real: enable linear
[nofib.git] / real / rx / src / FAintersect.hs
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