regex-pderiv 0.0.9 → 0.1.0

raw patch · 10 files changed

+240/−82 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/Regex/PDeriv/ByteString/LeftToRight.lhs +4/−4
• Text/Regex/PDeriv/ByteString/LeftToRightD.lhs +23/−12
• Text/Regex/PDeriv/ByteString/Posix.lhs +8/−7
• Text/Regex/PDeriv/ByteString/RightToLeft.lhs +29/−12
• Text/Regex/PDeriv/ByteString/TwoPasses.lhs +5/−5
• Text/Regex/PDeriv/Common.lhs +20/−4
• Text/Regex/PDeriv/IntPattern.lhs +67/−9
• Text/Regex/PDeriv/RE.lhs +62/−17
• Text/Regex/PDeriv/Translate.lhs +18/−9
• regex-pderiv.cabal +4/−3

@@ -34,8 +34,8 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, IsEmpty(..), my_hash, my_lookup, GFlag(..), IsEmpty(..), nub2, preBinder, mainBinder, subBinder)-> import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, toBinder, Binder(..), strip, listifyBinder)+> 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) @@ -71,7 +71,7 @@ >     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, isEmpty (strip s)]                   -- the final states+>         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, @@ -312,7 +312,7 @@ >     Left err -> Left ("parseRegex for Text.Regex.PDeriv.ByteString failed:"++show err) >     Right pat -> Right (patToRegex pat compOpt execOpt) >     where ->       patToRegex p _ _ = Regex (compilePat p)+>       patToRegex p _ _ = Regex (compilePat $ simplify p)   

