diff options
Diffstat (limited to 'ast/CC')
| -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  | 
