* Eliminates a jump-to-jump case in "flatten-code".

scheme/ikarus.compiler.altcogen.ss

@@ -2585,6 +2585,11 @@
   (define (unique-label)
     (label (gensym)))
   ;;;
+  (define (constant=? x k)
+    (struct-case x 
+      [(constant k0) (equal? k0 k)]
+      [else #f]))
+  ;;;
   (define (P x lt lf ac)
     (struct-case x
       [(constant c) 
@@ -2595,6 +2600,10 @@
        (E e0 (P e1 lt lf ac))]
       [(conditional e0 e1 e2)
        (cond
+         [(and (constant=? e1 #t) (constant=? e2 #f))
+          (P e0 lt lf ac)]
+         [(and (constant=? e1 #f) (constant=? e2 #t))
+          (P e0 lf lt ac)]
          [(and lt lf) 
           (let ([l (unique-label)])
             (P e0 #f l

scheme/ikarus.compiler.ss

@@ -1821,14 +1821,14 @@
                    cases)
               cp free name))])]
       [else (error who "invalid expression" (unparse x))]))
-  (when (assembler-output) 
-    (printf "BEFORE\n")
-    (pretty-print (unparse x)))
+  ;(when (assembler-output) 
+  ;  (printf "BEFORE\n")
+  ;  (pretty-print (unparse x)))
   (let ([x (E x)])
     (let ([v (make-codes all-codes x)])
-      (when (assembler-output) 
-        (printf "AFTER\n")
-        (pretty-print (unparse v)))
+      ;(when (assembler-output) 
+      ;  (printf "AFTER\n")
+      ;  (pretty-print (unparse v)))
       v)))
 
 

scheme/last-revision

@@ -1 +1 @@
-1101
+1102