@@ -39,10 +39,10 @@ data Expr = IntNum Int
3939 | Var String
4040 | Case Expr [(Pattern,Expr)]
4141 | Data String [Expr]
42− deriving (Show, Eq)
42+ deriving (Eq)
4343
4444data Definition = Definition String [String] Expr
45− deriving (Show, Eq)
45+ deriving (Eq)
4646
4747cons h t = Data "Cons" [h,t]
4848nil = Data "Nil" []
@@ -70,4 +70,51 @@ instance Show Pattern where
7070 if take 5 name == "Tuple" && all isDigit (drop 5 name) then
7171 parens . intercalate ", " $ map show ps
7272 else (if null ps then id else parens) $ unwords (name : map show ps)
73− where parens s = "(" ++ s ++ ")"
73+ where parens s = "(" ++ s ++ ")"
74+
75+instance Show Expr where
76+ show (IntNum n) = show n
77+ show (FloatNum n) = show n
78+ show (Chr c) = show c
79+ show (Str s) = show s
80+ show (Boolean b) = show b
81+ show (Range e1 e2) = "[" ++ show e1 ++ ".." ++ show e2 ++ "]"
82+ show (Access e x) = show' e ++ "." ++ x
83+ show (Binop op e1 e2) = show' e1 ++ " " ++ op ++ " " ++ show' e2
84+ show (Lambda x e) = let (xs,e') = getLambdas (Lambda x e) in
85+ concat [ "\\", intercalate " " xs, " -> ", show e' ]
86+ show (App e1 e2) = show' e1 ++ " " ++ show' e2
87+ show (If e1 e2 e3) = concat [ "if ", show e1, " then ", show e2, " else ", show e3 ]
88+ show (Let defs e) = "let { " ++ intercalate " ; " (map show defs) ++ " } in " ++ show e
89+ show (Var x) = x
90+ show (Case e pats) = "case " ++ show e ++ " of { " ++ intercalate " ; " (map (\(p,e) -> show p ++ " -> " ++ show e) pats) ++ " }"
91+ show (Data name es)
92+ | name == "Cons" = ("["++) . (++"]") . intercalate "," . map show $ delist (Data "Cons" es)
93+ | name == "Nil" = "[]"
94+ | otherwise = name ++ " " ++ intercalate " " (map show' es)
95+ show (Lift f es) = concat [ "lift", show $ length es, " ", show' f, " ", intercalate " " (map show' es) ]
96+ show (Fold e1 e2 e3) = concat [ "foldp ", show' e1, " ", show' e2, " ", show' e3 ]
97+ show (Async e) = "async " ++ show' e
98+ show (Input i) = i
99+
100+instance Show Definition where
101+ show (Definition v [] e) = v ++ " = " ++ show e
102+ show (Definition f args e) = f ++ " " ++ intercalate " " args ++ " = " ++ show e
103+
104+getLambdas (Lambda x e) = (x:xs,e')
105+ where (xs,e') = getLambdas e
106+getLambdas e = ([],e)
107+
108+show' e = if needsParens e then "(" ++ show e ++ ")" else show e
109+
110+needsParens (Binop _ _ _) = True
111+needsParens (Lambda _ _) = True
112+needsParens (App _ _) = True
113+needsParens (If _ _ _) = True
114+needsParens (Let _ _) = True
115+needsParens (Case _ _) = True
116+needsParens (Data name (x:xs)) = name /= "Cons"
117+needsParens (Lift _ _) = True
118+needsParens (Fold _ _ _) = True
119+needsParens (Async _) = True
120+needsParens _ = False