From d951a11b1141b9f4c1ee50c7f89b68c552883c16 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Fri, 24 Jul 2020 22:24:44 +0200 Subject: Move CC.{Source,Typed} to CC.AST.* --- ast/CC/AST/Source.hs | 47 ++++++++++++++++++++++++++++++++++++ ast/CC/AST/Typed.hs | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 114 insertions(+) create mode 100644 ast/CC/AST/Source.hs create mode 100644 ast/CC/AST/Typed.hs (limited to 'ast/CC/AST') diff --git a/ast/CC/AST/Source.hs b/ast/CC/AST/Source.hs new file mode 100644 index 0000000..3d7d5ea --- /dev/null +++ b/ast/CC/AST/Source.hs @@ -0,0 +1,47 @@ +module CC.AST.Source(module CC.AST.Source, module CC.Types) where + +import Data.List + +import CC.Pretty +import CC.Types + + +data Program = Program [Decl] + deriving (Show, Read) + +data Decl = Def Def -- import? + deriving (Show, Read) + +data Def = Function (Maybe Type) + (Name, SourceRange) + [(Name, SourceRange)] + Expr + deriving (Show, Read) + +data Type = TFun Type Type + | TInt + | TTup [Type] + deriving (Show, Read) + +data Expr = Lam SourceRange [(Name, SourceRange)] Expr + | Call SourceRange Expr Expr + | Int SourceRange Int + | Tup SourceRange [Expr] + | Var SourceRange Name + | Annot SourceRange Expr Type + deriving (Show, Read) + +instance Pretty Type where + prettyPrec _ TInt = "Int" + prettyPrec p (TFun a b) = + precParens p 2 (prettyPrec 3 a ++ " -> " ++ prettyPrec 2 b) + prettyPrec _ (TTup ts) = + "(" ++ intercalate ", " (map pretty ts) ++ ")" + +instance HasRange Expr where + range (Lam sr _ _) = sr + range (Call sr _ _) = sr + range (Int sr _) = sr + range (Tup sr _) = sr + range (Var sr _) = sr + range (Annot sr _ _) = sr diff --git a/ast/CC/AST/Typed.hs b/ast/CC/AST/Typed.hs new file mode 100644 index 0000000..f4c4d56 --- /dev/null +++ b/ast/CC/AST/Typed.hs @@ -0,0 +1,67 @@ +module CC.AST.Typed( + module CC.AST.Typed, + module CC.Types +) where + +import Data.List + +import CC.Pretty +import CC.Types + + +data ProgramT = ProgramT [DefT] + deriving (Show, Read) + +data DefT = DefT Name ExprT + deriving (Show, Read) + +data TypeT = TFunT TypeT TypeT + | TIntT + | TTupT [TypeT] + | TyVar Int + deriving (Show, Read) + +data ExprT = LamT TypeT Occ ExprT + | CallT TypeT ExprT ExprT + | IntT Int + | TupT [ExprT] + | VarT Occ + deriving (Show, Read) + +data Occ = Occ Name TypeT + deriving (Show, Read) + +exprType :: ExprT -> TypeT +exprType (LamT typ _ _) = typ +exprType (CallT typ _ _) = typ +exprType (IntT _) = TIntT +exprType (TupT es) = TTupT (map exprType es) +exprType (VarT (Occ _ typ)) = typ + +instance Pretty TypeT where + prettyPrec _ TIntT = "Int" + prettyPrec p (TFunT a b) = + precParens p 2 (prettyPrec 3 a ++ " -> " ++ prettyPrec 2 b) + prettyPrec _ (TTupT ts) = + "(" ++ intercalate ", " (map pretty ts) ++ ")" + prettyPrec _ (TyVar i) = 't' : show i + +instance Pretty ExprT where + prettyPrec p (LamT ty (Occ n t) e) = + precParens p 2 $ + "(\\(" ++ n ++ " :: " ++ pretty t ++ ") -> " + ++ prettyPrec 2 e ++ ") :: " ++ pretty ty + prettyPrec p (CallT ty e1 e2) = + precParens p 2 $ + prettyPrec 3 e1 ++ " " ++ prettyPrec 3 e2 ++ " :: " ++ pretty ty + prettyPrec _ (IntT i) = show i + prettyPrec _ (TupT es) = "(" ++ intercalate ", " (map pretty es) ++ ")" + prettyPrec p (VarT (Occ n t)) = + precParens p 2 $ + show n ++ " :: " ++ pretty t + +instance Pretty DefT where + pretty (DefT n e) = n ++ " = " ++ pretty e + +instance Pretty ProgramT where + pretty (ProgramT defs) = concatMap ((++ "\n") . pretty) defs -- cgit v1.2.3-70-g09d2