1 module FAcon
    2 
    3 ( conTNFA
    4 )
    5 
    6 where
    7 
    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 FAmap
   20 import FAcmpct
   21 
   22 conTNFA :: Opts -> TCon -> [TNFA Int] -> TNFA Int
   23 -- apply a constructor
   24 conTNFA opts tc as = 
   25     let -- make each arg top-down, tag it with its number
   26         aks    = [ mapTNFA opts (\ v -> (k, v)) a 
   27                 | (k, a) <- zippy [1..tconarity tc] as ]
   28 
   29         moves  = foldl         (plusFM_C (error "conTNFA.moves")) emptyFM
   30                                [ m | TNFA _ _ _ m <- aks ]
   31         starts =               [ s | TNFA _ _ s _ <- aks ]
   32         alls   = unionManySets [ a | TNFA _ a _ _ <- aks ]
   33         cons   = unionManySets (unitSet tc : [ c | TNFA c _ _ _ <- aks ]) 
   34 
   35         top = (0,0); tops = unitSet top
   36         its = unitFM top (mapSet (mksterm tc) (insts starts))
   37         
   38         t = TNFA cons (alls `unionSet` tops) tops
   39                 (plusFM_C (error "conTNFA.e") moves its)
   40         d = cmpctTNFA opts t
   41     in  
   42 
   43         trinfo opts "con" d $
   44 
   45         d
   46