Add code to handle when the test expression is neither true nor false.

Closes PR 14564.

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/dead-code.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require syntax/parse racket/promise syntax/stx unstable/sequence
+         racket/syntax
          (for-template racket/base)
          "../utils/utils.rkt"
          (types type-table)
@@ -12,31 +13,33 @@
 ;; The type based 'dead code elimination' done by this file just makes the dead code obvious.
 ;; The actual elimination step is left to the compiler.
 
-
-;; if the conditional has a known truth value, we can reveal this
-;; we have to keep the test, in case it has side effects
-(define-syntax-class tautology
-  #:attributes (opt)
-  (pattern e:opt-expr
-    #:when (tautology? #'e)
-    #:attr opt (delay #'(begin e.opt #t))))
-
-(define-syntax-class contradiction
-  #:attributes (opt)
-  (pattern e:opt-expr
-    #:when (contradiction? #'e)
-    #:attr opt (delay #'(begin e.opt #f))))
-
-
 (define-syntax-class dead-code-opt-expr
   #:commit
   #:literal-sets (kernel-literals)
-  (pattern ((~and kw if) tst:tautology thn:opt-expr els:expr)
+  (pattern ((~and kw if) tst:opt-expr thn:opt-expr els:opt-expr)
-    #:do [(log-optimization "dead else branch" "Unreachable else branch elimination." #'els)]
+    #:do [(define takes-true (test-position-takes-true-branch #'tst))
-    #:with opt (syntax/loc/origin this-syntax #'kw (if tst.opt thn.opt els)))
+          (define takes-false (test-position-takes-false-branch #'tst))
-  (pattern ((~and kw if) tst:contradiction thn:expr els:opt-expr)
+          (unless takes-true
-    #:do [(log-optimization "dead then branch" "Unreachable then branch elimination." #'thn)]
+            (log-optimization "dead then branch" "Unreachable then branch elimination." #'thn))
-    #:with opt (syntax/loc/origin this-syntax #'kw (if tst.opt thn els.opt)))
+          (unless takes-false
+            (log-optimization "dead else branch" "Unreachable else branch elimination." #'els))]
+    #:with thn-opt (if takes-true #'thn.opt #'thn)
+    #:with els-opt (if takes-false #'els.opt #'els)
+    ;; if the conditional has a known truth value, we can reveal this
+    ;; we have to keep the test, in case it has side effects
+    #:with opt
+      (cond
+        [(and (not takes-true) (not takes-false))
+         (quasisyntax/loc/origin this-syntax #'kw
+           (if #t tst.opt (begin thn-opt els-opt)))]
+        [else
+          (define/with-syntax tst-opt
+            (cond
+              [(and takes-true takes-false) #'tst.opt]
+              [takes-true #'(begin tst.opt #t)]
+              [takes-false #'(begin tst.opt #f)]))
+          (quasisyntax/loc/origin this-syntax #'kw
+            (if tst-opt thn-opt els-opt))]))
   (pattern ((~and kw lambda) formals . bodies)
     #:when (dead-lambda-branch? #'formals)
     #:with opt this-syntax)

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt

@@ -18,8 +18,8 @@
  [reset-type-table (-> any/c)]
  [test-position-add-true (syntax? . -> . any)]
  [test-position-add-false (syntax? . -> . any)]
- [tautology? (syntax? . -> . boolean?)]
+ [test-position-takes-true-branch (syntax? . -> . boolean?)]
- [contradiction? (syntax? . -> . boolean?)]
+ [test-position-takes-false-branch (syntax? . -> . boolean?)]
  [add-dead-lambda-branch (syntax? . -> . any)]
  [dead-lambda-branch? (syntax? . -> . boolean?)]
  [;; Register that the given expression should be ignored
@@ -63,29 +63,18 @@
                                         (syntax-column e))))))
 
 ;; For expressions in test position keep track of if it evaluates to true/false
-;; values: can be 'true, 'false, 'both.
+(define test-position-table/true (make-hasheq))
-(define test-position-table (make-hasheq))
+(define test-position-table/false (make-hasheq))
 
 (define (test-position-add-true expr)
-  (hash-update! test-position-table expr
+  (hash-set! test-position-table/true expr #t))
-    (lambda (v)
-      (case v
-        [(true) 'true]
-        [(false both) 'both]))
-    'true))
 (define (test-position-add-false expr)
-  (hash-update! test-position-table expr
+  (hash-set! test-position-table/false expr #t))
-    (lambda (v)
-      (case v
-        [(false) 'false]
-        [(true both) 'both]))
-    'false))
 
-(define-values (tautology? contradiction?)
+(define (test-position-takes-true-branch expr)
-  (let ()
+  (hash-ref test-position-table/true expr #f))
-    (define ((mk t?) e)
+(define (test-position-takes-false-branch expr)
-      (eq? t? (hash-ref test-position-table e 'not-there)))
+  (hash-ref test-position-table/false expr #f))
-    (values (mk 'true) (mk 'false))))
 
 ;; keeps track of lambda branches that never get evaluated, so that the
 ;; optimizer can eliminate dead code. The key is the formals syntax object.

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/both-if-branches-dead.rkt

@@ -0,0 +1,13 @@
+#;#;
+#<<END
+TR opt: both-if-branches-dead.rkt 4:6 12 -- dead then branch
+TR opt: both-if-branches-dead.rkt 5:6 (* 3 4) -- dead else branch
+END
+""
+#lang typed/racket/base
+#reader tests/typed-racket/optimizer/reset-port
+;; Test that code where neither branch is taken works
+(let/ec: k : Any
+  (if (k (void))
+      12
+      (* 3 4)))