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