From 3ebe9e78f9c86feb14d80dd499adec6438dc37e3 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 15 Mar 2011 16:42:01 -0400
Subject: [PATCH] Optimize add1 and sub1 on floats and fixnums.

---
 .../tests/typed-scheme/optimizer/tests/add1.rkt | 17 +++++++++++++++++
 collects/typed-scheme/optimizer/fixnum.rkt      | 13 ++++++++++++-
 collects/typed-scheme/optimizer/float.rkt       | 11 ++++++++++-
 3 files changed, 39 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/add1.rkt

diff --git a/collects/tests/typed-scheme/optimizer/tests/add1.rkt b/collects/tests/typed-scheme/optimizer/tests/add1.rkt
new file mode 100644
index 0000000000..49e97d4048
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/add1.rkt
@@ -0,0 +1,17 @@
+#;
+(
+add1.rkt line 14 col 6 - add1 - fixnum add1
+add1.rkt line 15 col 6 - sub1 - fixnum sub1
+add1.rkt line 16 col 6 - add1 - float add1
+add1.rkt line 17 col 6 - sub1 - float sub1
+6
+2
+3.3
+1.25
+)
+
+#lang typed/racket #:optimize
+(ann (add1 5) Fixnum)
+(ann (sub1 3) Fixnum)
+(ann (add1 2.3) Float)
+(ann (sub1 2.25) Float)
diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt
index c8ee0533ad..c8c7399e2a 100644
--- a/collects/typed-scheme/optimizer/fixnum.rkt
+++ b/collects/typed-scheme/optimizer/fixnum.rkt
@@ -150,4 +150,15 @@
            #:when (subtypeof? #'n -NonNegFixnum) ; (abs min-fixnum) is not a fixnum
            #:with opt
            (begin (log-optimization "fixnum fxabs" #'op)
-                  #'(unsafe-fxabs n.opt))))
+                  #'(unsafe-fxabs n.opt)))
+
+  (pattern (#%plain-app (~and op (~literal add1)) n:fixnum-expr)
+           #:when (subtypeof? this-syntax -Fixnum)
+           #:with opt
+           (begin (log-optimization "fixnum add1" #'op)
+                  #'(unsafe-fx+ n.opt 1)))
+  (pattern (#%plain-app (~and op (~literal sub1)) n:fixnum-expr)
+           #:when (subtypeof? this-syntax -Fixnum)
+           #:with opt
+           (begin (log-optimization "fixnum sub1" #'op)
+                  #'(unsafe-fx- n.opt 1))))
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index a6cf12636b..3b278de2d4 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -124,4 +124,13 @@
   (pattern (#%plain-app (~and op (~literal zero?)) f:float-expr)
            #:with opt
            (begin (log-optimization "float zero?" #'op)
-                  #'(unsafe-fl= f.opt 0.0))))
+                  #'(unsafe-fl= f.opt 0.0)))
+
+  (pattern (#%plain-app (~and op (~literal add1)) n:float-expr)
+           #:with opt
+           (begin (log-optimization "float add1" #'op)
+                  #'(unsafe-fl+ n.opt 1.0)))
+  (pattern (#%plain-app (~and op (~literal sub1)) n:float-expr)
+           #:with opt
+           (begin (log-optimization "float sub1" #'op)
+                  #'(unsafe-fl- n.opt 1.0))))