diff options
| -rw-r--r-- | ast/CC/Context.hs | 7 | ||||
| -rw-r--r-- | backend/CC/Backend/Dumb.hs | 14 | ||||
| -rw-r--r-- | compcomp.cabal | 8 | ||||
| -rw-r--r-- | main/Main.hs | 3 | ||||
| -rw-r--r-- | parser/CC/Parser.hs | 2 | ||||
| -rw-r--r-- | typecheck/CC/Typecheck.hs | 10 | 
6 files changed, 36 insertions, 8 deletions
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  | 
