From ee3788d35edd1a6107a2b5e0c1d7172234f7a640 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Fri, 24 Jul 2020 22:39:29 +0200
Subject: Define builtins in backend

---
 ast/CC/Context.hs          |  7 ++++++-
 backend/CC/Backend/Dumb.hs | 14 ++++++++++++++
 compcomp.cabal             |  8 +++++++-
 main/Main.hs               |  3 ++-
 parser/CC/Parser.hs        |  2 +-
 typecheck/CC/Typecheck.hs  | 10 ++++++----
 6 files changed, 36 insertions(+), 8 deletions(-)
 create mode 100644 backend/CC/Backend/Dumb.hs

diff --git a/ast/CC/Context.hs b/ast/CC/Context.hs
index 1f8c673..0a54392 100644
--- a/ast/CC/Context.hs
+++ b/ast/CC/Context.hs
@@ -1,5 +1,10 @@
 module CC.Context where
 
+import CC.AST.Typed
+
 
 -- | Source metadata for compilation
-data Context = Context FilePath
+data Context = Context FilePath Builtins
+
+-- | Information about builtins supported by the enabled backend
+data Builtins = Builtins [(Name, TypeT)]
diff --git a/backend/CC/Backend/Dumb.hs b/backend/CC/Backend/Dumb.hs
new file mode 100644
index 0000000..070fece
--- /dev/null
+++ b/backend/CC/Backend/Dumb.hs
@@ -0,0 +1,14 @@
+module CC.Backend.Dumb(builtins) where
+
+import CC.AST.Typed
+import CC.Context
+
+
+builtins :: Builtins
+builtins = Builtins
+    [ ("print", TFunT TIntT (TTupT []))
+    , ("fst", TFunT (TTupT [TyVar 1, TyVar 2]) (TyVar 1))
+    , ("snd", TFunT (TTupT [TyVar 1, TyVar 2]) (TyVar 2))
+    , ("_add", TFunT TIntT (TFunT TIntT TIntT))
+    , ("_sub", TFunT TIntT (TFunT TIntT TIntT))
+    , ("_mul", TFunT TIntT (TFunT TIntT TIntT)) ]
diff --git a/compcomp.cabal b/compcomp.cabal
index 6635172..8e094f6 100644
--- a/compcomp.cabal
+++ b/compcomp.cabal
@@ -15,7 +15,7 @@ executable            compcomp
     import:           deps
     hs-source-dirs:   main
     main-is:          Main.hs
-    build-depends:    cc-parser, cc-typecheck, cc-ast, cc-utils
+    build-depends:    cc-parser, cc-typecheck, cc-backend-dumb, cc-ast, cc-utils
 
 library               cc-parser
     import:           deps
@@ -29,6 +29,12 @@ library               cc-typecheck
     build-depends:    containers, mtl, cc-ast, cc-utils
     exposed-modules:  CC.Typecheck
 
+library               cc-backend-dumb
+    import:           deps
+    hs-source-dirs:   backend
+    build-depends:    cc-ast, cc-utils
+    exposed-modules:  CC.Backend.Dumb
+
 library               cc-ast
     import:           deps
     hs-source-dirs:   ast
diff --git a/main/Main.hs b/main/Main.hs
index f5a3d5a..a7e242d 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -4,6 +4,7 @@ import System.Exit
 
 import qualified CC.Parser as Parser
 import qualified CC.Typecheck as Typecheck
+import qualified CC.Backend.Dumb as Backend
 
 import CC.Context
 import CC.Pretty
@@ -29,7 +30,7 @@ main = do
     let combined = parse `passJoin` typecheck
 
     source <- getContents
-    let context = Context "<stdin>"
+    let context = Context "<stdin>" Backend.builtins
     case combined context (read source) of
         Right prog -> pprint prog
         Left err -> die err
diff --git a/parser/CC/Parser.hs b/parser/CC/Parser.hs
index 76f0b68..3183dea 100644
--- a/parser/CC/Parser.hs
+++ b/parser/CC/Parser.hs
@@ -12,7 +12,7 @@ import CC.Pretty
 type Parser a = Parsec String () a
 
 runPass :: Context -> RawString -> Either (PrettyShow ParseError) Program
-runPass (Context path) (RawString src) = fmapLeft PrettyShow (parseProgram path src)
+runPass (Context path _) (RawString src) = fmapLeft PrettyShow (parseProgram path src)
   where fmapLeft f (Left x) = Left (f x)
         fmapLeft _ (Right x) = Right x
 
diff --git a/typecheck/CC/Typecheck.hs b/typecheck/CC/Typecheck.hs
index aac7923..bf1d17c 100644
--- a/typecheck/CC/Typecheck.hs
+++ b/typecheck/CC/Typecheck.hs
@@ -181,14 +181,16 @@ inferList env (expr : exprs) = do
 
 
 runPass :: Context -> Program -> Either TCError ProgramT
-runPass _ prog = runTM (typeCheck prog)
+runPass (Context _ (Builtins builtins)) prog =
+    let env = Env (Map.fromList [(name, generalise emptyEnv ty) | (name, ty) <- builtins])
+    in runTM (typeCheck env prog)
 
-typeCheck :: Program -> TM ProgramT
-typeCheck (Program decls) =
+typeCheck :: Env -> Program -> TM ProgramT
+typeCheck startEnv (Program decls) =
     let defs = [(name, ty)
                | Def (Function (Just ty) (name, _) _ _) <- decls]
         env = foldl (\env' (name, ty) -> envAdd name (generalise env' (convertType ty)) env')
-                    emptyEnv defs
+                    startEnv defs
     in ProgramT <$> mapM (typeCheckDef env . (\(Def def) -> def)) decls
 
 typeCheckDef :: Env -> Def -> TM DefT
-- 
cgit v1.2.3-70-g09d2