app/Main.hs

@@ -6,85 +6,10 @@ module Main
   (main)
   where
 
-import Data.Text (Text)
-import Effectful
-import Gyehoek.QBE as QBE
-import Data.List (List)
-import Data.Text.IO qualified as TIO
-import Control.Lens
-import Data.Vector (Vector)
-import Data.Function (fix)
-import Effectful.Writer.Static.Local
+import qualified Gyehoek.ANF as ANF
+import Gyehoek.QBE (render)
+import qualified Data.Text.IO as TIO
 
 
-type Name = Text
-
-data Value
-  = ValInt Int
-  | ValNil
-  | ValPrim Prim
-  deriving (Show)
-
-data Sexp
-  -- | Cons
-  = Sexp :. Sexp
-  | UseVal Value
-  deriving (Show)
-
-infixr 5 :.
-pattern Cons :: Sexp -> Sexp -> Sexp
-pattern Cons x y = x :. y
-
-data Prim = PrimAdd | PrimSub | PrimMul | PrimDiv
-  deriving (Show)
-
-mapcar :: Traversal' Sexp Sexp
-mapcar k (Cons x xs) = Cons <$> k x <*> mapcar k xs
-mapcar k x           = pure x
-
-type CodeGen = Writer (Vector Inst)
-
-runCodeGen :: Eff (CodeGen : es) a -> Eff es (a, Vector Inst)
-runCodeGen = runWriter
-
-emit :: CodeGen :> es => Inst -> Eff es ()
-emit = tell . pure
-
-compile
-  :: (GenSym :> es, CodeGen :> es)
-  => Sexp
-  -> (QBE.Val -> Eff es Jump)
-  -> Eff es Jump
-
-compile (UseVal (ValInt n)) k =
-  k . ValConst . CInt . fromIntegral $ n
-
-compile (UseVal (ValPrim p) :. args) k = f (args ^.. mapcar)
-  where
-    f [x,y] =
-      compile x \x' ->
-        compile y \y' -> do
-          r <- gensym
-          emit $ BinaryOp (r := Long) bop x' y'
-          k (ValTemporary r)
-    f _ = _
-    bop = case p of
-      PrimAdd -> Add
-      PrimMul -> Mul
-      _ -> _
-
-compile _ _ = _
-
-compile' :: (GenSym :> es) => Ident Label -> Sexp -> Eff es Block
-compile' l e = do
-  (j,is) <- runCodeGen $ compile e (pure . Ret . Just)
-  pure $ Block l [] (is ^.. each) j
-
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
-
-expr = UseVal (ValPrim PrimAdd)
-  :. UseVal (ValInt 1)
-  :. UseVal (ValInt 2)
-  -- :. UseVal (ValInt 3)
-  :. UseVal ValNil
+main = TIO.putStrLn . render $ ANF.expr