module Lecture2
where

import Auxfuns
import qualified NFAe as Ne
import NFAe (eclosure)
import qualified NFA as N
import qualified DFA as D
import Transform(reachableDFA,reToNFAe)
import PP
import PrintDFA
import PrintNFA
import PrintNFAe
import PrintRegExp
import List
import Graphviz


unionDFA :: (Ord q1, Ord q2) => D.DFA q1 s -> D.DFA q2 s -> D.DFA (q1, q2) s
unionDFA (D.DFA { D.states = bigQ1, D.symbols = sigma, D.delta = d1, D.start = q10, D.final = f1})
         (D.DFA { D.states = bigQ2, D.delta = d2, D.start = q20, D.final = f2})  
    = D.DFA { D.states = [(q1,q2) | q1 <- bigQ1, q2 <- bigQ2],
              D.symbols = sigma,
              D.delta = \ (q1,q2) a -> (d1 q1 a, d2 q2 a),
              D.start = (q10,q20),
              D.final = nub $ [(q1,q2) | q1 <- f1, q2 <- bigQ2] ++ 
                              [(q1,q2) | q1 <- bigQ1, q2 <- f2]}



nfaToDfa :: (Ord q) => N.NFA q s -> D.DFA [q] s
nfaToDfa (N.NFA {N.states = bigQ,
                 N.symbols = sigma,
                 N.delta = d,
                 N.start = q0,
                 N.final = f}) 
    = D.DFA { D.states = powerSet bigQ,
              D.symbols = sigma,
              D.delta = \ps a -> unions $ [d p a | p <- ps],
              D.start = [q0],
              D.final = [qs | qs <- powerSet bigQ, not $ null $ intersect qs f]}

nfaeToDfa :: (Ord q) => Ne.NFAe q s -> D.DFA [q] s
nfaeToDfa (Ne.NFAe {Ne.states = bigQ,
                    Ne.symbols = sigma,
                    Ne.delta = d,
                    Ne.start = q0,
                    Ne.final = f}) 
    = D.DFA { D.states = powerSet bigQ,
              D.symbols = sigma,
              D.delta = \ps a -> eclosure bigQ d $ unions $ [d p (Just a) | p <- ps],
              D.start = eclosure bigQ d [q0],
              D.final = [qs | qs <- powerSet bigQ, not $ null $ intersect qs f]}


--------------------------------------------------------

data Close q s = Close [q] (Ne.NFAe q s)

close xs (d@(Ne.NFAe states syms delta s f)) = 
  Close (eclosure states delta xs) d


instance (Eq q,Show q,Show s) => Graph (Close q s) where
  nodes (Close xs t) = map f pairs
    where pairs = zip (Ne.states t) [0..] 
          f (q,n) = (n,show q,stateColor t q)
          stateColor t q | elem q xs = Blue
          stateColor t q | q == (Ne.start t)   = Green
	  stateColor t q | elem q (Ne.final t) = Red
	  stateColor t q                    = None
	                            

  edges (Close xs t) = 
            [(n,m,sh s,None) 
            | (q1,n) <- pairs
            , s <- Nothing : (map Just (Ne.symbols t))
            , m <- locate q1 s ]
    where pairs = zip (Ne.states t) [0..]
          find q = case lookup q pairs of {Just n -> n}
          locate q1 s = map find (Ne.delta t q1 s) 
          sh Nothing = "^"
          sh (Just z) = show z

n1 = pnG N.mc
n2 = pnG (nfaToDfa N.mc)
n3 = pnG (reachableDFA $ nfaToDfa N.mc)

n4 = reToNFAe (parseRegExp "a+bc+de*")
n5 = pnG n4
n6 = nfaeToDfa n4
n7 = reachableDFA n6

n8 = pnG(close [3] n4)
n9 = pnG(close [5] n4)