From 22d8ff707cda8f4253420092f9f4ebc466408258 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Sat, 2 Jun 2012 09:51:08 +0200
Subject: [PATCH] FLOAT optimizer is now a bit more clever and returns a typed
 output with inlined forms

---
 src/cmp/cmpopt-constant.lsp |  6 ++++++
 src/cmp/cmpopt.lsp          | 24 ++++++++++++++++++++++++
 2 files changed, 30 insertions(+)

diff --git a/src/cmp/cmpopt-constant.lsp b/src/cmp/cmpopt-constant.lsp
index f113a41e5..4dfde16d5 100644
--- a/src/cmp/cmpopt-constant.lsp
+++ b/src/cmp/cmpopt-constant.lsp
@@ -29,3 +29,9 @@
         (error (c) failure))
       failure))
 
+(defun constant-value-p (form &optional env)
+  (if (constant-expression-p form)
+      (handler-case
+	  (values t (cmp-eval form))
+	(error (c) (values nil form)))
+      (values nil form)))
diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp
index 73b1ddbba..696a2db7e 100644
--- a/src/cmp/cmpopt.lsp
+++ b/src/cmp/cmpopt.lsp
@@ -316,3 +316,27 @@
 
 (define-compiler-macro coerce (&whole form value type &environment env)
   (expand-coerce form value type env))
+
+(define-compiler-macro float (&whole form value &optional float &environment env)
+  (or 
+   (and
+    float
+    (policy-inline-type-checks env)
+    (multiple-value-bind (constant-p float)
+	(constant-value-p float env)
+      (when (and constant-p (floatp float))
+	(let* ((aux (gentemp))
+	       (float (type-of float))
+	       (c-type (lisp-type->rep-type float)))
+	  `(let ((value ,value))
+	     (declare (:read-only value))
+	     (compiler-typecase value
+	       (,float value)
+	       (t
+		(ffi:c-inline (value) (:object) ,c-type
+			      ,(ecase c-type
+				      (:double "ecl_to_double(#0)")
+				      (:float "ecl_to_float(#0)")
+				      (:long-double "ecl_to_long_double(#0)"))
+			      :one-liner t :side-effects nil))))))))
+   form))