Put these modules in a directory called bf and install it as a package. The expander path is given below as bf/expander. If you install the project in a directory with another name, change this to name-of-your-dir/expander. If you don’t want to install the project as a package, you can use "expander.rkt" (with the quotes).
#lang br/quicklang
(module reader br
(require "reader.rkt")
(provide read-syntax))
#lang br/quicklang
(require "parser.rkt")
(define (read-syntax path port)
(define parse-tree (parse path (make-tokenizer port)))
(define module-datum `(module bf-mod bf/expander
,parse-tree))
(datum->syntax #f module-datum))
(provide read-syntax)
(require brag/support)
(define (make-tokenizer port)
(define (next-token)
(define bf-lexer
(lexer
[(char-set "><-.,+[]") lexeme]
[any-char (next-token)]))
(bf-lexer port))
next-token)
#lang brag
bf-program : (bf-op | bf-loop)*
bf-op : ">" | "<" | "+" | "-" | "." | ","
bf-loop : "[" (bf-op | bf-loop)* "]"
#lang br/quicklang
(define-macro (bf-module-begin PARSE-TREE)
#'(#%module-begin
PARSE-TREE))
(provide (rename-out [bf-module-begin #%module-begin]))
(define (fold-funcs apl bf-funcs)
(for/fold ([current-apl apl])
([bf-func (in-list bf-funcs)])
(apply bf-func current-apl)))
(define-macro (bf-program OP-OR-LOOP-ARG ...)
#'(begin
(define first-apl (list (make-vector 30000 0) 0))
(void (fold-funcs first-apl (list OP-OR-LOOP-ARG ...)))))
(provide bf-program)
(define-macro (bf-loop "[" OP-OR-LOOP-ARG ... "]")
#'(lambda (arr ptr)
(for/fold ([current-apl (list arr ptr)])
([i (in-naturals)]
#:break (zero? (apply current-byte
current-apl)))
(fold-funcs current-apl (list OP-OR-LOOP-ARG ...)))))
(provide bf-loop)
(define-macro-cases bf-op
[(bf-op ">") #'gt]
[(bf-op "<") #'lt]
[(bf-op "+") #'plus]
[(bf-op "-") #'minus]
[(bf-op ".") #'period]
[(bf-op ",") #'comma])
(provide bf-op)
(define (current-byte arr ptr) (vector-ref arr ptr))
(define (set-current-byte arr ptr val)
(vector-set! arr ptr val)
arr)
(define (gt arr ptr) (list arr (add1 ptr)))
(define (lt arr ptr) (list arr (sub1 ptr)))
(define (plus arr ptr)
(list
(set-current-byte arr ptr (add1 (current-byte arr ptr)))
ptr))
(define (minus arr ptr)
(list
(set-current-byte arr ptr (sub1 (current-byte arr ptr)))
ptr))
(define (period arr ptr)
(write-byte (current-byte arr ptr))
(list arr ptr))
(define (comma arr ptr)
(list (set-current-byte arr ptr (read-byte)) ptr))