From 95e7bdd7d7721332d888f5595371819fcaa08577 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 7 Jun 2023 15:52:56 +0200
Subject: [PATCH] cmpc: change compiler-macro cl:float to c-inliner macro

The compiler macro expanded float to c-inline.
---
 src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp | 15 +++++++++++++++
 src/cmp/cmpopt.lsp                      | 23 -----------------------
 2 files changed, 15 insertions(+), 23 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
index 08656d56a..699d01bf1 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
@@ -135,3 +135,18 @@
      do (if arguments
             (setf arg1 (save-inline-loc result))
             (return result))))
+
+(define-c-inliner float (return-type arg &optional float)
+  (let ((arg-c-type (lisp-type->rep-type (inlined-arg-type arg)))
+        (flt-c-type (lisp-type->rep-type (inlined-arg-type float))))
+    (when (member flt-c-type '(:float :double :long-double))
+      (if (eq arg-c-type flt-c-type)
+          (inlined-arg-loc arg)
+          (produce-inline-loc (list arg)
+                              (list :object)
+                              (list flt-c-type)
+                              (ecase flt-c-type
+                                (:float       "ecl_to_float(#0)")
+                                (:double      "ecl_to_double(#0)")
+                                (:long-double "ecl_to_long_double(#0)"))
+                              nil t)))))
diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp
index 08b7c4a9d..545fce8d4 100644
--- a/src/cmp/cmpopt.lsp
+++ b/src/cmp/cmpopt.lsp
@@ -339,29 +339,6 @@
 (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* ((float (type-of float))
-               (c-type (lisp-type->rep-type float)))
-          `(let ((value ,value))
-             (declare (:read-only value))
-             (ext: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))
-
 (define-compiler-macro princ (&whole whole expression &optional stream &environment env)
   (if (constantp expression env)
       (let ((value (ext:constant-form-value expression env)))