tabe


tabe と申します。
http://fixedpoint.jp/

Scheme を知ってプログラマになりました。
Gauche のおかげで C も好きになってきました。


fortune --r6rs

(library (export export) (export export) (import (rnrs)) (define-syntax export (syntax-rules () ((_ import) (import (import import))))))
(import (export export))
(export export)

fortune --scheme

(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)))

Yet Another bfi

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)))

最終更新 : 2012/02/23 03:59:41 UTC