入出力用のストリーム作成

例えば出力だけ考えてみると、まず考えられるのは単純に、 logで出力することである。しかしlog以外の選択肢も考えられる。 logでコンソール出力するだけでなく、Webページのテキスト上で出力したり、テキストファイルに吐き出したりできるような汎用性が持たせられると良い。

そこで今回は、いわゆる「ストリームオブジェクト」のようなものを作って、そこから入出力を行うような設計にしてみる。

Streamの作成

src/Brainfuck/Interp/Stream.pursを作成。この後使うモジュールをインポート。

1
2
3
4
5

module Brainfuck.Interp.Stream where

import Prelude

import Brainfuck.Interp (Interp)

Stream型を作成する。これは入出力を束ねた型になっている。 inputは、外部からの入力を1文字受け取る。 outputは、Charの値を外部に出力する。

1
2
3
4

newtype Stream = Stream
  { input :: Interp Char
  , output ::Char -> Interp Unit
  }

Streamを通じてデータを読み書きする関数を作成。

1
2
3
4
5
6
7

read :: Stream -> Interp Char
read (Stream { input }) = input


write :: Char -> Stream -> Interp Unit
write c (Stream { output }) =
  output c

1
2
3
4
5
6

defaultStream :: Stream
defaultStream = Stream { input, output }
  where
    input = pure 'N' -- Not Implemented

    output _ = pure unit -- Not Implemented

‘.‘と’,’

src/Brainfuck/Interp/Command.pursを修正する。まず以下のインポート文を追加。

1
2
3

import Brainfuck.Interp.Util (readCharOrFail)
import Brainfuck.Interp.Stream (write, read, Stream)
import Data.Char (toCharCode) as Char

StreamはEnvのレコードのフィールドとして扱いたいところだが、 それをやるとBrainfuck.Interp.Stream、Brainfuck.Env、Brainfuck.Interpとでcircular importとなってしまう。 仕方ないのでinterpCommandの引数で扱うことにする。

interpCommandの引数を追加し、.命令と,命令を実装する。 inputやoutputの実装はinterpCommandの管轄外であり、 とにかく「inputは1文字返してくれて、outputは1文字送ってくれる」という気持ちを持って実装する。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

interpCommand :: Stream -> Command -> Interp Unit
interpCommand stream =
  case _ of
    -- ... 略 ...

     Output -> do
       c <- readCharOrFail
       write c stream

     Input -> do
       x <- read stream
       modifyDataOrFail (\_ -> Char.toCharCode x)

    -- ... 略 ...

Brainfuckの修正

src/Brainfuck.pursを修正する。以下のモジュールを追加でインポートしておく。

1

import Brainfuck.Interp.Stream (Stream, defaultStream)

interpCommandの修正に伴い、interpProgramを修正。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

interpProgram :: Stream -> Interp Unit
interpProgram stream = do
  -- ... 略 ...
  case readCommand program state of
    Just cmd -> do
      interpCommand stream cmd -- 引数を追加

      incInstPtr
      interpProgram stream -- 引数を追加
  -- ... 略 ...

Streamを引数にとるバージョンのrunを定義。 それを用いてrunDefaultを書き直す。

1
2
3
4
5
6
7

run :: Stream -> Program -> Effect (InterpResult Unit)
run stream program =
  runInterp (interpProgram stream) (makeEnv program) defaultState


runDefault :: Program -> Effect (InterpResult Unit)
runDefault program = run defaultStream program

コンソール出力

出力ストリームの実装

src/Brainfuck/Interp/Stream.pursのdefaultStreamにおいて、outputをlogで実装してみる。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11

-- import文追加
import Effect.Class (liftEffect)
import Effect.Console (log)


defaultStream :: Stream
defaultStream = Stream { input, output }
  where
    input = pure 'N' -- Not Implemented

    output c = liftEffect $ log $ show c

これでようやくHello, Worldが出力できる。Wikipediaにあるコードを借りる。

> import Brainfuck.Interp.Stream
> runDefault $ fromString "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++."
'H'
'e'
'l'
'l'
'o'
' '
'W'
'o'
'r'
'l'
'd'
'!'
'\n'

{ result: (Right unit), state: { dptr: 6, iptr: 106, memory: [0,0,72,100,87,33,10,0,0,0] } }

出力先の変更

log関数の仕様上改行が入ってしまう。そもそもlogはデバッグ用のものであり、出力には適していない。 ではデバッグではない標準出力はあるのかとうと、それはNode.jsでいうprocess.stdout.writeに当たる(とはいえNode.jsは詳しくないので確かではないが…)。 それをラッピングしたものがpurescript-node-processに用意されているので、これを使うことにする。

該当パッケージをインストールする。

% spago install node-process node-buffer node-streams

src/Stream.pursにNode.js用のストリームを定義する。以下のパッケージをインポートしておく。

1
2
3
4

import Data.String.CodeUnits (singleton) as CodeUnits
import Node.Process (stdout)
import Node.Encoding (Encoding(UTF8))
import Node.Stream (writeString)

