Brainf*ckインタプリタをつくりながら学ぶHaskell（第一回：ごりごり編）

HaskellでBrainf*ckのインタプリタを作って行きます。
Brainf*ckについてはwikipedia参照です。

第一回は実直に文字を1文字づつ読み込みながら実行していくものを実装してみましょう。
今回はIO以外のモナドの力を使わずにごりごり実装していきます。

• 第一回：ごりごり編←いまここ
• 第二回：Stateモナド編
• 第三回：パーサコンビネータ編
• 最終回：Operationalモナド編

メモリとは

type Memory = ([Char],Char,[Char])

initMemory :: Memory
initMemory = ([],toEnum 0,[])

メモリ空間は現在の番地と前後のメモリ空間を配列で定義します。
メモリはIntとかの数値型で定義してもいいんですけど、今回はCharで定義します。

初期値(initMemory)では、前後のメモリ空間を空の配列としておき、必要になってからメモリ空間を拡張していきます。
現在値(toEnum 0)は0で初期化します。
toEnumはEnumクラスで提供される函数です。
今回の場合はIntをCharに変換します。逆はfromEnumです。

class Enum a where
  succ :: a -> a
  pred :: a -> a
  toEnum :: Int -> a
  fromEnum :: a -> Int
  enumFrom :: a -> [a]
  enumFromThen :: a -> a -> [a]
  enumFromTo :: a -> a -> [a]
  enumFromThenTo :: a -> a -> a -> [a]

インタプリタとは

interpreter :: String -> Memory -> IO Memory

インタプリタはコード(文字)とメモリを受け取って、IO処理をするものとして定義します。
初期のメモリ値を受け取って、処理後のメモリ値を返します。

終了条件

interpreter [] mem = return mem

コードが終わったらその時点のメモリを返却します。

値のインクリメントとデクリメント

interpreter ('+':s) (l,m,r) = interpreter s (l,succ m,r)
interpreter ('-':s) (l,m,r) = interpreter s (l,pred m,r)

succとpredはEnumクラスで提供される函数です。
次へと前へです。

ポインタのインクリメントとデクリメント

interpreter ('>':s) (l,m,r) = interpreter s $
  if null l
    then (    [], toEnum 0, m:r)
    else (tail l,   head l, m:r)
interpreter ('<':s) (l,m,r) = interpreter s $
  if null r
    then (m:l, toEnum 0,     [])
    else (m:l,   head r, tail r)

以下'>'側での説明
現在値を右側の配列の先頭に追加します。
左側の配列が空なら、現在値に0を設定します。左側は空のままです。
左側の配列が空でないなら、現在地に先頭の要素を設定します。
左側は先頭を取り除いた残りの要素が設定されます。
こうすることでメモリ空間にあたる配列が必要に応じて拡張されていきます。

出力と入力

interpreter ('.':s) (l,m,r) = putChar m >> interpreter s (l,m,r)
interpreter (',':s) (l,_,r) = getChar >>= \c -> interpreter s (l,c,r)

メモリをChar型で定義したので、
出力はメモリの現在値を出力するだけ。入力は現在値を入力値で置き換えるだけです。

ループ

