PageRenderTime 25ms CodeModel.GetById 9ms app.highlight 11ms RepoModel.GetById 1ms app.codeStats 0ms

/hhydra/HydraParser.hs

http://hhydra.googlecode.com/
Haskell | 422 lines | 217 code | 107 blank | 98 comment | 0 complexity | a0b7d4a8379681eea0f7e6b438e94f90 MD5 | raw file
  1{-
  2Copyright (c) 2007, Enrico Franchi
  3All rights reserved.
  4
  5Redistribution and use in source and binary forms, with or without
  6modification, are permitted provided that the following conditions are
  7met:
  81) Redistributions of source code must retain the above copyright
  9notice, this list of conditions and the following disclaimer.
 102) Redistributions in binary form must reproduce the above copyright
 11notice, this list of conditions and the following disclaimer in the
 12documentation and/or other materials provided with the distribution.
 133) Neither my name nor the names of its contributors may be used to
 14endorse or promote products derived from this software without specific
 15prior written permission.
 16
 17THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
 18IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 19TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
 20PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
 21OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 22EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 23PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 24PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 25LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 26NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 27SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 28-}
 29module HydraParser
 30    where
 31
 32import Hydra
 33
 34-- parser produced by Happy Version 1.16
 35
 36data HappyAbsSyn t4 t5 t6 t7 t8
 37	= HappyTerminal Token
 38	| HappyErrorToken Int
 39	| HappyAbsSyn4 t4
 40	| HappyAbsSyn5 t5
 41	| HappyAbsSyn6 t6
 42	| HappyAbsSyn7 t7
 43	| HappyAbsSyn8 t8
 44
 45action_0 (9) = happyShift action_4
 46action_0 (4) = happyGoto action_3
 47action_0 _ = happyFail
 48
 49action_1 (9) = happyShift action_2
 50action_1 _ = happyFail
 51
 52action_2 (10) = happyShift action_9
 53action_2 _ = happyFail
 54
 55action_3 (11) = happyAccept
 56action_3 _ = happyFail
 57
 58action_4 (9) = happyShift action_8
 59action_4 (10) = happyShift action_9
 60action_4 (5) = happyGoto action_5
 61action_4 (6) = happyGoto action_6
 62action_4 (8) = happyGoto action_7
 63action_4 _ = happyFail
 64
 65action_5 (9) = happyShift action_8
 66action_5 (5) = happyGoto action_5
 67action_5 (6) = happyGoto action_6
 68action_5 (7) = happyGoto action_15
 69action_5 (8) = happyGoto action_14
 70action_5 _ = happyReduce_5
 71
 72action_6 (9) = happyShift action_8
 73action_6 (5) = happyGoto action_5
 74action_6 (6) = happyGoto action_6
 75action_6 (7) = happyGoto action_13
 76action_6 (8) = happyGoto action_14
 77action_6 _ = happyReduce_5
 78
 79action_7 (10) = happyShift action_12
 80action_7 _ = happyFail
 81
 82action_8 (9) = happyShift action_8
 83action_8 (10) = happyShift action_11
 84action_8 (5) = happyGoto action_5
 85action_8 (6) = happyGoto action_6
 86action_8 (8) = happyGoto action_10
 87action_8 _ = happyFail
 88
 89action_9 _ = happyReduce_1
 90
 91action_10 (10) = happyShift action_16
 92action_10 _ = happyFail
 93
 94action_11 _ = happyReduce_3
 95
 96action_12 _ = happyReduce_2
 97
 98action_13 _ = happyReduce_7
 99
