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
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
45data Happy_IntList = HappyCons 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 (0) tk st sts (_ `HappyStk` ans `HappyStk` _) =
101        happyReturn1 ans
102happyAccept j tk st sts (HappyStk ans _) =
103         (happyReturn1 ans)
104
105-----------------------------------------------------------------------------
106-- Arrays only: do the next action
107
108
109
110happyDoAction i tk st
111        = {- nothing -}
112          case action of
113                (0)           -> {- nothing -}
114                                     happyFail (happyExpListPerState ((st) :: Int)) i tk st
115                (-1)          -> {- nothing -}
116                                     happyAccept i tk st
117                n | (n < ((0) :: Int)) -> {- nothing -}
118                                                   (happyReduceArr Happy_Data_Array.! rule) i tk st
119                                                   where rule = ((negate ((n + ((1) :: Int)))))
120                n                 -> {- nothing -}
121                                     happyShift new_state i tk st
122                                     where new_state = (n - ((1) :: Int))
123   where off    = happyAdjustOffset (indexShortOffAddr happyActOffsets st)
124         off_i  = (off + i)
125         check  = if (off_i >= ((0) :: Int))
126                  then (indexShortOffAddr happyCheck off_i == i)
127                  else False
128         action
129          | check     = indexShortOffAddr happyTable off_i
130          | otherwise = indexShortOffAddr happyDefActions st
131
132
133
134
135
136
137
138
139
140
141
142
143indexShortOffAddr arr off = arr Happy_Data_Array.! off
144
145
146{-# INLINE happyLt #-}
147happyLt x y = (x < y)
148
149
150
151
152
153
154readArrayBit arr bit =
155    Bits.testBit (indexShortOffAddr arr (bit `div` 16)) (bit `mod` 16)
156
157
158
159
160
161
162-----------------------------------------------------------------------------
163-- HappyState data type (not arrays)
164
165
166
167
168
169
170
171
172
173
174
175
176
177-----------------------------------------------------------------------------
178-- Shifting a token
179
180happyShift new_state (0) tk st sts stk@(x `HappyStk` _) =
181     let i = (case x of { HappyErrorToken (i) -> i }) in
182--     trace "shifting the error token" $
183     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)
184
185happyShift new_state i tk st sts stk =
186     happyNewToken new_state (HappyCons (st) (sts)) ((HappyTerminal (tk))`HappyStk`stk)
187
188-- happyReduce is specialised for the common cases.
189
190happySpecReduce_0 i fn (0) tk st sts stk
191     = happyFail [] (0) tk st sts stk
192happySpecReduce_0 nt fn j tk st@((action)) sts stk
193     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)
194
195happySpecReduce_1 i fn (0) tk st sts stk
196     = happyFail [] (0) tk st sts stk
197happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')
198     = let r = fn v1 in
199       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
200
201happySpecReduce_2 i fn (0) tk st sts stk
202     = happyFail [] (0) tk st sts stk
203happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')
204     = let r = fn v1 v2 in
205       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
206
207happySpecReduce_3 i fn (0) tk st sts stk
208     = happyFail [] (0) tk st sts stk
209happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
210     = let r = fn v1 v2 v3 in
211       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
212
213happyReduce k i fn (0) tk st sts stk
214     = happyFail [] (0) tk st sts stk
215happyReduce k nt fn j tk st sts stk
216     = case happyDrop (k - ((1) :: Int)) sts of
217         sts1@((HappyCons (st1@(action)) (_))) ->
218                let r = fn stk in  -- it doesn't hurt to always seq here...
219                happyDoSeq r (happyGoto nt j tk st1 sts1 r)
220
221happyMonadReduce k nt fn (0) tk st sts stk
222     = happyFail [] (0) tk st sts stk
223happyMonadReduce k nt fn j tk st sts stk =
224      case happyDrop k (HappyCons (st) (sts)) of
225        sts1@((HappyCons (st1@(action)) (_))) ->
226          let drop_stk = happyDropStk k stk in
227          happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
228
229happyMonad2Reduce k nt fn (0) tk st sts stk
230     = happyFail [] (0) tk st sts stk
231happyMonad2Reduce k nt fn j tk st sts stk =
232      case happyDrop k (HappyCons (st) (sts)) of
233        sts1@((HappyCons (st1@(action)) (_))) ->
234         let drop_stk = happyDropStk k stk
235
236             off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1)
237             off_i = (off + nt)
238             new_state = indexShortOffAddr happyTable off_i
239
240
241
242
243          in
244          happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
245
246happyDrop (0) l = l
247happyDrop n (HappyCons (_) (t)) = happyDrop (n - ((1) :: Int)) t
248
249happyDropStk (0) l = l
250happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs
251
252-----------------------------------------------------------------------------
253-- Moving to a new state after a reduction
254
255
256happyGoto nt j tk st =
257   {- nothing -}
258   happyDoAction j tk new_state
259   where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st)
260         off_i = (off + nt)
261         new_state = indexShortOffAddr happyTable off_i
262
263
264
265
266-----------------------------------------------------------------------------
267-- Error recovery (ERROR_TOK is the error token)
268
269-- parse error if we are in recovery and we fail again
270happyFail explist (0) tk old_st _ stk@(x `HappyStk` _) =
271     let i = (case x of { HappyErrorToken (i) -> i }) in
272--      trace "failing" $
273        happyError_ explist i tk
274
275{-  We don't need state discarding for our restricted implementation of
276    "error".  In fact, it can cause some bogus parses, so I've disabled it
277    for now --SDM
278
279-- discard a state
280happyFail  ERROR_TOK tk old_st CONS(HAPPYSTATE(action),sts)
281                                                (saved_tok `HappyStk` _ `HappyStk` stk) =
282--      trace ("discarding state, depth " ++ show (length stk))  $
283        DO_ACTION(action,ERROR_TOK,tk,sts,(saved_tok`HappyStk`stk))
284-}
285
286-- Enter error recovery: generate an error token,
287--                       save the old token and carry on.
288happyFail explist i tk (action) sts stk =
289--      trace "entering error recovery" $
290        happyDoAction (0) tk action sts ((HappyErrorToken (i)) `HappyStk` stk)
291
292-- Internal happy errors:
293
294notHappyAtAll :: a
295notHappyAtAll = error "Internal Happy error\n"
296
297-----------------------------------------------------------------------------
298-- Hack to get the typechecker to accept our action functions
299
300
301
302
303
304
305
306-----------------------------------------------------------------------------
307-- Seq-ing.  If the --strict flag is given, then Happy emits
308--      happySeq = happyDoSeq
309-- otherwise it emits
310--      happySeq = happyDontSeq
311
312happyDoSeq, happyDontSeq :: a -> b -> b
313happyDoSeq   a b = a `seq` b
314happyDontSeq a b = b
315
316-----------------------------------------------------------------------------
317-- Don't inline any functions from the template.  GHC has a nasty habit
318-- of deciding to inline happyGoto everywhere, which increases the size of
319-- the generated parser quite a bit.
320
321
322{-# NOINLINE happyDoAction #-}
323{-# NOINLINE happyTable #-}
324{-# NOINLINE happyCheck #-}
325{-# NOINLINE happyActOffsets #-}
326{-# NOINLINE happyGotoOffsets #-}
327{-# NOINLINE happyDefActions #-}
328
329{-# NOINLINE happyShift #-}
330{-# NOINLINE happySpecReduce_0 #-}
331{-# NOINLINE happySpecReduce_1 #-}
332{-# NOINLINE happySpecReduce_2 #-}
333{-# NOINLINE happySpecReduce_3 #-}
334{-# NOINLINE happyReduce #-}
335{-# NOINLINE happyMonadReduce #-}
336{-# NOINLINE happyGoto #-}
337{-# NOINLINE happyFail #-}
338
339-- end of Happy Template.
340