diff --git a/Text/Regex/Deriv/ByteString/Posix.lhs b/Text/Regex/Deriv/ByteString/Posix.lhs --- a/Text/Regex/Deriv/ByteString/Posix.lhs +++ b/Text/Regex/Deriv/ByteString/Posix.lhs @@ -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' diff --git a/regex-deriv.cabal b/regex-deriv.cabal --- a/regex-deriv.cabal +++ b/regex-deriv.cabal @@ -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