bf.scm

   1 (define (bf-dptr-forward data dptr)
   2
   3
   4 (define bf-instructions
   5   (list
   6    (cons (">" . (lambda (data dptr) 'a)))))
   7
   8 (define (bf program-string)
   9   ;; (let ((matching-brackets (bf-scan-bracket program-string)))
  10     (let run-loop
  11         ((data (make-vector 3000 0))
  12          (data-pointer 0)
  13          (next-instruction-i 0))
  14       (if (< next-instruction-i (string-length program-string))
  15           (let ((next-instruction
  16                  (string-ref program-string next-instruction-i)))
  17             (case next-instruction
  18               ((#\>)
  19                (run-loop data (1+ data-pointer) (1+ next-instruction-i)))
  20               ((#\<)
  21                (run-loop data (1- data-pointer) (1+ next-instruction-i)))
  22               ((#\+)
  23                (vector-set! data data-pointer
  24                             (1+ (vector-ref data data-pointer)))
  25                (run-loop data data-pointer (1+ next-instruction-i)))
  26               ((#\-)
  27                (vector-set! data data-pointer
  28                             (1- (vector-ref data data-pointer)))
  29                (run-loop data data-pointer (1+ next-instruction-i)))
  30               ((#\.)
  31                (display (vector-ref data data-pointer))
  32                (run-loop data data-pointer (1+ next-instruction-i)))
  33               ((#\,)
  34                (vector-set! data data-pointer
  35                             (char->integer (read-char)))
  36                (run-loop data data-pointer (1+ next-instruction-i)))
  37               )))))
  38
  39 (bf ",.")