update stacker versions

beautiful-racket-lib/br/quicklang.rkt

@@ -1,4 +1,5 @@
 #lang br
+(require (for-syntax racket/list sugar/debug))
 (provide (except-out (all-from-out br) #%module-begin)
          (rename-out [quicklang-mb #%module-begin]))
 
@@ -6,14 +7,19 @@
   (define-values
     (kw-pairs other-exprs)
     (let loop ([kw-pairs null][exprs (syntax->list #'exprs)])
-      (if (and (pair? exprs) (keyword? (syntax-e (car exprs))) (symbol? (syntax-e (cadr exprs))))
+      (if (and (pair? exprs) (keyword? (syntax-e (car exprs))))
-          (loop (cons (list (string->symbol (keyword->string (syntax-e (car exprs))))
+          (loop (cons (cons (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])
+  (define reserved-keywords '(provide))
+  (define (reserved? kw-pair) (memq (car kw-pair) reserved-keywords))
+  (define-values (reserved-kwpairs other-kwpairs) (partition reserved? kw-pairs))
+  (with-pattern ([((KW . VAL) ...) other-kwpairs]
+                 [(PROVIDED-ID ...) (or (assq 'provide reserved-kwpairs) null)])
     #`(#%module-begin
+       (provide PROVIDED-ID ...)
        (provide (rename-out [VAL KW]) ...)
        (provide #%top #%app #%datum #%top-interaction)
        . #,(datum->syntax #'exprs other-exprs #'exprs))))

beautiful-racket/br/demo/stacker copy.rkt

@@ -0,0 +1,36 @@
+#lang br/quicklang
+
+(define (read-syntax src-path in-port)
+  (define args (port->list read in-port))
+  (define module-datum `(module stacker-mod br/demo/stacker
+                          ,@args))
+  (datum->syntax #f module-datum))
+(provide read-syntax)
+
+(define-macro (stacker-module-begin ARG ...)
+  #'(#%module-begin
+     (push ARG) ...
+     (display (first stack))))
+(provide (rename-out [stacker-module-begin #%module-begin]))
+
+(define stack empty)
+
+(define (pop-stack!)
+  (define first-item (first stack))
+  (set! stack (rest stack))
+  first-item)
+
+(define (push-stack! elem) (set! stack (cons elem stack)))
+
+(define (push arg)
+  (cond
+    [(number? arg) (push-stack! arg)]
+    [else
+     (define op-result (arg (pop-stack!) (pop-stack!))) 
+     (push-stack! op-result)]))
+
+(provide + *)
+
+(module+ test 
+  (require rackunit)
+  (check-equal? (with-output-to-string (λ () (dynamic-require "stacker-test.rkt" #f))) "36"))

beautiful-racket/br/demo/stacker.rkt

@@ -1,18 +1,18 @@
 #lang br/quicklang
-#:read-syntax stacker-read-syntax
-#:#%module-begin stacker-module-begin
 
 (define (stacker-read-syntax src-path in-port)
-  (define stack-args (port->list read in-port))
+  (define args (port->list read in-port))
-  (with-pattern ([(STACK-ARG ...) stack-args])
+  (with-pattern ([(ARG ...) args])
     (strip-identifier-bindings
      #'(module stacker-mod br/demo/stacker
-         (push STACK-ARG) ...))))
+         ARG ...))))
+(provide read-syntax)
 
-(define-macro (stacker-module-begin PUSH-EXPR ...)
+(define-macro (stacker-module-begin ARG ...)
   #'(#%module-begin
-     PUSH-EXPR ...
+     (push ARG) ...
      (display (first stack))))
+(provide (rename-out [stacker-module-begin #%module-begin]))
 
 (define stack empty)
 
@@ -20,9 +20,8 @@
   (cond
     [(number? arg) (set! stack (cons arg stack))]
     [else
-     (define result (arg (first stack) (second stack)))
+     (define op-result (arg (first stack) (second stack)))
-     (set! stack (cons result (drop stack 2)))]))
+     (set! stack (cons op-result (drop stack 2)))]))
-(provide push)
 
 (provide + *)
 

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

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

beautiful-racket/br/demo/stacker0.rkt

@@ -0,0 +1,38 @@
+#lang br/quicklang
+
+(define (read-syntax src-path in-port)
+  (define args (port->lines in-port))
+  (define module-datum `(module stacker-mod br/demo/stacker0
+                          ,@args))
+  (datum->syntax #f module-datum))
+(provide read-syntax)
+
+(define-macro (stacker-module-begin ARG ...)
+  #'(#%module-begin
+     (push ARG) ...
+     (display (first stack))))
+(provide (rename-out [stacker-module-begin #%module-begin]))
+
+(define stack empty)
+
+(define (pop-stack!)
+  (define item (first stack))
+  (set! stack (rest stack))
+  item)
+
+(define (push-stack! item) (set! stack (cons item stack)))
+
+(define (push arg)
+  (cond
+    [(equal? arg "+")
+     (define sum (+ (pop-stack!) (pop-stack!)))
+     (push-stack! sum)]
+    [(equal? arg "*")
+     (define product (* (pop-stack!) (pop-stack!)))
+     (push-stack! product)]
+    [(string->number arg) (push-stack! (string->number arg))]))
+
+
+(module+ test 
+  (require rackunit)
+  (check-equal? (with-output-to-string (λ () (dynamic-require "stacker0-test.rkt" #f))) "36"))

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

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

beautiful-racket/br/demo/stacker1.rkt

@@ -0,0 +1,36 @@
+#lang br/quicklang
+
+(define (read-syntax src-path in-port)
+  (define args (port->list read in-port))
+  (define module-datum `(module stacker-mod br/demo/stacker1
+                          ,@args))
+  (datum->syntax #f module-datum))
+(provide read-syntax)
+
+(define-macro (stacker-module-begin ARG ...)
+  #'(#%module-begin
+     (push ARG) ...
+     (display (first stack))))
+(provide (rename-out [stacker-module-begin #%module-begin]))
+
+(define stack empty)
+
+(define (pop-stack!)
+  (define item (first stack))
+  (set! stack (rest stack))
+  item)
+
+(define (push-stack! item) (set! stack (cons item stack)))
+
+(define (push arg)
+  (cond
+    [(number? arg) (push-stack! arg)]
+    [else
+     (define op-result (arg (pop-stack!) (pop-stack!))) 
+     (push-stack! op-result)]))
+
+(provide + *)
+
+(module+ test 
+  (require rackunit)
+  (check-equal? (with-output-to-string (λ () (dynamic-require "stacker1-test.rkt" #f))) "36"))

beautiful-racket/br/demo/stacker2.rkt

@@ -1,30 +1,26 @@
 #lang br/quicklang
-#:read-syntax stacker-read-syntax
+(provide read-syntax
-#:#%module-begin stacker-module-begin
+         (rename-out [stacker-module-begin #%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))
+  (define args (port->list read in-port))
-  (with-pattern ([(STACK-ARG ...) stack-args])
+  (define module-datum `(module stacker2-mod br/demo/stacker2
-    (strip-identifier-bindings
+                          ,@args))
-     #'(module stacker2-mod br/demo/stacker2
+  (datum->syntax #f module-datum))
-         STACK-ARG ...))))
 
-(define-macro (stacker-module-begin STACK-ARG ...)
+(define-macro (stacker-module-begin ARG ...)
   #'(#%module-begin
      (define stack-result
        (for/fold ([stack empty])
-                 ([arg (in-list (list STACK-ARG ...))])
+                 ([arg (in-list (list ARG ...))])
          (push arg stack)))
      (display (first stack-result))))
 
 (define (push arg stack)
-  (cond
+  (if (number? arg)
-    [(number? arg) (cons arg stack)]
+      (cons arg stack)
-    [else
+      (cons (arg (first stack) (second stack)) (drop stack 2))))
-     (define result (arg (first stack) (second stack)))
-     (cons result (drop stack 2))]))
-
-(provide + *)
 
 (module+ test 
   (require rackunit)

beautiful-racket/br/demo/stacker3.rkt

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