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