diff --git a/beautiful-racket-lib/br/syntax-scopes-test.rkt b/beautiful-racket-lib/br/syntax-scopes-test.rkt index aa26775..697c45a 100644 --- a/beautiful-racket-lib/br/syntax-scopes-test.rkt +++ b/beautiful-racket-lib/br/syntax-scopes-test.rkt @@ -8,36 +8,54 @@ (define-scope green (blue yellow)) (define-scope purple (blue red))) -(define #'(define-blue _id _val) - (with-blue-binding-form ([x '_id]) - #'(define x _val))) +(define #'(def-blue-x) + (with-blue-binding-form (x) + #'(define x (+ 42 42)))) -#;(define-blue x (+ 42 42)) -(define #'(def-x) - (with-blue-binding-form ([x 'x]) - #'(define x (+ 42 42)))) +(define #'(print-blue-x) + (with-purple-identifiers (x) + #'x)) -(define #'(def-x-2) - (with-yellow-binding-form ([x 'x]) - #'(define x (+ 42)))) -(define #'(print-x) - (with-yellow-syntax ([x 'x]) - #'(println (+ x x)))) +(define #'(define-blue _id _expr) + (with-syntax ([_id (blue-binding-form #'_id)]) + #'(define _id _expr))) -(define #'(print-x-2) - (with-purple-syntax ([x 'x]) - #'(println (+ x x x)))) -(scopes (syntax-find (expand-once #'(def-x)) 'x)) -(def-x) -(def-x-2) +(define #'(print-blue-y) + (with-blue-identifiers (y) + #'y)) + +(scopes (syntax-find (expand-once #'(def-blue-x)) 'x)) +(def-blue-x) +(scopes (syntax-find (expand-once #'(print-blue-x)) 'x)) +(print-blue-x) +(let () + (scopes (syntax-find (expand-once #'(print-blue-x)) 'x)) + #;(print-blue-x)) ;; error why? + +(define-blue y (+ 42 42)) +(print-blue-y) + +#| +(define #'(def-y) + (with-yellow-binding-form (y) + #'(define y (+ 42)))) + + + + +#;(scopes (syntax-find (expand-once #'(def-x)) 'x)) +#;(def-x) +(def-y) (scopes (syntax-find (expand-once #'(print-x)) 'x)) (print-x) -(scopes (syntax-find (expand-once #'(print-x-2)) 'x)) -(print-x-2) +(scopes (syntax-find (expand-once #'(print-y)) 'y)) +(print-y) #;(let-syntax ([x (λ(stx) (syntax-case stx () [_ #'42]))]) - (* x 4)) + (* x 4)) + +|# diff --git a/beautiful-racket-lib/br/syntax.rkt b/beautiful-racket-lib/br/syntax.rkt index 2193f0f..fc29ee7 100644 --- a/beautiful-racket-lib/br/syntax.rkt +++ b/beautiful-racket-lib/br/syntax.rkt @@ -67,9 +67,9 @@ [else (raise-argument-error 'syntax-find "not given syntax or datum as second argument" stx-or-datum)])) (let/ec exit (let loop ([so stx]) - (cond - [(eq? (syntax->datum so) datum) (exit so)] - [(syntax->list so) => (curry map loop)])))) + (cond + [(eq? (syntax->datum so) datum) (exit so)] + [(syntax->list so) => (curry map loop)])))) (define (->syntax x) @@ -85,7 +85,8 @@ [add-id (format-id #'id "add-~a" #'id)] [flip-id (format-id #'id "flip-~a" #'id)] [id-binding-form (format-id #'id "~a-binding-form" #'id)] - [with-id-syntax (format-id #'id "with-~a-syntax" #'id)] + [define-id (format-id #'id "define-~a" #'id)] + [with-id-identifiers (format-id #'id "with-~a-identifiers" #'id)] [let-id-syntax (format-id #'id "let-~a-syntax" #'id)] [with-id-binding-form (format-id #'id "with-~a-binding-form" #'id)] [remove-id (format-id #'id "remove-~a" #'id)] @@ -113,10 +114,10 @@ (member (car (context (add-id (datum->syntax #f '_)))) (context (->syntax x))) #t)) - (define-syntax-rule (with-id-syntax ([pat val] (... ...)) . body) - (with-syntax ([pat (id* val)] (... ...)) . body)) - (define-syntax-rule (with-id-binding-form ([pat val] (... ...)) . body) - (with-syntax ([pat (id-binding-form val)] (... ...)) . body)) + (define-syntax-rule (with-id-identifiers (name (... ...)) . body) + (with-syntax ([name (id* 'name)] (... ...)) . body)) + (define-syntax-rule (with-id-binding-form (name (... ...)) . body) + (with-syntax ([name (id-binding-form 'name)] (... ...)) . body)) (define-syntax-rule (let-id-syntax ([pat val] (... ...)) . body) (let-syntax ([pat (id* val)] (... ...)) . body))))]))