diff --git a/racket/collects/syntax/parse.rkt b/racket/collects/syntax/parse.rkt index 7e920c2a1e..6d72774e29 100644 --- a/racket/collects/syntax/parse.rkt +++ b/racket/collects/syntax/parse.rkt @@ -12,8 +12,7 @@ (begin-for-syntax (require racket/contract/base - "parse/private/pattern-expander-prop.rkt" - "parse/private/pattern-expander.rkt") + syntax/parse/private/residual-ct) (provide pattern-expander? (contract-out [pattern-expander @@ -21,4 +20,11 @@ [prop:pattern-expander (struct-type-property/c (-> pattern-expander? (-> syntax? syntax?)))] [syntax-local-syntax-parse-pattern-introduce - (-> syntax? syntax?)]))) + (-> syntax? syntax?)])) + + (define pattern-expander + (let () + (struct pattern-expander (proc) #:transparent + #:omit-define-syntaxes + #:property prop:pattern-expander (λ (this) (pattern-expander-proc this))) + pattern-expander))) diff --git a/racket/collects/syntax/parse/debug.rkt b/racket/collects/syntax/parse/debug.rkt index a101d3a0d5..a816fd4c6e 100644 --- a/racket/collects/syntax/parse/debug.rkt +++ b/racket/collects/syntax/parse/debug.rkt @@ -8,7 +8,8 @@ racket/list racket/pretty "../parse.rkt" - syntax/parse/private/residual + (except-in syntax/parse/private/residual + prop:pattern-expander syntax-local-syntax-parse-pattern-introduce) "private/runtime.rkt" "private/runtime-progress.rkt" "private/runtime-report.rkt" diff --git a/racket/collects/syntax/parse/private/pattern-expander-prop.rkt b/racket/collects/syntax/parse/private/pattern-expander-prop.rkt deleted file mode 100644 index afb4ab938f..0000000000 --- a/racket/collects/syntax/parse/private/pattern-expander-prop.rkt +++ /dev/null @@ -1,17 +0,0 @@ -#lang racket/base -(provide (all-defined-out)) - -(define-values (prop:pattern-expander pattern-expander? get-proc-getter) - (make-struct-type-property 'pattern-expander)) - -(define (pattern-expander-proc pat-expander) - (define get-proc (get-proc-getter pat-expander)) - (get-proc pat-expander)) - -(define current-syntax-parse-pattern-introducer - (make-parameter - (lambda (stx) - (error 'syntax-local-syntax-parse-pattern-introduce "not expanding syntax-parse pattern")))) - -(define (syntax-local-syntax-parse-pattern-introduce stx) - ((current-syntax-parse-pattern-introducer) stx)) diff --git a/racket/collects/syntax/parse/private/pattern-expander.rkt b/racket/collects/syntax/parse/private/pattern-expander.rkt deleted file mode 100644 index 9b4bd8d505..0000000000 --- a/racket/collects/syntax/parse/private/pattern-expander.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket/base -(require (only-in "pattern-expander-prop.rkt" prop:pattern-expander)) -(provide pattern-expander) - -(struct pattern-expander (proc) #:transparent - #:omit-define-syntaxes ;; don't give indirect access to proc via match - #:property prop:pattern-expander - (λ (this) (pattern-expander-proc this))) ; needs to be wrapped in (λ (this) (_ this)) diff --git a/racket/collects/syntax/parse/private/rep.rkt b/racket/collects/syntax/parse/private/rep.rkt index 528f49be19..caec3aa878 100644 --- a/racket/collects/syntax/parse/private/rep.rkt +++ b/racket/collects/syntax/parse/private/rep.rkt @@ -18,8 +18,7 @@ "rep-data.rkt" "rep-patterns.rkt" syntax/parse/private/residual-ct ;; keep abs. path - "kws.rkt" - "pattern-expander-prop.rkt") + "kws.rkt") ;; Error reporting ;; All entry points should have explicit, mandatory #:context arg diff --git a/racket/collects/syntax/parse/private/residual-ct.rkt b/racket/collects/syntax/parse/private/residual-ct.rkt index 922007af0e..ab681a6cda 100644 --- a/racket/collects/syntax/parse/private/residual-ct.rkt +++ b/racket/collects/syntax/parse/private/residual-ct.rkt @@ -15,7 +15,12 @@ log-syntax-parse-error log-syntax-parse-warning log-syntax-parse-info - log-syntax-parse-debug) + log-syntax-parse-debug + prop:pattern-expander + pattern-expander? + pattern-expander-proc + current-syntax-parse-pattern-introducer + syntax-local-syntax-parse-pattern-introduce) (define-logger syntax-parse) @@ -69,3 +74,20 @@ An EH-alternative is (define-struct den:lit (internal external input-phase lit-phase) #:transparent) (define-struct den:datum-lit (internal external) #:transparent) (define-struct den:delayed (parser class)) + +;; == Pattern expanders + +(define-values (prop:pattern-expander pattern-expander? get-proc-getter) + (make-struct-type-property 'pattern-expander)) + +(define (pattern-expander-proc pat-expander) + (define get-proc (get-proc-getter pat-expander)) + (get-proc pat-expander)) + +(define current-syntax-parse-pattern-introducer + (make-parameter + (lambda (stx) + (error 'syntax-local-syntax-parse-pattern-introduce "not expanding syntax-parse pattern")))) + +(define (syntax-local-syntax-parse-pattern-introduce stx) + ((current-syntax-parse-pattern-introducer) stx))