如何让DrRacket正确地画出箭头

在DrRacket里，当光标移动到一个名字上时，会出现从其使用指向其定义的箭头。这个箭头可以辅助代码阅读，也预示了“变量重命名”功能的作用范围。

由于宏的存在，一部分的 identifier 会在宏返回的syntax对象中丢失，因此需要在宏返回的syntax对象的 syntax property 里追加相应的信息。涉及的 syntax property 有：

对宏编写者而言，disappeared-use属性动得最频繁。所有不出现在宏返回的syntax对象中的 identifier ，都应该被记录 syntax property 的这一项里（除了宏自己的名字的 identifier ，那个是由expander记录到origin属性）。

现在看一下几种常见的情况。

宏的Pattern 的 literal identifier

syntax-rules、syntax-case等的pattern里面的 literal identifier ，是disappeared-use属性遗漏的重灾区（截至7.8，case宏仍不能给else的使用画上箭头）。

下面这个程序非常简单，但是foo的使用却画不出箭头：

#lang racket

(define-syntax foo (syntax-rules ()))

(define-syntax bar
  (syntax-rules (foo)
    [(_ foo x) x]))

(bar foo 1)

所以，syntax-rules是不能自动处理好这个问题的。当需要匹配syntax中的 literal identifier 时，不要用syntax-rules。

(syntax-rules () _ ...)以外的用法都是不恰当的。

先考虑换成syntax-case：

