← Back to branch summary

~ubuntu-branches/ubuntu/trusty/happy/trusty-proposed

« back to all changes in this revision

Viewing changes to src/Info.lhs

  • Committer: Package Import Robot
  • Author(s): Joachim Breitner
  • Date: 2013-09-18 19:11:12 UTC
  • mfrom: (1.2.8)
  • Revision ID: package-import@ubuntu.com-20130918191112-h5he0u2g5tqnh90m
Tags: 1.19.0-1
* Fix Vcs-Darcs url: http://darcs.debian.org/ instead of
  http://darcs.debian.org/darcs/
* New upstream release

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/Info.lhs
6
6
 
7
7
> module Info (genInfoFile) where
8
8
 
9
 
> import Paths_happy            ( version )
10
 
> import LALR                   ( Lr0Item(..) )
 
9
> import Paths_happy            ( version )
 
10
> import LALR                   ( Lr0Item(..) )
11
11
> import GenUtils               ( str, interleave, interleave', ljustify )
12
12
> import Data.Set ( Set )
13
13
> import qualified Data.Set as Set hiding ( Set )
15
15
 
16
16
> import Data.Array
17
17
> import Data.List (nub)
18
 
> import Data.Version           ( showVersion )
 
18
> import Data.Version           ( showVersion )
19
19
 
20
20
Produce a file of parser information, useful for debugging the parser.
21
21
 
22
22
> genInfoFile
23
 
>       :: [Set Lr0Item]
24
 
>       -> Grammar
25
 
>       -> ActionTable
26
 
>       -> GotoTable
27
 
>       -> [(Int,String)]
28
 
>       -> Array Int (Int,Int)
29
 
>       -> String
30
 
>       -> [Int]                        -- unused rules
31
 
>       -> [String]                     -- unused terminals
32
 
>       -> String
 
23
>       :: [Set Lr0Item]
 
24
>       -> Grammar
 
25
>       -> ActionTable
 
26
>       -> GotoTable
 
27
>       -> [(Int,String)]
 
28
>       -> Array Int (Int,Int)
 
29
>       -> String
 
30
>       -> [Int]                        -- unused rules
 
31
>       -> [String]                     -- unused terminals
 
32
>       -> String
33
33
 
34
 
> genInfoFile items 
35
 
>       (Grammar { productions = prods
36
 
>                , lookupProdNo = lookupProd
37
 
>                , lookupProdsOfName = lookupProdNos
38
 
>                , non_terminals = nonterms
 
34
> genInfoFile items
 
35
>       (Grammar { productions = prods
 
36
>                , lookupProdNo = lookupProd
 
37
>                , lookupProdsOfName = lookupProdNos
 
38
>                , non_terminals = nonterms
39
39
>                , token_names = env
40
 
>                })
41
 
>        action goto tokens conflictArray filename unused_rules unused_terminals
42
 
>       = (showHeader
43
 
>       . showConflicts
44
 
>       . showUnused
45
 
>       . showProductions 
46
 
>       . showTerminals 
47
 
>       . showNonTerminals 
48
 
>       . showStates
49
 
>       . showStats
50
 
>       ) ""
 
40
>                })
 
41
>        action goto tokens conflictArray filename unused_rules unused_terminals
 
42
>       = (showHeader
 
43
>       . showConflicts
 
44
>       . showUnused
 
45
>       . showProductions
 
46
>       . showTerminals
 
47
>       . showNonTerminals
 
48
>       . showStates
 
49
>       . showStats
 
50
>       ) ""
51
51
>   where
52
52
 
53
 
>   showHeader 
54
 
>       = banner ("Info file generated by Happy Version " ++ 
55
 
>                 showVersion version ++ " from " ++ filename)
 
53
>   showHeader
 
54
>       = banner ("Info file generated by Happy Version " ++
 
55
>                 showVersion version ++ " from " ++ filename)
56
56
 
57
57
>   showConflicts
58
 
>       = str "\n"
59
 
>       . foldr (.) id (map showConflictsState (assocs conflictArray))
60
 
>       . str "\n"
 
58
>       = str "\n"
 
59
>       . foldr (.) id (map showConflictsState (assocs conflictArray))
 
60
>       . str "\n"
61
61
 
62
62
>   showConflictsState (_,     (0,0)) = id
63
63
>   showConflictsState (state, (sr,rr))
64
 
>       = str "state "
65
 
>       . shows state
66
 
>       . str " contains "
67
 
>       . interleave' " and " (
68
 
>               (if sr /= 0 
69
 
>                       then [ shows sr . str " shift/reduce conflicts" ]
70
 
>                       else []) ++
71
 
>                if rr /= 0
72
 
>                       then [ shows rr . str " reduce/reduce conflicts" ]
73
 
>                       else [])
74
 
>       . str ".\n"
 
64
>       = str "state "
 
65
>       . shows state
 
66
>       . str " contains "
 
67
>       . interleave' " and " (
 
68
>               (if sr /= 0
 
69
>                       then [ shows sr . str " shift/reduce conflicts" ]
 
70
>                       else []) ++
 
71
>                if rr /= 0
 