@@ -27,6 +27,10 @@ > import qualified Data.ByteString.Char8 as S > import Control.DeepSeq +> -- import Control.Parallel +> -- import Control.Parallel.Strategies hiding (Seq)++ > import System.IO.Unsafe (unsafePerformIO)  > import Text.Regex.Base(RegexOptions(..))@@ -34,8 +38,8 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, IsEmpty(..), my_hash, my_lookup, GFlag(..), IsEmpty(..), nub2, preBinder, mainBinder, subBinder)-> import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, toBinder, Binder(..), strip, listifyBinder)+> 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) @@ -71,7 +75,7 @@ >     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, isEmpty (strip s)]                       -- the final states+>         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, @@ -112,7 +116,7 @@ >     | otherwise =  >         let  >             all_sofar_states = acc_states ++ curr_states->             new_delta = [ (s, l, sfs) | s <- curr_states, l <- sig, let sfs = pdPat0 s l]+>             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)@@ -142,7 +146,7 @@ >         -- 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, isEmpty (strip s)]                       -- the final states+>         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) | @@ -282,20 +286,20 @@ > patMatchesIntStatePdPat1 cnt dStateTable  w' [] = [] > patMatchesIntStatePdPat1 cnt dStateTable  w' currNfaStateBinders = >     case {-# SCC "uncons" #-} S.uncons w' of ->       Nothing -> currNfaStateBinders+>       Nothing -> currNfaStateBinders -- we are done with the matching >       Just (l,w) -> ->           let ((i,_,_):_) = currNfaStateBinders+>           let ((i,_,_):_) = currNfaStateBinders  -- i is the current DFA state >               k           = {-# SCC "k" #-} l `seq` i `seq` my_hash i l >           in >           case k `seq` IM.lookup k dStateTable of->             { Nothing -> [] -- key miss means some letter exists in w but not in r.    +>             { 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` map (\f -> f cnt b) fs ) currNfaStateBinders +>                                                        Just fs -> b `seq` fs `seq` map (\f -> f cnt b) fs ) currNfaStateBinders  >                     nextNfaStateBinders = {-# SCC "nextNfaStateBinders" #-} -- io `seq`  >                                           binders `seq` next_nfaStates `seq` j `seq` >                                           map (\(x,y) -> (j,x,y)) (zip next_nfaStates binders)@@ -303,9 +307,17 @@ >                 in nextNfaStateBinders `seq` cnt' `seq` w `seq` >                        patMatchesIntStatePdPat1 cnt' dStateTable w  nextNfaStateBinders }  +> {- > concatMap' :: (a -> [b]) -> [a] -> [b]+> concatMap' f x = reverse $ foldr ( \ b a -> (++) (f b) $! a) [] x                                +> -}++> +> 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 @@ -386,7 +398,7 @@ >     Left err -> Left ("parseRegex for Text.Regex.PDeriv.ByteString failed:"++show err) >     Right pat -> Right (patToRegex pat compOpt execOpt) >     where ->       patToRegex p _ _ = Regex (compilePat p)+>       patToRegex p _ _ = Regex (compilePat $ simplify p)   @@ -398,7 +410,7 @@ > regexec :: Regex      -- ^ Compiled regular expression >        -> S.ByteString -- ^ ByteString to match against >        -> Either String (Maybe (S.ByteString, S.ByteString, S.ByteString, [S.ByteString]))-> regexec (Regex r) bs =+> regexec (Regex r) bs = -- r `seq` Right Nothing >  case greedyPatMatchCompiled r bs of >    Nothing -> Right (Nothing) >    Just env ->@@ -413,7 +425,6 @@ >          main = case lookup mainBinder env of { Just w -> w ; Nothing -> S.empty } >          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.

@@ -43,7 +43,7 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, IsEmpty(..), my_hash, my_lookup, GFlag(..), IsEmpty(..), 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)@@ -82,7 +82,7 @@ >     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, isEmpty (strip s)]                   --  the final states+>         final = all `seq`  [ s | s <- all, posEpsilon (strip s)]                   --  the final states >         sfinal = final `seq` dictionary `seq` map (mapping dictionary) final >         lists = delta `seq` dictionary `seq` [ (j, l, (i,f,flag,gf)) | (p,l,f,q,flag,gf) <- delta,  >                                                let i = mapping dictionary p  @@ -154,7 +154,7 @@ > lookupPdPat0' :: PdPat0TableRev -> (Int,Binder) -> Letter -> [(Int,Binder,Int,Bool)] > lookupPdPat0' hash_table (i,b) (l,x) =  >     case IM.lookup (my_hash i l) hash_table of->     Just quatripples -> [ (j, op x b, p, gf) | (j, op, p, gf) <- quatripples ]+>     Just quatripples -> [ b' `seq` (j, b', p, gf) | (j, op, p, gf) <- quatripples, let b' =  op x b ] >     Nothing -> []   > {- | map pattern variable to greedy flag@@ -314,12 +314,13 @@  a function that updates the binder given an index (that is the pattern var) ASSUMPTION: the  var index in the pattern is linear. e.g. no ( 0 :: R1, (1 :: R2, 2 :: R3))+The update start from the last pos of the input string, ending with the first pos of the input.  > updateBinderByIndex :: Int  >                     -> Int  >                     -> Binder  >                     -> Binder-> updateBinderByIndex i pos binder = +> updateBinderByIndex i pos binder = -- binder {- >     case IM.lookup i binder of >       { Nothing -> IM.insert i [(pos,pos+1)] binder >       ; Just ranges -> @@ -331,7 +332,7 @@ >           | pos < (b - 1) -> IM.update (\_ -> Just ((pos,pos+1):(b,e):rs)) i binder >           | otherwise     -> error ("impossible, the current letter position is greater than the last recorded letter" ++ show i ++ show pos ++ show (b,e)) >         }->       }+>       } -- -}  > {- > updateBinderByIndex :: Int    -- ^ pattern variable index@@ -421,11 +422,11 @@ >                      -- in [ (PPlus p' (PStar p), f) | (p', f) <- pfs ] > {- > pdPat0 (PPlus p1 p2@(PStar _)) l  -- we drop this case since it make difference with the PPair->        | isEmpty (strip p1) = [ (PPlus p3 p2, f) | (p3,f) <- pdPat0 p1 l ] ++ (pdPat0 p2 l) -- simply drop p1 since it is empty+>        | posEpsilon (strip p1) = [ (PPlus p3 p2, f) | (p3,f) <- pdPat0 p1 l ] ++ (pdPat0 p2 l) -- simply drop p1 since it is empty >        | otherwise = [ (PPlus p3 p2, f) | (p3,f) <- pdPat0 p1 l ]  > -} > pdPat0 (PPair p1 p2) l = ->     if (isEmpty (strip p1))+>     if (posEpsilon (strip p1)) >     then if isGreedy p1 >          then nub3 ([ (PPair p1' p2, f, True) | (p1' , f, _ ) <- pdPat0 p1 l ] ++ (pdPat0 p2 l)) >          else nub3 ((pdPat0 p2 l) ++ [ (PPair p1' p2, f, False) | (p1' , f, _) <- pdPat0 p1 l ])

@@ -31,8 +31,8 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, IsEmpty(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), nub3, preBinder, mainBinder, subBinder) -> import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, toBinder, Binder(..), strip, listifyBinder)+> 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) @@ -69,7 +69,7 @@ >     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, isEmpty (strip s)]                   -- the final states+>         final = all `seq`  [ s | s <- all, posEpsilon (strip s)]                   -- the final states >         sfinal = final `seq` dictionary `seq` map (mapping dictionary) final >         lists = delta `seq` dictionary `seq` [ (j, l, (i,f,flag)) | (p,l,f,q,flag) <- delta,  >                                                let i = mapping dictionary p  @@ -119,7 +119,7 @@ >             (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'  -> pdPat0Flag p l = let qfs = pdPat0 p l+> pdPat0Flag p l = let qfs = pdPat0Sim p l >                  in case qfs of  >                       []        -> [] >                       [ (q,f) ] -> [ ((q,f),0) ] @@ -157,6 +157,18 @@   +> patMatchesIntStatePdPat0Rev'  :: Int -> PdPat0TableRev -> Word -> [(Int, [Binder -> Binder], Int)] -> [(Int, [Binder -> Binder], Int )]+> patMatchesIntStatePdPat0Rev'  cnt pdStateTableRev w fs =+>     case {-# SCC "myuncons" #-} S.uncons w of +>       Nothing -> fs+>       Just (l,w') -> +>           let +>               fs' = nub3 [ g `seq` (j, g, pri) | (i, f, _) <- fs, (j, f', pri) <- lookupPdPat0' pdStateTableRev i (l,cnt), let g = (f' cnt):f ]+>               cnt' = {-# SCC "cnt_minus_one" #-} cnt - 1+>           in fs' `seq` cnt' `seq` patMatchesIntStatePdPat0Rev' cnt' pdStateTableRev w' fs'+++ > patMatchIntStatePdPat0Rev :: Pat -> Word -> [Env] > patMatchIntStatePdPat0Rev p w =  >     let@@ -164,10 +176,12 @@ >         b = toBinder p >         l = S.length w >         w' = S.reverse w->         fs = [ (i, id, 0) | i <- fins ]->         fs' =  w' `seq` fins `seq` l `seq` pdStateTableRev `seq` (patMatchesIntStatePdPat0Rev (l-1) pdStateTableRev w' fs)->         -- fs'' = my_sort fs'->         allbinders = b `seq` [ (f b) | (s,f,_) <- fs', s == 0 ]+>         -- fs = [ (i, id, 0) | i <- fins ]+>         -- fs' =  w' `seq` fins `seq` l `seq` pdStateTableRev `seq` (patMatchesIntStatePdPat0Rev (l-1) pdStateTableRev w' fs)+>         -- allbinders = b `seq` [ (f b) | (s,f,_) <- fs', s == 0 ]+>         fs = [ (i, [], 0) | i <- fins ]+>         fs' =  w' `seq` fins `seq` l `seq` pdStateTableRev `seq` (patMatchesIntStatePdPat0Rev' (l-1) pdStateTableRev w' fs)+>         allbinders = b `seq` [ (foldl' (\x g -> (g x)) b f) | (s,f,_) <- fs', s == 0 ] >     in map (collectPatMatchFromBinder w) allbinders >                       @@ -196,10 +210,13 @@ >     let >         l = S.length w >         w' = S.reverse w->         fs = [ (i, id, i) | i <- fins ]->         fs' = w' `seq` fs `seq`  l `seq` pdStateTable `seq` (patMatchesIntStatePdPat0Rev (l-1) pdStateTable w' fs)+>         -- fs = [ (i, id, i) | i <- fins ]+>         -- 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 `seq` [ (f b) | (s,f,_) <- fs', s == 0 ]+>         -- allbinders = fs' `seq` b `seq` [ (f b) | (s,f,_) <- fs', s == 0 ]+>         fs = [ (i, [], 0) | i <- fins ]+>         fs' =  w' `seq` fins `seq` l `seq` pdStateTable `seq` (patMatchesIntStatePdPat0Rev' (l-1) pdStateTable w' fs)+>         allbinders = b `seq` [ (foldl' (\x g -> (g x)) b f) | (s,f,_) <- fs', s == 0 ] >     in allbinders `seq` map (collectPatMatchFromBinder w) allbinders >        @@ -230,7 +247,7 @@ >     Left err -> Left ("parseRegex for Text.Regex.PDeriv.ByteString failed:"++show err) >     Right pat -> Right (patToRegex pat compOpt execOpt) >     where ->       patToRegex p _ _ = Regex (compilePat p)+>       patToRegex p _ _ = Regex (compilePat $ simplify p)   

@@ -33,8 +33,8 @@  > import Text.Regex.PDeriv.RE > import Text.Regex.PDeriv.Pretty (Pretty(..))-> import Text.Regex.PDeriv.Common (Range, Letter, IsEmpty(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), nub2, preBinder, mainBinder, subBinder)-> import Text.Regex.PDeriv.IntPattern (Pat(..), pdPat, pdPat0, toBinder, Binder(..), strip, listifyBinder)+> 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) @@ -105,7 +105,7 @@ >     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, isEmpty (strip s)]                   --  the final states+>         final = all `seq`  [ s | s <- all, posEpsilon (strip s)]                   --  the final states >         sfinal = final `seq` dictionary `seq` map (mapping dictionary) final >         sdelta = [ (i,l,jfs) |  >                   (p,l, qfs) <- delta, @@ -156,7 +156,7 @@ >     | otherwise =  >         let  >             all_sofar_states = acc_states ++ curr_states->             new_delta = [ (s, l, sfs) | s <- curr_states, l <- sig, let sfs = pdPat0 s l]+>             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)@@ -259,7 +259,7 @@ >     Left err -> Left ("parseRegex for Text.Regex.PDeriv.ByteString failed:"++show err) >     Right pat -> Right (patToRegex pat compOpt execOpt) >     where ->       patToRegex p _ _ = Regex (compilePat p)+>       patToRegex p _ _ = Regex (compilePat $ simplify p)   

