packages feed

regex-tdfa 1.1.0 → 1.1.1

raw patch · 19 files changed

+428/−587 lines, 19 filesdep ~containers

Dependency ranges changed: containers

Files

Text/Regex/TDFA.hs view
@@ -1,15 +1,3 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--{- Wrong answer--"A\n_"-"(^|()|.|()){0,3}()"--("TDFA   ",("",array (0,4) [(0,("",(0,0))),(1,("",(-1,0))),(2,("",(-1,0))),(3,("",(-1,0))),(4,("",(0,0)))],"A\n_"))---}-- {-|   The "Text.Regex.TDFA" module provides a backend for regular@@ -18,28 +6,57 @@ you import this along with other backends then you should do so with qualified imports (with renaming for convenience). -Todo:-  compNoCapture to avoid creating any tags and optimize inStar stuff...-  runBool case for aborting on shortest match-  frontAnchored-  Cleanup locations of helper functions-  Decide whether to nix DoPa or just replace with Int-  Make untagged TDFA for non-capturing cases-  Pull starTrans into ReadRegex-  Consider replacing Pattern with CorePattern entirely-  Remove parent info from GroupInfo and/or reduce tag resetting workload-    (try to shift work from doing resets to post-processing)+This regex-tdfa package implements, correctly, POSIX extended regular+expressions.  It is highly unlikely that the regex-posix package on+your operating system is correct, see+http://www.haskell.org/haskellwiki/Regex_Posix for examples of your+OS's bugs. -Beyond posix:-  non-capturing groups-  Inverted tests and additional tests-  lazy instead of greedy-  possessive instead of greedy-  leftmost branch instead of leftmost/longest (open/close group instead of tagging)+This package does provide captured parenthesized subexpressions.++Depending on the text being searched this package supports Unicode.+The [Char] and (Seq Char) text types support Unicode.  The ByteString+and ByteString.Lazy text types only support ASCII.  It is possible to+support utf8 encoded ByteString.Lazy by using regex-tdfa and+regex-tdfa-utf8 packages together  (required the utf8-string package).++As of version 1.1.1 the following GNU extensions are recognized, all+anchors:++\` at beginning of entire text++\' at end of entire text++\< at beginning of word++\> at end of word++\b at either beginning or end of word++\B at neither beginning nor end of word++Where the "word" boundaries means between characters that are and are+not in the [:word:] character class which contains [a-zA-Z0-9_].  Note+that \< and \b may match before the entire text and \> and \b may+match at the end of the entire text.++There is no locale support, so collating elements like [.ch.] are+simply ignored and equivalence classes like [=a=] are converted to+just [a].  The character classes like [:alnum:] are supported over+ASCII only, valid classes are alnum, digit, punct, alpha, graph,+space, blank, lower, upper, cntrl, print, xdigit, word.++This package does not provide "basic" regular expressions.  This+package does not provide back references inside regular expressions.++The package does not provide Perl style regular expressions.  Please+look at the regex-pcre and pcre-light packages instead.+ -}  module Text.Regex.TDFA(getVersion_Text_Regex_TDFA-                      ,module Text.Regex.TDFA.Wrap+                      ,(=~),(=~~)+                      ,module Text.Regex.TDFA.Common                       ,module Text.Regex.Base) where  import Data.Version(Version)@@ -48,9 +65,29 @@ import Text.Regex.TDFA.ByteString() import Text.Regex.TDFA.ByteString.Lazy() import Text.Regex.TDFA.Sequence()-import Text.Regex.TDFA.Wrap(Regex,CompOption(..),ExecOption(..),(=~),(=~~))+import Text.Regex.TDFA.Common(Regex,CompOption(..),ExecOption(..))+--import Text.Regex.TDFA.Wrap(Regex,CompOption(..),ExecOption(..),(=~),(=~~))  import Paths_regex_tdfa(version)  getVersion_Text_Regex_TDFA :: Version getVersion_Text_Regex_TDFA = version+++-- | This is the pure functional matching operator.  If the target+-- cannot be produced then some empty result will be returned.  If+-- there is an error in processing, then 'error' will be called.+(=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target)+     => source1 -> source -> target+(=~) x r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex+               make = makeRegex+           in match (make r) x++-- | This is the monadic matching operator.  If a single match fails,+-- then 'fail' will be called.+(=~~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,Monad m)+      => source1 -> source -> m target+(=~~) x r = do let make :: (RegexMaker Regex CompOption ExecOption a, Monad m) => a -> m Regex+                   make = makeRegexM+               q <- make r+               matchM q x
Text/Regex/TDFA/ByteString.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-} {-|  This modules provides 'RegexMaker' and 'RegexLike' instances for using 'ByteString' with the DFA backend ("Text.Regex.Lib.WrapDFAEngine" and@@ -19,7 +18,7 @@  ) where  import Data.Array((!),elems)-import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Char8 as B(ByteString,take,drop,unpack)  import Text.Regex.Base(MatchArray,RegexContext(..),RegexMaker(..),RegexLike(..)) import Text.Regex.Base.Impl(polymatch,polymatchM)@@ -27,7 +26,6 @@ import Text.Regex.TDFA.String() -- piggyback on RegexMaker for String import Text.Regex.TDFA.TDFA(patternToRegex) import Text.Regex.TDFA.Common(Regex(..),CompOption,ExecOption(captureGroups))-import Text.Regex.TDFA.Wrap()  import Data.Maybe(listToMaybe) import Text.Regex.TDFA.NewDFA.Engine(execMatch)
Text/Regex/TDFA/ByteString/Lazy.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fno-warn-orphans #-} {-|  This modules provides 'RegexMaker' and 'RegexLike' instances for using 'ByteString' with the DFA backend ("Text.Regex.Lib.WrapDFAEngine" and@@ -18,7 +17,7 @@  ) where  import Data.Array.IArray((!),elems,amap)-import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Lazy.Char8 as L(ByteString,take,drop,unpack)  import Text.Regex.Base(MatchArray,RegexContext(..),RegexMaker(..),RegexLike(..)) import Text.Regex.Base.Impl(polymatch,polymatchM)@@ -26,7 +25,6 @@ import Text.Regex.TDFA.String() -- piggyback on RegexMaker for String import Text.Regex.TDFA.TDFA(patternToRegex) import Text.Regex.TDFA.Common(Regex(..),CompOption,ExecOption(captureGroups))-import Text.Regex.TDFA.Wrap()  import Data.Maybe(listToMaybe) import Text.Regex.TDFA.NewDFA.Engine(execMatch)@@ -61,14 +59,15 @@          (matchOnce regex source)   matchAllText regex source =     let go i _ _ | i `seq` False = undefined-        go i t [] = []+        go _i _t [] = []         go i t (x:xs) =           let (off0,len0) = x!0               trans pair@(off32,len32) = (L.take (fi len32) (L.drop (fi (off32-i)) t),pair)               t' = L.drop (fi (off0+len0-i)) t-          in amap trans x : seq t' (go (i+off0+len0) t' xs) +          in amap trans x : seq t' (go (off0+len0) t' xs)      in go 0 source (matchAll regex source) +fi :: (Integral a, Num b) => a -> b fi = fromIntegral  compile :: CompOption -- ^ Flags (summed together)
Text/Regex/TDFA/Common.hs view
@@ -2,23 +2,21 @@ -- | Common provides simple functions to the backend.  It defines most -- of the data types.  All modules should call error via the -- common_error function below.-module Text.Regex.TDFA.Common {- export everything -} where+module Text.Regex.TDFA.Common where -{- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -}+import Text.Regex.Base(RegexOptions(..)) +{- By Chris Kuklewicz, 2007-2009. BSD License, see the LICENSE file. -} import Text.Show.Functions()---import Control.Monad.State(State)-import Data.Monoid(mempty,mappend)-import Data.Foldable(Foldable(..)) import Data.Array.IArray(Array) import Data.IntSet.EnumSet2(EnumSet) import qualified Data.IntSet.EnumSet2 as Set(toList)+import Data.IntMap.CharMap2(CharMap(..)) import Data.IntMap (IntMap)-import qualified Data.IntMap as IMap (findWithDefault,assocs,toList,null)+import qualified Data.IntMap as IMap (findWithDefault,assocs,toList,null,size,toAscList) import Data.IntSet(IntSet)-import Data.IntMap.CharMap2(CharMap) import qualified Data.IntMap.CharMap2 as Map (assocs,toAscList,null)-import Data.Sequence(Seq)+import Data.Sequence as S(Seq) --import Debug.Trace  import Text.Regex.TDFA.IntArrTrieSet(TrieSet)@@ -82,20 +80,28 @@ instance Show DoPa where   showsPrec p (DoPa {dopaIndex=i}) = ('#':) . showsPrec p i --- | Control whether the pattern is multiline or--- case-sensitive like Text.Regex and whether to capture the subgroups--- (\1, \2, etc).-data CompOption = CompOption { caseSensitive :: Bool    -- ^ True by default-                             , multiline :: Bool        -- ^ True by default, implies "." and "[^a]" will not match '\n'-                             , rightAssoc :: Bool       -- ^ False (and therefore left associative) by default-                             , 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).-                             , testMatch :: Bool        -- ^ False by default. Set to True to quickly return shortest match (w/o groups). [ UNUSED ]-                             } deriving (Read,Show)+-- | 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,+                      `[^' 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. Add the extended non-POSIX syntax described in "Text.Regex.TDFA" haddock documentation.+  , 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)+ -- | Used by implementation to name certain Postions during matching type Tag = Int           -- ^ identity of Position tag to set during a transition -- | Internal use to indicate type of tag and preference for larger or smaller Positions@@ -109,37 +115,60 @@ type GroupIndex = Int -- | GroupInfo collects the parent and tag information for an instance  -- of a group-data GroupInfo = GroupInfo {thisIndex,parentIndex::GroupIndex-                           ,startTag,stopTag,flagTag::Tag-                           } deriving Show+data GroupInfo = GroupInfo {+    thisIndex, parentIndex :: GroupIndex+  , startTag, stopTag, flagTag :: Tag+  } deriving Show  -- | The TDFA backend specific 'Regex' type, used by this module's RegexOptions and RegexMaker-data Regex = Regex {regex_dfa :: DFA                             -- ^ starting DFA state-                   ,regex_init :: Index                          -- ^ index of starting state-                   ,regex_b_index :: (Index,Index)               -- ^ indexes of smallest and largest states-                   ,regex_b_tags :: (Tag,Tag)                    -- ^ indexes of smallest and largest tags-                   ,regex_trie :: TrieSet DFA                    -- ^ All DFA states-                   ,regex_tags :: Array Tag OP                   -- ^ information about each tag-                   ,regex_groups :: Array GroupIndex [GroupInfo] -- ^ information about each group-                   ,regex_isFrontAnchored :: Bool                -- ^ used for optimizing execution-                   ,regex_compOptions :: CompOption              -- -                   ,regex_execOptions :: ExecOption}+data Regex = Regex {+    regex_dfa :: DFA                             -- ^ starting DFA state+  , regex_init :: Index                          -- ^ index of starting state+  , regex_b_index :: (Index,Index)               -- ^ indexes of smallest and largest states+  , regex_b_tags :: (Tag,Tag)                    -- ^ indexes of smallest and largest tags+  , regex_trie :: TrieSet DFA                    -- ^ All DFA states+  , regex_tags :: Array Tag OP                   -- ^ information about each tag+  , regex_groups :: Array GroupIndex [GroupInfo] -- ^ information about each group+  , regex_isFrontAnchored :: Bool                -- ^ used for optimizing execution+  , regex_compOptions :: CompOption+  , regex_execOptions :: ExecOption+  } -- no deriving at all, the DFA may be too big to ever traverse! ++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 = r {regex_execOptions=e}+  getExecOpts r = regex_execOptions r++ data WinEmpty = WinEmpty Instructions               | WinTest WhichTest (Maybe WinEmpty) (Maybe WinEmpty)   deriving Show  -- | Internal NFA node type-data QNFA = QNFA {q_id :: Index-                 ,q_qt :: QT}+data QNFA = QNFA {q_id :: Index, q_qt :: QT}+ -- | Internal to QNFA type.-data QT = Simple {qt_win :: WinTags -- ^ empty transitions to the virtual winning state-                 ,qt_trans :: CharMap QTrans -- ^ all ways to leave this QNFA to other or the same QNFA-                 ,qt_other :: QTrans -- ^ default ways to leave this QNFA to other or the same QNFA+data QT = Simple { qt_win :: WinTags -- ^ empty transitions to the virtual winning state+                 , qt_trans :: CharMap QTrans -- ^ all ways to leave this QNFA to other or the same QNFA+                 , qt_other :: QTrans -- ^ default ways to leave this QNFA to other or the same QNFA                  }-        | Testing {qt_test :: WhichTest -- ^ The test to perform-                  ,qt_dopas :: EnumSet DoPa  -- ^ location(s) of the anchor(s) in the original regexp-                  ,qt_a,qt_b :: QT -- ^ use qt_a if test is True, else use qt_b+        | Testing { qt_test :: WhichTest -- ^ The test to perform+                  , qt_dopas :: EnumSet DoPa  -- ^ location(s) of the anchor(s) in the original regexp+                  , qt_a, qt_b :: QT -- ^ use qt_a if test is True, else use qt_b                   }  -- | Internal type to represent the tagged transition from one QNFA to@@ -147,7 +176,14 @@ type QTrans = IntMap {- Destination Index -} [TagCommand]  -- | Known predicates, just Beginning of Line (^) and End of Line ($).-data WhichTest = Test_BOL | Test_EOL deriving (Show,Eq,Ord,Enum)+-- Also support for GNU extensions is being added: \` beginning of+-- buffer, \' end of buffer, \< and \> for begin and end of words, \b+-- and \B for word boundary and not word boundary.+data WhichTest = Test_BOL | Test_EOL -- '^' and '$' (affected by multiline option)+               | Test_BOB | Test_EOB -- \` and \' begin and end buffer+               | Test_BOW | Test_EOW -- \< and \> begin and end word+               | Test_EdgeWord | Test_NotEdgeWord -- \b and \B word boundaries+  deriving (Show,Eq,Ord,Enum)  -- | The things that can be done with a Tag.  TagTask and -- ResetGroupStopTask are for tags with Maximize or Minimize OP@@ -155,6 +191,7 @@ -- for tags with Orbit OP value. data TagTask = TagTask | ResetGroupStopTask | SetGroupStopTask              | ResetOrbitTask | EnterOrbitTask | LeaveOrbitTask deriving (Show,Eq)+ -- | Ordered list of tags and their associated Task type TagTasks = [(Tag,TagTask)] -- | When attached to a QTrans the TagTask can be done before or after@@ -300,27 +337,16 @@                                 | otherwise = indent . map (\(source,ins) -> show (dest,source,ins) ) . IMap.assocs $ srcMap --        spawnIns = Instructions { newPos = [(0,SetPost)], newOrbits = Nothing } -data SList a = !a :! !(SList a) | SEnd -infixr :!--instance Functor SList where-  fmap f = go where go SEnd = SEnd-                    go (a :! b) = f a :! go b--instance Foldable SList where-  fold SEnd = mempty-  fold (a :! b) = a `mappend` fold b-  foldMap f = go where go SEnd = mempty-                       go (a :! b) = f a `mappend` go b-  foldr f x = go where go (a :! b) = f a (go b)-                       go SEnd = x-  foldr1 f = go where go (a :! SEnd) = a-                      go (a :! b) = f a (go b)-                      go SEnd = error "foldr1 on SEnd"-  foldl f x = go x where go c (a :! b) = go (f c a) b-                         go c SEnd = c-  foldl1 f = start where start SEnd = error "foldl1 on SEnd"-                         start (a :! b) = go a b-                         go c (a :! b) = go (f c a) b-                         go c SEnd = c+instance Eq QT where+  t1@(Testing {}) == t2@(Testing {}) =+    (qt_test t1) == (qt_test t2) && (qt_a t1) == (qt_a t2) && (qt_b t1) == (qt_b t2)+  (Simple w1 (CharMap t1) o1) == (Simple w2 (CharMap t2) o2) =+    w1 == w2 && eqTrans && eqQTrans o1 o2+    where eqTrans :: Bool+          eqTrans = (IMap.size t1 == IMap.size t2)+                    && and (zipWith together (IMap.toAscList t1) (IMap.toAscList t2))+            where together (c1,qtrans1) (c2,qtrans2) = (c1 == c2) && eqQTrans qtrans1 qtrans2+          eqQTrans :: QTrans -> QTrans -> Bool+          eqQTrans = (==)+  _ == _ = False
Text/Regex/TDFA/CorePattern.hs view
@@ -417,6 +417,7 @@                                  ,preReset=[],postSet=[],preTag=apply m1,postTag=apply m2                                  ,tagged=False,childGroups=False,wants=WantsQT                                  ,unQ=Test myTest }+        xtra = newSyntax compOpt     in case pIn of          PEmpty -> nil          POr [] -> nil@@ -501,6 +502,14 @@          PDot {} -> one          PAny {} -> one          PAnyNot {} -> one+         -- CompOption's newSyntax enables these escaped anchors+         PEscape dopa '`'  | xtra -> test (Test_BOB,dopa)+         PEscape dopa '\'' | xtra -> test (Test_EOB,dopa)+         PEscape dopa '<'  | xtra -> test (Test_BOW,dopa)+         PEscape dopa '>'  | xtra -> test (Test_EOW,dopa)+         PEscape dopa 'b'  | xtra -> test (Test_EdgeWord,dopa)+         PEscape dopa 'B'  | xtra -> test (Test_NotEdgeWord,dopa)+         -- otherwise escape codes are just the escaped character          PEscape {} -> one           -- A PGroup node in the Pattern tree does not become a node
Text/Regex/TDFA/NewDFA/Engine.hs view
@@ -5,7 +5,7 @@ -- variants. module Text.Regex.TDFA.NewDFA.Engine(execMatch) where -import Control.Monad(when,forM,forM_,liftM2,foldM,join,MonadPlus(..),filterM)+import Control.Monad(when,forM,forM_,liftM2,foldM,join,filterM) import Data.Array.Base(unsafeRead,unsafeWrite,STUArray(..)) -- #ifdef __GLASGOW_HASKELL__ import GHC.Arr(STArray(..))@@ -19,33 +19,29 @@ -} import Prelude hiding ((!!)) -import Data.Array.MArray(MArray(..),unsafeFreeze,getAssocs)-import Data.Array.IArray(Array,bounds,assocs)---import qualified Data.Foldable as F-import qualified Data.IntMap.CharMap2 as CMap(lookup,findWithDefault)+import Data.Array.MArray(MArray(..),unsafeFreeze)+import Data.Array.IArray(Array,bounds,assocs,Ix(rangeSize,range))+import qualified Data.IntMap.CharMap2 as CMap(findWithDefault) import Data.IntMap(IntMap) import qualified Data.IntMap as IMap(null,toList,lookup,insert)-import Data.Ix(Ix,rangeSize,range)-import Data.Maybe(catMaybes,listToMaybe)+import Data.Maybe(catMaybes) import Data.Monoid(Monoid(..))---import Data.IntSet(IntSet)-import qualified Data.IntSet as ISet(toAscList,null)-import qualified Data.Array.ST+import qualified Data.IntSet as ISet(toAscList) import Data.Array.IArray((!))-import qualified Data.Array.MArray import Data.List(partition,sort,foldl',sortBy,groupBy)-import Data.STRef-import qualified Control.Monad.ST.Lazy as L-import qualified Control.Monad.ST.Strict as S+import Data.STRef(STRef,newSTRef,readSTRef,writeSTRef)+import qualified Control.Monad.ST.Lazy as L(ST,runST,strictToLazyST)+import qualified Control.Monad.ST.Strict as S(ST) import Data.Sequence(Seq,ViewL(..),viewl)-import qualified Data.Sequence as Seq-import qualified Data.ByteString.Char8 as SBS-import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.Sequence as Seq(null)+import qualified Data.ByteString.Char8 as SBS(ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString)  import Text.Regex.Base(MatchArray,MatchOffset,MatchLength)-import qualified Text.Regex.TDFA.IntArrTrieSet as Trie+import qualified Text.Regex.TDFA.IntArrTrieSet as Trie(lookupAsc) import Text.Regex.TDFA.Common hiding (indent) import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))+import Text.Regex.TDFA.NewDFA.MakeTest(test_singleline,test_multiline) import qualified Text.Regex.TDFA.NewDFA.Engine_FA as FA(execMatch) import qualified Text.Regex.TDFA.NewDFA.Engine_NC as NC(execMatch) import qualified Text.Regex.TDFA.NewDFA.Engine_NC_FA as NC_FA(execMatch)@@ -79,8 +75,7 @@                    , regex_groups = aGroups                    , regex_isFrontAnchored = frontAnchored                    , regex_compOptions = CompOption { multiline = newline }-                   , regex_execOptions = ExecOption { captureGroups = capture-                                                    , testMatch = _checkMatch }})+                   , regex_execOptions = ExecOption { captureGroups = capture }})           offsetIn prevIn inputIn = case (subCapture,frontAnchored) of                                       (True  ,False) -> L.runST runCaptureGroup                                       (True  ,True)  -> FA.execMatch r offsetIn prevIn inputIn@@ -147,7 +142,7 @@               if test wt offset prev input                 then next' s1 s2 did a offset prev input                 else next' s1 s2 did b offset prev input-            Simple' {dt_win=w,dt_trans=t, dt_other=o} ->+            Simple' {dt_trans=t, dt_other=o} ->               case uncons input of                 Nothing -> finalizeWinners                 Just (c,input') ->@@ -289,7 +284,7 @@                 x@((sourceIndex,_instructions),_pos,_orbit') <- which !! destIndex                 if sourceIndex == (-1)                   then spawnStart b_tags blank destIndex s2 (succ offset)-                  else updateCopy doActions x offset s2 destIndex+                  else updateCopy x offset s2 destIndex           earlyStart <- fmap minimum $ mapM performTransTo dl           -- findTrans part 3           earlyWin <- readSTRef (mq_earliest winQ)@@ -401,14 +396,6 @@ {-# INLINE mkTest #-} mkTest :: Uncons text => Bool -> WhichTest -> Index -> Char -> text -> Bool mkTest isMultiline = if isMultiline then test_multiline else test_singleline-  where test_multiline Test_BOL _off prev _input = prev == '\n'-        test_multiline Test_EOL _off _prev input = case uncons input of-                                                     Nothing -> True-                                                     Just (next,_) -> next == '\n'-        test_singleline Test_BOL off _prev _input = off == 0-        test_singleline Test_EOL _off _prev input = case uncons input of-                                                      Nothing -> True-                                                      _ -> False  ---- @@ -544,40 +531,6 @@     (SetVal v1,SetVal v2) -> compare v1 v2     _ -> err $ "bestTrans.compareWith.choose sees incomparable "++show (post1,post2) -comp01 :: C s-comp01 preTag (_state1,pos1,_orbit1') np1 (_state2,pos2,_orbit2') np2 = do-  c <- liftM2 compare (pos2!!0) (pos1!!0) -- reversed since Minimize-  case c of-    EQ -> challenge1-    answer -> return answer- where-  challenge1 = do-    case np1 of-      ((t1,b1):_rest1) | t1==1 -> do-        let p1 = case b1 of SetPre -> preTag-                            SetPost -> succ preTag-                            SetVal v -> v-        case np2 of-          ((t2,b2):_rest2) | t2==1 -> do-            let p2 = case b2 of SetPre -> preTag-                                SetPost -> succ preTag-                                SetVal v -> v-            return (compare p1 p2)-          _ -> do-            p2 <- pos2 !! 1-            return (compare p1 p2)-      _ -> do-        p1 <- pos1 !! 1-        case np2 of-          ((t2,b2):_rest2) | t2==1 -> do-            let p2 = case b2 of SetPre -> preTag-                                SetPost -> succ preTag-                                SetVal v -> v-            return (compare p1 p2)-          _ -> do-            p2 <- pos2 !! 1-            return (compare p1 p2)- ditzyComp'3 :: forall s. Array Tag OP -> C s ditzyComp'3 aTagOP = comp0 where   (F comp1:compsRest) = allcomps 1@@ -665,15 +618,6 @@   compare p1 p2 `mappend` comparePos (viewl ps1) (viewl ps2)  {- CONVERT WINNERS TO MATCHARRAY -}--tagsToGroup0ST :: forall s. Array GroupIndex [GroupInfo] -> WScratch s -> S.ST s MatchArray-tagsToGroup0ST _aGroups (WScratch {w_pos=pos})= do-  ma <- newArray (0,0) (-1,0) :: ST s (STArray s Int (MatchOffset,MatchLength))-  startPos0 <- pos !! 0-  stopPos0 <- pos !! 1-  set ma 0 (startPos0,stopPos0-startPos0)-  unsafeFreeze ma- tagsToGroupsST :: forall s. Array GroupIndex [GroupInfo] -> WScratch s -> S.ST s MatchArray tagsToGroupsST aGroups (WScratch {w_pos=pos})= do   let b_max = snd (bounds (aGroups))@@ -718,13 +662,12 @@   return thisPos  {-# INLINE updateCopy #-}-updateCopy :: (Index -> STUArray s Tag Position -> [(Tag, Action)] -> ST s a)-           -> ((Index, Instructions), STUArray s Tag Position, OrbitLog)+updateCopy :: ((Index, Instructions), STUArray s Tag Position, OrbitLog)            -> Index            -> MScratch s            -> Int            -> ST s Position-updateCopy doActions ((_i1,instructions),oldPos,newOrbit) preTag s2 i2 = do+updateCopy ((_i1,instructions),oldPos,newOrbit) preTag s2 i2 = do   b_tags <- getBounds oldPos   newerPos <- maybe (do     a <- newA_ b_tags
Text/Regex/TDFA/NewDFA/Engine_FA.hs view
@@ -6,7 +6,6 @@ -- specialized to produce the needed variants. module Text.Regex.TDFA.NewDFA.Engine_FA(execMatch) where -import Control.Monad(when,unless,forM,forM_,liftM2,foldM,join,MonadPlus(..),filterM) import Data.Array.Base(unsafeRead,unsafeWrite,STUArray(..)) -- #ifdef __GLASGOW_HASKELL__ import GHC.Arr(STArray(..))@@ -18,35 +17,30 @@ import Data.Array.ST(STArray) -- #endif -}-import Prelude hiding ((!!)) -import Data.Array.MArray(MArray(..),unsafeFreeze,getAssocs)-import Data.Array.IArray(Array,bounds,assocs)---import qualified Data.Foldable as F-import qualified Data.IntMap.CharMap2 as CMap(lookup,findWithDefault)+import Prelude hiding ((!!))+import Control.Monad(when,unless,forM,forM_,liftM2,foldM)+import Data.Array.MArray(MArray(..),unsafeFreeze)+import Data.Array.IArray(Array,bounds,assocs,Ix(range))+import qualified Data.IntMap.CharMap2 as CMap(findWithDefault) import Data.IntMap(IntMap) import qualified Data.IntMap as IMap(null,toList,lookup,insert)-import Data.Ix(Ix,rangeSize,range)-import Data.Maybe(catMaybes,listToMaybe)+import Data.Maybe(catMaybes) import Data.Monoid(Monoid(..))---import Data.IntSet(IntSet) import qualified Data.IntSet as ISet(toAscList,null)-import qualified Data.Array.ST import Data.Array.IArray((!))-import qualified Data.Array.MArray-import Data.List(partition,sort,foldl',sortBy,groupBy)-import Data.STRef-import qualified Control.Monad.ST.Lazy as L-import qualified Control.Monad.ST.Strict as S+import Data.List(sortBy,groupBy)+import Data.STRef(STRef,newSTRef,readSTRef,writeSTRef)+import qualified Control.Monad.ST.Strict as S(ST,runST) import Data.Sequence(Seq,ViewL(..),viewl)-import qualified Data.Sequence as Seq-import qualified Data.ByteString.Char8 as SBS-import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.Sequence as Seq(null)+import qualified Data.ByteString.Char8 as SBS(ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString)  import Text.Regex.Base(MatchArray,MatchOffset,MatchLength)-import qualified Text.Regex.TDFA.IntArrTrieSet as Trie import Text.Regex.TDFA.Common hiding (indent) import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))+import Text.Regex.TDFA.NewDFA.MakeTest(test_singleline,test_multiline)  --import Debug.Trace @@ -71,16 +65,13 @@ {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> SBS.ByteString -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> LBS.ByteString -> [MatchArray] #-} execMatch :: Uncons text => Regex -> Position -> Char -> text -> [MatchArray]-execMatch r@(Regex { regex_dfa =  DFA {d_id=didIn,d_dt=dtIn}-                   , regex_init = startState-                   , regex_b_index = b_index-                   , regex_b_tags = b_tags_all-                   , regex_trie = trie-                   , regex_tags = aTags-                   , regex_groups = aGroups-                   , regex_compOptions = CompOption { multiline = newline }-                   , regex_execOptions = ExecOption { captureGroups = capture-                                                    , testMatch = _checkMatch }})+execMatch (Regex { regex_dfa =  DFA {d_id=didIn,d_dt=dtIn}+                 , regex_init = startState+                 , regex_b_index = b_index+                 , regex_b_tags = b_tags_all+                 , regex_tags = aTags+                 , regex_groups = aGroups+                 , regex_compOptions = CompOption { multiline = newline } } )           offsetIn prevIn inputIn = S.runST goNext where    b_tags :: (Tag,Tag)@@ -246,7 +237,7 @@           let performTransTo (destIndex,_sources) = {-# SCC "goNext.findTrans.performTransTo" #-} do                 x@((sourceIndex,_instructions),_pos,_orbit') <- which !! destIndex                 unless (sourceIndex == (-1)) $-                  (updateCopy doActions x offset s2 destIndex)+                  (updateCopy x offset s2 destIndex)           mapM_ performTransTo dl           -- findTrans part 3           let offset' = succ offset in seq offset' $ next s2 s1 did' dt' offset' prev' input'@@ -276,9 +267,7 @@           prep'd <- mapM prep (IMap.toList w)           case map snd prep'd of             [] -> return ()-            (first:rest) -> do-              best@((_sourceIndex,_instructions),bp,_orbit') <- foldM challenge first rest-              newWinner offset best+            (first:rest) -> newWinner offset =<< foldM challenge first rest          newWinner preTag ((_sourceIndex,winInstructions),oldPos,_newOrbit) = {-# SCC "goNext.newWinner" #-} do           newerPos <- newA_ b_tags@@ -308,14 +297,6 @@ {-# INLINE mkTest #-} mkTest :: Uncons text => Bool -> WhichTest -> Index -> Char -> text -> Bool mkTest isMultiline = if isMultiline then test_multiline else test_singleline-  where test_multiline Test_BOL _off prev _input = prev == '\n'-        test_multiline Test_EOL _off _prev input = case uncons input of-                                                     Nothing -> True-                                                     Just (next,_) -> next == '\n'-        test_singleline Test_BOL off _prev _input = off == 0-        test_singleline Test_EOL _off _prev input = case uncons input of-                                                      Nothing -> True-                                                      _ -> False  ---- @@ -348,7 +329,7 @@ data MScratch s = MScratch { m_pos :: !(STArray s Index (Maybe (STUArray s Tag Position)))                            , m_orbit :: !(STArray s Index OrbitLog)                            }-newtype BlankScratch s = BlankScratch { blank_pos :: (STUArray s Tag Position)+newtype BlankScratch s = BlankScratch { _blank_pos :: (STUArray s Tag Position)                                       } newtype WScratch s = WScratch { w_pos :: (STUArray s Tag Position)                               }@@ -423,40 +404,6 @@     (SetVal v1,SetVal v2) -> compare v1 v2     _ -> err $ "bestTrans.compareWith.choose sees incomparable "++show (post1,post2) -comp01 :: C s-comp01 preTag (_state1,pos1,_orbit1') np1 (_state2,pos2,_orbit2') np2 = do-  c <- liftM2 compare (pos2!!0) (pos1!!0) -- reversed since Minimize-  case c of-    EQ -> challenge1-    answer -> return answer- where-  challenge1 = do-    case np1 of-      ((t1,b1):_rest1) | t1==1 -> do-        let p1 = case b1 of SetPre -> preTag-                            SetPost -> succ preTag-                            SetVal v -> v-        case np2 of-          ((t2,b2):_rest2) | t2==1 -> do-            let p2 = case b2 of SetPre -> preTag-                                SetPost -> succ preTag-                                SetVal v -> v-            return (compare p1 p2)-          _ -> do-            p2 <- pos2 !! 1-            return (compare p1 p2)-      _ -> do-        p1 <- pos1 !! 1-        case np2 of-          ((t2,b2):_rest2) | t2==1 -> do-            let p2 = case b2 of SetPre -> preTag-                                SetPost -> succ preTag-                                SetVal v -> v-            return (compare p1 p2)-          _ -> do-            p2 <- pos2 !! 1-            return (compare p1 p2)- ditzyComp'3 :: forall s. Array Tag OP -> C s ditzyComp'3 aTagOP = comp0 where   (F comp1:compsRest) = allcomps 1@@ -545,14 +492,6 @@  {- CONVERT WINNERS TO MATCHARRAY -} -tagsToGroup0ST :: forall s. Array GroupIndex [GroupInfo] -> WScratch s -> S.ST s MatchArray-tagsToGroup0ST _aGroups (WScratch {w_pos=pos})= do-  ma <- newArray (0,0) (-1,0) :: ST s (STArray s Int (MatchOffset,MatchLength))-  startPos0 <- pos !! 0-  stopPos0 <- pos !! 1-  set ma 0 (startPos0,stopPos0-startPos0)-  unsafeFreeze ma- tagsToGroupsST :: forall s. Array GroupIndex [GroupInfo] -> WScratch s -> S.ST s MatchArray tagsToGroupsST aGroups (WScratch {w_pos=pos})= do   let b_max = snd (bounds (aGroups))@@ -597,13 +536,12 @@   return thisPos  {-# INLINE updateCopy #-}-updateCopy :: (Index -> STUArray s Tag Position -> [(Tag, Action)] -> ST s a)-           -> ((Index, Instructions), STUArray s Tag Position, OrbitLog)+updateCopy :: ((Index, Instructions), STUArray s Tag Position, OrbitLog)            -> Index            -> MScratch s            -> Int            -> ST s ()-updateCopy doActions ((_i1,instructions),oldPos,newOrbit) preTag s2 i2 = do+updateCopy ((_i1,instructions),oldPos,newOrbit) preTag s2 i2 = do   b_tags <- getBounds oldPos   newerPos <- maybe (do     a <- newA_ b_tags
Text/Regex/TDFA/NewDFA/Engine_NC.hs view
@@ -1,47 +1,28 @@ -- | This is the non-capturing form of Text.Regex.TDFA.NewDFA.String module Text.Regex.TDFA.NewDFA.Engine_NC(execMatch) where -import Control.Monad(when,forM,forM_,liftM2,foldM,join,MonadPlus(..),filterM)-import Data.Array.Base(unsafeRead,unsafeWrite,STUArray(..))--- #ifdef __GLASGOW_HASKELL__-import GHC.Arr(STArray(..))-import GHC.ST(ST(..))-import GHC.Prim(MutableByteArray#,RealWorld,Int#,sizeofMutableByteArray#,unsafeCoerce#)-{---- #else-import Control.Monad.ST(ST)-import Data.Array.ST(STArray)--- #endif--}+import Control.Monad(when,join,filterM)+import Data.Array.Base(unsafeRead,unsafeWrite) import Prelude hiding ((!!)) -import Data.Array.MArray(MArray(..),unsafeFreeze,getAssocs)-import Data.Array.IArray(Array,bounds,assocs)---import qualified Data.Foldable as F-import qualified Data.IntMap.CharMap2 as CMap(lookup,findWithDefault)-import Data.IntMap(IntMap)-import qualified Data.IntMap as IMap(null,toList,lookup,insert,keys,member)-import Data.Ix(Ix,rangeSize,range)-import Data.Maybe(catMaybes,listToMaybe)-import Data.Monoid(Monoid(..))---import Data.IntSet(IntSet)-import qualified Data.IntSet as ISet(toAscList,null)-import qualified Data.Array.ST-import Data.Array.IArray((!))-import qualified Data.Array.MArray as MA-import Data.List(partition,sort,foldl',sortBy,groupBy)-import Data.STRef-import qualified Control.Monad.ST.Lazy as L-import qualified Control.Monad.ST.Strict as S-import Data.Sequence(Seq,ViewL(..),viewl)-import qualified Data.Sequence as Seq-import qualified Data.ByteString.Char8 as SBS-import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Array.MArray(MArray(..),unsafeFreeze)+import Data.Array.IArray(Ix)+import Data.Array.ST(STArray,STUArray)+import qualified Data.IntMap.CharMap2 as CMap(findWithDefault)+import qualified Data.IntMap as IMap(null,toList,keys,member)+import qualified Data.IntSet as ISet(toAscList)+import Data.STRef(STRef,newSTRef,readSTRef,writeSTRef)+import qualified Control.Monad.ST.Lazy as L(runST,strictToLazyST)+import qualified Control.Monad.ST.Strict as S(ST)+import Data.Sequence(Seq)+import qualified Data.ByteString.Char8 as SBS(ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString)  import Text.Regex.Base(MatchArray,MatchOffset,MatchLength)-import qualified Text.Regex.TDFA.IntArrTrieSet as Trie+import qualified Text.Regex.TDFA.IntArrTrieSet as Trie(lookupAsc) import Text.Regex.TDFA.Common hiding (indent) import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))+import Text.Regex.TDFA.NewDFA.MakeTest(test_singleline,test_multiline)  -- import Debug.Trace @@ -52,11 +33,11 @@ err s = common_error "Text.Regex.TDFA.NewDFA.Engine_NC"  s  {-# INLINE (!!) #-}-(!!) :: (MArray a e (S.ST s),Ix i) => a i e -> i -> S.ST s e-(!!) = MA.readArray -- unsafeRead+(!!) :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> S.ST s e+(!!) = unsafeRead {-# INLINE set #-}-set :: (MArray a e (S.ST s),Ix i) => a i e -> i -> e -> S.ST s ()-set = MA.writeArray -- unsafeWrite+set :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> e -> S.ST s ()+set = unsafeWrite  {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> ([] Char) -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> (Seq Char) -> [MatchArray] #-}@@ -66,13 +47,8 @@ execMatch (Regex { regex_dfa = (DFA {d_id=didIn,d_dt=dtIn})                  , regex_init = startState                  , regex_b_index = b_index-                 , regex_b_tags = b_tags_all                  , regex_trie = trie-                 , regex_tags = aTags-                 , regex_groups = aGroups-                 , regex_compOptions = CompOption { multiline = newline }-                 , regex_execOptions = ExecOption { captureGroups = capture-                                                  , testMatch = _checkMatch }})+                 , regex_compOptions = CompOption { multiline = newline } } )           offsetIn prevIn inputIn = L.runST runCaptureGroup where    !test = mkTest newline         @@ -98,7 +74,6 @@     set s1In startState offsetIn     writeSTRef storeNext (err "obtainNext called while goNext is running!")     eliminatedStateFlag <- newSTRef False-    eliminatedRespawnFlag <- newSTRef False     let next s1 s2 did dt offset prev input = {-# SCC "goNext.next" #-}           case dt of             Testing' {dt_test=wt,dt_a=a,dt_b=b} ->@@ -123,7 +98,7 @@               if test wt offset prev input                 then next' s1 s2 did a offset prev input                 else next' s1 s2 did b offset prev input-            Simple' {dt_win=w,dt_trans=t, dt_other=o} ->+            Simple' {dt_trans=t, dt_other=o} ->               case uncons input of                 Nothing -> finalizeWinners                 Just (c,input') -> do@@ -196,14 +171,6 @@ {-# INLINE mkTest #-} mkTest :: Uncons text => Bool -> WhichTest -> Index -> Char -> text -> Bool mkTest isMultiline = if isMultiline then test_multiline else test_singleline-  where test_multiline Test_BOL _off prev _input = prev == '\n'-        test_multiline Test_EOL _off _prev input = case uncons input of-                                                     Nothing -> True-                                                     Just (next,_) -> next == '\n'-        test_singleline Test_BOL off _prev _input = off == 0-        test_singleline Test_EOL _off _prev input = case uncons input of-                                                      Nothing -> True-                                                      _ -> False  ---- @@ -225,7 +192,7 @@   writeSTRef list []  putMQ :: WScratch -> MQ s -> S.ST s ()-putMQ ws@(WScratch {ws_start=start,ws_stop=stop}) (MQ {mq_earliest=earliest,mq_list=list}) = do+putMQ ws@(WScratch {ws_start=start}) (MQ {mq_earliest=earliest,mq_list=list}) = do   startE <- readSTRef earliest   if start <= startE     then writeSTRef earliest start >> writeSTRef list [ws]@@ -235,7 +202,7 @@           !new = ws : rest       writeSTRef list new -getMQ :: Position -> MQ s -> ST s [WScratch]+getMQ :: Position -> MQ s -> S.ST s [WScratch] getMQ pos (MQ {mq_earliest=earliest,mq_list=list}) = do   old <- readSTRef list   case span (\ w -> pos <= ws_start w) old of@@ -255,20 +222,16 @@                            , _s_mq :: !(MQ s)                            } type MScratch s = STUArray s Index Position-data WScratch = WScratch {ws_start,ws_stop :: !Position}+data WScratch = WScratch {ws_start,_ws_stop :: !Position}   deriving Show  {- DEBUGGING HELPERS -} {- CREATING INITIAL MUTABLE SCRATCH DATA STRUCTURES -}  {-# INLINE newA #-}-newA :: (MArray (STUArray s) e (ST s)) => (Tag,Tag) -> e -> S.ST s (STUArray s Tag e)+newA :: (MArray (STUArray s) e (S.ST s)) => (Tag,Tag) -> e -> S.ST s (STUArray s Tag e) newA b_tags initial = newArray b_tags initial -{-# INLINE newA_ #-}-newA_ :: (MArray (STUArray s) e (ST s)) => (Tag,Tag) -> S.ST s (STUArray s Tag e)-newA_ b_tags = newArray_ b_tags- newScratch :: (Index,Index) -> S.ST s (SScratch s) newScratch b_index = do   s1 <- newMScratch b_index@@ -281,8 +244,8 @@  {- CONVERT WINNERS TO MATCHARRAY -} -wsToGroup :: WScratch -> ST s MatchArray+wsToGroup :: WScratch -> S.ST s MatchArray wsToGroup (WScratch start stop) = do-  ma <- newArray (0,0) (start,stop-start)  :: ST s (STArray s Int (MatchOffset,MatchLength))+  ma <- newArray (0,0) (start,stop-start)  :: S.ST s (STArray s Int (MatchOffset,MatchLength))   unsafeFreeze ma
Text/Regex/TDFA/NewDFA/Engine_NC_FA.hs view
@@ -1,75 +1,40 @@ -- | This is the non-capturing form of Text.Regex.TDFA.NewDFA.String module Text.Regex.TDFA.NewDFA.Engine_NC_FA(execMatch) where -import Control.Monad(when,unless,forM,forM_,liftM2,foldM,join,MonadPlus(..),filterM)-import Data.Array.Base(unsafeRead,unsafeWrite,STUArray(..))--- #ifdef __GLASGOW_HASKELL__-import GHC.Arr(STArray(..))-import GHC.ST(ST(..))-import GHC.Prim(MutableByteArray#,RealWorld,Int#,sizeofMutableByteArray#,unsafeCoerce#)-{---- #else-import Control.Monad.ST(ST)-import Data.Array.ST(STArray)--- #endif--}+import Control.Monad(unless) import Prelude hiding ((!!)) -import Data.Array.MArray(MArray(..),unsafeFreeze,getAssocs)-import Data.Array.IArray(Array,bounds,assocs)-import qualified Data.Foldable as F-import qualified Data.IntMap.CharMap2 as CMap(lookup,findWithDefault)-import Data.IntMap(IntMap)-import qualified Data.IntMap as IMap(null,toList,lookup,insert,keys,member)-import Data.Ix(Ix,rangeSize,range)-import Data.Maybe(catMaybes,listToMaybe)-import Data.Monoid(Monoid(..))---import Data.IntSet(IntSet)-import qualified Data.IntSet as ISet(toAscList,null)-import qualified Data.Array.ST-import Data.Array.IArray((!))-import qualified Data.Array.MArray-import Data.List(partition,sort,foldl',sortBy,groupBy)-import Data.STRef-import qualified Control.Monad.ST.Lazy as L-import qualified Control.Monad.ST.Strict as S-import Data.Sequence(Seq,ViewL(..),viewl)-import qualified Data.Sequence as Seq-import qualified Data.ByteString.Char8 as SBS-import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Array.MArray(MArray(newArray),unsafeFreeze)+import Data.Array.ST(STArray)+import qualified Data.IntMap.CharMap2 as CMap(findWithDefault)+import qualified Data.IntMap as IMap(null)+import qualified Data.IntSet as ISet(null)+import qualified Data.Array.MArray()+import Data.STRef(newSTRef,readSTRef,writeSTRef)+import qualified Control.Monad.ST.Strict as S(ST,runST)+import Data.Sequence(Seq)+import qualified Data.ByteString.Char8 as SBS(ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString)  import Text.Regex.Base(MatchArray,MatchOffset,MatchLength)-import qualified Text.Regex.TDFA.IntArrTrieSet as Trie import Text.Regex.TDFA.Common hiding (indent) import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))+import Text.Regex.TDFA.NewDFA.MakeTest(test_singleline)  --import Debug.Trace  -- trace :: String -> a -> a -- trace _ a = a -err :: String -> a-err s = common_error "Text.Regex.TDFA.NewDFA"  s--{-# INLINE (!!) #-}-(!!) :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> S.ST s e-(!!) = unsafeRead-{-# INLINE set #-}-set :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> e -> S.ST s ()-set = unsafeWrite- {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> ([] Char) -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> (Seq Char) -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> SBS.ByteString -> [MatchArray] #-} {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> LBS.ByteString -> [MatchArray] #-} execMatch :: Uncons text => Regex -> Position -> Char -> text -> [MatchArray] execMatch (Regex { regex_dfa = DFA {d_dt=dtIn} })-          offsetIn prevIn inputIn = S.runST goNext where+          offsetIn _prevIn inputIn = S.runST goNext where -  test Test_BOL off _input = off == 0-  test Test_EOL _off input = case uncons input of-                               Nothing -> True-                               _ -> False+  test wt off input = test_singleline wt off '\n' input    goNext = {-# SCC "goNext" #-} do     winQ <- newSTRef Nothing@@ -104,7 +69,7 @@  {- CONVERT WINNERS TO MATCHARRAY -} -makeGroup :: Position -> Position -> ST s MatchArray+makeGroup :: Position -> Position -> S.ST s MatchArray makeGroup start stop = do-  ma <- newArray (0,0) (start,stop-start)  :: ST s (STArray s Int (MatchOffset,MatchLength))+  ma <- newArray (0,0) (start,stop-start)  :: S.ST s (STArray s Int (MatchOffset,MatchLength))   unsafeFreeze ma
+ Text/Regex/TDFA/NewDFA/MakeTest.hs view
@@ -0,0 +1,47 @@+module Text.Regex.TDFA.NewDFA.MakeTest(test_singleline,test_multiline) where++import qualified Data.IntSet as ISet(IntSet,member,fromAscList)+import Text.Regex.TDFA.Common(WhichTest(..),Index)+import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))++{-# INLINE test_singleline #-}+{-# INLINE test_multiline #-}+{-# INLINE test_common #-}+test_singleline,test_multiline,test_common :: Uncons text => WhichTest -> Index -> Char -> text -> Bool+test_multiline Test_BOL _off prev _input = prev == '\n'+test_multiline Test_EOL _off _prev input = case uncons input of+                                                     Nothing -> True+                                                     Just (next,_) -> next == '\n'+test_multiline test off prev input = test_common test off prev input++test_singleline Test_BOL off _prev _input = off == 0+test_singleline Test_EOL _off _prev input = case uncons input of+                                              Nothing -> True+                                              _ -> False+test_singleline test off prev input = test_common test off prev input++test_common Test_BOB off _prev _input = off==0+test_common Test_EOB _off _prev input = case uncons input of+                                          Nothing -> True+                                          _ -> False+test_common Test_BOW _off prev input = not (isWord prev) && case uncons input of+                                                            Nothing -> False+                                                            Just (c,_) -> isWord c+test_common Test_EOW _off prev input = isWord prev && case uncons input of+                                                        Nothing -> True+                                                        Just (c,_) -> not (isWord c)+test_common Test_EdgeWord _off prev input =+  if isWord prev+    then case uncons input of Nothing -> True+                              Just (c,_) -> not (isWord c)+    else case uncons input of Nothing -> False+                              Just (c,_) -> isWord c+test_common Test_NotEdgeWord _off prev input = not (test_common Test_EdgeWord _off prev input)++test_common Test_BOL _ _ _ = undefined+test_common Test_EOL _ _ _ = undefined++isWord :: Char -> Bool+isWord c = ISet.member (fromEnum c) wordSet+  where wordSet :: ISet.IntSet+        wordSet = ISet.fromAscList . map fromEnum $ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"
Text/Regex/TDFA/NewDFA/Tester.hs view
@@ -2,19 +2,18 @@ --  module Text.Regex.TDFA.NewDFA.Tester(matchTest) where -import Control.Monad(MonadPlus(..)) import qualified Data.IntMap.CharMap2 as CMap(findWithDefault)-import qualified Data.IntMap as IMap+import qualified Data.IntMap as IMap(null) import qualified Data.IntSet as ISet(null) -import Data.Sequence(Seq,ViewL(..),viewl)-import qualified Data.Sequence as Seq-import qualified Data.ByteString.Char8 as SBS-import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Sequence(Seq)+import qualified Data.ByteString.Char8 as SBS(ByteString)+import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString)  import Text.Regex.Base() import Text.Regex.TDFA.Common hiding (indent) import Text.Regex.TDFA.NewDFA.Uncons (Uncons(uncons))+import Text.Regex.TDFA.NewDFA.MakeTest(test_singleline,test_multiline)  {-# SPECIALIZE matchTest :: Regex -> ([] Char) -> Bool #-} {-# SPECIALIZE matchTest :: Regex -> (Seq Char) -> Bool #-}@@ -22,19 +21,13 @@ {-# SPECIALIZE matchTest :: Regex -> LBS.ByteString -> Bool #-} matchTest :: Uncons text => Regex -> text -> Bool matchTest (Regex { regex_dfa = dfaIn-                 , regex_isFrontAnchored = ifa-                 , regex_compOptions = CompOption { multiline = newline } } )+                 , regex_isFrontAnchored = ifa } )           inputIn = ans where    ans = case ifa of           True -> single0 (d_dt dfaIn) inputIn           False -> multi0 (d_dt dfaIn) inputIn -  {-# NOINLINE test0 #-}-  {-# NOINLINE test #-}-  !test0 = mkTest0 newline-  !test = mkTest newline         -   multi0 (Testing' {dt_test=wt,dt_a=a,dt_b=b}) input =     if test0 wt input       then multi0 a input@@ -73,14 +66,14 @@                case CMap.findWithDefault o c t of                  Transition {trans_single=DFA {d_id=did',d_dt=dt'}}                    | ISet.null did' -> False-                   | otherwise -> single dt' input'+                   | otherwise -> single dt' c input'     | otherwise = True -  single (Testing' {dt_test=wt,dt_a=a,dt_b=b}) input =-    if testFA wt input-      then single a input-      else single b input-  single (Simple' {dt_win=w,dt_trans=t, dt_other=o}) input+  single (Testing' {dt_test=wt,dt_a=a,dt_b=b}) prev input =+    if testFA wt prev input+      then single a prev input+      else single b prev input+  single (Simple' {dt_win=w,dt_trans=t, dt_other=o}) _prev input     | IMap.null w =         case uncons input of              Nothing -> False@@ -88,39 +81,21 @@                case CMap.findWithDefault o c t of                  Transition {trans_single=DFA {d_id=did',d_dt=dt'}}                    | ISet.null did' -> False-                   | otherwise -> single dt' input'+                   | otherwise -> single dt' c input'     | otherwise = True -testFA0,testFA :: Uncons text => WhichTest -> text -> Bool-testFA0 Test_BOL _input = True-testFA0 Test_EOL input = case uncons input of-                           Nothing -> True-                           _ -> False-testFA Test_BOL _input = False-testFA Test_EOL input = case uncons input of-                          Nothing -> True-                          _ -> False+{-# INLINE testFA0 #-}+testFA0 :: Uncons text => WhichTest -> text -> Bool+testFA0 wt text = test_singleline wt 0 '\n' text -{-# INLINE mkTest0 #-}-mkTest0 :: Uncons text => Bool -> WhichTest -> text -> Bool-mkTest0 isMultiline = if isMultiline then test_multiline else test_singleline-  where test_multiline Test_BOL _input = True-        test_multiline Test_EOL input = case uncons input of-                                          Nothing -> True-                                          Just (next,_) -> next == '\n'-        test_singleline Test_BOL _input = True-        test_singleline Test_EOL input = case uncons input of-                                           Nothing -> True-                                           _ -> False+{-# INLINE testFA #-}+testFA :: Uncons text => WhichTest -> Char -> text -> Bool+testFA wt prev text = test_singleline wt 1 prev text -{-# INLINE mkTest #-}-mkTest :: Uncons text => Bool -> WhichTest -> Char -> text -> Bool-mkTest isMultiline = if isMultiline then test_multiline else test_singleline-  where test_multiline Test_BOL prev _input = prev == '\n'-        test_multiline Test_EOL _prev input = case uncons input of-                                                Nothing -> True-                                                Just (next,_) -> next == '\n'-        test_singleline Test_BOL _prev _input = False-        test_singleline Test_EOL _prev input = case uncons input of-                                                Nothing -> True-                                                _ -> False+{-# INLINE test0 #-}+test0 :: Uncons text => WhichTest -> text -> Bool+test0 wt input = test_multiline wt 0 '\n' input++{-# INLINE test #-}+test :: Uncons text => WhichTest -> Char -> text -> Bool+test wt prev input = test_multiline wt 1 prev input
Text/Regex/TDFA/Pattern.hs view
@@ -160,7 +160,7 @@   unCapture' (PGroup (Just _) p) = PGroup Nothing p   unCapture' x = x -}-+reGroup :: Pattern -> Pattern reGroup p@(PConcat xs) | 2 <= length xs = PGroup Nothing p reGroup p@(POr xs)     | 2 <= length xs = PGroup Nothing p reGroup p = p
Text/Regex/TDFA/ReadRegex.hs view
@@ -5,9 +5,7 @@ -- -- The PGroup returned always have (Maybe GroupIndex) set to (Just _) -- and never to Nothing.-module Text.Regex.TDFA.ReadRegex (parseRegex-                                 ,decodePatternSet-                                 ,legalCharacterClasses) where+module Text.Regex.TDFA.ReadRegex (parseRegex) where  {- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -} @@ -17,7 +15,7 @@   sepBy1, option, notFollowedBy, many1, lookAhead, eof, between,   string, noneOf, digit, char, anyChar) import Control.Monad(liftM, when, guard)-import qualified Data.Set as Set(Set,fromList, toList, insert,empty)+import qualified Data.Set as Set(fromList)  -- | BracketElement is internal to this module data BracketElement = BEChar Char | BEChars String | BEColl String | BEEquiv String | BEClass String@@ -141,40 +139,4 @@     atEnd <- (lookAhead (char ']') >> return True) <|> (return False)     when (not atEnd) (unexpected "A dash is in the wrong place in a bracket")   return (BEChar c)---- | decodePatternSet cannot handle collating element and treats--- equivalence classes as just their definition and nothing more.-decodePatternSet :: PatternSet -> Set.Set Char-decodePatternSet (PatternSet msc mscc _ msec) =-  let baseMSC = maybe Set.empty id msc-      withMSCC = foldl (flip Set.insert) baseMSC  (maybe [] (concatMap decodeCharacterClass . Set.toList) mscc)-      withMSEC = foldl (flip Set.insert) withMSCC (maybe [] (concatMap unSEC . Set.toList) msec)-  in withMSEC---- | This is the list of recognized [: :] character classes, others--- are decoded as empty.-legalCharacterClasses :: [String]-legalCharacterClasses = ["alnum","digit","punct","alpha","graph"-  ,"space","blank","lower","upper","cntrl","print","xdigit","word"]---- | This returns the disctince ascending list of characters--- represented by [: :] values in legalCharacterClasses; unrecognized--- class names return an empty string-decodeCharacterClass :: PatternSetCharacterClass -> String-decodeCharacterClass (PatternSetCharacterClass s) =-  case s of-    "alnum" -> ['0'..'9']++['a'..'z']++['A'..'Z']-    "digit" -> ['0'..'9']-    "punct" -> ['\33'..'\47']++['\58'..'\64']++['\91'..'\95']++"\96"++['\123'..'\126']-    "alpha" -> ['a'..'z']++['A'..'Z']-    "graph" -> ['\41'..'\126']-    "space" -> "\t\n\v\f\r "-    "blank" -> "\t "-    "lower" -> ['a'..'z']-    "upper" -> ['A'..'Z']-    "cntrl" -> ['\0'..'\31']++"\127" -- with NUL-    "print" -> ['\32'..'\126']-    "xdigit" -> ['0'..'9']++['a'..'f']++['A'..'F']-    "word" -> ['0'..'9']++['a'..'z']++['A'..'Z']++"_"-    _ -> []
Text/Regex/TDFA/Sequence.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-} {-|  This modules provides 'RegexMaker' and 'RegexLike' instances for using 'ByteString' with the DFA backend ("Text.Regex.Lib.WrapDFAEngine" and@@ -17,33 +16,34 @@  ,regexec  ) where -import qualified Data.Sequence as S-import Data.Sequence (ViewL(EmptyL,(:<)))+import Data.Sequence(Seq)+import Data.Foldable as F(toList) -import Text.Regex.Base(MatchArray,RegexContext(..),RegexMaker(..),RegexLike(..))+import Text.Regex.Base(MatchArray,RegexContext(..),RegexMaker(..),RegexLike(..),Extract(..)) import Text.Regex.Base.Impl(polymatch,polymatchM)-import Text.Regex.TDFA.Common(common_error,Regex(..),CompOption,ExecOption(captureGroups))+import Text.Regex.TDFA.Common(Regex(..),CompOption,ExecOption(captureGroups)) import Text.Regex.TDFA.String() -- piggyback on RegexMaker for String import Text.Regex.TDFA.TDFA(patternToRegex)-import Text.Regex.TDFA.Wrap() import Text.Regex.TDFA.ReadRegex(parseRegex)-import qualified Data.Foldable as F(toList) -import Data.Array.IArray((!),listArray,elems,bounds)+import Data.Array.IArray((!),elems) import Data.Maybe(listToMaybe) import Text.Regex.TDFA.NewDFA.Engine(execMatch) import Text.Regex.TDFA.NewDFA.Tester as Tester(matchTest)  {- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -} -instance RegexContext Regex (S.Seq Char) (S.Seq Char) where+instance RegexContext Regex (Seq Char) (Seq Char) where   match = polymatch   matchM = polymatchM -instance RegexMaker Regex CompOption ExecOption (S.Seq Char) where-  makeRegexOptsM c e source = either fail return $ compile c e source+instance RegexMaker Regex CompOption ExecOption (Seq Char) where+  makeRegexOptsM c e source =+    case parseRegex (F.toList source) of+      Left err -> fail $ "parseRegex for Text.Regex.TDFA.Sequence failed:"++show err+      Right pattern -> return $ patternToRegex pattern c e -instance RegexLike Regex (S.Seq Char) where+instance RegexLike Regex (Seq Char) where   matchOnce r s = listToMaybe (matchAll r s)   matchAll r s = execMatch r 0 '\n' s   matchCount r s = length (matchAll r' s)@@ -51,37 +51,31 @@   matchTest = Tester.matchTest   matchOnceText regex source =      fmap (\ma -> let (o,l) = ma!0-                 in (S.take o source-                    ,fmap (\ol@(off,len) -> (S.take len (S.drop off source),ol)) ma-                    ,S.drop (o+l) source))+                 in (before o source+                    ,fmap (\ol -> (extract ol source,ol)) ma+                    ,after (o+l) source))          (matchOnce regex source)   matchAllText regex source =-    map (fmap (\ol@(off,len) -> (S.take len (S.drop off source),ol)))+    map (fmap (\ol -> (extract ol source,ol)))         (matchAll regex source) -{-# INLINE toList #-}-toList :: S.Seq Char -> [Char]-toList s = expand (S.viewl s) where-  expand EmptyL = []-  expand (c :< cs) = c : expand (S.viewl cs)- compile :: CompOption -- ^ Flags (summed together)         -> ExecOption -- ^ Flags (summed together)-        -> (S.Seq Char) -- ^ The regular expression to compile+        -> (Seq Char) -- ^ The regular expression to compile         -> Either String Regex -- ^ Returns: the compiled regular expression compile compOpt execOpt bs =-  case parseRegex (toList bs) of-    Left err -> Left ("parseRegex for Text.Regex.TDFA.ByteString failed:"++show err)+  case parseRegex (F.toList bs) of+    Left err -> Left ("parseRegex for Text.Regex.TDFA.Sequence failed:"++show err)     Right pattern -> Right (patternToRegex pattern compOpt execOpt)  execute :: Regex      -- ^ Compiled regular expression-        -> (S.Seq Char) -- ^ ByteString to match against+        -> (Seq Char) -- ^ ByteString to match against         -> Either String (Maybe MatchArray) execute r bs = Right (matchOnce r bs)  regexec :: Regex      -- ^ Compiled regular expression-        -> (S.Seq Char) -- ^ ByteString to match against-        -> Either String (Maybe ((S.Seq Char), (S.Seq Char), (S.Seq Char), [(S.Seq Char)]))+        -> (Seq Char) -- ^ ByteString to match against+        -> Either String (Maybe ((Seq Char), (Seq Char), (Seq Char), [(Seq Char)])) regexec r bs =   case matchOnceText r bs of     Nothing -> Right (Nothing)
Text/Regex/TDFA/String.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fno-warn-orphans #-} {- |  This modules provides 'RegexMaker' and 'RegexLike' instances for using 'String' with the TDFA backend.@@ -20,16 +19,13 @@  ,regexec  ) where -import Data.Array.IArray((!),amap)- import Text.Regex.Base.Impl(polymatch,polymatchM) import Text.Regex.Base.RegexLike(RegexMaker(..),RegexLike(..),RegexContext(..),MatchOffset,MatchLength,MatchArray) import Text.Regex.TDFA.Common(common_error,Regex(..),CompOption,ExecOption(captureGroups)) import Text.Regex.TDFA.ReadRegex(parseRegex) import Text.Regex.TDFA.TDFA(patternToRegex)-import Text.Regex.TDFA.Wrap() -import Data.Array.IArray((!),listArray,elems,bounds)+import Data.Array.IArray((!),elems,amap) import Data.Maybe(listToMaybe) import Text.Regex.TDFA.NewDFA.Engine(execMatch) import Text.Regex.TDFA.NewDFA.Tester as Tester(matchTest)@@ -80,11 +76,11 @@   -- matchOnceText   matchAllText r s =     let go i _ _ | i `seq` False = undefined-        go i t [] = []+        go _i _t [] = []         go i t (x:xs) = let (off0,len0) = x!0                             trans pair@(off,len) = (take len (drop (off-i) t),pair)                             t' = drop (off0+len0-i) t-                        in amap trans x : seq t' (go (i+off0+len0) t' xs)+                        in amap trans x : seq t' (go (off0+len0) t' xs)     in go 0 s (matchAll r s)  instance RegexContext Regex String String where
Text/Regex/TDFA/TDFA.hs view
@@ -7,21 +7,23 @@  --import Control.Arrow((***)) import Control.Monad.Instances()-import Control.Monad.RWS+import Data.Monoid(Monoid(..)) import Control.Monad.State(State,MonadState(..),execState) import Data.Array.IArray(Array,(!),bounds,{-assocs-}) import Data.IntMap(IntMap)-import qualified Data.IntMap as IMap+import qualified Data.IntMap as IMap(empty,keys,delete,null,lookup,fromDistinctAscList+                                    ,member,unionWith,singleton,union+                                    ,toAscList,Key,elems,toList,insert+                                    ,insertWith,insertWithKey) import Data.IntMap.CharMap2(CharMap(..)) import qualified Data.IntMap.CharMap2 as Map(empty) --import Data.IntSet(IntSet)-import qualified Data.IntSet as ISet+import qualified Data.IntSet as ISet(empty,singleton,null) import Data.List(foldl') import qualified Data.Map (Map,empty,member,insert,elems)-import Data.Maybe(isJust) import Data.Sequence as S((|>),{-viewl,ViewL(..)-}) -import Text.Regex.TDFA.Common+import Text.Regex.TDFA.Common {- all -} import Text.Regex.TDFA.IntArrTrieSet(TrieSet) import qualified Text.Regex.TDFA.IntArrTrieSet as Trie(lookupAsc,fromSinglesMerge) import Text.Regex.TDFA.Pattern(Pattern)@@ -303,7 +305,7 @@    where     -- can DT never win or accept a character (when following trans_single)?     isDTLosing :: DT -> Bool-    isDTLosing (Testing' {dt_a=a,dt_b=b}) = isDTLosing a && isDTLosing b+    isDTLosing (Testing' {dt_a=a',dt_b=b'}) = isDTLosing a' && isDTLosing b'     isDTLosing (Simple' {dt_win=w}) | not (IMap.null w) = False -- can win with 0 characters     isDTLosing (Simple' {dt_trans=CharMap mt,dt_other=o}) =       let ts = o : IMap.elems mt@@ -313,7 +315,7 @@       transLoses (Transition {trans_single=dfa,trans_how=dtrans}) = isDTLose dfa || onlySpawns dtrans        where         isDTLose :: DFA -> Bool-        isDTLose dfa = ISet.null (d_id dfa)+        isDTLose dfa' = ISet.null (d_id dfa')         onlySpawns :: DTrans -> Bool         onlySpawns t = case IMap.elems t of                          [m] -> IMap.null m
Text/Regex/TDFA/TNFA.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fno-warn-orphans #-} -- XXX design uncertainty:  should preResets be inserted into nullView? -- if not, why not? ADDED @@ -35,12 +34,13 @@  {- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -} -import Control.Monad.State+import Control.Monad(when)+import Control.Monad.State(State,runState,execState,get,put,modify) import Data.Array.IArray(Array,array) import Data.Char(toLower,toUpper,isAlpha,ord) import Data.List(foldl') import Data.IntMap (IntMap)-import qualified Data.IntMap as IMap(size,toAscList,null,unionWith,singleton,fromList,fromDistinctAscList)+import qualified Data.IntMap as IMap(toAscList,null,unionWith,singleton,fromList,fromDistinctAscList) import Data.IntMap.CharMap2(CharMap(..)) import qualified Data.IntMap.CharMap2 as Map(null,singleton,map) import qualified Data.IntMap.EnumMap2 as EMap(null,keysSet,assocs)@@ -48,14 +48,16 @@ import qualified Data.IntSet.EnumSet2 as Set(singleton,toList,insert) import Data.Maybe(catMaybes,isNothing) import Data.Monoid(mempty,mappend)-import qualified Data.Set(insert,toAscList)+import qualified Data.Set as S(Set,insert,toAscList,empty) -import Text.Regex.TDFA.Common+import Text.Regex.TDFA.Common(QT(..),QNFA(..),QTrans,TagTask(..),TagUpdate(..),DoPa(..)+                             ,CompOption(..)+                             ,Tag,TagTasks,TagList,Index,WinTags,GroupIndex,GroupInfo(..)+                             ,common_error,noWin,snd3,mapSnd) import Text.Regex.TDFA.CorePattern(Q(..),P(..),OP(..),WhichTest,cleanNullView,NullView                                   ,SetTestInfo(..),Wanted(..),TestInfo                                   ,mustAccept,cannotAccept,patternToQ)-import Text.Regex.TDFA.Pattern(Pattern(..))-import Text.Regex.TDFA.ReadRegex(decodePatternSet)+import Text.Regex.TDFA.Pattern(Pattern(..),PatternSet(..),unSEC,PatternSetCharacterClass(..)) --import Debug.Trace  ecart :: String -> a -> a@@ -67,19 +69,6 @@ debug :: (Show a) => a -> s -> s debug _ s = s -instance Eq QT where-  t1@(Testing {}) == t2@(Testing {}) =-    (qt_test t1) == (qt_test t2) && (qt_a t1) == (qt_a t2) && (qt_b t1) == (qt_b t2)-  (Simple w1 (CharMap t1) o1) == (Simple w2 (CharMap t2) o2) =-    w1 == w2 && eqTrans && eqQTrans o1 o2-    where eqTrans :: Bool-          eqTrans = (IMap.size t1 == IMap.size t2)-                    && and (zipWith together (IMap.toAscList t1) (IMap.toAscList t2))-            where together (c1,qtrans1) (c2,qtrans2) = (c1 == c2) && eqQTrans qtrans1 qtrans2-          eqQTrans :: QTrans -> QTrans -> Bool-          eqQTrans = (==)-  _ == _ = False- qtwin,qtlose :: QT -- qtwin is the continuation after matching the whole pattern.  It has -- no futher transitions and sets tag #1 to the current position.@@ -761,10 +750,10 @@            in Simple { qt_win = mempty, qt_trans = trans, qt_other = mempty }          PDot _ -> Simple { qt_win = mempty, qt_trans = dotTrans, qt_other = target }          PAny _ ps ->-           let trans = toMap target . Data.Set.toAscList . decodePatternSet $ ps+           let trans = toMap target . S.toAscList . decodePatternSet $ ps            in Simple { qt_win = mempty, qt_trans = trans, qt_other = mempty }          PAnyNot _ ps ->-           let trans = toMap mempty . Data.Set.toAscList . addNewline . decodePatternSet $ ps+           let trans = toMap mempty . S.toAscList . addNewline . decodePatternSet $ ps            in Simple { qt_win = mempty, qt_trans = trans, qt_other = target }          _ -> err ("Cannot acceptTrans pattern "++show (qTop,pIn))     where  -- Take a common destination and a sorted list of unique chraceters@@ -779,7 +768,7 @@                                                         )                                                    else (dl.((ord c,dest):))                                        ) id -      addNewline | multiline compOpt = Data.Set.insert '\n'+      addNewline | multiline compOpt = S.insert '\n'                  | otherwise = id       dotTrans | multiline compOpt = Map.singleton '\n' mempty                | otherwise = mempty@@ -794,5 +783,44 @@   ADD ORPHAN ID check and make this a fatal error while testing++-}++-- | decodePatternSet cannot handle collating element and treats+-- equivalence classes as just their definition and nothing more.+decodePatternSet :: PatternSet -> S.Set Char+decodePatternSet (PatternSet msc mscc _ msec) =+  let baseMSC = maybe S.empty id msc+      withMSCC = foldl (flip S.insert) baseMSC  (maybe [] (concatMap decodeCharacterClass . S.toAscList) mscc)+      withMSEC = foldl (flip S.insert) withMSCC (maybe [] (concatMap unSEC . S.toAscList) msec)+  in withMSEC++-- | This returns the disctince ascending list of characters+-- represented by [: :] values in legalCharacterClasses; unrecognized+-- class names return an empty string+decodeCharacterClass :: PatternSetCharacterClass -> String+decodeCharacterClass (PatternSetCharacterClass s) =+  case s of+    "alnum" -> ['0'..'9']++['a'..'z']++['A'..'Z']+    "digit" -> ['0'..'9']+    "punct" -> ['\33'..'\47']++['\58'..'\64']++['\91'..'\95']++"\96"++['\123'..'\126']+    "alpha" -> ['a'..'z']++['A'..'Z']+    "graph" -> ['\41'..'\126']+    "space" -> "\t\n\v\f\r "+    "blank" -> "\t "+    "lower" -> ['a'..'z']+    "upper" -> ['A'..'Z']+    "cntrl" -> ['\0'..'\31']++"\127" -- with NUL+    "print" -> ['\32'..'\126']+    "xdigit" -> ['0'..'9']++['a'..'f']++['A'..'F']+    "word" -> ['0'..'9']++['a'..'z']++['A'..'Z']++"_"+    _ -> []++{-+-- | This is the list of recognized [: :] character classes, others+-- are decoded as empty.+legalCharacterClasses :: [String]+legalCharacterClasses = ["alnum","digit","punct","alpha","graph"+  ,"space","blank","lower","upper","cntrl","print","xdigit","word"]  -}
− Text/Regex/TDFA/Wrap.hs 
@@ -1,43 +0,0 @@-{-# OPTIONS -fno-warn-orphans #-}--- | "Text.Regex.TDFA.Wrap" provides the instance of RegexOptions and--- the definition of (=~) and (=~~).  This is all re-exported by--- "Text.Regex.TDFA".--module Text.Regex.TDFA.Wrap(Regex(..),CompOption(..),ExecOption(..),(=~),(=~~)) where--{- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -}--import Text.Regex.Base.RegexLike(RegexMaker(..),RegexOptions(..),RegexContext(..))-import Text.Regex.TDFA.Common(CompOption(..),ExecOption(..),Regex(..))--instance RegexOptions Regex CompOption ExecOption where-  blankCompOpt = defaultCompOpt-  blankExecOpt = defaultExecOpt-  defaultCompOpt = CompOption { caseSensitive = True-                              , multiline = True-                              , rightAssoc = True-                              , lastStarGreedy = False-                              }-  defaultExecOpt = ExecOption { captureGroups = True-                              , testMatch = False-                              }-  setExecOpts e r = r {regex_execOptions=e}-  getExecOpts r = regex_execOptions r---- | This is the pure functional matching operator.  If the target--- cannot be produced then some empty result will be returned.  If--- there is an error in processing, then 'error' will be called.-(=~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target)-     => source1 -> source -> target-(=~) x r = let make :: RegexMaker Regex CompOption ExecOption a => a -> Regex-               make = makeRegex-           in match (make r) x---- | This is the monadic matching operator.  If a single match fails,--- then 'fail' will be called.-(=~~) :: (RegexMaker Regex CompOption ExecOption source,RegexContext Regex source1 target,Monad m)-      => source1 -> source -> m target-(=~~) x r = do let make :: (RegexMaker Regex CompOption ExecOption a, Monad m) => a -> m Regex-                   make = makeRegexM-               q <- make r-               matchM q x
regex-tdfa.cabal view
@@ -1,5 +1,5 @@ Name:                   regex-tdfa-Version:                1.1.0+Version:                1.1.1 -- 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@@ -37,6 +37,8 @@ -- 1.0.5 use "uncons" on SBS -- 1.0.6 try NewDFATest_SBS with uncons -- 1.0.7 make NewDFA directory and String_NC+-- 1.1.0 NewDFA code working+-- 1.1.1 add gnu escapes License:                BSD3 License-File:           LICENSE Copyright:              Copyright (c) 2007, Christopher Kuklewicz@@ -77,13 +79,13 @@                           Text.Regex.TDFA.NewDFA.Engine_NC_FA                           Text.Regex.TDFA.NewDFA.Tester                           Text.Regex.TDFA.NewDFA.Uncons+                          Text.Regex.TDFA.NewDFA.MakeTest                           Text.Regex.TDFA.Pattern                           Text.Regex.TDFA.ReadRegex                           Text.Regex.TDFA.Sequence                           Text.Regex.TDFA.String                           Text.Regex.TDFA.TDFA                           Text.Regex.TDFA.TNFA-                          Text.Regex.TDFA.Wrap   Buildable:              True   Extensions:             MultiParamTypeClasses, FunctionalDependencies, BangPatterns, MagicHash, RecursiveDo, NoMonoPatBinds, ForeignFunctionInterface, UnboxedTuples, TypeOperators, FlexibleContexts, ExistentialQuantification, UnliftedFFITypes, TypeSynonymInstances, FlexibleInstances   GHC-Options:            -Wall -O2 -funbox-strict-fields