www

commit 8f836d6c16f8e140b696dac32d112b562824d0be
parent f0fcc2b16997c76e0e1b270a70b58a73c374a84f
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Tue, 30 Aug 2016 12:39:14 +0200

Use with-disappeared-uses to make DrRacket draw arrows from expander definitions to their uses.

Diffstat:
M
private/expanders.rkt
 | 
19
+++++++++----------
A
test/test-arrows.rkt
 | 
14
++++++++++++++

2 files changed, 23 insertions(+), 10 deletions(-)
diff --git a/private/expanders.rkt b/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))
-\ No newline at end of file
+  (with-disappeared-uses 
+   (expand-syntax-tree not-expander-stx-of-type?
+                       call-expander-transformer
+                       stx)))
+\ No newline at end of file
diff --git a/test/test-arrows.rkt b/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)
+\ No newline at end of file