packages feed

regex-pderiv 0.1.0 → 0.1.1

raw patch · 14 files changed

+686/−70 lines, 14 filesdep +parallelPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: parallel

API changes (from Hackage documentation)

- Text.Regex.PDeriv.Common: type Range = (Int, Int)
+ Text.Regex.PDeriv.ByteString.RightToLeft: parsePat :: String -> Either ParseError Pat
+ Text.Regex.PDeriv.Common: Range :: !Int -> !Int -> Range
+ Text.Regex.PDeriv.Common: data Range
+ Text.Regex.PDeriv.Common: instance Eq Range
+ Text.Regex.PDeriv.Common: instance Show Range
+ Text.Regex.PDeriv.Common: maxRange :: (a, b) -> b
+ Text.Regex.PDeriv.Common: minRange :: (a, b) -> a
+ Text.Regex.PDeriv.Common: range :: Int -> Int -> Range
+ Text.Regex.PDeriv.Dictionary: emptyTrie :: Trie a
+ Text.Regex.PDeriv.ExtPattern: EGroupNonMarking :: EPat -> EPat
+ Text.Regex.PDeriv.Nfa: nofAllStates :: NFA a t -> Int
+ Text.Regex.PDeriv.Nfa: nofDelta :: NFA t t1 -> Int
+ Text.Regex.PDeriv.Nfa: nofFinalStates :: NFA a t -> Int
+ Text.Regex.PDeriv.Nfa: nofInitStates :: NFA a t -> Int
+ Text.Regex.PDeriv.RE: partDerivSub :: RE -> Char -> [RE]
+ Text.Regex.PDeriv.RE: sigmaREsub :: RE -> [Char]
+ Text.Regex.PDeriv.String: CompOption :: Bool -> Bool -> Bool -> Bool -> Bool -> CompOption
+ Text.Regex.PDeriv.String: ExecOption :: Bool -> ExecOption
+ Text.Regex.PDeriv.String: captureGroups :: ExecOption -> Bool
+ Text.Regex.PDeriv.String: caseSensitive :: CompOption -> Bool
+ Text.Regex.PDeriv.String: compile :: CompOption -> ExecOption -> String -> Either String Regex
+ Text.Regex.PDeriv.String: data CompOption
+ Text.Regex.PDeriv.String: data ExecOption
+ Text.Regex.PDeriv.String: data Regex
+ Text.Regex.PDeriv.String: defaultCompOpt :: RegexOptions regex compOpt execOpt => compOpt
+ Text.Regex.PDeriv.String: defaultExecOpt :: RegexOptions regex compOpt execOpt => execOpt
+ Text.Regex.PDeriv.String: execute :: Regex -> String -> Either String (Maybe Env)
+ Text.Regex.PDeriv.String: lastStarGreedy :: CompOption -> Bool
+ Text.Regex.PDeriv.String: multiline :: CompOption -> Bool
+ Text.Regex.PDeriv.String: newSyntax :: CompOption -> Bool
+ Text.Regex.PDeriv.String: regexec :: Regex -> String -> Either String (Maybe (String, String, String, [String]))
+ Text.Regex.PDeriv.String: rightAssoc :: CompOption -> Bool
+ Text.Regex.PDeriv.String.LeftToRightD: CompOption :: Bool -> Bool -> Bool -> Bool -> Bool -> CompOption
+ Text.Regex.PDeriv.String.LeftToRightD: ExecOption :: Bool -> ExecOption
+ Text.Regex.PDeriv.String.LeftToRightD: captureGroups :: ExecOption -> Bool
+ Text.Regex.PDeriv.String.LeftToRightD: caseSensitive :: CompOption -> Bool
+ Text.Regex.PDeriv.String.LeftToRightD: compile :: CompOption -> ExecOption -> String -> Either String Regex
+ Text.Regex.PDeriv.String.LeftToRightD: data CompOption
+ Text.Regex.PDeriv.String.LeftToRightD: data ExecOption
+ Text.Regex.PDeriv.String.LeftToRightD: data Regex
+ Text.Regex.PDeriv.String.LeftToRightD: defaultCompOpt :: RegexOptions regex compOpt execOpt => compOpt
+ Text.Regex.PDeriv.String.LeftToRightD: defaultExecOpt :: RegexOptions regex compOpt execOpt => execOpt
+ Text.Regex.PDeriv.String.LeftToRightD: execute :: Regex -> String -> Either String (Maybe Env)
+ Text.Regex.PDeriv.String.LeftToRightD: instance Read CompOption
+ Text.Regex.PDeriv.String.LeftToRightD: instance Read ExecOption
+ Text.Regex.PDeriv.String.LeftToRightD: instance RegexOptions Regex CompOption ExecOption
+ Text.Regex.PDeriv.String.LeftToRightD: instance Show CompOption
+ Text.Regex.PDeriv.String.LeftToRightD: instance Show ExecOption
+ Text.Regex.PDeriv.String.LeftToRightD: lastStarGreedy :: CompOption -> Bool
+ Text.Regex.PDeriv.String.LeftToRightD: multiline :: CompOption -> Bool
+ Text.Regex.PDeriv.String.LeftToRightD: newSyntax :: CompOption -> Bool
+ Text.Regex.PDeriv.String.LeftToRightD: regexec :: Regex -> String -> Either String (Maybe (String, String, String, [String]))
+ Text.Regex.PDeriv.String.LeftToRightD: rightAssoc :: CompOption -> Bool

Files

