blob: 35b8522bc4a5cb20a6a3da6e8ac3fd6803e36518 (
plain) (
blame)
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
implementation module Sil.Util
import _SystemArray
import StdEnum
from StdFunc import id
import StdInt
import StdList
import StdOverloaded
import StdString
from Data.Func import $
import Data.List
import Data.Maybe
import Text
import Sil.Parse
import Sil.Syntax
:: PrintState =
{ indent :: Int
}
instance zero PrintState where zero = {indent=0}
incIndent :: PrintState -> PrintState
incIndent ps = {ps & indent=inc ps.indent}
decIndent :: PrintState -> PrintState
decIndent ps = {ps & indent=dec ps.indent}
instance toString PrintState where toString st = {'\t' \\ _ <- [1..st.indent]}
instance PrettyPrinter [Token]
where
print st [] = ""
print st [t] = toString t
print st [t:ts=:[t`:_]] = toString t +++ spaceBetween t t` +++ print st` ts
where
st` = {st & indent=indent`}
indent` = newIndent t t` st.indent
spaceBetween :: Token Token -> String
spaceBetween _ TBraceClose = newline
spaceBetween TParenOpen _ = ""
spaceBetween TParenClose TBraceOpen = space
spaceBetween TParenClose _ = ""
spaceBetween TBraceOpen _ = newline
spaceBetween TBraceClose _ = newline
spaceBetween TComma _ = space
spaceBetween TSemicolon _ = newline
spaceBetween TAssign _ = space
spaceBetween (TLit _) _ = space
spaceBetween TIf _ = space
spaceBetween TWhile _ = space
spaceBetween TReturn _ = space
spaceBetween (TName _) TParenClose = ""
spaceBetween (TName _) TSemicolon = ""
spaceBetween (TName _) _ = space
newline = "\r\n" +++ {'\t' \\ _ <- [1..indent`]}
space = " "
newIndent :: Token Token -> Int -> Int
newIndent TBraceOpen _ = inc
newIndent _ TBraceClose = dec
newIndent _ _ = id
instance PrettyPrinter Program
where
print st prog = p st prog.p_funs
where
p :: PrintState [Function] -> String
p _ [] = ""
p st [f] = print st f
p st [f:fs] = print st f <+ "\r\n\r\n" <+ p st fs
instance PrettyPrinter Function
where
print st f = st <+ f.f_type <+ " " <+ f.f_name
<+ "(" <+ printersperse ", " f.f_args <+ ") {\r\n"
<+ print {st & indent=st.indent+1} f.f_code <+ "\r\n" <+ st <+ "}"
instance PrettyPrinter CodeBlock
where
print st cb = concat $ intersperse "\r\n" $
[print st x \\ x <- cb.cb_init] ++ [print st x \\ x <- cb.cb_content]
instance PrettyPrinter Initialisation
where
print st init = st <+ init.init_type <+ " " <+ init.init_name <+ ";"
instance PrettyPrinter Statement
where
print st (If c t Nothing) = st <+ "if (" <+ c <+ ") {\r\n" <+
print (incIndent st) t <+ "\r\n" <+ st <+ "}"
print st (If c t (Just e)) = st <+ "if (" <+ c <+ ") {\r\n" <+
print st` t <+ "\r\n" <+ st <+ "} else {\r\n" <+
print st` e <+ "\r\n" <+ st <+ "}"
where st` = incIndent st
print st stm = st <+ stm
instance toString Statement
where
toString (Declaration n a) = n <+ " " <+ TAssign <+ " " <+ a <+ ";"
toString (Application app) = toString app <+ ";"
toString (Return Nothing) = "return;"
toString (Return (Just a)) = "return " <+ a <+ ";"
toString (If c t e) = "if (" <+ c <+ ") ..."
toString (MachineStm s) = "|~" <+ s
toString _ = "<<unimplemented Statement>>"
instance toString Type
where
toString TBool = "Bool"
toString TInt = "Int"
toString TVoid = "Void"
instance toString Arg where toString arg = arg.arg_type <+ " " <+ arg.arg_name
instance toString Application
where
toString (Name n) = n
toString (Literal lit) = toString lit
toString (App n args) = n <+ "(" <+ printersperse ", " args <+ ")"
toString (BuiltinApp op e) = op <+ "(" <+ e <+ ")"
toString (BuiltinApp2 e1 op e2) = "(" <+ e1 <+ ") " <+ op <+ " (" <+ e2 <+ ")"
instance toString Op1
where
toString Neg = "~"
instance toString Op2
where
toString Add = "+"
toString Sub = "-"
toString Mul = "*"
toString Div = "/"
toString Rem = "%"
toString Equals = "=="
toString LogOr = "||"
toString LogAnd = "&&"
instance toString Literal
where
toString (BLit b) = toString b
toString (ILit i) = toString i
printersperse :: a [b] -> String | toString a & toString b
printersperse _ [] = ""
printersperse _ [x] = toString x
printersperse g [x:xs] = x <+ g <+ printersperse g xs
|
