Raymond Toy pushed to branch issue-435-add-core-math-lisp-support at cmucl / cmucl Commits: 76cbe06e by Raymond Toy at 2026-06-29T14:47:43-07:00 Refactor the common bits of def-math-rtn The bits for the single and double float versions are essentially identical except for the type. Refactor that into a common function. - - - - - 1 changed file: - src/code/irrat.lisp Changes: ===================================== src/code/irrat.lisp ===================================== @@ -40,33 +40,31 @@ ;;; call, and saves number consing to boot. ;;; (defmacro def-math-rtn (name num-args) - (multiple-value-bind (c-name lisp-name) - (if (listp name) - (values (first name) (second name)) - (values name - (intern (concatenate 'simple-string - "%" - (string-upcase name))))) - `(progn - (declaim (inline ,lisp-name)) - (export ',lisp-name) - (alien:def-alien-routine (,c-name ,lisp-name) double-float - ,@(let ((results nil)) - (dotimes (i num-args (nreverse results)) - (push (list (intern (format nil "ARG-~D" i)) - 'double-float) - results)))) - ;; The C99 convention is for the float version to have the same - ;; name as the double version but with an "f" appended. We do - ;; the same here and append an "F" to the lisp name too. - (alien:def-alien-routine (,(concatenate 'string c-name "f") - ,(symbolicate lisp-name "F")) - single-float - ,@(let ((results nil)) - (dotimes (i num-args (nreverse results)) - (push (list (intern (format nil "ARG-~D" i)) - 'single-float) - results))))))) + (flet ((def-rtn (c-name lisp-name type) + `(progn + (declaim (inline ,lisp-name)) + (export ',lisp-name) + (alien:def-alien-routine (,c-name ,lisp-name) ,type + ,@(let ((results nil)) + (dotimes (i num-args (nreverse results)) + (push (list (intern (format nil "ARG-~D" i)) + type) + results))))))) + (multiple-value-bind (c-name lisp-name) + (if (listp name) + (values (first name) (second name)) + (values name + (intern (concatenate 'simple-string + "%" + (string-upcase name))))) + `(progn + ,(def-rtn c-name lisp-name 'double-float) + ;; The C99 convention is for the float version to have the same + ;; name as the double version but with an "f" appended. We do + ;; the same here and append an "F" to the lisp name too. + ,(def-rtn (concatenate 'string c-name "f") + (symbolicate lisp-name "F") + 'single-float))))) (eval-when (compile load eval) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/76cbe06eca0812f1575147a5... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/76cbe06eca0812f1575147a5... You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications: https://gitlab.common-lisp.net/-/profile/notifications | Help: https://gitlab.common-lisp.net/help