From 6f90daf7e7d1193bebefea24d45b463c4a5194fc Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Sun, 10 Aug 2008 18:15:24 -0400 Subject: [PATCH] Explicit precision specification modes The GSL precision mode used mainly in special functions is now explicitly given in the CL argument list; remove special treatment of :mode in C argument list of defmfun call, which meddled with the CL arglist. Changed sf-mode options to :double, :single, :approx. --- init/defmfun.lisp | 115 +++++++++++----------- linear-algebra/.gitignore | 1 + special-functions/airy.lisp | 34 +++---- special-functions/bessel.lisp | 6 +- special-functions/elliptic-integrals.lisp | 42 ++++---- special-functions/return-structures.lisp | 8 +- 6 files changed, 101 insertions(+), 105 deletions(-) create mode 100644 linear-algebra/.gitignore diff --git a/init/defmfun.lisp b/init/defmfun.lisp index 36042c9a..22eea28e 100644 --- a/init/defmfun.lisp +++ b/init/defmfun.lisp @@ -1,6 +1,6 @@ ;; Macro for defining GSL functions. ;; Liam Healy 2008-04-16 20:49:50EDT defmfun.lisp -;; Time-stamp: <2008-08-09 19:49:10EDT defmfun.lisp> +;; Time-stamp: <2008-08-10 18:00:49EDT defmfun.lisp> ;; $Id$ (in-package :gsl) @@ -127,7 +127,7 @@ (expand-defmfun-wrap 'airy-Ai '(x) "gsl_sf_airy_Ai_e" - '((x :double) :mode (ret sf-result)) + '((x :double) (mode sf-mode) (ret sf-result)) '(:documentation "The Airy function Ai(x).")) ;;; Generic function and methods of a vector @@ -460,13 +460,12 @@ ;; walk only a top-level function call (rest val) (list val))))) - (remove :mode c-arguments)))) + c-arguments))) (defun expand-defmfun-plain (name arglist gsl-name c-arguments key-args) "The main function for expansion of defmfun." (with-defmfun-key-args key-args - (let* ((cargs (substitute '(mode sf-mode) :mode c-arguments)) - (carg-symbs (c-arguments cargs)) + (let* ((carg-symbs (c-arguments c-arguments)) (clargs (or arglist carg-symbs)) (arglist-symbs (arglist-plain-and-categories arglist nil)) (cret-type (if (member c-return *special-c-return*) @@ -474,7 +473,7 @@ (if (listp c-return) (st-type c-return) c-return))) (cret-name (if (listp c-return) (st-symbol c-return) (make-symbol "CRETURN"))) - (complex-args (complex-scalars clargs cargs)) + (complex-args (complex-scalars clargs c-arguments)) (allocated ; Foreign objects to be allocated (remove-if (lambda (s) @@ -483,7 +482,7 @@ (allocated-decl (append (mapcar - (lambda (s) (find s cargs :key #'st-symbol)) + (lambda (s) (find s c-arguments :key #'st-symbol)) allocated))) (clret (or ; better as a symbol macro (substitute cret-name :c-return return) @@ -491,60 +490,56 @@ outputs (unless (eq c-return :void) (list cret-name)))) - (clargs-types (cl-argument-types clargs cargs))) + (clargs-types (cl-argument-types clargs c-arguments))) `(,defn - ,@(when (and name (not (defgeneric-method-p name))) - (list name)) - ,(let ((noaux - (if (member :mode c-arguments) - `(,@clargs &optional (mode :double-prec)) - `(,@clargs)))) - (if global - (append noaux (cons '&aux global)) - noaux)) - ,(declaration-form - clargs-types (set-difference arglist-symbs carg-symbs)) - ,@(when documentation (list documentation)) - (,@(if (or allocated-decl complex-args) - `(cffi:with-foreign-objects - ,(mapcar #'wfo-declare - (append allocated-decl - (mapcar #'rest complex-args)))) - '(let ())) - #-native ,@(mapcar (lambda (v) `(copy-cl-to-c ,v)) inputs) - (let ((,cret-name - (cffi:foreign-funcall - ,gsl-name - ,@(mapcan - (lambda (arg) - (let ((cfind ; variable is complex - (first (member (st-symbol arg) complex-args :key 'first)))) - (if cfind ; so substitute call to complex-to-gsl - `(,(third cfind) - (complex-to-gsl ,(first cfind) ,(second cfind))) - ;; otherwise use without conversion - (list (if (member (st-symbol arg) allocated) - :pointer - (st-type arg)) - (st-symbol arg))))) - cargs) - ,cret-type))) - ,@(case c-return - (:void `((declare (ignore ,cret-name)))) - (:error-code ; fill in arguments - `((check-gsl-status ,cret-name - ',(or (defgeneric-method-p name) name))))) - #-native - ,@(when outputs `(,(mapcar (lambda (x) `(setf (cl-invalid ,x) t))) outputs)) - ,@(when (or null-pointer-info (eq c-return :pointer)) - `((check-null-pointer ,cret-name - ,@(or null-pointer-info - '(:ENOMEM "No memory allocated"))))) - ,@after - (values - ,@(defmfun-return - c-return cret-name clret allocated return return-supplied-p - enumeration outputs)))))))) + ,@(when (and name (not (defgeneric-method-p name))) + (list name)) + ,(if global + (append clargs (cons '&aux global)) + clargs) + ,(declaration-form + clargs-types (set-difference arglist-symbs carg-symbs)) + ,@(when documentation (list documentation)) + (,@(if (or allocated-decl complex-args) + `(cffi:with-foreign-objects + ,(mapcar #'wfo-declare + (append allocated-decl + (mapcar #'rest complex-args)))) + '(let ())) + #-native ,@(mapcar (lambda (v) `(copy-cl-to-c ,v)) inputs) + (let ((,cret-name + (cffi:foreign-funcall + ,gsl-name + ,@(mapcan + (lambda (arg) + (let ((cfind ; variable is complex + (first (member (st-symbol arg) complex-args :key 'first)))) + (if cfind ; so substitute call to complex-to-gsl + `(,(third cfind) + (complex-to-gsl ,(first cfind) ,(second cfind))) + ;; otherwise use without conversion + (list (if (member (st-symbol arg) allocated) + :pointer + (st-type arg)) + (st-symbol arg))))) + c-arguments) + ,cret-type))) + ,@(case c-return + (:void `((declare (ignore ,cret-name)))) + (:error-code ; fill in arguments + `((check-gsl-status ,cret-name + ',(or (defgeneric-method-p name) name))))) + #-native + ,@(when outputs `(,(mapcar (lambda (x) `(setf (cl-invalid ,x) t))) outputs)) + ,@(when (or null-pointer-info (eq c-return :pointer)) + `((check-null-pointer ,cret-name + ,@(or null-pointer-info + '(:ENOMEM "No memory allocated"))))) + ,@after + (values + ,@(defmfun-return + c-return cret-name clret allocated return return-supplied-p + enumeration outputs)))))))) (defun defmfun-return (c-return cret-name clret allocated return return-supplied-p enumeration outputs) diff --git a/linear-algebra/.gitignore b/linear-algebra/.gitignore new file mode 100644 index 00000000..b25c15b8 --- /dev/null +++ b/linear-algebra/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/special-functions/airy.lisp b/special-functions/airy.lisp index 25fb67f2..9c757f67 100644 --- a/special-functions/airy.lisp +++ b/special-functions/airy.lisp @@ -1,6 +1,6 @@ ;; Airy functions ;; Liam Healy, Fri Mar 17 2006 - 18:41 -;; Time-stamp: <2008-07-10 21:20:39EDT airy.lisp> +;; Time-stamp: <2008-08-10 17:50:02EDT airy.lisp> ;; $Id$ (in-package :gsl) @@ -9,48 +9,48 @@ ;;;; Airy functions ;;;;**************************************************************************** -(defmfun airy-Ai (x) - "gsl_sf_airy_Ai_e" ((x :double) :mode (ret sf-result)) +(defmfun airy-Ai (x &optional (mode :double)) + "gsl_sf_airy_Ai_e" ((x :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The Airy function Ai(x).") -(defmfun airy-Bi (x) - "gsl_sf_airy_Bi_e" ((x :double) :mode (ret sf-result)) +(defmfun airy-Bi (x &optional (mode :double)) + "gsl_sf_airy_Bi_e" ((x :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The Airy function Bi(x).") -(defmfun airy-Ai-scaled (x) - "gsl_sf_airy_Ai_scaled_e" ((x :double) :mode (ret sf-result)) +(defmfun airy-Ai-scaled (x &optional (mode :double)) + "gsl_sf_airy_Ai_scaled_e" ((x :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The scaled Airy function S_A(x) Ai(x). For x>0 the scaling factor S_A(x) is \exp(+(2/3) x^(3/2)), and is 1 for x<0.") -(defmfun airy-Bi-scaled (x) - "gsl_sf_airy_Bi_scaled_e" ((x :double) :mode (ret sf-result)) +(defmfun airy-Bi-scaled (x &optional (mode :double)) + "gsl_sf_airy_Bi_scaled_e" ((x :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The scaled Airy function S_B(x) Bi(x). For x>0 the scaling factor S_B(x) is exp(-(2/3) x^(3/2)), and is 1 for x<0.") -(defmfun airy-Ai-deriv (x) - "gsl_sf_airy_Ai_deriv_e" ((x :double) :mode (ret sf-result)) +(defmfun airy-Ai-deriv (x &optional (mode :double)) + "gsl_sf_airy_Ai_deriv_e" ((x :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The Airy function derivative Ai'(x).") -(defmfun airy-Bi-deriv (x) - "gsl_sf_airy_Bi_deriv_e" ((x :double) :mode (ret sf-result)) +(defmfun airy-Bi-deriv (x &optional (mode :double)) + "gsl_sf_airy_Bi_deriv_e" ((x :double) (mode sf-mode) (ret sf-result)) :documentation "The Airy function derivative Bi'(x).") -(defmfun airy-Ai-deriv-scaled (x) - "gsl_sf_airy_Ai_deriv_scaled_e" ((x :double) :mode (ret sf-result)) +(defmfun airy-Ai-deriv-scaled (x &optional (mode :double)) + "gsl_sf_airy_Ai_deriv_scaled_e" ((x :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The scaled Airy function derivative S_A(x) Ai'(x). For x>0 the scaling factor S_A(x) is exp(+(2/3) x^(3/2)), and is 1 for x<0.") -(defmfun airy-Bi-deriv-scaled (x) - "gsl_sf_airy_Bi_deriv_scaled_e" ((x :double) :mode (ret sf-result)) +(defmfun airy-Bi-deriv-scaled (x &optional (mode :double)) + "gsl_sf_airy_Bi_deriv_scaled_e" ((x :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The scaled Airy function derivative S_B(x) Bi'(x). For x>0 the scaling factor S_B(x) is diff --git a/special-functions/bessel.lisp b/special-functions/bessel.lisp index bfcaaeb9..7e2f2c6d 100644 --- a/special-functions/bessel.lisp +++ b/special-functions/bessel.lisp @@ -1,6 +1,6 @@ ;; Bessel functions ;; Liam Healy, Fri Mar 17 2006 - 18:42 -;; Time-stamp: <2008-07-08 21:43:01EDT bessel.lisp> +;; Time-stamp: <2008-08-10 17:55:45EDT bessel.lisp> ;; $Id$ (in-package :gsl) @@ -365,9 +365,9 @@ "The regular cylindrical Bessel function of fractional order \nu, J_\nu(x).") -(defmfun spherical-Jnu-array (nu v) +(defmfun spherical-Jnu-array (nu v &optional (mode :double)) "gsl_sf_bessel_sequence_Jnu_e" - ((nu :double) :mode ((dim0 v) :int) ((c-pointer v) :pointer)) + ((nu :double) (mode sf-mode) ((dim0 v) :int) ((c-pointer v) :pointer)) :outputs (v) :documentation ; FDL "The regular cylindrical Bessel function of diff --git a/special-functions/elliptic-integrals.lisp b/special-functions/elliptic-integrals.lisp index bdd53300..07571a95 100644 --- a/special-functions/elliptic-integrals.lisp +++ b/special-functions/elliptic-integrals.lisp @@ -1,6 +1,6 @@ ;; Elliptic integrals ;; Liam Healy, Mon Mar 20 2006 - 21:50 -;; Time-stamp: <2008-03-13 17:27:04EDT elliptic-integrals.lisp> +;; Time-stamp: <2008-08-10 17:55:35EDT elliptic-integrals.lisp> ;; $Id$ (in-package :gsl) @@ -9,15 +9,15 @@ ;;;; Legendre form of complete elliptic integrals ;;;;**************************************************************************** -(defmfun elliptic-integral-K-complete (k) - "gsl_sf_ellint_Kcomp_e" ((k :double) :mode (ret sf-result)) +(defmfun elliptic-integral-K-complete (k &optional (mode :double)) + "gsl_sf_ellint_Kcomp_e" ((k :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The complete elliptic integral of the first kind, K(k). Note that Abramowitz & Stegun define this function in terms of the parameter m = k^2.") -(defmfun elliptic-integral-E-complete (k) - "gsl_sf_ellint_Ecomp_e" ((k :double) :mode (ret sf-result)) +(defmfun elliptic-integral-E-complete (k &optional (mode :double)) + "gsl_sf_ellint_Ecomp_e" ((k :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The complete elliptic integral of the second kind, E(k). Note that Abramowitz & Stegun define this function in terms of the @@ -27,32 +27,32 @@ ;;;; Legendre form of incomplete elliptic integrals ;;;;**************************************************************************** -(defmfun elliptic-integral-F (phi k) - "gsl_sf_ellint_F_e" ((phi :double) (k :double) :mode (ret sf-result)) +(defmfun elliptic-integral-F (phi k &optional (mode :double)) + "gsl_sf_ellint_F_e" ((phi :double) (k :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The incomplete elliptic integral of the first kind, F(phi,k). Note that Abramowitz & Stegun define this function in terms of the parameter m = k^2.") -(defmfun elliptic-integral-E (phi k) - "gsl_sf_ellint_E_e" ((phi :double) (k :double) :mode (ret sf-result)) +(defmfun elliptic-integral-E (phi k &optional (mode :double)) + "gsl_sf_ellint_E_e" ((phi :double) (k :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The incomplete elliptic integral of the second kind, E(phi,k). Note that Abramowitz & Stegun define this function in terms of the parameter m = k^2.") -(defmfun elliptic-integral-P (phi k n) +(defmfun elliptic-integral-P (phi k n &optional (mode :double)) "gsl_sf_ellint_P_e" - ((phi :double) (k :double) (n :double) :mode (ret sf-result)) + ((phi :double) (k :double) (n :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The incomplete elliptic integral of the third kind, P(phi,k,n). Note that Abramowitz & Stegun define this function in terms of the parameters m = k^2 and sin^2(alpha) = k^2, with the change of sign n to -n.") -(defmfun elliptic-integral-D (phi k n) +(defmfun elliptic-integral-D (phi k n &optional (mode :double)) "gsl_sf_ellint_D_e" - ((phi :double) (k :double) (n :double) :mode (ret sf-result)) + ((phi :double) (k :double) (n :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The incomplete elliptic integral D(phi,k,n) which is defined through the Carlson form RD(x,y,z) @@ -63,26 +63,26 @@ ;;;; Carlson forms ;;;;**************************************************************************** -(defmfun elliptic-integral-RC (x y) - "gsl_sf_ellint_RC_e" ((x :double) (y :double) :mode (ret sf-result)) +(defmfun elliptic-integral-RC (x y &optional (mode :double)) + "gsl_sf_ellint_RC_e" ((x :double) (y :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The incomplete elliptic integral RC(x,y).") -(defmfun elliptic-integral-RD (x y z) +(defmfun elliptic-integral-RD (x y z &optional (mode :double)) "gsl_sf_ellint_RD_e" - ((x :double) (y :double) (z :double) :mode (ret sf-result)) + ((x :double) (y :double) (z :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The incomplete elliptic integral RD(x,y,z).") -(defmfun elliptic-integral-RF (x y z) +(defmfun elliptic-integral-RF (x y z &optional (mode :double)) "gsl_sf_ellint_RF_e" - ((x :double) (y :double) (z :double) :mode (ret sf-result)) + ((x :double) (y :double) (z :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The incomplete elliptic integral RF(x,y,z).") -(defmfun elliptic-integral-RJ (x y z p) +(defmfun elliptic-integral-RJ (x y z p &optional (mode :double)) "gsl_sf_ellint_RJ_e" - ((x :double) (y :double) (z :double) (p :double) :mode (ret sf-result)) + ((x :double) (y :double) (z :double) (p :double) (mode sf-mode) (ret sf-result)) :documentation ; FDL "The incomplete elliptic integral RJ(x,y,z,p).") diff --git a/special-functions/return-structures.lisp b/special-functions/return-structures.lisp index 4f3fdb48..0edcc2ad 100644 --- a/special-functions/return-structures.lisp +++ b/special-functions/return-structures.lisp @@ -1,6 +1,6 @@ ;; Structures returned by special functions. ;; Liam Healy, Mon Jan 1 2007 - 11:35 -;; Time-stamp: <2008-02-16 22:45:31EST return-structures.lisp> +;; Time-stamp: <2008-08-10 17:47:07EDT return-structures.lisp> ;; $Id$ (in-package :gsl) @@ -26,9 +26,9 @@ (cffi:defcenum sf-mode "Numerical precision modes with which to calculate special functions." ;; file:///usr/share/doc/gsl-ref-html/gsl-ref_7.html#SEC62 - :double-prec - :single-prec - :approx-prec) + :double + :single + :approx) (defun val (sf-result &optional (type 'sf-result)) (cffi:foreign-slot-value sf-result type 'val)) -- GitLab