-- parser produced by Happy Version 1.14 module Parser (parse) where import Lexer (lex_tok) import ParserM (Token(..), Tree(..), ParserM, run_parser, get_pos, show_pos, happyError) data HappyAbsSyn = HappyTerminal Token | HappyErrorToken Int | HappyAbsSyn4 (Tree) type HappyReduction = Int -> (Token) -> HappyState (Token) (HappyStk HappyAbsSyn -> ParserM(HappyAbsSyn)) -> [HappyState (Token) (HappyStk HappyAbsSyn -> ParserM(HappyAbsSyn))] -> HappyStk HappyAbsSyn -> ParserM(HappyAbsSyn) action_0, action_1, action_2, action_3, action_4, action_5, action_6 :: Int -> HappyReduction happyReduce_1, happyReduce_2 :: HappyReduction action_0 (5) = happyShift action_4 action_0 (6) = happyShift action_2 action_0 (4) = happyGoto action_3 action_0 _ = happyFail action_1 (6) = happyShift action_2 action_1 _ = happyFail action_2 _ = happyReduce_1 action_3 (7) = happyAccept action_3 _ = happyFail action_4 (5) = happyShift action_4 action_4 (6) = happyShift action_2 action_4 (4) = happyGoto action_5 action_4 _ = happyFail action_5 (5) = happyShift action_4 action_5 (6) = happyShift action_2 action_5 (4) = happyGoto action_6 action_5 _ = happyFail action_6 _ = happyReduce_2 happyReduce_1 = happySpecReduce_1 4 happyReduction_1 happyReduction_1 _ = HappyAbsSyn4 (Leaf ) happyReduce_2 = happySpecReduce_3 4 happyReduction_2 happyReduction_2 (HappyAbsSyn4 happy_var_3) (HappyAbsSyn4 happy_var_2) _ = HappyAbsSyn4 (Fork happy_var_2 happy_var_3 ) happyReduction_2 _ _ _ = notHappyAtAll happyNewToken action sts stk = lex_tok(\tk -> let cont i = action i i tk (HappyState action) sts stk in case tk of { TEOF -> action 7 7 (error "reading EOF!") (HappyState action) sts stk; TFork -> cont 5; TLeaf -> cont 6; _ -> happyError }) happyThen :: ParserM a -> (a -> ParserM b) -> ParserM b happyThen = (>>=) happyReturn :: a -> ParserM a happyReturn = (return) happyThen1 = happyThen happyReturn1 = happyReturn parsex = happyThen (happyParse action_0) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll }) happySeq = happyDontSeq parse :: String -> Either String Tree parse = run_parser parsex {-# LINE 1 "GenericTemplate.hs" #-} -- $Id: Parser.hs,v 1.1 2004/02/20 11:38:05 simonmar Exp $ {-# LINE 15 "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 _) = (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 x of { HappyErrorToken (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)) ((HappyTerminal (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 ( (HappyErrorToken (i)) `HappyStk` stk) -- Internal happy errors: notHappyAtAll = error "Internal Happy error\n" ----------------------------------------------------------------------------- -- Hack to get the typechecker to accept our action functions ----------------------------------------------------------------------------- -- 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.