simplify gather-common-attrs

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)
+(define attr-missing (gensym))
-  (let ([qs qs-in])
+(define (gather-common-attrs qs)
-    (and (quad-attrs (car qs))
+  (let loop ([qs qs]
-         (let ([attr-missing (gensym)])
+             [common-attrs (if (quad-attrs (car qs))
-           (let loop ([qs (cdr qs)]
+                               (for/list ([kv-pair (in-hash-pairs (quad-attrs (car qs)))] 
-                      [common-attrs (for/list ([kv-pair (in-hash-pairs (quad-attrs (car qs)))] 
+                                          #:unless (member (car kv-pair) cannot-be-common-attrs))  
-                                               #:unless (member (car kv-pair) cannot-be-common-attrs))  
+                                 kv-pair)
-                                      kv-pair)])
+                               empty)])
-             (cond
+    (cond
-               [(empty? common-attrs) #f]
+      [(empty? common-attrs) #f]
-               [(empty? qs) (flatten common-attrs)]
+      [(empty? qs) (flatten common-attrs)]
-               [else (define reference-quad (car qs))
+      [else (loop (cdr qs) 
-                     (loop (cdr qs) 
+                  (filter (λ(ca) (equal? (quad-attr-ref (car qs) (car ca) attr-missing) (cdr ca)))
-                           (filter (λ(ca) (let ([v (quad-attr-ref reference-quad (car ca) attr-missing)])
+                          common-attrs))])))
-                                            (equal? v (cdr ca))))
-                                   common-attrs))]))))))
 
 
 (define-syntax (define-box-type stx)