1 module FAintersect 2 3 ( intersectTNFA 4 ) 5 6 where 7 8 import Set 9 import FiniteMap 10 11 import Stuff 12 import Options 13 14 import TA 15 import FAtypes 16 import Ids 17 18 import FAcmpct 19 import FAkeepcons 20 21 intersectTNFA :: Opts -> TNFA Int -> TNFA Int -> TNFA Int 22 intersectTNFA opts a1 @ (TNFA consa1 _ _ _) a2 @ (TNFA consa2 _ _ _) = 23 let cons = consa1 `intersectSet` consa2 24 TNFA cons1 all1 starts1 moves1 = keepconsTNFA opts a1 cons 25 TNFA cons2 all2 starts2 moves2 = keepconsTNFA opts a2 cons 26 27 comb (w1, w2) = mkSet 28 [ mksterm (stcon t1) (zippy (stargs t1) (stargs t2)) 29 | t1 <- setToList 30 (lookupWithDefaultFM moves1 (error "intersectTNFA.t1") w1) 31 , stcon t1 `elementOf` cons 32 33 , t2 <- setToList 34 (lookupWithDefaultFM moves2 (error "intersectTNFA.t2") w2) 35 36 , stcon t2 `elementOf` cons 37 , stcon t1 == stcon t2 38 ] 39 40 moves = listToFM [ ( (w1, w2), cs) 41 | w1 <- setToList all1, w2 <- setToList all2 42 , cs <- [ comb (w1, w2) ], not (isEmptySet cs) 43 ] 44 starts3 = mkSet [ (x, y) 45 | x <- setToList starts1, y <- setToList starts2 ] 46 47 all3 = mkSet [ (x, y) 48 | x <- setToList all1, y <- setToList all2 ] 49 b3 = TNFA cons all3 starts3 moves 50 51 c = cmpctTNFA opts b3 52 53 in 54 -- trace ("\nintersectTNFA.a1: " ++ show a1) $ 55 -- trace ("\nintersectTNFA.a2: " ++ show a2) $ 56 -- trace ("\nintersectTNFA.cons: " ++ show cons) $ 57 -- trace ("\nintersectTNFA.moves: " ++ show moves) $ 58 -- trace ("\nintersectTNFA.starts': " ++ show starts') $ 59 -- trace ("\nintersectTNFA.all: " ++ show all) $ 60 -- trace ("\nintersectTNFA.starts: " ++ show starts) $ 61 -- trace ("\nintersectTNFA.b: " ++ show b) $ 62 63 trinfo opts "intersect" c $ 64 65 c