1 {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} 2 {-# OPTIONS -fglasgow-exts -cpp #-} 3 {-# LANGUAGE NoMonomorphismRestriction #-} 4 {-# OPTIONS -fno-warn-incomplete-patterns -fno-warn-missing-signatures #-} 5 6 module Text.RegExp.Parser ( parse ) where 7 8 import Text.RegExp.Data 9 ( eps, char, psym, anySym, alt, seq_, rep, rep1, opt, brep ) 10 11 import Data.Char ( isSpace, toLower, isAlphaNum, isDigit ) 12 import qualified Data.Array as Happy_Data_Array 13 import qualified GHC.Exts as Happy_GHC_Exts 14 15 -- parser produced by Happy Version 1.18.5 16 17 newtype HappyAbsSyn t4 = HappyAbsSyn HappyAny 18 #if __GLASGOW_HASKELL__ >= 607 19 type HappyAny = Happy_GHC_Exts.Any 20 #else 21 type HappyAny = forall a . a 22 #endif 23 happyIn4 :: t4 -> (HappyAbsSyn t4) 24 happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x 25 {-# INLINE happyIn4 #-} 26 happyOut4 :: (HappyAbsSyn t4) -> t4 27 happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x 28 {-# INLINE happyOut4 #-} 29 happyInTok :: (Token) -> (HappyAbsSyn t4) 30 happyInTok x = Happy_GHC_Exts.unsafeCoerce# x 31 {-# INLINE happyInTok #-} 32 happyOutTok :: (HappyAbsSyn t4) -> (Token) 33 happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x 34 {-# INLINE happyOutTok #-} 35 36 37 happyActOffsets :: HappyAddr 38 happyActOffsets = HappyA# "\x04\x00\x00\x00\xff\xff\x00\x00\x04\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x04\x00\x04\x00\x00\x00\x00\x00\x00\x00\x16\x00\x19\x00\x00\x00\x00\x00"# 39 40 happyGotoOffsets :: HappyAddr 41 happyGotoOffsets = HappyA# "\x13\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# 42 43 happyDefActions :: HappyAddr 44 happyDefActions = HappyA# "\xfe\xff\x00\x00\x00\x00\xfd\xff\xfe\xff\xf5\xff\xf4\xff\x00\x00\xfc\xff\xfe\xff\xfe\xff\xf8\xff\xf7\xff\xf6\xff\xfa\xff\xfb\xff\xf9\xff"# 45 46 happyCheck :: HappyAddr 47 happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x04\x00\xff\xff\x01\x00\x07\x00\x08\x00\x09\x00\x05\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x0a\x00\x0b\x00\x02\x00\x03\x00\x04\x00\x00\x00\x06\x00\x07\x00\x08\x00\x09\x00\x02\x00\x03\x00\x04\x00\x02\x00\x03\x00\x07\x00\x08\x00\x09\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\xff\xff"# 48 49 happyTable :: HappyAddr 50 happyTable = HappyA# "\x00\x00\x09\x00\x0a\x00\x0b\x00\x00\x00\x04\x00\x0c\x00\x0d\x00\x0e\x00\x05\x00\x0e\x00\xff\xff\x0f\x00\x07\x00\x06\x00\x07\x00\x09\x00\x0a\x00\x0b\x00\x02\x00\x11\x00\x0c\x00\x0d\x00\x0e\x00\x09\x00\x0a\x00\x0b\x00\x09\x00\x0a\x00\x0c\x00\x0d\x00\x0e\x00\x0c\x00\x0d\x00\x0e\x00\x00\x00\x00\x00\x00\x00"# 51 52 happyReduceArr = Happy_Data_Array.array (1, 11) [ 53 (1 , happyReduce_1), 54 (2 , happyReduce_2), 55 (3 , happyReduce_3), 56 (4 , happyReduce_4), 57 (5 , happyReduce_5), 58 (6 , happyReduce_6), 59 (7 , happyReduce_7), 60 (8 , happyReduce_8), 61 (9 , happyReduce_9), 62 (10 , happyReduce_10), 63 (11 , happyReduce_11) 64 ] 65 66 happy_n_terms = 13 :: Int 67 happy_n_nonterms = 1 :: Int 68 69 happyReduce_1 = happySpecReduce_0 0# happyReduction_1 70 happyReduction_1 = happyIn4 71 (eps 72 ) 73 74 happyReduce_2 = happySpecReduce_1 0# happyReduction_2 75 happyReduction_2 happy_x_1 76 = case happyOutTok happy_x_1 of { (Sym happy_var_1) -> 77 happyIn4 78 (char happy_var_1 79 )} 80 81 happyReduce_3 = happySpecReduce_2 0# happyReduction_3 82 happyReduction_3 happy_x_2 83 happy_x_1 84 = case happyOut4 happy_x_1 of { happy_var_1 -> 85 happyIn4 86 (rep happy_var_1 87 )} 88 89 happyReduce_4 = happySpecReduce_3 0# happyReduction_4 90 happyReduction_4 happy_x_3 91 happy_x_2 92 happy_x_1 93 = case happyOut4 happy_x_1 of { happy_var_1 -> 94 case happyOut4 happy_x_3 of { happy_var_3 -> 95 happyIn4 96 (seq_ happy_var_1 happy_var_3 97 )}} 98 99 happyReduce_5 = happySpecReduce_3 0# happyReduction_5 100 happyReduction_5 happy_x_3 101 happy_x_2 102 happy_x_1 103 = case happyOut4 happy_x_1 of { happy_var_1 -> 104 case happyOut4 happy_x_3 of { happy_var_3 -> 105 happyIn4 106 (alt happy_var_1 happy_var_3 107 )}} 108 109 happyReduce_6 = happySpecReduce_3 0# happyReduction_6 110 happyReduction_6 happy_x_3 111 happy_x_2 112 happy_x_1 113 = case happyOut4 happy_x_2 of { happy_var_2 -> 114 happyIn4 115 (happy_var_2 116 )} 117 118 happyReduce_7 = happySpecReduce_2 0# happyReduction_7 119 happyReduction_7 happy_x_2 120 happy_x_1 121 = case happyOut4 happy_x_1 of { happy_var_1 -> 122 happyIn4 123 (rep1 happy_var_1 124 )} 125 126 happyReduce_8 = happySpecReduce_2 0# happyReduction_8 127 happyReduction_8 happy_x_2 128 happy_x_1 129 = case happyOut4 happy_x_1 of { happy_var_1 -> 130 happyIn4 131 (opt happy_var_1 132 )} 133 134 happyReduce_9 = happySpecReduce_2 0# happyReduction_9 135 happyReduction_9 happy_x_2 136 happy_x_1 137 = case happyOut4 happy_x_1 of { happy_var_1 -> 138 case happyOutTok happy_x_2 of { (Bnd happy_var_2) -> 139 happyIn4 140 (brep happy_var_2 happy_var_1 141 )}} 142 143 happyReduce_10 = happySpecReduce_1 0# happyReduction_10 144 happyReduction_10 happy_x_1 145 = case happyOutTok happy_x_1 of { (Cls happy_var_1) -> 146 happyIn4 147 (uncurry psym happy_var_1 148 )} 149 150 happyReduce_11 = happySpecReduce_1 0# happyReduction_11 151 happyReduction_11 happy_x_1 152 = happyIn4 153 (anySym 154 ) 155 156 happyNewToken action sts stk [] = 157 happyDoAction 12# notHappyAtAll action sts stk [] 158 159 happyNewToken action sts stk (tk:tks) = 160 let cont i = happyDoAction i tk action sts stk tks in 161 case tk of { 162 Sym happy_dollar_dollar -> cont 1#; 163 Ast -> cont 2#; 164 Seq -> cont 3#; 165 Bar -> cont 4#; 166 L -> cont 5#; 167 R -> cont 6#; 168 Pls -> cont 7#; 169 Que -> cont 8#; 170 Bnd happy_dollar_dollar -> cont 9#; 171 Cls happy_dollar_dollar -> cont 10#; 172 Dot -> cont 11#; 173 _ -> happyError' (tk:tks) 174 } 175 176 happyError_ tk tks = happyError' (tk:tks) 177 178 newtype HappyIdentity a = HappyIdentity a 179 happyIdentity = HappyIdentity 180 happyRunIdentity (HappyIdentity a) = a 181 182 instance Monad HappyIdentity where 183 return = HappyIdentity 184 (HappyIdentity p) >>= q = q p 185 186 happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b 187 happyThen = (>>=) 188 happyReturn :: () => a -> HappyIdentity a 189 happyReturn = (return) 190 happyThen1 m k tks = (>>=) m (\a -> k a tks) 191 happyReturn1 :: () => a -> b -> HappyIdentity a 192 happyReturn1 = \a tks -> (return) a 193 happyError' :: () => [(Token)] -> HappyIdentity a 194 happyError' = HappyIdentity . parseError 195 196 parseTokens tks = happyRunIdentity happySomeParser where 197 happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) 198 199 happySeq = happyDontSeq 200 201 202 parse = parseTokens . scan 203 204 data Token = Seq | Sym Char | Ast | Bar | L | R 205 | Pls | Que | Bnd (Int,Int) 206 | Cls (String,Char -> Bool) | Dot 207 208 209 token :: Char -> Token 210 token '*' = Ast 211 token '|' = Bar 212 token '(' = L 213 token ')' = R 214 token '?' = Que 215 token '+' = Pls 216 token '.' = Dot 217 token c = Sym c 218 219 scan :: String -> [Token] 220 scan = insertSeqs . process 221 222 insertSeqs :: [Token] -> [Token] 223 insertSeqs [] = [] 224 insertSeqs [t] = [t] 225 insertSeqs (a:ts@(b:_)) 226 | lseq a && rseq b = a : Seq : insertSeqs ts 227 | otherwise = a : insertSeqs ts 228 229 lseq :: Token -> Bool 230 lseq Bar = False 231 lseq L = False 232 lseq _ = True 233 234 rseq :: Token -> Bool 235 rseq (Sym _) = True 236 rseq L = True 237 rseq (Cls _) = True 238 rseq Dot = True 239 rseq _ = False 240 241 process :: String -> [Token] 242 process [] = [] 243 244 process ('\\':c:cs) = Cls (['\\',c],symClassPred c) : process cs 245 246 process ('{':cs) = case reads cs of 247 (n,'}':s1) : _ -> Bnd (n,n) : process s1 248 (n,',':s1) : _ -> 249 case reads s1 of 250 (m,'}':s2) : _ -> Bnd (n,m) : process s2 251 _ -> token '{' : process cs 252 _ -> token '{' : process cs 253 254 process ('[':'^':cs) = Cls (('[':'^':s),not.p) : process xs 255 where (s,p,xs) = processCls cs 256 257 process ('[' :cs) = Cls ('[':s,p) : process xs 258 where (s,p,xs) = processCls cs 259 260 process (c:cs) = token c : process cs 261 262 processCls :: String -> (String, Char -> Bool, String) 263 264 processCls [] = parseError [] 265 266 processCls (']':cs) = ("]", const False, cs) 267 268 processCls ('\\':c:cs) 269 | isSymClassChar c = ('\\':c:s, \x -> symClassPred c x || p x, xs) 270 where (s,p,xs) = processCls cs 271 272 processCls ('\\':c:cs) = ('\\':c:s, \x -> x==c || p x, xs) 273 where (s,p,xs) = processCls cs 274 275 processCls (c:'-':e:cs) | e /= ']' 276 = (c:'-':e:s, \d -> (c<=d && d<=e) || p d, xs) 277 where (s,p,xs) = processCls cs 278 279 processCls (c:cs) = (c:s, \b -> b==c || p b, xs) 280 where (s,p,xs) = processCls cs 281 282 isSymClassChar :: Char -> Bool 283 isSymClassChar = (`elem`"wWdDsS") 284 285 symClassPred :: Char -> Char -> Bool 286 symClassPred 'w' = isWordChar 287 symClassPred 'd' = isDigit 288 symClassPred 's' = isSpace 289 symClassPred 'W' = not . isWordChar 290 symClassPred 'D' = not . isDigit 291 symClassPred 'S' = not . isSpace 292 symClassPred c = (c==) 293 294 isWordChar :: Char -> Bool 295 isWordChar c = c == '_' || isAlphaNum c 296 297 parseError :: [Token] -> a 298 parseError _ = error "cannot parse regular expression" 299 {-# LINE 1 "templates/GenericTemplate.hs" #-} 300 {-# LINE 1 "templates/GenericTemplate.hs" #-} 301 {-# LINE 1 "<built-in>" #-} 302 {-# LINE 1 "<command line>" #-} 303 {-# LINE 1 "templates/GenericTemplate.hs" #-} 304 -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp 305 306 {-# LINE 30 "templates/GenericTemplate.hs" #-} 307 308 309 data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList 310 311 312 313 314 315 {-# LINE 51 "templates/GenericTemplate.hs" #-} 316 317 {-# LINE 61 "templates/GenericTemplate.hs" #-} 318 319 {-# LINE 70 "templates/GenericTemplate.hs" #-} 320 321 infixr 9 `HappyStk` 322 data HappyStk a = HappyStk a (HappyStk a) 323 324 ----------------------------------------------------------------------------- 325 -- starting the parse 326 327 happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll 328 329 ----------------------------------------------------------------------------- 330 -- Accepting the parse 331 332 -- If the current token is 0#, it means we've just accepted a partial 333 -- parse (a %partial parser). We must ignore the saved token on the top of 334 -- the stack in this case. 335 happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = 336 happyReturn1 ans 337 happyAccept j tk st sts (HappyStk ans _) = 338 (happyTcHack j (happyTcHack st)) (happyReturn1 ans) 339 340 ----------------------------------------------------------------------------- 341 -- Arrays only: do the next action 342 343 344 345 happyDoAction i tk st 346 = {- nothing -} 347 348 349 case action of 350 0# -> {- nothing -} 351 happyFail i tk st 352 -1# -> {- nothing -} 353 happyAccept i tk st 354 n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- nothing -} 355 356 (happyReduceArr Happy_Data_Array.! rule) i tk st 357 where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) 358 n -> {- nothing -} 359 360 361 happyShift new_state i tk st 362 where !(new_state) = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) 363 where !(off) = indexShortOffAddr happyActOffsets st 364 !(off_i) = (off Happy_GHC_Exts.+# i) 365 check = if (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#)) 366 then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) 367 else False 368 !(action) 369 | check = indexShortOffAddr happyTable off_i 370 | otherwise = indexShortOffAddr happyDefActions st 371 372 {-# LINE 130 "templates/GenericTemplate.hs" #-} 373 374 375 indexShortOffAddr (HappyA# arr) off = 376 Happy_GHC_Exts.narrow16Int# i 377 where 378 !i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) 379 !high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) 380 !low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) 381 !off' = off Happy_GHC_Exts.*# 2# 382 383 384 385 386 387 data HappyAddr = HappyA# Happy_GHC_Exts.Addr# 388 389 390 391 392 ----------------------------------------------------------------------------- 393 -- HappyState data type (not arrays) 394 395 {-# LINE 163 "templates/GenericTemplate.hs" #-} 396 397 ----------------------------------------------------------------------------- 398 -- Shifting a token 399 400 happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = 401 let !(i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in 402 -- trace "shifting the error token" $ 403 happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) 404 405 happyShift new_state i tk st sts stk = 406 happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) 407 408 -- happyReduce is specialised for the common cases. 409 410 happySpecReduce_0 i fn 0# tk st sts stk 411 = happyFail 0# tk st sts stk 412 happySpecReduce_0 nt fn j tk st@((action)) sts stk 413 = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) 414 415 happySpecReduce_1 i fn 0# tk st sts stk 416 = happyFail 0# tk st sts stk 417 happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') 418 = let r = fn v1 in 419 happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) 420 421 happySpecReduce_2 i fn 0# tk st sts stk 422 = happyFail 0# tk st sts stk 423 happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') 424 = let r = fn v1 v2 in 425 happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) 426 427 happySpecReduce_3 i fn 0# tk st sts stk 428 = happyFail 0# tk st sts stk 429 happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') 430 = let r = fn v1 v2 v3 in 431 happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) 432 433 happyReduce k i fn 0# tk st sts stk 434 = happyFail 0# tk st sts stk 435 happyReduce k nt fn j tk st sts stk 436 = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of 437 sts1@((HappyCons (st1@(action)) (_))) -> 438 let r = fn stk in -- it doesn't hurt to always seq here... 439 happyDoSeq r (happyGoto nt j tk st1 sts1 r) 440 441 happyMonadReduce k nt fn 0# tk st sts stk 442 = happyFail 0# tk st sts stk 443 happyMonadReduce k nt fn j tk st sts stk = 444 happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) 445 where !(sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) 446 drop_stk = happyDropStk k stk 447 448 happyMonad2Reduce k nt fn 0# tk st sts stk 449 = happyFail 0# tk st sts stk 450 happyMonad2Reduce k nt fn j tk st sts stk = 451 happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) 452 where !(sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) 453 drop_stk = happyDropStk k stk 454 455 !(off) = indexShortOffAddr happyGotoOffsets st1 456 !(off_i) = (off Happy_GHC_Exts.+# nt) 457 !(new_state) = indexShortOffAddr happyTable off_i 458 459 460 461 462 happyDrop 0# l = l 463 happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t 464 465 happyDropStk 0# l = l 466 happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs 467 468 ----------------------------------------------------------------------------- 469 -- Moving to a new state after a reduction 470 471 472 happyGoto nt j tk st = 473 {- nothing -} 474 happyDoAction j tk new_state 475 where !(off) = indexShortOffAddr happyGotoOffsets st 476 !(off_i) = (off Happy_GHC_Exts.+# nt) 477 !(new_state) = indexShortOffAddr happyTable off_i 478 479 480 481 482 ----------------------------------------------------------------------------- 483 -- Error recovery (0# is the error token) 484 485 -- parse error if we are in recovery and we fail again 486 happyFail 0# tk old_st _ stk = 487 -- trace "failing" $ 488 happyError_ tk 489 490 {- We don't need state discarding for our restricted implementation of 491 "error". In fact, it can cause some bogus parses, so I've disabled it 492 for now --SDM 493 494 -- discard a state 495 happyFail 0# tk old_st (HappyCons ((action)) (sts)) 496 (saved_tok `HappyStk` _ `HappyStk` stk) = 497 -- trace ("discarding state, depth " ++ show (length stk)) $ 498 happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) 499 -} 500 501 -- Enter error recovery: generate an error token, 502 -- save the old token and carry on. 503 happyFail i tk (action) sts stk = 504 -- trace "entering error recovery" $ 505 happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) 506 507 -- Internal happy errors: 508 509 notHappyAtAll = error "Internal Happy error\n" 510 511 ----------------------------------------------------------------------------- 512 -- Hack to get the typechecker to accept our action functions 513 514 515 happyTcHack :: Happy_GHC_Exts.Int# -> a -> a 516 happyTcHack x y = y 517 {-# INLINE happyTcHack #-} 518 519 520 ----------------------------------------------------------------------------- 521 -- Seq-ing. If the --strict flag is given, then Happy emits 522 -- happySeq = happyDoSeq 523 -- otherwise it emits 524 -- happySeq = happyDontSeq 525 526 happyDoSeq, happyDontSeq :: a -> b -> b 527 happyDoSeq a b = a `seq` b 528 happyDontSeq a b = b 529 530 ----------------------------------------------------------------------------- 531 -- Don't inline any functions from the template. GHC has a nasty habit 532 -- of deciding to inline happyGoto everywhere, which increases the size of 533 -- the generated parser quite a bit. 534 535 536 {-# NOINLINE happyDoAction #-} 537 {-# NOINLINE happyTable #-} 538 {-# NOINLINE happyCheck #-} 539 {-# NOINLINE happyActOffsets #-} 540 {-# NOINLINE happyGotoOffsets #-} 541 {-# NOINLINE happyDefActions #-} 542 543 {-# NOINLINE happyShift #-} 544 {-# NOINLINE happySpecReduce_0 #-} 545 {-# NOINLINE happySpecReduce_1 #-} 546 {-# NOINLINE happySpecReduce_2 #-} 547 {-# NOINLINE happySpecReduce_3 #-} 548 {-# NOINLINE happyReduce #-} 549 {-# NOINLINE happyMonadReduce #-} 550 {-# NOINLINE happyGoto #-} 551 {-# NOINLINE happyFail #-} 552 553 -- end of Happy Template.