1
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
4
-- pretty-printer generated by the BNF converter
10
-- the top-level printing method
11
printTree :: Print a => a -> String
12
printTree = render . prt 0
14
type Doc = [ShowS] -> [ShowS]
19
render :: Doc -> String
20
render d = rend 0 (map ($ "") $ d []) "" where
21
rend i ss = case ss of
22
"[" :ts -> showChar '[' . rend i ts
23
"(" :ts -> showChar '(' . rend i ts
24
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
25
"}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
26
"}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
27
";" :ts -> showChar ';' . new i . rend i ts
28
t : "," :ts -> showString t . space "," . rend i ts
29
t : ")" :ts -> showString t . showChar ')' . rend i ts
30
t : "]" :ts -> showString t . showChar ']' . rend i ts
31
t :ts -> space t . rend i ts
33
new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
34
space t = showString t . (\s -> if null s then "" else (' ':s))
37
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
39
concatS :: [ShowS] -> ShowS
40
concatS = foldr (.) id
42
concatD :: [Doc] -> Doc
43
concatD = foldr (.) id
45
replicateS :: Int -> ShowS -> ShowS
46
replicateS n f = concatS (replicate n f)
48
-- the printer class does the job
50
prt :: Int -> a -> Doc
52
prtList = concatD . map (prt 0)
54
instance Print a => Print [a] where
57
instance Print Char where
58
prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
59
prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
61
mkEsc :: Char -> Char -> ShowS
63
_ | s == q -> showChar '\\' . showChar s
64
'\\'-> showString "\\\\"
65
'\n' -> showString "\\n"
66
'\t' -> showString "\\t"
69
prPrec :: Int -> Int -> Doc -> Doc
70
prPrec i j = if j<i then parenth else id
73
instance Print Integer where
74
prt _ x = doc (shows x)
75
prtList es = case es of
77
[x] -> (concatD [prt 0 x])
78
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
81
instance Print Double where
82
prt _ x = doc (shows x)
85
instance Print Ident where
86
prt _ (Ident i) = doc (showString ( i))
87
prtList es = case es of
88
[x] -> (concatD [prt 0 x])
89
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
93
instance Print LGrammar where
95
LGr ldefs -> prPrec i 0 (concatD [prt 0 ldefs])
98
instance Print LDef where
100
DefAll def -> prPrec i 0 (concatD [prt 0 def])
101
DefSome ids def -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 def])
102
LDefView ids -> prPrec i 0 (concatD [doc (showString "views") , prt 0 ids])
104
prtList es = case es of
106
[x] -> (concatD [prt 0 x])
107
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
109
instance Print Grammar where
111
Grammar defs -> prPrec i 0 (concatD [prt 0 defs])
114
instance Print Def where
116
Rule label cat items -> prPrec i 0 (concatD [prt 0 label , doc (showString ".") , prt 0 cat , doc (showString "::=") , prt 0 items])
117
Comment str -> prPrec i 0 (concatD [doc (showString "comment") , prt 0 str])
118
Comments str0 str -> prPrec i 0 (concatD [doc (showString "comment") , prt 0 str0 , prt 0 str])
119
Internal label cat items -> prPrec i 0 (concatD [doc (showString "internal") , prt 0 label , doc (showString ".") , prt 0 cat , doc (showString "::=") , prt 0 items])
120
Token id reg -> prPrec i 0 (concatD [doc (showString "token") , prt 0 id , prt 0 reg])
121
PosToken id reg -> prPrec i 0 (concatD [doc (showString "position") , doc (showString "token") , prt 0 id , prt 0 reg])
122
Entryp ids -> prPrec i 0 (concatD [doc (showString "entrypoints") , prt 0 ids])
123
Separator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "separator") , prt 0 minimumsize , prt 0 cat , prt 0 str])
124
Terminator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "terminator") , prt 0 minimumsize , prt 0 cat , prt 0 str])
125
Delimiters cat str0 str separation minimumsize -> prPrec i 0 (concatD [doc (showString "delimiters") , prt 0 cat , prt 0 str0 , prt 0 str , prt 0 separation , prt 0 minimumsize])
126
Coercions id n -> prPrec i 0 (concatD [doc (showString "coercions") , prt 0 id , prt 0 n])
127
Rules id rhss -> prPrec i 0 (concatD [doc (showString "rules") , prt 0 id , doc (showString "::=") , prt 0 rhss])
128
Function id args exp -> prPrec i 0 (concatD [doc (showString "define") , prt 0 id , prt 0 args , doc (showString "=") , prt 0 exp])
129
Layout strs -> prPrec i 0 (concatD [doc (showString "layout") , prt 0 strs])
130
LayoutStop strs -> prPrec i 0 (concatD [doc (showString "layout") , doc (showString "stop") , prt 0 strs])
131
LayoutTop -> prPrec i 0 (concatD [doc (showString "layout") , doc (showString "toplevel")])
133
prtList es = case es of
135
[x] -> (concatD [prt 0 x])
136
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
138
instance Print Item where
140
Terminal str -> prPrec i 0 (concatD [prt 0 str])
141
NTerminal cat -> prPrec i 0 (concatD [prt 0 cat])
143
prtList es = case es of
145
x:xs -> (concatD [prt 0 x , prt 0 xs])
147
instance Print Cat where
149
ListCat cat -> prPrec i 0 (concatD [doc (showString "[") , prt 0 cat , doc (showString "]")])
150
IdCat id -> prPrec i 0 (concatD [prt 0 id])
153
instance Print Label where
155
LabNoP labelid -> prPrec i 0 (concatD [prt 0 labelid])
156
LabP labelid profitems -> prPrec i 0 (concatD [prt 0 labelid , prt 0 profitems])
157
LabPF labelid0 labelid profitems -> prPrec i 0 (concatD [prt 0 labelid0 , prt 0 labelid , prt 0 profitems])
158
LabF labelid0 labelid -> prPrec i 0 (concatD [prt 0 labelid0 , prt 0 labelid])
161
instance Print LabelId where
163
Id id -> prPrec i 0 (concatD [prt 0 id])
164
Wild -> prPrec i 0 (concatD [doc (showString "_")])
165
ListE -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "]")])
166
ListCons -> prPrec i 0 (concatD [doc (showString "(") , doc (showString ":") , doc (showString ")")])
167
ListOne -> prPrec i 0 (concatD [doc (showString "(") , doc (showString ":") , doc (showString "[") , doc (showString "]") , doc (showString ")")])
170
instance Print ProfItem where
172
ProfIt intlists ns -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "[") , prt 0 intlists , doc (showString "]") , doc (showString ",") , doc (showString "[") , prt 0 ns , doc (showString "]") , doc (showString ")")])
174
prtList es = case es of
175
[x] -> (concatD [prt 0 x])
176
x:xs -> (concatD [prt 0 x , prt 0 xs])
178
instance Print IntList where
180
Ints ns -> prPrec i 0 (concatD [doc (showString "[") , prt 0 ns , doc (showString "]")])
182
prtList es = case es of
184
[x] -> (concatD [prt 0 x])
185
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
187
instance Print Separation where
189
SepNone -> prPrec i 0 (concatD [])
190
SepTerm str -> prPrec i 0 (concatD [doc (showString "terminator") , prt 0 str])
191
SepSepar str -> prPrec i 0 (concatD [doc (showString "separator") , prt 0 str])
194
instance Print Arg where
196
Arg id -> prPrec i 0 (concatD [prt 0 id])
198
prtList es = case es of
200
x:xs -> (concatD [prt 0 x , prt 0 xs])
202
instance Print Exp where
204
Cons exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString ":") , prt 0 exp])
205
App id exps -> prPrec i 1 (concatD [prt 0 id , prt 2 exps])
206
Var id -> prPrec i 2 (concatD [prt 0 id])
207
LitInt n -> prPrec i 2 (concatD [prt 0 n])
208
LitChar c -> prPrec i 2 (concatD [prt 0 c])
209
LitString str -> prPrec i 2 (concatD [prt 0 str])
210
LitDouble d -> prPrec i 2 (concatD [prt 0 d])
211
List exps -> prPrec i 2 (concatD [doc (showString "[") , prt 0 exps , doc (showString "]")])
213
prtList es = case es of
215
[x] -> (concatD [prt 2 x])
216
[x] -> (concatD [prt 0 x])
217
x:xs -> (concatD [prt 2 x , prt 2 xs])
218
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
220
instance Print RHS where
222
RHS items -> prPrec i 0 (concatD [prt 0 items])
224
prtList es = case es of
225
[x] -> (concatD [prt 0 x])
226
x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
228
instance Print MinimumSize where
230
MNonempty -> prPrec i 0 (concatD [doc (showString "nonempty")])
231
MEmpty -> prPrec i 0 (concatD [])
234
instance Print Reg where
236
RSeq reg0 reg -> prPrec i 2 (concatD [prt 2 reg0 , prt 3 reg])
237
RAlt reg0 reg -> prPrec i 1 (concatD [prt 1 reg0 , doc (showString "|") , prt 2 reg])
238
RMinus reg0 reg -> prPrec i 1 (concatD [prt 2 reg0 , doc (showString "-") , prt 2 reg])
239
RStar reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "*")])
240
RPlus reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "+")])
241
ROpt reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "?")])
242
REps -> prPrec i 3 (concatD [doc (showString "eps")])
243
RChar c -> prPrec i 3 (concatD [prt 0 c])
244
RAlts str -> prPrec i 3 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
245
RSeqs str -> prPrec i 3 (concatD [doc (showString "{") , prt 0 str , doc (showString "}")])
246
RDigit -> prPrec i 3 (concatD [doc (showString "digit")])
247
RLetter -> prPrec i 3 (concatD [doc (showString "letter")])
248
RUpper -> prPrec i 3 (concatD [doc (showString "upper")])
249
RLower -> prPrec i 3 (concatD [doc (showString "lower")])
250
RAny -> prPrec i 3 (concatD [doc (showString "char")])