~ chicken-core (chicken-5) a2ea74893661fd798594c5be9792448e1fedab54

commit a2ea74893661fd798594c5be9792448e1fedab54
Author:     felix <felix@z.(none)>
AuthorDate: Sun Apr 3 09:14:11 2011 +0200
Commit:     felix <felix@z.(none)>
CommitDate: Sun Apr 3 09:14:11 2011 +0200

    enforcing adds blist entries for both cond.-tags

diff --git a/scrutinizer.scm b/scrutinizer.scm
index ed8418b4..c3eb0470 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -750,7 +750,6 @@
 				      (alist-cons (cons var (car ctags)) pt blist)))
 				   (a
 				    (when enforces
-				      ;;XXX when ctags is set, add blist entries for both flows
 				      (let ((ar (cond ((blist-type var flow) =>
 						       (lambda (t)
 							 (if (type<=? t argr)
@@ -760,8 +759,15 @@
 						      ((type<=? (cdr a) argr) (cdr a))
 						      (else argr))))
 					(d "  assuming: ~a -> ~a (flow: ~a)" var ar (car flow))
-					(set! blist 
-					  (alist-cons (cons var (car flow)) ar blist)))))))))
+					(set! blist
+					  (alist-cons (cons var (car flow)) ar blist))
+					(when ctags
+					  (set! blist
+					    (alist-cons
+					     (cons var (car ctags)) ar
+					     (alist-cons
+					      (cons var (cdr ctags)) ar
+					      blist)))))))))))
 		       subs
 		       (cons fn (procedure-argument-types fn (sub1 len))))
 		      r)))