Raymond Toy pushed to branch issue-435-add-core-math-lisp-support at cmucl / cmucl Commits: e8cec854 by Raymond Toy at 2026-02-25T15:25:23-08:00 Update sincos for single-float Define %%sincosf for the single version to match %%sincos. Update %sincos to accept both single and double float values. Modify cis to %use %%sincos and %%sincosf instead of using %sincos to bypass the %type dispatch that %sincos does anyway. - - - - - 32530cd0 by Raymond Toy at 2026-02-25T15:27:55-08:00 Update deftransforms to call the single-float special functions. - - - - - e8f54c41 by Raymond Toy at 2026-02-25T15:49:14-08:00 Tell compiler about %%sincos and friends and update cis deftransforms Add defknown for %%sincos and %%sincosf, removing the defknown for %sincos. Update the deftransforms for cis to use %%sincos and %%sincosf. - - - - - 2 changed files: - src/code/irrat.lisp - src/compiler/float-tran.lisp Changes: ===================================== src/code/irrat.lisp ===================================== @@ -225,21 +225,34 @@ (y0 double-float :out) (y1 double-float :out)) -(declaim (inline %%sincos)) +(declaim (inline %%sincos %%sincosf)) (alien:def-alien-routine ("lisp_sincos" %%sincos) c-call:void (x double-float) (s double-float :out) (c double-float :out)) +(alien:def-alien-routine ("lisp_sincosf" %%sincosf) + c-call:void + (x single-float) + (s single-float :out) + (c single-float :out)) + (declaim (inline %sincos)) (export '%sincos) (defun %sincos (x) - (declare (double-float x)) - (multiple-value-bind (ign s c) - (%%sincos x) - (declare (ignore ign)) - (values s c))) + (declare (float x)) + (etypecase x + (single-float + (multiple-value-bind (ign s c) + (%%sincosf x) + (declare (ignore ign)) + (values s c))) + (double-float + (multiple-value-bind (ign s c) + (%%sincos x) + (declare (ignore ign)) + (values s c)))))  ;;;; Power functions. @@ -1005,17 +1018,17 @@ (if (complexp theta) (error (intl:gettext "Argument to CIS is complex: ~S") theta) (number-dispatch ((theta real)) - ((rational) - (let ((arg (coerce theta 'double-float))) - (multiple-value-bind (s c) - (%sincos arg) - (complex (coerce c 'single-float) - (coerce s 'single-float))))) - (((foreach single-float double-float)) - (multiple-value-bind (s c) - (%sincos (coerce theta 'double-float)) - (complex (coerce c '(dispatch-type theta)) - (coerce s '(dispatch-type theta))))) + (((foreach rational single-float)) + (let ((arg (coerce theta 'single-float))) + (multiple-value-bind (ign s c) + (%%sincosf arg) + (declare (ignore ign)) + (complex c s)))) + ((double-float) + (multiple-value-bind (ign s c) + (%%sincos theta) + (declare (ignore ign)) + (complex c s))) #+double-double ((double-double-float) (multiple-value-bind (s c) ===================================== src/compiler/float-tran.lisp ===================================== @@ -683,25 +683,44 @@ (asinh %asinh *) (acosh %acosh float) (atanh %atanh float))) + (destructuring-bind (name prim rtype) + stuff + (let ((primf (intern (string (symbolicate prim "F")) + "KERNEL"))) + (deftransform name ((x) '(single-float) rtype :eval-name t) + #-core-math + `(coerce (,prim (coerce x 'double-float)) 'single-float) + #+core-math + `(,primf x)) + (deftransform name ((x) '(double-float) rtype :eval-name t :when :both) + `(,prim x))))) + +#-core-math +(dolist (stuff '((sqrt %sqrt float))) (destructuring-bind (name prim rtype) stuff (deftransform name ((x) '(single-float) rtype :eval-name t) `(coerce (,prim (coerce x 'double-float)) 'single-float)) (deftransform name ((x) '(double-float) rtype :eval-name t :when :both) - `(,prim x)))) + `(,prim x)))) -(defknown (%sincos) - (double-float) (values double-float double-float) +(defknown (kernel::%%sincos) + (double-float) (values null double-float double-float) + (movable foldable flushable)) + +(defknown (kernel::%%sincosf) + (single-float) (values null single-float single-float) (movable foldable flushable)) (deftransform cis ((x) (single-float) * :when :both) - `(multiple-value-bind (s c) - (%sincos (coerce x 'double-float)) - (complex (coerce c 'single-float) - (coerce s 'single-float)))) + `(multiple-value-bind (ign s c) + (kernel::%%sincosf x) + (declare (ignore ign)) + (complex c s))) (deftransform cis ((x) (double-float) * :when :both) - `(multiple-value-bind (s c) - (%sincos x) + `(multiple-value-bind (ign s c) + (kernel::%%sincos x) + (declare (ignore ign)) (complex c s))) ;;; The argument range is limited on the x86 FP trig. functions. A View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9f7c82924e28f8274b3b3c9... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9f7c82924e28f8274b3b3c9... You're receiving this email because of your account on gitlab.common-lisp.net.