diff options
Diffstat (limited to 'ast')
-rw-r--r-- | ast/CC/Source.hs | 18 | ||||
-rw-r--r-- | ast/CC/Typed.hs | 29 |
2 files changed, 32 insertions, 15 deletions
diff --git a/ast/CC/Source.hs b/ast/CC/Source.hs index 80d8f01..81e691b 100644 --- a/ast/CC/Source.hs +++ b/ast/CC/Source.hs @@ -26,21 +26,9 @@ data Expr = Call SourceRange Expr Expr deriving (Show, Read) instance Pretty Type where - pretty = unparse - -class Unparse a where - -- Parentheses are required if precedence of unparsed element is - -- greater than the argument. - unparsePrec :: Int -> a -> String - - unparse :: a -> String - unparse = unparsePrec 0 - -instance Unparse Type where - unparsePrec _ TInt = "Int" - unparsePrec p (TFun a b) = - let s = unparsePrec 3 a ++ " -> " ++ unparsePrec 2 b - in if p > 2 then "(" ++ s ++ ")" else s + prettyPrec _ TInt = "Int" + prettyPrec p (TFun a b) = + precParens p 2 (prettyPrec 3 a ++ " -> " ++ prettyPrec 2 b) instance HasRange Expr where range (Call sr _ _) = sr diff --git a/ast/CC/Typed.hs b/ast/CC/Typed.hs index b11067f..5b8ed38 100644 --- a/ast/CC/Typed.hs +++ b/ast/CC/Typed.hs @@ -3,6 +3,7 @@ module CC.Typed( module CC.Types ) where +import CC.Pretty import CC.Types @@ -33,3 +34,31 @@ exprType :: ExprT -> TypeT exprType (CallT typ _ _) = typ exprType (IntT _) = TIntT 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 _ (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 p (VarT (Occ n t)) = + precParens p 2 $ + show n ++ " :: " ++ pretty t + +instance Pretty DefT where + pretty (FunctionT n e) = n ++ " = " ++ pretty e + +instance Pretty DeclT where + pretty (DefT def) = pretty def + +instance Pretty ProgramT where + pretty (ProgramT decls) = concatMap ((++ "\n") . pretty) decls |