Compare commits

..

2 Commits

3 changed files with 24 additions and 11 deletions

View File

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

View File

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

13
test/test-arrows.rkt Normal file
View File

@ -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)