www.pudn.com > happy-1.13.rar > HappyTemplate-coerce

{-# LINE 1 "GenericTemplate.hs" #-} 
-- $Id: GenericTemplate.hs,v 1.23 2002/05/23 09:24:27 simonmar Exp $ 
 
 
 
 
 
 
 
 
 
 
 
 
 
{-# LINE 27 "GenericTemplate.hs" #-} 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
infixr 9 `HappyStk` 
data HappyStk a = HappyStk a (HappyStk a) 
 
----------------------------------------------------------------------------- 
-- starting the parse 
 
happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll 
 
----------------------------------------------------------------------------- 
-- Accepting the parse 
 
happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j  
				                  ) 
					   (happyReturn1 ans) 
 
----------------------------------------------------------------------------- 
-- Arrays only: do the next action 
 
{-# LINE 150 "GenericTemplate.hs" #-} 
 
 
----------------------------------------------------------------------------- 
-- HappyState data type (not arrays) 
 
 
 
newtype HappyState b c = HappyState 
        (Int# ->                    -- token number 
         Int# ->                    -- token number (yes, again) 
         b ->                           -- token semantic value 
         HappyState b c ->              -- current state 
         [HappyState b c] ->            -- state stack 
         c) 
 
 
 
----------------------------------------------------------------------------- 
-- Shifting a token 
 
happyShift new_state 1# tk st sts stk@(x `HappyStk` _) = 
     let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in 
--     trace "shifting the error token" $ 
     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk) 
 
happyShift new_state i tk st sts stk = 
     happyNewToken new_state ((st):(sts)) ((happyInTok (tk))`HappyStk`stk) 
 
-- happyReduce is specialised for the common cases. 
 
happySpecReduce_0 i fn 1# tk st sts stk 
     = happyFail 1# tk st sts stk 
happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk 
     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk) 
 
happySpecReduce_1 i fn 1# tk st sts stk 
     = happyFail 1# tk st sts stk 
happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk') 
     = let r = fn v1 in 
       happySeq r (action nt j tk st sts (r `HappyStk` stk')) 
 
happySpecReduce_2 i fn 1# tk st sts stk 
     = happyFail 1# tk st sts stk 
happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk') 
     = let r = fn v1 v2 in 
       happySeq r (action nt j tk st sts (r `HappyStk` stk')) 
 
happySpecReduce_3 i fn 1# tk st sts stk 
     = happyFail 1# tk st sts stk 
happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') 
     = let r = fn v1 v2 v3 in 
       happySeq r (action nt j tk st sts (r `HappyStk` stk')) 
 
happyReduce k i fn 1# tk st sts stk 
     = happyFail 1# tk st sts stk 
happyReduce k nt fn j tk st sts stk 
     = case happyDrop (k -# (1# :: Int#)) sts of 
	 sts1@(((st1@(HappyState (action))):(_))) -> 
        	let r = fn stk in  -- it doesn't hurt to always seq here... 
       		happyDoSeq r (action nt j tk st1 sts1 r) 
 
happyMonadReduce k nt fn 1# tk st sts stk 
     = happyFail 1# tk st sts stk 
happyMonadReduce k nt fn j tk st sts stk = 
        happyThen1 (fn stk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk)) 
       where sts1@(((st1@(HappyState (action))):(_))) = happyDrop k ((st):(sts)) 
             drop_stk = happyDropStk k stk 
 
happyDrop 0# l = l 
happyDrop n ((_):(t)) = happyDrop (n -# (1# :: Int#)) t 
 
happyDropStk 0# l = l 
happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs 
 
----------------------------------------------------------------------------- 
-- Moving to a new state after a reduction 
 
 
 
 
 
 
 
 
 
happyGoto action j tk st = action j j tk (HappyState action) 
 
 
----------------------------------------------------------------------------- 
-- Error recovery (1# is the error token) 
 
-- parse error if we are in recovery and we fail again 
happyFail  1# tk old_st _ stk = 
--	trace "failing" $  
    	happyError 
 
 
{-  We don't need state discarding for our restricted implementation of 
    "error".  In fact, it can cause some bogus parses, so I've disabled it 
    for now --SDM 
 
-- discard a state 
happyFail  1# tk old_st (((HappyState (action))):(sts))  
						(saved_tok `HappyStk` _ `HappyStk` stk) = 
--	trace ("discarding state, depth " ++ show (length stk))  $ 
	action 1# 1# tk (HappyState (action)) sts ((saved_tok`HappyStk`stk)) 
-} 
 
-- Enter error recovery: generate an error token, 
--                       save the old token and carry on. 
happyFail  i tk (HappyState (action)) sts stk = 
--      trace "entering error recovery" $ 
	action 1# 1# tk (HappyState (action)) sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk) 
 
-- Internal happy errors: 
 
notHappyAtAll = error "Internal Happy error\n" 
 
----------------------------------------------------------------------------- 
-- Hack to get the typechecker to accept our action functions 
 
 
happyTcHack :: Int# -> a -> a 
happyTcHack x y = y 
{-# INLINE happyTcHack #-} 
 
 
----------------------------------------------------------------------------- 
-- Seq-ing.  If the --strict flag is given, then Happy emits  
--	happySeq = happyDoSeq 
-- otherwise it emits 
-- 	happySeq = happyDontSeq 
 
happyDoSeq, happyDontSeq :: a -> b -> b 
happyDoSeq   a b = a `seq` b 
happyDontSeq a b = b 
 
----------------------------------------------------------------------------- 
-- Don't inline any functions from the template.  GHC has a nasty habit 
-- of deciding to inline happyGoto everywhere, which increases the size of 
-- the generated parser quite a bit. 
 
 
 
 
 
 
 
 
 
{-# NOINLINE happyShift #-} 
{-# NOINLINE happySpecReduce_0 #-} 
{-# NOINLINE happySpecReduce_1 #-} 
{-# NOINLINE happySpecReduce_2 #-} 
{-# NOINLINE happySpecReduce_3 #-} 
{-# NOINLINE happyReduce #-} 
{-# NOINLINE happyMonadReduce #-} 
{-# NOINLINE happyGoto #-} 
{-# NOINLINE happyFail #-} 
 
-- end of Happy Template.