nodeStreamを定義。 writeStringは、どうやら内部でwritable.writeを呼び出している模様。 UTF8でエンコーディングを指定し、第4引数は出力後のコールバック関数のようだ。

1
2
3
4
5
6
7

nodeStream :: Stream
nodeStream = Stream { input, output }
  where
    input = pure 'N' -- Not Implemented

    output c =
      void $ liftEffect $ writeString stdout UTF8 (CodeUnits.singleton c) (pure unit)

REPLで確認してみると、無事改行無しの出力ができている。

> run nodeStream (fromString "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.")
Hello World!
{ result: (Right unit), state: { dptr: 6, iptr: 106, memory: [0,0,72,100,87,33,10,0,0,0] } }

修正: Interpの抽象化

入力を非同期処理で扱う必要があるため、全体の計算をAffで扱えると良い。 もっと一般的に、EffectでもAffでも使えるようにInterpを抽象化する (やってみたら想像以上に修正箇所が多く、大変だった…)。

Affを使いたいので、以下のパッケージをインストール。

% spago install aff

Interpの修正

src/Brainfuck/Interp.pursを修正。まず以下のインポート文を追加。

1

TODO

根本となるInterpの型を修正する。Interpに型変数mを持たせる。 Interp自身がモナド変換子になったような感じ。

1

newtype Interp m a = Interp (ReaderT Env (ExceptT Error (StateT State m)) a)

この時点でspago buildすると型エラーがたくさん出るはずなので、エラーメッセージに従って修正していけばよい。 以下、修正箇所を示すが、抜けがあるかもしれない。

runInterpの型を修正。

1

runInterp :: forall m a. Monad m => Interp m a -> Env -> State -> m (InterpResult a)

derive newtypeを修正。どのように修正すべきかは、StateTのinstanceを参考にする。 というのも、mの制約に直接影響するのはStateTだからだ。

1
2
3
4
5
6
7
8
9

derive newtype instance (Functor m) => Functor (Interp m)
derive newtype instance (Monad m) => Apply (Interp m)
derive newtype instance (Monad m) => Applicative (Interp m)
derive newtype instance (Monad m) => Bind (Interp m)
derive newtype instance (Monad m) => Monad (Interp m)
derive newtype instance (Monad m) => MonadState State (Interp m)
derive newtype instance (Monad m) => MonadAsk Env (Interp m)
derive newtype instance (Monad m) => MonadThrow Error (Interp m)
derive newtype instance (MonadEffect m) => MonadEffect (Interp m)

MonadAffのderive newtypeを追加。

1

derive newtype instance (MonadAff m) => MonadAff (Interp m)

Streamの修正

src/Brainfuck/Interp/Streamを修正。まず以下のimportを追加。

1
2

import Effect (Effect)
import Effect.Aff (Aff)

Streamに型変数mをつける。

1
2
3
4

newtype Stream m = Stream
  { input :: Interp m Char
  , output :: Char -> Interp m Unit
  }

それに合わせてread、writeを修正。 defaultStreamとnodeStreamのStream mには具体的なmを指定。

1
2
3
4
5
6
7

read :: forall m. Stream m -> Interp m Char

write :: forall m. Char -> Stream m -> Interp m Unit

defaultStream :: Stream Effect

nodeStream :: Stream Aff

Utilの修正

src/Brainfuck/Interp/Util.pursにおいて、全ての関数の引数を修正。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11

modifyDataOrFail ::  forall m. Monad m => (Int -> Int) -> Interp m Unit

readDataOrFail ::  forall m. Monad m => Interp m Int

readCharOrFail :: forall m. Monad m => Interp m Char

readCommandOrFail :: forall m. Monad m => Interp m Command

incInstPtr ::  forall m. Monad m => Interp m Unit

decInstPtr ::  forall m. Monad m => Interp m Unit

Commandの修正

src/Brainfuck/Interp/Command.pursを修正。こちらも全ての関数の引数を修正。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19

interpCommand :: forall m. Monad m => Stream m -> Command -> Interp m Unit

incDataPtr :: forall m. Monad m => Interp m Unit

decDataPtr :: forall m. Monad m => Interp m Unit

incData :: forall m. Monad m => Interp m Unit

decData :: forall m. Monad m => Interp m Unit

goToRBrace :: forall m. Monad m => Interp m Unit

goToLBrace :: forall m. Monad m => Interp m Unit

goToMate :: forall m. Monad m => Interp m Unit -> Interp m Unit
goToMate move = go 0
  where
    go :: Int -> Interp m Unit
    -- 略

Brainfuckの修正

src/Brainfuck.pursを修正。runDefault以外の関数の型を修正。

1
2
3

run :: forall m. Monad m => Stream m -> Program -> m (InterpResult Unit)

interpProgram :: forall m. Monad m => Stream m -> Interp m Unit

これでspago buildするとエラーが無くなるはず。

