Haskellでチューリングマシン(4) 命令の実行処理を作成

前回、テープの走査をモナドに包む時に、テープの値と一緒に、「ヘッドのステータス」を状態として保持できるようにしました。
この値は単なるInt型として実装したのですが、明確なアイデンティティを与えるため、HeadStateという別名を付けました。

--ヘッドが保持するステータス
type HeadStatus = Int

--ヘッドの状態 (テープ、ステータス)
data MachineState = MachineState { msTape :: Tape, msState :: HeadStatus } deriving Show

伴って、関連する関数等の表記もこの型名に統一されています。

さて、前回までは主にテープと、それを読み取るヘッドの動作を実装していきましたが、ここからは実際にチューリングマシンがプログラムを実行できるようにしていきます。

チューリングマシンのプログラムが実行される様子はチューリングマシンの原理に詳しく書かれているのですが、要点を纏めると、五つのパラメータを持ったいくつかの命令があり、現在のヘッドの状態とヘッドが指し示すテープの値を条件として、該当する命令があればそれを実行し、その結果の状態を条件として次に実行すべき命令を検索します。また、条件に当てはまる命令が無い場合は処理を停止します。

---

チューリングマシンのプログラムの命令の、五つのパラーメータは、大きくわけて「検索条件」と「実行内容」の二種類に分けられます。

• 検索条件
  • ステータス
  • テープの値
• 実行内容
  • 新しいステータス
  • テープに書き込む値
  • ヘッドの移動方向

なのでまず、これを元に、命令を表すOrder型を作ります。

--命令
data Order = Order {
  --走査条件
  ordState :: HeadStatus, --現在のステータス
  ordHeadValue :: TapeValue, --現在ヘッドの位置にある値
  --実行処理
  ordWriteValue :: TapeValue, --新しく書きこむ値
  ordNewState :: Int, --新しく書きこむステータス
  ordDirection :: Direction --評価後のヘッドの移動方向
  } deriving (Show,Eq)

ヘッドの移動方向は、Machineモナドに合わせて「前方 Forward」「後方 Front」とします（一般的にはLeft、Rightが使われてるのを後になって知ったのですが、今回はこのまま勧める事にしました。）

--ヘッドの移動方向
data Direction = Front | Forward deriving (Show,Eq)

---

次に、実際にこれを実行するexecMachineProgram関数を考えます。
テープの読み書きや、ステータスの状態を読み書きする関数は既に前回実装してありますので、これらを組み合わせれば良さそうです。
Machineモナド内で扱う関数なので、型は必然的に「a -> Machine b」になる事が想像できます。a については当然、複数の命令を受け取りたいので [Order] とすれば良いでしょう。

続いて、戻り値の b についてです。
前述の通り、検索条件に該当する命令が無い場合、何も処理できないので、プログラムは停止しますが、この関数は所謂「ステップ実行」なので、プログラムが停止したかどうかを戻り値として返す必要があります、この「停止したかどうか」というフラグのため、ProcessStateという代数データ型を新たに定義して、これを戻り値としましょう。

--プログラムの停止状況
data ProcessState = Finished | Running deriving (Show,Eq)

つまり、execMachineProgramの型は「execMachineProgram :: [Order] -> Machine ProcessState 」となります。
以下が実際のコードです。

--現在の状況にマッチした命令を検索し、実行する
execMachineProgram :: [Order] -> Machine ProcessState 
execMachineProgram orderList = do
  state <- readState
  tapev <- readTape
  findedOrder <- return (ordFind state tapev)
  --該当無し Finishedを返す
  if findedOrder == Nothing then return Finished 
    --命令を処理し、Runningを返す
    else do
      order <- return (fromJust findedOrder)
      --実行
      writeTape (ordWriteValue order)
      writeState (ordNewState order)
      moveDirection (ordDirection order)
      return Running

  where
    --命令のリストから検索条件にマッチする命令を検索する
    ordFind :: HeadStatus -> TapeValue -> Maybe Order
    ordFind state val = let
      findedList = filter (\ord -> ordState ord == state && ordHeadValue ord == val) orderList
      in if findedList == [] then Nothing
         else Just (head findedList)

    --Directionの値に応じてテープ移動
    moveDirection :: Direction -> Machine ()
    moveDirection d | d == Front = moveFront
                    | d == Forward = moveForward

