From 1b1aecbb84daf1b08802361f2cfe376e2245da8f Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sun, 28 Aug 2016 20:31:43 -0700
Subject: [PATCH] old bf expander

---
 .../br/demo/bf/bf-expander-imperative.rkt     | 29 +++++++++++++++++++
 1 file changed, 29 insertions(+)
 create mode 100644 beautiful-racket/br/demo/bf/bf-expander-imperative.rkt

diff --git a/beautiful-racket/br/demo/bf/bf-expander-imperative.rkt b/beautiful-racket/br/demo/bf/bf-expander-imperative.rkt
new file mode 100644
index 0000000..5aead01
--- /dev/null
+++ b/beautiful-racket/br/demo/bf/bf-expander-imperative.rkt
@@ -0,0 +1,29 @@
+#lang br/quicklang
+ 
+(provide #%module-begin)
+
+(define-macro (bf-program OP-OR-LOOP ...)
+  #'(begin OP-OR-LOOP ...))
+(provide bf-program)
+
+(define-macro-cases op
+  [(op ">") #'(move-pointer 1)]
+  [(op "<") #'(move-pointer -1)]
+  [(op "+") #'(set-current-byte! (add1 (get-current-byte)))]
+  [(op "-") #'(set-current-byte! (sub1 (get-current-byte)))]
+  [(op ".") #'(write-byte (get-current-byte))]
+  [(op ",") #'(set-current-byte! (read-byte))])
+(provide op)
+
+(define bf-vector (make-vector 30000 0))
+(define bf-pointer 0)
+
+(define (move-pointer how-far) (set! bf-pointer (+ bf-pointer how-far)))
+
+(define (get-current-byte) (vector-ref bf-vector bf-pointer))
+(define (set-current-byte! val)  (vector-set! bf-vector bf-pointer val))
+
+(define-macro (loop LOOP-ARG ...)
+  #'(until (zero? (get-current-byte))
+           LOOP-ARG ...))
+(provide loop)