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 +1/−1
- Text/Regex/PDeriv/ByteString/LeftToRight.lhs +3/−3
- Text/Regex/PDeriv/ByteString/LeftToRightD.lhs +50/−17
- Text/Regex/PDeriv/ByteString/Posix.lhs +17/−17
- Text/Regex/PDeriv/ByteString/RightToLeft.lhs +3/−2
- Text/Regex/PDeriv/ByteString/TwoPasses.lhs +3/−3
- Text/Regex/PDeriv/Common.lhs +14/−2
- Text/Regex/PDeriv/ExtPattern.lhs +2/−0
- Text/Regex/PDeriv/IntPattern.lhs +36/−12
- Text/Regex/PDeriv/Parse.lhs +57/−10
- Text/Regex/PDeriv/String.lhs +31/−0
- Text/Regex/PDeriv/String/LeftToRightD.lhs +450/−0
- Text/Regex/PDeriv/Translate.lhs +14/−0
- regex-pderiv.cabal +5/−3
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