@@ -2,7 +2,10 @@ > module Text.Regex.PDeriv.Common  >     ( Range >     , Letter->     , IsEmpty (..)+>     , PosEpsilon (..)+>     , IsEpsilon (..)+>     , IsPhi (..)+>     , Simplifiable (..) >     , my_hash >     , my_lookup >     , GFlag (..)@@ -25,9 +28,22 @@ > -- | a character and its index (position) > type Letter = (Char,Int)      -> class IsEmpty a where->     isEmpty :: a -> Bool+> -- | test for 'epsilon \in a' epsilon-possession+> class PosEpsilon a where+>     posEpsilon :: a -> Bool +> -- | test for epsilon == a+> class IsEpsilon a where+>     isEpsilon :: a -> Bool++> -- | test for \phi == a+> class IsPhi a where+>     isPhi :: a -> Bool++> class Simplifiable a where+>     simplify :: a -> a++ > my_hash :: Int -> Char -> Int > my_hash i x = (ord x) + 256 * i @@ -101,7 +117,7 @@ > nub3subsimple im [ x ] = [ x ] > nub3subsimple im (x@(k,f,0):xs) = x:(nub3subsimple im xs) > nub3subsimple im (x@(k,f,1):xs) = let im' = IM.insert k () im->                                   in x:(nub3subsimple im' xs)+>                                   in im' `seq` x:(nub3subsimple im' xs) > nub3subsimple im (x@(k,f,n):xs) = case IM.lookup k im of  >                                   Just _ -> nub3subsimple im xs >                                   Nothing -> let im' = IM.insert k () im

