#lang bf expander

expander.rkt

#lang br/quicklang
 
(define-macro (bf-module-begin PARSE-TREE)
  #'(#%module-begin
     PARSE-TREE))
(provide (rename-out [bf-module-begin #%module-begin]))

(define-macro (bf-program OP-OR-LOOP-ARG ...)
  #'(time OP-OR-LOOP-ARG ...))
(provide bf-program)

(define-macro (bf-loop "[" OP-OR-LOOP-ARG ... "]")
  #'(until (zero? (current-byte))
      OP-OR-LOOP-ARG ...))
(provide bf-loop)

(define-macro-cases bf-op
  [(bf-op ">") #'(ptr++)]
  [(bf-op "<") #'(ptr--)]
  [(bf-op "+") #'(inc)]
  [(bf-op "-") #'(dec)]
  [(bf-op ".") #'(write)]
  [(bf-op ",") #'(read)])
(provide bf-op)

(define arr (make-bytes 30000 0))
(define ptr 0)

(require racket/unsafe/ops)

(define bytes-ref unsafe-bytes-ref)
(define bytes-set! unsafe-bytes-set!)

(define (current-byte) (bytes-ref arr ptr))
(define (set-current-byte! val) (bytes-set! arr ptr val))

(define (add1 n) (unsafe-fx+ n 1))
(define (sub1 n) (unsafe-fx- n 1))

(define (ptr++) (set! ptr (add1 ptr)))
(define (ptr--) (set! ptr (sub1 ptr)))
(define (inc) (set-current-byte! (add1 (current-byte))))
(define (dec) (set-current-byte! (sub1 (current-byte))))
(define (write) (write-byte (current-byte)))
(define (read) (set-current-byte! (read-byte)))