mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-02-18 05:00:55 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmpc: change compiler-macro cl:float to c-inliner macro

Browse source 
The compiler macro expanded float to c-inline.
This commit is contained in:
Daniel Kochmański 2023-06-07 15:52:56 +02:00
parent 4a1902658c
commit 95e7bdd7d7
2 changed files with 15 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
View file

@ -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)))))

23
src/cmp/cmpopt.lsp
View file

@ -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)))