aboutsummaryrefslogtreecommitdiff
path: root/ast/CC
diff options
context:
space:
mode:
authorTom Smeding <tom.smeding@gmail.com>2020-07-23 20:15:15 +0200
committerTom Smeding <tom.smeding@gmail.com>2020-07-23 20:15:15 +0200
commit39ea4ac3a4b7663882a83f2ada43c8238f087d9b (patch)
tree70b28d7f0bd301f8eb912837b126956ecdaa1ca3 /ast/CC
parentbc52411ae2ed26cab1d5086ae6df68f23ebbd052 (diff)
Use Pretty for errors and expressions
Diffstat (limited to 'ast/CC')
-rw-r--r--ast/CC/Source.hs18
-rw-r--r--ast/CC/Typed.hs29
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