resyntax/default-recommendations/deprecation-migrations.rkt at 2ff14140c75ff11d64ceada15d71138d457e94ea · jackfirth/resyntax · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
#lang racket/base


(require racket/contract/base)


(provide
 (contract-out
  [deprecation-migrations refactoring-suite?]))


(require racket/class
         resyntax/base
         resyntax/deprecated-alias
         syntax/parse)


;@----------------------------------------------------------------------------------------------------


(define (resyntax-phase1-eval compile-time-expression-stx #:quote-syntax? [quote-syntax? #false])
  (namespace-require 'syntax/macro-testing)
  (namespace-require '(for-syntax racket/base))
  (if quote-syntax?
      (eval `(phase1-eval ,(syntax->datum compile-time-expression-stx) #:quote quote-syntax))
      (eval `(phase1-eval ,(syntax->datum compile-time-expression-stx)))))


(define-refactoring-rule inline-deprecated-alias
  #:description "This form has been renamed. Use the new name instead of the deprecated alias."

  (alias-id:id . tail)

  #:do [(namespace-require '(for-syntax resyntax/deprecated-alias))]
  #:when (resyntax-phase1-eval
          #'(let-values ([(immediate _)
                          (syntax-local-value/immediate #'alias-id (λ () (values #false #false)))])
              (deprecated-alias? immediate)))
  #:do [(define target-id-symbol
          (resyntax-phase1-eval
           #'(let-values ([(immediate _)
                           (syntax-local-value/immediate #'alias-id
                                                         (λ () (values #false #false)))])
               (deprecated-alias-target immediate))))]
  #:with target-id (datum->syntax #'alias-id target-id-symbol)

  (target-id . tail))


(define-refactoring-suite deprecation-migrations
  #:rules (inline-deprecated-alias))