From 4c8e90b8aca56dee3730d8c8abeed41f6a0ba466 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 6 Dec 2011 09:42:40 -0500
Subject: [PATCH] Drop some trivially-pure code.

original commit: a497300fbe2b7fff390cbb3707e23b968b3826a1
---
 .../optimizer/tests/drop-pure-pred.rkt        | 16 ++++++++++
 collects/typed-racket/optimizer/dead-code.rkt | 29 +++++++++++++++++--
 2 files changed, 42 insertions(+), 3 deletions(-)
 create mode 100644 collects/tests/typed-racket/optimizer/tests/drop-pure-pred.rkt

diff --git a/collects/tests/typed-racket/optimizer/tests/drop-pure-pred.rkt b/collects/tests/typed-racket/optimizer/tests/drop-pure-pred.rkt
new file mode 100644
index 00000000..ae2552dd
--- /dev/null
+++ b/collects/tests/typed-racket/optimizer/tests/drop-pure-pred.rkt
@@ -0,0 +1,16 @@
+#;
+(
+TR opt: drop-pure-pred.rkt 13:6 (exact-integer? x) -- useless pure code
+TR opt: drop-pure-pred.rkt 15:6 (list 2) -- dead else branch
+'(1)
+)
+
+#lang typed/scheme
+#:optimize
+
+(let ()
+  (define x 7)
+  (if (exact-integer? x)
+      (list 1)
+      (list 2)))
+
diff --git a/collects/typed-racket/optimizer/dead-code.rkt b/collects/typed-racket/optimizer/dead-code.rkt
index 01fa25e8..da14192d 100644
--- a/collects/typed-racket/optimizer/dead-code.rkt
+++ b/collects/typed-racket/optimizer/dead-code.rkt
@@ -1,13 +1,36 @@
 #lang scheme/base
 
 (require syntax/parse
-         (for-template scheme/base)
+         (for-template scheme/base racket/flonum racket/fixnum)
          "../utils/utils.rkt"
          (types type-table)
+         (utils tc-utils)
          (optimizer utils logging))
 
 (provide dead-code-opt-expr)
 
+(define-syntax-class predicate
+  #:literals (flvector? fxvector? exact-integer? fixnum? flonum? vector? string? bytes?)
+  [pattern (~and x:id (~or flvector? exact-integer? fixnum? flonum? vector? fxvector?))])
+
+(define (pure? stx)
+  (syntax-parse stx
+    #:literals (#%plain-app)
+    [(#%plain-app f:predicate x:id)
+     #:when (eq? 'lexical (identifier-binding #'x))
+     (add-disappeared-use #'f)
+     (add-disappeared-use #'x)
+     #true]
+    [else #false]))
+
+(define (optimize/drop-pure stx) 
+  (cond [(pure? stx)
+         (log-optimization "useless pure code"
+                           "Unreachable pure code elimination."
+                           stx)
+         (syntax/loc stx (void))]
+        [else ((optimize) stx)]))
+
 (define-syntax-class dead-code-opt-expr
   #:commit
   ;; if one of the brances of an if is unreachable, we can eliminate it
@@ -20,7 +43,7 @@
                                     #'els)
                   (quasisyntax/loc/origin 
                    this-syntax #'kw
-                   (#%expression (begin #,((optimize) #'tst)
+                   (#%expression (begin #,(optimize/drop-pure #'tst)
                                         #,((optimize) #'thn))))))
   (pattern ((~and kw (~literal if)) tst:expr thn:expr els:expr)
            #:when (contradiction? #'tst)
@@ -30,5 +53,5 @@
                                     #'thn)
                   (quasisyntax/loc/origin 
                    this-syntax #'kw
-                   (#%expression (begin #,((optimize) #'tst)
+                   (#%expression (begin #,(optimize/drop-pure #'tst)
                                         #,((optimize) #'els)))))))