[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2013-11-8-g5d7af87

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  5d7af879d56be571ab7818d3a547c08035287967 (commit)
       via  daa00b2733984884a56834efc28a4859872fa8ac (commit)
      from  d5983ca74965ef16fb3cb47d78024c3eb68a4a59 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 5d7af879d56be571ab7818d3a547c08035287967
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Dec 7 15:26:26 2013 -0800

    Teach compiler to derive the results of DECODE-FLOAT.
    
    src/compiler/float-tran.lisp
    o Add defoptimizer for DECODE-FLOAT.
    
    src/general-info/release-20f.txt:
    o Update notes.

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 187d17b..5fbc2e0 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -2014,6 +2014,89 @@
 	 (specifier-type `(complex ,(or (numeric-type-format arg) 'float))))
      #'cis))
 
+;;; Derive the result types of DECODE-FLOAT
+
+(defun decode-float-frac-derive-type-aux (arg)
+  ;; The fraction part of DECODE-FLOAT is always a subset of the
+  ;; interval [0.5, 1), even for subnormals.  While possible to derive
+  ;; a tighter bound in some cases, we don't.  Just return that
+  ;; interval of the approriate type when possible.  If not, just use
+  ;; float.
+  (if (numeric-type-format arg)
+      (specifier-type `(,(numeric-type-format arg)
+			 ,(coerce 1/2 (numeric-type-format arg))
+			 (,(coerce 1 (numeric-type-format arg)))))
+      (specifier-type '(float 0.5 (1.0)))))
+
+(defun decode-float-exp-derive-type-aux (arg)
+  ;; Derive the exponent part of the float.  It's always an integer
+  ;; type.
+  (flet ((calc-exp (x)
+	   (when x
+	     (nth-value 1 (decode-float x))))
+	 (min-exp ()
+	   ;; Use decode-float on 0 of the appropriate type to find
+	   ;; the min exponent.  If we don't know the actual number
+	   ;; format, use double, which has the widest range
+	   ;; (including double-double-float).
+	   (if (numeric-type-format arg)
+	       (nth-value 1 (decode-float (coerce 0 (numeric-type-format arg))))
+	       (nth-value 1 (decode-float (coerce 0 'double-float)))))
+	 (max-exp ()
+	   ;; Use decode-float on the most postive number of the
+	   ;; appropriate type to find the max exponent.  If we don't
+	   ;; know the actual number format, use double, which has the
+	   ;; widest range (including double-double-float).
+	   (if (eq (numeric-type-format arg) 'single-float)
+	       (nth-value 1 (decode-float most-positive-single-float))
+	       (nth-value 1 (decode-float most-positive-double-float)))))
+    (let* ((lo (or (bound-func #'calc-exp
+			       (numeric-type-low arg))
+		   (min-exp)))
+	   (hi (or (bound-func #'calc-exp
+			       (numeric-type-high arg))
+		   (max-exp))))
+      (specifier-type `(integer ,(or lo '*) ,(or hi '*))))))
+
+(defun decode-float-sign-derive-type-aux (arg)
+  ;; Derive the sign of the float.
+  (flet ((calc-sign (x)
+	   (when x
+	     (nth-value 2 (decode-float x)))))
+    (let* ((lo (bound-func #'calc-sign
+			       (numeric-type-low arg)))
+	   (hi (bound-func #'calc-sign
+			       (numeric-type-high arg))))
+      (if (numeric-type-format arg)
+	  (specifier-type `(,(numeric-type-format arg)
+			     ;; If lo or high bounds are NIL, use -1
+			     ;; or 1 of the appropriate type instead.
+			     ,(or lo (coerce -1 (numeric-type-format arg)))
+			     ,(or hi (coerce 1  (numeric-type-format arg)))))
+	  (specifier-type '(or (member 1f0 -1f0
+				1d0 -1d0
+				#+double-double 1w0
+				#+double-double -1w0)))))))
+
+(defoptimizer (decode-float derive-type) ((num))
+  (let ((f (one-arg-derive-type num
+				#'(lambda (arg)
+				    (decode-float-frac-derive-type-aux arg))
+				#'(lambda (arg)
+				    (nth-value 0 (decode-float arg)))))
+	(e (one-arg-derive-type num
+				#'(lambda (arg)
+				    (decode-float-exp-derive-type-aux arg))
+				#'(lambda (arg)
+				    (nth-value 1 (decode-float arg)))))
+	(s (one-arg-derive-type num
+				#'(lambda (arg)
+				    (decode-float-sign-derive-type-aux arg))
+				#'(lambda (arg)
+				    (nth-value 2 (decode-float arg))))))
+    (make-values-type :required (list f
+				      e
+				      s))))
 
 ;;; Support for double-double floats
 ;;;
diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt
index 4077097..dd1cf1b 100644
--- a/src/general-info/release-20f.txt
+++ b/src/general-info/release-20f.txt
@@ -28,6 +28,7 @@ New in this release:
       lowercase letters when needed.
     * Micro-optimize KERNEL:DOUBLE-FLOAT-BITS for x86/sse2.
     * Add micro-optimization for unary FTRUNCATE for x86/sse2.
+    * Compiler can derive the types of the results of DECODE-FLOAT.
 
   * ANSI compliance fixes:
 

commit daa00b2733984884a56834efc28a4859872fa8ac
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Dec 7 15:25:26 2013 -0800

    Regenerated.

diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot
index 3d53de0..283dcaf 100644
--- a/src/i18n/locale/cmucl.pot
+++ b/src/i18n/locale/cmucl.pot
@@ -14480,7 +14480,7 @@ msgid ""
 msgstr ""
 
 #: src/code/macros.lisp
-msgid "Cond clause is not a list: ~S."
+msgid "Cond clause should be a non-empty list: ~S."
 msgstr ""
 
 #: src/code/macros.lisp

-----------------------------------------------------------------------

Summary of changes:
 src/compiler/float-tran.lisp     |   83 ++++++++++++++++++++++++++++++++++++++
 src/general-info/release-20f.txt |    1 +
 src/i18n/locale/cmucl.pot        |    2 +-
 3 files changed, 85 insertions(+), 1 deletion(-)


hooks/post-receive
-- 
CMU Common Lisp