wip: stackify

src/Gyehoek/Stack/VM.hs

@@ -1,8 +1,10 @@
+{-# LANGUAGE ViewPatterns #-}
 module Gyehoek.Stack.VM
   ( VM(..)
   , Env(..)
   , eval
   , trace
+  , module Gyehoek.Stack.Syntax
   ) where
 
 import Gyehoek.Stack.Syntax
@@ -68,23 +70,18 @@ stepI e vm (Pop r) = case vm ^. #stack of
 
 stepI e vm (PopCont r) = case vm ^. #kstack of
   [] -> error "empty stack"
-  (x:xs) -> vm & #registers . at r ?~ ObjLabel x
+  (x:xs) -> vm & #registers . at r ?~ ObjImm (ImmLabel x)
                & #kstack .~ xs
 
-stepI e vm (CallReg r xs) = stepI e vm (CallLabel l xs)
-  where l = case vm ^? #registers . at r . _Just . #ObjLabel of
+stepI e vm (Call v xs) =
+  case evalToLabel e vm v of
+    "halt" -> vm & #result ?~ fmap (evalVal e vm) xs
+    l -> vm & #code .~ b.code
+            & #registers .~ fmap (evalVal e vm) (H.fromList $ b.params `zip` xs)
+      where
+        b = case e ^. #blocks . at l of
           Just x -> x
-          Nothing -> error [i|tried to call undefined register: #{r}|]
-
-stepI e vm (CallLabel "halt" xs) = vm & #result ?~ fmap (evalVal e vm) xs
-
-stepI e vm (CallLabel l xs) =
-  vm & #code .~ b.code
-     & #registers .~ fmap (evalVal e vm) (H.fromList $ b.params `zip` xs)
-  where
-    b = case e ^. #blocks . at l of
-      Just x -> x
-      Nothing -> error [i|undefined label: #{l}|]
+          Nothing -> error [i|undefined label: #{l}|]
 
 stepI e vm (If c t f) =
   case evalVal e vm c of
@@ -93,6 +90,11 @@ stepI e vm (If c t f) =
 
 stepI e vm ins = error [i|unimplemented instruction: #{ins}|]
 
+evalToLabel e vm v =
+  case evalVal e vm v of
+    ObjImm (ImmLabel x) -> x
+    x -> error [i|not a label: #{x}|]
+
 evalVal :: Env -> VM -> Val -> Obj
 evalVal e vm = \case
   ValImm imm -> ObjImm imm
@@ -104,7 +106,7 @@ initialVM :: VM
 initialVM = MkVM
   { stack = []
   , kstack = ["halt"]
-  , code = [CallLabel "main" []]
+  , code = [Call (ValImm $ ImmLabel "main") []]
   , registers = mempty
   , stdout = ""
   , result = Nothing
@@ -131,39 +133,3 @@ trace p = initialVM & unfoldr \vm ->
       Just _ -> Nothing
       Nothing -> Just (vm, step e vm)
   where e = initialEnv p
-
-fac =
-      [ MkBlock "fac" ["n"]
-        [ Prim "x0" $ PrimZeroP (ValReg "n")
-        , If (ValReg "x0")
-          [ PopCont "ktail"
-          , CallReg "ktail" [ValImm (ImmInt 1)]
-          ]
-          [ Push (ValReg "n")
-          , Prim "x1" $ PrimSub (ValReg "n") (ValImm (ImmInt 1))
-          , PushCont "fac-k0"
-          , CallLabel "fac" [ValReg "x1"]
-          ]
-        ]
-      , MkBlock "fac-k0" ["x2"]
-        [ Pop "n"
-        , Prim "x3" $ PrimMul (ValReg "x2") (ValReg "n")
-        , PopCont "ktail"
-        , CallReg "ktail" [ValReg "x3"]
-        ]
-      ]
-
-fac3 = MkProgram $
-  [ MkBlock "main" []
-    [ CallLabel "fac" [ValImm (ImmInt 3)]
-    ]
-  ] <> fac
-
-fac3_trace = trace fac3
-
-showVM :: VM -> Text
-showVM vm = [i|(#{instr}) ; #{stk} #{kstk}|]
-  where
-    instr = vm ^?! #code . _head
-    stk = vm.stack
-    kstk = vm.kstack