Brainfuckコンパイラ

id:mzpさんがBrainfuckインタプリタを作っていたので、なんとなくBrainfuckからSchemeへのコンパイラを作ってみた。

こんな感じになってます。

(define (char->symbol c)
  (string->symbol #`",c"))

(define (inst-name->cont name k)
  (lambda (x)
    (k `((,(char->symbol name)) ,@x))))

(define (compile k)
  (let1 c (read-char)
    (if (eof-object? c)
	(k '())
	(case c
	  ((#\+ #\- #\> #\< #\. #\,)
	   (compile (inst-name->cont c k)))
	  ((#\[)
	   (compile
	    (lambda (x)
	      (compile
	       (lambda (y)
		 (k `((while (nonzero?) ,@x) ,@y)))))))
	  ((#\])
	   (k '()))
	  (else (compile k))))))

(define (bf->scm)
  (for-each write
	    `((define memory (make-vector 30000 0))
	      (define pointer 0)
	      (define (+) (inc! (ref memory pointer)))
	      (define (-) (dec! (ref memory pointer)))
	      (define (>) (inc! pointer))
	      (define (<) (dec! pointer))
	      (define (|,|) (set! (ref memory pointer) (char->integer (read-char))))
	      (define (|.|) (display (integer->char (ref memory pointer))))
	      (define (nonzero?) (not (zero? (ref memory pointer))))
	      (define (main args)
		,@(compile identity)))))

(define (main args)
  (bf->scm)
  0)

標準入力からBrainfuckのコードを渡してやると、標準出力にSchemeのコードが出力されます。

$ gosh bf2scm.scm < HELLOBF.BF > HELLOBF.scm
$ cat HELLOBF.scm
(define memory (make-vector 30000 0))(define pointer 0)(define (+) (inc! (ref memory pointer)))(define (-) (dec! (ref memory pointer)))(define (>) (inc! pointer))(define (<) (dec! pointer))(define (|,|) (set! (ref memory pointer) (char->integer (read-char))))(define (|.|) (display (integer->char (ref memory pointer))))(define (nonzero?) (not (zero? (ref memory pointer))))(define (main args) (>) (+) (+) (+) (+) (+) (+) (+) (+) (+) (while (nonzero?) (<) (+) (+) (+) (+) (+) (+) (+) (+) (>) (-)) (<) (|.|) (>) (+) (+) (+) (+) (+) (+) (+) (while (nonzero?) (<) (+) (+) (+) (+) (>) (-)) (<) (+) (|.|) (+) (+) (+) (+) (+) (+) (+) (|.|) (|.|) (+) (+) (+) (|.|) (while (nonzero?) (-)) (>) (+) (+) (+) (+) (+) (+) (+) (+) (while (nonzero?) (<) (+) (+) (+) (+) (>) (-)) (<) (|.|) (>) (+) (+) (+) (+) (+) (+) (+) (+) (+) (+) (+) (while (nonzero?) (<) (+) (+) (+) (+) (+) (>) (-)) (<) (|.|) (>) (+) (+) (+) (+) (+) (+) (+) (+) (while (nonzero?) (<) (+) (+) (+) (>) (-)) (<) (|.|) (+) (+) (+) (|.|) (-) (-) (-) (-) (-) (-) (|.|) (-) (-) (-) (-) (-) (-) (-) (-) (|.|) (while (nonzero?) (-)) (>) (+) (+) (+) (+) (+) (+) (+) (+) (while (nonzero?) (<) (+) (+) (+) (+) (>) (-)) (<) (+) (|.|) (while (nonzero?) (-)) (+) (+) (+) (+) (+) (+) (+) (+) (+) (+) (|.|))
$ gosh HELLOBF.scm
Hello World!
$