blob: a809d6ebd69b82580c314f74f3b9eb4d06a85923 (
plain)
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
module AST where
import Data.List
import qualified GCStore as GCS (Id)
type Name = String
data Program = Program Block
deriving (Show)
data Block = Block [Statement]
deriving (Show)
data Statement
= Declaration Name Expression
| Assignment Name Expression
| Condition Expression Block Block
| Dive Name [Expression] Block
| Expr Expression
deriving (Show)
data Expression
= EBin BinaryOp Expression Expression
| EUn UnaryOp Expression
| ELit Literal
deriving (Show)
data Literal
= LNum Double
| LStr String
| LVar Name
| LBlock BlockType ArgList Block
| LGCSId GCS.Id
| LNil
deriving (Show)
type ArgList = [Name]
data BlockType = BT0 | BT1 | BT2 -- the number of ?'s
deriving (Show, Enum, Eq)
data BinaryOp
= BOPlus | BOMinus | BOMul | BODiv | BOMod | BOPow
| BOLess | BOGreater | BOEqual | BOLEq | BOGEq
| BOBoolAnd | BOBoolOr
deriving (Show, Eq)
data UnaryOp
= UONeg | UONot
deriving (Show, Eq)
class ASTPretty a where
astPrettyI :: Int -> a -> String
astPretty :: a -> String
astPretty = astPrettyI 0
indent :: Int -> String
indent n = replicate (4*n) ' '
instance ASTPretty Program where
astPrettyI i (Program (Block sts)) =
let pr = map (astPrettyI i) sts
in intercalate "\n" $ map (uncurry (++)) $ zip ("" : cycle [indent i]) pr
instance ASTPretty Block where
astPrettyI _ (Block []) = "{}"
astPrettyI i (Block sts) =
let lns = map (('\n' : indent (i+1)) ++) $ map (astPrettyI (i+1)) sts
in "{" ++ concat lns ++ "\n" ++ indent i ++ "}"
instance ASTPretty Statement where
astPrettyI i (Declaration n e) = n ++ " := " ++ astPrettyI i e ++ ";"
astPrettyI i (Assignment n e) = n ++ " = " ++ astPrettyI i e ++ ";"
astPrettyI i (Condition c b1 b2) =
"if " ++ astPrettyI i c ++ " " ++ astPrettyI i b1 ++ " else " ++ astPrettyI i b2
astPrettyI i (Dive n [] b) = n ++ " " ++ astPrettyI i b
astPrettyI i (Dive n al b) =
n ++ "(" ++ intercalate ", " (map (astPrettyI i) al) ++ ") " ++ astPrettyI i b
astPrettyI i (Expr e) = astPrettyI i e ++ ";"
instance ASTPretty Expression where
astPrettyI i (EBin bo e1 e2) =
"(" ++ astPrettyI i e1 ++ ") " ++ astPrettyI i bo ++ " (" ++ astPrettyI i e2 ++ ")"
astPrettyI i (EUn uo e) =
astPrettyI i uo ++ "(" ++ astPrettyI i e ++ ")"
astPrettyI i (ELit l) = astPrettyI i l
instance ASTPretty Literal where
astPrettyI _ (LNum m) = show m
astPrettyI _ (LStr s) = show s
astPrettyI _ (LVar n) = n
astPrettyI i (LBlock bt [] b) = replicate (fromEnum bt) '?' ++ astPrettyI i b
astPrettyI i (LBlock bt al b) =
replicate (fromEnum bt) '?' ++ "(" ++ intercalate ", " al ++ ")" ++ astPrettyI i b
astPrettyI _ (LGCSId d) = "<[" ++ show d ++ "]>"
astPrettyI _ LNil = "nil"
instance ASTPretty BinaryOp where
astPrettyI _ bo = case bo of
BOPlus -> "+"
BOMinus -> "-"
BOMul -> "*"
BODiv -> "/"
BOMod -> "%"
BOPow -> "**"
BOLess -> "<"
BOGreater -> ">"
BOEqual -> "=="
BOLEq -> "<="
BOGEq -> ">="
BOBoolAnd -> "&&"
BOBoolOr -> "||"
instance ASTPretty UnaryOp where
astPrettyI _ uo = case uo of
UONeg -> "-"
UONot -> "!"
|
