added #:datum-literals, like #:literals but for ~datum patterns
This commit is contained in:
Ryan Culpepper
parent
40d2fd65b0
commit
d5fe602131
|
|
@ -14,6 +14,7 @@
|
|||
[syntax/parse/private/rep ;; keep abs. path
|
||||
(parse-kw-formals
|
||||
check-conventions-rules
|
||||
check-datum-literals-list
|
||||
create-aux-def)]))
|
||||
;; FIXME: workaround for phase>0 bug in racket/runtime-path (and thus lazy-require)
|
||||
;; Without this, dependencies don't get collected.
|
||||
|
|
@ -79,6 +80,7 @@
|
|||
(raise-syntax-error #f "expected phase-level (exact integer or #f)" ctx stx))
|
||||
stx)
|
||||
|
||||
;; check-litset-list : stx stx -> (listof (cons id literalset))
|
||||
(define-for-syntax (check-litset-list stx ctx)
|
||||
(syntax-case stx ()
|
||||
[(litset-id ...)
|
||||
|
|
@ -101,17 +103,23 @@
|
|||
(list #'id #'id)]
|
||||
[_ (raise-syntax-error #f "expected literal entry" ctx stx)]))
|
||||
|
||||
(define-for-syntax (check-duplicate-literals stx imports lits)
|
||||
(define-for-syntax (check-duplicate-literals ctx imports lits datum-lits)
|
||||
(let ([lit-t (make-hasheq)]) ;; sym => #t
|
||||
(define (check+enter! key blame-stx)
|
||||
(when (hash-ref lit-t key #f)
|
||||
(raise-syntax-error #f (format "duplicate literal: ~a" key) stx blame-stx))
|
||||
(raise-syntax-error #f (format "duplicate literal: ~a" key) ctx blame-stx))
|
||||
(hash-set! lit-t key #t))
|
||||
(for ([id+litset (in-list imports)])
|
||||
(let ([litset-id (car id+litset)]
|
||||
[litset (cdr id+litset)])
|
||||
(for ([entry (in-list (literalset-literals litset))])
|
||||
(check+enter! (car entry) litset-id))))
|
||||
(cond [(lse:lit? entry)
|
||||
(check+enter! (lse:lit-internal entry) litset-id)]
|
||||
[(lse:datum-lit? entry)
|
||||
(check+enter! (lse:datum-lit-internal entry) litset-id)]))))
|
||||
(for ([datum-lit (in-list datum-lits)])
|
||||
(let ([internal (den:datum-lit-internal datum-lit)])
|
||||
(check+enter! (syntax-e internal) internal)))
|
||||
(for ([lit (in-list lits)])
|
||||
(check+enter! (syntax-e (car lit)) (car lit)))))
|
||||
|
||||
|
|
@ -122,6 +130,7 @@
|
|||
(parse-keyword-options
|
||||
#'rest
|
||||
`((#:literal-sets ,check-litset-list)
|
||||
(#:datum-literals ,check-datum-literals-list)
|
||||
(#:phase ,check-phase-level)
|
||||
(#:for-template)
|
||||
(#:for-syntax)
|
||||
|
|
@ -136,28 +145,35 @@
|
|||
[(assq '#:for-syntax chunks) 1]
|
||||
[(assq '#:for-label chunks) #f]
|
||||
[else (options-select-value chunks '#:phase #:default 0)])]
|
||||
[datum-lits
|
||||
(options-select-value chunks '#:datum-literals #:default null)]
|
||||
[lits (syntax-case rest ()
|
||||
[( (lit ...) )
|
||||
(for/list ([lit (in-list (syntax->list #'(lit ...)))])
|
||||
(check-literal-entry/litset lit stx))]
|
||||
[_ (raise-syntax-error #f "bad syntax" stx)])]
|
||||
[imports (options-select-value chunks '#:literal-sets #:default null)])
|
||||
(check-duplicate-literals stx imports lits)
|
||||
(check-duplicate-literals stx imports lits datum-lits)
|
||||
(with-syntax ([((internal external) ...) lits]
|
||||
[(datum-internal ...) (map den:datum-lit-internal datum-lits)]
|
||||
[(datum-external ...) (map den:datum-lit-external datum-lits)]
|
||||
[(litset-id ...) (map car imports)]
|
||||
[relphase relphase])
|
||||
#`(begin
|
||||
(define phase-of-literals
|
||||
(if 'relphase
|
||||
(+ (phase-of-enclosing-module) 'relphase)
|
||||
'relphase))
|
||||
(and 'relphase
|
||||
(+ (variable-reference->module-base-phase (#%variable-reference))
|
||||
'relphase)))
|
||||
(define-syntax name
|
||||
(make-literalset
|
||||
(append (literalset-literals (syntax-local-value (quote-syntax litset-id)))
|
||||
...
|
||||
(list (list 'internal
|
||||
(quote-syntax external)
|
||||
(quote-syntax phase-of-literals))
|
||||
(list (make-lse:lit 'internal
|
||||
(quote-syntax external)
|
||||
(quote-syntax phase-of-literals))
|
||||
...
|
||||
(make-lse:datum-lit 'datum-internal
|
||||
'datum-external)
|
||||
...))))
|
||||
(begin-for-syntax/once
|
||||
(for ([x (in-list (syntax->list #'(external ...)))])
|
||||
|
|
@ -174,26 +190,42 @@
|
|||
(quote-syntax #,stx) x))))))))]))
|
||||
|
||||
#|
|
||||
Literal sets: The goal is for literals to refer to their bindings at
|
||||
NOTES ON PHASES AND BINDINGS
|
||||
|
||||
phase 0 relative to the enclosing module
|
||||
(module M ....
|
||||
.... (define-literal-set LS #:phase PL ....)
|
||||
....)
|
||||
|
||||
Use cases, explained:
|
||||
1) module X with def-lit-set is required-for-syntax
|
||||
phase-of-mod-inst = 1
|
||||
phase-of-def = 0
|
||||
literals looked up at abs phase 1
|
||||
which is phase 0 rel to module X
|
||||
2) module X with local def-lit-set within define-syntax
|
||||
phase-of-mod-inst = 1 (mod at 0, but +1 within define-syntax)
|
||||
phase-of-def = 1
|
||||
literals looked up at abs phase 0
|
||||
which is phase 0 rel to module X
|
||||
3) module X with def-lit-set in phase-2 position (really uncommon case!)
|
||||
phase-of-mod-inst = 1 (not 2, apparently)
|
||||
phase-of-def = 2
|
||||
literals looked up at abs phase 0
|
||||
(that's why the weird (if (z?) 0 1) term)
|
||||
For the expansion of the define-literal-set form, the bindings of the literals
|
||||
can be accessed by (identifier-binding lit PL), because the phase of the enclosing
|
||||
module (M) is 0.
|
||||
|
||||
LS may be used, however, in a context where the phase of the enclosing
|
||||
module is not 0, so each instantiation of LS needs to calculate the
|
||||
phase of M and add that to PL.
|
||||
|
||||
--
|
||||
|
||||
Normally, literal sets that define the same name conflict. But it
|
||||
would be nice to allow them to both be imported in the case where they
|
||||
refer to the same binding.
|
||||
|
||||
Problem: Can't do the check eagerly, because the binding of L may
|
||||
change between when define-literal-set is compiled and the comparison
|
||||
involving L. For example:
|
||||
|
||||
(module M racket
|
||||
(require syntax/parse)
|
||||
(define-literal-set LS (lambda))
|
||||
(require (only-in some-other-lang lambda))
|
||||
.... LS ....)
|
||||
|
||||
The expansion of the LS definition sees a different lambda than the
|
||||
one that the literal in LS actually refers to.
|
||||
|
||||
Similarly, a literal in LS might not be defined when the expander
|
||||
runs, but might get defined later. (Although I think that will already
|
||||
cause an error, so don't worry about that case.)
|
||||
|#
|
||||
|
||||
;; FIXME: keep one copy of each identifier (?)
|
||||
|
|
@ -205,7 +237,10 @@ Use cases, explained:
|
|||
(syntax-local-value/record #'litset-id literalset?))])
|
||||
(unless val (raise-syntax-error #f "expected literal set name" stx #'litset-id))
|
||||
(let ([lits (literalset-literals val)])
|
||||
(with-syntax ([((_sym lit phase-var) ...) lits])
|
||||
(with-syntax ([((lit phase-var) ...)
|
||||
(for/list ([lit (in-list lits)]
|
||||
#:when (lse:lit? lit))
|
||||
(list (lse:lit-external lit) (lse:lit-phase lit)))])
|
||||
#'(make-literal-set-predicate (list (list (quote-syntax lit) phase-var) ...)))))]))
|
||||
|
||||
(define (make-literal-set-predicate lits)
|
||||
|
|
|
|||
|
|
@ -72,6 +72,7 @@ DeclEnv =
|
|||
|
||||
DeclEntry =
|
||||
(den:lit id id ct-phase ct-phase)
|
||||
(den:datum-lit id symbol)
|
||||
(den:class id id Arguments)
|
||||
(den:magic-class id id Arguments stx)
|
||||
(den:parser id (listof SAttr) bool bool bool)
|
||||
|
|
@ -82,6 +83,7 @@ Arguments is defined in rep-patterns.rkt
|
|||
A DeclEnv is built up in stages:
|
||||
1) syntax-parse (or define-syntax-class) directives
|
||||
#:literals -> den:lit
|
||||
#:datum-literals -> den:datum-lit
|
||||
#:local-conventions -> den:class
|
||||
#:conventions -> den:delayed
|
||||
#:literal-sets -> den:lit
|
||||
|
|
@ -101,20 +103,22 @@ expressions are duplicated, and may be evaluated in different scopes.
|
|||
|
||||
(define-struct declenv (table conventions))
|
||||
|
||||
(define-struct den:lit (internal external input-phase lit-phase))
|
||||
(define-struct den:class (name class argu))
|
||||
(define-struct den:magic-class (name class argu role))
|
||||
(define-struct den:parser (parser attrs splicing? commit? delimit-cut?))
|
||||
;; and from residual.rkt: (define-struct den:delayed (parser class))
|
||||
;; and from residual.rkt:
|
||||
;; (define-struct den:lit (internal external input-phase lit-phase))
|
||||
;; (define-struct den:datum-lit (internal external))
|
||||
;; (define-struct den:delayed (parser class))
|
||||
|
||||
(define (new-declenv literals #:conventions [conventions null])
|
||||
(make-declenv
|
||||
(for/fold ([table (make-immutable-bound-id-table)])
|
||||
([literal (in-list literals)])
|
||||
(bound-id-table-set table (car literal)
|
||||
(make den:lit (first literal) (second literal)
|
||||
(third literal) (fourth literal))))
|
||||
conventions))
|
||||
(let* ([table (make-immutable-bound-id-table)]
|
||||
[table (for/fold ([table table]) ([literal (in-list literals)])
|
||||
(let ([id (cond [(den:lit? literal) (den:lit-internal literal)]
|
||||
[(den:datum-lit? literal) (den:datum-lit-internal literal)])])
|
||||
;;(eprintf ">> added ~e\n" id)
|
||||
(bound-id-table-set table id literal)))])
|
||||
(make-declenv table conventions)))
|
||||
|
||||
(define (declenv-lookup env id #:use-conventions? [use-conventions? #t])
|
||||
(or (bound-id-table-ref (declenv-table env) id #f)
|
||||
|
|
@ -129,6 +133,8 @@ expressions are duplicated, and may be evaluated in different scopes.
|
|||
(match val
|
||||
[(den:lit _i _e _ip _lp)
|
||||
(wrong-syntax id "identifier previously declared as literal")]
|
||||
[(den:datum-lit _i _e)
|
||||
(wrong-syntax id "identifier previously declared as literal")]
|
||||
[(den:magic-class name _c _a _r)
|
||||
(if (and blame-declare? stxclass-name)
|
||||
(wrong-syntax name
|
||||
|
|
@ -191,7 +197,7 @@ expressions are duplicated, and may be evaluated in different scopes.
|
|||
(define DeclEnv/c declenv?)
|
||||
|
||||
(define DeclEntry/c
|
||||
(or/c den:lit? den:class? den:magic-class? den:parser? den:delayed?))
|
||||
(or/c den:lit? den:datum-lit? den:class? den:magic-class? den:parser? den:delayed?))
|
||||
|
||||
(define SideClause/c
|
||||
(or/c clause:fail? clause:with? clause:attr? clause:do?))
|
||||
|
|
@ -200,11 +206,12 @@ expressions are duplicated, and may be evaluated in different scopes.
|
|||
;; usually = #'(syntax-local-phase-level)
|
||||
(define ct-phase/c syntax?)
|
||||
|
||||
(provide (struct-out den:lit)
|
||||
(struct-out den:class)
|
||||
(provide (struct-out den:class)
|
||||
(struct-out den:magic-class)
|
||||
(struct-out den:parser)
|
||||
;; from residual.rkt:
|
||||
(struct-out den:lit)
|
||||
(struct-out den:datum-lit)
|
||||
(struct-out den:delayed))
|
||||
|
||||
(provide/contract
|
||||
|
|
@ -218,7 +225,7 @@ expressions are duplicated, and may be evaluated in different scopes.
|
|||
[stxclass-colon-notation? (parameter/c boolean?)]
|
||||
|
||||
[new-declenv
|
||||
(->* [(listof (list/c identifier? identifier? ct-phase/c ct-phase/c))]
|
||||
(->* [(listof (or/c den:lit? den:datum-lit?))]
|
||||
[#:conventions list?]
|
||||
DeclEnv/c)]
|
||||
[declenv-lookup
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
syntax/parse/private/keywords
|
||||
syntax/parse/private/residual ;; keep abs. path
|
||||
syntax/parse/private/runtime)
|
||||
racket/list
|
||||
racket/contract/base
|
||||
"minimatch.rkt"
|
||||
syntax/private/id-table
|
||||
|
|
@ -61,6 +62,9 @@
|
|||
[check-conventions-rules
|
||||
(-> syntax? syntax?
|
||||
(listof (list/c regexp? any/c)))]
|
||||
[check-datum-literals-list
|
||||
(-> syntax? syntax?
|
||||
(listof den:datum-lit?))]
|
||||
[check-attr-arity-list
|
||||
(-> syntax? syntax?
|
||||
(listof sattr?))])
|
||||
|
|
@ -220,11 +224,12 @@
|
|||
;; get-decls : chunks -> (values DeclEnv (listof syntax))
|
||||
(define (get-decls chunks strict?)
|
||||
(define lits (options-select-value chunks '#:literals #:default null))
|
||||
(define datum-lits (options-select-value chunks '#:datum-literals #:default null))
|
||||
(define litsets (options-select-value chunks '#:literal-sets #:default null))
|
||||
(define convs (options-select-value chunks '#:conventions #:default null))
|
||||
(define localconvs (options-select-value chunks '#:local-conventions #:default null))
|
||||
(define literals
|
||||
(append-lits+litsets lits litsets))
|
||||
(append/check-lits+litsets lits datum-lits litsets))
|
||||
(define-values (convs-rules convs-defs)
|
||||
(for/fold ([convs-rules null] [convs-defs null])
|
||||
([conv-entry (in-list convs)])
|
||||
|
|
@ -260,6 +265,8 @@
|
|||
(match entry
|
||||
[(den:lit _i _e _ip _lp)
|
||||
(values entry null)]
|
||||
[(den:datum-lit _i _e)
|
||||
(values entry null)]
|
||||
[(den:magic-class name class argu role)
|
||||
(values entry null)]
|
||||
[(den:class name class argu)
|
||||
|
|
@ -288,14 +295,39 @@
|
|||
[(den:delayed _p _c)
|
||||
(values entry null)]))
|
||||
|
||||
(define (append-lits+litsets lits litsets)
|
||||
(define seen (make-bound-id-table lits))
|
||||
(for ([litset (in-list litsets)])
|
||||
(for ([lit (in-list litset)])
|
||||
(when (bound-id-table-ref seen (car lit) #f)
|
||||
(wrong-syntax (car lit) "duplicate literal declaration"))
|
||||
(bound-id-table-set! seen (car lit) #t)))
|
||||
(apply append lits litsets))
|
||||
;; append/check-lits+litsets : .... -> (listof (U den:lit den:datum-lit))
|
||||
(define (append/check-lits+litsets lits datum-lits litsets)
|
||||
(define seen (make-bound-id-table))
|
||||
(define (check-id id [blame-ctx id])
|
||||
(if (bound-id-table-ref seen id #f)
|
||||
(wrong-syntax blame-ctx "duplicate literal declaration: ~s" (syntax-e id))
|
||||
(bound-id-table-set! seen id #t))
|
||||
id)
|
||||
(let* ([litsets*
|
||||
(for/list ([entry (in-list litsets)])
|
||||
(let ([litset-id (first entry)]
|
||||
[litset (second entry)]
|
||||
[lctx (third entry)]
|
||||
[input-phase (fourth entry)])
|
||||
(define (get/check-id sym)
|
||||
(check-id (datum->syntax lctx sym) litset-id))
|
||||
(for/list ([lse (in-list (literalset-literals litset))])
|
||||
(match lse
|
||||
[(lse:lit internal external lit-phase)
|
||||
(let ([internal (get/check-id internal)])
|
||||
(make den:lit internal external input-phase lit-phase))]
|
||||
[(lse:datum-lit internal external)
|
||||
(let ([internal (get/check-id internal)])
|
||||
(make den:datum-lit internal external))]))))]
|
||||
[lits*
|
||||
(for/list ([lit (in-list lits)])
|
||||
(check-id (den:lit-internal lit))
|
||||
lit)]
|
||||
[datum-lits*
|
||||
(for/list ([datum-lit (in-list datum-lits)])
|
||||
(check-id (den:datum-lit-internal datum-lit))
|
||||
datum-lit)])
|
||||
(apply append lits* datum-lits* litsets*)))
|
||||
|
||||
;; parse-variant : stx boolean DeclEnv #f/(listof Sattr) -> RHS
|
||||
(define (parse-variant stx splicing? decls0 expected-attrs)
|
||||
|
|
@ -609,6 +641,8 @@
|
|||
(match entry
|
||||
[(den:lit internal literal input-phase lit-phase)
|
||||
(create-pat:literal literal input-phase lit-phase)]
|
||||
[(den:datum-lit internal sym)
|
||||
(create-pat:datum sym)]
|
||||
[(den:magic-class name class argu role)
|
||||
(let* ([pos-count (length (arguments-pargs argu))]
|
||||
[kws (arguments-kws argu)]
|
||||
|
|
@ -1222,24 +1256,20 @@
|
|||
[_
|
||||
(raise-syntax-error #f "expected attribute name with optional depth declaration" ctx stx)]))
|
||||
|
||||
;; check-literals-list : stx stx -> (listof (list id id ct-phase ct-phase))
|
||||
;; check-literals-list : stx stx -> (listof den:lit)
|
||||
;; - txlifts defs of phase expressions
|
||||
;; - txlifts checks that literals are bound
|
||||
(define (check-literals-list stx ctx)
|
||||
(unless (stx-list? stx)
|
||||
(raise-syntax-error #f "expected literals list" ctx stx))
|
||||
(let ([lits
|
||||
(for/list ([x (in-list (stx->list stx))])
|
||||
(check-literal-entry x ctx))])
|
||||
(let ([dup (check-duplicate-identifier (map car lits))])
|
||||
(when dup (raise-syntax-error #f "duplicate literal identifier" ctx dup)))
|
||||
lits))
|
||||
(for/list ([x (in-list (stx->list stx))])
|
||||
(check-literal-entry x ctx)))
|
||||
|
||||
;; check-literal-entry : stx stx -> (list id id ct-phase ct-phase)
|
||||
;; check-literal-entry : stx stx -> den:lit
|
||||
(define (check-literal-entry stx ctx)
|
||||
(define (go internal external phase)
|
||||
(txlift #`(check-literal #,external #,phase #,ctx))
|
||||
(list internal external phase phase))
|
||||
(make den:lit internal external phase phase))
|
||||
(syntax-case stx ()
|
||||
[(internal external #:phase phase)
|
||||
(and (identifier? #'internal) (identifier? #'external))
|
||||
|
|
@ -1251,32 +1281,44 @@
|
|||
(identifier? #'id)
|
||||
(go #'id #'id #'(syntax-local-phase-level))]
|
||||
[_
|
||||
(raise-syntax-error #f "expected literal entry"
|
||||
ctx stx)]))
|
||||
(raise-syntax-error #f "expected literal entry" ctx stx)]))
|
||||
|
||||
;; check-datum-literals-list : stx stx -> (listof den:datum-lit)
|
||||
(define (check-datum-literals-list stx ctx)
|
||||
(unless (stx-list? stx)
|
||||
(raise-syntax-error #f "expected datum-literals list" ctx stx))
|
||||
(for/list ([x (in-list (stx->list stx))])
|
||||
(check-datum-literal-entry x ctx)))
|
||||
|
||||
;; check-datum-literal-entry : stx stx -> den:datum-lit
|
||||
(define (check-datum-literal-entry stx ctx)
|
||||
(syntax-case stx ()
|
||||
[(internal external)
|
||||
(and (identifier? #'internal) (identifier? #'external))
|
||||
(make den:datum-lit #'internal (syntax-e #'external))]
|
||||
[id
|
||||
(identifier? #'id)
|
||||
(make den:datum-lit #'id (syntax-e #'id))]
|
||||
[_
|
||||
(raise-syntax-error #f "expected datum-literal entry" ctx stx)]))
|
||||
|
||||
;; Literal sets - Import
|
||||
|
||||
;; check-literal-sets-list : stx stx -> (listof (listof (list id id ct-phase^2)))
|
||||
;; check-literal-sets-list : stx stx -> (listof (list id literalset stx stx))
|
||||
(define (check-literal-sets-list stx ctx)
|
||||
(unless (stx-list? stx)
|
||||
(raise-syntax-error #f "expected literal-set list" ctx stx))
|
||||
(for/list ([x (in-list (stx->list stx))])
|
||||
(check-literal-set-entry x ctx)))
|
||||
|
||||
;; check-literal-set-entry : stx stx -> (listof (list id id ct-phase^2))
|
||||
;; check-literal-set-entry : stx stx -> (list id literalset stx stx)
|
||||
(define (check-literal-set-entry stx ctx)
|
||||
(define (elaborate litset-id lctx phase)
|
||||
(let ([litset (syntax-local-value/record litset-id literalset?)])
|
||||
(unless litset
|
||||
(raise-syntax-error #f "expected identifier defined as a literal-set"
|
||||
ctx litset-id))
|
||||
(elaborate2 litset lctx phase)))
|
||||
(define (elaborate2 litset lctx phase)
|
||||
(for/list ([entry (in-list (literalset-literals litset))])
|
||||
(list (datum->syntax lctx (car entry) stx)
|
||||
(cadr entry)
|
||||
phase
|
||||
(caddr entry))))
|
||||
(list litset-id litset lctx phase)))
|
||||
(syntax-case stx ()
|
||||
[(litset . more)
|
||||
(and (identifier? #'litset))
|
||||
|
|
@ -1483,6 +1525,7 @@
|
|||
(define common-parse-directive-table
|
||||
(list (list '#:disable-colon-notation)
|
||||
(list '#:literals check-literals-list)
|
||||
(list '#:datum-literals check-datum-literals-list)
|
||||
(list '#:literal-sets check-literal-sets-list)
|
||||
(list '#:conventions check-conventions-list)
|
||||
(list '#:local-conventions check-conventions-rules)))
|
||||
|
|
|
|||
|
|
@ -5,8 +5,12 @@
|
|||
(struct-out integrate)
|
||||
(struct-out conventions)
|
||||
(struct-out literalset)
|
||||
(struct-out lse:lit)
|
||||
(struct-out lse:datum-lit)
|
||||
(struct-out eh-alternative-set)
|
||||
(struct-out eh-alternative)
|
||||
(struct-out den:lit)
|
||||
(struct-out den:datum-lit)
|
||||
(struct-out den:delayed))
|
||||
|
||||
;; == from rep-attr.rkt
|
||||
|
|
@ -38,9 +42,14 @@ A ConventionRule is (list regexp DeclEntry)
|
|||
|
||||
#|
|
||||
A LiteralSet is
|
||||
(make-literalset (listof (list symbol id phase-var-id)))
|
||||
(make-literalset (listof LiteralSetEntry))
|
||||
An LiteralSetEntry is one of
|
||||
- (make-lse:lit symbol id ct-phase)
|
||||
- (make-lse:datum-lit symbol symbol)
|
||||
|#
|
||||
(define-struct literalset (literals) #:transparent)
|
||||
(define-struct lse:lit (internal external phase) #:transparent)
|
||||
(define-struct lse:datum-lit (internal external) #:transparent)
|
||||
|
||||
#|
|
||||
An EH-alternative-set is
|
||||
|
|
@ -51,4 +60,6 @@ An EH-alternative is
|
|||
(define-struct eh-alternative-set (alts))
|
||||
(define-struct eh-alternative (repc attrs parser))
|
||||
|
||||
(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))
|
||||
|
|
|
|||
|
|
@ -15,7 +15,8 @@ As a remedy, @racketmodname[syntax/parse] offers @deftech{literal
|
|||
sets}. A literal set is defined via @racket[define-literal-set] and
|
||||
used via the @racket[#:literal-set] option of @racket[syntax-parse].
|
||||
|
||||
@defform/subs[(define-literal-set id maybe-phase maybe-imports (literal ...))
|
||||
@defform/subs[(define-literal-set id maybe-phase maybe-imports maybe-datum-literals
|
||||
(literal ...))
|
||||
([literal literal-id
|
||||
(pattern-id literal-id)]
|
||||
[maybe-phase (code:line)
|
||||
|
|
@ -23,6 +24,8 @@ used via the @racket[#:literal-set] option of @racket[syntax-parse].
|
|||
(code:line #:for-syntax)
|
||||
(code:line #:for-label)
|
||||
(code:line #:phase phase-level)]
|
||||
[maybe-datum-literals (code:line)
|
||||
(code:line #:datum-literals (datum-literal ...))]
|
||||
[maybe-imports (code:line)
|
||||
(code:line #:literal-sets (imported-litset-id ...))])]{
|
||||
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@ Two parsing forms are provided: @racket[syntax-parse] and
|
|||
@defform/subs[(syntax-parse stx-expr parse-option ... clause ...+)
|
||||
([parse-option (code:line #:context context-expr)
|
||||
(code:line #:literals (literal ...))
|
||||
(code:line #:datum-literals (datum-literal ...))
|
||||
(code:line #:literal-sets (literal-set ...))
|
||||
(code:line #:conventions (convention-id ...))
|
||||
(code:line #:local-conventions (convention-rule ...))
|
||||
|
|
@ -30,6 +31,8 @@ Two parsing forms are provided: @racket[syntax-parse] and
|
|||
[literal literal-id
|
||||
(pattern-id literal-id)
|
||||
(pattern-id literal-id #:phase phase-expr)]
|
||||
[datum-literal literal-id
|
||||
(pattern-id literal-id)]
|
||||
[literal-set literal-set-id
|
||||
(literal-set-id literal-set-option ...)]
|
||||
[literal-set-option (code:line #:at context-id)
|
||||
|
|
@ -76,10 +79,12 @@ failures; otherwise @racket[stx-expr] is used. The
|
|||
(pattern-id literal-id)
|
||||
(pattern-id literal-id #:phase phase-expr)])
|
||||
#:contracts ([phase-expr (or/c exact-integer? #f)])]{
|
||||
|
||||
@margin-note*{
|
||||
Unlike @racket[syntax-case], @racket[syntax-parse] requires all
|
||||
literals to have a binding. To match identifiers by their symbolic
|
||||
names, use the @racket[~datum] pattern form instead.
|
||||
names, use @racket[#:datum-literals] or the @racket[~datum] pattern
|
||||
form instead.
|
||||
}
|
||||
@;
|
||||
The @racket[#:literals] option specifies identifiers that should be
|
||||
|
|
@ -94,6 +99,23 @@ If the @racket[#:phase] option is given, then the literal is compared
|
|||
at phase @racket[phase-expr]. Specifically, the binding of the
|
||||
@racket[literal-id] at phase @racket[phase-expr] must match the
|
||||
input's binding at phase @racket[phase-expr].
|
||||
|
||||
In other words, the @racket[syntax-pattern]s are interpreted as if each
|
||||
occurrence of @racket[pattern-id] were replaced with the following pattern:
|
||||
@racketblock[(~literal literal-id #:phase phase-expr)]
|
||||
}
|
||||
|
||||
@specsubform/subs[(code:line #:datum-literals (datum-literal ...))
|
||||
([datum-literal literal-id
|
||||
(pattern-id literal-id)])]{
|
||||
|
||||
Like @racket[#:literals], but the literals are matched as symbols
|
||||
instead of as identifiers.
|
||||
|
||||
In other words, the @racket[syntax-pattern]s are interpreted as if each
|
||||
occurrence of @racket[pattern-id] were replaced with the following
|
||||
pattern:
|
||||
@racketblock[(~datum literal-id)]
|
||||
}
|
||||
|
||||
@specsubform/subs[(code:line #:literal-sets (literal-set ...))
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ means specifically @tech{@Spattern}.
|
|||
(@#,ref[~var s-] id)
|
||||
(@#,ref[~var s+] id syntax-class-id maybe-role)
|
||||
(@#,ref[~var s+] id (syntax-class-id arg ...) maybe-role)
|
||||
(~literal literal-id)
|
||||
(~literal literal-id maybe-phase)
|
||||
atomic-datum
|
||||
(~datum datum)
|
||||
(H-pattern . S-pattern)
|
||||
|
|
@ -298,7 +298,9 @@ combined with the syntax class's description in error messages.
|
|||
]
|
||||
}
|
||||
|
||||
@specsubform[(@#,defhere[~literal] literal-id)]{
|
||||
@specsubform/subs[(@#,defhere[~literal] literal-id maybe-phase)
|
||||
([maybe-phase (code:line)
|
||||
(code:line #:phase phase-expr)])]{
|
||||
|
||||
A @deftech{literal} identifier pattern. Matches any identifier
|
||||
@racket[free-identifier=?] to @racket[literal-id].
|
||||
|
|
@ -309,6 +311,10 @@ A @deftech{literal} identifier pattern. Matches any identifier
|
|||
(syntax-parse #'(lambda x 12)
|
||||
[((~literal define) var:id body:expr) 'ok])
|
||||
]
|
||||
|
||||
The identifiers are compared at the phase given by
|
||||
@racket[phase-expr], if it is given, or
|
||||
@racket[(syntax-local-phase-level)] otherwise.
|
||||
}
|
||||
|
||||
@specsubform[atomic-datum]{
|
||||
|
|
|
|||
|
|
@ -29,6 +29,7 @@ structures can share syntax class definitions.
|
|||
(code:line #:commit)
|
||||
(code:line #:no-delimit-cut)
|
||||
(code:line #:literals (literal-entry ...))
|
||||
(code:line #:datum-literals (datum-literal-entry ...))
|
||||
(code:line #:literal-sets (literal-set ...))
|
||||
(code:line #:conventions (convention-id ...))
|
||||
(code:line #:local-conventions (convention-rule ...))
|
||||
|
|
@ -107,7 +108,8 @@ It is an error to use both @racket[#:commit] and
|
|||
@racket[#:no-delimit-cut].
|
||||
}
|
||||
|
||||
@specsubform[(code:line #:literals (literal-entry))]
|
||||
@specsubform[(code:line #:literals (literal-entry ...))]
|
||||
@specsubform[(code:line #:datum-literals (datum-literal-entry ...))]
|
||||
@specsubform[(code:line #:literal-sets (literal-set ...))]
|
||||
@specsubform[(code:line #:conventions (convention-id ...))]{
|
||||
|
||||
|
|
|
|||
|
|
@ -97,6 +97,18 @@
|
|||
(go #'begin #f)
|
||||
(void)))
|
||||
|
||||
;; Litsets with datum-lits
|
||||
|
||||
(test-case "litset, datum-lits"
|
||||
(let ([one 1])
|
||||
(define-literal-set lits-d #:datum-literals (one two) ())
|
||||
(syntax-parse #'one #:literal-sets (lits-d)
|
||||
[one (void)])
|
||||
(let ([one 2])
|
||||
(syntax-parse #'one #:literal-sets (lits-d) [one (void)]))))
|
||||
|
||||
;; literal-set->predicate
|
||||
|
||||
(require (for-label '#%kernel))
|
||||
|
||||
(test-case "litset->pred"
|
||||
|
|
|
|||
|
|
@ -79,6 +79,14 @@
|
|||
[+ (void)]
|
||||
[_ (error 'wrong)]))
|
||||
|
||||
(test-case "datum literals"
|
||||
(syntax-parse #'one #:datum-literals (one)
|
||||
[one (void)]))
|
||||
(test-case "datum literals (not id=?)"
|
||||
(let ([one 1])
|
||||
(syntax-parse (let ([one 2]) #'one) #:datum-literals (one)
|
||||
[one (void)])))
|
||||
|
||||
;; compound patterns
|
||||
(tok (a b c) (x y z)
|
||||
(and (bound (x 0) (y 0) (z 0)) (s= x 'a) (s= y 'b))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user