Haskell でオートマトン(6)

Dfa をさらに書き直してよりエレガント?にした。

• 状態遷移関数は結局、lookup するだけだった
• インスタンスを生成するための関数を追加した
• union をより簡潔に。

module Fa where
import qualified Test.HUnit as Test
-- import System.Environment

data State = State String | State2 (State, State) deriving (Eq, Show)
type Symbol = Char
type Alphabet = [Symbol]

-- Dfa states alphabet transition-function "start state" "accept states"
data Dfa = Dfa [State] Alphabet [((State, Symbol), State)] State [State] deriving (Show, Eq)

transitFa alist s0 c0 = case lookup (s0, c0) alist of
                          Just s -> s
                          Nothing -> error "Invalid transition."

makeDfa qs cs tr st as = if (checkStart && checkAccept && and (map checkTransit tr)) then
                             Dfa qs cs tr st as
                         else
                             error "Fail to makeDfa: Invalid data."
                         where
                           checkStart = (elem st qs)
                           checkAccept = all (\x -> elem x qs) as
                           checkTransit ((s, c), n) = and [elem s qs, elem c cs, elem n qs]

accept :: Dfa -> [Symbol] -> Bool

accept (Dfa qs cs tr st as) str = accept' st str
    where
      accept' s [] = elem s as
      accept' s (c:cs) = accept' (transitFa tr s c) cs

union :: Dfa -> Dfa -> Dfa
--union = undefined
union (Dfa qs1 c1 tr1 s1 as1) (Dfa qs2 c2 tr2 s2 as2) = Dfa states alphabet transit start accept 
    where
      states = [ State2 (r1, r2) | r1 <- qs1, r2 <- qs2 ]
      alphabet = c1 -- fixme
      start = State2 (s1, s2)
      accept = [ State2 (r1, r2) | r1 <- qs1, r2 <- qs2, (elem r1 as1) || (elem r2 as2)]
      transit = [ ((State2 (r1, r2), a),
                   State2 (transitFa tr1 r1 a, transitFa tr2 r2 a))
                  | r1 <- qs1, r2 <- qs2, a <- alphabet]