Haskell でオートマトン(2)

オートマトンの続き。先に書いた例は簡潔だけど、状態遷移関数に相当するものがパターンマッチの中に埋め込まれている。このままでは、オートマトンを新しく定義するためには Eval が必要になる、ように思える。Eval を使うのはたぶん良くない。
しばらく考えて遷移をデータ型にしてみることにした。

module Fa where
import System.Environment

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

data Transition = Transition State Symbol [State] deriving (Show, Eq)

-- Dfa Alphabet States Start Accept Transition
data Dfa = Dfa Alphabet [State] State [State] [Transition] deriving (Show, Eq)

transit' :: Transition -> State -> Symbol -> [State]
transit' (Transition (State s0) c0 ss) (State s1) c1 | (s0 == s1) && (c0 == c1) = ss
                                                     | otherwise = []

transit (Dfa cs states start accepts transition) s c =
    concat [ transit' x s c| x <- transition ]

dfa1 = Dfa "ab" [State "q0", State "q1"] (State "q0") [State "q1"] 
       [Transition (State "q0") 'a' [State "q1"],
        Transition (State "q0") 'b' [State "q0"],
        Transition (State "q1") 'a' [State "q0"],
        Transition (State "q1") 'b' [State "q1"]]

状態遷移は、 Transition 状態 文字 遷移する状態、のように定義される。ここでは広義の DFA とした。狭義の DFA では、どの状態も全ての文字に対して必ず一つの遷移する状態を持つが、広義の DFA は空を許す。

続く。