← Back to branch summary

~ubuntu-branches/ubuntu/edgy/bnfc/edgy

« back to all changes in this revision

Viewing changes to PrintBNF.hs

  • Committer: Bazaar Package Importer
  • Author(s): Antti-Juhani Kaijanaho
  • Date: 2005-04-10 13:53:34 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050410135334-sg1bq2mbqw41kbi8
Tags: 2.2-1
* New upstream release
  - incorporates our change
      Makefile (GHC_OPTS): Remove -Wall to avoid clutter at build time
* debian/copyright: Update.
* Makefile: clean should remove formats/{profile,xml}/*.{hi,o}

Show diffs side-by-side

added added

removed removed

Lines of Context:
PrintBNF.hs
1
 
{-
2
 
    BNF Converter: Pretty printer
3
 
    Copyright (C) 2004  Author:  BNF Converter
4
 
 
5
 
    This program is free software; you can redistribute it and/or modify
6
 
    it under the terms of the GNU General Public License as published by
7
 
    the Free Software Foundation; either version 2 of the License, or
8
 
    (at your option) any later version.
9
 
 
10
 
    This program is distributed in the hope that it will be useful,
11
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
12
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
 
    GNU General Public License for more details.
14
 
 
15
 
    You should have received a copy of the GNU General Public License
16
 
    along with this program; if not, write to the Free Software
17
 
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
18
 
-}
19
 
 
20
1
module PrintBNF where
21
2
 
22
3
-- pretty-printer generated by the BNF converter
28
9
printTree :: Print a => a -> String
29
10
printTree = render . prt 0
30
11
 
31
 
 
32
 
render :: [String] -> String
33
 
render = rend 0 where
 
12
type Doc = [ShowS] -> [ShowS]
 
13
 
 
14
doc :: ShowS -> Doc
 
15
doc = (:)
 
16
 
 
17
render :: Doc -> String
 
18
render d = rend 0 (map ($ "") $ d []) "" where
34
19
  rend i ss = case ss of
35
 
    "["      :ts -> cons "["  $ rend i ts
36
 
    "("      :ts -> cons "("  $ rend i ts
37
 
    "{"      :ts -> cons "{"  $ new (i+1) $ rend (i+1) ts
38
 
    "}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts
39
 
    "}"      :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts
40
 
    ";"      :ts -> cons ";"  $ new i $ rend i ts
41
 
    t  : "," :ts -> cons t    $ space "," $ rend i ts
42
 
    t  : ")" :ts -> cons t    $ cons ")"  $ rend i ts
43
 
    t  : "]" :ts -> cons t    $ cons "]"  $ rend i ts
44
 
    t        :ts -> space t   $ rend i ts
45
 
    _            -> ""
46
 
  cons s t  = s ++ t
47
 
  new i s   = '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
48
 
  space t s = if null s then t else t ++ " " ++ s
49
 
 
50
 
parenth :: [String] -> [String]
51
 
parenth ss = ["("] ++ ss ++ [")"]
 
20
    "["      :ts -> showChar '[' . rend i ts
 
21
    "("      :ts -> showChar '(' . rend i ts
 
22
    "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
 
23
    "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
 
24
    "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
 
25
    ";"      :ts -> showChar ';' . new i . rend i ts
 
26
    t  : "," :ts -> showString t . space "," . rend i ts
 
27
    t  : ")" :ts -> showString t . showChar ')' . rend i ts
 
28
    t  : "]" :ts -> showString t . showChar ']' . rend i ts
 
29
    t        :ts -> space t . rend i ts
 
30
    _            -> id
 
31
  new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
 
32
  space t = showString t . (\s -> if null s then "" else (' ':s))
 
33
 
 
34
parenth :: Doc -> Doc
 
35
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
 
36
 
 
37
concatS :: [ShowS] -> ShowS
 
38
concatS = foldr (.) id
 
39
 
 
40
concatD :: [Doc] -> Doc
 
41
concatD = foldr (.) id
 
42
 
 
43
replicateS :: Int -> ShowS -> ShowS
 
44
replicateS n f = concatS (replicate n f)
52
45
 
53
46
-- the printer class does the job
54
47
class Print a where
55
 
  prt :: Int -> a -> [String]
56
 
  prtList :: [a] -> [String]
57
 
  prtList = concat . map (prt 0)
 
48
  prt :: Int -> a -> Doc
 
49
  prtList :: [a] -> Doc
 
50
  prtList = concatD . map (prt 0)
58
51
 
59
52
instance Print a => Print [a] where
60
53
  prt _ = prtList
61
54
 
 
55
instance Print Char where
 
56
  prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
 
57
  prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
 
58
 
 
59
mkEsc :: Char -> Char -> ShowS
 
60
mkEsc q s = case s of
 
61
  _ | s == q -> showChar '\\' . showChar s
 
62
  '\\'-> showString "\\\\"
 
63
  '\n' -> showString "\\n"
 
64
  '\t' -> showString "\\t"
 
65
  _ -> showChar s
 
66
 
 
67
prPrec :: Int -> Int -> Doc -> Doc
 
68
prPrec i j = if j<i then parenth else id
 
69
 
 
70
 
62
71
instance Print Integer where
63
 
  prt _ = (:[]) . show
 
72
  prt _ x = doc (shows x)
 
73
  prtList es = case es of
 
74
   [] -> (concatD [])
 
75
   [x] -> (concatD [prt 0 x])
 
76
   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
 
77
 
64
78
 
65
79
instance Print Double where
66
 
  prt _ = (:[]) . show
67
 
 
68
 
instance Print Char where
69
 
  prt _ s = ["'" ++ mkEsc s ++ "'"]
70
 
  prtList s = ["\"" ++ concatMap mkEsc s ++ "\""]
71
 
 
72
 
mkEsc s = case s of
73
 
  _ | elem s "\\\"'" -> '\\':[s]
74
 
  '\n' -> "\\n"
75
 
  '\t' -> "\\t"
76
 
  _ -> [s]
77
 
 
78
 
prPrec :: Int -> Int -> [String] -> [String]
79
 
prPrec i j = if j<i then parenth else id
 
80
  prt _ x = doc (shows x)
80
81
 
81
82
 
82
83
instance Print Ident where
83
 
  prt _ (Ident i) = [i]
 
84
  prt _ (Ident i) = doc (showString i)
84
85
  prtList es = case es of
85
 
   [x] -> (concat [prt 0 x])
86
 
   x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
 
86
   [x] -> (concatD [prt 0 x])
 
87
   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
87
88
 
88
89
 
89
90
 
90
91
instance Print Grammar where
91
92
  prt i e = case e of
92
 
   Grammar defs -> prPrec i 0 (concat [prt 0 defs])
 
93
   Grammar defs -> prPrec i 0 (concatD [prt 0 defs])
93
94
 
94
95
 
95
96
instance Print Def where
96
97
  prt i e = case e of
97
 
   Rule label cat items -> prPrec i 0 (concat [prt 0 label , ["."] , prt 0 cat , ["::="] , prt 0 items])
98
 
   Comment str -> prPrec i 0 (concat [["comment"] , prt 0 str])
99
 
   Comments str0 str -> prPrec i 0 (concat [["comment"] , prt 0 str0 , prt 0 str])
100
 
   Internal label cat items -> prPrec i 0 (concat [["internal"] , prt 0 label , ["."] , prt 0 cat , ["::="] , prt 0 items])
101
 
   Token id reg -> prPrec i 0 (concat [["token"] , prt 0 id , prt 0 reg])
102
 
   Entryp ids -> prPrec i 0 (concat [["entrypoints"] , prt 0 ids])
103
 
   Separator minimumsize cat str -> prPrec i 0 (concat [["separator"] , prt 0 minimumsize , prt 0 cat , prt 0 str])
104
 
   Terminator minimumsize cat str -> prPrec i 0 (concat [["terminator"] , prt 0 minimumsize , prt 0 cat , prt 0 str])
105
 
   Coercions id n -> prPrec i 0 (concat [["coercions"] , prt 0 id , prt 0 n])
106
 
   Rules id rhss -> prPrec i 0 (concat [["rules"] , prt 0 id , ["::="] , prt 0 rhss])
107
 
   Layout strs -> prPrec i 0 (concat [["layout"] , prt 0 strs])
108
 
   LayoutStop strs -> prPrec i 0 (concat [["layout"] , ["stop"] , prt 0 strs])
109
 
   LayoutTop  -> prPrec i 0 (concat [["layout"] , ["toplevel"]])
 
98
   Rule label cat items -> prPrec i 0 (concatD [prt 0 label , doc (showString ".") , prt 0 cat , doc (showString "::=") , prt 0 items])
 
99
   Comment str -> prPrec i 0 (concatD [doc (showString "comment") , prt 0 str])
 
100
   Comments str0 str -> prPrec i 0 (concatD [doc (showString "comment") , prt 0 str0 , prt 0 str])
 
101
   Internal label cat items -> prPrec i 0 (concatD [doc (showString "internal") , prt 0 label , doc (showString ".") , prt 0 cat , doc (showString "::=") , prt 0 items])
 
102
   Token id reg -> prPrec i 0 (concatD [doc (showString "token") , prt 0 id , prt 0 reg])
 
103
   PosToken id reg -> prPrec i 0 (concatD [doc (showString "position") , doc (showString "token") , prt 0 id , prt 0 reg])
 
104
   Entryp ids -> prPrec i 0 (concatD [doc (showString "entrypoints") , prt 0 ids])
 
105
   Separator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "separator") , prt 0 minimumsize , prt 0 cat , prt 0 str])
 
106
   Terminator minimumsize cat str -> prPrec i 0 (concatD [doc (showString "terminator") , prt 0 minimumsize , prt 0 cat , prt 0 str])
 
107
   Coercions id n -> prPrec i 0 (concatD [doc (showString "coercions") , prt 0 id , prt 0 n])
 
108
   Rules id rhss -> prPrec i 0 (concatD [doc (showString "rules") , prt 0 id , doc (showString "::=") , prt 0 rhss])
 
109
   Layout strs -> prPrec i 0 (concatD [doc (showString "layout") , prt 0 strs])
 
110
   LayoutStop strs -> prPrec i 0 (concatD [doc (showString "layout") , doc (showString "stop") , prt 0 strs])
 
111
   LayoutTop  -> prPrec i 0 (concatD [doc (showString "layout") , doc (showString "toplevel")])
110
112
 
111
113
  prtList es = case es of
112
 
   [] -> (concat [])
113
 
   x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
 
114
   [] -> (concatD [])
 
115
   x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
114
116
 
115
117
instance Print Item where
116
118
  prt i e = case e of
117
 
   Terminal str -> prPrec i 0 (concat [prt 0 str])
118
 
   NTerminal cat -> prPrec i 0 (concat [prt 0 cat])
 
119
   Terminal str -> prPrec i 0 (concatD [prt 0 str])
 
120
   NTerminal cat -> prPrec i 0 (concatD [prt 0 cat])
119
121
 
120
122
  prtList es = case es of
121
 
   [] -> (concat [])
122
 
   x:xs -> (concat [prt 0 x , prt 0 xs])
 
123
   [] -> (concatD [])
 
124
   x:xs -> (concatD [prt 0 x , prt 0 xs])
123
125
 
124
126
instance Print Cat where
125
127
  prt i e = case e of
126
 
   ListCat cat -> prPrec i 0 (concat [["["] , prt 0 cat , ["]"]])
127
 
   IdCat id -> prPrec i 0 (concat [prt 0 id])
 
128
   ListCat cat -> prPrec i 0 (concatD [doc (showString "[") , prt 0 cat , doc (showString "]")])
 
129
   IdCat id -> prPrec i 0 (concatD [prt 0 id])
128
130
 
129
131
 
130
132
instance Print Label where
131
133
  prt i e = case e of
132
 
   Id id -> prPrec i 0 (concat [prt 0 id])
133
 
   Wild  -> prPrec i 0 (concat [["_"]])
134
 
   ListE  -> prPrec i 0 (concat [["["] , ["]"]])
135
 
   ListCons  -> prPrec i 0 (concat [["("] , [":"] , [")"]])
136
 
   ListOne  -> prPrec i 0 (concat [["("] , [":"] , ["["] , ["]"] , [")"]])
137
 
 
 
134
   LabNoP labelid -> prPrec i 0 (concatD [prt 0 labelid])
 
135
   LabP labelid profitems -> prPrec i 0 (concatD [prt 0 labelid , prt 0 profitems])
 
136
   LabPF labelid0 labelid profitems -> prPrec i 0 (concatD [prt 0 labelid0 , prt 0 labelid , prt 0 profitems])
 
137
   LabF labelid0 labelid -> prPrec i 0 (concatD [prt 0 labelid0 , prt 0 labelid])
 
138
 
 
139
 
 
140
instance Print LabelId where
 
141
  prt i e = case e of
 
142
   Id id -> prPrec i 0 (concatD [prt 0 id])
 
143
   Wild  -> prPrec i 0 (concatD [doc (showString "_")])
 
144
   ListE  -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "]")])
 
145
   ListCons  -> prPrec i 0 (concatD [doc (showString "(") , doc (showString ":") , doc (showString ")")])
 
146
   ListOne  -> prPrec i 0 (concatD [doc (showString "(") , doc (showString ":") , doc (showString "[") , doc (showString "]") , doc (showString ")")])
 
147
 
 
148
 
 
149
instance Print ProfItem where
 
150
  prt i e = case e of
 
151
   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 ")")])
 
152
 
 
153
  prtList es = case es of
 
154
   [x] -> (concatD [prt 0 x])
 
155
   x:xs -> (concatD [prt 0 x , prt 0 xs])
 
156
 
 
157
instance Print IntList where
 
158
  prt i e = case e of
 
159
   Ints ns -> prPrec i 0 (concatD [doc (showString "[") , prt 0 ns , doc (showString "]")])
 
160
 
 
161
  prtList es = case es of
 
162
   [] -> (concatD [])
 
163
   [x] -> (concatD [prt 0 x])
 
164
   x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
138
165
 
139
166
instance Print RHS where
140
167
  prt i e = case e of
141
 
   RHS items -> prPrec i 0 (concat [prt 0 items])
 
168
   RHS items -> prPrec i 0 (concatD [prt 0 items])
142
169
 
143
170
  prtList es = case es of
144
 
   [x] -> (concat [prt 0 x])
145
 
   x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
 
171
   [x] -> (concatD [prt 0 x])
 
172
   x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
146
173
 
147
174
instance Print MinimumSize where
148
175
  prt i e = case e of
149
 
   MNonempty  -> prPrec i 0 (concat [["nonempty"]])
150
 
   MEmpty  -> prPrec i 0 (concat [])
 
176
   MNonempty  -> prPrec i 0 (concatD [doc (showString "nonempty")])
 
177
   MEmpty  -> prPrec i 0 (concatD [])
151
178
 
152
179
 
153
180
instance Print Reg where
154
181
  prt i e = case e of
155
 
   RSeq reg0 reg -> prPrec i 2 (concat [prt 2 reg0 , prt 3 reg])
156
 
   RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg])
157
 
   RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["-"] , prt 2 reg])
158
 
   RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]])
159
 
   RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]])
160
 
   ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]])
161
 
   REps  -> prPrec i 3 (concat [["eps"]])
162
 
   RChar c -> prPrec i 3 (concat [prt 0 c])
163
 
   RAlts str -> prPrec i 3 (concat [["["] , prt 0 str , ["]"]])
164
 
   RSeqs str -> prPrec i 3 (concat [["{"] , prt 0 str , ["}"]])
165
 
   RDigit  -> prPrec i 3 (concat [["digit"]])
166
 
   RLetter  -> prPrec i 3 (concat [["letter"]])
167
 
   RUpper  -> prPrec i 3 (concat [["upper"]])
168
 
   RLower  -> prPrec i 3 (concat [["lower"]])
169
 
   RAny  -> prPrec i 3 (concat [["char"]])
 
182
   RSeq reg0 reg -> prPrec i 2 (concatD [prt 2 reg0 , prt 3 reg])
 
183
   RAlt reg0 reg -> prPrec i 1 (concatD [prt 1 reg0 , doc (showString "|") , prt 2 reg])
 
184
   RMinus reg0 reg -> prPrec i 1 (concatD [prt 2 reg0 , doc (showString "-") , prt 2 reg])
 
185
   RStar reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "*")])
 
186
   RPlus reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "+")])
 
187
   ROpt reg -> prPrec i 3 (concatD [prt 3 reg , doc (showString "?")])
 
188
   REps  -> prPrec i 3 (concatD [doc (showString "eps")])
 
189
   RChar c -> prPrec i 3 (concatD [prt 0 c])
 
190
   RAlts str -> prPrec i 3 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
 
191
   RSeqs str -> prPrec i 3 (concatD [doc (showString "{") , prt 0 str , doc (showString "}")])
 
192
   RDigit  -> prPrec i 3 (concatD [doc (showString "digit")])
 
193
   RLetter  -> prPrec i 3 (concatD [doc (showString "letter")])
 
194
   RUpper  -> prPrec i 3 (concatD [doc (showString "upper")])
 
195
   RLower  -> prPrec i 3 (concatD [doc (showString "lower")])
 
196
   RAny  -> prPrec i 3 (concatD [doc (showString "char")])
170
197
 
171
198
 
172
199