(補足) AffはShowクラスのインスタンスではないので、REPLで出力を試したいならlaunchAff_を利用する。

> launchAff_ $ run nodeStream (fromString "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.")
Hello World!

しかし残念ながらInterpResult Unitは出力されない。もし出力したいのであれば、logとかをつかって出力する関数を新たに作る必要がある。

1
2
3
4
5
6
7
8
9

-- 以下のimportを追加
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Console (log)


runWithLog :: forall m. MonadEffect m => Stream m -> Program -> m Unit
runWithLog stream program = do
  res <- run stream program
  liftEffect $ log $ ("\n" <> show res)

> launchAff_ $ runWithLog nodeStream (fromString "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.")
Hello World!

{ result: (Right unit), state: { dptr: 6, iptr: 106, memory: [0,0,72,100,87,33,10,0,0,0] } }

コンソール入力

2つの方法が考えられる。

  • stdinから readStringを使って文字列を読み取る。 ただし標準入力にデータが来ているかどうかをonReadable で待つ必要がある。onReadableにてコールバック関数を指定する。
  • node-readlineパッケージを利用。 プロンプトを表示して入力を促すだけならquestion関数が使いやすいと思う。 questionにてコールバック関数を指定する。

いずれにせよ、affパッケージのmakeAffを使い、 コールバック処理をAffに変換する必要がある (後者について、node-readline-affというパッケージがあるようだが、現時点では古いようで利用できない)。

2種類の方法を試みたが、個人的に後者のほうが分かりやすかったのでそちらを紹介する。

該当パッケージをインストール。

% spago install node-readline exceptions

src/Stream.pursを修正。該当モジュールをインポート。

1
2
3
4
5
6
7
8
9

import Brainfuck.Error (Error(..))
import Control.Monad.Error.Class (throwError)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.String.CodeUnits (take, toChar) as CodeUnits
import Effect.Exception (Error) as E
import Effect.Aff.Class (liftAff)
import Effect.Aff (Canceler, nonCanceler, makeAff)
import Node.ReadLine (createConsoleInterface, noCompletion, close, question, Interface) as RL

inputを実装する。interfaceを作って、questionAff(これから実装する関数)を使って入力を促し、文字列を取得。 closeでinterfaceを閉じる。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16

nodeStream :: Stream Aff
nodeStream = Stream { input, output }
  where
    input = do 
      interface <- liftEffect $ RL.createConsoleInterface RL.noCompletion
      s <- liftAff $ questionAff "input> " interface
      liftEffect $ RL.close interface
      case CodeUnits.toChar $ CodeUnits.take 1 s of
        Just c ->
          pure c

        Nothing ->
          throwError CharInputFailed

    output c =
      void $ liftEffect $ writeString stdout UTF8 (CodeUnits.singleton c) (pure unit)

questionAffはquestion関数をAff用にラッピングしたもの。

1
2
3
4
5
6
7

questionAff :: String -> RL.Interface -> Aff String
questionAff q interface = makeAff go
  where
    go :: (Either E.Error String -> Effect Unit) -> Effect Canceler
    go handler = do
      RL.question q (handler <<< Right) interface
      pure nonCanceler

makeAffは、

1

  onSomeEvent (\x -> callback x)

というように、コールバック関数を引数にとる関数onSomeEventを

1
2

  x <- onSomeEventAff
  callback

みたいに使う関数onSomeEventAffに変換するために用いるようだ。

handlerはStringではなくEither Error Stringを持っている。 今回エラーが起こることはないので、コード中では(handler <<< Right)のように無理矢理Rightをくっつけている (<<<演算子を使っているが、これは(\s -> handler $ Right s)と同義)。

Cancelerというのは非同期処理中にキャンセルが起こった場合に呼ばれる関数の模様(参考)。 まだその用途がいまいちよく分かっていないのだが、とりあえずnonCancelerを指定しておいた。

入力の確認

試したところ、REPLでは動作確認できない模様 (入力待ちになってくれない)。なのでsrc/Main.pursに動作確認用のコードを書く。

3文字の入力を促して、アルファベットを1ずらして出力するBrainfuckプログラムを書いてみる。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

module Main where

import Prelude

import Brainfuck (runWithLog) as B
import Brainfuck.Interp.Stream (nodeStream) as BIS
import Brainfuck.Program (fromString) as BP
import Effect (Effect)
import Effect.Aff (launchAff_)

main :: Effect Unit
main =
  launchAff_ $ B.runWithLog BIS.nodeStream (BP.fromString ",>,>,<<+.>+.>+.")

spago runで実行してみる。

% spago run
input> a
input> b
input> c
bcd
{ result: (Right unit), state: { dptr: 2, iptr: 15, memory: [98,99,100,0,0,0,0,0,0,0] } }

ちゃんとbcdが出力されている。

次回

CUIで可視化することを考える。Brainfuckのインタプリタが各ステップにおいて、どの命令を指しているのか、どこのメモリを指しているのかを可視化してみる。