diff --git a/Text/Regex/TDFA.hs b/Text/Regex/TDFA.hs --- a/Text/Regex/TDFA.hs +++ b/Text/Regex/TDFA.hs @@ -41,7 +41,7 @@ ,module Text.Regex.TDFA.Wrap ,module Text.Regex.Base) where -import Data.Version(Version(..)) +import Data.Version(Version) import Text.Regex.Base import Text.Regex.TDFA.String() import Text.Regex.TDFA.ByteString() @@ -49,8 +49,7 @@ import Text.Regex.TDFA.Sequence() import Text.Regex.TDFA.Wrap(Regex,CompOption(..),ExecOption(..),(=~),(=~~)) +import Paths_regex_tdfa(version) + getVersion_Text_Regex_TDFA :: Version -getVersion_Text_Regex_TDFA = - Version { versionBranch = [0,95,2] - , versionTags = ["tdfa","unstable"] - } +getVersion_Text_Regex_TDFA = version 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 @@ -86,7 +86,7 @@ -- 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). - , testMatch :: Bool -- ^ False by default. Set to True to quickly return shortest match (w/o groups). + , testMatch :: Bool -- ^ False by default. Set to True to quickly return shortest match (w/o groups). [ UNUSED ] } deriving (Read,Show) -- | Used by implementation to name certain Postions during matching diff --git a/Text/Regex/TDFA/MutRun.hs b/Text/Regex/TDFA/MutRun.hs --- a/Text/Regex/TDFA/MutRun.hs +++ b/Text/Regex/TDFA/MutRun.hs @@ -1,6 +1,10 @@ -- | "Text.Regex.TDFA.Run" is the main module for matching a DFA -- against a String. Many of the associated functions are exported to -- other modules to help match against other types. +-- +-- 2009-January: logic changes to capturing in matchHere (need to change noCap XXX TODO): +-- The logic below has been changed to recognize an empty match at the end of the string. +-- The logic below has been changed to proceed after the first empty match. module Text.Regex.TDFA.MutRun (findMatch,findMatchAll,countMatchAll) where import Control.Monad(MonadPlus(..)) @@ -107,9 +111,16 @@ Just (w,(off',prev',input')) -> do ma <- lazy (tagsToGroupsST (regex_groups regexIn) w) let len = snd (ma!0) - rest <- if len==0 || null input' then return [] - else do () <- lazy (resetScratch regexIn off' s1 w0) - go off' prev' input' + rest <- if len==0 + then case input' of + [] -> return [] + (prev'':input'') -> do + let off'' = succ off' + () <- lazy (resetScratch regexIn off'' s1 w0) + go off'' prev'' input'' + else do + () <- lazy (resetScratch regexIn off' s1 w0) + go off' prev' input' return (ma:rest) if frontAnchored then if offsetIn/=0 then return [] @@ -134,8 +145,17 @@ Just (off',prev',input') -> let len = off'-off ma = array (0,0) [(0,(off,len))] + rest = if len == 0 + then case input' of + [] -> [] + (prev'':input'') -> + let off'' = succ off' + in go off'' prev'' input'' + else go off' prev' input' +{- rest = if len == 0 || null input then [] else go off' prev' input' +-} in (ma:rest) in if frontAnchored then if offsetIn /= 0 then [] diff --git a/Text/Regex/TDFA/MutRunBS.hs b/Text/Regex/TDFA/MutRunBS.hs --- a/Text/Regex/TDFA/MutRunBS.hs +++ b/Text/Regex/TDFA/MutRunBS.hs @@ -101,7 +101,7 @@ let go off = {-# SCC "runHerePure.go" #-} off `seq` do answer <- lazy (runHere Nothing (d_dt (regex_dfa regexIn)) s1 s2 off) case answer of - Nothing -> if off==final + Nothing -> if off==final -- no match starting past the last character then return [] else do let off' = succ off () <- lazy (resetScratch regexIn off' s1 w0) @@ -109,7 +109,11 @@ Just (w,off') -> do ma <- lazy (tagsToGroupsST (regex_groups regexIn) w) let len = snd (ma!0) - rest <- if len==0 || off'==final then return [] + rest <- if len==0 + then if off'==final then return [] + else do let off'' = succ off' + () <- lazy (resetScratch regexIn off'' s1 w0) + go off'' else do () <- lazy (resetScratch regexIn off' s1 w0) go off' return (ma:rest) @@ -133,7 +137,9 @@ Just off' -> let len = off'-off ma = array (0,0) [(0,(off,len))] - rest = if len == 0 || off'==final then [] + rest = if len==0 + then if off'==final then [] + else go (succ off') else go off' in (ma:rest) in if frontAnchored diff --git a/Text/Regex/TDFA/MutRunLBS.hs b/Text/Regex/TDFA/MutRunLBS.hs --- a/Text/Regex/TDFA/MutRunLBS.hs +++ b/Text/Regex/TDFA/MutRunLBS.hs @@ -108,7 +108,11 @@ Just (w,off') -> do ma <- lazy (tagsToGroupsST (regex_groups regexIn) w) let len = snd (ma!0) - rest <- if len==0 || off'==final then return [] + rest <- if len==0 + then if off'==final then return [] + else do let off'' = succ off' + () <- lazy (resetScratch regexIn off'' s1 w0) + go off'' else do () <- lazy (resetScratch regexIn off' s1 w0) go off' return (ma:rest) @@ -132,7 +136,9 @@ Just off' -> let len = off'-off ma = array (0,0) [(0,(off,len))] - rest = if len == 0 || off'==final then [] + rest = if len==0 + then if off'==final then [] + else go (succ off') else go off' in (ma:rest) in if frontAnchored diff --git a/Text/Regex/TDFA/MutRunSeq.hs b/Text/Regex/TDFA/MutRunSeq.hs --- a/Text/Regex/TDFA/MutRunSeq.hs +++ b/Text/Regex/TDFA/MutRunSeq.hs @@ -110,9 +110,15 @@ Just (w,(off',prev',input')) -> do ma <- lazy (tagsToGroupsST (regex_groups regexIn) w) let len = snd (ma!0) - rest <- if len==0 || S.null input' then return [] - else do () <- lazy (resetScratch regexIn off' s1 w0) - go off' prev' input' + rest <- if len==0 + then case S.viewl input of + EmptyL -> return [] + (prev'' :< input'') -> do + let off'' = succ off' + () <- lazy (resetScratch regexIn off'' s1 w0) + go off'' prev'' input'' + else do () <- lazy (resetScratch regexIn off' s1 w0) + go off' prev' input' return (ma:rest) if frontAnchored then if offsetIn/=0 then return [] @@ -133,12 +139,17 @@ Nothing -> case S.viewl input of EmptyL -> [] (prev' :< input') -> let off' = succ off - in go off' prev' input' + in go off' prev' input' Just (off',prev',input') -> let len = off'-off ma = array (0,0) [(0,(off,len))] - rest = if len == 0 || S.null input then [] - else go off' prev' input' + rest = if len==0 + then case S.viewl input' of + EmptyL -> [] + (prev'' :< input'') -> + let off'' = succ off' + in go off'' prev'' input'' + else go off' prev' input' in (ma:rest) in if frontAnchored then if offsetIn /= 0 then [] 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 @@ -184,7 +184,7 @@ {- The iterations before the last required one cannot determine the group capture so change the PGroups to False or wrap in PNonCapture. -} - PBound i Nothing p -> PConcat $ apply (p':) (pred i) [p,simplify' $ PStar False p] + PBound i Nothing p -> asGroup . PConcat $ apply (p':) (pred i) [p,simplify' $ PStar False p] where p' = nonCapture' p -- XXX cleanup {- p{0,2} is (pp?)? is p?p? and p{0,3} is (p(pp?)?)? is p?p?p? @@ -228,16 +228,61 @@ And by this logic, the PStar False is really p*! So p{0,} is p* and p{1,} is pp*! and p{2,} is p'pp*! and p{3,} is p'p'pp*! + +WTF BUG: but which is right? The last capture is "" if the (){,} is +itself put in parenthesis. So the simple solution is to wrap the +expanded PBound in a (PGroup Nothing). + +/Test-str "ababcd" "(a|ab|c|bcd){0,10}(d*)" +TDFA ("","ababcd","",["bcd",""]) +/Test-str "ababcd" "(a|ab|c|bcd){1,10}(d*)" +TDFA ("","ababcd","",["bcd",""]) +/Test-str "ababcd" "(a|ab|c|bcd){2,10}(d*)" +TDFA ("","ababcd","",["c","d"]) +/Test-str "ababcd" "(a|ab|c|bcd){3,10}(d*)" +TDFA ("","ababcd","",["c","d"]) +./Test-str "ababcd" "(a|ab|c|bcd){4,10}(d*)" +TDFA ("ababcd","","",[]) + +./Test-str "ababcd" "(a|ab|c|bcd){0,}(d*)" +TDFA ("","ababcd","",["bcd",""]) +./Test-str "ababcd" "(a|ab|c|bcd){1,}(d*)" +TDFA ("","ababcd","",["bcd",""]) +./Test-str "ababcd" "(a|ab|c|bcd){2,}(d*)" +TDFA ("","ababcd","",["c","d"]) +./Test-str "ababcd" "(a|ab|c|bcd){3,}(d*)" +TDFA ("","ababcd","",["c","d"]) +./Test-str "ababcd" "(a|ab|c|bcd){4,}(d*)" +TDFA ("ababcd","","",[]) + +The two parsing are, explicity in my notation: + +./Test-str "ababcd" "(a|ab|c|bcd)?(a|ab|c|bcd)?(a|ab|c|bcd)?(a|ab|c|bcd)?(d*)" +TDFA ("","ababcd","",["ab","ab","c","","d"]) + +In the next series is the issue with + +./Test-str "ababcd" "((a|ab|c|bcd)((a|ab|c|bcd)((a|ab|c|bcd)(a|ab|c|bcd)?)?)?)?(d*)" +TDFA ("","ababcd","",["ababcd","ab","abcd","a","bcd","bcd","",""]) +./Test-str "ababcd" "<(a|ab|c|bcd)<(a|ab|c|bcd)<(a|ab|c|bcd)(a|ab|c|bcd)?>?>?>?(d*)" +TDFA ("","ababcd","",["ab","a","bcd","",""]) +./Test-str "ababcd" "(a|ab|c|bcd)((a|ab|c|bcd)((a|ab|c|bcd)((a|ab|c|bcd)(a|ab|c|bcd)?)?)?)?(d*)" +TDFA ("","ababcd","",["ab","abcd","a","bcd","bcd","","","",""]) +./Test-str "ababcd" "(a|ab|c|bcd)(a|ab|c|bcd)((a|ab|c|bcd)((a|ab|c|bcd)((a|ab|c|bcd)(a|ab|c|bcd)?)?)?)?(d*)" +TDFA ("","ababcd","",["ab","ab","c","c","","","","","","d"]) +./Test-str "ababcd" "(a|ab|c|bcd)(a|ab|c|bcd)(a|ab|c|bcd)((a|ab|c|bcd)((a|ab|c|bcd)((a|ab|c|bcd)(a|ab|c|bcd)?)?)?)?(d*)" +TDFA ("","ababcd","",["ab","ab","c","","","","","","","","d"]) + -} PBound 0 (Just j) p | cannotMatchNull p -> apply (quest' . (concat' p)) (pred j) (quest' p) | canOnlyMatchNull p -> quest' p | otherwise -> POr [ simplify' (PConcat (p : replicate (pred j) (nonEmpty' p))) , PEmpty ] -- - PBound i (Just j) p | i == j -> PConcat $ apply (p':) (pred i) [p] - | cannotMatchNull p -> PConcat $ apply (p':) (pred i) $ (p:) $ + PBound i (Just j) p | i == j -> asGroup . PConcat $ apply (p':) (pred i) [p] + | cannotMatchNull p -> asGroup . PConcat $ apply (p':) (pred i) $ (p:) $ [apply (quest' . (concat' p)) (pred (j-i)) (quest' p)] | canOnlyMatchNull p -> p - | otherwise -> PConcat $ (replicate (pred i) p') ++ p : (replicate (j-i) (nonEmpty' p)) + | otherwise -> asGroup . PConcat $ (replicate (pred i) p') ++ p : (replicate (j-i) (nonEmpty' p)) where p' = nonCapture' p -- XXX cleanup -- Left intact PEmpty -> pass @@ -260,6 +305,7 @@ nonEmpty' = PNonEmpty nonCapture' = PNonCapture apply f n x = foldr ($) x (replicate n f) + asGroup p = PGroup Nothing (simplify' p) pass = pIn -- | Function to transform a pattern into an equivalent, but less 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 @@ -58,6 +58,9 @@ import Text.Regex.TDFA.ReadRegex(decodePatternSet) import Debug.Trace +ecart :: String -> a -> a +ecart _ = id + err :: String -> a err t = common_error "Text.Regex.TDFA.TNFA" t @@ -470,7 +473,7 @@ else ans) else this) {- NonEmpty is like actNullable (Or [Empty,q]) without the extra tag to prefer the first Empty branch -} - NonEmpty q -> trace ("\n> getTrans/NonEmpty"++show qIn) $ do + NonEmpty q -> ecart ("\n> getTransTagless/NonEmpty"++show qIn) $ do -- Assertion to check than Pattern.starTrans did its job right: when (cannotAccept q) (err $ "getTransTagless/NonEmpty : provided with a *cannotAccept* pattern: "++show (qTop,qIn)) when (mustAccept q) (err $ "getTransTagless/NonEmpty : provided with a *mustAccept* pattern: "++show (qTop,qIn)) @@ -509,7 +512,7 @@ return (fmap getQT meAcceptingOut) Star {} -> do (_,meAcceptingOut,_) <- actNullableTagless qIn (eLoop,Nothing,Nothing) return (fmap getQT meAcceptingOut) - NonEmpty {} -> trace ("\n> inStar/NonEmpty"++show qIn) $ + NonEmpty {} -> ecart ("\n> inStarNullableTagless/NonEmpty"++show qIn) $ do (_,meAcceptingOut,_) <- actNullableTagless qIn (eLoop,Nothing,Nothing) return (fmap getQT meAcceptingOut) Test {} -> return Nothing -- with Or this discards ^ branch in "(^|foo|())*" @@ -639,7 +642,7 @@ return (thisAll,ansAll) return (if mayFirstBeNull then (if clear then thisAC else ansAC) else thisAC) - NonEmpty q -> trace ("\n> actNullableTagless/NonEmpty"++show qIn) $ do + NonEmpty q -> ecart ("\n> actNullableTagless/NonEmpty"++show qIn) $ do -- We *know* that q is nullable from Pattern and CorePattern checks, but assert here anyway when (mustAccept q) (err $ "actNullableTagless/NonEmpty : provided with a *mustAccept* pattern: "++show (qTop,qIn)) when (cannotAccept q) (err $ "actNullableTagless/NonEmpty : provided with a *cannotAccept* pattern: "++show (qTop,qIn)) diff --git a/regex-tdfa.cabal b/regex-tdfa.cabal --- a/regex-tdfa.cabal +++ b/regex-tdfa.cabal @@ -1,52 +1,54 @@ Name: regex-tdfa -Version: 0.95.2 -Cabal-Version: >=1.2 +Version: 0.97.1 +-- 0.97.1: Bug Fix: Use PGroup Nothing when expanding PBound +Cabal-Version: >=1.2.3 License: BSD3 License-File: LICENSE -Copyright: Copyright (c) 2007, Christopher Kuklewicz +Copyright: Copyright (c) 2007-2009, Christopher Kuklewicz Author: Christopher Kuklewicz Maintainer: TextRegexLazy@personal.mightyreason.com Stability: Seems to work, but not POSIX yet Homepage: http://sourceforge.net/projects/lazy-regex Package-URL: http://darcs.haskell.org/packages/regex-unstable/regex-tdfa/ -Synopsis: Replaces/Enhances Text.Regex +Synopsis: Accurate POSIX extended regular expression library Description: A new all Haskell "tagged" DFA regex engine, inspired by libtre Category: Text Tested-With: GHC Build-Type: Simple - flag base4 library + Build-Depends: regex-base >= 0.80, parsec, mtl, containers, array, bytestring if flag(base4) - Build-Depends: regex-base >= 0.80, base >= 4.0, parsec, mtl, containers, array, bytestring, ghc-prim + Build-Depends: base >= 4.0, ghc-prim else - Build-Depends: regex-base >= 0.80, base < 4.0, parsec, mtl, containers, array, bytestring - Exposed-Modules: Text.Regex.TDFA.Common - Text.Regex.TDFA.IntArrTrieSet - Text.Regex.TDFA.TNFA - Text.Regex.TDFA.TDFA - Text.Regex.TDFA.Pattern - Text.Regex.TDFA.ReadRegex - Text.Regex.TDFA.CorePattern - Text.Regex.TDFA.RunMutState - Text.Regex.TDFA.String - Text.Regex.TDFA.MutRun - Text.Regex.TDFA.ByteString - Text.Regex.TDFA.MutRunBS - Text.Regex.TDFA.ByteString.Lazy - Text.Regex.TDFA.MutRunLBS - Text.Regex.TDFA.Sequence - Text.Regex.TDFA.MutRunSeq - Text.Regex.TDFA.Wrap - Text.Regex.TDFA - Data.IntSet.EnumSet - Data.IntMap.EnumMap - Data.IntMap.CharMap - Buildable: True - Extensions: MultiParamTypeClasses, FunctionalDependencies, BangPatterns, MagicHash, RecursiveDo, NoMonoPatBinds, ForeignFunctionInterface, UnboxedTuples, TypeOperators, FlexibleContexts, ExistentialQuantification, UnliftedFFITypes, TypeSynonymInstances - GHC-Options: -Wall -O2 -funbox-strict-fields + Build-Depends: base < 4.0 + other-modules: Paths_regex_tdfa + Exposed-Modules: Text.Regex.TDFA.Common + Text.Regex.TDFA.IntArrTrieSet + Text.Regex.TDFA.TNFA + Text.Regex.TDFA.TDFA + Text.Regex.TDFA.Pattern + Text.Regex.TDFA.ReadRegex + Text.Regex.TDFA.CorePattern + Text.Regex.TDFA.RunMutState + Text.Regex.TDFA.String + Text.Regex.TDFA.MutRun + Text.Regex.TDFA.ByteString + Text.Regex.TDFA.MutRunBS + Text.Regex.TDFA.ByteString.Lazy + Text.Regex.TDFA.MutRunLBS + Text.Regex.TDFA.Sequence + Text.Regex.TDFA.MutRunSeq + Text.Regex.TDFA.Wrap + Text.Regex.TDFA + Data.IntSet.EnumSet + Data.IntMap.EnumMap + Data.IntMap.CharMap + Buildable: True + Extensions: MultiParamTypeClasses, FunctionalDependencies, BangPatterns, MagicHash, RecursiveDo, NoMonoPatBinds, ForeignFunctionInterface, UnboxedTuples, TypeOperators, FlexibleContexts, ExistentialQuantification, UnliftedFFITypes, TypeSynonymInstances + GHC-Options: -Wall -O2 -funbox-strict-fields -- GHC-Options: -Wall -O2 -- GHC-Options: -Wall -ddump-minimal-imports -- GHC-Prof-Options: -auto-all