Schemeで適当にBrainFuckインタプリタ

Programming Scheme BrainFuck

やらなければいけないレポートがあるという現実から目を逸らしてSchemeでBrainfuckインタプリタつくってたら朝になっていたのでやばい。Schemeでのまともなプログラムの書き方とかまず全然わからないのもほげ。目を背けたい事柄が無かったらたぶんわざわざSchemeでbfインタプリタなんて書かなかっただろうなというほげほげ。

運が良ければちゃんと動くかもねというレベルのソース。

(define (read-bf codestring)
  (define (isbf? c) (case c ((#\> #\< #\+ #\- #\[ #\] #\. #\,) #t) (else #f)))
  (define code (open-input-string codestring))
  (define (iter codels c)
    (if (eof-object? c)
      codels
      (if (isbf? c)
        (iter (append codels (list c)) (read-char code))
        (iter codels (read-char code)))))
  (iter '() (read-char code)))

(define (run-bf codels)
  (define (mem-inc! mem mp) (vector-set! mem mp (+ (vector-ref mem mp) 1)))
  (define (mem-dec! mem mp) (vector-set! mem mp (- (vector-ref mem mp) 1)))
  (define (mem2out mem mp) (write-char (integer->char (vector-ref mem mp))))
  (define (in2mem! mem mp) (vector-set! mem mp (char->integer (read-char))))
  (define (mem? mem mp) (if (= (vector-ref mem mp) 0) #f #t))
  (define (brakout codels)
    (define (iter codels nest)
      (if (= nest 0)
        codels
        (cond
          ((eq? (car codels) #\[) (iter (cdr codels) (+ nest 1)))
          ((eq? (car codels) #\]) (iter (cdr codels) (- nest 1)))
          (else (iter (cdr codels) nest)))))
    (iter codels 1))
  (define (inbrak codels mem mp)
    (let ((ret (iter (cdr codels) mem mp)))
      (if (= ret -1) -1
        (iter codels mem ret))))
  (define (iter codels mem mp)
    (if (null? codels) -1
      ((lambda (c)
        (cond
          ((eq? c #\+) (begin
                (mem-inc! mem mp)
                (iter (cdr codels) mem mp)))
          ((eq? c #\-) (begin
                (mem-dec! mem mp)
                (iter (cdr codels) mem mp)))
          ((eq? c #\>)
              (iter (cdr codels) mem (+ mp 1)))
          ((eq? c #\<)
              (iter (cdr codels) mem (- mp 1)))
          ((eq? c #\.) (begin
                (mem2out mem mp)
                (iter (cdr codels) mem mp)))
          ((eq? c #\,) (begin
                (in2mem! mem mp)
                (iter (cdr codels) mem mp)))
          ((eq? c #\[)
              (if (mem? mem mp)
                (inbrak codels mem mp)
                (iter (brakout (cdr codels)) mem mp)))
          ((eq? c #\]) mp))) (car codels))))
  (iter codels (make-vector 300 0) 0))

(run-bf (read-bf "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.+++++++.--------.--."))
; hoge-1
(run-bf (read-bf ">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++[<++++>-]<.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------.[-]>++++++++[<++++>-]<+.[-]++++++++++."))
; Hello World!
; -1

正常に終了すると-1を返す。

test