From f1091f4cd6dd55e2317ee4a7e0cd6a605edd98b2 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Fri, 12 Dec 2025 22:37:12 +0100 Subject: [PATCH 1/4] expt: fix floating point contagion Examples of the bug (expt -1.4d0 #C(1 2)) -> #C(-0.0020444484 -0.0016295447) (expt #C(1.0 3.0) 0.0d0) -> #C(1.0 0.0) These return a (complex single-float), should be (complex double-float). The code incorrectly assumed that the numbers associated to the types tx and ty were ordered such that long floats and complex long floats have higher numbers than double floats and complex double floats. --- src/c/numbers/expt.d | 20 +++++++++++--------- src/tests/normal-tests/complex.lsp | 6 ++++++ 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/src/c/numbers/expt.d b/src/c/numbers/expt.d index 66b16276e..ea387faf3 100644 --- a/src/c/numbers/expt.d +++ b/src/c/numbers/expt.d @@ -80,8 +80,14 @@ expt_zero(cl_object x, cl_object y) return ecl_make_complex(z, ecl_make_fixnum(0)); #ifdef ECL_COMPLEX_FLOAT case t_csfloat: + if (tx == t_longfloat || ty == t_longfloat) + return clfloat_one; + if (tx == t_doublefloat || ty == t_doublefloat) + return cdfloat_one; return csfloat_one; case t_cdfloat: + if (tx == t_longfloat || ty == t_longfloat) + return clfloat_one; return cdfloat_one; case t_clfloat: return clfloat_one; @@ -149,21 +155,17 @@ ecl_expt_complex_float(cl_object x, cl_object y) { cl_object ret; ECL_MATHERR_CLEAR; - switch ((ty > tx)? ty : tx) { - case t_clfloat: - case t_longfloat: + if (tx == t_clfloat || tx == t_longfloat || + ty == t_clfloat || ty == t_longfloat) { ret = ecl_make_clfloat (cpowl(ecl_to_clfloat(x), ecl_to_clfloat(y))); - break; - case t_cdfloat: - case t_doublefloat: + } else if (tx == t_cdfloat || tx == t_doublefloat || + ty == t_cdfloat || ty == t_doublefloat) { ret = ecl_make_cdfloat (cpow (ecl_to_cdfloat(x), ecl_to_cdfloat(y))); - break; - default: + } else { ret = ecl_make_csfloat (cpowf(ecl_to_csfloat(x), ecl_to_csfloat(y))); - break; } ECL_MATHERR_TEST; return ret; diff --git a/src/tests/normal-tests/complex.lsp b/src/tests/normal-tests/complex.lsp index d2276acbc..2fd66b56e 100644 --- a/src/tests/normal-tests/complex.lsp +++ b/src/tests/normal-tests/complex.lsp @@ -304,3 +304,9 @@ ;; (test csfloat.0010.issue-547 (finishes (expt #c(1.0 0.0) 2)))) + +(test complex.0011.expt-float-contagion + (is (typep (expt -1.4d0 #C(1 2)) '(complex double-float))) + (is (typep (expt -1.4l0 #C(1 2)) '(complex long-float))) + (is (typep (expt #C(1.0 3.0) 0.0d0) '(complex double-float))) + (is (typep (expt #C(1.0 3.0) 0.0l0) '(complex long-float)))) From c6488fa1c115b59655fbc3c0d0e912087f7c7f49 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Fri, 12 Dec 2025 23:05:02 +0100 Subject: [PATCH 2/4] cmp: fix type propagator for EXPT There were a number of bugs here: - REAL was returned even for complex exponents - The special case of exponent=0 wasn't handled correctly - In some cases, EXPT could return integer or rational results but the type propagator would always assume that coercion to floating point was happening. --- src/cmp/cmpprop-num.lsp | 33 ++++++++++++------ src/tests/normal-tests/compiler.lsp | 53 +++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+), 11 deletions(-) diff --git a/src/cmp/cmpprop-num.lsp b/src/cmp/cmpprop-num.lsp index ba78ca536..8ad2b1e8e 100644 --- a/src/cmp/cmpprop-num.lsp +++ b/src/cmp/cmpprop-num.lsp @@ -131,17 +131,28 @@ ;; (expt number-type integer) -> number-type ;; (expt number-type1 number-type2) -> (max-float number-type1 number-type2) ;; - (let ((exponent (ensure-real-type exponent))) - (values (list base exponent) - (cond ((eql exponent 'integer) - (if (subtypep base 'fixnum *cmp-env*) - 'integer - base)) - ((type>= '(real 0 *) base *cmp-env*) - (let* ((exponent (ensure-nonrational-type exponent))) - (maximum-number-type exponent base))) - (t - 'number))))) + (values (list base exponent) + (cond ((type>= '(real 0 0) base *cmp-env*) + (maximum-number-type base exponent)) + ((type>= '(real (0) *) base *cmp-env*) + (cond ((type>= '(integer 0 *) exponent *cmp-env*) + (maximum-number-type base 'integer :integer-result 'integer)) + ((type-and exponent 'integer) + ;; This becomes quite complex here, simplify + ;; our life by just returning 'number. We + ;; could do better, but the compiler won't be + ;; able to optimize much with the complicated + ;; type combinations we would be returning + ;; here. + 'number) + (t + (maximum-number-type (ensure-nonrational-type exponent) + base)))) + ((or (type>= '(complex float) base *cmp-env*) + (type>= '(complex float) exponent *cmp-env*)) + (maximum-number-type exponent base)) + (t + 'number)))) (def-type-propagator abs (fname arg) (multiple-value-bind (output arg) diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp index 231b60789..90a003ee9 100644 --- a/src/tests/normal-tests/compiler.lsp +++ b/src/tests/normal-tests/compiler.lsp @@ -2602,3 +2602,56 @@ '(lambda () (- most-positive-fixnum 3)))) (- most-positive-fixnum 3))) + +;;; Date 2025-12-12 +;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/804 +;;; Description +;;; +;;; Incorrect type propagation and inline expansions for the EXPT +;;; function +;;; +(deftest cmp.0112.type-propagation-expt () + (flet ((supertypes (tp) + (let ((types '(fixnum integer ratio rational + single-float double-float long-float float real + (complex integer) (complex ratio) (complex rational) + (complex single-float) (complex double-float) (complex long-float) + (complex float) number + (integer (0) *) (single-float (0) *) (double-float (0) *) + (long-float (0) *) (float (0) *) (real (0) *)))) + (cons tp + (loop for supertype in types + if (subtypep tp supertype) + collect supertype))))) + (let* ((numbers '(-2 -1 0 1 2 + -1/2 1/3 + -1.3 0.0 0.75 1.0 + -0.8d0 0.0d0 1.0d0 1.3d0 + -1.6l0 0.0l0 1.0l0 0.9l0 + #C(1 2) #C(1/2 3/2) + #C(1.0 3.0) #C(1.0d0 0.5d0) #C(1.0l0 2.3l0))) + (numbers-and-types + (loop for base in numbers + nconc (loop for exponent in numbers + nconc (loop for base-type in (supertypes (type-of base)) + nconc (loop for exponent-type in (supertypes (type-of exponent)) + collect (cons (cons base exponent) (cons base-type exponent-type))))))) + (functions-and-types + (funcall (compile nil + `(lambda () + (declare (optimize (safety 0))) + (list ,@(loop for (base-type . exponent-type) in (delete-duplicates + (mapcar #'cdr numbers-and-types) + :test #'equal) + collect `(cons (lambda (x y) + (declare (type ,base-type x) + (type ,exponent-type y)) + (expt x y)) + (cons ',base-type ',exponent-type)))))))) + (miscompiled-cases (loop for ((base . exponent) . types) in numbers-and-types + for f in (car (find types functions-and-types :test #'equal :key #'cdr)) + unless (handler-case + (eql (expt base exponent) (funcall f base exponent)) + (arithmetic-error () t)) + collect (list (cons base exponent) types (expt base exponent) (funcall f base exponent))))) + (is (null miscompiled-cases))))) From cae32c08bc4213e448ce2f4934690814e4393850 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 13 Dec 2025 17:41:12 +0100 Subject: [PATCH 3/4] cmp: fix inline expansions for EXPT function Floating point contagion rules and the special case (expt 0 0) were not handled correctly. --- src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp index 8c995570c..7d9e1bc8d 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp @@ -533,8 +533,17 @@ ;; Note that the following two inlines are conflicting. CHOOSE-INLINE-INFO ;; assumes the one that has more specific types. (def-inline cl:expt :always ((integer 0 0) (integer 0 0)) :fixnum "1") - (def-inline cl:expt :always ((integer 0 0) t) :fixnum "0") - (def-inline cl:expt :always ((integer 1 1) t) :fixnum "1") + (def-inline cl:expt :always ((real 0 0) (real 0 0)) :float "1.0f" :exact-return-type t) + (def-inline cl:expt :always ((real 0 0) (real 0 0)) :double "1.0" :exact-return-type t) + (def-inline cl:expt :always ((real 0 0) (real 0 0)) :long-double "1.0l" :exact-return-type t) + (def-inline cl:expt :always ((integer 0 0) integer) :fixnum "(((#1) == 0) ? 1 : 0)") + (def-inline cl:expt :always ((real 0 0) real) :float "(ecl_zerop(#1) ? 1.0f : 0.0f)" :exact-return-type t) + (def-inline cl:expt :always ((real 0 0) real) :double "(ecl_zerop(#1) ? 1.0 : 0.0)" :exact-return-type t) + (def-inline cl:expt :always ((real 0 0) real) :long-double "(ecl_zerop(#1) ? 1.0l : 0.0l)" :exact-return-type t) + (def-inline cl:expt :always ((integer 1 1) integer) :fixnum "1") + (def-inline cl:expt :always ((real 1 1) real) :float "1.0f" :exact-return-type t) + (def-inline cl:expt :always ((real 1 1) real) :double "1.0" :exact-return-type t) + (def-inline cl:expt :always ((real 1 1) real) :long-double "1.0l" :exact-return-type t) (def-inline cl:expt :always ((long-float 0.0l0 *) long-float) :long-double "powl((long double)#0,(long double)#1)") (def-inline cl:expt :always ((double-float 0.0d0 *) double-float) :double "pow((double)#0,(double)#1)") (def-inline cl:expt :always ((single-float 0.0f0 *) single-float) :float "powf((float)#0,(float)#1)") From 411723aa95a2d54151fd04663102a0823dda5c04 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 13 Dec 2025 19:24:56 +0100 Subject: [PATCH 4/4] cmp: fix inline expansion for ABS function --- src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp index 7d9e1bc8d..5f2c9074b 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp @@ -525,7 +525,7 @@ (def-inline cl:evenp :always (t) :bool "ecl_evenp(#0)") (def-inline cl:evenp :always (fixnum fixnum) :bool "~(#0) & 1") - (def-inline cl:abs :always (t t) t "ecl_abs(#0,#1)") + (def-inline cl:abs :always (t) t "ecl_abs(#0)") (def-inline cl:exp :always (t) t "ecl_exp(#0)") (def-inline cl:expt :always (t t) t "ecl_expt(#0,#1)")