100action_14 _ = happyReduce_6
101
102action_15 _ = happyReduce_8
103
104action_16 _ = happyReduce_4
105
106happyReduce_1 = happySpecReduce_2  4 happyReduction_1
107happyReduction_1 _
108	_
109	 =  HappyAbsSyn4
110		 (Root []
111	)
112
113happyReduce_2 = happySpecReduce_3  4 happyReduction_2
114happyReduction_2 _
115	(HappyAbsSyn8  happy_var_2)
116	_
117	 =  HappyAbsSyn4
118		 (Root happy_var_2
119	)
120happyReduction_2 _ _ _  = notHappyAtAll 
121
122happyReduce_3 = happySpecReduce_2  5 happyReduction_3
123happyReduction_3 _
124	_
125	 =  HappyAbsSyn5
126		 (Head 0 0
127	)
128
129happyReduce_4 = happySpecReduce_3  6 happyReduction_4
130happyReduction_4 _
131	(HappyAbsSyn8  happy_var_2)
132	_
133	 =  HappyAbsSyn6
134		 (Body 0 0 happy_var_2
135	)
136happyReduction_4 _ _ _  = notHappyAtAll 
137
138happyReduce_5 = happySpecReduce_0  7 happyReduction_5
139happyReduction_5  =  HappyAbsSyn7
140		 ([]
141	)
142
143happyReduce_6 = happySpecReduce_1  7 happyReduction_6
144happyReduction_6 (HappyAbsSyn8  happy_var_1)
145	 =  HappyAbsSyn7
146		 (happy_var_1
147	)
148happyReduction_6 _  = notHappyAtAll 
149
150happyReduce_7 = happySpecReduce_2  8 happyReduction_7
151happyReduction_7 (HappyAbsSyn7  happy_var_2)
152	(HappyAbsSyn6  happy_var_1)
153	 =  HappyAbsSyn8
154		 (happy_var_1:happy_var_2
155	)
156happyReduction_7 _ _  = notHappyAtAll 
157
158happyReduce_8 = happySpecReduce_2  8 happyReduction_8
159happyReduction_8 (HappyAbsSyn7  happy_var_2)
160	(HappyAbsSyn5  happy_var_1)
161	 =  HappyAbsSyn8
162		 (happy_var_1:happy_var_2
163	)
164happyReduction_8 _ _  = notHappyAtAll 
165
166happyNewToken action sts stk [] =
167	action 11 11 notHappyAtAll (HappyState action) sts stk []
168
169happyNewToken action sts stk (tk:tks) =
170	let cont i = action i i tk (HappyState action) sts stk tks in
171	case tk of {
172	LParen -> cont 9;
173	RParen -> cont 10;
174	_ -> happyError' (tk:tks)
175	}
176
177happyError_ tk tks = happyError' (tk:tks)
178
179newtype HappyIdentity a = HappyIdentity a
180happyIdentity = HappyIdentity
181happyRunIdentity (HappyIdentity a) = a
182
183instance Monad HappyIdentity where
184    return = HappyIdentity
185    (HappyIdentity p) >>= q = q p
186
187happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b
188happyThen = (>>=)
189happyReturn :: () => a -> HappyIdentity a
190happyReturn = (return)
191happyThen1 m k tks = (>>=) m (\a -> k a tks)
192happyReturn1 :: () => a -> b -> HappyIdentity a
193happyReturn1 = \a tks -> (return) a
194happyError' :: () => [Token] -> HappyIdentity a
195happyError' = HappyIdentity . parseError
196
197parse tks = happyRunIdentity happySomeParser where
198  happySomeParser = happyThen (happyParse action_0 tks) (\x -> case x of {HappyAbsSyn4 z -> happyReturn z; _other -> notHappyAtAll })
199
200happySeq = happyDontSeq
201
202
203parseError :: [Token] -> a
204parseError _ = error "Parse error"
205
206data Token = RParen | LParen
207             deriving (Eq, Show)
208
209type TokenStream = [Token]
210
211tokenize :: [Char] -> [Token]
212tokenize [] = []
213tokenize ('(':cs) = (LParen : tokenize cs)
214tokenize (')':cs) = (RParen : tokenize cs)
215tokenize (c:cs)   = tokenize cs
216
217
218-- hydra :: String -> Hydra a b
219hydra = parse . tokenize
220{-# LINE 1 "GenericTemplate.hs" #-}
221{-# LINE 1 "<built-in>" #-}
222{-# LINE 1 "<command line>" #-}
223{-# LINE 1 "GenericTemplate.hs" #-}
224-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp 
225
226{-# LINE 28 "GenericTemplate.hs" #-}
227
228
229
230
231
232
233
234
235{-# LINE 49 "GenericTemplate.hs" #-}
236
237{-# LINE 59 "GenericTemplate.hs" #-}
238
239{-# LINE 68 "GenericTemplate.hs" #-}
240
241infixr 9 `HappyStk`
242data HappyStk a = HappyStk a (HappyStk a)
243
244-----------------------------------------------------------------------------
245-- starting the parse
246
247happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
248
249-----------------------------------------------------------------------------
250-- Accepting the parse
251
252-- If the current token is (1), it means we've just accepted a partial
253-- parse (a %partial parser).  We must ignore the saved token on the top of
254-- the stack in this case.
255happyAccept (1) tk st sts (_ `HappyStk` ans `HappyStk` _) =
256	happyReturn1 ans
257happyAccept j tk st sts (HappyStk ans _) = 
258	 (happyReturn1 ans)
259
260-----------------------------------------------------------------------------
261-- Arrays only: do the next action
262
263{-# LINE 155 "GenericTemplate.hs" #-}
264
265-----------------------------------------------------------------------------
266-- HappyState data type (not arrays)
267
268
269
270newtype HappyState b c = HappyState
271        (Int ->                    -- token number
272         Int ->                    -- token number (yes, again)
273         b ->                           -- token semantic value
274         HappyState b c ->              -- current state
275         [HappyState b c] ->            -- state stack
276         c)
277
278
279
280-----------------------------------------------------------------------------
281-- Shifting a token
282
283happyShift new_state (1) tk st sts stk@(x `HappyStk` _) =
284     let i = (case x of { HappyErrorToken (i) -> i }) in
285--     trace "shifting the error token" $
286     new_state i i tk (HappyState (new_state)) ((st):(sts)) (stk)
287
288happyShift new_state i tk st sts stk =
289     happyNewToken new_state ((st):(sts)) ((HappyTerminal (tk))`HappyStk`stk)
290
291-- happyReduce is specialised for the common cases.
292
293happySpecReduce_0 i fn (1) tk st sts stk
294     = happyFail (1) tk st sts stk
295happySpecReduce_0 nt fn j tk st@((HappyState (action))) sts stk
296     = action nt j tk st ((st):(sts)) (fn `HappyStk` stk)
297
298happySpecReduce_1 i fn (1) tk st sts stk
299     = happyFail (1) tk st sts stk
300happySpecReduce_1 nt fn j tk _ sts@(((st@(HappyState (action))):(_))) (v1`HappyStk`stk')
301     = let r = fn v1 in
302       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
303
304happySpecReduce_2 i fn (1) tk st sts stk
305     = happyFail (1) tk st sts stk
306happySpecReduce_2 nt fn j tk _ ((_):(sts@(((st@(HappyState (action))):(_))))) (v1`HappyStk`v2`HappyStk`stk')
307     = let r = fn v1 v2 in
308       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
309
310happySpecReduce_3 i fn (1) tk st sts stk
311     = happyFail (1) tk st sts stk
312happySpecReduce_3 nt fn j tk _ ((_):(((_):(sts@(((st@(HappyState (action))):(_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
313     = let r = fn v1 v2 v3 in
314       happySeq r (action nt j tk st sts (r `HappyStk` stk'))
315
316happyReduce k i fn (1) tk st sts stk
317     = happyFail (1) tk st sts stk
318happyReduce k nt fn j tk st sts stk
319     = case happyDrop (k - ((1) :: Int)) sts of
320	 sts1@(((st1@(HappyState (action))):(_))) ->
321        	let r = fn stk in  -- it doesn't hurt to always seq here...
322       		happyDoSeq r (action nt j tk st1 sts1 r)
323
324happyMonadReduce k nt fn (1) tk st sts stk
325     = happyFail (1) tk st sts stk
326happyMonadReduce k nt fn j tk st sts stk =
327        happyThen1 (fn stk tk) (\r -> action nt j tk st1 sts1 (r `HappyStk` drop_stk))
328       where sts1@(((st1@(HappyState (action))):(_))) = happyDrop k ((st):(sts))
329             drop_stk = happyDropStk k stk
330
331happyMonad2Reduce k nt fn (1) tk st sts stk
332     = happyFail (1) tk st sts stk
333happyMonad2Reduce k nt fn j tk st sts stk =
334       happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
335       where sts1@(((st1@(HappyState (action))):(_))) = happyDrop k ((st):(sts))
336             drop_stk = happyDropStk k stk
337
338
339
340
341
342             new_state = action
343
344
345happyDrop (0) l = l
346happyDrop n ((_):(t)) = happyDrop (n - ((1) :: Int)) t
347
348happyDropStk (0) l = l
349happyDropStk n (x `HappyStk` xs) = happyDropStk (n - ((1)::Int)) xs
350
351-----------------------------------------------------------------------------
352-- Moving to a new state after a reduction
353
354{-# LINE 253 "GenericTemplate.hs" #-}
355happyGoto action j tk st = action j j tk (HappyState action)
356
357
358-----------------------------------------------------------------------------
359-- Error recovery ((1) is the error token)
360
361-- parse error if we are in recovery and we fail again
362happyFail  (1) tk old_st _ stk =
363--	trace "failing" $ 
364    	happyError_ tk
365
366{-  We don't need state discarding for our restricted implementation of
367    "error".  In fact, it can cause some bogus parses, so I've disabled it
368    for now --SDM
369
370-- discard a state
371happyFail  (1) tk old_st (((HappyState (action))):(sts)) 
372						(saved_tok `HappyStk` _ `HappyStk` stk) =
373--	trace ("discarding state, depth " ++ show (length stk))  $
374	action (1) (1) tk (HappyState (action)) sts ((saved_tok`HappyStk`stk))
375-}
376
377-- Enter error recovery: generate an error token,
378--                       save the old token and carry on.
379happyFail  i tk (HappyState (action)) sts stk =
380--      trace "entering error recovery" $
381	action (1) (1) tk (HappyState (action)) sts ( (HappyErrorToken (i)) `HappyStk` stk)
382
383-- Internal happy errors:
384
385notHappyAtAll = error "Internal Happy error\n"
386
387-----------------------------------------------------------------------------
388-- Hack to get the typechecker to accept our action functions
389
390
391
392
393
394
395
396-----------------------------------------------------------------------------
397-- Seq-ing.  If the --strict flag is given, then Happy emits 
398--	happySeq = happyDoSeq
399-- otherwise it emits
400-- 	happySeq = happyDontSeq
401
402happyDoSeq, happyDontSeq :: a -> b -> b
403happyDoSeq   a b = a `seq` b
404happyDontSeq a b = b
405
406-----------------------------------------------------------------------------
407-- Don't inline any functions from the template.  GHC has a nasty habit
408-- of deciding to inline happyGoto everywhere, which increases the size of
409-- the generated parser quite a bit.
410
411{-# LINE 317 "GenericTemplate.hs" #-}
412{-# NOINLINE happyShift #-}
413{-# NOINLINE happySpecReduce_0 #-}
414{-# NOINLINE happySpecReduce_1 #-}
415{-# NOINLINE happySpecReduce_2 #-}
416{-# NOINLINE happySpecReduce_3 #-}
417{-# NOINLINE happyReduce #-}
418{-# NOINLINE happyMonadReduce #-}
419{-# NOINLINE happyGoto #-}
420{-# NOINLINE happyFail #-}
421
422-- end of Happy Template.