Fixed documentation: expand-all-expanders-of-type should be expand-syntax-tree-with-expanders-of-type

Remove the extra use-site scope on the body of define-?-expander.

private/define-expanders.rkt

@@ -7,6 +7,13 @@
 
 (provide define-expander-type)
 
+(define-for-syntax (remove-use-site-scope stx)
+  (define bd
+    (syntax-local-identifier-as-binding (syntax-local-introduce #'here)))
+  (define delta
+    (make-syntax-delta-introducer (syntax-local-introduce #'here) bd))
+  (delta stx 'remove))
+
 (define-syntax define-expander-type
   (syntax-parser
     [(_ name:id)
@@ -15,13 +22,17 @@
                                [?-expander? "~a-expander?"]
                                [define-?-expander "define-~a-expander"]
                                [expand-all-?-expanders "expand-all-~a-expanders"])
-                       #'(begin
+                       #`(begin
                            (define-for-syntax ?-expander-type (make-expander-type))
                            (define-for-syntax (make-?-expander transformer)
                              (expander ?-expander-type transformer))
                            (define-for-syntax (?-expander? v)
-                             (expander-of-type? ?-expander-type v))
-                           (define-syntax-rule (define-?-expander expander-name transformer)
-                             (define-syntax expander-name (make-?-expander transformer)))
+                             (and (expander? v)
+                                  (expander-of-type? ?-expander-type v)))
+                           (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)
                              (expand-syntax-tree-with-expanders-of-type ?-expander-type stx))))]))

private/define-expanders.scrbl

@@ -23,6 +23,7 @@ expanders for use with other macros.
    environment}
  @item{@code{expand-all-id-expanders} - a procedure bound at phase
    @; TODO: expand-all-expanders-of-type is not documented
-   level 1 that's equivalent to @racket[expand-all-expanders-of-type] with
-   the @code{id-expander-type} as the type argument}
+   level 1 that's equivalent to
+   @racket[expand-syntax-tree-with-expanders-of-type] with the
+   @code{id-expander-type} as the type argument}
  ]}

private/expanders.rkt

@@ -4,16 +4,14 @@
          syntax/parse
          syntax/stx
          predicates
-         fancy-app)
+         fancy-app
+         racket/syntax)
 
 (provide (struct-out expander)
          (contract-out
           [expander-of-type? (-> expander-type? expander? boolean?)]
           [expand-syntax-tree-with-expanders-of-type (-> expander-type? syntax? syntax?)]))
 
