1 module FAunify
    2 
    3 ( unifyTNFA
    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 FAhom
   19 import FAcmpct
   20 
   21 
   22 unifyTNFA :: Opts -> TNFA Int -> TNFA Int
   23 unifyTNFA opts = fixpoint (same opts) where
   24         same opts b @ (TNFA cons all starts moves) =
   25             let        -- this uses Ord on sets!
   26                 c = collectFM (eltsFM moves)
   27                 h = mapFM ( \ w ts -> 
   28                     lookupWithDefaultFM c 
   29                         (error ("same.c cannot find " ++ show ts)) ts) moves
   30                 d = homTNFA opts (\ x -> case lookupFM h x of
   31                         Just y -> Right y; Nothing -> Left x) b 
   32                 e = cmpctTNFA opts d
   33             in
   34 
   35 --           trace ("(* heurist *)") $
   36 
   37 --           trace ("\nheuristic.same.b: " ++ show b) $
   38 --           trace ("\nheuristic.same.c: " ++ show c) $
   39 --           trace ("\nheuristic.same.h: " ++ show h) $
   40 --           trace ("\nheuristic.same.d: " ++ show d) $
   41 --           trace ("\nheuristic.same.e: " ++ show d) $
   42 
   43                 trinfo opts "unify" e $
   44 
   45                 e
   46