Text/Regex/PDeriv/ByteString.lhs view
@@ -19,7 +19,7 @@  The re-exports -> import Text.Regex.PDeriv.ByteString.RightToLeft ( Regex+> import Text.Regex.PDeriv.ByteString.LeftToRightD ( Regex >                                                 , CompOption(..) >                                                 , ExecOption(..) >                                                 , defaultCompOpt
Text/Regex/PDeriv/ByteString/LeftToRight.lhs view
@@ -34,7 +34,7 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), nub2, preBinder, mainBinder, subBinder)+> import Text.Regex.PDeriv.Common (Range(..), Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), nub2, preBinder, mainBinder, subBinder) > import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, pdPat0Sim, toBinder, Binder(..), strip, listifyBinder) > import Text.Regex.PDeriv.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -51,8 +51,8 @@  > type Env = [(Int,Word)] -> rg_collect :: S.ByteString -> (Int,Int) -> S.ByteString-> rg_collect w (i,j) = S.take (j' - i' + 1) (S.drop i' w)+> rg_collect :: S.ByteString -> Range -> S.ByteString+> rg_collect w (Range i j) = S.take (j' - i' + 1) (S.drop i' w) >	       where i' = fromIntegral i >	             j' = fromIntegral j 
Text/Regex/PDeriv/ByteString/LeftToRightD.lhs view
@@ -6,7 +6,7 @@ an emptiable pattern and the input word is fully consumed.  > {-# LANGUAGE GADTs, MultiParamTypeClasses, FunctionalDependencies,->     FlexibleInstances, TypeSynonymInstances, FlexibleContexts #-} +>     FlexibleInstances, TypeSynonymInstances, FlexibleContexts, BangPatterns #-}    > module Text.Regex.PDeriv.ByteString.LeftToRightD@@ -27,8 +27,8 @@ > import qualified Data.ByteString.Char8 as S > import Control.DeepSeq -> -- import Control.Parallel -> -- import Control.Parallel.Strategies hiding (Seq)+> import Control.Parallel +> import Control.Parallel.Strategies    > import System.IO.Unsafe (unsafePerformIO)@@ -38,7 +38,7 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), nub2, preBinder, mainBinder, subBinder)+> import Text.Regex.PDeriv.Common (Range(..), Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), nub2, preBinder, mainBinder, subBinder) > import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, pdPat0Sim, toBinder, Binder(..), strip, listifyBinder) > import Text.Regex.PDeriv.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insert, insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -55,8 +55,10 @@  > type Env = [(Int,Word)] -> rg_collect :: S.ByteString -> (Int,Int) -> S.ByteString-> rg_collect w (i,j) = S.take (j' - i' + 1) (S.drop i' w)+ rg_collect :: S.ByteString -> (Int,Int) -> S.ByteString++> rg_collect :: S.ByteString -> Range -> S.ByteString+> rg_collect w (Range i j) = S.take (j' - i' + 1) (S.drop i' w) >	       where i' = fromIntegral i >	             j' = fromIntegral j @@ -289,27 +291,57 @@ >       Nothing -> currNfaStateBinders -- we are done with the matching >       Just (l,w) ->  >           let ((i,_,_):_) = currNfaStateBinders  -- i is the current DFA state->               k           = {-# SCC "k" #-} l `seq` i `seq` my_hash i l+>               k           =  l `seq` i `seq` my_hash i l >           in->           case k `seq` IM.lookup k dStateTable of+>           case {- k `seq` -} IM.lookup k dStateTable of >             { Nothing -> [] -- "key missing" which means some letter exists in w but not in r.     >             ; Just (j,next_nfaStates,fDict) -> ->                 let -- ->                     binders = {-# SCC "binders" #-} -- io `seq`->                               currNfaStateBinders `seq` fDict `seq`  ->                               concatMap' ( \ (_,m,b) -> case IM.lookup m fDict of ->                                                        Nothing -> []->                                                        Just fs -> b `seq` fs `seq` map (\f -> f cnt b) fs ) currNfaStateBinders ->                     nextNfaStateBinders = {-# SCC "nextNfaStateBinders" #-} -- io `seq` +>                 let +>                     binders :: [Binder]+>                     binders = +>                               fDict `seq` computeBinders currNfaStateBinders fDict cnt +>                     nextNfaStateBinders = -- io `seq`  >                                           binders `seq` next_nfaStates `seq` j `seq` >                                           map (\(x,y) -> (j,x,y)) (zip next_nfaStates binders) >                     cnt' = {-# SCC "cnt" #-} cnt + 1 >                 in nextNfaStateBinders `seq` cnt' `seq` w `seq` >                        patMatchesIntStatePdPat1 cnt' dStateTable w  nextNfaStateBinders }  ++fusing up the computation for binders++> computeBinders :: [(Int,Int,Binder)] -> IM.IntMap [Int -> Binder -> Binder] -> Int -> [Binder]+> computeBinders currNfaStateBinders fDict cnt = +>     cm currNfaStateBinders+>     where +>        cm :: [(Int,Int,Binder)] -> [Binder]+>        cm bs = foldl' k [] bs+>        k :: [Binder] -> (Int,Int,Binder) -> [Binder]+>        k !a (_,!m,!b) = case IM.lookup m fDict of { Nothing -> a; Just !gs -> ((++) a $! (map (\g -> g cnt b) gs)) }  ++ > {--> concatMap' :: (a -> [b]) -> [a] -> [b]-> concatMap' f x = reverse $ foldr ( \ b a -> (++) (f b) $! a) [] x                                ++general type scheme concatMapl :: (a -> [b]) -> [a] -> [b]+++> concatMapl :: ((Int,Int,Binder) -> [Binder]) -> [(Int,Int,Binder)] -> [Binder]+> concatMapl f x = foldl' k [] x+>   where +>       k a b = a `seq` b `seq` (++) a (f b) -- to make it stricter+> -- same as k !a !b = (++) a (f b) +++> +> foldl'rnf :: NFData a => (a -> b -> a) -> a -> [b] -> a+> foldl'rnf f z xs = lgo z xs+>    where                      +>       lgo z []     = z      +>       lgo z (x:xs) = lgo z' xs +>          where +>             z' = f z x `using` rseq {- was 'rnf' in the realworld haskell book -}+> + > -}  > @@ -325,6 +357,7 @@ >                        foldr' f b' as  +>   > patMatchIntStatePdPat1 :: Pat -> Word -> [Env] > patMatchIntStatePdPat1 p w = 
Text/Regex/PDeriv/ByteString/Posix.lhs view
@@ -43,7 +43,7 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, PosEpsilon(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), preBinder, subBinder, mainBinder)+> import Text.Regex.PDeriv.Common (Range(..), Letter, PosEpsilon(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), preBinder, subBinder, mainBinder) > import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, toBinder, Binder(..), strip, listifyBinder) > import Text.Regex.PDeriv.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -57,8 +57,8 @@  > type Word = S.ByteString -> rg_collect :: S.ByteString -> (Int,Int) -> S.ByteString-> rg_collect w (i,j) = S.take (j' - i') (S.drop i' w)+> rg_collect :: S.ByteString -> Range -> S.ByteString+> rg_collect w (Range i j) = S.take (j' - i') (S.drop i' w) >	       where i' = fromIntegral i >	             j' = fromIntegral j @@ -251,7 +251,7 @@ > firstNonEQ (o:_) = o  > len :: Range -> Int-> len (b,e) = e - b + 1+> len (Range b e) = e - b + 1   > patMatchIntStatePdPat0Rev :: Pat -> Word -> [Env]@@ -322,14 +322,14 @@ >                     -> Binder > updateBinderByIndex i pos binder = -- binder {- >     case IM.lookup i binder of->       { Nothing -> IM.insert i [(pos,pos+1)] binder+>       { Nothing -> IM.insert i [(Range pos (pos+1))] binder >       ; Just ranges ->  >         case ranges of ->         { [] -> IM.update (\_ -> Just [(pos,pos+1)]) i binder->         ; ((b,e):rs) ->           | b == e -> IM.update (\_ -> Just ((pos,pos+1):(b,e):rs)) i binder -- preserve the reset points (i,i)->           | pos == b - 1  -> IM.update (\_ -> Just ((b-1,e):rs)) i binder->           | pos < (b - 1) -> IM.update (\_ -> Just ((pos,pos+1):(b,e):rs)) i binder+>         { [] -> IM.update (\_ -> Just [(Range pos (pos+1))]) i binder+>         ; rs_@((Range b e):rs) +>           | b == e -> IM.update (\_ -> Just ((Range pos (pos+1)):rs_)) i binder -- preserve the reset points (i,i)+>           | pos == b - 1  -> IM.update (\_ -> Just ((Range (b-1) e):rs)) i binder+>           | pos < (b - 1) -> IM.update (\_ -> Just ((Range pos (pos+1)):rs_)) i binder >           | otherwise     -> error ("impossible, the current letter position is greater than the last recorded letter" ++ show i ++ show pos ++ show (b,e)) >         } >       } -- -}@@ -382,8 +382,8 @@ >            aux is b = foldl (\b' i ->  >                              case IM.lookup i b' of >                                { Nothing -> b'->                                ; Just [] -> IM.update (\r -> Just [(j, j)]) i b'->                                ; Just ((s,e):ses) -> IM.update (\r -> Just ((j,j):(s,e):ses)) i b'+>                                ; Just [] -> IM.update (\r -> Just [(Range j j)]) i b'+>                                ; Just (ses_@((Range s e):ses)) -> IM.update (\r -> Just ((Range j j):ses_)) i b' >                                }) b is >                                                        @@ -549,7 +549,7 @@ >         fs' = w' `seq` fs `seq`  l `seq` pdStateTable `seq` (patMatchesIntStatePdPat0Rev (l-1) pdStateTable w' fs) >         -- fs'' = fs' `seq` my_sort fs' >         allbinders = fs' `seq` [  b' | (s,b',_,_) <- fs', s == 0 ]->         io = logger (print $ show b) `seq` logger (print $ show allbinders)+>         -- io = logger (print $ show b) `seq` logger (print $ show allbinders) >     in -- io `seq`  >            allbinders `seq` map (binderToMatchArray l fb posixBnd) allbinders @@ -573,9 +573,9 @@ >         mbPrefixB = IM.lookup preBinder b >         mbSubfixB = IM.lookup subBinder b >         mainB     = case (mbPrefixB, mbSubfixB) of->                       (Just [(_,x)], Just [(y,_)]) -> (x, y - x)->                       (Just [(_,x)], _)            -> (x, l - x)->                       (_, Just [(y,_)])            -> (0, y) +>                       (Just [(Range _ x)], Just [(Range y _)]) -> (x, y - x)+>                       (Just [(Range _ x)], _)            -> (x, l - x)+>                       (_, Just [(Range y _)])            -> (0, y)  >                       (_, _)                       -> (0, l) >                       _                            -> error (show (mbPrefixB, mbSubfixB) )  >         rs        = map snd subPatB      @@ -583,7 +583,7 @@ >         io = logger (print $ "\n" ++ show rs ++ " || " ++ show rs' ++ "\n") >     in -- io `seq`  >        listToArray (mainB:rs')->     where fromRange (b,e) = (b, e-b) +>     where fromRange (Range b e) = (b, e-b)  >           -- chris' test cases requires us to get the last result even if it is a reset point, >           -- e.g. input:"aaa"	 pattern:"((..)|(.))*" expected match:"(0,3)(2,3)(-1,-1)(2,3)" note that (..) matches with [(0,2),(2,2)], we return [(2,2)] >           lastNonEmpty [] = (-1,0)
Text/Regex/PDeriv/ByteString/RightToLeft.lhs view
@@ -19,6 +19,7 @@ >     , compile >     , execute >     , regexec+>     , parsePat >     ) where   > import Data.List @@ -31,7 +32,7 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), nub3, preBinder, mainBinder, subBinder) +> import Text.Regex.PDeriv.Common (Range(..), Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), nub3, preBinder, mainBinder, subBinder)  > import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, pdPat0Sim, toBinder, Binder(..), strip, listifyBinder) > import Text.Regex.PDeriv.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -48,7 +49,7 @@   > rg_collect :: S.ByteString -> Range -> S.ByteString-> rg_collect w (i,j) = S.take (j' - i' + 1) (S.drop i' w)+> rg_collect w (Range i j) = S.take (j' - i' + 1) (S.drop i' w) >	       where i' = fromIntegral i >	             j' = fromIntegral j 
Text/Regex/PDeriv/ByteString/TwoPasses.lhs view
@@ -33,7 +33,7 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), nub2, preBinder, mainBinder, subBinder)+> import Text.Regex.PDeriv.Common (Range(..), Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), nub2, preBinder, mainBinder, subBinder) > import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, pdPat0Sim, toBinder, Binder(..), strip, listifyBinder) > import Text.Regex.PDeriv.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -78,8 +78,8 @@   -> rg_collect :: S.ByteString -> (Int,Int) -> S.ByteString-> rg_collect w (i,j) = S.take (j' - i' + 1) (S.drop i' w)+> rg_collect :: S.ByteString -> Range -> S.ByteString+> rg_collect w (Range i j) = S.take (j' - i' + 1) (S.drop i' w) >	       where i' = fromIntegral i >	             j' = fromIntegral j 
Text/Regex/PDeriv/Common.lhs view
@@ -1,6 +1,7 @@+> {-# LANGUAGE BangPatterns #-} > -- | this module contains the defs of common data types and type classes > module Text.Regex.PDeriv.Common ->     ( Range+>     ( Range(..), range, minRange, maxRange >     , Letter >     , PosEpsilon (..) >     , IsEpsilon (..)@@ -24,7 +25,18 @@ > import Data.List (nubBy)  > -- | (sub)words represent by range-> type Range  = (Int,Int)      +> -- type Range  = (Int,Int)      +> data Range = Range !Int !Int deriving Show++> instance Eq Range where+>   (==) (Range x y) (Range w z) = (x == w) && (y == z)++> range :: Int -> Int -> Range+> range = Range++> minRange = fst+> maxRange = snd+ > -- | a character and its index (position) > type Letter = (Char,Int)      
Text/Regex/PDeriv/ExtPattern.lhs view
@@ -2,6 +2,7 @@  > -- | The external pattern syntax (ERE syntax) > data EPat = EEmpty +>          | EGroupNonMarking EPat -- ^ non marking group (?: re ) >          | EGroup EPat    -- ^ the group ( re ) >          | EOr [EPat]     -- ^ the union re|re >          | EConcat [EPat] -- ^ the concantenation rere@@ -22,6 +23,7 @@ > hasGroup :: EPat -> Bool > hasGroup EEmpty = False > hasGroup (EGroup _) = True+> hasGroup (EGroupNonMarking ep) = hasGroup ep > hasGroup (EOr eps) = any hasGroup eps > hasGroup (EConcat eps) = any hasGroup eps > hasGroup (EOpt ep _) = hasGroup ep
Text/Regex/PDeriv/IntPattern.lhs view
@@ -1,3 +1,4 @@+> {-# LANGUAGE BangPatterns #-} > -- | This module defines the data type of internal regular expression pattern,  > -- | as well as the partial derivative operations for regular expression patterns. > module Text.Regex.PDeriv.IntPattern @@ -16,7 +17,7 @@  > import Data.List > import qualified Data.IntMap as IM-> import Text.Regex.PDeriv.Common (Range, Letter, PosEpsilon(..), IsEpsilon(..), IsPhi(..), GFlag(..), IsGreedy(..), Simplifiable(..) )+> import Text.Regex.PDeriv.Common (Range(..), range, minRange, maxRange, Letter, PosEpsilon(..), IsEpsilon(..), IsPhi(..), GFlag(..), IsGreedy(..), Simplifiable(..) ) > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Dictionary (Key(..), primeL, primeR) > import Text.Regex.PDeriv.Pretty@@ -128,12 +129,12 @@ >          let pds = pdPat p (l,idx) >          in if null pds then [] >             else case w of->		  [] -> [ PVar x [ (idx,idx) ] pd | pd <- pds ]->		  ((b,e):rs)      --  ranges are stored in the reversed manner, the first pair the right most segment+>		  [] -> [ PVar x [ (range idx idx) ] pd | pd <- pds ]+>		  (rs_@((Range b e):rs))     --  ranges are stored in the reversed manner, the first pair the right most segment >                     | idx == (e + 1) -> -- it is consecutive->                         [ PVar x ((b,idx):rs) pd | pd <- pds ]+>                         [ PVar x ((range b idx):rs) pd | pd <- pds ] >                     | otherwise ->      -- it is NOT consecutive->                         [ PVar x ((idx,idx):(b,e):rs) pd | pd <- pds ]+>                         [ PVar x ((range idx idx):rs_) pd | pd <- pds ] > pdPat (PE r) (l,idx) = let pds = partDeriv r l  >                  in if null pds then [] >                     else [ PE $ resToRE pds ]@@ -206,6 +207,17 @@ > type Binder = IM.IntMap [Range]  +> -- | check whether a pattern has binder+> hasBinder :: Pat -> Bool+> hasBinder (PVar _ _ _) = True                              +> hasBinder  (PPair p1 p2) = (hasBinder p1) || (hasBinder p2)+> hasBinder  (PPlus p1 p2) = hasBinder p1 +> hasBinder  (PStar p1 g)  = hasBinder p1 +> hasBinder  (PE r)        = False+> hasBinder  (PChoice p1 p2 g) = (hasBinder p1) || (hasBinder p2)+> hasBinder  (PEmpty p) = hasBinder p+                                                      + > -- | Function 'toBinder' turns a pattern into a binder > toBinder :: Pat -> Binder > toBinder p = IM.fromList (toBinderList p)@@ -231,13 +243,15 @@ >                     -> Int  >                     -> Binder  >                     -> Binder-> updateBinderByIndex i pos binder = -- binder  {-+> updateBinderByIndex i !pos binder =  -- binder  {- >     IM.update (\ r -> case r of  -- we always initialize to [], we don't need to handle the key miss case->                       {  ((b,e):rs)->                           | pos == e + 1 -> Just ((b,e+1):rs)->                           | pos > e + 1  -> Just ((pos,pos):(b,e):rs)->                           | otherwise    -> error "impossible, the current letter position is smaller than the last recorded letter"   ->                       ; [] -> Just [(pos,pos)] +>                       {  (rs_@((Range b e):rs)) -> +>                           let !e' =  e + 1+>                           in case e' of                                                    +>                              _ | pos == e' -> Just ((range b e'):rs)+>                                | pos > e'  -> Just ((range pos pos):rs_)+>                                | otherwise    -> error "impossible, the current letter position is smaller than the last recorded letter"   +>                       ; [] -> Just [(range pos pos)]  >                       } ) i binder -- -} > {- > updateBinderByIndex i pos binder = @@ -288,6 +302,15 @@ >           -> Letter -- ^ the letter to be "consumed" >           -> [(Pat, Int -> Binder -> Binder)] > pdPat0 (PVar x w p) (l,idx) +>     | hasBinder p = +>         let pfs = pdPat0 p (l,idx)+>         in g `seq` pfs `seq` [ (PVar x [] pd, (\i -> (g i) . (f i) )) | (pd,f) <- pfs ]+>     | otherwise = -- p is not nested+>         let pds = partDeriv (strip p) l+>         in g `seq` pds `seq` if null pds then []+>                              else [ (PVar x [] (PE (resToRE pds)), g) ]+>     where g = updateBinderByIndex x +> {- >     | IM.null (toBinder p) = -- p is not nested >         let pds = partDeriv (strip p) l >         in g `seq` pds `seq` if null pds then []@@ -295,7 +318,8 @@ >     | otherwise =  >         let pfs = pdPat0 p (l,idx) >         in g `seq` pfs `seq` [ (PVar x [] pd, (\i -> (g i) . (f i) )) | (pd,f) <- pfs ]->     where g = updateBinderByIndex x+>     where g = updateBinderByIndex x +> -} > pdPat0 (PE r) (l,idx) =  >     let pds = partDeriv r l >     in  pds `seq` if null pds then []
Text/Regex/PDeriv/Parse.lhs view
@@ -7,10 +7,11 @@ internal pattern representation. This parser is largely adapted from Text.Regex.TDFA.ReadRegex +> import Data.Char > import Text.ParserCombinators.Parsec((<|>), (<?>), >                                      unexpected, try, runParser, many, getState, setState, CharParser, ParseError, >                                      sepBy1, option, notFollowedBy, many1, lookAhead, eof, between,->                                      string, noneOf, digit, char, anyChar)+>                                      string, oneOf, noneOf, digit, char, anyChar) > import Control.Monad(liftM, when, guard) > import Data.List (sort,nub) > import qualified Data.IntMap as IM@@ -67,8 +68,25 @@ >          p_esc_char <|> >          p_char -> p_group = liftM EGroup $ between (char '(') (char ')') p_ere+ p_group = liftM EGroup $ between (char '(') (char ')') p_ere +> p_group = +>     between (char '(') (char ')') +>                 ( try +>                   ( do  +>                     { -- non marking group +>                     ; (char '?') +>                     ; (char ':')+>                     ; x <- p_ere+>                     ; return (EGroupNonMarking x)+>                     } +>                   )+>                  <|>+>                  liftM EGroup p_ere+>                 )+++ parsing [ ... ] and [^ ... ]  > p_charclass = @@ -94,15 +112,15 @@  > p_one_enum = p_range <|> p_char_set  -> p_range = try $ do  -- try is like atomically?->           { start <- noneOf "]-"+> p_range = try $ do  +>           { start <- (try p_esc_char_) <|> noneOf "]-" >           ; char '-'->           ; end <- noneOf "]"+>           ; end <- (try p_esc_char_) <|> noneOf "]" >           ; return [ start .. end ]  >           }  > p_char_set = do ->   { c <- noneOf "]"+>   { c <- (try p_esc_char_) <|> noneOf "]" -- <|> (char '\\' >> p_special_char) >   ; when (c == '-') $ >     do -- when it is a dash, it must be at the end of the [..] >     { atEnd <- (lookAhead (char ']') >> return True) <|> (return False)@@ -111,21 +129,50 @@ >   ; return [c] >   } - parse the dot (all characters)  > p_dot = char '.' >> (return EDot)  parse the escaped chars -> p_esc_char = char '\\' >> anyChar >>= \c -> return (EEscape c)+> p_esc_char_ = char '\\' >> ((try p_tab) <|> (try p_return) <|> (try p_newline) <|> (try p_oct_ascii) <|> anyChar) +> p_esc_char = char '\\' >> ((try p_tab) <|> (try p_return) <|> (try p_newline) <|> (try p_oct_ascii) <|> anyChar) >>= \c -> return (EEscape c)++oct ascii, e.g. \000++> p_return = do +>            { char 'r'+>            ; return '\r'+>            }++> p_newline = do +>             { char 'n'+>             ; return '\n'+>             }++> p_tab = do +>         { char 't'+>         ; return '\t'+>         }+++> p_oct_ascii = do  +>               { d1 <- digit+>               ; d2 <- digit+>               ; d3 <- digit+>               ; return (chr ((digitToInt d2)*8 + (digitToInt d3)))+>               }++ parse a single non-escaped char -> p_char = noneOf specials >>= \c -> return (EChar c)->     where specials = "^.[$()|*+?{\\"+> specials = "^.[$()|*+?{\\" +> p_char = noneOf specials >>= \c -> return (EChar c) +> p_special_char :: CharParser EState Char+> p_special_char = oneOf specials   > p_post_anchor_or_atom atom = 
+ Text/Regex/PDeriv/String.lhs view
@@ -0,0 +1,31 @@+> {- By Kenny Zhuo Ming Lu and Martin Sulzmann, 2009, BSD License -}++A string implementation of reg exp pattern matching using partial derivative++> {-# LANGUAGE GADTs, MultiParamTypeClasses, FunctionalDependencies,+>     FlexibleInstances, TypeSynonymInstances, FlexibleContexts #-} +++> module Text.Regex.PDeriv.String +>     ( Regex+>     , CompOption(..)+>     , ExecOption(..)+>     , defaultCompOpt+>     , defaultExecOpt+>     , compile+>     , execute+>     , regexec+>     ) where ++The re-exports++> import Text.Regex.PDeriv.String.LeftToRightD ( Regex+>                                              , CompOption(..)+>                                              , ExecOption(..)+>                                              , defaultCompOpt+>                                              , defaultExecOpt+>                                              , compile+>                                              , execute+>                                              , regexec+>                                              ) +
+ Text/Regex/PDeriv/String/LeftToRightD.lhs view
@@ -0,0 +1,450 @@+> {- By Kenny Zhuo Ming Lu and Martin Sulzmann, 2009, BSD License -}++A string implementation of reg exp pattern matching using partial derivative+This algorithm exploits the extension of partial derivative of regular expression patterns.+This algorithm proceeds by scanning the input word from left to right until we reach +an emptiable pattern and the input word is fully consumed.++> {-# LANGUAGE GADTs, MultiParamTypeClasses, FunctionalDependencies,+>     FlexibleInstances, TypeSynonymInstances, FlexibleContexts, BangPatterns #-} +++> module Text.Regex.PDeriv.String.LeftToRightD+>     ( Regex+>     , CompOption(..)+>     , ExecOption(..)+>     , defaultCompOpt+>     , defaultExecOpt+>     , compile+>     , execute+>     , regexec+>     ) where ++> import Data.List +> import Data.Char (ord)+> -- import GHC.Int+> import qualified Data.IntMap as IM++> import System.IO.Unsafe (unsafePerformIO)++> import Text.Regex.Base(RegexOptions(..))++> import Text.Regex.PDeriv.RE+> import Text.Regex.PDeriv.Pretty (Pretty(..))+> import Text.Regex.PDeriv.Common (Range(..), Letter, PosEpsilon(..), Simplifiable(..), my_hash, my_lookup, GFlag(..), nub2, preBinder, mainBinder, subBinder)+> import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, pdPat0Sim, toBinder, Binder(..), strip, listifyBinder)+> import Text.Regex.PDeriv.Parse+> import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insert, insertNotOverwrite, lookupAll, empty, isIn, nub)+++A word is a byte string.++> type Word = String+++----------------------------+-- (greedy) pattern matching++> type Env = [(Int,Word)]++> rg_collect :: String -> Range -> String+> rg_collect w (Range i j) = take (j' - i' + 1) (drop i' w)+>	       where i' = fromIntegral i+>	             j' = fromIntegral j++++we compile all the possible partial derivative operation into a table+The table maps key to a set of target integer states and their corresponding+binder update functions. ++> type PdPat0Table = IM.IntMap [(Int, Int -> Binder -> Binder)]++A function that builds the above table from the pattern++> buildPdPat0Table :: Pat ->  (PdPat0Table, [Int])+> buildPdPat0Table init = +>     let sig = map (\x -> (x,0)) (sigmaRE (strip init))                              -- the sigma+>         init_dict = D.insertNotOverwrite (D.hash init) (init,0) D.empty             -- add init into the initial dictionary+>         (all, delta, dictionary) = sig `seq` builder sig [] [] [init] init_dict 1   -- all states and delta+>         final = all `seq`  [ s | s <- all, posEpsilon (strip s)]                       -- the final states+>         sfinal = final `seq` dictionary `seq` map (mapping dictionary) final+>         lists = [ (i,l,jfs) | +>                   (p,l, qfs) <- delta, +>                   let i = mapping dictionary p+>                       jfs = map (\(q,f) -> (mapping dictionary q, f)) qfs+>                   ]+>         hash_table = foldl' (\ dict (p,x,q) -> +>                                  let k = my_hash p (fst x)+>                                  in case IM.lookup k dict of +>                                       Just ps -> error "Found a duplicate key in the PdPat0Table, this should not happen."+>                                       Nothing -> IM.insert k q dict) IM.empty lists+>     in (hash_table, sfinal)+++                             +Some helper functions used in buildPdPat0Table++> mapping :: D.Dictionary (Pat,Int) -> Pat -> Int+> mapping dictionary x = let candidates = D.lookupAll (D.hash x) dictionary+>                        in candidates `seq` +>                           case candidates of+>                             [(_,i)] -> i+>                             _ -> +>                                 case lookup x candidates of+>                                 (Just i) -> i+>                                 Nothing -> error ("this should not happen. looking up " ++ (pretty x) ++ " from " ++ (show candidates) )++> builder :: [Letter] +>         -> [Pat] +>         -> [(Pat,Letter, [(Pat, Int -> Binder -> Binder)] )]+>         -> [Pat] +>         -> D.Dictionary (Pat,Int)+>         -> Int +>         -> ([Pat], [(Pat, Letter, [(Pat, Int -> Binder -> Binder)])], D.Dictionary (Pat,Int))+> builder sig acc_states acc_delta curr_states dict max_id +>     | null curr_states  = (acc_states, acc_delta, dict)+>     | otherwise = +>         let +>             all_sofar_states = acc_states ++ curr_states+>             new_delta = [ (s, l, sfs) | s <- curr_states, l <- sig, let sfs = pdPat0Sim s l]+>             new_states = all_sofar_states `seq` D.nub [ s' | (_,_,sfs) <- new_delta, (s',f) <- sfs+>                                                       , not (s' `D.isIn` dict) ]+>             acc_delta_next  = (acc_delta ++ new_delta)+>             (dict',max_id') = new_states `seq` foldl' (\(d,id) p -> (D.insertNotOverwrite (D.hash p) (p,id) d, id + 1) ) (dict,max_id) new_states+>         in {- dict' `seq` max_id' `seq` -} builder sig all_sofar_states acc_delta_next new_states dict' max_id' +++++Optimizaing lookup pdpat table.+build a hash table that map [ Int ]  states + label  to [ Int ] states where +the resulting [ Int ] is already nubbed and join, hence there is no need to run the pairing and nubbing on the fly.+This would cause some compile time overhead and trading space with time.++Technical problem, how to hash a [ Int ] in Haskell?++> type NFAStates = [ Int ]++> type DPat0Table = IM.IntMap ( Int       -- the next DFA state+>                             , NFAStates -- the next NFA states+>                             , IM.IntMap [Int -> Binder -> Binder] -- the transition function : position -> current_binders -> next_binders+>                             ) -- deterministic: one output state and one update function++> buildDPat0Table :: Pat -> (DPat0Table, [Int])+> buildDPat0Table init = +>     let sig = map (\x -> (x,0)) (sigmaRE (strip init))                              -- the sigma+>         -- building the NFA+>         init_dict = D.insertNotOverwrite (D.hash init) (init,0) D.empty             -- add init into the initial dictionary+>         (all, delta, dictionary) = sig `seq` builder sig [] [] [init] init_dict 1   -- all states and delta+>         final = all `seq`  [ s | s <- all, posEpsilon (strip s)]                       -- the final states+>         sfinal = final `seq` dictionary `seq` map (mapping dictionary) final+>         lists = dictionary `seq` +>                 [ (i,l,jfs) | +>                   (p,l, qfs) <- delta, +>                   let i   = mapping dictionary p+>                       jfs = map (\(q,f) -> (mapping dictionary q, f)) qfs+>                   ]+>         hash_table = lists `seq` +>                      foldl' (\ dict (p,x,q) -> +>                                  let k = my_hash p (fst x)+>                                  in case IM.lookup k dict of +>                                       Just ps -> error "Found a duplicate key in the PdPat0Table, this should not happen."+>                                       Nothing -> IM.insert k q dict) IM.empty lists+>         -- building the DFA+>         init'       = [ 0 ]+>         init_dict'  = init' `seq` D.insert (D.hash init') (init',0) D.empty+>         (all', delta', dictionary') = hash_table `seq` init' `seq` init_dict' `seq`+>                                       builder' hash_table sig [] [] [init'] init_dict' 1+>         lists'      = delta' `seq` dictionary' `seq` +>                       map (\(c,l,n,f) -> +>                                let i = c `seq` mapping' dictionary' c+>                                    j = n `seq` mapping' dictionary' n+>                                in f `seq` i `seq` j `seq` n `seq` l `seq` (i, l, j, n, f)) delta'+>         hash_table' = lists' `seq` +>                       foldl' (\ dict' (i, l, j, n, f) ->+>                              let k = my_hash i (fst l)+>                              in case IM.lookup k dict' of+>                                   Just ps -> error "Found a duplicate key."+>                                   Nothing -> IM.insert k (j,n,f) dict') IM.empty lists'+>     in hash_table' `seq` sfinal `seq` (hash_table',sfinal)+++> mapping' :: D.Dictionary (NFAStates,Int) -> NFAStates -> Int+> mapping' dictionary x = let candidates = dictionary `seq` D.lookupAll (D.hash x) dictionary+>                         in candidates `seq` +>                            case candidates of+>                                     [(_,i)] -> i+>                                     _ -> +>                                         case lookup x candidates of+>                                         (Just i) -> i+>                                         Nothing -> error ("this should not happen. looking up " ++ (show x) ++ " from " ++ (show candidates) )+++> builder' :: PdPat0Table+>          -> [ Letter ]+>          -> [ NFAStates ] -- all so far+>          -> [ ( NFAStates, Letter, NFAStates, IM.IntMap [Int -> Binder -> Binder] ) ]  -- delta+>          -> [ NFAStates ]  -- maybe new states+>          -> D.Dictionary (NFAStates, Int) -- mapping dictionary+>          -> Int -- max key+>          -> ( [ NFAStates ] -- all states+>             , [ (NFAStates, Letter, NFAStates, IM.IntMap [Int -> Binder -> Binder] ) ]  -- all delta : book keeping: IntMap, mapping input nfa state to op?+>             , D.Dictionary (NFAStates, Int) )+> builder' pdStateTable sig acc_states acc_delta [] dict max_id = (acc_states, acc_delta, dict)+> builder' pdStateTable sig acc_states acc_delta curr_states dict max_id =+>     let all_sofar_states = acc_states `seq` curr_states `seq` +>                            acc_states ++ curr_states +>         insert k f im    = k `seq` im `seq` +>                            case IM.lookup k im of +>                            { Just fs -> IM.update (\_ -> Just (fs ++ [ f ])) k im +>                            ; Nothing -> IM.insert k [f] im+>                            }+> {-+>         new_delta        = [ next_state `seq` f_dict `seq` (curr_state, l, next_state, f_dict) |+>                              curr_state <- curr_states+>                            , l <- sig+>                            , let pairs = curr_state `seq` l `seq` nub2 (concatMap ( \n_state -> lookupPdPat1 pdStateTable n_state l ) curr_state) +>                            , not (null pairs)+>                            , let (next_state, curr_state_and_f_pairs) = pairs `seq` unzip pairs+>                                  f_dict                               = curr_state_and_f_pairs `seq` foldl' (\im (l,f) -> insert l f im) IM.empty curr_state_and_f_pairs+>                            ] +>  -}+>         new_delta        = pdStateTable `seq` curr_states `seq`+>                            concatMap ( \curr_state -> +>                                          map (\l -> +>                                                   let+>                                                       pairs = curr_state `seq` l `seq` nub2 (concatMap' ( \n_state -> lookupPdPat1 pdStateTable n_state l ) curr_state) +>                                                       (next_state, curr_state_and_f_pairs) = pairs `seq` unzip pairs+>                                                       f_dict                               = curr_state_and_f_pairs `seq` +>                                                                                              foldl' (\im (l,f) -> insert l f im) IM.empty curr_state_and_f_pairs+>                                                       in next_state `seq` f_dict `seq` (curr_state, l, next_state, f_dict) ) sig+>                                        )  curr_states+>         new_states       = new_delta `seq` +>                            D.nub [ next_state | +>                                    (_,_,next_state,_) <- new_delta+>                                  , not (next_state `D.isIn` dict) ]+>         acc_delta_next   = acc_delta `seq` new_delta `seq` +>                            (acc_delta ++ new_delta)+>         (dict',max_id')  = new_states `seq` dict `seq` max_id `seq`  +>                            foldl' (\(d,id) p -> (D.insert (D.hash p) (p,id) d, id + 1)) (dict,max_id) new_states +>     in all_sofar_states `seq` new_states `seq` dict' `seq` max_id'`seq` sig `seq` acc_delta_next `seq`+>            builder' pdStateTable sig all_sofar_states acc_delta_next new_states dict' max_id'+++++++the "partial derivative" operations among integer states + binders+++> lookupPdPat1 :: PdPat0Table -> Int -> Letter -> [ ( Int -- next state+>                                                   , ( Int -- current state : used as key to build the hash table+>                                                     , Int -> Binder -> Binder)) ]+> lookupPdPat1 hash_table i (l,_) = +>     let k = my_hash i l+>     in +>       k `seq` +>       case IM.lookup k hash_table of +>                { Just pairs -> +>                      map (\ (j,op) -> +>                               (j, (i, op))) pairs +>                ; Nothing -> [] +>                }++collection function for binder ++> collectPatMatchFromBinder :: Word -> Binder -> Env+> collectPatMatchFromBinder w b = +>     collectPatMatchFromBinder_ w (listifyBinder b)++> collectPatMatchFromBinder_ w [] = []+> collectPatMatchFromBinder_ w ((x,[]):xs) = (x,""):(collectPatMatchFromBinder_ w xs)+> collectPatMatchFromBinder_ w ((x,rs):xs) = (x,foldl' (++) "" $ map (rg_collect w) (reverse rs)):(collectPatMatchFromBinder_ w xs)+++orginally the type was Int -> DPat0Table -> Word -> (Int,[(Int,Binder)]) -> (Int, [(Int,Binder)])+where the first Int is the DFA state, but this leads to a mysterious Stack overflow fiasco, (which I don't have time to investigate why+or able to come out a smallish example)++> patMatchesIntStatePdPat1 :: Int -> DPat0Table -> Word -> [(Int,Int,Binder)] -> [(Int,Int,Binder)]+> patMatchesIntStatePdPat1 cnt dStateTable  w' [] = []+> patMatchesIntStatePdPat1 cnt dStateTable  w' currNfaStateBinders =+>     case  w' of +>       [] -> currNfaStateBinders -- we are done with the matching+>       (l:w) -> +>           let ((i,_,_):_) = currNfaStateBinders  -- i is the current DFA state+>               k           =  l `seq` i `seq` my_hash i l+>           in+>           case IM.lookup k dStateTable of+>             { Nothing -> [] -- "key missing" which means some letter exists in w but not in r.    +>             ; Just (j,next_nfaStates,fDict) -> +>                 let +>                     binders :: [Binder]+>                     binders = +>                               fDict `seq` computeBinders currNfaStateBinders fDict cnt +>                     nextNfaStateBinders = -- io `seq` +>                                           binders `seq` next_nfaStates `seq` j `seq`+>                                           map (\(x,y) -> (j,x,y)) (zip next_nfaStates binders)+>                     cnt' = {-# SCC "cnt" #-} cnt + 1+>                 in nextNfaStateBinders `seq` cnt' `seq` w `seq`+>                        patMatchesIntStatePdPat1 cnt' dStateTable w  nextNfaStateBinders } +++fusing up the computation for binders++> computeBinders :: [(Int,Int,Binder)] -> IM.IntMap [Int -> Binder -> Binder] -> Int -> [Binder]+> computeBinders currNfaStateBinders fDict cnt = +>     cm currNfaStateBinders+>     where +>        cm :: [(Int,Int,Binder)] -> [Binder]+>        cm bs = foldl' k [] bs+>        k :: [Binder] -> (Int,Int,Binder) -> [Binder]+>        k !a (_,!m,!b) = case IM.lookup m fDict of { Nothing -> a; Just !gs -> ((++) a $! (map (\g -> g cnt b) gs)) }  +++> +> concatMap' :: (a -> [b]) -> [a] -> [b]+> concatMap' f x = foldr' ( \ b a -> (++) a $! (f b) ) [] x+> +++> foldr' :: (a -> b -> b) -> b -> [a] -> b+> foldr' f b [] = b+> foldr' f b (a:as) = let b' = f a b +>                     in b' `seq` +>                        foldr' f b' as+++> ++> patMatchIntStatePdPat1 :: Pat -> Word -> [Env]+> patMatchIntStatePdPat1 p w = +>   let+>     (dStateTable,sfinal) = buildDPat0Table p+>     s = 0+>     b = toBinder p+>     allbinders' = b `seq` s `seq` dStateTable `seq` (patMatchesIntStatePdPat1 0 dStateTable w [(0,s,b)])+>     allbinders = allbinders' `seq` map third (filter (\(_,i,_) -> i `elem` sfinal) allbinders' )+>   in map (collectPatMatchFromBinder w) $! allbinders+++> greedyPatMatch' :: Pat -> Word -> Maybe Env+> greedyPatMatch' p w =+>      first (patMatchIntStatePdPat1 p w)+>   where+>     first (env:_) = return env+>     first _ = Nothing+++Compilation+++> compilePat :: Pat -> (DPat0Table, [Int], Binder)+> compilePat p =  (dStateTable, sfinal, b)+>     where +>           (dStateTable,sfinal) = buildDPat0Table p+>           b = toBinder p++> patMatchIntStateCompiled :: (DPat0Table, [Int], Binder) -> Word -> [Env]+> patMatchIntStateCompiled (dStateTable,sfinal,b) w = +>   let+>     s = 0 +>     e = [(0,0,b)]+>     allbinders' = e `seq` b `seq` s `seq` dStateTable `seq` (patMatchesIntStatePdPat1 0 dStateTable w e ) +>     allbinders = allbinders' `seq` map third (filter (\(_,i,_) -> i `elem` sfinal) allbinders' )+>   in allbinders `seq` map (collectPatMatchFromBinder w) allbinders++> third :: (a,b,c) -> c+> third (_,_,x) = x++> greedyPatMatchCompiled :: (DPat0Table, [Int], Binder) -> Word -> Maybe Env+> greedyPatMatchCompiled compiled w =+>      first (patMatchIntStateCompiled compiled w)+>   where+>     first (env:_) = return env+>     first _ = Nothing++++> -- | The PDeriv backend spepcific 'Regex' type++> newtype Regex = Regex (DPat0Table, [Int], Binder) +++-- todo: use the CompOption and ExecOption++> compile :: CompOption -- ^ Flags (summed together)+>         -> ExecOption -- ^ Flags (summed together) +>         -> String -- ^ The regular expression to compile+>         -> Either String Regex -- ^ Returns: the compiled regular expression+> compile compOpt execOpt bs =+>     case parsePat bs of+>     Left err -> Left ("parseRegex for Text.Regex.PDeriv.ByteString failed:"++show err)+>     Right pat -> Right (patToRegex pat compOpt execOpt)+>     where +>       patToRegex p _ _ = Regex (compilePat $ simplify p)++++> execute :: Regex      -- ^ Compiled regular expression+>        -> String -- ^ String to match against+>        -> Either String (Maybe Env)+> execute (Regex r) bs = Right (greedyPatMatchCompiled r bs)++> regexec :: Regex      -- ^ Compiled regular expression+>        -> String -- ^ String to match against+>        -> Either String (Maybe (String, String, String, [String]))+> regexec (Regex r) bs = -- r `seq` Right Nothing+>  case greedyPatMatchCompiled r bs of+>    Nothing -> Right (Nothing)+>    Just env ->+>      let pre = case lookup preBinder env of { Just w -> w ; Nothing -> [] }+>          post = case lookup subBinder env of { Just w -> w ; Nothing -> [] }+>          main = case lookup mainBinder env of { Just w -> w ; Nothing -> [] }+>          matched = map snd (filter (\(v,w) -> v > 0) env)+>      in Right (Just (pre,main,post,matched))++> -- | Control whether the pattern is multiline or case-sensitive like Text.Regex and whether to+> -- capture the subgroups (\1, \2, etc).  Controls enabling extra anchor syntax.+> data CompOption = CompOption {+>       caseSensitive :: Bool    -- ^ True in blankCompOpt and defaultCompOpt+>     , multiline :: Bool +>   {- ^ False in blankCompOpt, True in defaultCompOpt. Compile for+>   newline-sensitive matching.  "By default, newline is a completely ordinary+>   character with no special meaning in either REs or strings.  With this flag,+>   inverted bracket expressions and . never match newline, a ^ anchor matches the+>   null string after any newline in the string in addition to its normal+>   function, and the $ anchor matches the null string before any newline in the+>   string in addition to its normal function." -}+>     , rightAssoc :: Bool       -- ^ True (and therefore Right associative) in blankCompOpt and defaultCompOpt+>     , newSyntax :: Bool        -- ^ False in blankCompOpt, True in defaultCompOpt. +>     , lastStarGreedy ::  Bool  -- ^ False by default.  This is POSIX correct but it takes space and is slower.+>                                -- Setting this to true will improve performance, and should be done+>                                -- if you plan to set the captureGroups execoption to False.+>     } deriving (Read,Show)++> data ExecOption = ExecOption  {+>   captureGroups :: Bool    -- ^ True by default.  Set to False to improve speed (and space).+>   } deriving (Read,Show)++> instance RegexOptions Regex CompOption ExecOption where+>     blankCompOpt =  CompOption { caseSensitive = True+>                                , multiline = False+>                                , rightAssoc = True+>                                , newSyntax = False+>                                , lastStarGreedy = False+>                                  }+>     blankExecOpt =  ExecOption { captureGroups = True }+>     defaultCompOpt = CompOption { caseSensitive = True+>                                 , multiline = True+>                                 , rightAssoc = True+>                                 , newSyntax = True+>                                 , lastStarGreedy = False+>                                   }+>     defaultExecOpt =  ExecOption { captureGroups = True }+>     setExecOpts e r = undefined+>     getExecOpts r = undefined ++
Text/Regex/PDeriv/Translate.lhs view
@@ -204,6 +204,13 @@ >          ; p <- trans' e -- no need to go through trans which possible tag p with a posix var >          ; return ( PVar i [] p) >          }+>       {-+>         e ~> p+>         -----------------+>         (? e ) ~>_p p +>        -}+>     ; EGroupNonMarking e -> +>         trans' e >     ; EOr es ->  >         {- >           e1 ~> p1  e2 ~> p2@@ -417,6 +424,13 @@ >          e ~> r >         ---------- >         (e) ~> r+>        -}+>       r_trans e+>     ; EGroupNonMarking e ->+>       {- we might not need this rule+>          e ~> r+>         ----------+>         (?e) ~> r >        -} >       r_trans e >     ; EOr es ->
regex-pderiv.cabal view
@@ -1,5 +1,5 @@ Name:                   regex-pderiv-Version:                0.1.0+Version:                0.1.1 License:                BSD3 License-File:           LICENSE Copyright:              Copyright (c) 2010, Kenny Zhuo Ming Lu and Martin Sulzmann@@ -19,7 +19,7 @@  library    Build-Depends:        regex-base >= 0.93.1, parsec, mtl, containers, bytestring, deepseq-  Build-Depends:	bitset+  Build-Depends:	bitset, parallel   Build-Depends:         base >= 4.0 && < 5.0, ghc-prim   Exposed-Modules:       Text.Regex.PDeriv.ByteString                          Text.Regex.PDeriv.ByteString.TwoPasses@@ -27,6 +27,8 @@                          Text.Regex.PDeriv.ByteString.LeftToRight                          Text.Regex.PDeriv.ByteString.LeftToRightD                          Text.Regex.PDeriv.ByteString.Posix+                         Text.Regex.PDeriv.String+                         Text.Regex.PDeriv.String.LeftToRightD                          Text.Regex.PDeriv.Common                           Text.Regex.PDeriv.Word                          Text.Regex.PDeriv.ExtPattern@@ -39,5 +41,5 @@                          Text.Regex.PDeriv.Dictionary   Buildable:              True   Extensions:             GADTs, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances, FlexibleContexts-  GHC-Options:            -threaded+  GHC-Options:            -threaded -funbox-strict-fields   GHC-Prof-Options:       -auto-all