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

syntax/keyword: renamed and added selection procedures

Browse Source 
syntax/parse: documented #:context option

svn: r15839
This commit is contained in:
Ryan Culpepper 2009-08-30 18:22:09 +00:00
parent 188dba05f4
commit 1a2ce72089
6 changed files with 74 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/syntax/keyword.ss
View File

@ -48,7 +48,10 @@
[options-select
(-> options/c keyword?
(listof list?))]
[options-select-one
[options-select-row
(-> options/c keyword? #:default any/c
any/c)]
[options-select-value
(-> options/c keyword? #:default any/c
any/c)]

30
collects/syntax/private/keyword.ss
View File

@ -7,7 +7,8 @@
(provide parse-keyword-options
parse-keyword-options/eol
options-select
options-select-one
options-select-row
options-select-value
check-expression
check-identifier
@ -141,16 +142,35 @@
#:when (eq? kw (car chunk)))
(cddr chunk)))
;; options-select-one : Options keyword -> any
(define (options-select-one chunks kw
#:default default)
;; options-select-row : Options keyword -> any
(define (options-select-row chunks kw #:default default)
(let ([results (options-select chunks kw)])
(cond [(null? results)
default]
[(null? (cdr results))
(car results)]
[else
(error 'options-select-one "multiple occurrences of ~s keyword option" kw)])))
(error 'options-select-row
"multiple occurrences of ~s keyword" kw)])))
;; options-select-value : Options keyword -> any
(define (options-select-value chunks kw #:default default)
(let ([results (options-select chunks kw)])
(cond [(null? results)
default]
[(null? (cdr results))
(let ([row (car results)])
(cond [(null? row)
(error 'options-select-value
"keyword ~s has no arguments" kw)]
[(null? (cdr row))
(car row)]
[else
(error 'options-select-value
"keyword ~s has more than one argument" kw)]))]
[else
(error 'options-select-value
"multiple occurrences of ~s keyword" kw)])))
;; Check Procedures

3
collects/syntax/private/stxparse/parse.ss
View File

@ -143,8 +143,7 @@
#:context stx
#:no-duplicates? #t))
(define context
(let ([c (options-select-one chunks '#:context #:default #f)])
(if c (car c) #'x)))
(options-select-value chunks '#:context #:default #'x))
(define-values (decls0 defs) (get-decls+defs chunks))
(define (for-clause clause)
(syntax-case clause ()

48
collects/syntax/private/stxparse/rep.ss
View File

@ -590,17 +590,17 @@
(parse-keyword-options/eol #'options optional-directive-table
#:no-duplicates? #t
#:context stx))
#|
(define defaults
(car (options-select-one chunks '#:defaults #:default '(()))))
|#
(with-syntax ([(too-many-msg)
(options-select-one chunks '#:too-many #:default #'(#f))]
[(name)
(options-select-one chunks '#:name #:default #'(#f))])
(let ([too-many-msg
(options-select-value chunks '#:too-many #:default #'#f)]
[name
(options-select-value chunks '#:name #:default #'#f)]
#|
[defaults
(options-select-value chunks '#:defaults #:default '())]
|#)
(make ehpat (map attr-make-uncertain (pattern-attrs head))
head
(make rep:optional #'name #'too-many-msg #| defaults |#))))]))
(make rep:optional name too-many-msg #| defaults |#))))]))
(define (parse-ehpat/once stx decls)
(syntax-case stx (~once)
@ -612,15 +612,15 @@
(list '#:too-many check-expression)
(list '#:name check-expression))
#:context stx))
(with-syntax ([(too-few-msg)
(options-select-one chunks '#:too-few #:default #'(#f))]
[(too-many-msg)
(options-select-one chunks '#:too-many #:default #'(#f))]
[(name)
(options-select-one chunks '#:name #:default #'(#f))])
(let ([too-few-msg
(options-select-value chunks '#:too-few #:default #'#f)]
[too-many-msg
(options-select-value chunks '#:too-many #:default #'#f)]
[name
(options-select-value chunks '#:name #:default #'#f)])
(make ehpat (pattern-attrs head)
head
(make rep:once #'name #'too-few-msg #'too-many-msg))))]))
(make rep:once name too-few-msg too-many-msg))))]))
(define (parse-ehpat/bounds stx decls)
(syntax-case stx (~bounds)
@ -641,16 +641,16 @@
(list '#:too-many check-expression)
(list '#:name check-expression))
#:context stx)])
(with-syntax ([(too-few-msg)
(options-select-one chunks '#:too-few #:default #'(#f))]
[(too-many-msg)
(options-select-one chunks '#:too-many #:default #'(#f))]
[(name)
(options-select-one chunks '#:name #:default #'(#f))])
(let ([too-few-msg
(options-select-value chunks '#:too-few #:default #'#f)]
[too-many-msg
(options-select-value chunks '#:too-many #:default #'#f)]
[name
(options-select-value chunks '#:name #:default #'#f)])
(make ehpat (map increase-depth (pattern-attrs head))
head
(make rep:bounds #'min #'max #'name
#'too-few-msg #'too-many-msg)))))]))
(make rep:bounds #'min #'max
name too-few-msg too-many-msg)))))]))
;; -----

17
collects/syntax/scribblings/keyword.scrbl
View File

@ -214,7 +214,7 @@ the arity of the keyword.
}
@defproc[(options-select-one [options #, @techlink{options}]
@defproc[(options-select-row [options #, @techlink{options}]
[keyword keyword?]
[#:default default any/c])
any]{
@ -226,6 +226,21 @@ the @scheme[default] list is returned.
}
@defproc[(options-select-value [options #, @techlink{options}]
[keyword keyword?]
[#:default default any/c])
any]{
Like @scheme[options-select], except that the given keyword must occur
either zero or one times in @scheme[options]. If the keyword occurs,
the associated list of parsed argument values must have exactly one
element, and that element is returned. If the keyword does not occur
in @scheme[options], the @scheme[default] value is returned.
}
@defproc[(check-identifier [stx syntax?] [ctx (or/c false/c syntax?)]) identifier?]{
A @techlink{check-procedure} that accepts only identifiers.

6
collects/syntax/scribblings/parse.scrbl
View File

@ -40,7 +40,8 @@ This section describes the @scheme[syntax-parse] pattern matching
form, syntax patterns, and attributes.
@defform/subs[(syntax-parse stx-expr parse-option ... clause ...+)
([parse-option (code:line #:literals (literal ...))
([parse-option (code:line #:context context-expr)
(code:line #:literals (literal ...))
(code:line #:literal-sets (literal-set ...))
(code:line #:conventions (convention-id ...))]
[literal literal-id
@ -57,7 +58,8 @@ subterms of the syntax object and that clause's side conditions and
If the syntax object fails to match any of the patterns (or all
matches fail the corresponding clauses' side conditions), a syntax
error is raised.
error is raised. If the @scheme[#:context] argument is given,
@scheme[context-expr] is used in reporting the error.
The @scheme[#:literals] option specifies identifiers that should match
as literals, rather than simply being pattern variables. A literal in