-(define (maybe-syntax-local-value stx)
-  (syntax-local-value stx (λ () #f)))
-
 (struct expander (type transformer))
 
 (define (expander-of-type? type expander)
@@ -22,12 +20,12 @@
 (define (expander-stx? v)
   (and (syntax? v)
        (syntax-parse v
-         [(id:id _ ...) (expander? (maybe-syntax-local-value #'id))]
+         [(id:id . _) (syntax-local-value/record #'id expander?)]
          [_ #f])))
 
 (define (expander-stx->expander expander-stx)
   (syntax-parse expander-stx
-    [(id:id _ ...) (maybe-syntax-local-value #'id)]))
+    [(id:id . _) (syntax-local-value/record #'id expander?)]))
 
 (define (expander-stx-of-type? type v)
   (and (expander-stx? v)
@@ -47,6 +45,7 @@
 
 (define (expand-syntax-tree-with-expanders-of-type type stx)
   (define not-expander-stx-of-type? (not? (expander-stx-of-type? type _)))
-  (expand-syntax-tree not-expander-stx-of-type?
-                      call-expander-transformer
-                      stx))
+  (with-disappeared-uses 
+   (expand-syntax-tree not-expander-stx-of-type?
+                       call-expander-transformer
+                       stx)))

test/test-arrows.rkt

@@ -0,0 +1,13 @@
+#lang racket
+(require generic-syntax-expanders rackunit)
+(define-expander-type foo)
+(define-foo-expander foo1 (λ _ #''ok))
+(define-syntax (bar stx)
+  (syntax-case stx ()
+    [(_ body)
+     (expand-all-foo-expanders #'body)]))
+;; When hovering "foo1" in the code below with the mouse, an arrow should 
+;; be shown in DrRacket from the foo1 in (define-foo-expander foo1 …) above.
+;; This is not automatically checked, as it would be difficult/brittle to check
+;; for the syntax property. Patches welcome.
+(check-equal? (bar (foo1)) 'ok)

test/test-call-with-dotted-last.rkt

@@ -0,0 +1,22 @@
+#lang racket
+
+(require generic-syntax-expanders
+         (for-syntax syntax/parse)
+         rackunit)
+
+(define-expander-type foo)
+
+(define-foo-expander some-foo-expander
+  (syntax-parser
+    [(_ a:id b:id c:id . d:id) #'(d c b a)]))
+
+(define-syntax (test-foo-expander stx)
+  (syntax-parse stx
+    [(_ e:expr)
+     #`'#,(expand-all-foo-expanders #'e)]))
+
+(test-equal?
+ "Check that some-foo-expander accepts being called
+ when it is the first item of a dotted list"
+ (test-foo-expander (some-foo-expander x y z . t))
+ '(t z y x))

test/test-define-x-expander-use-site-scope-simple.rkt

@@ -0,0 +1,175 @@
+#lang racket
+
+;; For a more realistic use-case justifying why this behaviour matters, see the
+;; discussion at https://github.com/jackfirth/generic-syntax-expanders/pull/8
+;; and in particular the test file at
+;;   https://github.com/jsmaniac/generic-syntax-expanders
+;;     /blob/ec43791028715221c678f8536389a39ee760ed98
+;;     /test/test-define-x-expander-use-site-scope.rkt
+
+(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))))

test/test-foo-mixin-expander-predicate.rkt

@@ -0,0 +1,61 @@
+#lang racket
+
+(require generic-syntax-expanders
+         (for-syntax syntax/parse
+                     rackunit))
+(require (for-syntax generic-syntax-expanders))
+(define-expander-type foo)
+(define-expander-type other)
+(define-foo-expander foo-exp (λ (stx) #''foo-exp-is-a-foo-expander))
+(define-other-expander other-exp (λ (stx) #''other-exp-is-not-a-foo-expander))
+(define-syntax not-an-expander 'syntax-local-value-is-not-an-expander)
+(begin-for-syntax
+  (test-not-exn
+   "Check that foo-expander? can be passed any value, not just an expander?"
+   (λ ()
+     (foo-expander? 123)
+     (void)))
+  
+  (test-false
+   "Check that (static foo-expander?) rejects syntax that is not an identifier?"
+   (syntax-parse #'(definitely not-a-foo-expander)
+     [(~var exp (static foo-expander? "a foo expander")) #t]
+     [_ #f]))
+  
+  (test-false
+   "Check that (static foo-expander?) rejects an id without syntax-local-value"
+   (syntax-parse #'no-syntax-local-value
+     [(~var exp (static foo-expander? "a foo expander")) #t]
+     [_ #f]))
+
+  (test-begin
+   (test-false
+    "Check that foo-expander? rejects an id which is not an expander?"
+    (foo-expander? (syntax-local-value #'not-an-expander)))
+   (test-false
+    "Check that foo-expander? rejects an id which is not an expander?"
+    (syntax-parse #'not-an-expander
+      [(~var exp (static foo-expander? "a foo expander")) #t]
+      [_ #f])))
+
+  (test-begin
+   (test-false
+    (string-append "Check that foo-expander? rejects an id which is an"
+                   " expander? but not a foo-expander?")
+    (foo-expander? (syntax-local-value #'other-exp)))
+   (test-false
+    (string-append "Check that foo-expander? rejects an id which is an"
+                   " expander? but not a foo-expander?")
+    (syntax-parse #'other-exp
+      [(~var exp (static foo-expander? "a foo expander")) #t]
+      [_ #f])))
+
+  (test-begin
+   (test-true
+    "Check that foo-expander? accepts an id which is a foo-expander?"
+    (foo-expander? (syntax-local-value #'foo-exp)))
+   (test-true
+    "Check that foo-expander? accepts an id which is a foo-expander?"
+    (syntax-parse #'foo-exp
+      [(~var exp (static foo-expander? "a foo expander")) #t]
+      [_ #f]))))