Ticket #1616: T.hs

File T.hs, 9.2 KB (added by guest, 7 years ago)
Line 
1module Main where
2
3import Data.Set
4import GHC.Exts
5import Char
6
7data Token =  TokenEOF
8           | TokenReset
9  deriving Show
10
11
12newtype Trace = Trace [Tick]
13  deriving Show
14
15
16newtype Tick = Tick (Set Sig)
17  deriving Show
18
19data Sig =  Pure String
20  deriving (Show, Eq, Ord)
21 
22
23
24
25newtype HappyAbsSyn  = HappyAbsSyn (() -> ())
26happyIn4 :: (([Sig], [Tick], [Trace])) -> (HappyAbsSyn )
27happyIn4 x = unsafeCoerce# x
28{-# INLINE happyIn4 #-}
29happyOut4 :: (HappyAbsSyn ) -> (([Sig], [Tick], [Trace]))
30happyOut4 x = unsafeCoerce# x
31{-# INLINE happyOut4 #-}
32happyIn5 :: (([Sig], [Tick], [Trace]) 
33             -> ([Sig], [Tick], [Trace])) -> (HappyAbsSyn )
34happyIn5 x = unsafeCoerce# x
35{-# INLINE happyIn5 #-}
36happyOut5 :: (HappyAbsSyn ) -> (([Sig], [Tick], [Trace]) 
37             -> ([Sig], [Tick], [Trace]))
38happyOut5 x = unsafeCoerce# x
39{-# INLINE happyOut5 #-}
40happyInTok :: Token -> (HappyAbsSyn )
41happyInTok x = unsafeCoerce# x
42{-# INLINE happyInTok #-}
43happyOutTok :: (HappyAbsSyn ) -> Token
44happyOutTok x = unsafeCoerce# x
45{-# INLINE happyOutTok #-}
46
47type HappyReduction m = 
48           Int# 
49        -> (Token)
50        -> HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)
51        -> [HappyState (Token) (HappyStk HappyAbsSyn -> [(Token)] -> m HappyAbsSyn)] 
52        -> HappyStk HappyAbsSyn 
53        -> [(Token)] -> m HappyAbsSyn
54
55action_0,
56 action_1,
57 action_2,
58 action_3,
59 action_4,
60 action_5,
61 action_6 :: () => Int# -> HappyReduction (HappyIdentity)
62
63happyReduce_1,
64 happyReduce_2,
65 happyReduce_3 :: () => HappyReduction (HappyIdentity)
66
67action_0 (6#) = happyShift action_2
68action_0 (7#) = happyShift action_5
69action_0 (4#) = happyGoto action_3
70action_0 (5#) = happyGoto action_4
71action_0 x = happyTcHack x happyFail
72
73action_1 (6#) = happyShift action_2
74action_1 x = happyTcHack x happyFail
75
76action_2 x = happyTcHack x happyReduce_1
77
78action_3 (8#) = happyAccept
79action_3 x = happyTcHack x happyFail
80
81action_4 (6#) = happyShift action_2
82action_4 (7#) = happyShift action_5
83action_4 (4#) = happyGoto action_6
84action_4 (5#) = happyGoto action_4
85action_4 x = happyTcHack x happyFail
86
87action_5 x = happyTcHack x happyReduce_3
88
89action_6 x = happyTcHack x happyReduce_2
90
91happyReduce_1 = happySpecReduce_1 4# happyReduction_1
92happyReduction_1 happy_x_1
93         =  happyIn4
94                 (( [], [], [])
95        )
96
97happyReduce_2 = happySpecReduce_2 4# happyReduction_2
98happyReduction_2 happy_x_2
99        happy_x_1
100         =  case happyOut5 happy_x_1 of { happy_var_1 -> 
101        case happyOut4 happy_x_2 of { happy_var_2 -> 
102        happyIn4
103                 (happy_var_1 happy_var_2
104        )}}
105
106happyReduce_3 = happySpecReduce_1 5# happyReduction_3
107happyReduction_3 happy_x_1
108         =  happyIn5
109                 (\x -> let{(si,  t, ts)= x;
110                                    si' = fromList si;
111                                    t'= [Tick si' ] ++ t
112                                   }in ([],[], (Trace t'):ts)
113        )
114
115happyNewToken action sts stk [] =
116        action 8# 8# (error "reading EOF!") (HappyState action) sts stk []
117
118happyNewToken action sts stk (tk:tks) =
119        let cont i = action i i tk (HappyState action) sts stk tks in
120        case tk of {
121        TokenEOF -> cont 6#;
122        TokenReset -> cont 7#;
123        _ -> happyError' (tk:tks)
124        }
125
126happyError_ tk tks = happyError' (tk:tks)
127
128newtype HappyIdentity a = HappyIdentity a
129happyIdentity = HappyIdentity
130happyRunIdentity (HappyIdentity a) = a
131
132instance Monad HappyIdentity where
133    return = HappyIdentity
134    (HappyIdentity p) >>= q = q p
135
136happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b
137happyThen = (>>=)
138happyReturn :: () => a -> HappyIdentity a
139happyReturn = (return)
140happyThen1 m k tks = (>>=) m (\a -> k a tks)
141happyReturn1 :: () => a -> b -> HappyIdentity a
142happyReturn1 = \a tks -> (return) a
143happyError' :: () => [Token] -> HappyIdentity a
144happyError' = HappyIdentity . happyError
145
146parse tks = happyRunIdentity happySomeParser where
147  happySomeParser = happyThen (happyParse action_0 tks) (\x -> happyReturn (happyOut4 x))
148
149happySeq = happyDoSeq
150
151happyError :: [Token]->a
152happyError [] = error ("Unespected end of tokens")
153happyError (s:ss) = error ("Parse error at :\n" ++ (show s))
154
155
156
157infixr 9 `HappyStk`
158data HappyStk a = HappyStk a (HappyStk a)
159
160-----------------------------------------------------------------------------
161-- starting the parse
162
163happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
164
165-----------------------------------------------------------------------------
166-- Accepting the parse
167
168-- If the current token is 1#, it means we've just accepted a partial
169-- parse (a %partial parser).  We must ignore the saved token on the top of
170-- the stack in this case.
171happyAccept 1# tk st sts (_ `HappyStk` ans `HappyStk` _) =
172        happyReturn1 ans
173happyAccept j tk st sts (HappyStk ans _) = 
174        (happyTcHack j ) (happyReturn1 ans)
175
176-----------------------------------------------------------------------------
177-- Arrays only: do the next action
178
179{-# LINE 155 "GenericTemplate.hs" #-}
180
181-----------------------------------------------------------------------------
182-- HappyState data type (not arrays)
183
184
185
186newtype HappyState b c = HappyState
187        (Int# ->                    -- token number
188         Int# ->                    -- token number (yes, again)
189         b ->                           -- token semantic value
190         HappyState b c ->              -- current state
191         [HappyState b c] ->            -- state stack
192         c)
193
194
195
196-----------------------------------------------------------------------------
197-- Shifting a token
198
199happyShift new_state 1# tk st sts stk@(x `HappyStk` _) =
200     let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in
201--     trace "shifting the error token" $
202     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)
203
204happyShift new_state i tk st sts stk =
205     happyNewToken new_state ((st):(sts)) ((happyInTok (tk))`HappyStk`stk)
206
207-- happyReduce is specialised for the common cases.
208
209happySpecReduce_0 i fn 1# tk st sts stk
210     = happyFail 1# tk st sts stk
211happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk
212     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)
213
214happySpecReduce_1 i fn 1# tk st sts stk
215     = happyFail 1# tk st sts stk
216happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')
217     = let r = fn v1 in
218       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
219
220happySpecReduce_2 i fn 1# tk st sts stk
221     = happyFail 1# tk st sts stk
222happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')
223     = let r = fn v1 v2 in
224       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
225
226happySpecReduce_3 i fn 1# tk st sts stk
227     = happyFail 1# tk st sts stk
228happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
229     = let r = fn v1 v2 v3 in
230       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
231
232happyReduce k i fn 1# tk st sts stk
233     = happyFail 1# tk st sts stk
234happyReduce k nt fn j tk st sts stk
235     = case happyDrop (k -# (1# :: Int#)) sts of
236         sts1@(((st1@(HappyState (action))):(_))) ->
237                let r = fn stk in  -- it doesn't hurt to always seq here...
238                happyDoSeq r (action nt j tk st1 sts1 r)
239
240happyMonadReduce k nt fn 1# tk st sts stk
241     = happyFail 1# tk st sts stk
242happyMonadReduce k nt fn j tk st sts stk =
243        happyThen1 (fn stk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))
244       where sts1@(((st1@(HappyState (action))):(_))) = happyDrop k ((st):(sts))
245             drop_stk = happyDropStk k stk
246
247happyDrop 0# l = l
248happyDrop n ((_):(t)) = happyDrop (n -# (1# :: Int#)) t
249
250happyDropStk 0# l = l
251happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs
252
253-----------------------------------------------------------------------------
254-- Moving to a new state after a reduction
255
256{-# LINE 239 "GenericTemplate.hs" #-}
257happyGoto action j tk st = action j j tk (HappyState action)
258
259
260-----------------------------------------------------------------------------
261-- Error recovery (1# is the error token)
262
263-- parse error if we are in recovery and we fail again
264happyFail  1# tk old_st _ stk =
265--      trace "failing" $
266        happyError_ tk
267
268-- Enter error recovery: generate an error token,
269--                       save the old token and carry on.
270happyFail  i tk (HappyState (action)) sts stk =
271--      trace "entering error recovery" $
272        action 1# 1# tk (HappyState (action)) sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)
273
274-- Internal happy errors:
275
276notHappyAtAll = error "Internal Happy error\n"
277
278-----------------------------------------------------------------------------
279-- Hack to get the typechecker to accept our action functions
280
281
282happyTcHack :: Int# -> a -> a
283happyTcHack x y = y
284{-# INLINE happyTcHack #-}
285
286
287-----------------------------------------------------------------------------
288-- Seq-ing.  If the --strict flag is given, then Happy emits
289--      happySeq = happyDoSeq
290-- otherwise it emits
291--      happySeq = happyDontSeq
292
293happyDoSeq, happyDontSeq :: a -> b -> b
294happyDoSeq   a b = a `seq` b
295happyDontSeq a b = b
296-----------------------------------------------------------------------------
297-- Don't inline any functions from the template.  GHC has a nasty habit
298-- of deciding to inline happyGoto everywhere, which increases the size of
299-- the generated parser quite a bit.
300{-# NOINLINE happySpecReduce_1 #-}
301
302
303
304main :: IO()
305main = do (putStrLn.show.parse) [TokenReset, TokenEOF]
306
307