Use with-disappeared-uses to make DrRacket draw arrows from expander definitions to their uses.
This commit is contained in:
parent
f0fcc2b169
commit
8f836d6c16
|
@ -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)))
|
13
test/test-arrows.rkt
Normal file
13
test/test-arrows.rkt
Normal 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)
|
Loading…
Reference in New Issue
Block a user