Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv19119/src/compiler

Modified Files:
	srctran.lisp 
Log Message:
1.0.34.13: add DERIVE-TYPE optimizer for %UNARY-ROUND

This change enables %UNARY-ROUND to be inlined on several platforms.


Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.171
retrieving revision 1.172
diff -u -d -r1.171 -r1.172
--- srctran.lisp	26 Jan 2010 15:42:43 -0000	1.171
+++ srctran.lisp	27 Jan 2010 01:57:12 -0000	1.172
@@ -1806,6 +1806,24 @@
                              (ftruncate-derive-type-quot-aux n divisor nil))
                          #'%unary-ftruncate)))
 
+(defoptimizer (%unary-round derive-type) ((number))
+  (one-arg-derive-type number
+                       (lambda (n)
+                         (block nil
+                           (unless (numeric-type-real-p n)
+                             (return *empty-type*))
+                           (let* ((interval (numeric-type->interval n))
+                                  (low      (interval-low interval))
+                                  (high     (interval-high interval)))
+                             (specifier-type
+                              `(integer ,(if low
+                                             (round low)
+                                             '*)
+                                        ,(if high
+                                             (round high)
+                                             '*))))))
+                       #'%unary-round))
+
 ;;; Define optimizers for FLOOR and CEILING.
 (macrolet
     ((def (name q-name r-name)