diff --git a/beautiful-racket-lib/br/define.rkt b/beautiful-racket-lib/br/define.rkt index 157ebe3..3dfb22d 100644 --- a/beautiful-racket-lib/br/define.rkt +++ b/beautiful-racket-lib/br/define.rkt @@ -149,7 +149,7 @@ (λ (stx) (define result (syntax-parameterize ([caller-stx (make-rename-transformer #'stx)]) - (syntax-parse (syntax-case stx () [any #'any]) + (syntax-parse (if (syntax? stx) stx (datum->syntax #'here stx)) #:literals BOUND-LITS #:datum-literals UNBOUND-LITS [pat . result-exprs] ... diff --git a/beautiful-racket-lib/br/private/generate-literals.rkt b/beautiful-racket-lib/br/private/generate-literals.rkt index 9d44d36..3e262c4 100644 --- a/beautiful-racket-lib/br/private/generate-literals.rkt +++ b/beautiful-racket-lib/br/private/generate-literals.rkt @@ -22,13 +22,13 @@ pat-arg)) (define (generate-bound-and-unbound-literals pats #:treat-as-bound [bound-id #f]) + (define literals (generate-literals pats)) (define-values (bound-literals unbound-literals) - (partition identifier-binding (for/list ([pat (in-list (generate-literals pats))] - #:unless (and bound-id (bound-identifier=? pat bound-id))) - pat))) + (partition (λ (i) (or (identifier-binding i) + (and bound-id (bound-identifier=? i bound-id)))) literals)) ;; return as list of two lists so it's easy to match them in syntax pattern - (list (if bound-id (cons bound-id bound-literals) bound-literals) - unbound-literals)) + ;; `syntax-parse` crabs if there are any duplicate ids, so remove them + (map (λ (ids) (remove-duplicates ids bound-identifier=?)) (list bound-literals unbound-literals))) (define (all-...-follow-wildcards pats) (define prev-datum (box #f)) diff --git a/beautiful-racket-lib/br/syntax.rkt b/beautiful-racket-lib/br/syntax.rkt index 9b08e5c..38abc1c 100644 --- a/beautiful-racket-lib/br/syntax.rkt +++ b/beautiful-racket-lib/br/syntax.rkt @@ -39,10 +39,11 @@ (define-macro (syntax-parse/easy STX LITS . EXPS) (with-syntax ([(BOUND-LITS UNBOUND-LITS) (generate-bound-and-unbound-literals #'LITS)]) - #'(syntax-parse (syntax-case STX () [any #'any]) + #'(let ([stx STX]) + (syntax-parse (if (syntax? stx) stx (datum->syntax #'here stx)) #:literals BOUND-LITS #:datum-literals UNBOUND-LITS - . EXPS))) + . EXPS)))) (define-macro-cases pattern-case [(_ STX-ARG