regex-genex 0.2.1 → 0.3.0
raw patch · 3 files changed
+84/−17 lines, 3 filesdep +control-monad-omegadep +textPVP ok
version bump matches the API change (PVP)
Dependencies added: control-monad-omega, text
API changes (from Hackage documentation)
+ Regex.Genex: genexPure :: [String] -> [String]
Files
- regex-genex.cabal +6/−5
- src/Regex/Genex.hs +22/−12
- src/Regex/Genex/Pure.hs +56/−0
regex-genex.cabal view
@@ -1,5 +1,5 @@ Name : regex-genex-Version : 0.2.1+Version : 0.3.0 license : OtherLicense license-file : LICENSE cabal-version : >= 1.6@@ -17,16 +17,17 @@ library hs-source-dirs: . src exposed-modules: Regex.Genex Regex.Genex.Normalize- extensions : ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards+ other-modules: Regex.Genex.Pure+ extensions : ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards, RecordWildCards build-depends:- base >= 3 && < 5, haskell98, mtl, containers, sbv, regex-tdfa+ base >= 3 && < 5, haskell98, mtl, containers, sbv, regex-tdfa, control-monad-omega, text executable genex main-is: Main.hs hs-source-dirs: . src- extensions : ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards+ extensions : ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards, RecordWildCards build-depends:- base >= 3 && < 5, haskell98, mtl, containers, sbv, regex-tdfa+ base >= 3 && < 5, haskell98, mtl, containers, sbv, regex-tdfa, control-monad-omega, text source-repository head type: git
src/Regex/Genex.hs view
@@ -1,12 +1,14 @@ {-# LANGUAGE ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards #-}-module Regex.Genex (Model(..), genex, genexPrint, genexModels) where+module Regex.Genex (Model(..), genex, genexPure, genexPrint, genexModels) where import Data.SBV import Data.SBV.Internals (SBV) import Data.Set (toList) import Data.Monoid import Control.Monad.State import qualified Data.Char+import qualified Regex.Genex.Pure as Pure import Text.Regex.TDFA.Pattern+import Regex.Genex.Normalize (normalize) import Text.Regex.TDFA.ReadRegex (parseRegex) import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet@@ -15,7 +17,8 @@ import System.IO.Unsafe (unsafeInterleaveIO) import Regex.Genex.Normalize (normalize) --- | Given a list of regular repressions, returns all possible strings that matches all of them.+-- | Given a list of regular repressions, returns all possible strings that matches every one of them.+-- Guarantees to return shorter strings before longer ones. genex :: [String] -> IO [String] genex = genexWith getString @@ -34,11 +37,17 @@ genexPrint :: [String] -> IO () genexPrint = genexWith displayString +-- | A pure and much faster variant of @genex@, but without support for back-references, anchors or word boundaries.+-- Does not guarantee orders about length of strings.+-- Does not depend on the external 'yices' SMT solver.+genexPure :: [String] -> [String]+genexPure = Pure.genexPure+ type Len = Word16 type SChar = SWord8 type Str = [SChar] type Offset = SBV Len-type Flips = SWord64+type Flips = [SWord64] type Captures = SFunArray Word8 Len type Hits = Word16 @@ -119,7 +128,7 @@ exactMatch :: (?pats :: [(Pattern, GroupLens)]) => Len -> Symbolic SBool exactMatch len = do str <- mkFreeVars $ fromEnum len- initialFlips <- free "flips"+ initialFlips <- mkFreeVars 1 captureAt <- newArray_ (Just minBound) captureLen <- newArray_ (Just minBound) let ?str = str@@ -134,9 +143,9 @@ runPat s (pat, groupLens) = let ?pat = pat in let ?grp = groupLens in ite (ok s &&& pos s .== strLen) (match s{ pos = 0, captureAt, captureLen })- s{ ok = false, pos = maxBound, flips = maxBound }+ s{ ok = false, pos = maxBound, flips = [maxBound] } let Status{ ok, pos, flips } = foldl runPat initialStatus ?pats- return (flips .== 0 &&& pos .== strLen &&& ok)+ return (bAll (.== 0) flips &&& pos .== strLen &&& ok) data Status = Status { ok :: SBool@@ -158,14 +167,15 @@ choice :: (?str :: Str, ?pat :: Pattern) => Flips -> [Flips -> Status] -> Status choice _ [] = error "X" choice flips [a] = a flips-choice flips [a, b] = ite (lsb flips) (b flips') (a flips')+choice flips [a, b] = ite (lsb flip) (b flips') (a flips') where- flips' = flips `shiftR` 1-choice flips xs = select (map ($ flips') xs) (head xs thisFlip){ ok = false } thisFlip+ flip = head flips+ flips' = [flip `shiftR` 1]+choice flips xs = select (map ($ flips') xs) (head xs [thisFlip]){ ok = false } thisFlip where bits = log2 $ length xs- flips' = flips `shiftR` bits- thisFlip = (flips `shiftL` (64 - bits)) `shiftR` (64 - bits)+ flips' = [head flips `shiftR` bits]+ thisFlip = head flips `shiftL` (64 - bits) `shiftR` (64 - bits) log2 :: Int -> Int log2 1 = 0@@ -309,7 +319,7 @@ | otherwise = (len .<= off) ||| (charAt (pos+off) .== charAt (from+off) &&& matchCapture from len (n+1)) where off = toEnum n- __FAIL__ = s{ ok = false, pos = maxBound, flips = maxBound }+ __FAIL__ = s{ ok = false, pos = maxBound, flips = [maxBound] } isEnd = (pos .== toEnum (length ?str)) isBegin = (pos .== 0) isWordCharAt at = let char = charAt at in
+ src/Regex/Genex/Pure.hs view
@@ -0,0 +1,56 @@+module Regex.Genex.Pure (genexPure) where+import qualified Data.Text as T+import qualified Data.IntSet as IntSet+import qualified Data.Set as Set+import Data.List (intersect, (\\))+import Control.Monad+import Control.Monad.Omega+import Regex.Genex.Normalize (normalize)+import Text.Regex.TDFA.Pattern+import Text.Regex.TDFA.ReadRegex (parseRegex)++parse :: String -> Pattern+parse r = case parseRegex r of+ Right (pattern, _) -> pattern+ Left x -> error $ show x++genexPure :: [String] -> [String]+genexPure = map T.unpack . foldl1 intersect . map (runOmega . omega . normalize IntSet.empty . parse)++maxRepeat :: Int+maxRepeat = 3++omega :: Pattern -> Omega T.Text+omega p = case p of+ PChar{..} -> isChar getPatternChar+ PAny {getPatternSet = PatternSet (Just cset) _ _ _} -> each $ map T.singleton $ Set.toList cset+ PQuest p -> join $ each [return T.empty, omega p]+ PPlus p -> omega $ PBound 1 Nothing p+ PStar _ p -> omega $ PBound 0 Nothing p+ PBound low high p -> do+ p <- omega p+ n <- each [low..maybe (low+3) id high]+ return $ T.replicate n p+ PConcat ps -> fmap T.concat . sequence $ map omega ps+ POr xs -> foldl1 mplus $ map omega xs+ PDot{} -> notChars []+ PEscape {..} -> case getPatternChar of+ 'n' -> isChar '\n'+ 't' -> isChar '\t'+ 'r' -> isChar '\r'+ 'f' -> isChar '\f'+ 'a' -> isChar '\a'+ 'e' -> isChar '\ESC'+ 'd' -> chars $ ['0'..'9']+ 'w' -> chars $ ['0'..'9'] ++ '_' : ['a'..'z'] ++ ['A'..'Z']+ 's' -> chars "\9\10\12\13\32"+ 'W' -> notChars $ ['0'..'9']+ 'S' -> notChars $ ['0'..'9'] ++ '_' : ['a'..'z'] ++ ['A'..'Z']+ 'D' -> notChars "\9\10\12\13\32"+ ch -> isChar ch+ _ -> error $ show p+ where+ isChar :: Char -> Omega T.Text+ isChar = return . T.singleton+ chars = each . map T.singleton+ notChars = chars . ([' '..'~'] \\)