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

syntax/parse: clean up insertion of default expressions in patterns

Browse Source
This commit is contained in:
Ryan Culpepper 2018-08-09 16:50:51 +02:00
parent 233c9b8f50
commit 4a7717679a
1 changed files with 9 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -874,9 +874,8 @@
(let* ([chunks (parse-keyword-options/eol #'more phase-directive-table (let* ([chunks (parse-keyword-options/eol #'more phase-directive-table
#:no-duplicates? #t #:no-duplicates? #t
#:context stx)] #:context stx)]
[phase (options-select-value chunks '#:phase [phase (options-select-value chunks '#:phase #:default #f)]
#:default #'(syntax-local-phase-level))]) [phase (if phase (txlift phase) #'(syntax-local-phase-level))])
;; FIXME: Duplicates phase expr!
(pat:literal #'lit phase phase))] (pat:literal #'lit phase phase))]
[_ [_
(wrong-syntax stx "bad ~~literal pattern")])) (wrong-syntax stx "bad ~~literal pattern")]))
@ -1036,12 +1035,11 @@
#:incompatible '((#:when #:unless)) #:incompatible '((#:when #:unless))
#:no-duplicates? #t)]) #:no-duplicates? #t)])
(let ([condition (let ([condition
(if (null? chunks) (cond [(options-select-value chunks '#:when #:default #f)
#'#t => values]
(let ([chunk (car chunks)]) [(options-select-value chunks '#:unless #:default #f)
(if (eq? (car chunk) '#:when) => (lambda (expr) #`(not #,expr))]
(caddr chunk) [else #'#t])])
#`(not #,(caddr chunk)))))])
(syntax-case rest () (syntax-case rest ()
[(message) [(message)
(action:fail condition #'message)] (action:fail condition #'message)]
@ -1562,9 +1560,8 @@
#:no-duplicates? #t #:no-duplicates? #t
#:context ctx)] #:context ctx)]
[lctx (options-select-value chunks '#:at #:default #'litset)] [lctx (options-select-value chunks '#:at #:default #'litset)]
[phase (options-select-value chunks '#:phase [phase (options-select-value chunks '#:phase #:default #f)])
#:default #'(syntax-local-phase-level))]) (elaborate #'litset lctx (if phase (txlift phase) #'(syntax-local-phase-level))))]
(elaborate #'litset lctx (txlift phase)))]
[litset [litset
(identifier? #'litset) (identifier? #'litset)
(elaborate #'litset #'litset #'(syntax-local-phase-level))] (elaborate #'litset #'litset #'(syntax-local-phase-level))]