Commit 185f7693 authored by simonmar's avatar simonmar
Browse files

[project @ 2002-01-31 13:46:38 by simonmar]

Add test for GHCi w/ Happy-generated parsers.
parent 95ac9a43
#-----------------------------------------------------------------------------
# $Id: Makefile,v 1.1 2002/01/31 13:46:38 simonmar Exp $
TOP = ../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/ghci.mk
{-# 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.
:unset +s
:unset +t
:set -package lang -fglasgow-exts
:l Parser
parser (lexer "a>b")
Compiling Parser ( Parser.hs, interpreted )
state: 0, token: 1, action: shift, enter state 2
state: 2, token: 2, action: reduce (rule 1), goto state 3
state: 3, token: 2, action: shift, enter state 4
state: 4, token: 1, action: shift, enter state 2
state: 2, token: 4, action: reduce (rule 1), goto state 7
state: 7, token: 4, action: reduce (rule 2), goto state 3
state: 3, token: 4, action: accept.
___ ___ _
/ _ \ /\ /\/ __(_)
/ /_\// /_/ / / | | GHC Interactive, version 5.03, for Haskell 98.
/ /_\\/ __ / /___| | http://www.haskell.org/ghc/
\____/\/ /_/\____/|_| Type :? for help.
Loading package std ... linking ... done.
Loading package lang ... linking ... done.
Ok, modules loaded: Parser.
2
Leaving GHCi.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment