regex-tdfa 1.1.3 → 1.1.4
raw patch · 6 files changed
+60/−23 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Text/Regex/TDFA/CorePattern.hs +28/−11
- Text/Regex/TDFA/NewDFA/Engine.hs +19/−5
- Text/Regex/TDFA/NewDFA/Engine_FA.hs +4/−4
- Text/Regex/TDFA/Pattern.hs +1/−1
- Text/Regex/TDFA/ReadRegex.hs +4/−1
- regex-tdfa.cabal +4/−1
Text/Regex/TDFA/CorePattern.hs view
@@ -44,10 +44,11 @@ import qualified Data.IntSet.EnumSet2 as Set(singleton,toList,isSubsetOf) import Text.Regex.TDFA.Common {- all -} import Text.Regex.TDFA.Pattern(Pattern(..),starTrans)---import Debug.Trace+-- import Debug.Trace {- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -} + --err :: String -> a --err = common_error "Text.Regex.TDFA.CorePattern" @@ -283,6 +284,16 @@ helper ls rs ((Left x):xs) = helper (ls.(x:)) rs xs -- Partial function: assumes starTrans has been run on the Pattern+-- Note that the lazy dependency chain for this very zigzag:+-- varies information is sent up the tree+-- handle tags depend on that and sends m1 m2 down the tree+-- makeGroup sends some tags to the writer (Right _)+-- withParent listens to children send group info to writer+-- and lazily looks resetGroupTags from aGroups, the result of all writer (Right _)+-- preReset stores the resetGroupTags result of the lookup in the tree+-- makeOrbit sends some tags to the writer (Left _)+-- withOrbit listens to children send orbit info to writer for resetOrbitTags +-- nullQ depends m1 m2 and resetOrbitTags and resetGroupTags and is sent up the tree patternToQ :: CompOption -> (Pattern,(GroupIndex,DoPa)) -> (Q,Array Tag OP,Array GroupIndex [GroupInfo]) patternToQ compOpt (pOrig,(maxGroupIndex,_)) = (tnfa,aTags,aGroups) where (tnfa,(tag_dlist,nextTag),groups) = runRWS monad startReader startState@@ -296,21 +307,23 @@ startReader = Just 0 -- start inside group 0, capturing enabled -- The startState is only acted upon in the "uniq" command -- Tag 0 is Minimized and Tag 1 is maximized, next tag has value of 2- -- This is regarless of right or left associativity+ -- This is regardless of right or left associativity startState :: ([OP]->[OP],Tag) startState = ( (Minimize:) . (Maximize:) , 2) -- uniq uses MonadState and always returns an "Apply _" tag {-# INLINE uniq #-} uniq :: String -> PM HandleTag- uniq _msg = do x <- fmap Apply (uniq' Maximize)--- trace (_msg ++ " Maximize "++show x) $ return x- return x+ uniq _msg = fmap Apply (uniq' Maximize)+-- uniq _msg = do x <- fmap Apply (uniq' Maximize)+-- trace ('\n':msg ++ " Maximize "++show x) $ return x+-- return x ignore :: String -> PM Tag- ignore _msg = do x <- uniq' Ignore--- trace (_msg ++ " Ignore "++show x) $ return x- return x+ ignore _msg = uniq' Ignore+-- ignore _msg = do x <- uniq' Ignore+-- trace ('\n':msg ++ " Ignore "++show x) $ return x+-- return x {-# NOINLINE uniq' #-} uniq' :: OP -> PM Tag@@ -326,7 +339,7 @@ -- makeOrbit uses MonadState(uniq) and MonadWriter(tell/Left) makeOrbit :: PM (Maybe Tag) makeOrbit = do x <- uniq' Orbit--- trace ("PStar Orbit "++show x) $ do+-- trace ('\n':"PStar Orbit "++show x) $ do tell [Left x] return (Just x) @@ -355,6 +368,8 @@ -- withParent uses MonadReader(local) to set getParentIndex to return (Just this) -- withParent uses MonadWriter(listens to makeGroup/Right) to return contained group indices (stopTag) -- withParent is only safe if getParentIndex has been checked to be not equal to Nothing (see PGroup below)+ -- Note use of laziness: the immediate children's group index is used to look up all copies of the + -- group in aGroups, including copies that are not immediate children. withParent :: GroupIndex -> PM a -> PM (a,[Tag]) withParent this = local (const (Just this)) . listens childGroupInfo where childGroupInfo x =@@ -440,11 +455,12 @@ bAdvice = toAdvice b -- last branch gets 'bAdvice', others may get own tag -- Due to the recursive-do, it seems that I have to put the if needTags into the op' newUniq = if needTags then uniq "POr branch" else return bAdvice+-- trace ("\nPOr sub "++show aAdvice++" "++show bAdvice++"needsTags is "++show needTags) $ return () -- The "bs" values are allocated in left-to-right order before the children in "qs" -- optimiztion: low priority for last branch is implicit, do not create separate tag here. bs <- fmap (++[bAdvice]) $ replicateM (pred $ length branches) newUniq -- 2 <= length ps -- create all the child branches in left-to-right order after the "bs"- qs <- forM (zip branches bs) (\(branch,bTag) -> go branch aAdvice bTag)+ qs <- forM (zip branches bs) (\(branch,bTag) -> (go branch aAdvice bTag)) let wqs = map wants qs wanted = if any (WantsBoth==) wqs then WantsBoth else case (any (WantsQNFA==) wqs,any (WantsQT==) wqs) of@@ -524,11 +540,12 @@ -- -- Guarded by the getParentIndex /= Nothing check is the -- withParent command.+ -- PGroup Nothing p -> go p m1 m2 PGroup (Just this) p -> do mParent <- getParentIndex case mParent of- Nothing -> go p m1 m2 -- just like PGrop Nothing p+ Nothing -> go p m1 m2 -- just like PGroup Nothing p Just parent -> do -- 'a' may be Advice or Apply from parent or Apply created here a <- if noTag m1 then uniq "PGroup start" else return m1
Text/Regex/TDFA/NewDFA/Engine.hs view
@@ -50,9 +50,17 @@ -- trace :: String -> a -> a -- trace _ a = a+{-+see :: (Show x, Monad m) => String -> x -> m a -> m a+see _ _ m = m+--see msg s m = trace ("\nsee: "++msg++" : "++show s) m +sees :: (Monad m) => String -> String -> m a -> m a+sees _ _ m = m+--sees msg s m = trace ("\nsee: "++msg++" :\n"++s) m+-} 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 +139,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 +156,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 +265,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 })@@ -478,6 +486,12 @@ return $ unlines [ "MScratch, index = "++show i , indent a , indent c]++showMS2 :: MScratch s -> ST s String+showMS2 s = do+ (lo,hi) <- getBounds (m_pos s)+ strings <- forM [lo..hi] (showMS s)+ return (unlines strings) showWS :: WScratch s -> ST s String showWS (WScratch pos) = do
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
@@ -135,7 +135,7 @@ -- and PEmpty and PStar True/False. For some PBound values it adds -- PNonEmpty and PNonCapture semantic marker. It also simplifies to -- flatten out nested POr and PConcat instances and eliminate some--- uneeded PEmpty values.+-- unneeded PEmpty values. starTrans :: Pattern -> Pattern starTrans = dfsPattern (simplify' . starTrans')
Text/Regex/TDFA/ReadRegex.hs view
@@ -131,7 +131,10 @@ start <- noneOf "]-" _ <- char '-' end <- noneOf "]"- return (BEChars [start..end])+ -- bug fix: check start <= end before "return (BEChars [start..end])"+ if start <= end+ then return (BEChars [start..end])+ else unexpected "End point of dashed character range is less than starting point" p_set_elem_char = do c <- noneOf "]"
regex-tdfa.cabal view
@@ -1,5 +1,5 @@ Name: regex-tdfa-Version: 1.1.3+Version: 1.1.4 -- 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,9 @@ -- 1.0.7 make NewDFA directory and String_NC -- 1.1.0 NewDFA code working -- 1.1.1 add gnu escapes+-- 1.1.2 worked+-- 1.1.3 BROKEN after 100 characters the compressOrbit dies!+-- 1.1.4 fixed License: BSD3 License-File: LICENSE Copyright: Copyright (c) 2007, Christopher Kuklewicz