resyntax/default-recommendations/syntax-parse-shortcuts.rkt at db3af6a8cbee555b98c8875be1d2ea38de35d3d0 · 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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
#lang racket/base


(require racket/contract/base)


(provide
 (contract-out
  [syntax-parse-shortcuts refactoring-suite?]))


(require (for-syntax racket/base
                     syntax/parse)
         rebellion/private/static-name
         resyntax/base
         resyntax/private/more-syntax-parse-classes
         resyntax/private/syntax-traversal
         racket/stream
         syntax/parse
         syntax/parse/define)


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


(define-refactoring-rule define-syntax-syntax-parse-to-define-syntax-parse-rule
  #:description
  "This `define-syntax` macro with a single `syntax-parse` clause can be replaced with a simpler,
equivalent `define-syntax-parse-rule` macro."
  #:literals (define-syntax lambda [syntax-parse syntax-parse #:phase 1] [syntax-id syntax #:phase 1])

  (define-syntax macro:id
    (lambda (stx-id:id)
      (syntax-parse stx-id2:id
        [(_ pattern ...) directive:syntax-parse-pattern-directive ... (syntax-id last-form)])))

  #:when (free-identifier=? (attribute stx-id) (attribute stx-id2) 1)

  #:with (new-body ...)
  (syntax-traverse #'((~@ . directive) ... last-form)
    [id-in-body:id
     #:when (free-identifier=? (attribute id-in-body) (attribute stx-id) 1)
     (syntax-property #'this-syntax 'skip-incorrect-binding-check? #true)])

  (define-syntax-parse-rule (macro pattern ...) new-body ...))


(define-refactoring-rule define-syntax-parser-to-define-syntax-parse-rule-simple
  #:description
  "This `define-syntax-parser` macro with a single clause can be replaced with a simpler, equivalent
`define-syntax-parse-rule` macro."
  #:literals (define-syntax-parser [syntax-id syntax #:phase 1])

  (define-syntax-parser macro:id
    [(_ . pattern) directive:syntax-parse-pattern-directive ... (syntax-id last-form)])

  #:with (new-body ...)
  #'((~@ . directive) ... last-form)

  (define-syntax-parse-rule (macro . pattern) new-body ...))


(define-refactoring-suite syntax-parse-shortcuts
  #:rules (define-syntax-syntax-parse-to-define-syntax-parse-rule
           define-syntax-parser-to-define-syntax-parse-rule-simple))