blob: bfdc9fc5bc4c2a41e1c7a9963ef2deba9c169b24 (
plain)
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
|
{-
Bug report from Jon Mountjoy:
While playing with Happy I managed to generate a Haskell program
which compiles fine under ghc but not under Hugs. I don't know which
one is the culprit....
In Hugs(January 1998), one gets
ERROR "hugs.hs" (line 32): Unresolved top-level overloading
*** Binding : happyReduce_1
*** Outstanding context : Functor b
where line 32 is the one marked -- ##
It compiles in ghc-3.00. Changing very small things, like the
line marked ---**** to
action_0 (6) = happyShift action_0 ---****
then makes ghc produce a similar message:
hugs.hs:37:
Cannot resolve the ambiguous context (Functor a1Ab)
`Functor a1Ab' arising from use of `reduction', at hugs.hs:37
-}
module ShouldSucceed where
data HappyAbsSyn t1 t2 t3
= HappyTerminal Token
| HappyErrorToken Int
| HappyAbsSyn1 t1
| HappyAbsSyn2 t2
| HappyAbsSyn3 t3
action_0 (6) = happyShift action_3 --- *****
action_0 (1) = happyGoto action_1
action_0 (2) = happyGoto action_2
action_0 _ = happyFail
action_1 (7) = happyAccept
action_1 _ = happyFail
action_2 _ = happyReduce_1
action_3 (5) = happyShift action_4
action_3 _ = happyFail
action_4 (4) = happyShift action_6
action_4 (3) = happyGoto action_5
action_4 _ = happyFail
action_5 _ = happyReduce_2
action_6 _ = happyReduce_3
happyReduce_1 = happySpecReduce_1 1 reduction where { -- ##
reduction
(HappyAbsSyn2 happy_var_1)
= HappyAbsSyn1
(\p -> let q = map (\(x,y) -> (x,y p)) happy_var_1 in (10.1))
;
reduction _ = notHappyAtAll }
happyReduce_2 = happySpecReduce_3 2 reduction where {
reduction
(HappyAbsSyn3 happy_var_3)
_
(HappyTerminal (TokenVar happy_var_1))
= HappyAbsSyn2
([(happy_var_1,happy_var_3)]);
reduction _ _ _ = notHappyAtAll }
happyReduce_3 = happySpecReduce_1 3 reduction where {
reduction
(HappyTerminal (TokenInt happy_var_1))
= HappyAbsSyn3
(\p -> happy_var_1);
reduction _ = notHappyAtAll }
happyNewToken action sts stk [] =
action 7 7 (error "reading EOF!") (HappyState action) sts stk []
happyNewToken action sts stk (tk:tks) =
let cont i = action i i tk (HappyState action) sts stk tks in
case tk of {
TokenInt happy_dollar_dollar -> cont 4;
TokenEq -> cont 5;
TokenVar happy_dollar_dollar -> cont 6;
}
happyThen = \m k -> k m
happyReturn = \a tks -> a
myparser = happyParse
happyError ::[Token] -> a
happyError _ = error "Parse error\n"
--Here are our tokens
data Token =
TokenInt Int
| TokenVar String
| TokenEq
deriving Show
main = print (myparser [] [])
-- $Id: tc095.hs,v 1.4 2005/05/24 11:33:11 simonpj Exp $
{-
The stack is in the following order throughout the parse:
i current token number
j another copy of this to avoid messing with the stack
tk current token semantic value
st current state
sts state stack
stk semantic stack
-}
-----------------------------------------------------------------------------
happyParse = happyNewToken action_0 [] []
-- All this HappyState stuff is simply because we can't have recursive
-- types in Haskell without an intervening data structure.
newtype HappyState b c = HappyState
(Int -> -- token number
Int -> -- token number (yes, again)
b -> -- token semantic value
HappyState b c -> -- current state
[HappyState b c] -> -- state stack
c)
-----------------------------------------------------------------------------
-- Accepting the parse
happyAccept j tk st sts [ HappyAbsSyn1 ans ] = happyReturn ans
happyAccept j tk st sts _ = notHappyAtAll
-----------------------------------------------------------------------------
-- Shifting a token
happyShift new_state (-1) tk st sts stk@(HappyErrorToken i : _) =
-- _trace "shifting the error token" $
new_state i i tk (HappyState new_state) (st:sts) stk
happyShift new_state i tk st sts stk =
happyNewToken new_state (st:sts) (HappyTerminal tk:stk)
-----------------------------------------------------------------------------
-- Reducing
-- happyReduce is specialised for the common cases.
-- don't allow reductions when we're in error recovery, because this can
-- lead to an infinite loop.
happySpecReduce_0 i fn (-1) tk _ sts stk
= case sts of
st@(HappyState action):sts -> action (-1) (-1) tk st sts stk
_ -> happyError
happySpecReduce_0 i fn j tk st@(HappyState action) sts stk
= action i j tk st (st:sts) (fn : stk)
happySpecReduce_1 i fn (-1) tk _ (st@(HappyState action):sts) stk
= action (-1) (-1) tk st sts stk
happySpecReduce_1 i fn j tk _ sts@(st@(HappyState action):_) (v1:stk')
= action i j tk st sts (fn v1 : stk')
happySpecReduce_1 _ _ _ _ _ _ _
= notHappyAtAll
happySpecReduce_2 i fn (-1) tk _ (st@(HappyState action):sts) stk
= action (-1) (-1) tk st sts stk
happySpecReduce_2 i fn j tk _ (_:sts@(st@(HappyState action):_)) (v1:v2:stk')
= action i j tk st sts (fn v1 v2 : stk')
happySpecReduce_2 _ _ _ _ _ _ _
= notHappyAtAll
happySpecReduce_3 i fn (-1) tk _ (st@(HappyState action):sts) stk
= action (-1) (-1) tk st sts stk
happySpecReduce_3 i fn j tk _ (_:_:sts@(st@(HappyState action):_))
(v1:v2:v3:stk')
= action i j tk st sts (fn v1 v2 v3 : stk')
happySpecReduce_3 _ _ _ _ _ _ _
= notHappyAtAll
happyReduce k i fn (-1) tk _ (st@(HappyState action):sts) stk
= action (-1) (-1) tk st sts stk
happyReduce k i fn j tk st sts stk = action i j tk st' sts' (fn stk)
where sts'@(st'@(HappyState action):_) = drop (k::Int) (st:sts)
happyMonadReduce k i c fn (-1) tk _ sts stk
= case sts of
(st@(HappyState action):sts) -> action (-1) (-1) tk st sts stk
[] -> happyError
happyMonadReduce k i c fn j tk st sts stk =
happyThen (fn stk) (\r -> action i j tk st' sts' (c r : stk'))
where sts'@(st'@(HappyState action):_) = drop (k::Int) (st:sts)
stk' = drop (k::Int) stk
-----------------------------------------------------------------------------
-- Moving to a new state after a reduction
happyGoto action j tk st = action j j tk (HappyState action)
-----------------------------------------------------------------------------
-- Error recovery (-1 is the error token)
-- fail if we are in recovery and no more states to discard
{-# NOINLINE happyFail #-}
-- NOINLINE else GHC diverges with the contravariant data type bug
-- See test simplCore/should_compile/simpl012
happyFail (-1) tk st' [] stk = happyError
-- discard a state
happyFail (-1) tk st' (st@(HappyState action):sts) stk =
-- _trace "discarding state" $
action (-1) (-1) tk st sts stk
-- Enter error recovery: generate an error token,
-- save the old token and carry on.
-- we push the error token on the stack in anticipation of a shift,
-- and also because this is a convenient place to store the saved token.
happyFail i tk st@(HappyState action) sts stk =
-- _trace "entering error recovery" $
action (-1) (-1) tk st sts (HappyErrorToken i : stk)
-- Internal happy errors:
notHappyAtAll = error "Internal Happy error\n"
-- end of Happy Template.
|