今までこのブログで書いてきたHaskellの関数の中では特に大きな物になってますが、今まで作ったモナド関数を、do構文を使って手続き的に組み合わせているだけなので、順に追っていけば単純です。
全体の流れとしては先ほど説明した通り、「現在のモナドの状態」を元に命令を、「Maybe Order」を返すordFind関数で検索し、該当する命令が無ければ（戻り値がNothingなら）、Finishedを返却、一致する命令があればその命令から一つ取り出し、テープの値やステータスを書き換えた後、前方または後方に移動し、Runnningを返却するという流れになっています。

---

ここで定義した関数やデータ型をOrderというモジュール名でエクスポートしました。プログラム全体については興味のある既得な人だけgithubを参照して頂く事として、動作を確認してみましょう。

次の例は、テープの値に0が続いている間、前方（右方向）に向かって只管1で埋めていき、1を見つけたらそれを0に書き換えて停止するものです。

module Main where
import Control.Monad(replicateM_)
import Order
  
--右方向に向かって、最初の1が見つかるまで1で埋めるシンプルなプログラム
program = [
  Order 0 T0 T1 0 Forward,
  Order 0 T1 T0 1 Front ]

--execMachineProgram関数がFinishedを返却するまで処理を繰り返す
runProgram = do
  res <- execMachineProgram program
  if res == Finished then return ()
    else runProgram

--テープを初期化する
makeInitTape = do
  replicateM_ 10 moveForward 
  writeTape T1
  replicateM_ 10 moveFront 
  
--テストプログラム実行
test = do
  makeInitTape --初期化
  runProgram --実行

--動作テスト
main = do
  putStrLn.show $ startMachine makeInitTape --初期状態
  putStrLn.show $ startMachine test --プログラム実行結果 

実行結果：

$ runghc Main.hs
|0| 0 0 0 0 0 0 0 0 0 1 
1 1 1 1 1 1 1 1 1 |1| 0 

実際にプログラムを実行しているのは、runProgram関数内部です。
出力上段の状態に初期化した後、execMachineProgram関数にOrder型のリスト（ここではprogramという変数名）を渡し、戻り値がFinishedになるまで再帰処理で繰り返し呼び出しています。

この関数はOrderモジュール内に実装しても良かったのですが、後々の事を考えて今は直接Mainモジュールに記述しています。

具体的な内部動作については、前半で提示したチューリングマシンに関するリンク先を参照してください。（これと同様のプログラムについて詳しい説明があります）

---

次は、簡単な足し算をやってみましょう。
といっても、二進数の足し算みたいな複雑なものでは無く「110111」という入力を2+3と見なして、「111110」に書き換えるようなプログラムです。

module Main where
import Control.Monad(replicateM_)
import Order 

--単純な足し算プログラム
program = [
  Order 0 T0 T0 0 Front,
  Order 0 T1 T0 1 Front,
  Order 1 T1 T1 1 Front,
  Order 1 T0 T1 2 Front, 
  Order 2 T1 T1 2 Front,
  Order 2 T0 T0 3 Front]

--execMachineProgram関数がFinishedを返却するまで処理を繰り返す
runProgram = do
  res <- execMachineProgram program
  if res == Finished then return ()
    else runProgram

--テープを初期化する
makeInitTape = do
  replicateM_ 4 (writeTape T1 >> moveForward)
  moveForward
  replicateM_ 6 (writeTape T1 >> moveForward)
  
--テストプログラム実行
test = do
  makeInitTape --初期化
  runProgram --実行
  
--動作テスト
main = do
  putStrLn.show $ startMachine makeInitTape --初期状態
  putStrLn.show $ startMachine test --プログラム実行結果 

実行結果：

$ runghc Main.hs
1 1 1 1 0 1 1 1 1 1 1 |0| 
|0| 0 1 1 1 1 1 1 1 1 1 1 0 0 

ちょっと分かりづらいですが、上の行（初期状態）が4+6の入力を表し、実際にrunProgram関数を適用した結果（下段）を見ると、1が10回続いているのが確認できると思います。

---

これで、チューリングマシン本体の大元となる処理は完成しました。

今後はこれをリファクタリングしつつ、もっと使いやすくしていく事を考えます。

具体的には、テープの初期化やチューリングマシンの命令リストの作成を、コマンド入力やファイル読み込みでできるようにしたり、途中経過を出力しながらステップ実行したり、という事を検討しています・・・が、その前に、モジュールの構成等を整えたほうが良いですね、次回はこれでいきましょう。