From 2712ffa472774d84f23489ff9ddd9f4fd67d1e89 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 8 Apr 2016 09:16:09 -0700
Subject: [PATCH] add `while` and `until`

---
 br-bf/main.rkt     | 35 ++++++++++++++++-------------------
 br/conditional.rkt | 15 +++++++++++++++
 br/main.rkt        |  4 ++--
 3 files changed, 33 insertions(+), 21 deletions(-)
 create mode 100644 br/conditional.rkt

diff --git a/br-bf/main.rkt b/br-bf/main.rkt
index 89c68b1..ac0b7c8 100644
--- a/br-bf/main.rkt
+++ b/br-bf/main.rkt
@@ -20,25 +20,22 @@
     (for-each println (map syntax->datum result))
     result))
 
-
-(define #'(bf-program arg ...)
-  #'(begin arg ...))
-
-(define #'(op arg)
-  (case (syntax->datum #'arg)
-    [(">") #'(move-pointer 1)]
-    [("<") #'(move-pointer -1)]
-    [("+") #'(set-pointer-byte! (add1 (pointer-byte)))]
-    [("-") #'(set-pointer-byte! (sub1 (pointer-byte)))]
-    [(".") #'(write-byte (pointer-byte))]
-    [(",") #'(set-pointer-byte! (read-byte (current-input-port)))]
-    [else #'arg]))
-
-(define #'(loop lb arg ... rb)
-  #'(let loop ()
-      (unless (zero? (pointer-byte))
-        arg ...
-        (loop))))
+(define #'(bf-program <op> ...)
+  #'(begin <op> ...))
+
+(define #'(op <arg>)
+  (syntax-case #'(op <arg>) ()
+    [(op ">") #'(move-pointer 1)]
+    [(op "<") #'(move-pointer -1)]
+    [(op "+") #'(set-pointer-byte! (add1 (pointer-byte)))]
+    [(op "-") #'(set-pointer-byte! (sub1 (pointer-byte)))]
+    [(op ".") #'(write-byte (pointer-byte))]
+    [(op ",") #'(set-pointer-byte! (read-byte))]
+    [else #'<arg>])) ; <arg> must therefore be a loop
+
+(define #'(loop "[" <op> ... "]")
+  #'(until (zero? (pointer-byte))
+           <op> ...))
 
 (define bf-vector (make-vector 10 0))
 (define bf-pointer 0)
diff --git a/br/conditional.rkt b/br/conditional.rkt
new file mode 100644
index 0000000..c28b561
--- /dev/null
+++ b/br/conditional.rkt
@@ -0,0 +1,15 @@
+#lang racket/base
+(require (for-syntax racket/base))
+(provide (all-defined-out))
+
+(define-syntax-rule (until cond expr ...)
+  (let loop ()
+    (unless cond
+      expr ...
+      (loop))))
+
+(define-syntax-rule (while cond expr ...)
+  (let loop ()
+    (when cond
+      expr ...
+      (loop))))
\ No newline at end of file
diff --git a/br/main.rkt b/br/main.rkt
index b3d9db6..9ab9ab9 100644
--- a/br/main.rkt
+++ b/br/main.rkt
@@ -1,10 +1,10 @@
 #lang racket/base
 (require racket/provide racket/list racket/string racket/format racket/match racket/port
-         br/define br/syntax br/datum br/debug
+         br/define br/syntax br/datum br/debug br/conditional
          (for-syntax racket/base racket/syntax br/syntax br/define))
 (provide (except-out (all-from-out racket/base) define)
          (all-from-out racket/list racket/string racket/format racket/match racket/port
-                       br/syntax br/datum br/debug)
+                       br/syntax br/datum br/debug br/conditional)
          (for-syntax (all-from-out racket/base racket/syntax br/syntax))
          (filtered-out
           (λ (name)