diff options
Diffstat (limited to 'ghc/tests/ghci/prog005/Parser.hs')
| -rw-r--r-- | ghc/tests/ghci/prog005/Parser.hs | 359 |
1 files changed, 0 insertions, 359 deletions
diff --git a/ghc/tests/ghci/prog005/Parser.hs b/ghc/tests/ghci/prog005/Parser.hs deleted file mode 100644 index d7f007c98b..0000000000 --- a/ghc/tests/ghci/prog005/Parser.hs +++ /dev/null @@ -1,359 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp #-} --- parser produced by Happy Version 1.11 - -module Parser where - -import Char -import GlaExts -import Array -import IO -import IOExts - -data HappyAbsSyn - = HappyTerminal Token - | HappyErrorToken Int - | HappyAbsSyn4 (Int) - -happyActOffsets :: Addr -happyActOffsets = A# "\x0a\x00\x0a\x00\x00\x00\xff\xff\x0a\x00\x0a\x00\x08\x00\x07\x00\x00\x00"# - -happyGotoOffsets :: Addr -happyGotoOffsets = A# "\x06\x00\x00\x00\x00\x00\x00\x00\x05\x00\x04\x00\x00\x00\x00\x00\x00\x00"# - -happyDefActions :: Addr -happyDefActions = A# "\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xfc\xff\xfd\xff"# - -happyCheck :: Addr -happyCheck = A# "\xff\xff\x02\x00\x03\x00\x04\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x02\x00\x02\x00\x01\x00\xff\xff\xff\xff\xff\xff"# - -happyTable :: Addr -happyTable = A# "\x00\x00\x05\x00\x06\x00\xff\xff\x06\x00\x07\x00\x03\x00\x00\x00\x00\x00\x00\x00\x05\x00\x03\x00\x00\x00\x00\x00\x00\x00"# - -happyReduceArr = array (1, 3) [ - (1 , happyReduce_1), - (2 , happyReduce_2), - (3 , happyReduce_3) - ] - -happy_n_terms = 5 :: Int -happy_n_nonterms = 1 :: Int - -happyReduce_1 = happySpecReduce_1 0# happyReduction_1 -happyReduction_1 _ - = HappyAbsSyn4 - (1 - ) - -happyReduce_2 = happySpecReduce_3 0# happyReduction_2 -happyReduction_2 _ - _ - _ - = HappyAbsSyn4 - (2 - ) - -happyReduce_3 = happySpecReduce_3 0# happyReduction_3 -happyReduction_3 _ - _ - _ - = HappyAbsSyn4 - (3 - ) - -happyNewToken action sts stk [] = - happyDoAction 4# (error "reading EOF!") action sts stk [] - -happyNewToken action sts stk (tk:tks) = - let cont i = happyDoAction i tk action sts stk tks in - case tk of { - Tid -> cont 1#; - Tgreater -> cont 2#; - Tand -> cont 3#; - } - -happyThen = \m k -> k m -happyReturn = \a -> a -happyThen1 = happyThen -happyReturn1 = \a tks -> a - -parser tks = happyThen (happyParse 0# tks) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll }) - -data Token = Tid | Tgreater | Tand - deriving Show - -happyError = error "parse error" - -lexer :: String -> [Token] -lexer = l - where l "" = [] - l ('\n':cs) = l cs - l ('a':'n':'d':cs) = Tand : l cs - l (c:cs) - | isSpace c = l cs - | isAlpha c = let (_,rs) = span isAlpha (c:cs) - in Tid : l rs - l ('>':cs) = Tgreater : l cs -{-# LINE 1 "GenericTemplate.hs" #-} -{-# LINE 1 "GenericTemplate.hs" #-} --- $Id: Parser.hs,v 1.1 2002/01/31 13:46:38 simonmar Exp $ - - - - - - - - - - - - - -{-# LINE 27 "GenericTemplate.hs" #-} - - - -data Happy_IntList = HappyCons Int# Happy_IntList - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -happyTrace string expr = unsafePerformIO $ do - hPutStr stderr string - return expr - - - - -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 - (happyTcHack st)) - (happyReturn1 ans) - ------------------------------------------------------------------------------ --- Arrays only: do the next action - - - -happyDoAction i tk st - = (happyTrace ("state: " ++ show (I# (st)) ++ - ",\ttoken: " ++ show (I# (i)) ++ - ",\taction: ")) $ - case action of - 0# -> (happyTrace ("fail.\n")) $ - happyFail i tk st - -1# -> (happyTrace ("accept.\n")) $ - happyAccept i tk st - n | (n <# (0# :: Int#)) -> (happyTrace ("reduce (rule " ++ show rule - ++ ")")) $ - (happyReduceArr ! rule) i tk st - where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) - n -> (happyTrace ("shift, enter state " - ++ show (I# (new_state)) - ++ "\n")) $ - happyShift new_state i tk st - where new_state = (n -# (1# :: Int#)) - where off = indexShortOffAddr happyActOffsets st - off_i = (off +# i) - check = if (off_i >=# (0# :: Int#)) - then (indexShortOffAddr happyCheck off_i ==# i) - else False - action | check = indexShortOffAddr happyTable off_i - | otherwise = indexShortOffAddr happyDefActions st - - - - - - - -indexShortOffAddr (A# arr) off = -#if __GLASGOW_HASKELL__ > 500 - narrow16Int# i -#elif __GLASGOW_HASKELL__ == 500 - intToInt16# i -#else - (i `iShiftL#` 16#) `iShiftRA#` 16# -#endif - where - i = word2Int# ((high `shiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# - - - - - - ------------------------------------------------------------------------------ --- HappyState data type (not arrays) - -{-# LINE 153 "GenericTemplate.hs" #-} - - ------------------------------------------------------------------------------ --- Shifting a token - -happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = - let i = (case x of { HappyErrorToken (I# (i)) -> i }) in --- trace "shifting the error token" $ - happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) - -happyShift new_state i tk st sts stk = - happyNewToken new_state (HappyCons (st) (sts)) ((HappyTerminal (tk))`HappyStk`stk) - --- happyReduce is specialised for the common cases. - -happySpecReduce_0 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_0 nt fn j tk st@((action)) sts stk - = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) - -happySpecReduce_1 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') - = happyGoto nt j tk st sts (fn v1 `HappyStk` stk') - -happySpecReduce_2 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') - = happyGoto nt j tk st sts (fn v1 v2 `HappyStk` stk') - -happySpecReduce_3 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') - = happyGoto nt j tk st sts (fn v1 v2 v3 `HappyStk` stk') - -happyReduce k i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyReduce k nt fn j tk st sts stk = happyGoto nt j tk st1 sts1 (fn stk) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - -happyMonadReduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonadReduce k nt fn j tk st sts stk = - happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - -happyDrop 0# l = l -happyDrop n (HappyCons (_) (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 nt j tk st = - (happyTrace (", goto state " ++ show (I# (new_state)) ++ "\n")) $ - happyDoAction j tk new_state - where off = indexShortOffAddr happyGotoOffsets st - off_i = (off +# nt) - new_state = indexShortOffAddr happyTable off_i - - - - ------------------------------------------------------------------------------ --- Error recovery (0# is the error token) - --- parse error if we are in recovery and we fail again -happyFail 0# 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 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) = --- trace ("discarding state, depth " ++ show (length stk)) $ - happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) --} - --- Enter error recovery: generate an error token, --- save the old token and carry on. -happyFail i tk (action) sts stk = --- trace "entering error recovery" $ - happyDoAction 0# tk action sts ( (HappyErrorToken (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 #-} - - ------------------------------------------------------------------------------ --- 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 happyDoAction #-} -{-# NOINLINE happyTable #-} -{-# NOINLINE happyCheck #-} -{-# NOINLINE happyActOffsets #-} -{-# NOINLINE happyGotoOffsets #-} -{-# NOINLINE happyDefActions #-} - -{-# 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. |