app/Gyehoek/ANF.hs

@@ -7,7 +7,7 @@
 {-# OPTIONS_GHC -Wno-orphans -Wno-unused-matches -Wno-missing-signatures #-}
 {- HLINT ignore "Avoid lambda using `infix`" -}
 module Gyehoek.ANF
-  (toANF)
+  (toANF, lower)
   where
 
 import Data.Text (Text)
@@ -28,6 +28,8 @@ import Data.Foldable
 import Data.List.NonEmpty (NonEmpty((:|)), toList)
 import Gyehoek.QBE (FuncDef(FuncDef))
 import Data.Foldable1
+import qualified Data.Text as T
+import Data.String (fromString)
 
 
 -- data Val
@@ -107,6 +109,7 @@ instance Semigroup QBE.Program where
     QBE.Program (ts <> ts') (ds <> ds') (fs <> fs')
 
 instance Monoid QBE.Program where
+  mempty :: QBE.Program
   mempty = QBE.Program mempty mempty mempty
 
 funcdef :: QBE.Ident QBE.Global -> [QBE.Param] -> NonEmpty QBE.Block -> FuncDef
@@ -148,6 +151,16 @@ buildBlock :: QBE.Ident QBE.Label -> BlockBuilder -> QBE.Block
 buildBlock n bb = QBE.Block n [] (is ^.. each) j
   where (is,j) = evalBlockBuilder bb
 
+lowerName :: Name -> QBE.Ident t
+lowerName = fromString . T.unpack
+
+lowerPrim :: Prim -> _ -> _
+lowerPrim PrimAdd k = k $ QBE.ValGlobal "plus"
+lowerPrim PrimMul k = k $ QBE.ValGlobal "star"
+lowerPrim PrimSub k = k $ QBE.ValGlobal "_"
+lowerPrim PrimDiv k = k $ QBE.ValGlobal "slash"
+lowerPrim p k = _
+
 lowerVal
   :: forall es. (GenSym :> es)
   => Val
@@ -155,6 +168,8 @@ lowerVal
   -> Eff es BlockBuilder
 
 lowerVal (ValInt n) k = k . QBE.ValConst . QBE.CInt . fromIntegral $ n
+lowerVal (ValVar x) k = k . QBE.ValTemporary . lowerName $ x
+lowerVal (ValPrim p) k = lowerPrim p k
 lowerVal _ k = _
 
 lower'
@@ -167,9 +182,8 @@ 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))
+            (Just (lowerName r, QBE.AbiBaseTy QBE.Long))
             f'
             Nothing
             (QBE.Arg (QBE.AbiBaseTy QBE.Long) <$> xs')
@@ -179,6 +193,11 @@ lower' (ExpLetApply r f xs e) k =
 
 lower' _ k = _
 
--- lower e = do
---   _ <- runCodeGen (lower' e \r -> _)
---   _
+lower :: GenSym :> es => QBE.Ident QBE.Label -> Exp -> Eff es QBE.Block
+lower n e = buildBlock n <$> lower' e (pure . Exit . QBE.Ret . Just)
+
+wrapProgram :: Foldable1 t => t QBE.Block -> QBE.Program
+wrapProgram bs = QBE.Program [] [] [main] where
+  main = QBE.FuncDef [QBE.Export]
+    (Just (QBE.AbiBaseTy QBE.Word))
+    "main" Nothing [] QBE.NoVariadic (toNonEmpty bs)