@@ -9,13 +9,14 @@ >     , listifyBinder >  --  , updateBinderByIndex >     , pdPat0+>     , pdPat0Sim >     , nub2 >     ) >     where  > import Data.List > import qualified Data.IntMap as IM-> import Text.Regex.PDeriv.Common (Range, Letter, IsEmpty(..), GFlag(..), IsGreedy(..) )+> import Text.Regex.PDeriv.Common (Range, 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@@ -99,7 +100,7 @@ > mkEmpPat :: Pat -> Pat > mkEmpPat (PVar x w p) = PVar x w (mkEmpPat p) > mkEmpPat (PE r) ->   | isEmpty r = PE Empty+>   | posEpsilon r = PE Empty >   | otherwise = PE Phi > mkEmpPat (PStar p g) = PE Empty -- problematic?! we are losing binding (x,()) from  ( x : a*) ~> PE <> > mkEmpPat (PPlus p1 p2) = mkEmpPat p1 -- since p2 must be pstar we drop it. If we mkEmpPat p2, we need to deal with pdPat (PPlus (x :<>) (PE <>)) l@@ -140,7 +141,7 @@ >     first sub pattern is non-greedy. We simply swap the order of the  >     'choices' in the resulting pds. -}  > pdPat (PPair p1 p2) l = ->   if (isEmpty (strip p1))+>   if (posEpsilon (strip p1)) >   then  if isGreedy p1 >         then nub ([ PPair p1' p2 | p1' <- pdPat p1 l] ++  >                   [ PPair (mkEmpPat p1) p2' | p2' <- pdPat p2 l])@@ -159,7 +160,7 @@ >     Shall we swap the order of the alternatives when p' is non-greedy? >     Why not? This seems harmless since we have already made some progress by pushing l into p*. -} > pdPat (PPlus p1 p2@(PStar _ _)) l -- p2 must be pStar->     | isEmpty (strip p1) = +>     | posEpsilon (strip p1) =  >         if isGreedy p1  >         then [ PPlus p3 p2 | p3  <- pdPat p1 l ] ++ [ PPlus p3 p2' | (PPlus p1' p2') <- pdPat p2 l, let p3 =  p1' `getBindingsFrom` p1 ] >         else [ PPlus p3 p2' | (PPlus p1' p2') <- pdPat p2 l, let p3 =  p1' `getBindingsFrom` p1 ] ++ [ PPlus p3 p2 | p3  <- pdPat p1 l ]@@ -230,14 +231,14 @@ >                     -> 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->                       { [] -> Just [(pos,pos)] ->                       ; ((b,e):rs)+>                       {  ((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"   ->                       } ) i binder +>                       ; [] -> Just [(pos,pos)] +>                       } ) i binder -- -} > {- > updateBinderByIndex i pos binder =  >     case IM.lookup i binder of@@ -302,7 +303,7 @@ > pdPat0 (PStar p g) l = let pfs = pdPat0 p l >                        in pfs `seq` [ (PPair p' (PStar p g), f) | (p', f) <- pfs ] > pdPat0 (PPair p1 p2) l = ->     if (isEmpty (strip p1))+>     if (posEpsilon (strip p1)) >     then if isGreedy p1 >          then nub2 ([ (PPair p1' p2, f) | (p1' , f) <- pdPat0 p1 l ] ++ (pdPat0 p2 l)) >          else nub2 ((pdPat0 p2 l) ++ [ (PPair p1' p2, f) | (p1' , f) <- pdPat0 p1 l ])@@ -313,3 +314,60 @@  > nub2 :: Eq a => [(a,b)] -> [(a,b)] > nub2 = nubBy (\(p1,f1) (p2, f2) -> p1 == p2) +++> {-| Function 'pdPat0Sim' applies simplification to the results of 'pdPat0' -}+> pdPat0Sim :: Pat -- ^ the source pattern +>              -> Letter -- ^ the letter to be "consumed"+>              -> [(Pat, Int -> Binder -> Binder)]+> pdPat0Sim p l = +>      let pfs = pdPat0 p l+>          pfs' = pfs `seq` map (\(p,f) -> (simplify p, f)) pfs+>      in nub2 pfs'++++> -- | mainly interested in simplifying epsilon, p --> p+> -- could be made more optimal, e.g. (epsilon, epsilon) --> epsilon+> instance Simplifiable Pat where+>     -- simplify :: Pat -> Pat+>     simplify (PVar i rs p) = PVar i rs (simplify p)+>     simplify (PPair p1 p2) =+>         let p1' = simplify p1+>             p2' = simplify p2+>         in if isEpsilon p1'+>            then p2'+>            else if isEpsilon p2'+>                 then p1'+>                 else PPair p1' p2'+>     simplify (PChoice p1 p2 g) =+>         let p1' = simplify p1+>             p2' = simplify p2+>         in if isPhi p2'+>            then p1'+>            else if isPhi p1'+>                 then p2'+>                 else PChoice p1' p2' g+>     simplify (PStar p g) = PStar (simplify p) g+>     simplify (PPlus p1 p2) = PPlus (simplify p1) (simplify p2)+>     simplify (PE r) = PE (simplify r)+++> instance IsEpsilon Pat where+>    isEpsilon (PVar _ _ p) = isEpsilon p+>    isEpsilon (PE r) = isEpsilon r                                                        +>    isEpsilon (PPair p1 p2) =  (isEpsilon p1) && (isEpsilon p2)+>    isEpsilon (PChoice p1 p2 _) =  (isEpsilon p1) && (isEpsilon p2)+>    isEpsilon (PStar p _) = isEpsilon p+>    isEpsilon (PPlus p1 p2) = isEpsilon p1 && isEpsilon p2+>    isEpsilon (PEmpty _) = True+                                                        ++> instance IsPhi Pat where+>    isPhi (PVar _ _ p) = isPhi p+>    isPhi (PE r) = isPhi r                                                        +>    isPhi (PPair p1 p2) =  (isPhi p1) || (isPhi p2)+>    isPhi (PChoice p1 p2 _) =  (isPhi p1) && (isPhi p2)+>    isPhi (PStar p _) = False+>    isPhi (PPlus p1 p2) = isPhi p1 || isPhi p2+>    isPhi (PEmpty _) = False

@@ -7,7 +7,7 @@ > import Data.List (nub) > import Data.Char (chr) -> import Text.Regex.PDeriv.Common (IsEmpty(..), IsGreedy(..), GFlag(..))+> import Text.Regex.PDeriv.Common (PosEpsilon(..), IsEpsilon(..), IsPhi(..), Simplifiable(..), IsGreedy(..), GFlag(..)) > import Text.Regex.PDeriv.Dictionary (Key(..), primeL, primeR)  ------------------------@@ -30,7 +30,7 @@ >     (==) (Seq r1 r2) (Seq r3 r4) = (r1 == r3) && (r2 == r4) >     (==) (Star r1 g1) (Star r2 g2) = g1 == g2 && r1 == r2  >     (==) Any Any = True->     (==) (Not cs) (Not cs') = cs == cs'+>     (==) (Not cs) (Not cs') = cs == cs'  >     (==) _ _ = False  @@ -85,18 +85,40 @@ > resToRE (r:res) = foldl (\x y -> Choice x y Greedy) r res > resToRE [] = Phi -> -- | function 'isEmpty' checks whether regular expressions are empty-> instance IsEmpty RE where->   isEmpty Phi = False->   isEmpty Empty = True->   isEmpty (Choice r1 r2 g) = (isEmpty r1) || (isEmpty r2)->   isEmpty (Seq r1 r2) = (isEmpty r1) && (isEmpty r2)->   isEmpty (Star r g) = True->   isEmpty (L _) = False->   isEmpty Any = False->   isEmpty (Not _) = False++> instance PosEpsilon RE where+>   posEpsilon Phi = False+>   posEpsilon Empty = True+>   posEpsilon (Choice r1 r2 g) = (posEpsilon r1) || (posEpsilon r2)+>   posEpsilon (Seq r1 r2) = (posEpsilon r1) && (posEpsilon r2)+>   posEpsilon (Star r g) = True+>   posEpsilon (L _) = False+>   posEpsilon Any = False+>   posEpsilon (Not _) = False          +> -- | function 'isEpsilon' checks whether epsilon = r+> instance IsEpsilon RE where+>   isEpsilon Phi = False+>   isEpsilon Empty = True+>   isEpsilon (Choice r1 r2 g) = (isEpsilon r1) && (isEpsilon r2)+>   isEpsilon (Seq r1 r2) = (isEpsilon r1) && (isEpsilon r2)+>   isEpsilon (Star Phi g) = True+>   isEpsilon (Star r g) = isEpsilon r+>   isEpsilon (L _) = False+>   isEpsilon Any = False+>   isEpsilon (Not _) = False++> instance IsPhi RE where+>   isPhi Phi = True+>   isPhi Empty = False+>   isPhi (Choice r1 r2 g) = (isPhi r1) && (isPhi r2)+>   isPhi (Seq r1 r2) = (isPhi r1) || (isPhi r2)+>   isPhi (Star r g) = False+>   isPhi (L _) = False+>   isPhi Any = False+>   isPhi (Not _) = False+ > -- | function 'partDeriv' implements the partial derivative operations for regular expressions. We don't pay attention to the greediness flag here. > partDeriv :: RE -> Char -> [RE] > partDeriv r l = nub (partDerivSub r l)@@ -115,22 +137,22 @@ >     let  >         s1 = partDerivSub r1 l  >         s2 = partDerivSub r2 l->     in {- s1 `seq` s2 `seq` -} (s1 ++ s2)+>     in s1 `seq` s2 `seq` (s1 ++ s2) > partDerivSub (Seq r1 r2) l ->     | isEmpty r1 = +>     | posEpsilon r1 =  >           let  >               s0 = partDerivSub r1 l >               s1 = s0 `seq` [ (Seq r1' r2) | r1' <- s0 ] >               s2 = partDerivSub r2 l->           in {- s1 `seq` s2 `seq` -} (s1 ++ s2)+>           in s1 `seq` s2 `seq` (s1 ++ s2) >     | otherwise =  >         let  >             s0 = partDerivSub r1 l ->         in {- s0 `seq` -} [ (Seq r1' r2) | r1' <- s0 ]+>         in s0 `seq` [ (Seq r1' r2) | r1' <- s0 ] > partDerivSub (Star r g) l =  >     let >         s0 = partDerivSub r l->     in {- s0 `seq` -} [ (Seq r' (Star r g)) | r' <- s0 ]+>     in s0 `seq` [ (Seq r' (Star r g)) | r' <- s0 ]  > -- | function 'sigmaRE' returns all characters appearing in a reg exp. > sigmaRE :: RE -> [Char]@@ -146,3 +168,26 @@ > sigmaREsub Phi = [] > sigmaREsub Empty = [] +> instance Simplifiable RE where+>     simplify (L l) = L l+>     simplify Any   = Any+>     simplify (Not cs) = Not cs+>     simplify (Seq r1 r2) = +>         let r1' = simplify r1+>             r2' = simplify r2+>         in if isEpsilon r1'+>            then r2'+>            else if isEpsilon r2'+>                 then r1'+>                 else Seq r1' r2'+>     simplify (Choice r1 r2 g) = +>         let r1' = simplify r1+>             r2' = simplify r2+>         in if isPhi r1'+>            then r2'+>            else if isPhi r2'+>                 then r1'+>                 else Choice r1' r2' g+>     simplify (Star r g) = Star (simplify r) g+>     simplify Phi = Phi+>     simplify Empty = Empty

