add `while` and `until`

br-bf/main.rkt

@@ -20,25 +20,22 @@
     (for-each println (map syntax->datum result))
     result))
 
-
+(define #'(bf-program <op> ...)
-(define #'(bf-program arg ...)
+  #'(begin <op> ...))
-  #'(begin arg ...))
+
-
+(define #'(op <arg>)
-(define #'(op arg)
+  (syntax-case #'(op <arg>) ()
-  (case (syntax->datum #'arg)
+    [(op ">") #'(move-pointer 1)]
-    [(">") #'(move-pointer 1)]
+    [(op "<") #'(move-pointer -1)]
-    [("<") #'(move-pointer -1)]
+    [(op "+") #'(set-pointer-byte! (add1 (pointer-byte)))]
-    [("+") #'(set-pointer-byte! (add1 (pointer-byte)))]
+    [(op "-") #'(set-pointer-byte! (sub1 (pointer-byte)))]
-    [("-") #'(set-pointer-byte! (sub1 (pointer-byte)))]
+    [(op ".") #'(write-byte (pointer-byte))]
-    [(".") #'(write-byte (pointer-byte))]
+    [(op ",") #'(set-pointer-byte! (read-byte))]
-    [(",") #'(set-pointer-byte! (read-byte (current-input-port)))]
+    [else #'<arg>])) ; <arg> must therefore be a loop
-    [else #'arg]))
+
-
+(define #'(loop "[" <op> ... "]")
-(define #'(loop lb arg ... rb)
+  #'(until (zero? (pointer-byte))
-  #'(let loop ()
+           <op> ...))
-      (unless (zero? (pointer-byte))
-        arg ...
-        (loop))))
 
 (define bf-vector (make-vector 10 0))
 (define bf-pointer 0)

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))))

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)