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 79happyTrace string expr = Happy_System_IO_Unsafe.unsafePerformIO $ do 80 Happy_System_IO.hPutStr Happy_System_IO.stderr string 81 return expr 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 = (happyTrace ("state: " ++ show (st) ++ 112 ",\ttoken: " ++ show (i) ++ 113 ",\taction: ")) $ 114 case action of 115 (0) -> (happyTrace ("fail.\n")) $ 116 happyFail (happyExpListPerState ((st) :: Int)) i tk st 117 (-1) -> (happyTrace ("accept.\n")) $ 118 happyAccept i tk st 119 n | (n < ((0) :: Int)) -> (happyTrace ("reduce (rule " ++ show rule 120 ++ ")")) $ 121 (happyReduceArr Happy_Data_Array.! rule) i tk st 122 where rule = ((negate ((n + ((1) :: Int))))) 123 n -> (happyTrace ("shift, enter state " 124 ++ show (new_state) 125 ++ "\n")) $ 126 happyShift new_state i tk st 127 where new_state = (n - ((1) :: Int)) 128 where off = happyAdjustOffset (indexShortOffAddr happyActOffsets st) 129 off_i = (off + i) 130 check = if (off_i >= ((0) :: Int)) 131 then (indexShortOffAddr happyCheck off_i == i) 132 else False 133 action 134 | check = indexShortOffAddr happyTable off_i 135 | otherwise = indexShortOffAddr happyDefActions st 136 137 138 139 140 141 142 143 144 145 146 147 148indexShortOffAddr arr off = arr Happy_Data_Array.! off 149 150 151{-# INLINE happyLt #-} 152happyLt x y = (x < y) 153 154 155 156 157 158 159readArrayBit arr bit = 160 Bits.testBit (indexShortOffAddr arr (bit `div` 16)) (bit `mod` 16) 161 162 163 164 165 166 167----------------------------------------------------------------------------- 168-- HappyState data type (not arrays) 169 170 171 172 173 174 175 176 177 178 179 180 181 182----------------------------------------------------------------------------- 183-- Shifting a token 184 185happyShift new_state (0) tk st sts stk@(x `HappyStk` _) = 186 let i = (case x of { HappyErrorToken (i) -> i }) in 187-- trace "shifting the error token" $ 188 happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) 189 190happyShift new_state i tk st sts stk = 191 happyNewToken new_state (HappyCons (st) (sts)) ((HappyTerminal (tk))`HappyStk`stk) 192 193-- happyReduce is specialised for the common cases. 194 195happySpecReduce_0 i fn (0) tk st sts stk 196 = happyFail [] (0) tk st sts stk 197happySpecReduce_0 nt fn j tk st@((action)) sts stk 198 = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) 199 200happySpecReduce_1 i fn (0) tk st sts stk 201 = happyFail [] (0) tk st sts stk 202happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') 203 = let r = fn v1 in 204 happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) 205 206happySpecReduce_2 i fn (0) tk st sts stk 207 = happyFail [] (0) tk st sts stk 208happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') 209 = let r = fn v1 v2 in 210 happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) 211 212happySpecReduce_3 i fn (0) tk st sts stk 213 = happyFail [] (0) tk st sts stk 214happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') 215 = let r = fn v1 v2 v3 in 216 happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) 217 218happyReduce k i fn (0) tk st sts stk 219 = happyFail [] (0) tk st sts stk 220happyReduce k nt fn j tk st sts stk 221 = case happyDrop (k - ((1) :: Int)) sts of 222 sts1@((HappyCons (st1@(action)) (_))) -> 223 let r = fn stk in -- it doesn't hurt to always seq here... 224 happyDoSeq r (happyGoto nt j tk st1 sts1 r) 225 226happyMonadReduce k nt fn (0) tk st sts stk 227 = happyFail [] (0) tk st sts stk 228happyMonadReduce k nt fn j tk st sts stk = 229 case happyDrop k (HappyCons (st) (sts)) of 230 sts1@((HappyCons (st1@(action)) (_))) -> 231 let drop_stk = happyDropStk k stk in 232 happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) 233 234happyMonad2Reduce k nt fn (0) tk st sts stk 235 = happyFail [] (0) tk st sts stk 236happyMonad2Reduce k nt fn j tk st sts stk = 237 case happyDrop k (HappyCons (st) (sts)) of 238 sts1@((HappyCons (st1@(action)) (_))) -> 239 let drop_stk = happyDropStk k stk 240 241 off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1) 242 off_i = (off + nt) 243 new_state = indexShortOffAddr happyTable off_i 244 245 246 247 248 in 249 happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) 250 251happyDrop (0) l = l 252happyDrop n (HappyCons (_) (t)) = happyDrop (n - ((1) :: Int)) t 253 254happyDropStk (0) l = l 255happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs 256 257----------------------------------------------------------------------------- 258-- Moving to a new state after a reduction 259 260 261happyGoto nt j tk st = 262 (happyTrace (", goto state " ++ show (new_state) ++ "\n")) $ 263 happyDoAction j tk new_state 264 where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st) 265 off_i = (off + nt) 266 new_state = indexShortOffAddr happyTable off_i 267 268 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 (0) tk old_st _ stk@(x `HappyStk` _) = 276 let i = (case x of { HappyErrorToken (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 (action) sts stk = 294-- trace "entering error recovery" $ 295 happyDoAction (0) tk action sts ((HappyErrorToken (i)) `HappyStk` stk) 296 297-- Internal happy errors: 298 299notHappyAtAll :: a 300notHappyAtAll = error "Internal Happy error\n" 301 302----------------------------------------------------------------------------- 303-- Hack to get the typechecker to accept our action functions 304 305 306 307 308 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 `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{-# NOINLINE happyDoAction #-} 328{-# NOINLINE happyTable #-} 329{-# NOINLINE happyCheck #-} 330{-# NOINLINE happyActOffsets #-} 331{-# NOINLINE happyGotoOffsets #-} 332{-# NOINLINE happyDefActions #-} 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