remove duplicates

pull/13/merge
Matthew Butterick 7 years ago
parent 3c452e4d90
commit 177dae090f

@ -149,7 +149,7 @@
(λ (stx) (λ (stx)
(define result (define result
(syntax-parameterize ([caller-stx (make-rename-transformer #'stx)]) (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 #:literals BOUND-LITS
#:datum-literals UNBOUND-LITS #:datum-literals UNBOUND-LITS
[pat . result-exprs] ... [pat . result-exprs] ...

@ -22,13 +22,13 @@
pat-arg)) pat-arg))
(define (generate-bound-and-unbound-literals pats #:treat-as-bound [bound-id #f]) (define (generate-bound-and-unbound-literals pats #:treat-as-bound [bound-id #f])
(define literals (generate-literals pats))
(define-values (bound-literals unbound-literals) (define-values (bound-literals unbound-literals)
(partition identifier-binding (for/list ([pat (in-list (generate-literals pats))] (partition (λ (i) (or (identifier-binding i)
#:unless (and bound-id (bound-identifier=? pat bound-id))) (and bound-id (bound-identifier=? i bound-id)))) literals))
pat)))
;; return as list of two lists so it's easy to match them in syntax pattern ;; 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) ;; `syntax-parse` crabs if there are any duplicate ids, so remove them
unbound-literals)) (map (λ (ids) (remove-duplicates ids bound-identifier=?)) (list bound-literals unbound-literals)))
(define (all-...-follow-wildcards pats) (define (all-...-follow-wildcards pats)
(define prev-datum (box #f)) (define prev-datum (box #f))

@ -39,10 +39,11 @@
(define-macro (syntax-parse/easy STX LITS . EXPS) (define-macro (syntax-parse/easy STX LITS . EXPS)
(with-syntax ([(BOUND-LITS UNBOUND-LITS) (generate-bound-and-unbound-literals #'LITS)]) (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 #:literals BOUND-LITS
#:datum-literals UNBOUND-LITS #:datum-literals UNBOUND-LITS
. EXPS))) . EXPS))))
(define-macro-cases pattern-case (define-macro-cases pattern-case
[(_ STX-ARG [(_ STX-ARG

Loading…
Cancel
Save