suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

syntax/parse: combine away pattern-expander*.rkt modules

Browse Source
This commit is contained in:
Ryan Culpepper 2016-07-31 13:58:49 -04:00
parent 6fe55ec307
commit ce1bf2503d
6 changed files with 35 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/collects/syntax/parse.rkt
View File

@ -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)))

3
racket/collects/syntax/parse/debug.rkt
View File

@ -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"

17
racket/collects/syntax/parse/private/pattern-expander-prop.rkt
View File

@ -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))

8
racket/collects/syntax/parse/private/pattern-expander.rkt
View File

@ -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))

3
racket/collects/syntax/parse/private/rep.rkt
View File

@ -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

24
racket/collects/syntax/parse/private/residual-ct.rkt
View File

@ -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))