diff --git a/doc/src/references/gm-state-transitions.rst b/doc/src/references/gm-state-transitions.rst index 1b1e148..59df767 100644 --- a/doc/src/references/gm-state-transitions.rst +++ b/doc/src/references/gm-state-transitions.rst @@ -406,7 +406,7 @@ Core Transition Rules .. math:: \gmrule - { \mathtt{CaseJump} \begin{bmatrix} t \to c \end{bmatrix} : i + { \mathtt{CaseJump} \begin{bmatrix} t : c \end{bmatrix} : i & a : s & d & h diff --git a/src/GM.hs b/src/GM.hs index 381d134..7ed184f 100644 --- a/src/GM.hs +++ b/src/GM.hs @@ -144,8 +144,6 @@ isFinal st = null $ st ^. gmCode step :: GmState -> GmState step st = case head (st ^. gmCode) of - -- TODO: clean this up. let transition functions use the 'state' parameter - -- instead of passing it to them. Unwind -> unwindI PushGlobal n -> pushGlobalI n PushConstr t n -> pushConstrI t n @@ -164,8 +162,22 @@ step st = case head (st ^. gmCode) of Div -> divI Split n -> splitI n Pack t n -> packI t n + CaseJump as -> caseJumpI as where + caseJumpI :: [(Tag, Code)] -> GmState + caseJumpI as = st + & advanceCode + & gmCode %~ (i'++) + where + h = st ^. gmHeap + s = st ^. gmStack + NConstr t ss = head s + & hViewUnsafe h + i' = fromMaybe + (error $ "unmatched tag: " <> show t) + (lookup t as) + packI :: Tag -> Int -> GmState packI t n = st & advanceCode