remove CPS.ValLit

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
+    -- but we're reusing the lambda binding so we don't have to
-    -- reverences.
+    -- explicitly substitute recursive calls.
-    -- env <- gensym' @Name "env"
     let frees = freeWithBound' [f] lam
     let m' = ifoldr
              (\n x q -> [cps|(prim (env-ref #{f} #{n})

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 ->
+  MkProgram <$> telescope (convert @es) (p ^.. each . _Left) (pure . Halt)
-    pure . Halt1 $ case NE.nonEmpty exps of
-      Nothing -> ValLit Void
-      Just es -> NE.last es
 
 convertExp :: forall es. (GenSym :> es) => Scm.Exp -> Eff es Exp
 convertExp e = convert e (pure . Halt1)

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"]

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) =
+lowerVal g (ValImm imm) =
-  pure $ case l of
+  pure $ case imm of
-    LitInt n -> [expr|
+    ImmInt n -> [expr|
       (i32.const #{n})
       ##{makeSmallFixnum}
     |]
-    LitBool b -> [expr|
+    ImmBool b -> [expr|
       (i32.const #{b'})
       ref.i31
     |]

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}|]

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