diff --git a/docs/src/conf.py b/docs/src/conf.py index 8bb359c..7fac303 100644 --- a/docs/src/conf.py +++ b/docs/src/conf.py @@ -42,7 +42,7 @@ imgmath_latex_preamble = r''' \end{tblr} } \newcommand{\gmrule}[2] - {\begin{tblr}{|rrrll|} + {\begin{tblr}{|rrrrll|} \hline & #1 \\ \implies & #2 \\ diff --git a/docs/src/references/gm-state-transition-rules.rst b/docs/src/references/gm-state-transition-rules.rst index 53485c1..42b8cac 100644 --- a/docs/src/references/gm-state-transition-rules.rst +++ b/docs/src/references/gm-state-transition-rules.rst @@ -12,6 +12,7 @@ Core Transition Rules \gmrule { \mathtt{PushGlobal} \; f : i & s + & d & h & m \begin{bmatrix} @@ -20,6 +21,7 @@ Core Transition Rules } { i & a : s + & d & h & m } @@ -31,11 +33,13 @@ Core Transition Rules \gmrule { \mathtt{PushInt} \; n : i & s + & d & h & m } { i & a : s + & d & h \begin{bmatrix} a : \mathtt{NNum} \; n @@ -51,11 +55,13 @@ Core Transition Rules \gmrule { \mathtt{MkAp} : i & f : x : s + & d & h & m } { i & a : s + & d & h \begin{bmatrix} a : \mathtt{NAp} \; f \; x @@ -69,11 +75,13 @@ Core Transition Rules \gmrule { \mathtt{Push} \; n : i & a_0 : \ldots : a_n : s + & d & h & m } { i & a_n : a_0 : \ldots : a_n : s + & d & h & m } @@ -84,11 +92,13 @@ Core Transition Rules \gmrule { \mathtt{Slide} \; n : i & a_0 : \ldots : a_n : s + & d & h & m } { i & a_0 : s + & d & h & m } @@ -100,6 +110,7 @@ Core Transition Rules \gmrule { \mathtt{Unwind} : \nillist & a : s + & d & h \begin{bmatrix} a : \mathtt{NNum} \; n @@ -108,6 +119,7 @@ Core Transition Rules } { \nillist & a : s + & d & h & m } @@ -118,6 +130,7 @@ Core Transition Rules \gmrule { \mathtt{Unwind} : \nillist & a : s + & d & h \begin{bmatrix} a : \mathtt{NAp} \; f \; x @@ -126,6 +139,7 @@ Core Transition Rules } { \mathtt{Unwind} : \nillist & f : a : s + & d & h & m } @@ -138,6 +152,7 @@ Core Transition Rules \gmrule { \mathtt{Unwind} : \nillist & a_0 : \ldots : a_n : s + & d & h \begin{bmatrix} a_0 : \mathtt{NGlobal} \; n \; c \\ @@ -149,6 +164,7 @@ Core Transition Rules } { c & e_1 : \ldots : e_n : a_n : s + & d & h & m } @@ -159,6 +175,7 @@ Core Transition Rules \gmrule { \mathtt{Update} \; n : i & e : f : a_1 : \ldots : a_n : s + & d & h \begin{bmatrix} a_1 : \mathtt{NAp} \; f \; e \\ @@ -169,6 +186,7 @@ Core Transition Rules } { i & f : a_1 : \ldots : a_n : s + & d & h \begin{bmatrix} a_n : \mathtt{NInd} \; e @@ -182,11 +200,13 @@ Core Transition Rules \gmrule { \mathtt{Pop} \; n : i & a_1 : \ldots : a_n : s + & d & h & m } { i & s + & d & h & m } @@ -197,6 +217,7 @@ Core Transition Rules \gmrule { \mathtt{Unwind} : \nillist & a : s + & d & h \begin{bmatrix} a : \mathtt{NInd} \; a' @@ -205,6 +226,7 @@ Core Transition Rules } { \mathtt{Unwind} : \nillist & a' : s + & d & h & m } @@ -215,11 +237,13 @@ Core Transition Rules \gmrule { \mathtt{Alloc} \; n : i & s + & d & h & m } { i & a_1 : \ldots : a_n : s + & d & h \begin{bmatrix} a_1 : \mathtt{NUninitialised} \\ @@ -229,6 +253,43 @@ Core Transition Rules & m } +13. When unwinding, if the top of the stack is in WHNF, pop the dump + +.. math:: + \gmrule + { \mathtt{Unwind} : \nillist + & a : s + & \langle i', s' \rangle : d + & h + \begin{bmatrix} + a : \mathtt{NNum} \; n + \end{bmatrix} + & m + } + { i' + & a : s' + & d + & h + & m + } + +14. Evaluate the top of the stack to WHNF + +.. math:: + \gmrule + { \mathtt{Eval} : i + & a : s + & d + & h + & m + } + { i + & a : \nillist + & \langle i, s \rangle + & h + & m + } + *************** Extension Rules *************** diff --git a/src/GM.hs b/src/GM.hs index a45c252..a91bdfb 100644 --- a/src/GM.hs +++ b/src/GM.hs @@ -29,6 +29,7 @@ import Core data GmState = GmState { _gmCode :: Code , _gmStack :: Stack + , _gmDump :: Dump , _gmHeap :: GmHeap , _gmEnv :: Env , _gmStats :: Stats @@ -37,6 +38,7 @@ data GmState = GmState type Code = [Instr] type Stack = [Addr] +type Dump = [(Code, Stack)] type Env = [(Name, Addr)] type GmHeap = Heap Node @@ -49,6 +51,9 @@ data Instr = Unwind | Update Int | Pop Int | Alloc Int + | Eval + | Add + | Mul deriving (Show, Eq) data Node = NNum Int @@ -291,7 +296,7 @@ step st = case head (st ^. gmCode) of ---------------------------------------------------------------------------------- compile :: Program -> GmState -compile p = GmState c [] h g sts +compile p = GmState c [] [] h g sts where -- find the entry point and start unwinding c = [PushGlobal "main", Unwind] @@ -405,6 +410,8 @@ showState st = vcat , info $ showStack st , "-- Heap --------------------" , info $ showHeap st + , "-- Dump --------------------" + , info $ showDump st ] where stnum = st ^. (gmStats . stsReductions) @@ -429,14 +436,35 @@ showStack st = vcat $ uncurry showEntry <$> si -- stack with labeled indices si = [0..] `zip` s - digitalWidth = length . show - maxWidth = digitalWidth $ maximum (addresses h) - showIndex n = pad <> int n <> ": " - where pad = text (replicate (maxWidth - digitalWidth n) ' ') + w = maxWidth (addresses h) + showIndex n = padInt w n <> ": " showEntry :: Int -> Addr -> Doc showEntry n a = showIndex n <> showNodeAt st a +showDump :: GmState -> Doc +showDump st = vcat $ uncurry showEntry <$> di + where + h = st ^. gmHeap + d = st ^. gmDump + di = [0..] `zip` d + + showIndex n = padInt w n <> ": " + w = maxWidth (fst <$> di) + + showEntry :: Int -> (Code, Stack) -> Doc + showEntry n (c,s) = showIndex n + <> nest pprTabstop (showCode c) + +padInt :: Int -> Int -> Doc +padInt m n = text (replicate (m - digitalWidth n) ' ') <> int n + +maxWidth :: [Int] -> Int +maxWidth ns = digitalWidth $ maximum ns + +digitalWidth :: Int -> Int +digitalWidth = length . show + showHeap :: GmState -> Doc showHeap st = vcat $ showEntry <$> addresses h where @@ -483,7 +511,7 @@ showCode c = "Code" <+> braces instrs showInstr :: Instr -> Doc showInstr i = text $ show i -test = GmState c s h'' g sts +test = GmState c s d h'' g sts where c = [Push 4, Push 5, Slide 2, Unwind] s = [a0,a1,a2] @@ -492,5 +520,6 @@ test = GmState c s h'' g sts (h'',a2) = alloc h' $ NAp a0 a1 g = [ ("f", a0) ] + d = [] sts = def