diff --git a/beautiful-racket-lib/br/quicklang.rkt b/beautiful-racket-lib/br/quicklang.rkt index 5bbb1c7..04eafd2 100644 --- a/beautiful-racket-lib/br/quicklang.rkt +++ b/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) - (#%module-begin - (provide #%top #%app #%datum #%top-interaction) - . lines)) +(define-macro (quicklang-mb . exprs) + (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)))) + (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 diff --git a/beautiful-racket/br/demo/stacker.rkt b/beautiful-racket/br/demo/stacker.rkt index 4024496..c362753 100644 --- a/beautiful-racket/br/demo/stacker.rkt +++ b/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]) - #'(module stacker-mod br/demo/stacker - (push STACK-ARG) ...)))) -(provide read-syntax) + (strip-context + (with-pattern ([(STACK-ARG ...) stack-args]) + #'(module stacker-mod br/demo/stacker + (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")) \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker2.rkt b/beautiful-racket/br/demo/stacker2.rkt index 6d3adb3..30f884c 100644 --- a/beautiful-racket/br/demo/stacker2.rkt +++ b/beautiful-racket/br/demo/stacker2.rkt @@ -1,13 +1,13 @@ #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]) #'(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) - (cons arg stack) - (let* ([op arg] - [result (op (first stack) (second stack))]) - (cons result (drop stack 2))))) + (cond + [(number? arg) (cons arg stack)] + [else + (define result (arg (first stack) (second stack))) + (cons result (drop stack 2))])) -(provide + * #%app #%datum #%top-interaction) +(provide + *) (module+ test (require rackunit) diff --git a/beautiful-racket/br/demo/stacker3-test.rkt b/beautiful-racket/br/demo/stacker3-test.rkt new file mode 100644 index 0000000..9b826db --- /dev/null +++ b/beautiful-racket/br/demo/stacker3-test.rkt @@ -0,0 +1,8 @@ +#lang reader br/demo/stacker3 +4 +8 + ++ +3 + +* \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker3.rkt b/beautiful-racket/br/demo/stacker3.rkt new file mode 100644 index 0000000..4990803 --- /dev/null +++ b/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")) \ No newline at end of file