1{-# LINE 1 "templates/GenericTemplate.hs" #-}
2-- $Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp $
3
4
5
6
7
8
9
10
11
12
13
14
15
16-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
17#if __GLASGOW_HASKELL__ > 706
18#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Prelude.Bool)
19#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Prelude.Bool)
20#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Prelude.Bool)
21#else
22#define LT(n,m) (n Happy_GHC_Exts.<# m)
23#define GTE(n,m) (n Happy_GHC_Exts.>=# m)
24#define EQ(n,m) (n Happy_GHC_Exts.==# m)
25#endif
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList
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
86infixr 9 `HappyStk`
87data HappyStk a = HappyStk a (HappyStk a)
88
89-----------------------------------------------------------------------------
90-- starting the parse
91
92happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
93
94-----------------------------------------------------------------------------
95-- Accepting the parse
96
97-- If the current token is ERROR_TOK, it means we've just accepted a partial
98-- parse (a %partial parser).  We must ignore the saved token on the top of
99-- the stack in this case.
100happyAccept 1# tk st sts (_ `HappyStk` ans `HappyStk` _) =
101        happyReturn1 ans
102happyAccept j tk st sts (HappyStk ans _) =
103        (happyTcHack j ) (happyReturn1 ans)
104
105-----------------------------------------------------------------------------
106-- Arrays only: do the next action
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
140indexShortOffAddr (HappyA# arr) off =
141        Happy_GHC_Exts.narrow16Int# i
142  where
143        i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)
144        high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))
145        low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))
146        off' = off Happy_GHC_Exts.*# 2#
147
148
149
150
151{-# INLINE happyLt #-}
152happyLt x y = LT(x,y)
153
154
155readArrayBit arr bit =
156    Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `Prelude.mod` 16)
157  where unbox_int (Happy_GHC_Exts.I# x) = x
158
159
160
161
162
163
164data HappyAddr = HappyA# Happy_GHC_Exts.Addr#
165
166
167-----------------------------------------------------------------------------
168-- HappyState data type (not arrays)
169
170
171
172newtype HappyState b c = HappyState
173        (Happy_GHC_Exts.Int# ->                    -- token number
174         Happy_GHC_Exts.Int# ->                    -- token number (yes, again)
175         b ->                           -- token semantic value
176         HappyState b c ->              -- current state
177         [HappyState b c] ->            -- state stack
178         c)
179
180
181
182-----------------------------------------------------------------------------
183-- Shifting a token
184
185happyShift new_state 1# tk st sts stk@(x `HappyStk` _) =
186     let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
187--     trace "shifting the error token" $
188     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)
189
190happyShift new_state i tk st sts stk =
191     happyNewToken new_state ((st):(sts)) ((happyInTok (tk))`HappyStk`stk)
192
193-- happyReduce is specialised for the common cases.
194
195happySpecReduce_0 i fn 1# tk st sts stk
196     = happyFail [] 1# tk st sts stk
197happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk
198     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)
199
200happySpecReduce_1 i fn 1# tk st sts stk
201     = happyFail [] 1# tk st sts stk
202happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')
203     = let r = fn v1 in
204       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
205
206happySpecReduce_2 i fn 1# tk st sts stk
207     = happyFail [] 1# tk st sts stk
208happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')
209     = let r = fn v1 v2 in
210       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
211
212happySpecReduce_3 i fn 1# tk st sts stk
213     = happyFail [] 1# tk st sts stk
214happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
215     = let r = fn v1 v2 v3 in
216       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
217
218happyReduce k i fn 1# tk st sts stk
219     = happyFail [] 1# tk st sts stk
220happyReduce k nt fn j tk st sts stk
221     = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of
222         sts1@(((st1@(HappyState (action))):(_))) ->
223                let r = fn stk in  -- it doesn't hurt to always seq here...
224                happyDoSeq r (action nt j tk st1 sts1 r)
225
226happyMonadReduce k nt fn 1# tk st sts stk
227     = happyFail [] 1# tk st sts stk
228happyMonadReduce k nt fn j tk st sts stk =
229      case happyDrop k ((st):(sts)) of
230        sts1@(((st1@(HappyState (action))):(_))) ->
231          let drop_stk = happyDropStk k stk in
232          happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))
233
234happyMonad2Reduce k nt fn 1# tk st sts stk
235     = happyFail [] 1# tk st sts stk
236happyMonad2Reduce k nt fn j tk st sts stk =
237      case happyDrop k ((st):(sts)) of
238        sts1@(((st1@(HappyState (action))):(_))) ->
239         let drop_stk = happyDropStk k stk
240
241
242
243
244
245             _ = nt :: Happy_GHC_Exts.Int#
246             new_state = action
247
248          in
249          happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
250
251happyDrop 0# l = l
252happyDrop n ((_):(t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t
253
254happyDropStk 0# l = l
255happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs
256
257-----------------------------------------------------------------------------
258-- Moving to a new state after a reduction
259
260
261
262
263
264
265
266
267
268happyGoto action j tk st = action j j tk (HappyState action)
269
270
271-----------------------------------------------------------------------------
272-- Error recovery (ERROR_TOK is the error token)
273
274-- parse error if we are in recovery and we fail again
275happyFail explist 1# tk old_st _ stk@(x `HappyStk` _) =
276     let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
277--      trace "failing" $
278        happyError_ explist i tk
279
280{-  We don't need state discarding for our restricted implementation of
281    "error".  In fact, it can cause some bogus parses, so I've disabled it
282    for now --SDM
283
284-- discard a state
285happyFail  ERROR_TOK tk old_st CONS(HAPPYSTATE(action),sts)
286                                                (saved_tok `HappyStk` _ `HappyStk` stk) =
287--      trace ("discarding state, depth " ++ show (length stk))  $
288        DO_ACTION(action,ERROR_TOK,tk,sts,(saved_tok`HappyStk`stk))
289-}
290
291-- Enter error recovery: generate an error token,
292--                       save the old token and carry on.
293happyFail explist i tk (HappyState (action)) sts stk =
294--      trace "entering error recovery" $
295        action 1# 1# tk (HappyState (action)) sts ((Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)
296
297-- Internal happy errors:
298
299notHappyAtAll :: a
300notHappyAtAll = Prelude.error "Internal Happy error\n"
301
302-----------------------------------------------------------------------------
303-- Hack to get the typechecker to accept our action functions
304
305
306happyTcHack :: Happy_GHC_Exts.Int# -> a -> a
307happyTcHack x y = y
308{-# INLINE happyTcHack #-}
309
310
311-----------------------------------------------------------------------------
312-- Seq-ing.  If the --strict flag is given, then Happy emits
313--      happySeq = happyDoSeq
314-- otherwise it emits
315--      happySeq = happyDontSeq
316
317happyDoSeq, happyDontSeq :: a -> b -> b
318happyDoSeq   a b = a `Prelude.seq` b
319happyDontSeq a b = b
320
321-----------------------------------------------------------------------------
322-- Don't inline any functions from the template.  GHC has a nasty habit
323-- of deciding to inline happyGoto everywhere, which increases the size of
324-- the generated parser quite a bit.
325
326
327
328
329
330
331
332
333
334{-# NOINLINE happyShift #-}
335{-# NOINLINE happySpecReduce_0 #-}
336{-# NOINLINE happySpecReduce_1 #-}
337{-# NOINLINE happySpecReduce_2 #-}
338{-# NOINLINE happySpecReduce_3 #-}
339{-# NOINLINE happyReduce #-}
340{-# NOINLINE happyMonadReduce #-}
341{-# NOINLINE happyGoto #-}
342{-# NOINLINE happyFail #-}
343
344-- end of Happy Template.
345