SchemeでBrainFuck その2

Programming Scheme BrainFuck

前回書いたBrainFuckインタプリタはかなりおそかった。与えられたbfコードをリストとして構築しなおしてから、さあ実行、とかやってたからだろうか。リストの扱いくらいしかわからなかったからそうなったのだが。
bfのコードはそのままstringとして扱った方が簡単でした。あと速かった。

http://www.shiro.dreamhost.com/scheme/wiliki/wiliki.cgi?Scheme%3ABrainfuck
で拾ってきたquineのコードによるベンチマーク。前回書いたやつと、今回書き換えたやつにて。コード内部に直接quineのコードをぶちこんで、bf-run。

% time gosh bfi-ls.scm >/dev/null

real    0m5.240s
user    0m5.220s
sys     0m0.030s
% time gosh bfi-str.scm >/dev/null

real    0m0.170s
user    0m0.140s
sys     0m0.030s

30倍の高速化に成功! とか言ったらかっこいいだろうか。よくはないな。元々の30倍も高速化できるほどの駄インタプリタ書いたの俺だし。

コマンドライン引数与えたbfファイルを処理できるようにしてみた。Gaucheで動くことは確認。

% gosh bfi.scm hello.b 
Hello World!
% cat hello.b 
>+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++[<++++>-]<.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------.[-]>++++++++[<++++>-]<+.[-]++++++++++.

以下ソース

(define (bf-run code)
  (define (bf-inc! mem mp) (vector-set! mem mp (+ (vector-ref mem mp) 1)) mem)
  (define (bf-dec! mem mp) (vector-set! mem mp (- (vector-ref mem mp) 1)) mem)
  (define (bf-put mem mp) (write-char (integer->char (vector-ref mem mp))) mem)
  (define (bf-get! mem mp) (vector-set! mem mp (char->integer (read-char))) mem)
  (define (bf-mem? mem mp) (if (= (vector-ref mem mp) 0) #f #t))
  (define (bf-loop code cp mem mp)
    (let ((ret (iter code (+ cp 1) mem mp)))
      (if (< (car ret) (string-length code))
            (iter code cp mem (cdr ret)) ret)))
  (define (bf-loopout code cp)
    (define (iter code cp nest)
      (if (= nest 0)
        cp
        (let ((c (string-ref code cp)))
          (cond
            ((eq? c #\[) (iter code (+ cp 1) (+ nest 1)))
            ((eq? c #\]) (iter code (+ cp 1) (- nest 1)))
            (else (iter code (+ cp 1) nest))))))
    (iter code (+ cp 1) 1))
  (define (iter code cp mem mp)
    (if (< cp (string-length code))
      (let ((c (string-ref code cp)))
        (cond
          ((eq? c #\+) (iter code (+ cp 1) (bf-inc! mem mp) mp))
          ((eq? c #\-) (iter code (+ cp 1) (bf-dec! mem mp) mp))
          ((eq? c #\>) (iter code (+ cp 1) mem (+ mp 1)))
          ((eq? c #\<) (iter code (+ cp 1) mem (- mp 1)))
          ((eq? c #\.) (iter code (+ cp 1) (bf-put mem mp) mp))
          ((eq? c #\,) (iter code (+ cp 1) (bf-get! mem mp) mp))
          ((eq? c #\[)
              (if (bf-mem? mem mp)
                (bf-loop code cp mem mp)
                (iter code (bf-loopout code cp) mem mp)))
          ((eq? c #\]) (cons cp mp))
          (else (iter code (+ cp 1) mem mp))))
      (cons cp mp)))
  (iter code 0 (make-vector 30000 0) 0))
(define (bf-run-file file)
  (define (iter port)
    (let ((c (read-char port)))
      (if (eof-object? c)
        ()
        (cons c (iter port)))))
  (bf-run (list->string (iter (open-input-file file)))))
(define (main args)
  (if (null? (cdr args))
    (display "bfi bffile\n")
    (bf-run-file (cadr args))))

test