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

syntax/parse: added #:disable-colon-notation option

Browse Source
This commit is contained in:
Ryan Culpepper 2011-03-17 02:14:02 -06:00
parent b5154b444f
commit bf591d4d01
5 changed files with 39 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/syntax/parse/private/parse.rkt
View File

@ -192,16 +192,19 @@ Conventions:
#:no-duplicates? #t))
(define context
(options-select-value chunks '#:context #:default #'x))
(define colon-notation?
(not (assq '#:disable-colon-notation chunks)))
(define-values (decls0 defs)
(get-decls+defs chunks #t #:context #'ctx))
(define (for-clause clause)
(syntax-case clause ()
[[p . rest]
(let-values ([(rest pattern defs2)
(parse-pattern+sides #'p #'rest
#:splicing? #f
#:decls decls0
#:context #'ctx)])
(parameterize ((stxclass-colon-notation? colon-notation?))
(parse-pattern+sides #'p #'rest
#:splicing? #f
#:decls decls0
#:context #'ctx))])
(with-syntax ([rest rest]
[pattern pattern]
[(local-def ...) (append defs defs2)]

9
collects/syntax/parse/private/rep-data.rkt
View File

@ -222,6 +222,7 @@ Arguments is defined in rep-patterns.rkt
[make-dummy-stxclass (-> identifier? stxclass?)]
[stxclass-lookup-config (parameter/c (symbols 'no 'try 'yes))]
[stxclass-colon-notation? (parameter/c boolean?)]
[new-declenv
(->* [(listof (list/c identifier? identifier? ct-phase/c ct-phase/c))]
@ -256,6 +257,11 @@ Arguments is defined in rep-patterns.rkt
;; 'yes means lookup, raise error on failure
(define stxclass-lookup-config (make-parameter 'yes))
;; stxclass-colon-notation? : (parameterof boolean)
;; if #t, then x:sc notation means (~var x sc)
;; otherwise, just a var
(define stxclass-colon-notation? (make-parameter #t))
(define (get-stxclass id)
(define config (stxclass-lookup-config))
(if (eq? config 'no)
@ -274,7 +280,8 @@ Arguments is defined in rep-patterns.rkt
sc))
(define (split-id/get-stxclass id0 decls)
(cond [(regexp-match #rx"^([^:]*):(.+)$" (symbol->string (syntax-e id0)))
(cond [(and (stxclass-colon-notation?)
(regexp-match #rx"^([^:]*):(.+)$" (symbol->string (syntax-e id0))))
=> (lambda (m)
(define id
(datum->syntax id0 (string->symbol (cadr m)) id0 id0))

13
collects/syntax/parse/private/rep.rkt
View File

@ -159,14 +159,15 @@
(call/txlifts
(lambda ()
(parameterize ((current-syntax-context ctx))
(define-values (rest description transp? attributes auto-nested?
(define-values (rest description transp? attributes auto-nested? colon-notation?
decls defs options)
(parse-rhs/part1 stx splicing? (and expected-attrs #t)))
(define variants
(parameterize ((stxclass-lookup-config
(cond [expected-attrs 'yes]
[auto-nested? 'try]
[else 'no])))
[else 'no]))
(stxclass-colon-notation? colon-notation?))
(parse-variants rest decls splicing? expected-attrs)))
(let ([sattrs
(or attributes
@ -186,14 +187,15 @@
(define opaque? (and (assq '#:opaque chunks) #t))
(define transparent? (not opaque?))
(define auto-nested? (and (assq '#:auto-nested-attributes chunks) #t))
(define colon-notation? (not (assq '#:disable-colon-notation chunks)))
(define commit?
(and (assq '#:commit chunks) #t))
(define delimit-cut?
(not (assq '#:no-delimit-cut chunks)))
(define attributes (options-select-value chunks '#:attributes #:default #f))
(define-values (decls defs) (get-decls+defs chunks strict?))
(values rest description transparent? attributes auto-nested? decls defs
(make options commit? delimit-cut?)))
(values rest description transparent? attributes auto-nested? colon-notation?
decls defs (make options commit? delimit-cut?)))
;; ----
@ -1546,7 +1548,8 @@ A syntax class is integrable if
;; common-parse-directive-table
(define common-parse-directive-table
(list (list '#:literals check-literals-list)
(list (list '#:disable-colon-notation)
(list '#:literals check-literals-list)
(list '#:literal-sets check-literal-sets-list)
(list '#:conventions check-conventions-list)
(list '#:local-conventions check-conventions-rules)))

15
collects/syntax/scribblings/parse/parsing.scrbl
View File

@ -24,7 +24,8 @@ Two parsing forms are provided: @scheme[syntax-parse] and
(code:line #:literals (literal ...))
(code:line #:literal-sets (literal-set ...))
(code:line #:conventions (convention-id ...))
(code:line #:local-conventions (convention-rule ...))]
(code:line #:local-conventions (convention-rule ...))
(code:line #:disable-colon-notation)]
[literal literal-id
(pattern-id literal-id)
(pattern-id literal-id #:phase phase-expr)]
@ -119,6 +120,18 @@ of @tech{pattern directives}, and a non-empty sequence of body
expressions.
}
@specsubform[(code:line #:disable-colon-notation)]{
Suppresses the ``colon notation'' for annotated pattern variables.
@myexamples[
(syntax-parse #'(a b c)
[(x:y ...) 'ok])
(syntax-parse #'(a b c) #:disable-colon-notation
[(x:y ...) 'ok])
]
}
@defform[(syntax-parser parse-option ... clause ...+)]{
Like @scheme[syntax-parse], but produces a matching procedure. The

3
collects/syntax/scribblings/parse/stxclasses.scrbl
View File

@ -31,7 +31,8 @@ structures can share syntax class definitions.
(code:line #:literals (literal-entry ...))
(code:line #:literal-sets (literal-set ...))
(code:line #:conventions (convention-id ...))
(code:line #:local-conventions (convention-rule ...))]
(code:line #:local-conventions (convention-rule ...))
(code:line #:disable-colon-notation)]
[attr-arity-decl
attr-name-id
(attr-name-id depth)]