#lang br
(provide (all-from-out br)
         (all-defined-out))

(define bf-vector (make-vector 1000 0))
(define bf-pointer 0)
(define (byte-at-pointer) (vector-ref bf-vector bf-pointer))
(define (change-byte-at-pointer val) (vector-set! bf-vector bf-pointer val))

(define (change-pointer how-far)
  (set! bf-pointer (+ bf-pointer how-far)))

(define (change-pointer-val how-much)
  (change-byte-at-pointer (+ (byte-at-pointer) how-much)))

(define #'(bf-program arg ...)
  #'(begin arg ...))

(define #'(expr arg)
  (case (syntax->datum #'arg)
    [(">") #'(change-pointer 1)]
    [("<") #'(change-pointer -1)]
    [("+") #'(change-pointer-val 1)]
    [("-") #'(change-pointer-val -1)]
    [(".") #'(write-byte (byte-at-pointer))]
    [(",") #'(change-byte-at-pointer (read-byte (current-input-port)))]
    [else #'arg]))

(define #'(loop lb arg ... rb)
  #'(let loop ()
      (unless (zero? (vector-ref bf-vector bf-pointer))
        arg ...
        (loop))))

(module reader syntax/module-reader
  #:language 'br-bf
  #:read bf-read
  #:read-syntax bf-read-syntax
  #:whole-body-readers? #t
  
  (require "tokenizer.rkt" "parser.rkt")
  (define (bf-read in)
    (syntax->datum (bf-read-syntax #f in)))
  
  (define (bf-read-syntax src ip)
    (list (parse src (tokenize ip)))))