```--
-- Functions manipulating Finite Automata (DFA and NDFA)
--
--
-- Code Included in the Lecture Notes on
--
--      Language Processing (with a functional flavour)
--
--
--           Department of Computer Science,
--           University of Minho,
--           Braga, Portugal
--           jas@di.uminho.pt
--           2001
--

module Language.HaLex.FaOperations (
ndfa2dfa
, dfa2ndfa
, ndfa2ct
, CT
, lookupCT
, stsDfa
, concatNdfa
, unionNdfa
, starNdfa
, plusNdfa
, expNdfa
, unionDfa
, concatDfa
, starDfa
, plusDfa
) where

import Data.List
import Language.HaLex.Util
import Language.HaLex.Dfa
import Language.HaLex.Ndfa

--
-- Making a DFA from a NDFA
--

type StDfa st = [st]

type CT st = [( StDfa st, [StDfa st])]

stsDfa   = map fst
stsRHS   = map snd
allstsCT = concat . stsRHS

ndfa2ct :: Ord st => Ndfa st sy -> CT st
ndfa2ct (Ndfa v q s z delta) = limit (ndfa2dfaStep delta v) ttFstRow
where  ttFstRow = consRows delta [epsilon_closure delta s] v

ndfa2dfaStep :: Ord st => (st -> (Maybe sy) -> [st]) -> [sy] -> CT st -> CT st
ndfa2dfaStep delta alfabet ct = nub (ct `union` consRows delta newSts alfabet)
where newSts =  ((nub . allstsCT) ct) <-> (stsDfa ct)

consRows :: Ord st => (st -> (Maybe sy) -> [st]) -> [StDfa st] -> [sy] -> CT st
consRows delta []     alfabet = []
consRows delta (q:qs) alfabet = (q , oneRow delta q alfabet) :
(consRows delta qs alfabet)

oneRow :: Ord st => (st -> (Maybe sy) -> [st]) -> (StDfa st) -> [sy] -> [StDfa st]
oneRow delta sts alfabet = map (\ v -> sort (ndfawalk delta sts [v])) alfabet

ndfa2dfa :: (Ord st,Eq sy) => Ndfa st sy -> Dfa [st] sy
ndfa2dfa ndfa@(Ndfa v q s z delta)  = (Dfa v' q' s' z' delta')
where  tt = ndfa2ct ndfa
v' = v
q' = stsDfa tt
z' = finalStatesDfa q' z
delta' st sy = lookupCT st sy tt v

finalStatesDfa :: Eq st => [StDfa st] -> [st] -> [StDfa st]
finalStatesDfa []     z = []
finalStatesDfa (q:qs) z | (q `intersect` z /= []) = q : finalStatesDfa qs z
| otherwise               = finalStatesDfa qs z

-- lookupCT :: (Eq st, Eq sy) => [st] -> sy -> CT st -> [sy] -> StDfa st
lookupCT st sy []     v  = []
lookupCT st sy (q:qs) v  | (fst q == st) = (snd q) !! col
| otherwise     = lookupCT st sy qs v
where (Just col) = elemIndex sy v

--
-- Making a NDFA from a DFA
--

dfa2ndfa :: Dfa st sy -> Ndfa st sy
dfa2ndfa (Dfa v q s z delta) = (Ndfa v q [s] z delta')
where delta' q (Just a) = [delta q a]
delta' q Nothing  = []

--
-- Concatenation of Ndfa's
--

concatNdfa :: (Eq a, Eq b) => Ndfa b a -> Ndfa b a -> Ndfa b a
concatNdfa (Ndfa vp qp sp zp dp) (Ndfa vq qq sq zq dq) = Ndfa v' q' s' z' d'
where v' = vp `union` vq
q' = qp `union` qq
s' = sp
z' = zq
d' q | q `elem` zp = dp' q
| q `elem` qp = dp  q
| otherwise   = dq  q
where dp' q Nothing = (dp q Nothing) `union` sq
dp' q sy      = dp q sy

--
-- Union Ndfa
--

unionNdfa :: (Eq a, Eq b) => Ndfa b a -> Ndfa b a -> Ndfa b a
unionNdfa (Ndfa vp qp sp zp dp) (Ndfa vq qq sq zq dq) = Ndfa v' q' s' z' d'
where v' = vp `union` vq
q' = qp `union` qq
s' = sp `union` sq
z' = zp `union` zq
d' q | q `elem` qp = dp q
| q `elem` qq = dq q

--
-- Star Ndfa
--

starNdfa :: Eq st => Ndfa st sy -> Ndfa st sy
starNdfa (Ndfa v qs s z d) = Ndfa v qs s z d'
where d' q | q `elem` s = ds' q
| q `elem` z = dz' q
| otherwise  = d q
where ds' q Nothing  = z `union` (d q Nothing)
ds' q sy       = d q sy

dz' q Nothing  = s `union` (d q Nothing)
dz' q sy       = d q sy

--
-- Plus Ndfa
--

plusNdfa :: Eq st => Ndfa st sy -> Ndfa st sy
plusNdfa (Ndfa v qs s z d) = Ndfa v qs s z d'
where d' q | q `elem` z = dz' q
| otherwise  = d q
where dz' q Nothing  = s `union` (d q Nothing)
dz' q sy       = d q sy

--
-- Exponenciation
--

expNdfa :: (Eq st,Eq sy) => Ndfa st sy -> Int -> Ndfa Int sy
expNdfa ndfa n = expNdfa' (renameNdfa ndfa 1) n

expNdfa' :: Eq sy => Ndfa Int sy -> Int -> Ndfa Int sy
expNdfa'  ndfa 1 = ndfa
expNdfa'  ndfa i = concatNdfa ndfa (expNdfa' ndfa (i-1))

--
-- Concatenation of Dfa's
--

concatDfa :: (Eq a, Eq b) => Dfa b a -> Dfa b a -> Ndfa b a
concatDfa (Dfa vp qp sp zp dp) (Dfa vq qq sq zq dq) = Ndfa v' q' s' z' d'
where v' = vp `union` vq
s' = [sp]
z' = zq
q' = qp `union` qq
d' q | q `elem` zp = dz' q
| q `elem` qp = dp' q
| q `elem` qq = dq' q
where dz' q  Nothing = [sq]
dz' q (Just y) | y `elem` vp = [dp q y]
| otherwise   = []

dp' q Nothing  = []
dp' q (Just y) | y `elem` vp = [dp q y]
| otherwise   = []

dq' q Nothing  = []
dq' q (Just y) | y `elem` vq = [dq q y]
| otherwise   = []

--
-- Union of Dfa's
--

unionDfa :: (Eq a, Eq b) => Dfa b a -> Dfa b a -> Ndfa b a
unionDfa (Dfa vp qp sp zp dp) (Dfa vq qq sq zq dq) = Ndfa v' q' s' z' d'
where v' = vp `union` vq
q' = qp `union` qq
s' = [sp,sq]
z' = zp ++ zq
d' _ Nothing                 = []
d' q (Just sy) | q `elem` qp && sy `elem` vp = [dp q sy]
| q `elem` qq && sy `elem` vq = [dq q sy]
| otherwise   = []

--
-- Star Dfa
--

starDfa :: Eq st => Dfa st sy -> Ndfa st sy
starDfa (Dfa v q s z d) = Ndfa v q [s] z d'
where d' q | q == s     = ds' q
| q `elem` z = dz' q
| otherwise  = dd' q
where ds' q Nothing  = z
ds' q (Just y) = [d q y]

dz' q Nothing  = [s]
dz' q (Just y) = [d q y]

dd' q (Just y) = [d q y]
dd' _ _        = []

--
-- Plus Dfa
--

plusDfa :: Eq st => Dfa st sy -> Ndfa st sy
plusDfa (Dfa v q s z d) = Ndfa v q [s] z d'
where d' q | q `elem` z = dz' q
| otherwise  = dd' q
where dz' q Nothing  = [s]
dz' q (Just y) = [d q y]

dd' q (Just y) = [d q y]
dd' _ _ = []
```