diff --git a/Text/Regex/TDFA.hs b/Text/Regex/TDFA.hs --- a/Text/Regex/TDFA.hs +++ b/Text/Regex/TDFA.hs @@ -23,17 +23,19 @@ As of version 1.1.1 the following GNU extensions are recognized, all anchors: -\` at beginning of entire text +\\\` at beginning of entire text -\' at end of entire text +\\\' at end of entire text -\< at beginning of word +\\< at beginning of word -\> at end of word +\\> at end of word -\b at either beginning or end of word +\\b at either beginning or end of word -\B at neither beginning nor end of word +\\B at neither beginning nor end of word + +The above are controlled by the 'newSyntax' Bool in 'CompOption'. Where the "word" boundaries means between characters that are and are not in the [:word:] character class which contains [a-zA-Z0-9_]. Note diff --git a/Text/Regex/TDFA/Common.hs b/Text/Regex/TDFA/Common.hs --- a/Text/Regex/TDFA/Common.hs +++ b/Text/Regex/TDFA/Common.hs @@ -87,9 +87,9 @@ , 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, - `[^' bracket expressions and `.' never match newline, a `^' anchor matches the + 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 + 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. Add the extended non-POSIX syntax described in "Text.Regex.TDFA" haddock documentation. @@ -102,13 +102,17 @@ captureGroups :: Bool -- ^ True by default. Set to False to improve speed (and space). } deriving (Read,Show) --- | Used by implementation to name certain Postions during matching -type Tag = Int -- ^ identity of Position tag to set during a transition +-- | Used by implementation to name certain Postions during +-- matching. Identity of Position tag to set during a transition +type Tag = Int -- | Internal use to indicate type of tag and preference for larger or smaller Positions data OP = Maximize | Minimize | Orbit | Ignore deriving (Eq,Show) -type Index = Int -- ^ Internal NFA node identity number -type SetIndex = IntSet {- Index -} -- ^ Internal DFA identity is this Set of NFA Index -type Position = Int -- ^ Index into the text being searched +-- | Internal NFA node identity number +type Index = Int +-- | Internal DFA identity is this Set of NFA Index +type SetIndex = IntSet {- Index -} +-- | Index into the text being searched +type Position = Int -- | GroupIndex is for indexing submatches from capturing -- parenthesized groups (PGroup/Group) diff --git a/Text/Regex/TDFA/CorePattern.hs b/Text/Regex/TDFA/CorePattern.hs --- a/Text/Regex/TDFA/CorePattern.hs +++ b/Text/Regex/TDFA/CorePattern.hs @@ -97,7 +97,7 @@ -- (i.e. with a Test) or unconditionally accept 0 characters. These -- are in the list in order of preference, with most preferred listed -- first. -type NullView = [(SetTestInfo,TagList)] -- Ordered list of null views, each is a set of tests and tags +type NullView = [(SetTestInfo,TagTasks)] -- Ordered list of null views, each is a set of tests and tags -- During the depth first traversal, children are told about tags by the parent. -- They may change Apply to Advice and they may generate new tags. @@ -140,18 +140,19 @@ -- preTags a b = promote a `mappend` promote b -- where promote = maybe [] (\x -> [(x,PreUpdate TagTask)]) -promotePreTag :: HandleTag -> TagList -promotePreTag = maybe [] (\x -> [(x,PreUpdate TagTask)]) . apply +promoteTag :: HandleTag -> TagTasks +promoteTag = maybe [] (\x -> [(x,TagTask)]) . apply makeEmptyNullView :: HandleTag -> HandleTag -> NullView -makeEmptyNullView a b = [(mempty, promotePreTag a ++ promotePreTag b)] +makeEmptyNullView a b = [(mempty, promoteTag a ++ promoteTag b)] makeTestNullView :: TestInfo -> HandleTag -> HandleTag -> NullView -makeTestNullView (w,d) a b = [(SetTestInfo (Map.singleton w (Set.singleton d)), promotePreTag a ++ promotePreTag b)] +makeTestNullView (w,d) a b = [(SetTestInfo (Map.singleton w (Set.singleton d)) + , promoteTag a ++ promoteTag b)] tagWrapNullView :: HandleTag -> HandleTag -> NullView -> NullView tagWrapNullView a b oldNV = - case (promotePreTag a, promotePreTag b) of + case (promoteTag a, promoteTag b) of ([],[]) -> oldNV (pre,post) -> do (oldTests,oldTasks) <- oldNV @@ -160,8 +161,8 @@ -- For PGroup, need to prepend reset tasks before others in nullView addGroupResetsToNullView :: [Tag] -> Tag -> NullView -> NullView addGroupResetsToNullView groupResets groupSet nv = [ (test, prepend (append tags) ) | (test,tags) <- nv ] - where prepend = foldr (\h t -> (h:).t) id . map (\tag->(tag,PreUpdate ResetGroupStopTask)) $ groupResets - append = (++[(groupSet,PreUpdate SetGroupStopTask)]) + where prepend = foldr (\h t -> (h:).t) id . map (\tag->(tag,ResetGroupStopTask)) $ groupResets + append = (++[(groupSet,SetGroupStopTask)]) -- For PStar, need to put in the orbit TagTasks orbitWrapNullView :: Maybe Tag -> [Tag] -> NullView -> NullView @@ -171,8 +172,8 @@ (Nothing,_) -> do (oldTests,oldTasks) <- oldNV return (oldTests,prepend oldTasks) (Just o,_) -> do (oldTests,oldTasks) <- oldNV - return (oldTests,prepend $ [(o,PreUpdate EnterOrbitTask)] ++ oldTasks ++ [(o,PreUpdate LeaveOrbitTask)]) - where prepend = foldr (\h t -> (h:).t) id . map (\tag->(tag,PreUpdate ResetOrbitTask)) $ orbitResets + return (oldTests,prepend $ [(o,EnterOrbitTask)] ++ oldTasks ++ [(o,LeaveOrbitTask)]) + where prepend = foldr (\h t -> (h:).t) id . map (\tag->(tag,ResetOrbitTask)) $ orbitResets -- The NullViews are ordered, and later test sets that contain the -- tests from any earlier entry will never be chosen. This function diff --git a/Text/Regex/TDFA/NewDFA/Engine.hs b/Text/Regex/TDFA/NewDFA/Engine.hs --- a/Text/Regex/TDFA/NewDFA/Engine.hs +++ b/Text/Regex/TDFA/NewDFA/Engine.hs @@ -52,7 +52,7 @@ -- trace _ a = a err :: String -> a -err s = common_error "Text.Regex.TDFA.NewDFA" s +err s = common_error "Text.Regex.TDFA.NewDFA.Engine" s {-# INLINE (!!) #-} (!!) :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> S.ST s e @@ -131,7 +131,7 @@ Just (c,input') -> case CMap.findWithDefault o c t of Transition {trans_many=DFA {d_id=did',d_dt=dt'},trans_how=dtrans} -> - findTrans s1 s2 did' dt' dtrans offset c input' + findTrans s1 s2 did did' dt' dtrans offset c input' | otherwise -> do (did',dt') <- processWinner s1 did dt w offset next' s1 s2 did' dt' offset prev input @@ -148,7 +148,7 @@ Just (c,input') -> case CMap.findWithDefault o c t of Transition {trans_many=DFA {d_id=did',d_dt=dt'},trans_how=dtrans} -> - findTrans s1 s2 did' dt' dtrans offset c input' + findTrans s1 s2 did did' dt' dtrans offset c input' -- compressOrbits gets all the current Tag-0 start information from -- the NFA states; then it loops through all the Orbit tags with @@ -257,10 +257,10 @@ -- "storeNext". If no winners are ready to be released then the -- computation continues immediately. - findTrans s1 s2 did' dt' dtrans offset prev' input' = {-# SCC "goNext.findTrans" #-} do + findTrans s1 s2 did did' dt' dtrans offset prev' input' = {-# SCC "goNext.findTrans" #-} do -- findTrans part 0 -- MAGIC TUNABLE CONSTANT 100 (and 100-1). TODO: (offset .&. 127 == 127) instead? - when (not (null orbitTags) && (offset `rem` 100 == 99)) (compressOrbits s1 did' offset) + when (not (null orbitTags) && (offset `rem` 100 == 99)) (compressOrbits s1 did offset) -- findTrans part 1 let findTransTo (destIndex,sources) | IMap.null sources = set which destIndex ((-1,Instructions { newPos = [(0,SetPost)], newOrbits = Nothing }) diff --git a/Text/Regex/TDFA/NewDFA/Engine_FA.hs b/Text/Regex/TDFA/NewDFA/Engine_FA.hs --- a/Text/Regex/TDFA/NewDFA/Engine_FA.hs +++ b/Text/Regex/TDFA/NewDFA/Engine_FA.hs @@ -48,7 +48,7 @@ -- trace _ a = a err :: String -> a -err s = common_error "Text.Regex.TDFA.NewDFA" s +err s = common_error "Text.Regex.TDFA.NewDFA.Engine_FA" s {-# INLINE (!!) #-} (!!) :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> S.ST s e @@ -103,7 +103,7 @@ case CMap.findWithDefault o c t of Transition {trans_single=DFA {d_id=did',d_dt=dt'},trans_how=dtrans} | ISet.null did' -> finalizeWinner - | otherwise -> findTrans s1 s2 did' dt' dtrans offset c input' + | otherwise -> findTrans s1 s2 did did' dt' dtrans offset c input' -- compressOrbits gets all the current Tag-0 start information from -- the NFA states; then it loops through all the Orbit tags with @@ -212,10 +212,10 @@ -- "storeNext". If no winners are ready to be released then the -- computation continues immediately. - findTrans s1 s2 did' dt' dtrans offset prev' input' = {-# SCC "goNext.findTrans" #-} do + findTrans s1 s2 did did' dt' dtrans offset prev' input' = {-# SCC "goNext.findTrans" #-} do -- findTrans part 0 -- MAGIC TUNABLE CONSTANT 100 (and 100-1). TODO: (offset .&. 127 == 127) instead? - when (not (null orbitTags) && (offset `rem` 100 == 99)) (compressOrbits s1 did' offset) + when (not (null orbitTags) && (offset `rem` 100 == 99)) (compressOrbits s1 did offset) -- findTrans part 1 let findTransTo (destIndex,sources) | IMap.null sources = set which destIndex noSource diff --git a/Text/Regex/TDFA/Pattern.hs b/Text/Regex/TDFA/Pattern.hs --- a/Text/Regex/TDFA/Pattern.hs +++ b/Text/Regex/TDFA/Pattern.hs @@ -173,7 +173,7 @@ {- The PStar should not capture 0 characters on its first iteration, so set its mayFirstBeNull flag to False -} - PPlus p | canOnlyMatchNull p -> p + PPlus p | canOnlyMatchNull p -> nullGroup p | otherwise -> asGroup $ PConcat [reGroup p,PStar False p] {- "An ERE matching a single character repeated by an '*' , '?' , or @@ -261,7 +261,7 @@ | otherwise -> PStar True p PBound 0 (Just 1) p -> quest p -- Hard cases - PBound i Nothing p | canOnlyMatchNull p -> p + PBound i Nothing p | canOnlyMatchNull p -> nullGroup p | otherwise -> asGroup . PConcat $ apply (nc'p:) (pred i) [reGroup p,PStar False p] where nc'p = nonCapture' p PBound 0 (Just j) p | canOnlyMatchNull p -> quest p @@ -281,7 +281,7 @@ where p' = nonCapture' p -} {- 0.99.7 add -} - PBound i (Just j) p | canOnlyMatchNull p -> p + PBound i (Just j) p | canOnlyMatchNull p -> nullGroup p | i == j -> asGroup . PConcat $ apply (nc'p:) (pred i) [reGroup p] | otherwise -> asGroup . PConcat $ apply (nc'p:) (pred i) [reGroup p,apply (nonEmpty' . (concat' p)) (j-i-1) (ne'p) ] @@ -310,6 +310,7 @@ PNonCapture {} -> pass PNonEmpty {} -> pass -- TODO : remove PNonEmpty from program where + nullGroup p = p quest = (\ p -> POr [p,PEmpty]) -- require p to have been simplified -- quest' = (\ p -> simplify' $ POr [p,PEmpty]) -- require p to have been simplified concat' a b = simplify' $ PConcat [reGroup a,reGroup b] -- require a and b to have been simplified diff --git a/Text/Regex/TDFA/TNFA.hs b/Text/Regex/TDFA/TNFA.hs --- a/Text/Regex/TDFA/TNFA.hs +++ b/Text/Regex/TDFA/TNFA.hs @@ -52,7 +52,7 @@ import Text.Regex.TDFA.Common(QT(..),QNFA(..),QTrans,TagTask(..),TagUpdate(..),DoPa(..) ,CompOption(..) - ,Tag,TagTasks,TagList,Index,WinTags,GroupIndex,GroupInfo(..) + ,Tag,TagTasks,TagList,Index,GroupIndex,GroupInfo(..) ,common_error,noWin,snd3,mapSnd) import Text.Regex.TDFA.CorePattern(Q(..),P(..),OP(..),WhichTest,cleanNullView,NullView ,SetTestInfo(..),Wanted(..),TestInfo @@ -96,7 +96,7 @@ notNullable = null . nullQ -- This asks if the preferred (i.e. first) NullView has no tests. -maybeOnlyEmpty :: Q -> Maybe WinTags +maybeOnlyEmpty :: Q -> Maybe TagTasks maybeOnlyEmpty (Q {nullQ = ((SetTestInfo sti,tags):_)}) = if EMap.null sti then Just tags else Nothing maybeOnlyEmpty _ = Nothing @@ -167,9 +167,10 @@ losing to a branch of "lose" and winning to a branch of "win". Tests not in sti are unchanged (but the losing DoPa index might be added). -} -dominate :: QT -> QT -> (SetTestInfo,WinTags) -> QT -dominate win lose x@(SetTestInfo sti,tags) = debug ("dominate "++show x) $ +dominate :: QT -> QT -> (SetTestInfo,TagTasks) -> QT +dominate win lose x@(SetTestInfo sti,tagTasks) = debug ("dominate "++show x) $ let -- The winning states are reached through the SetTag + tags = [ (tag,PreUpdate task) | (tag,task) <- tagTasks ] win' = prependTags' tags win -- get the SetTestInfo winTests = listTestInfo win $ mempty @@ -241,7 +242,7 @@ -- This takes a function which implements a policy on mergining -- winning transitions and then merges all the transitions. It opens -- the CharMap newtype for more efficient operation, then rewraps it. -mergeQTWith :: (WinTags -> WinTags -> WinTags) -> QT -> QT -> QT +mergeQTWith :: (TagList -> TagList -> TagList) -> QT -> QT -> QT mergeQTWith mergeWins = merge where merge :: QT -> QT -> QT merge (Simple w1 t1 o1) (Simple w2 t2 o2) = @@ -366,17 +367,10 @@ promoteTasks :: (TagTask->TagUpdate) -> TagTasks -> TagList promoteTasks promote tags = map (\(tag,task) -> (tag,promote task)) tags --- only used in addWinTags -demoteTags :: TagList -> TagTasks -demoteTags = map helper - where helper (tag,PreUpdate tt) = (tag,tt) - helper (tag,PostUpdate tt) = (tag,tt) - -- This is polymorphic so addWinTags can be cute below {-# INLINE addWinTags #-} -addWinTags :: WinTags -> (TagTasks,a) -> (TagTasks,a) -addWinTags wtags (tags,cont) = (demoteTags wtags `mappend` tags - ,cont) +addWinTags :: TagTasks -> (TagTasks,a) -> (TagTasks,a) +addWinTags wtags (tags,cont) = (wtags `mappend` tags,cont) {-# INLINE addTag' #-} -- This is polymorphic so addTagAC can be cute below @@ -435,7 +429,7 @@ ,fmap (addGroupSets tags) mE ,fmap (addGroupSets tags) mQNFA) -addWinTagsAC :: WinTags -> ActCont -> ActCont +addWinTagsAC :: TagTasks -> ActCont -> ActCont addWinTagsAC wtags (e,mE,mQNFA) = (addWinTags wtags e ,fmap (addWinTags wtags) mE ,fmap (addWinTags wtags) mQNFA) diff --git a/regex-tdfa.cabal b/regex-tdfa.cabal --- a/regex-tdfa.cabal +++ b/regex-tdfa.cabal @@ -1,5 +1,5 @@ Name: regex-tdfa -Version: 1.1.1 +Version: 1.1.2 -- 0.99.4 tests pnonempty' = \ p -> POr [ PEmpty, p ] instead of PNonEmpty -- 0.99.5 remove PNonEmpty constructor -- 0.99.6 change to nested nonEmpty calls for PBound @@ -39,6 +39,7 @@ -- 1.0.7 make NewDFA directory and String_NC -- 1.1.0 NewDFA code working -- 1.1.1 add gnu escapes +-- 1.1.2 fix fatal error with wrong "d_id" passed to compressOrbits License: BSD3 License-File: LICENSE Copyright: Copyright (c) 2007, Christopher Kuklewicz