import List

fix f x = if x' == x then x' else fix f x' where x' = f x

data DFA a s = DFA [a] [s] s [(s,a,s)] [s] deriving Show
data NFA a s = NFA [a] [s] s [(s,EpsilonLift a,[s])] [s] deriving Show

data EpsilonLift a = Epsilon | Alphabet a deriving (Eq, Ord)

instance Show a => Show (EpsilonLift a) where
  show Epsilon = "''"
  show (Alphabet c) = show c

eKleen ss dl = nub $ [(s,[s])| s<-ss] ++ eTrans dl

eTrans dl = fix transitive [(x,y) | (x,Epsilon,y) <- dl] where
  transitive ts = nub (ts ++ [(x,z) | (x,ys)<-ts, (y,z)<-ts, y`elem`ys])

nfa2dfa (NFA sigma ss s0 dl fs) = DFA sigma ss' s0' dl' fs'
  where
  eTransCl = eTrans dl
  eKleenClOf sl = nub [y | s<-sl, (x,ys)<-eKleen ss dl, s==x, y<-ys]
  dla = [(x,a,ys)|(x,Alphabet a,ys)<-dl]
  dla1 = nub $ dla++[(x,a,z)| (x,a,ys)<-dla, (y,z)<-eTransCl, y`elem`ys]
  dla2 = nub $ dla1++[(x,a,z)| (x,ys)<-eTransCl, (y,a,z)<-dla1, y`elem`ys]
  s0' = eKleenClOf [s0]
  fs' = nub $ map eKleenClOf [s | s<-ss', not (null (intersect fs s))]
  dl' = fix nexts (nub $ adjs s0')
  ss' = nub $ map eKleenClOf (qs1++qs2)
      where (qs1,qs2) = unzip [(x,y)|(x,a,y)<-dl']
  nexts trs = nub $ trs ++ [tr | (_,_,xs) <- trs, tr <- adjs xs]
  adjs qs = do
    a <- sigma
    qs2@(_:_) <- [nub $ concat [y | (x,a',y)<-dla2, x`elem`qs, a==a']]
    return (eKleenClOf qs,a,eKleenClOf qs2)

-- for test

runDFA (DFA sigma ss s0 dl fs) str = foldl delta s0 str `elem` fs
  where
  delta s a = case find (\(s',a',_) -> s'==s && a'==a) dl of
                Just (_,_,s'') -> s''
                Nothing -> error ("no transition defined for "++show a)


runNFA (NFA sigma ss s0 dl fs) str =
  any (`elem` fs) $ foldl delta' (eKleenClOf [s0]) str
  where
  eKleenClOf sl = nub [y | s<-sl, (x,ys)<-eKleen ss dl, s==x, y<-ys]
  delta' sl a = nub [z | y<-eKleenClOf sl, z<-eKleenClOf(delta y a)]
  delta s a =
    case find (\(s',a',_) -> s'==s && (a'==Alphabet a || a'==Epsilon)) dl of
      Just (_,_,sl) -> sl
      Nothing -> error ("no transition defined for "++show a)

-- some test data
dfa = DFA "ab" "abx" 'a' d "ab"
  where
  d = [ ('a','a','a'),
        ('a','b','b'),
        ('b','a','x'),
        ('b','b','b'),
        ('x','a','x'),
        ('x','b','x')
      ]

nfa = NFA "abc" "abcx" 'a' d "c"
  where
  d = [
       ('a',Alphabet 'a',"b"),
       ('a',Alphabet 'b',"x"),
       ('a',Alphabet 'c',"x"),
       ('a',Epsilon,"b"),
       ('b',Alphabet 'a',"x"),
       ('b',Alphabet 'b',"c"),
       ('b',Alphabet 'c',"x"),
       ('b',Epsilon,"c"),
       ('c',Alphabet 'a',"x"),
       ('c',Alphabet 'b',"x"),
       ('c',Alphabet 'c',"c"),
       ('x',Alphabet 'a',"x"),
       ('x',Alphabet 'b',"x"),
       ('x',Alphabet 'c',"x")
      ]