1 module FAstar
    2 
    3 ( starTNFA
    4 , starTNFApublic 
    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 
   18 import Ids
   19 
   20 import FAmap
   21 
   22 import FAcheat
   23 
   24 
   25 ---------------------------------------------------------------------------
   26 
   27 starTNFA :: Opts -> TCon -> TNFA Int -> TNFA Int -> TNFA Int
   28 -- star dot product of two langugaes.
   29 -- replaces one specified nullary constructor of the first language
   30 -- with an epsilon trasition to the second language
   31 -- or with an epsilon to the first lang's start
   32 starTNFA opts tc
   33         a @ (TNFA cons1 all1 starts1 moves1)
   34         b =
   35     let
   36         startmoves1 = starts1 `bind` (lookupset moves1)
   37 
   38         m = 1 + maximum (0 :  setToList all1)
   39         TNFA cons2 all2 starts2 moves2 = mapTNFA opts (\ n -> n + m) b
   40 
   41         -- all that can be constructed from the start
   42         startmoves2 = starts2 `bind` (lookupset moves2)
   43 
   44         startmoves = startmoves1 `unionSet` startmoves2
   45 
   46         change t = if stcon t == tc then startmoves else unitSet t
   47 
   48         moves3 = mapFM (\ v ts -> ts `bind` change) moves1
   49         
   50         cons = (cons1 `minusSet` unitSet tc) `unionSet` cons2 
   51         all = all1 `unionSet` all2
   52         starts = starts2 `unionSet` starts1
   53         moves = plusFM_C (error "starTNFA.moves") moves3 moves2
   54 
   55         c = TNFA cons all starts moves
   56 
   57     in  
   58 
   59         trinfo opts "star" c $
   60 
   61         c
   62 
   63 
   64 starTNFApublic :: Opts -> [TNFA Int] -> TNFA Int
   65 starTNFApublic opts args =
   66     if length args /= 3 
   67     then error "starTNFApublic.args"
   68     else 
   69         let [tcarg, arg1, arg2] = args
   70         in  starTNFA opts (cheat tcarg) arg1 arg2
   71