72
>                       then [ shows rr . str " reduce/reduce conflicts" ]
 
73
>                       else [])
 
74
>       . str ".\n"
75
75
 
76
76
>   showUnused =
77
 
>         (case unused_rules of
78
 
>           [] -> id
79
 
>           _  ->   interleave "\n" (
80
 
>                       map (\r ->   str "rule " 
81
 
>                                  . shows r 
82
 
>                                  . str " is unused")
83
 
>                               unused_rules)
84
 
>                 . str "\n")
85
 
>       . (case unused_terminals of
86
 
>           [] -> id
87
 
>           _  ->   interleave "\n" (
88
 
>                       map (\t ->   str "terminal " 
89
 
>                                  . str t 
90
 
>                                  . str " is unused")
91
 
>                               unused_terminals)
92
 
>                 . str "\n")
93
 
 
94
 
>   showProductions = 
95
 
>         banner "Grammar"
96
 
>       . interleave "\n" (zipWith showProduction prods [ 0 :: Int .. ])
97
 
>       . str "\n"
98
 
  
 
77
>         (case unused_rules of
 
78
>           [] -> id
 
79
>           _  ->   interleave "\n" (
 
80
>                       map (\r ->   str "rule "
 
81
>                                  . shows r
 
82
>                                  . str " is unused")
 
83
>                               unused_rules)
 
84
>                 . str "\n")
 
85
>       . (case unused_terminals of
 
86
>           [] -> id
 
87
>           _  ->   interleave "\n" (
 
88
>                       map (\t ->   str "terminal "
 
89
>                                  . str t
 
90
>                                  . str " is unused")
 
91
>                               unused_terminals)
 
92
>                 . str "\n")
 
93
 
 
94
>   showProductions =
 
95
>         banner "Grammar"
 
96
>       . interleave "\n" (zipWith showProduction prods [ 0 :: Int .. ])
 
97
>       . str "\n"
 
98
 
99
99
>   showProduction (nt, toks, _sem, _prec) i
100
 
>       = ljuststr 50 (
101
 
>         str "\t"
102
 
>       . showName nt
103
 
>       . str " -> "
104
 
>       . interleave " " (map showName toks))
105
 
>       . str "  (" . shows i . str ")"
 
100
>       = ljuststr 50 (
 
101
>         str "\t"
 
102
>       . showName nt
 
103
>       . str " -> "
 
104
>       . interleave " " (map showName toks))
 
105
>       . str "  (" . shows i . str ")"
106
106
 
107
107
>   showStates =
108
 
>         banner "States"
109
 
>       . interleave "\n" (zipWith showState 
110
 
>               (map Set.toAscList items) [ 0 :: Int .. ])
 
108
>         banner "States"
 
109
>       . interleave "\n" (zipWith showState
 
110
>               (map Set.toAscList items) [ 0 :: Int .. ])
111
111
 
112
112
>   showState state n
113
 
>       = str "State ". shows n
114
 
>       . str "\n\n"
115
 
>       . interleave "\n" (map showItem [ (Lr0 r d) | (Lr0 r d) <- state, d /= 0 ])
116
 
>       . str "\n"
117
 
>       . foldr (.) id (map showAction (assocs (action ! n)))
118
 
>       . str "\n"
119
 
>       . foldr (.) id (map showGoto (assocs (goto ! n)))
 
113
>       = str "State ". shows n
 
114
>       . str "\n\n"
 
115
>       . interleave "\n" (map showItem [ (Lr0 r d) | (Lr0 r d) <- state, d /= 0 ])
 
116
>       . str "\n"
 
117
>       . foldr (.) id (map showAction (assocs (action ! n)))
 
118
>       . str "\n"
 
119
>       . foldr (.) id (map showGoto (assocs (goto ! n)))
120
120
 
121
121
>   showItem (Lr0 rule dot)
122
 
>       = ljuststr 50 (
123
 
>                 str "\t"
124
 
>               . showName nt
125
 
>               . str " -> "
126
 
>               . interleave " " (map showName beforeDot)
127
 
>               . str ". "
128
 
>               . interleave " " (map showName afterDot))
129
 
>       . str "   (rule " . shows rule . str ")"
130
 
>       where
131
 
>               (nt, toks, _sem, _prec) = lookupProd rule
132
 
>               (beforeDot, afterDot) = splitAt dot toks
 
122
>       = ljuststr 50 (
 
123
>                 str "\t"
 
124
>               . showName nt
 
125
>               . str " -> "
 
126
>               . interleave " " (map showName beforeDot)
 
127
>               . str ". "
 
128
>               . interleave " " (map showName afterDot))
 
129
>       . str "   (rule " . shows rule . str ")"
 
130
>       where
 
131
>               (nt, toks, _sem, _prec) = lookupProd rule
 
132
>               (beforeDot, afterDot) = splitAt dot toks
133
133
 
