From 39ea4ac3a4b7663882a83f2ada43c8238f087d9b Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Thu, 23 Jul 2020 20:15:15 +0200
Subject: Use Pretty for errors and expressions

---
 ast/CC/Source.hs | 18 +++---------------
 ast/CC/Typed.hs  | 29 +++++++++++++++++++++++++++++
 2 files changed, 32 insertions(+), 15 deletions(-)

(limited to 'ast/CC')

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
-- 
cgit v1.2.3-54-g00ecf