diff --git a/src/Gyehoek/CPS/Convert.hs b/src/Gyehoek/CPS/Convert.hs index c00f1a4..a875d38 100644 --- a/src/Gyehoek/CPS/Convert.hs +++ b/src/Gyehoek/CPS/Convert.hs @@ -110,9 +110,8 @@ convertLambda bs m = do convertProgram :: forall es. (GenSym :> es) => Scm.Program -> Eff es Program convertProgram p = do - let nothalt = ExpContinue (ValVar "main-ktail") - e <- telescope (convert @es) (p ^.. each . _Left) (pure . nothalt) - _ + MkProgram <$> telescope (convert @es) (p ^.. each . _Left) (pure . nothalt) + where nothalt = ExpContinue (ValVar "main-ktail") convertExp :: forall es. (GenSym :> es) => Scm.Exp -> Eff es Exp convertExp e = convert e (pure . Halt1) diff --git a/src/Gyehoek/CPS/Stackify.hs b/src/Gyehoek/CPS/Stackify.hs index 611d398..8d68677 100644 --- a/src/Gyehoek/CPS/Stackify.hs +++ b/src/Gyehoek/CPS/Stackify.hs @@ -120,8 +120,9 @@ emptyEnv = MkEnv mempty mempty ["halt"] stackifyExp :: GenSym :> es => Name -> Exp -> Eff es Stk.Program stackifyExp lbl e = do - (code,p) <- runStackify $ stackify emptyEnv e - pure $ p <> [ Stk.MkRoutine lbl [] (buildBlock code) ] + let g = emptyEnv & #bound . at "main-ktail" ?~ Stk.ValReg "main-ktail" + (code,p) <- runStackify $ stackify g e + pure $ p <> [ Stk.MkRoutine lbl ["main-ktail"] (buildBlock code) ] stackifyProgram :: GenSym :> es => Program -> Eff es Stk.Program stackifyProgram (MkProgram e) = stackifyExp "main" e diff --git a/src/Gyehoek/Stack/VM.hs b/src/Gyehoek/Stack/VM.hs index 9bea54a..c05c74b 100644 --- a/src/Gyehoek/Stack/VM.hs +++ b/src/Gyehoek/Stack/VM.hs @@ -112,7 +112,7 @@ initialVM :: VM initialVM = MkVM { stack = [] , code = [] - , tail = TailCall (ValLabel "main") [ValLabel "ktail"] + , tail = TailCall (ValLabel "main") [ValLabel "halt"] , registers = mempty , stdout = "" , result = Nothing