revise

beautiful-racket-lib/br/quicklang.rkt

@@ -2,10 +2,21 @@
 (provide (except-out (all-from-out br) #%module-begin)
          (rename-out [quicklang-mb #%module-begin]))
 
-(define-syntax-rule (quicklang-mb . lines)
+(define-macro (quicklang-mb . exprs)
-  (#%module-begin
+  (define-values
-     (provide #%top #%app #%datum #%top-interaction)
+    (kw-pairs other-exprs)
-     . lines))
+    (let loop ([kw-pairs null][exprs (syntax->list #'exprs)])
+      (if (and (pair? exprs) (keyword? (syntax-e (car exprs))) (symbol? (syntax-e (cadr exprs))))
+          (loop (cons (list (string->symbol (keyword->string (syntax-e (car exprs))))
+                            (cadr exprs)) ; leave val in stx form so local binding is preserved
+                      kw-pairs)
+                (cddr exprs))
+          (values kw-pairs exprs))))
+  (with-pattern ([((KW VAL) ...) kw-pairs])
+    #`(#%module-begin
+       (provide (rename-out [VAL KW]) ...)
+       (provide #%top #%app #%datum #%top-interaction)
+       . #,(datum->syntax #'exprs other-exprs #'exprs))))
 
 
 (module reader syntax/module-reader

beautiful-racket/br/demo/stacker.rkt

@@ -1,17 +1,18 @@
 #lang br/quicklang
+#:read-syntax stacker-read-syntax
+#:#%module-begin stacker-module-begin
 
-(define (read-syntax src-path in-port)
+(define (stacker-read-syntax src-path in-port)
   (define stack-args (port->list read in-port))
-  (strip-context (with-pattern ([(STACK-ARG ...) stack-args])
+  (strip-context
-                   #'(module stacker-mod br/demo/stacker
+   (with-pattern ([(STACK-ARG ...) stack-args])
-                       (push STACK-ARG) ...))))
+     #'(module stacker-mod br/demo/stacker
-(provide read-syntax)
+         (push STACK-ARG) ...))))
 
 (define-macro (stacker-module-begin PUSH-STACK-ARG ...)
   #'(#%module-begin
      PUSH-STACK-ARG ...
      (display (first stack))))
-(provide (rename-out [stacker-module-begin #%module-begin]))
 
 (define stack empty)
 
@@ -25,6 +26,6 @@
 
 (provide + *)
 
-#;(module+ test 
+(module+ test 
   (require rackunit)
   (check-equal? (with-output-to-string (λ () (dynamic-require "stacker-test.rkt" #f))) "36"))

beautiful-racket/br/demo/stacker2.rkt

@@ -1,13 +1,13 @@
 #lang br/quicklang
+#:read-syntax stacker-read-syntax
+#:#%module-begin stacker-module-begin
 
-
+(define (stacker-read-syntax src-path in-port)
-(define (read-syntax src-path in-port)
   (define stack-args (port->list read in-port))
   (strip-context
    (with-pattern ([(STACK-ARG ...) stack-args])
      #'(module stacker2-mod br/demo/stacker2
          STACK-ARG ...))))
-(provide read-syntax)
 
 (define-macro (stacker-module-begin STACK-ARG ...)
   #'(#%module-begin
@@ -16,16 +16,15 @@
                  ([arg (in-list (list STACK-ARG ...))])
          (push arg stack)))
      (display (first stack-result))))
-(provide (rename-out [stacker-module-begin #%module-begin]))
 
 (define (push arg stack)
-  (if (number? arg)
+  (cond
-      (cons arg stack)
+    [(number? arg) (cons arg stack)]
-      (let* ([op arg]
+    [else
-             [result (op (first stack) (second stack))])
+     (define result (arg (first stack) (second stack)))
-        (cons result (drop stack 2)))))
+     (cons result (drop stack 2))]))
 
-(provide + * #%app #%datum #%top-interaction)
+(provide + *)
 
 (module+ test 
   (require rackunit)

beautiful-racket/br/demo/stacker3-test.rkt

@@ -0,0 +1,8 @@
+#lang reader br/demo/stacker3
+4
+8
+
++
+3
+
+*

beautiful-racket/br/demo/stacker3.rkt

@@ -0,0 +1,24 @@
+#lang br/quicklang
+#:read-syntax stacker-read-syntax
+#:#%module-begin stacker-module-begin
+
+(define (stacker-read-syntax src-path in-port)
+  (strip-context
+   #`(module stacker3-mod br/demo/stacker3
+       #,@(port->list read in-port))))
+
+(define-macro (stacker-module-begin STACK-ARG ...)
+  #'(#%module-begin
+     (display
+      (first
+       (foldl (λ(arg stack)
+                (if (number? arg)
+                    (cons arg stack)
+                    (cons (arg (car stack) (cadr stack)) (cddr stack))))
+              null (list STACK-ARG ...))))))
+
+(provide + *)
+
+(module+ test 
+  (require rackunit)
+  (check-equal? (with-output-to-string (λ () (dynamic-require "stacker2-test.rkt" #f))) "36"))