134
134
>   showAction (_, LR'Fail)
135
 
>       = id
 
135
>       = id
136
136
>   showAction (t, act)
137
 
>       = str "\t"
138
 
>       . showJName 15 t
139
 
>       . showAction' act
140
 
>       . str "\n"
 
137
>       = str "\t"
 
138
>       . showJName 15 t
 
139
>       . showAction' act
 
140
>       . str "\n"
141
141
 
142
142
>   showAction' LR'MustFail
143
 
>       = str "fail"
 
143
>       = str "fail"
144
144
>   showAction' (LR'Shift n _)
145
 
>       = str "shift, and enter state "
146
 
>       . shows n
 
145
>       = str "shift, and enter state "
 
146
>       . shows n
147
147
>   showAction' LR'Accept
148
 
>       = str "accept"
 
148
>       = str "accept"
149
149
>   showAction' (LR'Reduce n _)
150
 
>       = str "reduce using rule "
151
 
>       . shows n
 
150
>       = str "reduce using rule "
 
151
>       . shows n
152
152
>   showAction' (LR'Multiple as a)
153
 
>       = showAction' a
154
 
>       . str "\n"
155
 
>       . interleave "\n" 
156
 
>               (map (\a' -> str "\t\t\t(" . showAction' a' . str ")") 
157
 
>                (nub (filter (/= a) as)))
 
153
>       = showAction' a
 
154
>       . str "\n"
 
155
>       . interleave "\n"
 
156
>               (map (\a' -> str "\t\t\t(" . showAction' a' . str ")")
 
157
>                (nub (filter (/= a) as)))
158
158
>   showAction' LR'Fail = error "showAction' LR'Fail: Unhandled case"
159
159
 
160
160
>   showGoto (_, NoGoto)
161
 
>       = id
 
161
>       = id
162
162
>   showGoto (nt, Goto n)
163
 
>       = str "\t"
164
 
>       . showJName 15 nt
165
 
>       . str "goto state "
166
 
>       . shows n
167
 
>       . str "\n"
 
163
>       = str "\t"
 
164
>       . showJName 15 nt
 
165
>       . str "goto state "
 
166
>       . shows n
 
167
>       . str "\n"
168
168
 
169
169
>   showTerminals
170
 
>       = banner "Terminals"
171
 
>       . interleave "\n" (map showTerminal tokens)
172
 
>       . str "\n"
 
170
>       = banner "Terminals"
 
171
>       . interleave "\n" (map showTerminal tokens)
 
172
>       . str "\n"
173
173
 
174
174
>   showTerminal (t,s)
175
 
>       = str "\t"
176
 
>       . showJName 15 t
177
 
>       . str "{ " . str s . str " }"
 
175
>       = str "\t"
 
176
>       . showJName 15 t
 
177
>       . str "{ " . str s . str " }"
178
178
 
179
179
>   showNonTerminals
180
 
>       = banner "Non-terminals"
181
 
>       . interleave "\n" (map showNonTerminal nonterms)
182
 
>       . str "\n"
 
180
>       = banner "Non-terminals"
 
181
>       . interleave "\n" (map showNonTerminal nonterms)
 
182
>       . str "\n"
183
183
 
184
184
>   showNonTerminal nt
185
 
>       = str "\t"
186
 
>       . showJName 15 nt
187
 
>       . (if (length nt_rules == 1)
188
 
>               then str " rule  "
189
 
>               else str " rules ")
190
 
>       . foldr1 (\a b -> a . str ", " . b) nt_rules
191
 
>       where nt_rules = map shows (lookupProdNos nt)
 
185
>       = str "\t"
 
186
>       . showJName 15 nt
 
187
>       . (if (length nt_rules == 1)
 
188
>               then str " rule  "
 
189
>               else str " rules ")
 
190
>       . foldr1 (\a b -> a . str ", " . b) nt_rules
 
191
>       where nt_rules = map shows (lookupProdNos nt)
192
192
 
193
 
>   showStats 
194
 
>       = banner "Grammar Totals"
195
 
>       . str   "Number of rules: " . shows (length prods)
196
 
>       . str "\nNumber of terminals: " . shows (length tokens)
197
 
>       . str "\nNumber of non-terminals: " . shows (length nonterms)
198
 
>       . str "\nNumber of states: " . shows (length items)
199
 
>       . str "\n"
 
193
>   showStats
 
194
>       = banner "Grammar Totals"
 
195
>       . str   "Number of rules: " . shows (length prods)
 
196
>       . str "\nNumber of terminals: " . shows (length tokens)
 
197
>       . str "\nNumber of non-terminals: " . shows (length nonterms)
 
198
>       . str "\nNumber of states: " . shows (length items)
 
199
>       . str "\n"
200
200
 
201
201
>   nameOf n    = env ! n
202
202
>   showName    = str . nameOf
206
206
> ljuststr n s = str (ljustify n (s ""))
207
207
 
208
208
> banner :: String -> String -> String
209
 
> banner s 
210
 
>       = str "-----------------------------------------------------------------------------\n"
211
 
>       . str s
212
 
>       . str "\n-----------------------------------------------------------------------------\n"
 
209
> banner s
 
210
>       = str "-----------------------------------------------------------------------------\n"
 
211
>       . str s
 
212
>       . str "\n-----------------------------------------------------------------------------\n"
213
213