private/define-expanders.rkt

@@ -27,8 +27,7 @@
                            (define-for-syntax (make-?-expander transformer)
                              (expander ?-expander-type transformer))
                            (define-for-syntax (?-expander? v)
-                             (and (expander? v)
-                                  (expander-of-type? ?-expander-type v)))
+                             (expander-of-type? ?-expander-type v))
                            (define-syntax define-?-expander
                              (syntax-parser
                                [(_ expander-name:id transformer:expr)

private/define-expanders.scrbl

@@ -23,7 +23,6 @@ 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-syntax-tree-with-expanders-of-type] with the
-   @code{id-expander-type} as the type argument}
+   level 1 that's equivalent to @racket[expand-all-expanders-of-type] with
+   the @code{id-expander-type} as the type argument}
  ]}

private/expanders.rkt

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

test/test-arrows.rkt

@@ -1,13 +0,0 @@
-#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

@@ -1,22 +0,0 @@
-#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-foo-mixin-expander-predicate.rkt

@@ -1,61 +0,0 @@
-#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]))))