docs/src/commentary/gm.rst

@@ -187,9 +187,9 @@ Core Transition Rules
    & m
    }
 
-8. When a global node is on top of the stack (and the correct number of
-   arguments have been provided), :code:`Unwind` jumps to the supercombinator's
-   code (:math:`\beta`-reduction)
+8. When a supercombinator is on top of the stack (and the correct number of
+   arguments have been provided), :code:`Unwind` sets up the stack and jumps to
+   the supercombinator's code (:math:`\beta`-reduction)
 
 .. math::
    \gmrule
@@ -197,12 +197,15 @@ Core Transition Rules
    & a_0 : \ldots : a_n : s
    & h
    \begin{bmatrix}
-        a_0 : \mathtt{NGlobal} \; n \; c
+        a_0 : \mathtt{NGlobal} \; n \; c \\
+        a_1 : \mathtt{NAp} \; a_0 \; e_1 \\
+        \vdots \\
+        a_n : \mathtt{NAp} \; a_{n-1} \; e_n \\
    \end{bmatrix}
    & m
    }
    { c
-   & a_0 : \ldots : a_n : s
+   & e_1 : \ldots : e_n : a_n : s
    & h
    & m
    }

src/GM.hs

@@ -191,20 +191,15 @@ step st = case head (st ^. gmCode) of
                 (h',a) = alloc h (NAp f x)
 
         -- a `Push n` instruction pushes the address of (n+1)-th argument onto
-        -- the stack. this means that the nth node on the stack is assumed to be
-        -- an application. the (n+1)-th argument is the rhs of that application.
+        -- the stack.
         push :: Int -> GmState -> GmState
         push n st = st
                   & gmCode  %~ drop 1
-                  & gmStack .~ s'
+                  & gmStack %~ (a:)
             where
-                s = st ^. gmStack
                 h = st ^. gmHeap
-
-                s' = arg : s
-                argAp = s !! (n+1)
-                arg = case hLookupUnsafe argAp h of
-                    NAp _ a -> a
+                s = st ^. gmStack
+                a = s !! n
 
         -- 'slide' the top of the stack `n` entries downwards, popping any
         -- entries along the way.
@@ -248,10 +243,20 @@ step st = case head (st ^. gmCode) of
                          -- leave the Unwind instr; continue unwinding
                          & gmStack %~ (f:)
             -- assumes length s < d (i.e. enough args have been supplied)
-            NGlobal d c -> st
+            NGlobal n c -> st
                          -- 'jump' to global's code by replacing our current
                          -- code with `c`
                          & gmCode  .~ c
+                         & gmStack .~ s'
+                where
+                    s' = args ++ drop n s
+                    args = getArgs $ take (n+1) s
+
+                    getArgs :: Stack -> [Addr]
+                    getArgs (_:ss) = fmap arg ss
+                        where
+                            arg (hViewUnsafe h -> NAp _ x) = x
+
             -- follow indirection
             NInd a      -> st
                          -- leave the Unwind instr; continue unwinding.