From b329a42b71f4c825b51969f052b085add560ec5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Thu, 20 Aug 2026 17:54:21 -0600 Subject: [PATCH] remove CPS.ValLit --- src/Gyehoek/CPS/Close.hs | 5 ++--- src/Gyehoek/CPS/Convert.hs | 15 +++++---------- src/Gyehoek/CPS/Eval.hs | 8 +++++--- src/Gyehoek/CPS/Lower.hs | 8 ++++---- src/Gyehoek/CPS/Stackify.hs | 2 -- src/Gyehoek/CPS/Syntax.hs | 2 -- 6 files changed, 16 insertions(+), 24 deletions(-) diff --git a/src/Gyehoek/CPS/Close.hs b/src/Gyehoek/CPS/Close.hs index 6ddeb01..e29f4ba 100644 --- a/src/Gyehoek/CPS/Close.hs +++ b/src/Gyehoek/CPS/Close.hs @@ -13,9 +13,8 @@ close = transformM \case ExpLetRec [(f, AbsLambda lam@(MkLambda bs kb m))] e -> do f_code <- gensym' @Name $ f ^. _Wrapped'. to (<> "-code") -- it would probably be most sane to generate a symbol for `env`, - -- but we're reusing the lambda binding for the sake of recursive - -- reverences. - -- env <- gensym' @Name "env" + -- but we're reusing the lambda binding so we don't have to + -- explicitly substitute recursive calls. let frees = freeWithBound' [f] lam let m' = ifoldr (\n x q -> [cps|(prim (env-ref #{f} #{n}) diff --git a/src/Gyehoek/CPS/Convert.hs b/src/Gyehoek/CPS/Convert.hs index bfc4c8e..a08d466 100644 --- a/src/Gyehoek/CPS/Convert.hs +++ b/src/Gyehoek/CPS/Convert.hs @@ -23,18 +23,16 @@ telescope f = Cont.runCont . traverse (Cont.cont . f) -pattern Atomic e <- - e@( Scm.ExpLambda _ _ - ; Scm.ExpVar _ - ; Scm.ExpLit _ ) - -- | Transform an expression with a meta-continuation. convert :: forall es. (GenSym :> es) => Scm.Exp -> (Val -> Eff es Exp) -> Eff es Exp convert (Scm.ExpVar x) k = k $ ValVar x -convert (Scm.ExpLit l) k = k $ ValLit l +convert (Scm.ExpLit l) k = k . ValImm $ case l of + LitInt n -> ImmInt n + LitBool b -> ImmBool b + _ -> _ -- special case: call/cc is desugared during cps-conversion... convert (Scm.ExpPrim (PrimCallCC withcc)) k = do @@ -112,10 +110,7 @@ convertLambda bs m = do convertProgram :: forall es. (GenSym :> es) => Scm.Program -> Eff es Program convertProgram p = - MkProgram <$> telescope (convert @es) (p ^.. each . _Left) \exps -> - pure . Halt1 $ case NE.nonEmpty exps of - Nothing -> ValLit Void - Just es -> NE.last es + MkProgram <$> telescope (convert @es) (p ^.. each . _Left) (pure . Halt) convertExp :: forall es. (GenSym :> es) => Scm.Exp -> Eff es Exp convertExp e = convert e (pure . Halt1) diff --git a/src/Gyehoek/CPS/Eval.hs b/src/Gyehoek/CPS/Eval.hs index f74c1d6..bcb2759 100644 --- a/src/Gyehoek/CPS/Eval.hs +++ b/src/Gyehoek/CPS/Eval.hs @@ -60,13 +60,15 @@ evalVal :: Env -> Val -> Obj evalVal g = \case ValVar x -> fromMaybe (error [i|unbound: #{x}|]) $ g ^?! #vars . at x ValImm x -> ObjImm x - ValLit l -> ObjImm $ case l of - LitInt n -> ImmInt n - LitBool b -> ImmBool b emptyEnv :: Env emptyEnv = MkEnv { vars = mempty + -- a kinda silly hack to make sure `halt` is handled correctly when + -- it appears as the tail continuation of an application. the + -- special case of `eval` responsible for `halt` only covers terms + -- of the form `(continue $halt xs …)`; other terms such as + -- `($some-fn xs $halt)` just see an undefined label `$halt`. , labels = H.singleton "halt" ( emptyEnv , AbsKappa' ["h0"] $ Halt [ValVar "h0"] diff --git a/src/Gyehoek/CPS/Lower.hs b/src/Gyehoek/CPS/Lower.hs index ebd26de..78a7894 100644 --- a/src/Gyehoek/CPS/Lower.hs +++ b/src/Gyehoek/CPS/Lower.hs @@ -82,13 +82,13 @@ popArg n = [expr| lowerVal :: (HasCallStack, GenMod :> es) => Env -> Val -> Eff es Wasm.Expr -lowerVal g (ValLit l) = - pure $ case l of - LitInt n -> [expr| +lowerVal g (ValImm imm) = + pure $ case imm of + ImmInt n -> [expr| (i32.const #{n}) ##{makeSmallFixnum} |] - LitBool b -> [expr| + ImmBool b -> [expr| (i32.const #{b'}) ref.i31 |] diff --git a/src/Gyehoek/CPS/Stackify.hs b/src/Gyehoek/CPS/Stackify.hs index 6df54c1..6d64f41 100644 --- a/src/Gyehoek/CPS/Stackify.hs +++ b/src/Gyehoek/CPS/Stackify.hs @@ -87,8 +87,6 @@ stackify _ e = error [i|unimplemented exp: #{e}|] stackifyVal :: Env -> Val -> Stk.Val stackifyVal g = \case - ValLit (LitInt n) -> Stk.ValImm (ImmInt n) - ValLit (LitBool b) -> Stk.ValImm (ImmBool b) ValImm imm -> Stk.ValImm imm ValVar v -> var g v v -> error [i|unimplemented val: #{v}|] diff --git a/src/Gyehoek/CPS/Syntax.hs b/src/Gyehoek/CPS/Syntax.hs index 9dda7a1..400e657 100644 --- a/src/Gyehoek/CPS/Syntax.hs +++ b/src/Gyehoek/CPS/Syntax.hs @@ -63,7 +63,6 @@ import Gyehoek.Prelude hiding (op) data Val = ValImm Imm - | ValLit Lit | ValVar Name deriving (Show, Generic, Data, Eq) @@ -173,7 +172,6 @@ instance Plated Exp where instance S.SexpIso Val where sexpIso = match - $ With (\lit -> lit . S.sexpIso) $ With (\imm -> imm . S.sexpIso) $ With (\var -> var . S.sexpIso) $ End