@@ -134,7 +134,7 @@ > trans :: EPat -> State TState Pat > trans epat =  >     do { is_posix <- isPosix -- if it is posix, we need to aggresively "tag" every sub expression with a binder->        ; if is_posix +>        ; if is_posix && isStructural epat >          then do  >            { gi <- getIncGI >            ; ipat <- trans' epat@@ -143,14 +143,22 @@ >            } >          else trans' epat >        }->     where trans' :: EPat -> State TState Pat->           trans' epat ->               | hasGroup epat = p_trans epat->               | otherwise     = do ->                                 { r <- r_trans epat->                                 ; return (PE r)->                                 }+>     where isStructural :: EPat -> Bool -- ^ indicate whether it is a complex structure which we need to add extra binding for POSIX tracking+>           isStructural (EOr _)     = True+>           isStructural (EConcat _) = True                                                                      +>           isStructural (EOpt _ _)  = True+>           isStructural (EPlus _ _) = True+>           isStructural (EStar _ _) = True+>           isStructural _           = False                                                                       +> trans' :: EPat -> State TState Pat+> trans' epat +>      | hasGroup epat = p_trans epat+>      | otherwise     = do +>                 { r <- r_trans epat+>                 ; return (PE r)+>                 }+ > {- > trans :: EPat -> State TState Pat > trans epat | hasGroup epat = p_trans epat@@ -192,7 +200,8 @@ >       -} >     ; EGroup e -> >       do { i <- getIncGI->          ; p <- trans e+>          ; -- p <- trans e+>          ; p <- trans' e -- no need to go through trans which possible tag p with a posix var >          ; return ( PVar i [] p) >          } >     ; EOr es -> 

@@ -1,5 +1,5 @@ Name:                   regex-pderiv-Version:                0.0.9+Version:                0.1.0 License:                BSD3 License-File:           LICENSE Copyright:              Copyright (c) 2010, Kenny Zhuo Ming Lu and Martin Sulzmann@@ -18,7 +18,8 @@ flag base4  library -  Build-Depends:        regex-base >= 0.93.1, parsec, mtl, containers, bytestring, deepseq, bitset+  Build-Depends:        regex-base >= 0.93.1, parsec, mtl, containers, bytestring, deepseq+  Build-Depends:	bitset   Build-Depends:         base >= 4.0 && < 5.0, ghc-prim   Exposed-Modules:       Text.Regex.PDeriv.ByteString                          Text.Regex.PDeriv.ByteString.TwoPasses@@ -38,5 +39,5 @@                          Text.Regex.PDeriv.Dictionary   Buildable:              True   Extensions:             GADTs, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, TypeSynonymInstances, FlexibleContexts-  GHC-Options:            +  GHC-Options:            -threaded   GHC-Prof-Options:       -auto-all