diff --git a/beautiful-racket-lib/br/quicklang.rkt b/beautiful-racket-lib/br/quicklang.rkt index 04eafd2..a12ff6a 100644 --- a/beautiful-racket-lib/br/quicklang.rkt +++ b/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)))) - (loop (cons (list (string->symbol (keyword->string (syntax-e (car exprs)))) + (if (and (pair? exprs) (keyword? (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)))) diff --git a/beautiful-racket/br/demo/stacker copy.rkt b/beautiful-racket/br/demo/stacker copy.rkt new file mode 100644 index 0000000..61ae415 --- /dev/null +++ b/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")) \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker.rkt b/beautiful-racket/br/demo/stacker.rkt index defd7f0..fb67913 100644 --- a/beautiful-racket/br/demo/stacker.rkt +++ b/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)) - (with-pattern ([(STACK-ARG ...) stack-args]) + (define args (port->list read in-port)) + (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))) - (set! stack (cons result (drop stack 2)))])) -(provide push) + (define op-result (arg (first stack) (second stack))) + (set! stack (cons op-result (drop stack 2)))])) (provide + *) diff --git a/beautiful-racket/br/demo/stacker0-test.rkt b/beautiful-racket/br/demo/stacker0-test.rkt new file mode 100644 index 0000000..596f3df --- /dev/null +++ b/beautiful-racket/br/demo/stacker0-test.rkt @@ -0,0 +1,6 @@ +#lang reader br/demo/stacker0 +4 +8 ++ +3 +* \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker0.rkt b/beautiful-racket/br/demo/stacker0.rkt new file mode 100644 index 0000000..227b153 --- /dev/null +++ b/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")) \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker1-test.rkt b/beautiful-racket/br/demo/stacker1-test.rkt new file mode 100644 index 0000000..f5af26a --- /dev/null +++ b/beautiful-racket/br/demo/stacker1-test.rkt @@ -0,0 +1,6 @@ +#lang reader br/demo/stacker1 +4 +8 ++ +3 +* \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker1.rkt b/beautiful-racket/br/demo/stacker1.rkt new file mode 100644 index 0000000..90ad172 --- /dev/null +++ b/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")) \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker2.rkt b/beautiful-racket/br/demo/stacker2.rkt index ed0e1db..7abed0d 100644 --- a/beautiful-racket/br/demo/stacker2.rkt +++ b/beautiful-racket/br/demo/stacker2.rkt @@ -1,30 +1,26 @@ #lang br/quicklang -#:read-syntax stacker-read-syntax -#:#%module-begin stacker-module-begin +(provide read-syntax + (rename-out [stacker-module-begin #%module-begin]) + + *) -(define (stacker-read-syntax src-path in-port) - (define stack-args (port->list read in-port)) - (with-pattern ([(STACK-ARG ...) stack-args]) - (strip-identifier-bindings - #'(module stacker2-mod br/demo/stacker2 - STACK-ARG ...)))) +(define (read-syntax src-path in-port) + (define args (port->list read in-port)) + (define module-datum `(module stacker2-mod br/demo/stacker2 + ,@args)) + (datum->syntax #f module-datum)) -(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 - [(number? arg) (cons arg stack)] - [else - (define result (arg (first stack) (second stack))) - (cons result (drop stack 2))])) - -(provide + *) + (if (number? arg) + (cons arg stack) + (cons (arg (first stack) (second stack)) (drop stack 2)))) (module+ test (require rackunit) diff --git a/beautiful-racket/br/demo/stacker3.rkt b/beautiful-racket/br/demo/stacker3.rkt index 4990803..d589234 100644 --- a/beautiful-racket/br/demo/stacker3.rkt +++ b/beautiful-racket/br/demo/stacker3.rkt @@ -1,24 +1,22 @@ #lang br/quicklang -#:read-syntax stacker-read-syntax -#:#%module-begin stacker-module-begin +(provide read-syntax (rename-out [stacker-module-begin #%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 - (first - (foldl (λ(arg stack) - (if (number? arg) - (cons arg stack) - (cons (arg (car stack) (cadr stack)) (cddr stack)))) - null (list STACK-ARG ...)))))) + (display (first + (foldl + (λ(x xs) + (if (number? x) + (cons x xs) + (cons (x (car xs) (cadr xs)) (cddr xs)))) + null (list 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 + (check-equal? (with-output-to-string (λ () (dynamic-require "stacker3-test.rkt" #f))) "36")) \ No newline at end of file