BrainfuckでHaskellのインタプリタを作った時の覚書です。
ちなみに著者であるわたしはHaskellを少し齧った程度です。
正直多分1週間もやってないので認識に対して誤りが含まれる可能性が多分に含まれる恐れがあります。

HaskellでBrainfuckのインタプリタ

そもそもHaskellって何

Haskellは関数型プログラミング言語です。
関数型プログラミング言語の特徴としてはなんといっても関数が数学的な関数のような性質を持つ点です。
この数学的な関数のような性質というのは写像などとも似ている点はありますがつまるところ、

a = b ⇒ f(a) = f(b)

です。
引数が等しい場合、戻り値も等しいというわけです。
これによりありがたい影響を得られるわけですが、今回は割愛します。

さて、これは逆に関数は状態を持って振る舞いを変えないとも言い換えられます。
これはチューリングマシーンを記述するために作られた言語に影響を受けた言語としてはなかなか辛いものです。
なぜならチューリングマシーンは状態を持つからです。

それでは、そんな関数型言語でどのようにしてBrainfuckのインタプリタを書いたのでしょうか。

ソースコード

まず初めに、ソースコードを載せます。

--文字を扱うためのおまじない
import Data.Char as Ch

--状態
data State = Normal | Rjump | Ljump deriving Eq

--tapeのtp番目の要素にfuncを適用する 
index (tape, tp) func= 
    (take tp tape) ++ [func(tape !! tp)] ++(drop (tp+1) tape)

--Brainfuckの'+'
inc n =
    mod (n+1) 256

--Brainfuckの'-'
dec n =
    mod (n+255) 256

--Brainfuckの','
gcr (tape, tp) ic =
    (take tp tape) ++ [Ch.ord(ic)] ++(drop (tp+1) tape)

--Brainfuckの'.'
pcr (tape, tp) os =
    os ++ [Ch.chr (tape!!tp)]

--インタプリタの本体
{-
bfif関数について考える。
インタプリタを動かす上で必要な情報
【引数】
- コードそのもの(String)
- コードの位置(Int)
- テープそのもの([Int])
- テープのポインタ(Int)
- 進行方向(Bool)
- レベル(Int)
- 入力文字(String)
- 出力文字(String)

【返り値】
- タプル
-}
bfif :: ((String, Int), ([Int], Int), (State, Int), (String, String)) -> String
bfif ((code, cp), (tape, tp), (st, level), (is, os)) =
    --状態によって場合わけ
    case st of
        Normal ->
            if
                --cpの値が参照位置を超えてないか否か
                cp >= (length code)
            then
                --結果を返す
                os
            else
                if
                    --ループに入りそうな時にどうにかしたいな。
                    code!!cp=='['||code!!cp==']'
                then
                    case code!!cp of
                        '[' ->
                            if
                                tape!!tp==0
                            then
                                bfif ((code, (cp+1)), (tape, tp), (Rjump, 1), (is, os))
                            else
                                bfif ((code, (cp+1)), (tape, tp), (Normal, 0), (is, os))
                        ']' -> bfif ((code, (cp-1)), (tape, tp), (Ljump, 1), (is, os))
                        _ -> "err"
                else
                    case (code!!cp) of
                        '>' -> bfif ((code, (cp+1)), (tape, (tp+1)), (st, 0), (is, os))
                        '<' -> bfif ((code, (cp+1)), (tape, (tp-1)), (st, 0), (is, os))
                        '+' -> bfif ((code, (cp+1)), ((index (tape, tp) inc), tp), (st, 0), (is, os))
                        '-' -> bfif ((code, (cp+1)), ((index (tape, tp) dec), tp), (st, 0), (is, os))
                        '.' -> bfif ((code, (cp+1)), (tape, tp), (st, 0), (is, (pcr (tape, tp) os)))
                        ',' -> bfif ((code, (cp+1)), ((gcr (tape, tp) (head is)), tp), (st, 0), (tail is, os))
                        _ -> bfif ((code, (cp+1)), (tape, tp), (st, 0), (is, os))
        Rjump ->
            if
                cp >= (length code)
            then
                "err"
            else
                case code!!cp of
                    '[' -> bfif ((code, (cp+1)), (tape, tp), (st, level+1), (is, os))
                    ']' ->
                        if
                            level==1
                        then
                            bfif ((code, (cp+1)), (tape, tp), (Normal, 0), (is, os))
                        else
                            bfif ((code, (cp+1)), (tape, tp), (st, level-1), (is, os))
                    _ -> bfif ((code, (cp+1)), (tape, tp), (st, level), (is, os))
        Ljump ->
            if
                cp<0
            then
                "err"
            else
                case code!!cp of
                    '[' -> 
                        if
                            level==1
                        then
                            bfif ((code, cp), (tape, tp), (Normal, 0), (is, os))
                        else
                            bfif ((code, (cp-1)), (tape, tp), (st, level-1), (is, os))
                    ']' -> bfif ((code, (cp-1)), (tape, tp), (st, level+1), (is, os))
                    _ -> bfif ((code, (cp-1)), (tape, tp), (st, level), (is, os))

bfi code is =
    bfif ((code, 0), ([0,0..], 0), (Normal, 0), (is, ""))

main :: IO ()
main = do
    --codeを入力
    --getstr <- getLine
    putStrLn "code"
    code <- getLine
    putStrLn "\ninput"
    is <- getLine
    let os = bfi code is
    putStrLn "\noutput"
    putStrLn $ os++"\n"

基本的な設計思想は再帰でループをしつつ、インタプリタが終了したと考えられたらその結果を引数を渡していくというものです。

とりあえずmainでインタプリタで解釈するコード、そしてあらかじめ標準入力を受け取っておきます。
そして出力もここでまとめて行います。

それに対してbfifという関数がインタープリタの本体です。
bfifの構造ですが、標準状態でインタプリタがソースコードの範囲を超えたら結果を返します。
bfifはこのような関数です。

bfif :: ((String, Int), ([Int], Int), (State, Int), (String, String)) -> String
bfif ((code, cp), (tape, tp), (st, level), (is, os)) =

これを簡単に説明するとBrainfuckに必要なデータをタプルという形式で一つの変数に詰め込んで、
その中にはソースコードに関する(code, cp)、配列に関する(tape, tp)、[と]などループを行うために使う(st, level)、入出力に関する(is, os)があります。

(code, cp)と(tape, tp)に関してはそれほど説明する点もなく、Haskellの配列と配列の位置を指し示すindexの値の組です。

(st, level)は[や]などのジャンプに関する制御で、stがRjumpまたはLjumpの時、その状態に応じてcpの値を増減させます。
levelは相対的なネストの深さです。

(is, os)は入出力に関するもので、isが入力された文字列、osが出力される文字列です。

それ以外の普通の文字では適当な動作が行われます。

それでは具体的にはどのような処理が行われているのでしょうか
例えば+では

'+' -> bfif ((code, (cp+1)), ((index (tape, tp) inc), tp), (st, 0), (is, os))

となっており、これはcpという現在Brainfuckのコードのどこを読んでいるのかという値を1加算し、インタプリタの配列tapeのポインタtpが指し示す値にincという関数を適用しています。他の命令もほとんど変わりはありません。

このように関数型言語でbrainfuckのインタプリタを作る場合は状態を引数として渡し、それが1回関数を通過するごとに変化した状態を引数として再度関数を呼び出す。

そして返り値はosであり、これは出力される文字列です。

このBrainfuckのインタプリタは、Brainfuckのコードを表す文字列のcodeと標準入力で入力された文字列isのみで出力が決まる関数であると見なすわけです。