~ chicken-core (chicken-5) 44348a9f9ab8bd3312e89e751a6307fe653e33f7

commit 44348a9f9ab8bd3312e89e751a6307fe653e33f7
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Jun 27 10:33:54 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Jun 27 10:33:54 2011 +0200

    drop else-branch when conditional test is non-boolean (as suggested by Joerg Wittenberger)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index bf0ed22d..36e3b566 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -100,6 +100,7 @@
   (let ((blist '())
 	(aliased '())
 	(noreturn #f)
+	(dropped-branches 0)
 	(safe-calls 0))
 
     (define (constant-result lit)
@@ -625,11 +626,18 @@
 		 ((##core#variable) (variable-result (first params) e loc flow))
 		 ((if)
 		  (let* ((tags (cons (tag) (tag)))
-			 (rt (single "in conditional" (walk (first subs) e loc #f #f flow tags) loc))
+			 (tst (first subs))
+			 (rt (single "in conditional" (walk tst e loc #f #f flow tags) loc))
 			 (c (second subs))
 			 (a (third subs))
 			 (nor0 noreturn))
-		    (always-true rt loc n)
+		    (when (and (always-true rt loc n) specialize)
+		      (set! dropped-branches (+ dropped-branches 1))
+		      (copy-node!
+		       (build-node-graph
+			`(let ((,(gensym) ,tst))
+			   ,c))
+		       n))
 		    (set! noreturn #f)
 		    (let* ((r1 (walk c e loc dest tail (cons (car tags) flow) #f))
 			   (nor1 noreturn))
@@ -904,6 +912,8 @@
 	 specialization-statistics))
       (when (positive? safe-calls)
 	(debugging 'x "safe calls" safe-calls)) ;XXX
+      (when (positive? dropped-branches)
+	(debugging 'x "dropped branches" dropped-branches)) ;XXX
       rn)))
 
 (define (compatible-types? t1 t2)