packages feed

regex-tdfa 1.1.1 → 1.1.2

raw patch · 8 files changed

+54/−51 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Text.Regex.TDFA.CorePattern: type NullView = [(SetTestInfo, TagList)]
+ Text.Regex.TDFA.CorePattern: type NullView = [(SetTestInfo, TagTasks)]

Files

Text/Regex/TDFA.hs view
@@ -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
Text/Regex/TDFA/Common.hs view
@@ -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)
Text/Regex/TDFA/CorePattern.hs view
@@ -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
Text/Regex/TDFA/NewDFA/Engine.hs view
@@ -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 })
Text/Regex/TDFA/NewDFA/Engine_FA.hs view
@@ -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
Text/Regex/TDFA/Pattern.hs view
@@ -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
Text/Regex/TDFA/TNFA.hs view
@@ -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)
regex-tdfa.cabal view
@@ -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