Gm m3 #3
@@ -187,9 +187,9 @@ Core Transition Rules
|
|||||||
& m
|
& m
|
||||||
}
|
}
|
||||||
|
|
||||||
8. When a global node is on top of the stack (and the correct number of
|
8. When a supercombinator is on top of the stack (and the correct number of
|
||||||
arguments have been provided), :code:`Unwind` jumps to the supercombinator's
|
arguments have been provided), :code:`Unwind` sets up the stack and jumps to
|
||||||
code (:math:`\beta`-reduction)
|
the supercombinator's code (:math:`\beta`-reduction)
|
||||||
|
|
||||||
.. math::
|
.. math::
|
||||||
\gmrule
|
\gmrule
|
||||||
@@ -197,12 +197,15 @@ Core Transition Rules
|
|||||||
& a_0 : \ldots : a_n : s
|
& a_0 : \ldots : a_n : s
|
||||||
& h
|
& h
|
||||||
\begin{bmatrix}
|
\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}
|
\end{bmatrix}
|
||||||
& m
|
& m
|
||||||
}
|
}
|
||||||
{ c
|
{ c
|
||||||
& a_0 : \ldots : a_n : s
|
& e_1 : \ldots : e_n : a_n : s
|
||||||
& h
|
& h
|
||||||
& m
|
& m
|
||||||
}
|
}
|
||||||
|
|||||||
25
src/GM.hs
25
src/GM.hs
@@ -191,20 +191,15 @@ step st = case head (st ^. gmCode) of
|
|||||||
(h',a) = alloc h (NAp f x)
|
(h',a) = alloc h (NAp f x)
|
||||||
|
|
||||||
-- a `Push n` instruction pushes the address of (n+1)-th argument onto
|
-- 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
|
-- the stack.
|
||||||
-- an application. the (n+1)-th argument is the rhs of that application.
|
|
||||||
push :: Int -> GmState -> GmState
|
push :: Int -> GmState -> GmState
|
||||||
push n st = st
|
push n st = st
|
||||||
& gmCode %~ drop 1
|
& gmCode %~ drop 1
|
||||||
& gmStack .~ s'
|
& gmStack %~ (a:)
|
||||||
where
|
where
|
||||||
s = st ^. gmStack
|
|
||||||
h = st ^. gmHeap
|
h = st ^. gmHeap
|
||||||
|
s = st ^. gmStack
|
||||||
s' = arg : s
|
a = s !! n
|
||||||
argAp = s !! (n+1)
|
|
||||||
arg = case hLookupUnsafe argAp h of
|
|
||||||
NAp _ a -> a
|
|
||||||
|
|
||||||
-- 'slide' the top of the stack `n` entries downwards, popping any
|
-- 'slide' the top of the stack `n` entries downwards, popping any
|
||||||
-- entries along the way.
|
-- entries along the way.
|
||||||
@@ -248,10 +243,20 @@ step st = case head (st ^. gmCode) of
|
|||||||
-- leave the Unwind instr; continue unwinding
|
-- leave the Unwind instr; continue unwinding
|
||||||
& gmStack %~ (f:)
|
& gmStack %~ (f:)
|
||||||
-- assumes length s < d (i.e. enough args have been supplied)
|
-- 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
|
-- 'jump' to global's code by replacing our current
|
||||||
-- code with `c`
|
-- code with `c`
|
||||||
& gmCode .~ 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
|
-- follow indirection
|
||||||
NInd a -> st
|
NInd a -> st
|
||||||
-- leave the Unwind instr; continue unwinding.
|
-- leave the Unwind instr; continue unwinding.
|
||||||
|
|||||||
Reference in New Issue
Block a user