packages feed

regex-pderiv 0.0.8.2 → 0.0.9

raw patch · 10 files changed

+363/−118 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Text.Regex.PDeriv.Common: maxBinder :: Int
- Text.Regex.PDeriv.Common: minBinder :: Int
+ Text.Regex.PDeriv.Common: mainBinder :: Int
+ Text.Regex.PDeriv.Common: preBinder :: Int
+ Text.Regex.PDeriv.Common: preBinder_ :: Int
+ Text.Regex.PDeriv.Common: subBinder :: Int
+ Text.Regex.PDeriv.Parse: parsePatPosix :: String -> Either ParseError (Pat, IntMap ())
+ Text.Regex.PDeriv.Translate: translatePosix :: EPat -> (Pat, IntMap ())
- Text.Regex.PDeriv.ByteString.Posix: type Regex = (PdPat0TableRev, [Int], Binder)
+ Text.Regex.PDeriv.ByteString.Posix: type Regex = (PdPat0TableRev, [Int], Binder, FollowBy, IntMap ())

Files

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, IsEmpty(..), my_hash, my_lookup, GFlag(..), IsEmpty(..), nub2, minBinder, maxBinder)+> 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.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -328,14 +328,15 @@ >  case greedyPatMatchCompiled r bs of >    Nothing -> Right (Nothing) >    Just env ->->      let pre = case lookup minBinder env of { Just w -> w ; Nothing -> S.empty }->          post = case lookup maxBinder env of { Just w -> w ; Nothing -> S.empty }->          full_len = S.length bs+>      let pre = case lookup preBinder env of { Just w -> w ; Nothing -> S.empty }+>          post = case lookup subBinder env of { Just w -> w ; Nothing -> S.empty }+>          {- full_len = S.length bs >          pre_len = S.length pre >          post_len = S.length post >          main_len = full_len - pre_len - post_len >          main_and_post = S.drop pre_len bs->          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post+>          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post -}+>          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))
Text/Regex/PDeriv/ByteString/LeftToRightD.lhs view
@@ -34,7 +34,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(..), nub2, minBinder, maxBinder)+> 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.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insert, insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -402,14 +402,15 @@ >  case greedyPatMatchCompiled r bs of >    Nothing -> Right (Nothing) >    Just env ->->      let pre = case lookup minBinder env of { Just w -> w ; Nothing -> S.empty }->          post = case lookup maxBinder env of { Just w -> w ; Nothing -> S.empty }->          full_len = S.length bs+>      let pre = case lookup preBinder env of { Just w -> w ; Nothing -> S.empty }+>          post = case lookup subBinder env of { Just w -> w ; Nothing -> S.empty }+>          {- full_len = S.length bs >          pre_len = S.length pre >          post_len = S.length post >          main_len = full_len - pre_len - post_len >          main_and_post = S.drop pre_len bs->          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post+>          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post -}+>          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)) @@ -508,3 +509,8 @@ > p11 = PPair (PStar (PVar 1 [] (PE (Seq digits_re (Star digits_re Greedy)))) Greedy) (PPair (PStar (PVar 2 [] (PE (Seq digits_re (Star digits_re Greedy)))) Greedy) (PPair (PStar (PVar 3 [] (PE (Seq digits_re (Star digits_re Greedy)))) Greedy) (PStar (PVar 4 [] (PE (Seq digits_re (Star digits_re Greedy)))) Greedy)))  > input11 = S.pack "1234567890123456789-"+++> Right up34 = compile defaultCompOpt defaultExecOpt (S.pack "(Ab|cD)*")++> s34 = S.pack "aBcD"
Text/Regex/PDeriv/ByteString/Posix.lhs view
@@ -4,6 +4,13 @@ This algorithm exploits the extension of partial derivative of regular expression patterns. This algorithm implements the POSIX matching policy proceeds by scanning the input word from right to left. +The binding scheme for posix is slightly different from the other algos such as LeftToRight, etc. +say given input "ab" pattern "(x :: a), (y :: b)"+the match result is { x -> (1,2) , y -> (2,3) } instead of +{ x -> (1,1), y -> (2,2) } (which was used in LeftToRight). +In Posix matching we need to use (n,n) to denote zero-length match which is used in resetting. +See resetLocalBnd below. Todo: we might want to update other algos to make it consistent+ > {-# LANGUAGE GADTs, MultiParamTypeClasses, FunctionalDependencies, >     FlexibleInstances, TypeSynonymInstances, FlexibleContexts #-}  @@ -36,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(..), nub2, minBinder, maxBinder)+> import Text.Regex.PDeriv.Common (Range, Letter, IsEmpty(..), my_hash, my_lookup, GFlag(..), IsEmpty(..), 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)@@ -51,7 +58,7 @@ > type Word = S.ByteString  > rg_collect :: S.ByteString -> (Int,Int) -> S.ByteString-> rg_collect w (i,j) = S.take (j' - i' + 1) (S.drop i' w)+> rg_collect w (i,j) = S.take (j' - i') (S.drop i' w) >	       where i' = fromIntegral i >	             j' = fromIntegral j @@ -114,7 +121,7 @@ >     | otherwise =  >         let  >             all_sofar_states = acc_states ++ curr_states->             new_delta = [ (s, l, f, s', flag, gf ) | s <- curr_states, l <- sig, ((s',f,gf),flag) <- pdPat0Flag s l]+>             new_delta = [ (s, l, f, s', flag, gf) | s <- curr_states, l <- sig, ((s',f, gf),flag) <- pdPat0Flag s l] >             new_states = all_sofar_states `seq` D.nub [ s' | (_,_,_,s',_,_) <- new_delta >                                                       , not (s' `D.isIn` dict) ] >             acc_delta_next  = (acc_delta ++ new_delta)@@ -131,14 +138,17 @@   > -- | Function 'collectPatMatchFromBinder' collects match results from binder -> collectPatMatchFromBinder :: Word -> Binder -> Env-> collectPatMatchFromBinder w b = collectPatMatchFromBinder_ w (listifyBinder b)-+> collectPatMatchFromBinder :: Word -> IM.IntMap () -> Binder -> Env+> collectPatMatchFromBinder w posixBnd b = collectPatMatchFromBinder_ w (filter ( \(i,r) -> IM.notMember i posixBnd) (listifyBinder b)) +> collectPatMatchFromBinder_ :: Word -> [(Int,[Range])] -> Env > collectPatMatchFromBinder_ w [] = []-> collectPatMatchFromBinder_ w ((x,[]):xs) = (x,S.empty):(collectPatMatchFromBinder_ w xs)-> collectPatMatchFromBinder_ w ((x,rs):xs) = (x,foldl S.append S.empty $ map (rg_collect w) (id rs)):(collectPatMatchFromBinder_ w xs)+> collectPatMatchFromBinder_ w ((x,rs):xrs) =+>     case rs of+>       [] -> (x,S.empty):(collectPatMatchFromBinder_ w xrs)+>       rs -> (x,foldl S.append S.empty $ map (rg_collect w) (id rs)):(collectPatMatchFromBinder_ w xrs) + > -- | algorithm right to left scanning single pass > -- | the "partial derivative" operations among integer states + binders > lookupPdPat0' :: PdPat0TableRev -> (Int,Binder) -> Letter -> [(Int,Binder,Int,Bool)]@@ -147,8 +157,21 @@ >     Just quatripples -> [ (j, op x b, p, gf) | (j, op, p, gf) <- quatripples ] >     Nothing -> []  +> {- | map pattern variable to greedy flag+> type GreedyFlagMap = IM.IntMap Bool -> patMatchesIntStatePdPat0Rev  :: Int -> PdPat0TableRev -> Word -> [(Int, Binder, Int, Bool)] -> [(Int, Binder, Int, Bool )]+> buildGFM :: Pat -> GreedyFlagMap+> buildGFM p = IM.fromList (aux p)+>   where aux :: Pat -> [(Int,Bool)]+>         aux  (PVar i rs p) = [(i, isGreedy p)] ++ (aux p)+>         aux  (PPair p1 p2) = (aux p1) ++ (aux p2)+>         aux  (PPlus p1 p2) = (aux p1) +>         aux  (PStar p1 g)  = (aux p1) +>         aux  (PE r)        = []+>         aux  (PChoice p1 p2 g) = (aux p1) ++ (aux p2)+>         aux  (PEmpty p) = aux p -}++> patMatchesIntStatePdPat0Rev  :: Int -> PdPat0TableRev -> Word -> [(Int, Binder, Int, Bool)] -> [(Int, Binder, Int, Bool)] > patMatchesIntStatePdPat0Rev  cnt pdStateTableRev w fs = >     case S.uncons w of  >       Nothing -> fs@@ -172,9 +195,9 @@ >     in (x:xs') > nubPosixSub a@(x@(k,b,n,vs):xs) =  >     let cmp (k1,b1,_,gf1) (k2,b2,_,gf2) = ->             case compare gf1 gf2 of+>              case compare gf1 gf2 of >               EQ -> compareBinderLocal b1 b2 --  compare (b1,v1) (b2,v2)->               ordering -> ordering +>               ordering -> ordering   >         ys = [ (k',b',n',gf') | (k',b',n',gf') <- a, k == k' ] >         zs = [ (k',b',n',gf') | (k',b',n',gf') <- a, not (k == k') ] >         y = maximumBy cmp ys@@ -183,16 +206,26 @@ >        else nubPosixSub xs  -> compareBinderLocal :: Binder -> Binder -> Ordering +> compareBinderLocal ::  Binder -> Binder -> Ordering  > compareBinderLocal bs bs' = ->     let rs  = map snd (listifyBinder bs)->         rs' = map snd (listifyBinder bs')+>     -- When comparing local binders, we should disregard the preBinder and subBinder in case of unanchored match.+>     -- If we include preBinder and subBinder in the local binders comparison, it leads to non-posix result.+>     -- Suppose we have unanchored p = (Ab|cD)*, transforming it into an anchored pattern (.*) (Ab|cD)* (.*) where the first (.*) is not greedy.+>     -- Since we have only pair constructor, we need to put paranthesis around sub binders, let say ((.*) (Ab|cD)*) (.*)+>     -- let input be AbCd, the first (.*) will consume the entire input in order to optimize ((.*) (Ab|cD)*).+>     --  similarly, we could construct another counter example "aBcD", if we put paranthesis around the 2nd and 3rd sub binders.+>     let rs  = map snd (listifyBinder bs) -- map snd (filter (\(x,_) -> x > preBinder && x < subBinder) (listifyBinder bs))+>         rs' = map snd (listifyBinder bs') -- map snd (filter (\(x,_) -> x > preBinder && x < subBinder) (listifyBinder bs')) >         os  = map (\ (r,r') -> compareRangeLocal r r')  (zip rs rs') >     in {- logger (print (show os)) `seq`  >        logger (print (show bs)) `seq`  >        logger (print (show bs')) `seq` -} >        firstNonEQ os+>           +>                ++ > compareRangeLocal :: [Range] -> [Range] -> Ordering > compareRangeLocal [] [] = EQ > compareRangeLocal (x:xs) (y:ys) @@ -229,10 +262,10 @@ >         l = S.length w >         w' = S.reverse w >         fs = [ (i, b, 0, True) | i <- fins ]->         fs' =  w' `seq` fins `seq` l `seq` pdStateTableRev `seq` (patMatchesIntStatePdPat0Rev (l-1) pdStateTableRev w' fs)+>         fs' =  w' `seq` fins `seq` l `seq` pdStateTableRev `seq` (patMatchesIntStatePdPat0Rev (l-1) pdStateTableRev  w' fs) >         -- fs'' = my_sort fs'->         allbinders = [ b | (s,b,_, _) <- fs', s == 0 ]->     in map (collectPatMatchFromBinder w) allbinders+>         allbinders = [ b | (s,b,_,_) <- fs', s == 0 ]+>     in map (collectPatMatchFromBinder w IM.empty ) allbinders -- todo: fix me >                        > -- my_sort = sortBy (\ (_,_,ps) (_,_,ps') -> compare ps ps')@@ -248,26 +281,27 @@ >     first _ = Nothing  -> compilePat :: Pat -> (PdPat0TableRev, [Int], Binder)-> compilePat p = {- pdStateTable `seq` b `seq` -} (pdStateTable, fins, b)+> compilePat :: (Pat,IM.IntMap ()) -> (PdPat0TableRev, [Int], Binder, FollowBy, IM.IntMap ())+> compilePat (p,posixBnd) = {- pdStateTable `seq` b `seq` -} (pdStateTable, fins, b, fb, posixBnd) >     where  >           (pdStateTable,fins) = buildPdPat0Table p >           b = toBinder p+>           fb = followBy p   -> patMatchIntStateCompiled ::  (PdPat0TableRev, [Int], Binder) -> Word -> [Env]-> patMatchIntStateCompiled (pdStateTable, fins ,b)  w =+> patMatchIntStateCompiled ::  (PdPat0TableRev, [Int], Binder, FollowBy, IM.IntMap ()) -> Word -> [Env]+> patMatchIntStateCompiled (pdStateTable, fins, b, fb, posixBinder)  w = >     let >         l = S.length w >         w' = S.reverse w >         fs = [ (i, b, i, True) | 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' | (s,b',_, _) <- fs', s == 0 ]->     in allbinders `seq` map (collectPatMatchFromBinder w) allbinders+>         allbinders = fs' `seq` [  b' | (s,b',_,_) <- fs', s == 0 ]+>     in allbinders `seq` map (collectPatMatchFromBinder w posixBinder) allbinders >        -> posixPatMatchCompiled :: (PdPat0TableRev, [Int], Binder) -> Word -> Maybe Env+> posixPatMatchCompiled :: (PdPat0TableRev, [Int], Binder, FollowBy, IM.IntMap ()) -> Word -> Maybe Env > posixPatMatchCompiled compiled w = >      first (patMatchIntStateCompiled compiled w) >   where@@ -287,14 +321,15 @@ >                     -> Binder > updateBinderByIndex i pos binder =  >     case IM.lookup i binder of->       { Nothing -> IM.insert i [(pos, pos)] binder+>       { Nothing -> IM.insert i [(pos,pos+1)] binder >       ; Just ranges ->  >         case ranges of ->         { [] -> IM.update (\_ -> Just [(pos,pos)]) i binder+>         { [] -> 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):(b,e):rs)) i binder->           | otherwise     -> error "impossible, the current letter position is greater than the last recorded letter"+>           | 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)) >         } >       } @@ -319,6 +354,7 @@ >     | otherwise = x:(updateBinderByIndexSub pos idx xs) > -} +> {- > resetLocalBnd :: Pat -> Binder -> Binder > resetLocalBnd p b =  >   let vs = getVars p@@ -328,20 +364,29 @@ >                              case IM.lookup i b' of >                                { Nothing -> b' >                                ; Just [] -> IM.update (\r -> Just r) i b'->                                ; Just ((s,e):_) -> IM.update (\r -> Just ((s,(s-1)):r)) i b'+>                                ; Just ((s,e):_) -> IM.update (\r -> Just ((s, s-1):r)) i b' >                                }) b is >                                                       -> {-->     where aux :: [Int] -> Binder -> Binder->           aux vs [] = []->           aux vs ((b@(x,r)):bs) | x `elem` vs = ->                                     case r of ->                                       { []        -> (b:(aux vs bs))->                                       ; ((s,e):_) -> ((x, (s,(s-1)):r):(aux vs bs))->                                       } ->                                 | otherwise   =  (b:(aux vs bs)) > -} ++> resetLocalBnd :: Pat -> Int -> Binder -> Binder+> resetLocalBnd p j b = +>   let vs = getVars p+>       x = aux vs b +>       io = logger (print j) `seq` logger (print b) `seq` logger (print x)+>   in -- io `seq` +>      x+>      where aux :: [Int] -> Binder -> Binder+>            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'+>                                }) b is+>                                                       ++ retrieve all variables appearing in p  > getVars :: Pat -> [Int] @@ -356,22 +401,23 @@ An specialized version of pdPat0 specially designed for the Posix match In case of p* we reset in the local binding. -> pdPat0 :: Pat -> Letter -> [(Pat, Int -> Binder -> Binder, Bool )]+> pdPat0 :: Pat -> Letter -> [(Pat, Int -> Binder -> Binder, Bool)] > pdPat0 (PVar x w p) (l,idx)  >     | IM.null (toBinder p) = -- p is not nested >         let pds = partDeriv (strip p) l >         in if null pds then []->            else [ (PVar x [] (PE (resToRE pds)), (\i -> (updateBinderByIndex x i)), True ) ]+>            else [ (PVar x [] (PE (resToRE pds)), (\i -> (updateBinderByIndex x i)), True) ] >     | otherwise =  >         let pfs = pdPat0 p (l,idx)->         in [ (PVar x [] pd, (\i -> (f i) . (updateBinderByIndex x i)  ), True ) | (pd,f, _) <- pfs ]+>         in [ (PVar x [] pd, (\i -> (f i) . (updateBinderByIndex x i)  ), True) | (pd,f,_) <- pfs ] > pdPat0 (PE r) (l,idx) =  >     let pds = partDeriv r l >     in if null pds then []->        else [ (PE (resToRE pds), ( \_ -> id ), True ) ]+>        else [ (PE (resToRE pds), ( \_ -> id ), True) ] > pdPat0 (PStar p g) l = let pfs = pdPat0 p l->                            reset  = resetLocalBnd p -- restart all local binder in variables in p->                        in [ (PPair p' (PStar p g), (\ i -> reset . (f i) ), True) | (p', f, _) <- pfs ]+>                            reset = resetLocalBnd p -- restart all local binder in variables in p+>                        in [ (PPair p' (PStar p g), (\ i -> (reset i) . (f i) ) , True) | (p', f, _) <- pfs ]+>                      --  in [ (PPair p' (PStar p g), (\ i -> reset . (f i) ), True) | (p', f, _) <- pfs ] >                      -- 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@@ -381,20 +427,22 @@ > pdPat0 (PPair p1 p2) l =  >     if (isEmpty (strip p1)) >     then if isGreedy p1->          then nub3 ([ (PPair p1' p2, f, True) | (p1' , f, _) <- pdPat0 p1 l ] ++ (pdPat0 p2 l))+>          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 ]) >     else [ (PPair p1' p2, f, True) | (p1',f, _) <- pdPat0 p1 l ] > pdPat0 (PChoice p1 p2 _) l =  >     nub3 ((pdPat0 p1 l) ++ (pdPat0 p2 l)) -- nub doesn't seem to be essential  +>  > nub3 :: Eq a => [(a,b,c)] -> [(a,b,c)]-> nub3 = nubBy (\(p1,_,_) (p2, _, _) -> p1 == p2) -+> nub3 = nubBy (\(p1,_,_) (p2,_,_) -> p1 == p2) +>   > -- | The PDeriv backend spepcific 'Regex' type--> type Regex = (PdPat0TableRev, [Int], Binder) +> -- | the IntMap keeps track of the auxillary binder generated because of posix matching, i.e. all sub expressions need to be tag+> -- | the FollowBy keeps track of the order of the pattern binder +> type Regex = (PdPat0TableRev, [Int], Binder, FollowBy, IM.IntMap ())    -- todo: use the CompOption and ExecOption@@ -404,11 +452,11 @@ >         -> S.ByteString -- ^ The regular expression to compile >         -> Either String Regex -- ^ Returns: the compiled regular expression > compile compOpt execOpt bs =->     case parsePat (S.unpack bs) of+>     case parsePatPosix (S.unpack bs) of >     Left err -> Left ("parseRegex for Text.Regex.PDeriv.ByteString failed:"++show err) >     Right pat -> Right (patToRegex pat compOpt execOpt) >     where ->       patToRegex p _ _ = (compilePat p)+>       patToRegex p _ _ =  compilePat p   @@ -422,18 +470,19 @@ >        -> Either String (Maybe (S.ByteString, S.ByteString, S.ByteString, [S.ByteString])) > regexec r bs = >  case posixPatMatchCompiled r bs of->    Nothing -> Right (Nothing)+>    Nothing -> Right Nothing >    Just env ->->      let pre = case lookup minBinder env of { Just w -> w ; Nothing -> S.empty }->          post = case lookup maxBinder env of { Just w -> w ; Nothing -> S.empty }+>      let pre = case lookup preBinder env of { Just w -> w ; Nothing -> S.empty }+>          post = case lookup subBinder env of { Just w -> w ; Nothing -> S.empty } >          full_len = S.length bs >          pre_len = S.length pre >          post_len = S.length post >          main_len = full_len - pre_len - post_len >          main_and_post = S.drop pre_len bs >          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post->          matched = map snd (filter (\(v,w) -> v > 0) env)->      in Right (Just (pre,main,post,matched))+>          matched = map snd (filter (\(v,w) -> v > mainBinder && v < subBinder ) env)+>      in -- logger (print (show env)) `seq` +>             Right (Just (pre,main,post,matched))   > -- | Control whether the pattern is multiline or case-sensitive like Text.Regex and whether to@@ -490,35 +539,58 @@   -> patMatchIntStateCompiledMatchArray ::  (PdPat0TableRev, [Int], Binder) -> Word -> [MatchArray]-> patMatchIntStateCompiledMatchArray (pdStateTable, fins ,b)  w =+> patMatchIntStateCompiledMatchArray ::  (PdPat0TableRev, [Int], Binder, FollowBy, IM.IntMap ()) -> Word -> [MatchArray]+> patMatchIntStateCompiledMatchArray (pdStateTable, fins, b, fb, posixBnd)  w = >     let >         l = S.length w >         w' = S.reverse w >         fs = [ (i, b, i, True) | 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' | (s,b',_, _) <- fs', s == 0 ]->         io = logger (print $ show allbinders)->     in io `seq` allbinders `seq` map (binderToMatchArray l) allbinders+>         allbinders = fs' `seq` [  b' | (s,b',_,_) <- fs', s == 0 ]+>         io = logger (print $ show b) `seq` logger (print $ show allbinders)+>     in -- io `seq` +>            allbinders `seq` map (binderToMatchArray l fb posixBnd) allbinders -> binderToMatchArray l b  = ->     let subPatB   = filter (\(x,_) -> x > minBinder && x < maxBinder) (listifyBinder b)->         mbPrefixB = IM.lookup minBinder b->         mbSubfixB = IM.lookup maxBinder b++> updateEmptyBinder b fb = +>     let +>         up b (x,y) = case IM.lookup x b of +>                      { Just (_:_) -> -- non-empty, nothing to do+>                        b+>                      ; Just [] ->  -- lookup the predecessor+>                        case IM.lookup y b of+>                        { Just r@(_:_) -> let i = snd (last r)+>                                          in IM.update (\_ -> Just [(i,i)]) x b+>                        ; _ -> b }+>                      ; Nothing -> b }+>     in foldl up b fb++> binderToMatchArray l fb posixBnd b  = +>     let -- b'        = updateEmptyBinder b fb+>         subPatB   = filter (\(x,_) -> x > mainBinder && x < subBinder && x `IM.notMember` posixBnd ) (listifyBinder b)+>         mbPrefixB = IM.lookup preBinder b+>         mbSubfixB = IM.lookup subBinder b >         mainB     = case (mbPrefixB, mbSubfixB) of->                       (Just [(_,x)], Just [(y,_)]) -> (x + 1, y - (x + 1))->                       (Just [(_,x)], _)            -> (x + 1, l - (x + 1))+>                       (Just [(_,x)], Just [(y,_)]) -> (x, y - x)+>                       (Just [(_,x)], _)            -> (x, l - x) >                       (_, Just [(y,_)])            -> (0, y)  >                       (_, _)                       -> (0, l)->                       _                            -> error (show (mbPrefixB, mbSubfixB) )->         rs = map snd subPatB      ->     in listToArray (mainB:(map (\r -> case r of { (_:_) -> fromRange (last r) ; [] -> (-1,0) } ) rs))->     where fromRange (b,e) = (b, e-b+1)+>                       _                            -> error (show (mbPrefixB, mbSubfixB) ) +>         rs        = map snd subPatB      +>         rs'       = map lastNonEmpty rs+>         io = logger (print $ "\n" ++ show rs ++ " || " ++ show rs' ++ "\n")+>     in -- io `seq` +>        listToArray (mainB:rs')+>     where fromRange (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)+>           lastNonEmpty rs = fromRange (last rs)  > listToArray l = listArray (0,length l-1) l -> posixPatMatchCompiledMatchArray :: (PdPat0TableRev, [Int], Binder) -> Word -> Maybe MatchArray+> posixPatMatchCompiledMatchArray :: (PdPat0TableRev, [Int], Binder, FollowBy, IM.IntMap () ) -> Word -> Maybe MatchArray > posixPatMatchCompiledMatchArray compiled w = >      first (patMatchIntStateCompiledMatchArray compiled w) >   where@@ -526,6 +598,28 @@ >     first _ = Nothing  +> -- | from FollowBy, we recover the right result of the variable that bound (-1,-1) to fit Chris' test case+> ++> type FollowBy = [(Int,Int)]++> followBy :: Pat -> FollowBy+> followBy p = map (\p -> (snd p, fst p)) (fst $ buildFollowBy p ([],[]))++> -- | describe the "followedBy" relation between two pattern variable+> buildFollowBy :: Pat -> ([(Int,Int)], [Int]) -> ([(Int,Int)], [Int])+> buildFollowBy (PVar x w p) (acc, lefts) = let (acc', lefts') = buildFollowBy p (acc,lefts)+>                                           in ([ (l,x) | l <- lefts] ++ acc', [x])+> buildFollowBy (PE r) x                  = x+> buildFollowBy (PStar p g) (acc, lefts)  = buildFollowBy p (acc,lefts)+> buildFollowBy (PPair p1 p2) (acc, lefts) = let (acc',lefts') = buildFollowBy p1 (acc,lefts)+>                                            in buildFollowBy p2 (acc',lefts')+> buildFollowBy (PChoice p1 p2 _) (acc, lefts) = let (acc1, lefts1) = buildFollowBy p1 (acc,lefts)+>                                                    (acc2, lefts2) = buildFollowBy p2 (acc1,lefts)+>                                                in (acc2, lefts1 ++ lefts2)+++ > Right r0 = compile defaultCompOpt defaultExecOpt (S.pack "(ab|a)(bc|c)") > s0 = S.pack "abc" @@ -607,6 +701,51 @@  > Right r64 =  compile defaultCompOpt defaultExecOpt (S.pack "^(a*?)(a*)(a*?)$") -> Right up25 = compile defaultCompOpt defaultExecOpt (S.pack "^(.*?)(a|ab|ba)(.*)$")-> Right up26 = compile defaultCompOpt defaultExecOpt (S.pack "(a|ab|ba)")+Right up25 = compile defaultCompOpt defaultExecOpt (S.pack "^(.*?)(a|ab|ba)(.*)$")++> Right up25 = compile defaultCompOpt defaultExecOpt (S.pack "(a|ab|ba)") > s25 = S.pack "aba"+++> Right up112 = compile defaultCompOpt defaultExecOpt (S.pack "a+(b|c)*d+")++Right up112 = compile defaultCompOpt defaultExecOpt (S.pack "^(.*?)(a+(b|c)*d+)(.*)$")++> s112 = S.pack "aabcdd"++Right up34 = compile defaultCompOpt defaultExecOpt (S.pack "^((.*?)((Ab|cD)*))(.*)$")++> Right up34 = compile defaultCompOpt defaultExecOpt (S.pack "(Ab|cD)*")++> s34 = S.pack "aBcD"++> Right up17 = compile defaultCompOpt defaultExecOpt (S.pack "a*(a.|aa)")++> s17 = S.pack "aaaa"++Right up27 = compile defaultCompOpt defaultExecOpt (S.pack "^(.*?)((ab|abab)(.*))$") ++> Right up27 = compile defaultCompOpt defaultExecOpt (S.pack "ab|abab") +++> s27 = S.pack "abbabab"+++> Right up11 = compile defaultCompOpt defaultExecOpt (S.pack ".*(.*)") ++> s11 = S.pack "ab"++> Right up8' = compile defaultCompOpt defaultExecOpt (S.pack "((..)|(.))*") ++> s8' = S.pack "aaa"+++> Right up8'' = compile defaultCompOpt defaultExecOpt (S.pack "^((a)|(b))*$") ++> s8'' = S.pack "aba"+++> Right up0' = compile defaultCompOpt defaultExecOpt (S.pack "(a|ab|c|bcd)*(d*)") ++> s0' = S.pack "ababcd"+
Text/Regex/PDeriv/ByteString/RightToLeft.lhs view
@@ -31,7 +31,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(..), IsGreedy(..), nub3, minBinder, maxBinder) +> 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.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -246,14 +246,15 @@ >  case greedyPatMatchCompiled r bs of >    Nothing -> Right Nothing >    Just env ->->      let pre = case lookup minBinder env of { Just w -> w ; Nothing -> S.empty }->          post = case lookup maxBinder env of { Just w -> w ; Nothing -> S.empty }->          full_len = S.length bs+>      let pre = case lookup preBinder env of { Just w -> w ; Nothing -> S.empty }+>          post = case lookup subBinder env of { Just w -> w ; Nothing -> S.empty }+>          {- full_len = S.length bs >          pre_len = S.length pre >          post_len = S.length post >          main_len = full_len - pre_len - post_len >          main_and_post = S.drop pre_len bs->          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post+>          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post -}+>          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))
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, IsEmpty(..), my_hash, my_lookup, GFlag(..), IsGreedy(..), nub2, minBinder, maxBinder)+> 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.Parse > import qualified Text.Regex.PDeriv.Dictionary as D (Dictionary(..), Key(..), insertNotOverwrite, lookupAll, empty, isIn, nub)@@ -275,14 +275,15 @@ >  case greedyPatMatchCompiled r bs of >    Nothing -> Right (Nothing) >    Just env ->->      let pre = case lookup minBinder env of { Just w -> w ; Nothing -> S.empty }->          post = case lookup maxBinder env of { Just w -> w ; Nothing -> S.empty }->          full_len = S.length bs+>      let pre = case lookup preBinder env of { Just w -> w ; Nothing -> S.empty }+>          post = case lookup subBinder env of { Just w -> w ; Nothing -> S.empty }+>          {- full_len = S.length bs >          pre_len = S.length pre >          post_len = S.length post >          main_len = full_len - pre_len - post_len >          main_and_post = S.drop pre_len bs->          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post+>          main = main_and_post `seq` main_len `seq` S.take main_len main_and_post -}+>          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))
Text/Regex/PDeriv/Common.lhs view
@@ -9,8 +9,10 @@ >     , IsGreedy (..) >     , nub2 >     , nub3->     , minBinder->     , maxBinder+>     , preBinder+>     , preBinder_+>     , subBinder+>     , mainBinder >     ) where  > import Data.Char (ord)@@ -126,10 +128,19 @@  The smallest binder index capturing the prefix of the unanchored regex -> minBinder :: Int-> minBinder = 0+> preBinder :: Int+> preBinder = -1 +> preBinder_ :: Int+> preBinder_ = -2+ The largest binder index capturing for the suffix of the unanchored regex -> maxBinder :: Int-> maxBinder = 2147483647+> subBinder :: Int+> subBinder = 2147483647+++The binder index capturing substring which matches by the unanchored regex++> mainBinder :: Int+> mainBinder = 0
Text/Regex/PDeriv/IntPattern.lhs view
@@ -174,9 +174,12 @@ > getBindingsFrom p1 p2 = let b = toBinder p2 >                         in assign p1 b >     where assign :: Pat -> Binder -> Pat->           assign (PVar x w p) b = case IM.lookup x b of->                                     Nothing -> let p' = assign p b in PVar x w p'->                                     Just rs -> let p' = assign p b in PVar x (w ++ rs) p'+>           assign (PVar x w p) b = +>               case IM.lookup x b of+>                  Nothing -> let p' = assign p b in PVar x w p'+>                  Just rs -> let+>                                 p' = assign p b +>                             in PVar x (w ++ rs) p' >           assign (PE r) _ = PE r >           assign (PPlus p1 p2) b = PPlus (assign p1 b) p2 -- we don't need to care about p2 since it is a p* >           assign (PPair p1 p2) b = PPair (assign p1 b) (assign p2 b)@@ -207,7 +210,7 @@ > toBinder p = IM.fromList (toBinderList p)  > toBinderList :: Pat -> [(Int, [Range])]-> toBinderList  (PVar i rs p) = [(i,rs)] ++ (toBinderList p)+> toBinderList  (PVar i rs p) = [(i, rs)] ++ (toBinderList p) > toBinderList  (PPair p1 p2) = (toBinderList p1) ++ (toBinderList p2) > toBinderList  (PPlus p1 p2) = (toBinderList p1)  > toBinderList  (PStar p1 g)    = (toBinderList p1) @@ -229,7 +232,7 @@ >                     -> 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)]+>                       { [] -> Just [(pos,pos)]  >                       ; ((b,e):rs) >                           | pos == e + 1 -> Just ((b,e+1):rs) >                           | pos > e + 1  -> Just ((pos,pos):(b,e):rs)
Text/Regex/PDeriv/Parse.lhs view
@@ -1,5 +1,5 @@ > {-# LANGUAGE FlexibleContexts #-}-> module Text.Regex.PDeriv.Parse (parsePat) where+> module Text.Regex.PDeriv.Parse (parsePat, parsePatPosix) where  > {- By Kenny Zhuo Ming Lu and Martin Sulzmann, 2009. BSD3 -} @@ -13,12 +13,13 @@ >                                      string, noneOf, digit, char, anyChar) > import Control.Monad(liftM, when, guard) > import Data.List (sort,nub)+> import qualified Data.IntMap as IM > import qualified Data.ByteString.Char8 as S  > import Text.Regex.PDeriv.ExtPattern (EPat(..)) > import Text.Regex.PDeriv.IntPattern (Pat(..)) > import Text.Regex.PDeriv.RE (RE(..))-> import Text.Regex.PDeriv.Translate (translate) +> import Text.Regex.PDeriv.Translate (translate, translatePosix)   > type EState = () > initEState = ()@@ -36,6 +37,15 @@ >              { Left error -> Left error >              ; Right (epat, estate) -> Right (translate epat) >              }++posix pattern parsing: we need to add binders everywhere++> parsePatPosix :: String -> Either ParseError (Pat,IM.IntMap ())+> parsePatPosix x = case parseEPat x of+>                   { Left error -> Left error+>                   ; Right (epat, estate) -> Right (translatePosix epat)+>                   }+  > p_ere :: CharParser EState EPat > p_ere = liftM EOr $ sepBy1 p_branch (char '|')
Text/Regex/PDeriv/Translate.lhs view
@@ -1,9 +1,10 @@ > -- | A translation schema from the external syntax (ERE) to our interal syntax (xhaskell style pattern) > module Text.Regex.PDeriv.Translate ->     ( translate ) where+>     ( translate, translatePosix ) where  > import Control.Monad.State -- needed for the translation scheme > import Data.Char (chr)+> import qualified Data.IntMap as IM  > import Text.Regex.PDeriv.ExtPattern > import Text.Regex.PDeriv.IntPattern@@ -15,13 +16,20 @@ > data TState = TState { ngi :: NGI   -- ^ negative group index >                      , gi :: GI     -- ^ (positive) group index >                      , anchorStart :: Bool->                      , anchorEnd :: Bool } -- the state for trasslation+>                      , anchorEnd :: Bool+>                      , posix :: Bool -- ^ if posix, add binders to non-groups +>                      , posix_binder :: IM.IntMap () -- ^ keep tracks of posix binder+>                      } -- the state for trasslation >             deriving Show   > -- variables 0,-1,-2 are reserved for pre, main and post!-> initTState = TState { ngi = -3, gi = 1, anchorStart = False, anchorEnd = False } +> initTState = TState { ngi = -3, gi = 1, anchorStart = False, anchorEnd = False, posix = False, posix_binder = IM.empty }  ++> initTStatePosix = TState { ngi = -3, gi = 1, anchorStart = False, anchorEnd = False, posix = True, posix_binder = IM.empty } ++ > type NGI = Int -- the non group index  > type GI = Int -- the group index@@ -72,7 +80,18 @@ >                   ; put st{anchorEnd=True} >                   } +> isPosix :: State TState Bool+> isPosix = do { st <- get+>              ; return (posix st)+>              } +> addPosixBinder :: Int -> State TState ()+> addPosixBinder i = do { st <- get+>                       ; let bs = posix_binder st+>                             bs' = IM.insert i () bs+>                       ; put st{posix_binder=bs'}+>                       }+ > -- | Translating external pattern to internal pattern > translate :: EPat -> Pat > translate epat = case runState (trans epat) initTState of@@ -80,12 +99,31 @@ >                    let hasAnchorS = anchorStart state >                        hasAnchorE = anchorEnd state >                    in case (hasAnchorS, hasAnchorE) of->                       (True, True) -> pat -- PVar 0 [] pat ->                       (True, False) -> PPair pat (PVar maxBinder [] (PE (Star Any NotGreedy)))->                       (False, True) -> PPair (PVar minBinder [] (PE (Star Any NotGreedy))) pat->                       (False, False) -> PPair (PVar minBinder [] (PE (Star Any NotGreedy))) (PPair pat (PVar maxBinder [] (PE (Star Any NotGreedy))))->                       -- (False, False) -> (PPair (PPair (PVar (-1) [] (PE (Star Any NotGreedy))) pat) (PVar (-2) [] (PE (Star Any Greedy))))+>                       (True, True)   -> PVar mainBinder [] pat +>                       (True, False)  -> PPair (PVar mainBinder [] pat) (PVar subBinder [] (PE (Star Any NotGreedy)))+>                       (False, True)  -> PPair (PVar preBinder [] (PE (Star Any NotGreedy))) (PVar mainBinder [] pat)+>                       -- (False, False) -> PPair (PPair (PVar preBinder [] (PE (Star Any NotGreedy))) (PVar mainBinder [] pat)) (PVar subBinder [] (PE (Star Any NotGreedy)))+>                       -- (False, False) -> PPair (PVar preBinder_ [] (PPair (PVar preBinder [] (PE (Star Any NotGreedy))) (PVar mainBinder [] pat))) (PVar subBinder [] (PE (Star Any NotGreedy)))+>                       (False, False) -> (PPair (PVar preBinder [] (PE (Star Any NotGreedy))) (PVar preBinder_ [] (PPair (PVar mainBinder [] pat) (PVar subBinder [] (PE (Star Any NotGreedy)))))) ++> -- |  for posix +> translatePosix :: EPat -> (Pat,IM.IntMap ())+> translatePosix epat = case runState (trans epat) initTStatePosix of+>                  (pat, state) ->+>                    let hasAnchorS = anchorStart state+>                        hasAnchorE = anchorEnd state+>                        posixBnd   = posix_binder state+>                    in case (hasAnchorS, hasAnchorE) of+>                       (True, True)   -> (PVar mainBinder [] pat, posixBnd)+>                       (True, False)  -> (PPair (PVar mainBinder [] pat) (PVar subBinder [] (PE (Star Any NotGreedy))), posixBnd)+>                       (False, True)  -> (PPair (PVar preBinder [] (PE (Star Any NotGreedy))) (PVar mainBinder [] pat), posixBnd)+>                       -- (False, False) -> PPair (PPair (PVar preBinder [] (PE (Star Any NotGreedy))) (PVar mainBinder [] pat)) (PVar subBinder [] (PE (Star Any NotGreedy)))+>                       -- (False, False) -> PPair (PVar preBinder_ [] (PPair (PVar preBinder [] (PE (Star Any NotGreedy))) (PVar mainBinder [] pat))) (PVar subBinder [] (PE (Star Any NotGreedy)))+>                       (False, False) -> ((PPair (PVar preBinder [] (PE (Star Any NotGreedy))) (PVar preBinder_ [] (PPair (PVar mainBinder [] pat) (PVar subBinder [] (PE (Star Any NotGreedy)))))), posixBnd)+++ > {-| 'trans' The top level translation scheme e ~> p >     There are two sub rules. >     e ~>_p p@@ -94,10 +132,45 @@ >     which are fired depending on whether e has Group pattern (...) (i.e. pattern variable) > -} > trans :: EPat -> State TState Pat-> trans epat | hasGroup epat = p_trans epat->            | otherwise     = do { r <- r_trans epat+> trans epat = +>     do { is_posix <- isPosix -- if it is posix, we need to aggresively "tag" every sub expression with a binder+>        ; if is_posix +>          then do +>            { gi <- getIncGI+>            ; ipat <- trans' epat+>            ; addPosixBinder gi+>            ; return (PVar gi [] ipat)+>            }+>          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) >                                 }++> {-+> trans :: EPat -> State TState Pat+> trans epat | hasGroup epat = p_trans epat+>            | otherwise     = +>                do +>                { is_posix <- isPosix +>                ; if is_posix +>                  then do +>                       { gi <- getIncGI+>                       ; r <- r_trans epat+>                       ; addPosixBinder gi+>                       ; return (PVar gi [] (PE r))+>                       }+>                  else do +>                    { r <- r_trans epat+>                    ; return (PE r)+>                    }+>                }+> -}+   > {-| 'p_trans' implementes the rule 'e ~>_p p'
regex-pderiv.cabal view
@@ -1,5 +1,5 @@ Name:                   regex-pderiv-Version:                0.0.8.2+Version:                0.0.9 License:                BSD3 License-File:           LICENSE Copyright:              Copyright (c) 2010, Kenny Zhuo Ming Lu and Martin Sulzmann