1 module FArquotient
    2 
    3 ( rquotientTNFA
    4 , rquotientTNFApublic
    5 )
    6 
    7 where
    8 
    9 import Set
   10 import FiniteMap
   11 
   12 import Stuff
   13 import Options
   14 
   15 import TA
   16 import FAtypes
   17 import Ids
   18 
   19 import FAuseful
   20 import FAkeepst
   21 
   22 import FAcheat
   23 
   24 
   25 import Trace
   26 
   27 ----------------------------------------------------------------------
   28 
   29 rquotientTNFA :: Opts -> TCon -> TNFA Int -> TNFA Int -> TNFA Int
   30 rquotientTNFA opts tc a1 @ (TNFA consa1 _ _ _) a2 @ (TNFA consa2 _ _ _) =
   31     let 
   32         -- not surprisingly, this is copied from intersectTNFA
   33 
   34         cons = consa1 
   35         TNFA cons1 all1 starts1 moves1 = a1
   36         TNFA cons2 all2 starts2 moves2 = a2
   37 
   38         comb (w1, w2) = mkSet
   39                 [ mksterm (stcon t2) (zip (stargs t1) (stargs t2))
   40                         -- don't use zippy here!
   41                         -- we're mis-using tc of arity 0 slightly
   42                 | t2 <- setToList 
   43                     (lookupWithDefaultFM moves2 (error "rquoteTNFA.t2") w2)
   44                 , stcon t2 == tc || stcon t2 `elementOf` cons 
   45 
   46                 , t1 <- setToList 
   47                     (lookupWithDefaultFM moves1 (error "rquoteTNFA.t1") w1)
   48                 , stcon t2 == tc || stcon t1 == stcon t2
   49 
   50                 ]
   51 
   52         moves = listToFM [ ( (w1, w2), cs)
   53                 | w1 <- setToList all1, w2 <- setToList all2 
   54                 , cs <- [ comb (w1, w2) ], not (isEmptySet cs)
   55                 ]
   56         starts3 = mkSet [ (x, y) 
   57                 | x <- setToList starts1, y <- setToList starts2 ]
   58         all3 =  mkSet [ (x, y) 
   59                 | x <- setToList all1, y <- setToList all2 ]
   60         b3 = TNFA (cons `unionSet` unitSet tc) all3 starts3 moves
   61 
   62 --      reachables = precs moves starts3
   63 --      t4 @ (TNFA cons4 all4 starts4 moves4) = keepstTNFA opts b3 reachables
   64 
   65         t4 @ (TNFA cons4 all4 starts4 moves4) = usefulTNFA opts b3 -- ???
   66 
   67         starts5 = mkSet [ v1 
   68                 | ((v1, v2) , ts ) <- fmToList moves4
   69                 , or [ stcon t == tc | t <- setToList ts ]
   70                 ]
   71         b6 = TNFA cons1 all1 starts5 moves1
   72 
   73     in  
   74 
   75 --      trace ("\nrquotient.a1: " ++ show a1) $
   76 --      trace ("\nrquotient.a2: " ++ show a2) $
   77 --      trace ("\nrquotient.moves: " ++ show moves) $
   78 --      trace ("\nrquotient.starts3: " ++ show starts3) $
   79 --      trace ("\nrquotient.all3: " ++ show all3) $
   80 --      trace ("\nrquotient.b3: " ++ show b3) $
   81 --      trace ("\nrquotient.t4: " ++ show t4) $
   82 --      trace ("\nrquotient.starts5: " ++ show starts5) $
   83 
   84         trinfo opts "rquotient" b6 $
   85         
   86         b6
   87 
   88 
   89 rquotientTNFApublic :: Opts -> [TNFA Int] -> TNFA Int
   90 rquotientTNFApublic opts args =
   91     if length args /= 3 
   92     then error "rquotientTNFApublic.args"
   93     else 
   94         let [tcarg, arg1, arg2] = args
   95         in  rquotientTNFA opts (cheat tcarg) arg1 arg2
   96