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