From adb97c757bb38960dfe0658f398aa5220b3bd2d6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 2 Jan 2015 12:54:17 -0800 Subject: [PATCH] simplify gather-common-attrs --- quad/quads.rkt | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/quad/quads.rkt b/quad/quads.rkt index caa2fb6f..8a91aa06 100644 --- a/quad/quads.rkt +++ b/quad/quads.rkt @@ -135,22 +135,20 @@ ;; make this a macro because qs-in is often huge ;; and the macro avoids allocation + garbage collection -(define-syntax-rule (gather-common-attrs qs-in) - (let ([qs qs-in]) - (and (quad-attrs (car qs)) - (let ([attr-missing (gensym)]) - (let loop ([qs (cdr qs)] - [common-attrs (for/list ([kv-pair (in-hash-pairs (quad-attrs (car qs)))] - #:unless (member (car kv-pair) cannot-be-common-attrs)) - kv-pair)]) - (cond - [(empty? common-attrs) #f] - [(empty? qs) (flatten common-attrs)] - [else (define reference-quad (car qs)) - (loop (cdr qs) - (filter (λ(ca) (let ([v (quad-attr-ref reference-quad (car ca) attr-missing)]) - (equal? v (cdr ca)))) - common-attrs))])))))) +(define attr-missing (gensym)) +(define (gather-common-attrs qs) + (let loop ([qs qs] + [common-attrs (if (quad-attrs (car qs)) + (for/list ([kv-pair (in-hash-pairs (quad-attrs (car qs)))] + #:unless (member (car kv-pair) cannot-be-common-attrs)) + kv-pair) + empty)]) + (cond + [(empty? common-attrs) #f] + [(empty? qs) (flatten common-attrs)] + [else (loop (cdr qs) + (filter (λ(ca) (equal? (quad-attr-ref (car qs) (car ca) attr-missing) (cdr ca))) + common-attrs))]))) (define-syntax (define-box-type stx)