1 module FAlquotient 2 3 ( lquotientTNFA 4 , lquotientTNFApublic 5 ) 6 7 where 8 9 10 import Set 11 import FiniteMap 12 13 import Stuff 14 import Options 15 16 import TA 17 import FAtypes 18 import Ids 19 20 import FAuseful (prods) 21 22 import FAcheat 23 24 ---------------------------------------------------------------------- 25 26 lquotientTNFA :: Opts -> TCon -> TNFA Int -> TNFA Int -> TNFA Int 27 lquotientTNFA opts tc a1 @ (TNFA consa1 _ _ _) a2 @ (TNFA consa2 _ _ _) = 28 let 29 -- not surprisingly, this is copied from intersectTNFA 30 31 -- todo:check that tc not in cons1 32 33 cons = consa1 `unionSet` unitSet tc 34 35 TNFA cons1 all1 starts1 moves1 = a1 36 TNFA cons2 all2 starts2 moves2 = a2 37 38 comb (w1, w2) = mkSet 39 [ mksterm (stcon t2) (zippy (stargs t1) (stargs t2)) 40 | t2 <- setToList 41 (lookupWithDefaultFM moves2 (error "lquoteTNFA.t2") w2) 42 43 , t1 <- setToList 44 (lookupWithDefaultFM moves1 (error "lquoteTNFA.t1") w1) 45 , stcon t2 == stcon t1 46 47 ] 48 49 moves = listToFM [ ( (w1, w2), cs) 50 | w1 <- setToList all1, w2 <- setToList all2 51 , cs <- [ comb (w1, w2) ] 52 , not (isEmptySet cs) 53 ] 54 55 moves3 = invert moves 56 prods3 = prods cons2 moves3 -- those that produce leaves 57 58 ws = prods3 `bind` \ (w1, w2) -> -- mark their partners 59 if w2 `elementOf` starts2 then unitSet w1 else emptySet 60 61 moves4 = mapFM (\ w ts -> 62 if w `elementOf` ws 63 then ts `unionSet` unitSet (mksterm tc []) 64 else ts ) moves1 65 66 b3 = TNFA cons all1 starts1 moves4 67 68 69 in 70 71 -- trace ("\nlquotient.a1: " ++ show a1) $ 72 -- trace ("\nlquotient.a2: " ++ show a2) $ 73 -- trace ("\nlquotient.moves: " ++ show moves) $ 74 -- trace ("\nlquotient.moves3: " ++ show moves3) $ 75 -- trace ("\nlquotient.prods3: " ++ show prods3) $ 76 -- trace ("\nlquotient.ws: " ++ show ws) $ 77 -- trace ("\nlquotient.moves4: " ++ show moves4) $ 78 -- trace ("\nlquotient.b3: " ++ show b3) $ 79 80 trinfo opts "lquotient" b3 $ 81 82 b3 83 84 85 lquotientTNFApublic :: Opts -> [TNFA Int] -> TNFA Int 86 lquotientTNFApublic opts args = 87 if length args /= 3 88 then error "lquotientTNFApublic.args" 89 else 90 let [tcarg, arg1, arg2] = args 91 in lquotientTNFA opts (cheat tcarg) arg1 arg2 92 93