src/Gyehoek/Stack/VM.hs

@@ -20,6 +20,7 @@ data VM = MkVM
   , code :: List Instr
   , registers :: HashMap Name Val
   , stdout :: Text
+  , result :: Maybe (List Val)
   }
   deriving (Show, Generic)
 
@@ -28,10 +29,9 @@ data Env = MkEnv
   }
   deriving (Show, Generic)
 
-step :: Env -> VM -> Either (List Val) VM
+step :: Env -> VM -> VM
 step e vm = case vm ^. #code of
-  CallLabel "halt" xs :_ -> Left xs
-  i:is -> Right $ stepI e (vm & #code .~ is) i
+  i:is -> stepI e (vm & #code .~ is) i
   _ -> error "halt never called"
 
 stepI :: Env -> VM -> Instr -> VM
@@ -51,6 +51,8 @@ stepI e vm (PopCont r) = case vm ^. #kstack of
 stepI e vm (CallReg r xs) = stepI e vm (CallLabel l xs)
   where l = vm ^?! #registers . at r . _Just . #ValLabel
 
+stepI e vm (CallLabel "halt" xs) = vm & #result ?~ xs
+
 stepI e vm (CallLabel l xs) =
   vm & #code .~ b.code
      & #registers .~ H.fromList (b.params `zip` xs)
@@ -68,6 +70,7 @@ initialVM = MkVM
   , code = [CallLabel "main" []]
   , registers = mempty
   , stdout = ""
+  , result = Nothing
   }
 
 initialEnv :: Program -> Env
@@ -81,4 +84,6 @@ loop f a = case f a of
   Left b -> b
 
 eval :: Program -> List Val
-eval p = loop (step $ initialEnv p) initialVM
+eval p = initialVM & loop \vm -> case vm ^. #result of
+  Nothing -> Right $ step (initialEnv p) vm
+  Just rs -> Left rs