tabe と申します。
http://fixedpoint.jp/
Scheme を知ってプログラマになりました。
Gauche のおかげで C も好きになってきました。
(library (export export) (export export) (import (rnrs)) (define-syntax export (syntax-rules () ((_ import) (import (import import)))))) (import (export export)) (export export)
(do()(#f)) ;; a shortest sexp yielding infinite loop (call/cc (lambda (x) ((lambda (y) (display y) (newline) (x (- 1 y))) (call/cc (lambda (c) (set! x c) 0))))) AND ((lambda (x) ((lambda (y) (display y) (newline) (x (- 1 y))) (call/cc (lambda (c) (set! x c) 0)))) call/cc) ((rec (cer rec) (rec cer)) (rec (cer rec) (rec cer))) ((call/cc call/cc) (call/cc call/cc)) (let ((let ((let let ((let (let let () let))) let)))) (eq? let (let))) ((lambda (lambda) (lambda lambda)) (lambda (lambda) (lambda lambda)))
Scheme:Brainfuck を参考にしています。 インタプリタ実行時の tape を3つに分けて、末尾再帰の形にしています。
(define (bfi iport) (define (parse iport handler) (let loop ((stack '()) (temp '())) (let ((char (read-char iport))) (if (eof-object? char) (if (null? stack) temp (handler "unmatched " #\[)) (case char ((#\+ #\, #\- #\. #\< #\>) (loop stack `(,@temp ,char))) ((#\[) (loop (cons temp stack) '())) ((#\]) (if (null? stack) (handler "extra " #\]) (loop (cdr stack) `(,@(car stack) ,temp)))) (else (handler "unknown command: " char))))))) (define (emulate tree head pt tail) (if (null? tree) (values head pt tail) (case (car tree) ((#\+) (emulate (cdr tree) head (logand (+ pt 1) #xff) tail)) ((#\-) (emulate (cdr tree) head (logand (- pt 1) #xff) tail)) ((#\,) (emulate (cdr tree) head (read-byte) tail)) ((#\.) (write-byte pt) (emulate (cdr tree) head pt tail)) ((#\<) (if (null? head) (error "pointer underflow: " (cons pt tail)) (emulate (cdr tree) (cdr head) (car head) (cons pt tail)))) ((#\>) (if (null? tail) (emulate (cdr tree) (cons pt head) 0 '()) (emulate (cdr tree) (cons pt head) (car tail) (cdr tail)))) (else (if (= pt 0) (emulate (cdr tree) head pt tail) (receive (h p t) (emulate (car tree) head pt tail) (emulate tree h p t))))))) (receive (head pt tail) (emulate (parse iport error) '() 0 '()) (values (reverse head) pt tail)))
(define (parse iport handler) (call/cc (lambda (ret) (let loop ((top? #t)) (let ((char (read-char iport))) (if (eof-object? char) (if top? '() (ret (handler "unmatched " #\[))) (case char ((#\+ #\, #\- #\. #\< #\>) (cons char (loop top?))) ((#\[) (let ((inner (loop #f))) (cons inner (loop top?)))) ((#\]) (if top? (ret (handler "extra " #\])) '())) (else (ret (handler "unknown command: " char))))))))))