(define-syntax (bar stx)
  (syntax-case stx (foo)
    [(_ foo x)
     #'x]))

这里有一个麻烦的地方，syntax-case不会为pattern中的 literal identifier 引入 pattern variable ，不能直接用 #'foo 访问到用户输入的foo。因此要变通一下：

(define-syntax (bar stx)
  (syntax-case stx ()
    [(_ foo-id x)
     (free-identifier=? #'foo-id #'foo)
     #'x]))

这里选择用syntax-case的"fender-expr"来对 literal identifier 进行匹配，这样#'foo-id就是用户输入的foo了。

然后是添加disappeared-use：

(define-syntax (bar stx)
  (syntax-case stx ()
    [(_ foo-id x)
     (free-identifier=? #'foo-id #'foo)
     (syntax-property #'x
                      'disappeared-use
                      (list (syntax-local-introduce #'foo-id)))]))

这里的syntax-local-introduce是必要的，因为宏展开结束反转 scope 的时候不会深入到 syntax property 里面的 identifier 。为了让foo能被正确识别为原始输入的一部分，需要手动用syntax-local-introduce反转 scope 。

syntax-parse

另一方面，syntax-parse支持#:track-literals选项，这种情况的处理就非常简单了：

(define-syntax-parser bar #:track-literals
  [(_ (~literal foo) x) #'x])

可以看出syntax-parse的巨大优势。因此在编写宏时，能用syntax-parse的应该尽量用。

"Pattern Expander"的Pattern中的literal identifier

对于模拟单步的宏展开的"pattern expander"（见可扩展的宏），情况要稍微复杂一些。有几种情况：

非表达式的位置

#lang racket
(require (for-syntax syntax/apply-transformer)
         syntax/parse/define)

(begin-for-syntax
  (define (apply-expander proc stx)
    (local-apply-transformer proc stx 'expression)))

(define-syntax foo (syntax-rules ()))

(define-syntax (use-expander stx)
  (syntax-case stx ()
    [(_ id in)
     #`(let (#,(apply-expander (syntax-local-value #'id) #'in))
         (void))]))

(define-syntax-parser expander1 #:track-literals
  [(~literal foo) #'[x 1]])

(use-expander expander1 foo)

这里，expander1的结果没有放在表达式位置，即便添加了#:track-literals，也没有用。

这种情况可以用with-disappeared-uses：

(define-syntax (use-expander stx)
  (syntax-case stx ()
    [(_ id in)
     (with-disappeared-uses
         (record-disappeared-uses #'id)
       #`(let (#,(apply-expander (syntax-local-value #'id) #'in))
           (void)))]))

(define-syntax-parser expander1
  [(~and (~literal foo) foo-id)
   (record-disappeared-uses #'foo-id)
   #'[x 1]])

这样，expander1和foo都画上了箭头。

非local-apply-transformer

把上面的apply-expander定义换成：

(define (apply-expander proc stx)
  (define introducer (make-syntax-introducer))
  (define intro-stx (introducer (syntax-local-introduce stx)))
  (syntax-local-introduce (introducer (proc intro-stx))))

这种旧式的展开方法因为record-disappeared-uses默认的syntax-local-introduce不是上面的introducer，所以画不出foo的箭头。

需要提供正确的introducer，并让record-disappeared-uses不进行syntax-local-introduce：

#lang racket
(require (for-syntax racket/syntax)
         syntax/parse/define)

(begin-for-syntax
  (define current-introducer (make-parameter #f))
  (define (current-introduce x)
    ((current-introducer) x))
  
  (define (apply-expander proc stx)
    (define introducer (make-syntax-introducer))
    (define intro-stx (introducer (syntax-local-introduce stx)))
    (syntax-local-introduce
     (introducer
      (parameterize ([current-introducer introducer])
        (proc intro-stx))))))


(define-syntax foo (syntax-rules ()))

(define-syntax (use-expander stx)
  (syntax-case stx ()
    [(_ id in)
     (with-disappeared-uses
         (record-disappeared-uses #'id)
       #`(let (#,(apply-expander (syntax-local-value #'id) #'in))
           (void)))]))

(define-syntax-parser expander1
  [(~and (~literal foo) foo-id)
   (record-disappeared-uses (current-introduce #'foo-id) #f)
   #'[x 1]])

(use-expander expander1 foo)

别人写的宏

如果上面的use-expander不能改，而expander1能改，那就要在expander1里寻找一个表达式位置了：

(define-syntax-parser expander1
  [(~and foo-id (~literal foo))
   #:with expr
   (syntax-property #'1
                    'disappeared-use
                    (list (syntax-local-introduce #'foo-id)))
   #'[x expr]])

若是非local-apply-transformer的情况（例如for），syntax-local-introduce不适用，可以改为用宏延迟 syntax property 的添加：

(define-syntax-parser disappeared-use
  [(_ x:id ...)
   (syntax-property
    #'(void)
    'disappeared-use
    (map syntax-local-introduce
         (syntax->list #'(x ...))))])

(define-syntax-parser expander1
  [(~and foo-id (~literal foo))
   #'[x (begin (disappeared-use foo-id) 1)]])

其他情况

参考如何使用First Class Internal Definition Context：

    (define-syntax-rule (syntax/track form)
      (syntax-case this-syntax ()
        [(head . _) (syntax-track-origin #'form this-syntax #'head)]))]
 ...
       [(begin form ...)
        #:with (expanded-form ...) (stx-map loop #'(form ...))
        (syntax/track (begin expanded-form ...))]
 ...

这里使用了syntax-track-origin来复制原有的 syntax property ，而原来的begin则被添加到origin属性中了。如果要继续添加disappeared-use属性，需要与原来的属性组合，类似于：

(syntax-property v
 'disappeared-use
 (cons (syntax-local-introduce #'id)
       (or (syntax-property v 'disappeared-use) null)))

至于sub-range-binders属性的用法比较简单，可以直接看The Racket Reference，一般用format-id的#:subs?特性即可。

其他情况也有，但由于不常见，这里不展开讨论。

Arrow Art

用这些箭头画一些图案的行为叫做Arrow Art，示例（需要通过右键 -> "Tack/Untack Arrow(s)"固定箭头看到效果）：

#lang racket
(define-syntax (arrow-art stx)
  (syntax-case stx ()
    [(_ id ...)
     (syntax-property
      (syntax-property
       #'(void)
       'disappeared-use
       (map syntax-local-introduce (syntax->list #'(id ...))))
      'disappeared-binding
      (map syntax-local-introduce (syntax->list #'(id ...))))]))

(arrow-art a     a
          
              a)

(arrow-art b     b

              b


              b)