getLoopString :: String -> String -> (String,String)
getLoopString t (']':xs) = (t,xs)
getLoopString t ('[':xs) = getLoopString (t++"[" ++ w ++ "]") xs' where
    (w,xs') = getLoopString "" xs
getLoopString t (c:xs)   = getLoopString (t++[c]) xs
-- 閉じ括弧の前にコードが終了した場合はエラー
getLoopString _ []       = fail "Unexpected end of script"

まずは"["から対応する"]"までの文字列を切り取る函数getLoopStringを定義します。
第一引数はループ内の文字を保存しておく用です。
返り値は(括弧内の文字列,括弧以降の文字列)です。
閉じ括弧の前にコードが終了した場合はエラーとします。

interpreter ('[':s) mem = loop mem >>= \mem' -> interpreter s' mem'
  where
    -- 先程のgetLoopStringでループ対象の文字列を取得します。
    (cLoop,s') = getLoopString "" s

    -- 内部函数です。
    -- 現在値が0になるまでループ対象の文字列をインタプリタに実行させて、変化後のメモリでまたループします。
    loop :: Memory -> IO Memory
    loop memory@(_,m,_)
      | m == toEnum 0 = return memory
      | otherwise     = interpreter cLoop memory >>= \memory' -> loop memory'

コメント

interpreter (_:s) mem = interpreter s mem

規定の文字以外はスキップします。

まとめ

type Memory = ([Char],Char,[Char])

initMemory :: Memory
initMemory = ([],toEnum 0,[])

interpreter :: String -> Memory -> IO Memory
interpreter [] mem = return mem
interpreter ('+':s) (l,m,r) = interpreter s (l,succ m,r)
interpreter ('-':s) (l,m,r) = interpreter s (l,pred m,r)
interpreter ('>':s) (l,m,r) = interpreter s $
  if null l
    then ([],toEnum 0,m:r)
    else (tail l,head l,m:r)
interpreter ('<':s) (l,m,r) = interpreter s $
  if null r
    then (m:l,toEnum 0,[])
    else (m:l,head r,tail r)
interpreter ('.':s) (l,m,r) = putChar m >> interpreter s (l,m,r)
interpreter (',':s) (l,_,r) = getChar >>= \c -> interpreter s (l,c,r)
interpreter ('[':s) mem = loop mem >>= \mem' -> interpreter s' mem'
  where
    (cLoop,s') = getLoopString "" s
    loop :: Memory -> IO Memory
    loop memory@(_,m,_)
      | m == toEnum 0 = return memory
      | otherwise     = interpreter cLoop memory >>= \memory' -> loop memory'
interpreter (_:s) mem = interpreter s mem

getLoopString :: String -> String -> (String,String)
getLoopString t (']':xs) = (t,xs)
getLoopString t ('[':xs) = getLoopString (t++"[" ++ w ++ "]") xs' where
    (w,xs') = getLoopString "" xs
getLoopString t (c:xs)   = getLoopString (t++[c]) xs
getLoopString _ []       = fail "Unexpected end of script"

Hello, world

> interpreter "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+." initMemory
< Hello, world!

ちゃんと実行できました。

次回予告

今回は、泥臭い感じのコードで実装してみました。
結構長いコードになりましたが、他の言語で書いた場合と比べると結構短いかもしれません。
メモリの扱い方なんかはHaskellらしさが出てると思います。

次回は、文字列をBrainf*ck用のデータ構造（中間言語）に置き換えてから実行する形に書き直して見たいと思います。

まて次回。

第一回の続き(/=第二回）

第二回にしようと思いましたがあんまり書くことがなかったので
ここに追記します。

BF型

せっかく強力な型システムがあるので、BF型をつくります。

data BF = Inc | Dec | LShift | RShift | PutC | GetC | Loop [BF] deriving (Show,Eq)

ただの文字列をBF型に置換します。

parseBF :: String -> [BF]
parseBF [] = []
parseBF ('+':s) = Inc : parseBF s
parseBF ('-':s) = Dec : parseBF s
parseBF ('>':s) = RShift : parseBF s
parseBF ('<':s) = LShift : parseBF s
parseBF ('.':s) = PutC : parseBF s
parseBF (',':s) = GetC : parseBF s
parseBF ('[':s) = Loop (parseBF cLoop) : parseBF s' where (cLoop,s') = getLoopString "" s -- 前回のgetLoopStringはそのまま
parseBF (_:s) = parseBF s

インタプリタを実装し直します。
といっても文字列がBF型の配列になっただけ。

interpreter :: [BF] -> Memory -> IO Memory
interpreter [] mem = return mem
interpreter (Inc:s) (l,m,r) = interpreter s (l,succ m,r)
interpreter (Dec:s) (l,m,r) = interpreter s (l,pred m,r)
interpreter (RShift:s) ([],m,r) = interpreter s (    [],toEnum 0,m:r)
interpreter (RShift:s) ( l,m,r) = interpreter s (tail l,  head l,m:r)
interpreter (LShift:s) (l,m,[]) = interpreter s (m:l,toEnum 0,    [])
interpreter (LShift:s) (l,m, r) = interpreter s (m:l,  head r,tail r)
interpreter (PutC:s) (l,m,r) = putChar m >> interpreter s (l,m,r)
interpreter (GetC:s) (l,_,r) = getChar >>= \c -> interpreter s (l,c,r)
interpreter (Loop _ :s) (l,m,r) | m == toEnum 0 = interpreter s (l,m,r)
interpreter (Loop code :s) mem = interpreter s mem >>= \mem' -> interpreter (Loop code:s) mem'

> parseBF "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+."
< [Inc,Inc,Inc,Inc,Inc,Inc,Inc,Inc,Inc,Loop [RShift,Inc,Inc,Inc,Inc,Inc,Inc,Inc,Inc,RShift,Inc,Inc,Inc,Inc,Inc,Inc,Inc,Inc,Inc,Inc,Inc,RShift,Inc,Inc,Inc,Inc,Inc,LShift,LShift,LShift,Dec],RShift,PutC,RShift,Inc,Inc,PutC,Inc,Inc,Inc,Inc,Inc,Inc,Inc,PutC,PutC,Inc,Inc,Inc,PutC,RShift,Dec,PutC,Dec,Dec,Dec,Dec,Dec,Dec,Dec,Dec,Dec,Dec,Dec,Dec,PutC,LShift,Inc,Inc,Inc,Inc,Inc,Inc,Inc,Inc,PutC,Dec,Dec,Dec,Dec,Dec,Dec,Dec,Dec,PutC,Inc,Inc,Inc,PutC,Dec,Dec,Dec,Dec,Dec,Dec,PutC,Dec,Dec,Dec,Dec,Dec,Dec,Dec,Dec,PutC,RShift,Inc,PutC]

> (interpreter . parseBF) "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+." initMemory
< Hello, world!

文字列をBF型に変換したことで、ループ処理において文字の取り出しと実行部分がわかれて多少スッキリした？
次回はStateモナドなどのチカラを使ってさらに書き直していきたいと思います。

つづき

第二回投稿しました。