/hhydra/HydraParser.hs
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.