diff --git a/app/Gyehoek/ANF.hs b/app/Gyehoek/ANF.hs index 6d05f84..9d20d23 100644 --- a/app/Gyehoek/ANF.hs +++ b/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 -> _) +-- _