fix gather-common-attrs

quad/quads-typed.rkt

@@ -113,25 +113,23 @@
       [else ""])))
 
 (define/typed+provide (gather-common-attrs qs)
-  ((Listof Quad) . -> . (U False HashableList))
-  (: check-cap (QuadAttrPair . -> . Boolean))
-  (define (check-cap cap)
-    (equal? (quad-attr-ref (car qs) (car cap) attr-missing) (cdr cap)))
+  ((Listof Quad) . -> . (Option HashableList))
+  (: check-cap (Quad QuadAttrPair . -> . Boolean))
+  (define (check-cap q cap) ; cap = candidate-attr-pair
+    (equal? (quad-attr-ref q (car cap) attr-missing) (cdr cap)))
   (let loop 
     ([qs qs]
-     [common-attr-pairs : (Listof QuadAttrPair) (if (quad-attrs (car qs))
-                                                    
+     ;; start with the set of pairs in the first quad, then filter it down
+     [candidate-attr-pairs : (Listof QuadAttrPair) (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)
                                                     null)])
     (cond
-      [(null? common-attr-pairs) #f]
-      [(null? qs) (cast (flatten common-attr-pairs) HashableList)] ;; flatten + cast needed because this output gets used by quadattrs
+      [(null? candidate-attr-pairs) #f] ; ran out of possible pairs, so return #f
+      [(null? qs) (cast (flatten candidate-attr-pairs) HashableList)] ; ran out of quads, so return common-attr-pairs
       ;; todo: reconsider type interface between output of this function and input to quadattrs
-      [else (loop (cdr qs) (filter check-cap common-attr-pairs))])))
-
-
+      [else (loop (cdr qs) (filter (λ([cap : QuadAttrPair]) (check-cap (car qs) cap)) candidate-attr-pairs))])))
 
 (: quadattrs ((Listof Any) . -> . QuadAttrs))
 (define (quadattrs xs)

quad/tests-typed.rkt

@@ -9,9 +9,10 @@
 (check-equal? (flatten-attrs (hash 'x -5.0) (hash 'x 10.0)) (apply hash '(x 5.0)))
 (check-equal? (merge-attrs (hash 'x -5.0) (hash 'x 10.0)) (apply hash '(x 10.0)))
 
-(check-equal? (gather-common-attrs (list (box '(foo bar)) (box '(foo bar goo bar zam zino)) (box '(foo bar)))) (list (cons 'foo 'bar)))
-(check-equal? (gather-common-attrs (list (box) (box '(foo bar goo bar zam zino)) (box '(foo bar)))) #f)
-(check-equal? (gather-common-attrs (list (box '(width bar)) (box '(width bar)) (box '(width bar)))) #f)
+(check-equal? (gather-common-attrs (list (box '(foo bar)) (box '(foo bar goo bar zam zino)) (box '(foo bar goo rab)))) '(foo bar))
+(check-false (gather-common-attrs (list (box) (box '(foo bar goo bar zam zino)) (box '(foo bar)))))
+(check-false (gather-common-attrs (list (box '(width bar)) (box '(width bar)) (box '(width bar)))))
+(check-false (gather-common-attrs (list (box '(foo bar)) (box '(foo zam)))))
 
 (define b1 (box '(x 10.0) "1st" (box '(foo bar) "2nd") "3rd"))
 (define b1-flattened (list (box '(x 10.0) "1st") (box '(x 10.0 foo bar) "2nd") (box '(x 10.0) "3rd")))