即席Brainf**k

若手の会の夜の宴会で、1時間くらいで書き上げたBrainf**kインタプリタ。インタプリタといっても、各演算子に対応する関数を定義して（30分）、PEGパーサジェネレータで文法を定義して、ソースコードをSchemeの命令列にコンパイル（30分）しただけ。Brainf**kのような単純な言語の場合、パーサジェネレータ自体がコンパイラになってしまいます。

http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3aBrainfuckにあるインタプリタと実行速度を比較してみるとこんな感じ。

$ time gosh bfi.scm quine.bf > /dev/null

real    0m0.515s
user    0m0.468s
sys     0m0.012s
$ time gosh bfi.scm quine2.bf > /dev/null

real    0m5.477s
user    0m5.344s
sys     0m0.020s
$ time ./scmbf.scm quine.bf > /dev/null

real    0m1.662s
user    0m1.588s
sys     0m0.036s
$ time ./scmbf.scm quine2.bf > /dev/null

real    0m1.073s
user    0m1.020s
sys     0m0.016s

skimuさんの実装ではquine.bfよりquine2.bfのほうが遅くなっていますが、今回の実装(scmbf.scm)ではquine.bfのほうが遅いです。quine.bfは同じ命令がずらーっと長く書いてあるのに対して、quine2.bfはループ命令などでコンパクトにまとまっています。skimuさんの実装では、tokenizeされた文字を1つ1つ見ながら実行しているみたいなので、quine.bfのような単純な構造だと速度がでるのでしょう。scmbfでは、一度Brainf**kのソースコードをコンパイルするので、そこに時間がかかっているのではないかと思います。実行自体はほぼ一瞬でしょう。

#!/usr/bin/env gosh
;; -*- coding: utf-8 mode: scheme -*-

(use file.util)

(load "../peg-parser/peg-parser.scm")

(define *registers* (make-vector 10000 0))

(define *pointer* 0)

(define *in* (standard-input-port))

(define (bf-incptr) (set! *pointer* (+ 1 *pointer*)))

(define (bf-decptr) (set! *pointer* (- *pointer* 1)))

(define (bf-incval)
  (let1 val (vector-ref *registers* *pointer*)
    (vector-set! *registers* *pointer*
		 (if (= val 255) 0 (+ 1 val)))))

(define (bf-decval)
  (let1 val (vector-ref *registers* *pointer*)
    (vector-set! *registers* *pointer*
		 (if (= val 0) 255 (- val 1)))))

(define (bf-put)
  (write-char (integer->char (vector-ref *registers* *pointer*))))

(define (bf-get)
  (vector-set! *registers* *pointer*
	       (let1 c (char->integer (read-char *in*))
		 (if (eof-object? c) 0 c))))

(define-macro (bf-loop . insts)
  `(while (not (= 0 (vector-ref *registers* *pointer*))) ,@insts))

(define (main args)
  (guard
      (err ((<unhandled-signal-error> err) #t)
	   (else (error "UNKNOWN ERROR")))
    (eval
     (cons
      'begin
      (parse-string-with
       ((Insts <- Spaces (inst Inst) Spaces (insts Insts) Spaces
	       :return (cons inst insts)
	       / Spaces (inst Inst) Spaces :return  `(,inst))
	(Inst <- #\[ (insts Insts) #\] :return `(bf-loop ,@insts)
	      / #\> :return '(bf-incptr)
	      / #\< :return '(bf-decptr)
	      / #\+ :return '(bf-incval)
	      / #\- :return '(bf-decval)
	      / #\. :return '(bf-put)
	      / #\, :return '(bf-get))
	(Spaces <- #[^-+<>.,\[\]] *))
       (file->string (if (null? args)
			 (error "NO SOUCE FILE")
			 (cadr args)))))
     (interaction-environment)))
  0)