diff --git a/private/define-expanders.rkt b/private/define-expanders.rkt index 1a31f1c..2ed4c47 100644 --- a/private/define-expanders.rkt +++ b/private/define-expanders.rkt @@ -21,7 +21,6 @@ [make-?-expander "make-~a-expander"] [?-expander? "~a-expander?"] [define-?-expander "define-~a-expander"] - [define-?-expander-bug "define-~a-expander-bug"] [expand-all-?-expanders "expand-all-~a-expanders"]) #`(begin (define-for-syntax ?-expander-type (make-expander-type)) @@ -29,9 +28,9 @@ (expander ?-expander-type transformer)) (define-for-syntax (?-expander? v) (expander-of-type? ?-expander-type v)) - (define-syntax (define-?-expander stx) - (syntax-case stx () - [(_ expander-name transformer) + (define-syntax define-?-expander + (syntax-parser + [(_ expander-name:id transformer:expr) (remove-use-site-scope #'(define-syntax expander-name (make-?-expander transformer)))])) (define-for-syntax (expand-all-?-expanders stx) diff --git a/test/test-define-x-expander-use-site-scope-simple.rkt b/test/test-define-x-expander-use-site-scope-simple.rkt new file mode 100644 index 0000000..294cf1d --- /dev/null +++ b/test/test-define-x-expander-use-site-scope-simple.rkt @@ -0,0 +1,172 @@ +#lang racket + +;; This test is simpler than test-define-x-expander-use-site-scope.rkt, +;; but is a bit more artificial. For a more realistic use-case, see the +;; test-define-x-expander-use-site-scope.rkt file. + +(require generic-syntax-expanders + rackunit) + +(define-expander-type foo) + +(define-syntax (expand-foos stx) + (syntax-case stx () + [(_ body) + (expand-all-foo-expanders #'body)])) + +;; Without PR #8, the `x` in `bb` is not `bound-identifier=?` to the `x` +;; defined by `aa`, despite the use of `syntax-local-introduce` to make the +;; macros unhygienic. +;; +;; This happens because `define-foo-expander` added an extra "use-site" scope +;; to the body of `aa` and a different "use-site" scope to the body of `bb`. +(define-foo-expander aa + (λ (_) + (syntax-local-introduce #'[x #t]))) + +(define-foo-expander bb + (λ (_) + (syntax-local-introduce #'x))) + +;; Due to the way `let` itself adds scopes to its definition and body, this +;; makes the identifiers `x` from `aa` and `x` from `bb` distinct, and the +;; latter cannot be used to refer to the former. +;; +;; Approximately, the code below expands to +;; +;; (let [(x⁰¹ #t)] +;; x⁰²) +;; +;; The `let` form then adds a "local" scope to both occurrences of `x`, and an +;; internal-definition context "intdef" scope to the `x` present in the body of +;; the `let` (but not to the one present in the bindings). The expanded form +;; therefore becomes: +;; +;; (let [(x⁰¹³ #t)] +;; x⁰²³⁴) +;; +;; where: +;; ⁰ are the module's scopes +;; ¹ is the undesired "use-site" scope added by `define-foo-expander` on `aa` +;; ² is the undesired "use-site" scope added by `define-foo-expander` on `bb` +;; ³ is the "local" scope added by `let` +;; ⁴ is the "intdef" scope added by `let` +;; +;; Since {0,2,3,4} is not a subset of {0,1,3}, the `x` inside the `let` is +;; unbound. +(test-true + "Test that `x` as produced by `(bb)` is correctly bound by the `x` + introduced by `(aa)`. + +This test fails without the PR #8 patch, because the body of `bb` and the body + of `aa` each have a different use-site scope, introduced by accident by + `define-foo-expander`. The occurrence of `x` introduced by `aa` and the + occurrence of `x` introduced by `bb` therefore have different scopes, and the + latter is not bound by the former. + +Without the PR #8 patch, this test case will not compile, and will fail with + the error `x: unbound identifier in module`." + (expand-foos + (let ((aa)) + (bb)))) + +;; ---------- + +;; It is worth noting that `define` seems to strip the "use-site" scopes present +;; on the defined identifier. If the code above is changed so that a `define` +;; form is used, the problem does not occur: +(define-foo-expander aa-def + (λ (_) + (syntax-local-introduce #'[define y #t]))) + +(define-foo-expander bb-def + (λ (_) + (syntax-local-introduce #'y))) + +;; This is because the code below expands to: +;; +;; (begin (define y⁰ #t) +;; (define y-copy y⁰²⁵) +;; +;; where: +;; ⁰ are the module's scopes +;; ¹ is the undesired "use-site" scope added by `define-foo-expander` on `aa` +;; and it is stripped by `define` from the first `y` +;; ² is the undesired "use-site" scope added by `define-foo-expander` on `bb` +;; ⁵ is the "use-site" scope added because it is in an expression position +;; +;; Since {0,2,5} is a subset of {0}, the second `y` refers to the first `y`. +(expand-foos + (begin (aa-def) + (define y-copy (bb-def)))) +(test-true + "Test that `y` as produced by `(bb-def)` is correctly bound by the `y` + defined by `(aa-def)`. + +This test succeeds without the PR #8 patch, which shows that `define` removes + all use-site scopes on the defined identifier (or at least it removes all the + use-site scopes present in this example). This can be checked in the macro + debugger, and explains why the test case did not fail with a simple `define`, + but does fail with a binding introduced by a `let`." + y-copy) + +;; ---------- + +;; The code below attempts to remove the extra "use-site" scope with +;; `syntax-local-identifier-as-binding`. However, that function does +;; not remove all use-site scopes, unlike the `define` above. + +(define-foo-expander aa-as-binding + (λ (_) + #`[#,(syntax-local-identifier-as-binding (syntax-local-introduce #'z)) #t])) + +(define-foo-expander bb-as-binding + (λ (_) + (syntax-local-introduce #'z))) + +(test-true + "Test that `z` as produced by `(bb-as-binding)` is correctly bound by + the `z` defined by `(aa-as-binding)`. + +This test fails without the PR #8 patch, which shows that that unlike `define`, + the `syntax-local-identifier-as-binding` function does not remove all use-site + scopes. + +Without the PR #8 patch, this test case will not compile, and will fail with + the error `z: unbound identifier in module`." + (expand-foos + (let ((aa-as-binding)) + (bb-as-binding)))) + +;; ---------- + +;; The `cc` expander acts either as aa or as bb depending on the keyword passed +;; to it. Without PR #8, the code below still compiles fine. +;; +;; +;; The fact that it worked without the patch testifies that the extra scope +;; was added on the definition of `aa` and `bb`, instead of being a new fresh +;; scope added each time the expander is called. Here, we have two calls to +;; the `cc` expander successfully communicating via the `w` variable, thanks +;; to `syntax-local-introduce` (which makes the macros unhygienic). +(define-foo-expander cc + (λ (stx) + (syntax-case stx () + [(_ #:aa) + (begin + (syntax-local-introduce #'[w #t]))] + [(_ #:bb) + (begin + (syntax-local-introduce #'w))]))) + +(test-true + "Test that `w` as produced by `(cc #:bb)` is correctly bound by the `w` + introduced by `(cc #:aa)`. + +This test succeeds without the PR #8 patch, which shows that the extra + scopes are per-expander and not per-invocation. Expanders can still be + unhygienic using `syntax-local-introduce`, but can communicate only with + themselves." + (expand-foos + (let ((cc #:aa)) + (cc #:bb)))) \ No newline at end of file diff --git a/test/test-define-x-expander-use-site-scope.rkt b/test/test-define-x-expander-use-site-scope.rkt index 34a1646..c7cb5e8 100644 --- a/test/test-define-x-expander-use-site-scope.rkt +++ b/test/test-define-x-expander-use-site-scope.rkt @@ -1,5 +1,9 @@ #lang racket +;; This test is a real-world use case for the simplified test in the +;; test-define-x-expander-use-site-scope-simple.rkt file. See that other +;; file for more thorrough explanations. + (require syntax/parse syntax/parse/experimental/eh generic-syntax-expanders @@ -10,8 +14,7 @@ (define-expander-type eh-mixin) -(begin-for-syntax - (define eh-post-accumulate (make-parameter #f))) +(define-for-syntax eh-post-accumulate (make-parameter #f)) (define-for-syntax (strip-use-site stx) (define bd @@ -59,15 +62,36 @@ #:post (~fail #:when (and (attribute some-pat) (attribute other-pat)))) -(check-equal? (syntax-parse #'(#:some) - [((~no-order (aa) (bb))) 'ok]) - 'ok) +(test-true + "Test that `#:some` and `#:other` are mutually exclusive. +This test will not compile without PR #8. +* `aa` expands to `(~and some-pat #:some)` +* `bb` expands to `(~and other-pat #:other)` +* `bb` injects after the unorderd sequence the check + `(and (attribute some-pat) (attribute other-pat))` +However, without the patch, `some-pat` inside the expression + `(and (attribute some-pat) (attribute other-pat))` has an extra + scope ¹ added by `define-eh-mixin-expander` on the whole body + of `bb`, while the pattern `(~and some-pat #:some)` has an extra + scope ² added by `define-eh-mixin-expander` on the whole body + of `aa`. +This means that `some-pat` inside the check is unbound, and the + compiler gives an error on the `some-pat` identifier declared + above." + (syntax-parse #'(#:some #:other) + [((~no-order (aa) (bb))) #f] + [_ #t])) -(check-equal? (syntax-parse #'(#:other) - [((~no-order (aa) (bb))) 'ok]) - 'ok) +(test-true + "Test that `#:some` on its own is accepted. + This test will not compile without PR #8 for the same reason as the + mutually-exclusive test above." + (syntax-parse #'(#:some) + [((~no-order (aa) (bb))) #t])) -(check-equal? (syntax-parse #'(#:some #:other) - [((~no-order (aa) (bb))) 'wrong] - [_ 'ok]) - 'ok) \ No newline at end of file +(test-true + "Test that `#:other` on its own is accepted. + This test will not compile without PR #8 for the same reason as the + mutually-exclusive test above." + (syntax-parse #'(#:other) + [((~no-order (aa) (bb))) #t])) \ No newline at end of file