regex-deriv 0.0.1 → 0.0.2
raw patch · 2 files changed
+46/−156 lines, 2 files
Files
- Text/Regex/Deriv/ByteString/Posix.lhs +45/−155
- regex-deriv.cabal +1/−1
Text/Regex/Deriv/ByteString/Posix.lhs view
@@ -64,49 +64,9 @@ > updateIfExist k !r !cf = > case IM.lookup k cf of > { Just !r' -> IM.update (\_ -> Just (combineRange r r')) k cf-> -- { Just !r' -> IM.update (\_ -> Just r) k cf-> ; Nothing -> IM.insert k r cf }--> {--> combineCF :: CarryForward -> CarryForward -> CarryForward-> combineCF cf1 cf2 = cf1-> -}--> {--> combineCF :: CarryForward -> CarryForward -> CarryForward-> combineCF cf1 cf2 = let -- l = logger (print ("combining" ++ show cf1 ++ " with " ++ show cf2))-> !cf = {- l `seq` -} {-# SCC "combineCF/unionWith" #-} IM.unionWith combineRange cf1 cf2-> in cf -> -}+> ; Nothing -> IM.insert k r cf } -> {- > combineRange :: [Range] -> [Range] -> [Range]-> combineRange rs1 rs2 = -> let rs = rs1 `seq` rs2 `seq` {-# SCC "combineRange/combineRangeAcc" #-} combineRangeAcc [] rs1 rs2 -> in rs `seq` reverse rs---> -> combineRangeAcc :: [Range] -> [Range] -> [Range] -> [Range]-> combineRangeAcc acc [] rs2 = let rs2' = reverse rs2 in rs2' `seq` rs2' ++ acc-> combineRangeAcc acc rs1 [] = let rs1' = reverse rs1 in rs1' `seq` rs1' ++ acc-> combineRangeAcc acc ((r1@(Range b1 e1)):rs1) ((r2@(Range b2 e2)):rs2) -> | b1 == b2 && e1 >= e2 = let acc' = (Range b1 e1):acc -> in acc' `seq` combineRangeAcc acc' rs1 rs2-> | b1 == b2 && e2 >= e1 = let acc' = (Range b2 e2):acc -> in acc' `seq` combineRangeAcc acc' rs1 rs2-> | b1 == e2+1 = let acc' = (Range b2 e1):acc-> in acc' `seq` combineRangeAcc acc' rs1 rs2-> | b2 == e1+1 = let acc' = (Range b1 e2):acc-> in acc' `seq` (combineRangeAcc acc' rs1 rs2)-> | b1 > e2+1 = let acc' = (Range b2 e2):acc-> in acc' `seq` (combineRangeAcc acc' (r1:rs1) rs2)-> | b2 > e1+1 = let acc' = (Range b1 e1):acc-> in acc' `seq` (combineRangeAcc acc' rs1 (r2:rs2))-> | otherwise = error $ "unhandle combineRangeAcc:" ++ show (r1:rs1) ++ " vs " ++ show (r2:rs2)--> -}-> combineRange :: [Range] -> [Range] -> [Range] > combineRange [] rs2 = rs2 > combineRange rs1 [] = rs1 > combineRange ((r1@(Range b1 e1)):rs1) ((r2@(Range b2 e2)):rs2) @@ -152,15 +112,14 @@ > in rs `seq` (r1:rs) -} > -- keeping only the last binding > [r2]-> | b1 >= b2 && e1 <= e2 = [r2]+> | otherwise = [r1] -- IMPORTANT: the application of combineCF cf1 cf2 always maintain the order where cf1 is the left most choice+> {- | b1 >= b2 && e1 <= e2 = [r2] > | b2 >= b1 && e2 <= e1 = [r1]-> | otherwise = error $ "unhandle combineRange:" ++ show (r1:rs1) ++ " vs " ++ show (r2:rs2)+> | otherwise = error $ "unhandle combineRange:" ++ show (r1:rs1) ++ " vs " ++ show (r2:rs2) -} -> -- -} - > combineCFs :: [CarryForward] -> CarryForward > combineCFs cfs = foldl' (\cf1 cf2 -> cf1 `combineCF` cf2) emptyCF cfs @@ -336,11 +295,41 @@ > in sb' `seq` (f' i sb')) > } -Turns a list of pattern x coercion pairs into a pchoice and a func, duplicate patterns are removed.+nub2Choice: turns a list of pattern x coercion pairs into a pchoice and a func, duplicate patterns (hence conflicting matches) are removed.+++e.g. ++*Text.Regex.Deriv.ByteString.Posix> matchInner [(testp, toSBinder testp)] (zip "ABAA" [1..])+[((0:(1:(2:(3:({(9:|[([<'A','C'>,'C'])]|),(9:|['C']|)}))))),+ SVar (0,[Range 1 4]) (SVar (1,[Range 1 4]) (SVar (2,[Range 1 4]) (SVar (3,[Range 1 4]) (SChoice [SVar (9,[]) (SRE (fromList [])) (fromList [(5,[Range 1 4]),(7,[Range 1 1]),(8,[Range 2 4])])+ ,SVar (9,[Range 4 4]) (SRE (fromList [])) (fromList [(5,[Range 1 3]),(7,[Range 1 2]),(8,[Range 3 3])])] (fromList [])) (fromList [])) (fromList [])) (fromList [])) (fromList []))]+++We match one more C,+The intermediate step was +++[((0:(1:(2:(3:({(9:|[([<>]|),(9:|[<>]|)}))))),+ SVar (0,[Range 1 4]) (SVar (1,[Range 1 4]) (SVar (2,[Range 1 4]) (SVar (3,[Range 1 4]) (SChoice [SVar (9,[Range 5 5]) (SRE (fromList [])) (fromList [(5,[Range 1 4]),(7,[Range 1 1]),(8,[Range 2 4])])+ ,SVar (9,[Range 4 5]) (SRE (fromList [])) (fromList [(5,[Range 1 3]),(7,[Range 1 2]),(8,[Range 3 3])])] (fromList [])) (fromList [])) (fromList [])) (fromList [])) (fromList []))]++++*Text.Regex.Deriv.ByteString.Posix> matchInner [(testp, toSBinder testp)] (zip "ABAAC" [1..])+[((0:(1:(2:(3:(9:|[<>]|))))),+ SVar (0,[Range 1 5]) (SVar (1,[Range 1 5]) (SVar (2,[Range 1 5]) (SVar (3,[Range 1 5]) (SVar (9,[Range 5 5]) (SRE (fromList [])) (fromList [(5,[Range 1 4]),(7,[Range 1 1]),(8,[Range 2 4])])) (fromList [])) (fromList [])) (fromList [])) (fromList []))]+++++ The first arg is a list of list of pair, because of the list monad generated by dPat0, each non-empty sub list is a singleton list. The resulting func accept a SChoice pattern (cf to the input list of pattern). ++ ----------------------------------- {}, d |-nub PChoice {}, \i -> id @@ -409,25 +398,8 @@ simplification -> {--> simplify :: [(Pat, Int -> SBinder -> SBinder)] -> [(Pat, Int -> SBinder -> SBinder)]-> simplify [] = []-> simplify pfs@[(PPair p1 p2, f)] -> | (isPhi (strip p1)) || (isPhi (strip p2)) = [] -> {- | (isEpsilon (strip p1)) =-> let rm = extract p1-> f i sb = case sb of { SPair sb1 sb2 cf -> let cf' = rm sb1 in carryForward (cf'++cf) sb2 }-> in [(p2,f)]-> | (isEpsilon (strip p2)) =-> let rm = extract p2-> f i sb = case sb of { SPair sb1 sb2 cf -> let cf' = rm sb2 in carryForward (cf'++cf) sb1 }-> in [(p1,f)] -}-> | otherwise = pfs-> simplify pfs = pfs-> -}- > simpFix :: Pat -> [(Pat, Int -> SBinder -> SBinder)]-> simpFix p = simp p -- simpFix' p (\i -> id) -- doto+> simpFix p = simp p -- simpFix' p (\i -> id) -- simpfix' seems not neccessary > simpFix' p f = > case simp p of@@ -620,51 +592,6 @@ > sbinderToEnv' p sb = error $ (pretty p) ++ " and " ++ (show sb) -> {--> sbinderToEnv :: Pat -> SBinder -> [Env]-> sbinderToEnv p sb = -> let envs = {-# SCC "sbinderToEnv/sbinderToEnv'" #-} sbinderToEnv' p sb-> envs' = {-# SCC "sbinderToEnv/sortEnvByVar'" #-} envs `seq` map sortEnvByVar envs-> in envs'--> sbinderToEnv' :: Pat -> SBinder -> [Env]-> sbinderToEnv' _ (SChoice [] _) = []-> sbinderToEnv' (PChoice (p:ps) g) (SChoice (sb:sbs) cf) -> | posEpsilon (strip p) = -> do { env <- sbinderToEnv' p sb-> ; let env' = IM.toList cf -> ; env `seq` env' `seq` return (env ++ env') }-> | otherwise = sbinderToEnv' (PChoice ps g) (SChoice sbs cf)-> sbinderToEnv' (PPair p1 p2) (SPair sb1 sb2 cf) =-> do { e1 <- sbinderToEnv' p1 sb1 -> ; e2 <- sbinderToEnv' p2 sb2-> ; let e3 = (IM.toList cf)-> ; e1 `seq` e2 `seq` e3 `seq` return (e1 ++ e2 ++ e3 ) }-> sbinderToEnv' (PVar x _ p) (SVar sr sb cf) -> | posEpsilon (strip p) = do { env <- sbinderToEnv' p sb-> ; let env' = env `seq` sr `seq` sr:env-> env'' = (IM.toList cf)-> ; env' `seq` env'' `seq` return (env' ++ env'') }-> | otherwise = []-> sbinderToEnv' (PStar _ _) (SStar cf) = let env = IM.toList cf in env `seq` [env]-> sbinderToEnv' (PE _) (SRE cf) = let env = IM.toList cf in env `seq` [env] -> sbinderToEnv' p sb = error $ (pretty p) ++ " and " ++ (show sb)---> sortEnvByVar :: Env -> Env -> sortEnvByVar env = let im = sortEnvByVar' env IM.empty -> in map (\(i,rs) -> (i, nub (sort rs) )) (IM.toList im)--> sortEnvByVar' :: Env -> IM.IntMap [Range] -> IM.IntMap [Range]-> sortEnvByVar' [] im = im-> sortEnvByVar' ((i,rs):srgs) im = -> case IM.lookup i im of -> { Just _ -> let im' = IM.update (\rs' -> Just $ rs ++ rs') i im-> in sortEnvByVar' srgs im' -> ; Nothing -> sortEnvByVar' srgs (IM.insert i rs im) } -> -}-- > type DfaTable = IM.IntMap (Int, Int -> SBinder -> SBinder, SBinder -> [Env]) @@ -676,26 +603,20 @@ > buildDfaTable :: Pat -> (DfaTable, SBinder, SBinder -> [Env], [Int]) > buildDfaTable p = > let sig = sigmaRE (strip p)-> -- init_dict = M.insert p 0 M.empty -> -- (allStates, delta, mapping) = builder sig [] [] init_dict 0 [p] -- 0 is already used by p > init_dict = M.insert p 0 M.empty > (delta, mapping) = {-# SCC "buildDfaTable/builder" #-} builder sig [] init_dict 0 [p] -- 0 is already used by p-> {- -> pat2id p = case M.lookup p mapping of -> { Just i -> i -> ; Nothing -> error ("pattern not found, this should not happen." ++ (show p) ++ (show (M.toList mapping))) }-> -}-> -- delta' = map (\ (s,c,d,f) -> (pat2id s, c, pat2id d, f, sbinderToEnv d) ) delta > delta' = delta > table = {-# SCC "buildDfaTable/table" #-} IM.fromList (map (\ (s,c,d,f,sb2env) -> (my_hash s c, (d,f,sb2env))) delta')-> -- finals = map pat2id (filter (\p -> posEpsilon (strip p) ) allStates)-> finals = [] -- todo+> finals = [] -- final is not needed, see the Arg below -- map snd (filter (\(p,i) -> posEpsilon $! strip p) ( M.toList mapping)) > in (table, toSBinder p, sbinderToEnv p, finals) testing > testp = -> let (Right (pp,posixBnd)) = parsePatPosix "^(((A|AB)(BAA|A))(AC|C))$" -- "^((A)|(AB)|(B))*$" --"^((a)|(bcdef)|(g)|(ab)|(c)|(d)|(e)|(efg)|(fg))*$"-- "X(.?){1,8}Y"+> -- let (Right (pp,posixBnd)) = parsePatPosix "(...?.?)*" +> -- let (Right (pp,posixBnd)) = parsePatPosix "^(((A|AB)(BAA|A))(AC|C))$" +> -- let (Right (pp,posixBnd)) = parsePatPosix "^((A)|(AB)|(B))*$" +> let (Right (pp,posixBnd)) = parsePatPosix "^((a)|(bcdef)|(g)|(ab)|(c)|(d)|(e)|(efg)|(fg))*$"-- "X(.?){1,8}Y" > in pp @@ -715,40 +636,8 @@ let (allStates, delta, mapping) = builder sig [] [] init_dict (0::Int) [testp] mapM_ (\p -> putStrLn (show p)) (sort allStates) -> {--> f p = -> let sig = sigmaRE (strip p)-> init_dict = M.insert p 0 M.empty -> f (allStates, delta, mapping) = builder sig [] [] init_dict 0 [p]-> pat2id p = case M.lookup p mapping of -> { Just i -> i -> ; Nothing -> error "pattern not found, this should not happen." }-> delta' = map (\ (s,c,d,f) -> (pat2id s, c, pat2id d, f, sbinderToEnv d) ) delta-> table = IM.fromList (map (\ (s,c,d,f,sb2env) -> (my_hash s c, (d,f,sb2env))) delta')-> in (map (\p -> (p, pat2id p)) allStates) -- (table, allStates, delta, delta')-> -} -> {--> builder :: [Char] -> -> [Pat] -> -> [ (Pat,Char,Pat,Int -> SBinder -> SBinder) ] -> -> M.Map Pat Int-> -> Int-> -> [Pat]-> -> ([Pat], [ (Pat,Char,Pat,Int -> SBinder -> SBinder) ], M.Map Pat Int)-> builder sig acc_pats acc_delta dict max_id curr_pats -> | null curr_pats = (acc_pats, acc_delta, dict)-> | otherwise = -> let all_sofar_pats = acc_pats ++ curr_pats-> -- io = logger (print all_sofar_pats)-> new_delta = [ (p,l,p',f') | p <- curr_pats, l <- sig, (p',f') <- dPat0 p l ]-> new_pats = D.nub [ p' | (p,l,p',f') <- new_delta, not (p' `M.member` dict) ]-> acc_delta_next = acc_delta ++ new_delta-> (dict',max_id') = foldl' (\(d,id) p -> (M.insert p (id+1) d, id + 1)) (dict,max_id) new_pats-> in {- io `seq` -} builder sig all_sofar_pats acc_delta_next dict' max_id' new_pats -> -} - > builder :: [Char] > -> [ (Int,Char,Int,Int -> SBinder -> SBinder, SBinder -> [Env] ) ] > -> M.Map Pat Int@@ -758,8 +647,7 @@ > builder sig acc_delta dict max_id curr_pats > | null curr_pats = (acc_delta, dict) > | otherwise = -> let -- all_sofar_pats = dict `union` fromList (zip curr_pats [(id+1)..])-> -- io = logger (print all_sofar_pats)+> let > new_delta = {-# SCC "builder/new_delta" #-} [ p `seq` p' `seq` l `seq` f' `seq` g `seq` (p,l,p',f',g) | p <- curr_pats, > l <- sig, (p',f') <- {-# SCC "builder/dPat0" #-} dPat0 p l, let g = sbinderToEnv p' ] > new_pats = {-# SCC "builder/new_pats" #-} D.nub [ p' | (p,l,p',f',g) <- new_delta, not (p' `M.member` dict) ]@@ -799,7 +687,9 @@ > let r = {-# SCC "execDfa" #-} dt `seq` execDfa 0 dt w [(0, init_sbinder, init_sb2env)] > in case r of > { [] -> Nothing -> ; ((i,sb,sb2env):_) -> case (sb2env sb) of -- todo: check i `elem` finals?+> ; ((i,sb,sb2env):_) -> case (sb2env sb) of +> -- Arg: why not i `elem` finals? +> -- No, we don't need to, because if the var pattern is not empty, the binding will not be extracted into the environment see sbinderToEnv > { [] -> Nothing > ; (e:_) -> let e' = filter (\(x,_) -> x `IM.notMember` posixBinder) e > in Just e'
regex-deriv.cabal view
@@ -1,5 +1,5 @@ Name: regex-deriv-Version: 0.0.1+Version: 0.0.2 License: BSD3 License-File: LICENSE Copyright: Copyright (c) 2010-2013, Kenny Zhuo Ming Lu and Martin Sulzmann