Haskellでチューリングマシン(1) 無限の長さのテープを作る - capriccioso String Creating(Object something){ return My.Expression(something); }

そろそろ簡単なテストコードを書き連ねるより、それなりの規模のものを一つ作ってみるのが良いと思ったので、タイトルの通り、チューリングマシンのエミュレーターを作ってみる事にしました。

Haskellもまだそんなに使いこなせてないうえに、チューリングマシンについても、あまりしっかりとは知らないので、色々と不安な部分はあるのですが、ゆっくり進めてみようと思います。

まず最初に「無限の長さを持つテープ」を作る事を考えます。はじめのうちは

data Tape a = Tape [a] [a]

のようなデータ型を定義し、任意のインデックスの値を読み書きできる仕組みをイメージしていたのですが、そもそもチューニングマシンのテープへは「ヘッドを右に移動する」「ヘッドを左に移動する」「ヘッドの位置に0か1の値を書き込む」の三種類の操作だけできれば良いわけなので、最終的に次のような形に落ち着きました。

module Tape where

--テープの値は 0 または 1
data TapeValue = T0 | T1 deriving Eq
instance Show TapeValue where
  show T0 = "0"
  show T1 = "1"

initTape = Tape [] [T0]

--無限長の長さを持つテープ
data Tape = Tape [TapeValue] [TapeValue] deriving Eq
instance Show Tape where
  show (Tape front forward) =
    toStr (reverse front) ++ "|" ++ show (head forward) ++ "| " ++ toStr (tail forward)
      where toStr l = concat $ map (\v -> show v ++ " ") l

--テープの移動
moveFront :: Tape -> Tape
moveFront (Tape [] forward) = Tape [] (T0 : forward)
moveFront (Tape front forward) = Tape (tail front) (head front : forward)

moveForward :: Tape -> Tape
moveForward (Tape front (position : [])) = Tape (position : front) [T0]
moveForward (Tape front forward) = Tape (head forward : front) (tail forward)

--書き込み
writeTape :: TapeValue -> Tape -> Tape
writeTape val (Tape front forward) = Tape front (val : tail forward)

headやtailの使い方等、あまり安全ではない書き方も含まれてはいるのですが、基本的にはテープのまっさらな状態を表すinitTape変数に対し

ヘッドを右に移動する moveForward
ヘッドを左に移動する moveFront
ヘッドの位置に値を書き込む writeTape

の三つの関数を使っているぶんには例外が発生する事は無いと思われます。

実行結果：

$ ghci tape.hs
GHCi, version 6.12.3: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
[1 of 1] Compiling Tape             ( tape.hs, interpreted )
Ok, modules loaded: Tape.
*Tape> initTape
|0| 
*Tape> moveFront it
|0| 0 
*Tape> moveFront it
|0| 0 0 
*Tape> writeTape T1 it
|1| 0 0 
*Tape> moveForward it
1 |0| 0 
*Tape> moveForward it
1 0 |0| 
*Tape> moveForward it
1 0 0 |0| 
*Tape> writeTape T1 it
1 0 0 |1| 
*Tape> moveForward it
1 0 0 1 |0| 
*Tape> writeTape T1 it
1 0 0 1 |1| 
*Tape> moveFront it
1 0 0 |1| 1 
*Tape> writeTape T0 it
1 0 0 |0| 1 
*Tape> moveFront it
1 0 |0| 0 1 
*Tape> writeTape T1 it
1 0 |1| 0 1

ちゃんとそれらしく動いているみたいですが、初期状態のテープの値は全部 0 で良かったんでしょうか・・・？
今後の目安として、大体ここまで１時間半くらいかかりました。