FSMOpt.hs

module FSMOpt where
import FSM
import GraphOps
import MUtils(collectByFst,collectBySnd,mapFst,mapSnd,usort)
import qualified IntMap as M
import qualified IntSet as S
import qualified OrdMap as OM
import List(sort,partition)

rmeqstate (n,NFA m) = (n',NFA (M.fromList m'))
  where (n',m') = repeat' rmeqstate1 (n,M.toList m)

repeat' f x =
  case f x of
    (True,x') -> x'
    (False,x') -> repeat' f x'

rmeqstate1 ((st,go),m) = (null sml,((s st,s go), m3))
  where
    m3 = [(st,[(e,s go)|(e,go)<-es])|(st:_,es)<-m2b]
    s x= M.lookupWithDefault sm x x
    sm = M.fromList sml
    sml = smla++smlb
    smlb = [(old,new)|(new:ss,_)<-m2b,old<-ss]
    smla = [(old,new)|(olds,[(E,new)])<-m2a,old<-olds]
    (m2a,m2b) = partition jumpstate m2
    m2 = opt m

    jumpstate (ss,[(E,g)]) = True
    jumpstate _ = False

    opt = collectBySnd . mapSnd usort

connectivity (n,NFA m) = (n,fmap next m)
  where next = S.fromList . map snd

epsilonconnectivity m = fmap epsnext m
  where epsnext ns = S.fromList [s|(E,s)<-ns]

unreachable fsm = sort . S.toList $ all `S.minus` r
  where
    r = reachable g start
    all = S.fromList . map fst . M.toList $ g
    ((start,_),g) = connectivity fsm

tokenclasses x = collectBySnd . collectByFst . tokenedges . edges $x

tokenedges edges = [(i,sg)|(T (I i),sg)<-edges]
outputedges edges = [(o,sg)|(T (O o),sg)<-edges]
epsilonedges edges = [sg|(E,sg)<-edges]

edges (NFA m) = [(e,(s,g))|(s,es)<-M.toList m,(e,g)<-es]

renumberEdges tclss (NFA ss) = NFA (fmap (usort . mapFst renEdge) ss)
  where
    renEdge (T (I c)) = case OM.lookup c tcmap of Just i -> T (I i)
    renEdge (T (O x)) = T (O x)
    renEdge E = E
    tcmap = OM.fromList tclss