From 2892e353d4f36e81ab36e2c1474e932a1c00b6ca Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Mon, 7 May 2012 16:18:33 +0400
Subject: [PATCH] Optimize truncate, ceiling and friends when divisor is 1 or
 -1.

If divisor is 1, return (values x 0), if it's -1 (values (- x) 0). If
it's a floating point truncation, like ftruncate or fceiling,
(values (- (float x)) 0).
---
 NEWS                      |    2 ++
 src/compiler/srctran.lisp |   18 ++++++++++++++++++
 2 files changed, 20 insertions(+)

diff --git a/NEWS b/NEWS
index a820ca0..71ddcd1 100644
--- a/NEWS
+++ b/NEWS
@@ -123,6 +123,8 @@ changes in sbcl-1.0.55 relative to sbcl-1.0.54:
   * optimization: the compiler no longer refuses to coerce large fixnums to
     single floats inline, except on x86 where this limitation is still
     necessary.
+  * optimization: truncation operations with constant divisor arguments
+    1 and -1 are optimized away.
   * bug fix: deadlock detection could report the same deadlock twice, for
     two different threads. Now a single deadlock is reported exactly once.
   * bug fix: interval-arithmetic division during type derivation did not
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index e666b87..ad7abbc 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -3587,6 +3587,24 @@
   (def round)
   (def floor)
   (def ceiling))
+
+(macrolet ((def (name &optional float)
+             (let ((x (if float '(float x) 'x)))
+               `(deftransform ,name ((x y) (integer (constant-arg (member 1 -1)))
+                                     *)
+                  "fold division by 1"
+                  `(values ,(if (minusp (lvar-value y))
+                                '(%negate ,x)
+                                ',x)  0)))))
+  (def truncate)
+  (def round)
+  (def floor)
+  (def ceiling)
+  (def ftruncate t)
+  (def fround t)
+  (def ffloor t)
+  (def fceiling t))
+
 
 ;;;; character operations
 
-- 
1.7.10.4