1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
module Haskell.AST where
import Data.List
type Name = String
type TyVar = String
data AST = AST [Toplevel]
deriving (Show, Eq)
data Toplevel = TopDef Def
| TopDecl Decl
| TopData Data
| TopClass Class
| TopInst Inst
deriving (Show, Eq)
data Def = Def Name Expr
deriving (Show, Eq)
data Expr = App Expr [Expr]
| Ref Name
| Num Integer
| Tup [Expr]
| Lam [Name] Expr
| Case Expr [(Pat, Expr)]
deriving (Show, Eq)
data Pat = PatAny
| PatVar Name
| PatCon Name [Pat]
| PatTup [Pat]
deriving (Show, Eq)
data Decl = Decl Name Type
deriving (Show, Eq)
data Type = TyTup [Type]
| TyInt
| TyFun Type Type
| TyRef Name [Type]
| TyVar Name
| TyVoid
deriving (Show, Eq)
data Data = Data Name [TyVar] [(Name, [Type])]
deriving (Show, Eq)
data Class = Class Name [TyVar] [Decl]
deriving (Show, Eq)
data Inst = Inst Name Type [Def]
deriving (Show, Eq)
class Pretty a where
pretty :: a -> String
instance Pretty AST where
pretty (AST tops) = intercalate "\n" (map pretty tops)
instance Pretty Toplevel where
pretty (TopDef x) = pretty x
pretty (TopDecl x) = pretty x
pretty (TopData x) = pretty x
pretty (TopClass x) = pretty x
pretty (TopInst x) = pretty x
instance Pretty Def where
pretty (Def n e) = n ++ " = " ++ pretty e
instance Pretty Expr where
pretty (App e as) = "(" ++ intercalate " " (map pretty (e:as)) ++ ")"
pretty (Ref n) = n
pretty (Num n) = show n
pretty (Tup es) = "(" ++ intercalate ", " (map pretty es) ++ ")"
pretty (Lam as e) = "(\\" ++ intercalate " " as ++ " -> " ++ pretty e ++ ")"
pretty (Case e arms) = "(case " ++ pretty e ++ " of { " ++ intercalate ";" (map go arms) ++ " })"
where go (p, e') = pretty p ++ " -> " ++ pretty e'
instance Pretty Pat where
pretty PatAny = "_"
pretty (PatVar n) = n
pretty (PatCon n ps) = "(" ++ n ++ " " ++ intercalate " " (map pretty ps) ++ ")"
pretty (PatTup ps) = "(" ++ intercalate ", " (map pretty ps) ++ ")"
instance Pretty Decl where
pretty (Decl n t) = n ++ " :: " ++ pretty t
instance Pretty Type where
pretty (TyTup ts) = "(" ++ intercalate ", " (map pretty ts) ++ ")"
pretty TyInt = "Int"
pretty (TyFun t u) = "(" ++ pretty t ++ " -> " ++ pretty u ++ ")"
pretty (TyRef n as) = "(" ++ n ++ " " ++ intercalate " " (map pretty as) ++ ")"
pretty (TyVar n) = n
pretty TyVoid = "#Void"
instance Pretty Data where
pretty (Data n as cs) = "data " ++ n ++ " " ++ intercalate " " as ++ " = " ++ intercalate " | " (map go cs)
where go (m, ts) = m ++ " " ++ intercalate " " (map pretty ts)
instance Pretty Class where
pretty (Class n as ds) = "class " ++ n ++ " " ++ intercalate " " as ++ " where { " ++ intercalate " ; " (map pretty ds) ++ "}"
instance Pretty Inst where
pretty (Inst n t ds) = "instance " ++ n ++ " " ++ pretty t ++ " where { " ++ intercalate " ; " (map pretty ds) ++ " }"
|
