diff --git a/src/Gyehoek/Stack/VM.hs b/src/Gyehoek/Stack/VM.hs index 821afc3..9c98b5c 100644 --- a/src/Gyehoek/Stack/VM.hs +++ b/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