app/Gyehoek/ANF.hs

@@ -146,10 +146,11 @@ toANF'
   -> Eff es Exp
 
 toANF' (Lam.ExpLit v) k = k . ValLit $ v
+
 toANF' (Lam.ExpPrim p) k =
-  telescope (toANF' <$> p) \p -> do
+  telescope (toANF' <$> p) \p' -> do
     r <- gensym
-    ExpLetPrim r p <$> k (ValVar r)
+    ExpLetPrim r p' <$> k (ValVar r)
 
 toANF' (Lam.ExpApply f xs) k =
   telescope (toANF' <$> (f:|xs)) \(f':|xs') -> do
@@ -236,6 +237,23 @@ lowerVal (ValLit (LitInt n)) k =
 lowerVal (ValLit _) k = error "todo"
 lowerVal (ValVar x) k = k . QBE.ValTemporary . lowerName $ x
 
+lowerBinaryOp :: QBE.Assignment -> Prim QBE.Val -> QBE.Inst
+lowerBinaryOp r p = QBE.BinaryOp r bop x y
+  where
+    (bop,x,y) = case p of
+      PrimAdd a b -> (QBE.Add,a,b)
+      PrimMul a b -> (QBE.Mul,a,b)
+      _ -> _
+
+-- lowerPrim 
+--   :: forall es. (GenSym :> es)
+--   => Prim Val
+--   -> (QBE.Val -> Eff es BlockBuilder)
+--   -> Eff es BlockBuilder
+-- lowerPrim p k = telescope (lowerVal <$> p) \p' -> do
+--   Emit [ lowerBinaryOp (r QBE.:= QBE.Long) p' ]
+--     <$> k (QBE.ValTemporary r)
+
 lower'
   :: forall es. (GenSym :> es)
   => Exp
@@ -244,6 +262,11 @@ lower'
 
 lower' (ExpVal v) k = lowerVal v k
 
+lower' (ExpLetPrim r p e) k =
+  telescope (lowerVal <$> p) \p' -> do
+    Emit [ lowerBinaryOp (lowerName r QBE.:= QBE.Long) p' ]
+      <$> lower' e k
+
 lower' (ExpLetApply r f xs e) k =
   telescope (lowerVal @es <$> (f:|xs)) \(f':|xs') -> do
     Emit [ QBE.Call

app/Gyehoek/Syntax.hs

@@ -13,6 +13,7 @@ import Prelude hiding ((.), id)
 import Control.Category
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Gyehoek.Sexp qualified
+import Control.Lens (Each)
 
 
 type Name = Text
@@ -24,6 +25,8 @@ data Prim e
   | PrimDiv e e
   deriving (Show, Generic, Functor, Foldable, Traversable)
 
+instance Each (Prim e) (Prim e') e e'
+
 data Lit
   = LitInt Int
   | LitNil