1 module FAhom
    2 
    3 ( homBDFA
    4 , homTNFA
    5 )
    6 
    7 where
    8 
    9 import Set
   10 import FiniteMap
   11 
   12 import Options
   13 
   14 import Stuff
   15 
   16 import TA
   17 import FAtypes
   18 
   19 
   20 
   21 
   22 homBDFA :: (Ord a, Ord b) => Opts -> (a -> b) -> (BDFA a -> BDFA b)
   23 -- homomorphism: identifies some states
   24 homBDFA opts f (BDFA cons all starts moves) =
   25     let 
   26         -- some paranoid checks first
   27         nostarts = all `minusSet` starts
   28         starts' = mapSet f starts
   29         nostarts' = mapSet f nostarts
   30         all' = starts' `unionSet` nostarts'
   31 
   32         moves' = addListToFM_C 
   33                 (\ x y -> if x /= y 
   34                         then error "bfdahom identifies incosistent ruleset"
   35                         else x)
   36                 emptyFM
   37                 [ (mksterm (stcon t) (map f (stargs t)), f w)
   38                 | (t, w) <- fmToList moves
   39                 ]
   40                 
   41     in  if not (isEmptySet (starts' `intersectSet` nostarts'))
   42         then error "homBDFA identifies starts and nostarts"
   43         else   BDFA cons all' starts' moves'
   44 
   45 ---------------------------------------------------------------
   46 
   47 homTNFA :: (Ord a, Ord b) => Opts -> (a -> b) -> (TNFA a -> TNFA b)
   48 -- homomorphism: identifies some states
   49 homTNFA opts f (TNFA cons all starts moves) =
   50     let 
   51         -- can't do paranoia checking here
   52         -- since rejecting states are not uniquely determined
   53 
   54         starts' = mapSet f starts
   55         all' = mapSet f all
   56 
   57         moves' = addListToFM_C 
   58                 (\ x y -> if x /= y 
   59                         then error "bfdahom identifies incosistent ruleset"
   60                         else x)
   61                 emptyFM
   62                 [ ( f w 
   63                   , mapSet ( \ t -> mksterm (stcon t) (map f (stargs t))) ts )
   64                 | (w, ts) <- fmToList moves
   65                 ]
   66                 
   67         g = TNFA cons all' starts' moves'
   68 
   69     in  
   70         trinfo opts "hom" g $
   71 
   72         g
   73 ------------------------------------------------------------------------