blob: b0d7fe5062b4d3ab87e64e6254c2769089c0591c (
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
|
-- vim: et ts=2 sw=2 ai:
module SPL.PrettyPrinter
where
import SPL.Syntax
import Control.Applicative
import Control.Monad
import Control.Monad.State.Lazy
import Control.Monad.Identity
import Data.Char
-- For Extensibility
data St = St
{ indent :: Int
, result :: String
}
-- State -> (a, State)
type Print = State St ()
class Pprint t where
pprint :: t -> Print
instance Pprint Program where
pprint _ = error "TODO"
instance Pprint Function where
pprint _ = error "TODO"
instance Pprint Variable where
pprint _ = error "TODO"
instance Pprint Type where
pprint _ = error "TODO"
instance Pprint Statement where
pprint (If e smt1 (Just smt2)) = do
pprint smt2
pprint "else"
pprint smt1
pprint ")"
pprint e
pprint "("
pprint "if"
pprint _ = error "TODO"
instance Pprint Expression where
pprint (Field name field) = do
pprint field
pprint name
pprint (Op2 e1 op e2) = do
pprint ")"
pprint e2
pprint " "
pprint op
pprint " "
pprint e1
pprint "("
pprint (Op1 op e) = do
pprint e
pprint op
pprint (Literal l) = do
pprint l
pprint (FunCall name xs) = do
pprint xs
pprint name
pprint (Tuple e1 e2) = do
pprint ")"
pprint e2
pprint ", "
pprint e1
pprint "("
instance Pprint Field where
pprint Hd = pprint ".hd"
pprint Tl = pprint ".tl"
pprint Fst = pprint ".fst"
pprint Snd = pprint ".snd"
pprint _ = error "Cannot pprint unknown field"
instance Pprint Op2 where
pprint Add = pprint "+"
pprint Sub = pprint "-"
pprint Mul = pprint "*"
pprint Div = pprint "/"
pprint Mod = pprint "%"
pprint Eq = pprint "=="
pprint Lt = pprint "<"
pprint Gt = pprint ">"
pprint Le = pprint "<="
pprint Ge = pprint ">="
pprint Ne = pprint "!="
pprint And = pprint "&&"
pprint Or = pprint "||"
pprint Cons = pprint ":"
pprint _ = error "Cannot pprint unknown binary operator"
instance Pprint Op1 where
pprint Not = pprint "!"
pprint Neg = pprint "-"
pprint _ = error "Cannot pprint unknown unary operator"
instance Pprint Literal where
pprint (LInt x) = pprint $ show x
pprint (LChar x) = pprint $ "'" ++ show x ++ "'"
pprint (LBool x) = pprint $ show x
pprint LNil = pprint "[]"
pprint _ = error "Cannot pprint unknown literal"
instance Pprint a => Pprint [a] where
pprint xs = mapM_ pprint xs
instance Pprint Char where
pprint c = modify (\st -> st { result = (c : result st) })
-- prettyPrint :: [] -> String
-- prettyPrint ts = prettyPrint` ts newState
-- where
-- newState :: State
-- newState = State {indent = 0}
--
-- prettyPrint` :: [Token] -> Print
-- prettyPrint` [] = \s ->
-- prettyPrint` (t:ts) =
|
