app/Gyehoek/ANF.hs

@@ -17,7 +17,7 @@ import Data.List (List)
 import Data.Text.IO qualified as TIO
 import Control.Lens
 import Data.Generics.Labels
-import Data.Vector (Vector)
+import Data.Vector.Strict (Vector)
 import Data.Function (fix)
 import Effectful.Writer.Static.Local
 import Gyehoek.Syntax qualified as Lam
@@ -25,7 +25,7 @@ import Gyehoek.Syntax (Name, Prim(..), Val(..))
 import Gyehoek.GenSym
 import Control.Monad.Cont
 import Data.Foldable
-import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.List.NonEmpty (NonEmpty((:|)), toList)
 import Gyehoek.QBE (FuncDef(FuncDef))
 import Data.Foldable1
 
@@ -131,36 +131,54 @@ prims = QBE.Program mempty mempty primfns where
       (QBE.Ret (Just (QBE.ValTemporary "r")))
     ]
 
+data BlockBuilder
+  = Emit (Vector QBE.Inst) !BlockBuilder
+  | Exit QBE.Jump
+  deriving (Show)
+
+instance Each BlockBuilder BlockBuilder QBE.Inst QBE.Inst where
+  each k (Emit is bb) = Emit <$> traverse k is <*> each k bb
+  each k (Exit j) = pure (Exit j)
+
+evalBlockBuilder :: BlockBuilder -> (Vector QBE.Inst, QBE.Jump)
+evalBlockBuilder (Emit is bb) = evalBlockBuilder bb & _1 <>:~ is
+evalBlockBuilder (Exit j)     = ([],j)
+
+buildBlock :: QBE.Ident QBE.Label -> BlockBuilder -> QBE.Block
+buildBlock n bb = QBE.Block n [] (is ^.. each) j
+  where (is,j) = evalBlockBuilder bb
+
 lowerVal
-  :: forall es. (GenSym :> es, CodeGen :> es)
+  :: forall es. (GenSym :> es)
   => Val
-  -> (QBE.Val -> Eff es QBE.Block)
-  -> Eff es QBE.Block
+  -> (QBE.Val -> Eff es BlockBuilder)
+  -> Eff es BlockBuilder
 
 lowerVal (ValInt n) k = k . QBE.ValConst . QBE.CInt . fromIntegral $ n
 lowerVal _ k = _
 
 lower'
-  :: forall es. (GenSym :> es, CodeGen :> es)
+  :: forall es. (GenSym :> es)
   => Exp
-  -> (QBE.Val -> Eff es QBE.Block)
-  -> Eff es QBE.Block
+  -> (QBE.Val -> Eff es BlockBuilder)
+  -> Eff es BlockBuilder
 
 lower' (ExpVal v) k = lowerVal v k
 
 lower' (ExpLetApply r f xs e) k =
   blah (lowerVal @es <$> (f:|xs)) \(f':xs') -> do
     r <- gensym
-    emit $ QBE.Call
-      (Just (r, QBE.AbiBaseTy QBE.Long))
-      f'
-      Nothing
-      (QBE.Arg (QBE.AbiBaseTy QBE.Long) <$> xs')
-      []
-    lower' e k
+    Emit [ QBE.Call
+            (Just (r, QBE.AbiBaseTy QBE.Long))
+            f'
+            Nothing
+            (QBE.Arg (QBE.AbiBaseTy QBE.Long) <$> xs')
+            []
+          ]
+      <$> lower' e k
 
 lower' _ k = _
 
-lower e = do
-  _ <- runCodeGen (lower' e \r -> _)
-  _
+-- lower e = do
+--   _ <- runCodeGen (lower' e \r -> _)
+--   _