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

syntax/parse: report stxclass arity error without ~var form

Browse Source 
closes PR 11933
This commit is contained in:
Ryan Culpepper 2011-06-26 04:09:41 -06:00
parent 7517fa948f
commit 2cea046fef
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -726,10 +726,10 @@ A syntax class is integrable if
#'name] #'name]
[_ [_
(wrong-syntax stx "bad ~~var form")])) (wrong-syntax stx "bad ~~var form")]))
(define-values (scname argu pfx) (define-values (scname sc+args-stx argu pfx)
(syntax-case stx (~var) (syntax-case stx (~var)
[(~var _name) [(~var _name)
(values #f null #f)] (values #f #f null #f)]
[(~var _name sc/sc+args . rest) [(~var _name sc/sc+args . rest)
(let-values ([(sc argu) (let-values ([(sc argu)
(let ([p (check-stxclass-application #'sc/sc+args stx)]) (let ([p (check-stxclass-application #'sc/sc+args stx)])
@ -740,7 +740,7 @@ A syntax class is integrable if
#:context stx)) #:context stx))
(define sep (define sep
(options-select-value chunks '#:attr-name-separator #:default #f)) (options-select-value chunks '#:attr-name-separator #:default #f))
(values sc argu (if sep (syntax-e sep) ".")))] (values sc #'sc/sc+args argu (if sep (syntax-e sep) ".")))]
[_ [_
(wrong-syntax stx "bad ~~var form")])) (wrong-syntax stx "bad ~~var form")]))
(cond [(and (epsilon? name0) (not scname)) (cond [(and (epsilon? name0) (not scname))
@ -748,7 +748,7 @@ A syntax class is integrable if
[(and (wildcard? name0) (not scname)) [(and (wildcard? name0) (not scname))
(create-pat:any)] (create-pat:any)]
[scname [scname
(let ([sc (get-stxclass/check-arity scname stx (let ([sc (get-stxclass/check-arity scname sc+args-stx
(length (arguments-pargs argu)) (length (arguments-pargs argu))
(arguments-kws argu))]) (arguments-kws argu))])
(parse-pat:var* stx allow-head? name0 sc argu pfx))] (parse-pat:var* stx allow-head? name0 sc argu pfx))]