This commit is contained in:
2026-07-07 16:38:13 -06:00
parent b2d9a982ac
commit 8bed7f09a5
3 changed files with 8 additions and 5 deletions
+1 -1
View File
@@ -28,7 +28,7 @@ convert (Scm.ExpLit l) k = k $ ValLit l
convert (Scm.ExpPrim p) k = convert (Scm.ExpPrim p) k =
telescope (convert @es) p \p' -> do telescope (convert @es) p \p' -> do
r <- gensym' "r" r <- gensym' "r"
ExpPrim p' [r] . pure <$> k (ValVar r) ExpPrim p' [r] <$> k (ValVar r)
convert (Scm.ExpLambda xs e) k = do convert (Scm.ExpLambda xs e) k = do
f <- gensym' "f" f <- gensym' "f"
+2 -2
View File
@@ -72,6 +72,7 @@ data Module = MkModule
data Func = MkFunc data Func = MkFunc
{ code :: Text { code :: Text
, numLocals :: Int
} }
deriving (Show, Generic) deriving (Show, Generic)
@@ -92,13 +93,12 @@ lower' :: Env -> Exp -> Vector Text
lower' g (Halt [e]) = lowerVal g e lower' g (Halt [e]) = lowerVal g e
lower' g (ExpPrim p rs es) = lower' g (ExpPrim p rs e) =
case p of case p of
PrimAdd x y -> lowerBinOp "i32.add" g x y r e PrimAdd x y -> lowerBinOp "i32.add" g x y r e
PrimMul x y -> lowerBinOp "i32.mul" g x y r e PrimMul x y -> lowerBinOp "i32.mul" g x y r e
where where
r = head rs r = head rs
e = head es
lowerBinOp op g x y r e = lowerBinOp op g x y r e =
lowerVal g x lowerVal g x
+5 -2
View File
@@ -41,9 +41,10 @@ data Kappa = MkKappa (List Name) Exp
deriving (Show, Generic) deriving (Show, Generic)
data Exp data Exp
= ExpPrim (Prim Val) (List Name) (List Exp) = ExpPrim (Prim Val) (List Name) Exp
| ExpFix (NonEmpty (Name, Kappa)) Exp | ExpFix (NonEmpty (Name, Kappa)) Exp
| ExpApply Val (List Val) | ExpApply Val (List Val)
| ExpIf Val Exp Exp
deriving (Show, Generic) deriving (Show, Generic)
pattern Halt :: List Val -> Exp pattern Halt :: List Val -> Exp
@@ -83,12 +84,14 @@ instance S.SexpIso Exp where
$ With (. prim) $ With (. prim)
$ With (. let_) $ With (. let_)
$ With (. app) $ With (. app)
$ With (. if_)
$ End $ End
where where
let_ = Gyehoek.Sexp.let_ "fix" S.sexpIso S.sexpIso S.sexpIso let_ = Gyehoek.Sexp.let_ "fix" S.sexpIso S.sexpIso S.sexpIso
if_ = S.list $ S.el S.sexpIso >>> S.el S.sexpIso >>> S.el S.sexpIso
app = S.list $ S.el S.sexpIso >>> S.rest S.sexpIso app = S.list $ S.el S.sexpIso >>> S.rest S.sexpIso
prim = S.list $ prim = S.list $
S.el (S.sym "prim") S.el (S.sym "prim")
>>> S.el (primSexpIso id (S.sexpIso @Val)) >>> S.el (primSexpIso id (S.sexpIso @Val))
>>> S.el S.sexpIso >>> S.el S.sexpIso
>>> S.rest S.sexpIso >>> S.el S.sexpIso