From ac62a39f9edc6aced82515c289894e225ffd79de Mon Sep 17 00:00:00 2001 From: liam <liam@a3d8a0fb-c1db-0310-ace7-a616afeb9e30> Date: Tue, 29 Jan 2008 03:45:40 +0000 Subject: [PATCH] Rename double-to-cl as dcref, etc. Make the symbol lookup use a hashtable for speed. Fix bug in return value in success-failure and success-continue cases. git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3277 a3d8a0fb-c1db-0310-ace7-a616afeb9e30 --- data/matrix.lisp | 10 ++--- general/functions.lisp | 6 +-- gsll.asd | 4 +- init/interface.lisp | 27 +++++-------- init/number-conversion.lisp | 38 ++++++++++--------- linear-least-squares.lisp | 4 +- minimization-multi.lisp | 9 ++--- .../ode-example.lisp | 6 +-- .../ode-system.lisp | 8 ++-- simulated-annealing.lisp | 4 +- special-functions/coulomb.lisp | 10 ++--- special-functions/gamma.lisp | 4 +- 12 files changed, 62 insertions(+), 68 deletions(-) diff --git a/data/matrix.lisp b/data/matrix.lisp index 65cda565..6360c3b3 100644 --- a/data/matrix.lisp +++ b/data/matrix.lisp @@ -1,6 +1,6 @@ ;; Matrices ;; Liam Healy, Sun Mar 26 2006 - 11:51 -;; Time-stamp: <2008-01-21 11:47:04EST matrix.lisp> +;; Time-stamp: <2008-01-28 22:19:38EST matrix.lisp> ;; $Id: $ (in-package :gsl) @@ -526,7 +526,7 @@ When there are several equal maximum elements then the lowest index is returned." :c-return :void - :return ((list (size-to-cl imax) (size-to-cl jmax)))) + :return ((list (scref imax) (scref jmax)))) (defun-gsl-mdsf gsl-min-index ((m gsl-matrix)) "gsl_matrix_min_index" @@ -536,7 +536,7 @@ When there are several equal minimum elements then the lowest index is returned." :c-return :void - :return ((list (size-to-cl imin) (size-to-cl jmin)))) + :return ((list (scref imin) (scref jmin)))) (defun-gsl-mdsf gsl-minmax-index ((m gsl-matrix)) "gsl_matrix_minmax_index" @@ -547,8 +547,8 @@ When there are several equal minimum elements then the lowest index is returned." :c-return :void - :return ((list (size-to-cl imin) (size-to-cl jmin)) - (list (size-to-cl imax) (size-to-cl jmax)))) + :return ((list (scref imin) (scref jmin)) + (list (scref imax) (scref jmax)))) ;;;;**************************************************************************** ;;;; Properties diff --git a/general/functions.lisp b/general/functions.lisp index 6eb85074..b20a678b 100644 --- a/general/functions.lisp +++ b/general/functions.lisp @@ -1,6 +1,6 @@ ;; Foreign callback functions. ;; Liam Healy -;; Time-stamp: <2008-01-20 22:34:41EST functions.lisp> +;; Time-stamp: <2008-01-28 22:21:09EST functions.lisp> ;; $Id: $ (in-package :gsl) @@ -182,7 +182,7 @@ reading or setting." `(symbol-macrolet ,(loop for i from 0 for a in element-names - collect `(,a (double-to-cl ,c-vector ,i))) + collect `(,a (dcref ,c-vector ,i))) ,@body)) (defmacro with-c-doubles @@ -193,5 +193,5 @@ ,(loop for (c-vector . element-names) in cvector-names append (loop for i from 0 for a in element-names - collect `(,a (double-to-cl ,c-vector ,i)))) + collect `(,a (dcref ,c-vector ,i)))) ,@body)) diff --git a/gsll.asd b/gsll.asd index f6f36935..6b011176 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2008-01-21 17:58:44EST gsll.asd> +;; Time-stamp: <2008-01-28 22:24:15EST gsll.asd> ;; $Id: $ (asdf:defsystem "gsll" @@ -171,6 +171,6 @@ (:file "hankel" :depends-on (init data)) (:file "roots-one" :depends-on (init general)) (:file "minimization-one" :depends-on (init general)) - (:file "roots-multi" :depends-on (init general data)) + (:file "roots-multi" :depends-on (init general data roots-one)) (:file "minimization-multi" :depends-on (init general data)) (:file "linear-least-squares" :depends-on (init general data)))) diff --git a/init/interface.lisp b/init/interface.lisp index a5dd7f7d..b2d2c474 100644 --- a/init/interface.lisp +++ b/init/interface.lisp @@ -1,6 +1,6 @@ ;; Macros to interface GSL functions. ;; Liam Healy -;; Time-stamp: <2008-01-26 21:33:48EST interface.lisp> +;; Time-stamp: <2008-01-28 22:36:32EST interface.lisp> ;; $Id: $ (in-package :gsl) @@ -11,24 +11,17 @@ ;;;; Lookup table to find CL functions from C function names ;;;;**************************************************************************** -(defparameter *sf-name-mapping* nil - "An alist mapping the CL and GSL names of the special functions. - This will only be populated when macros are expanded.") +(defparameter *gsl-symbol-equivalence* + (make-hash-table :test 'equal :size 1500)) (defun map-name (cl-name gsl-name) - (setf *sf-name-mapping* (acons cl-name gsl-name *sf-name-mapping*))) + ;; Trust here that the library does not have two symbols that differ + ;; only by the case of one or more letters. + (setf (gethash (string-downcase gsl-name) *gsl-symbol-equivalence*) cl-name)) (defun gsl-lookup (string) - "Find the CL function name given the GSL C special function function name. - If cl-ppcre (http://www.weitz.de/cl-ppcre/) is installed, the string - can be a regular expression; otherwise, it must match the C name exactly - except for case." - (remove string *sf-name-mapping* - :key #'rest - :test-not - (if (find-package :ppcre) - (symbol-function (intern "ALL-MATCHES" :ppcre)) - #'string-equal))) + "Find the GSLL (Lisp) equivalent of the GSL symbol." + (gethash (string-downcase string) *gsl-symbol-equivalence*)) ;;;;**************************************************************************** ;;;; Symbol-type declaration @@ -235,13 +228,13 @@ (:success-failure (if (equal clret invalidate) ;; success-failure more important than passed-in - `((success-failure ,@clret)) + `((success-failure ,cret-name)) (remove cret-name ; don't return c-return itself `(,@clret (success-failure ,cret-name))))) (:success-continue (if (equal clret invalidate) ;; success-failure more important than passed-in - `((success-continue ,@clret)) + `((success-continue ,cret-name)) (remove cret-name ; don't return c-return itself `(,@clret (success-continue ,cret-name))))) (:true-false diff --git a/init/number-conversion.lisp b/init/number-conversion.lisp index d25ff855..ec0c16b0 100644 --- a/init/number-conversion.lisp +++ b/init/number-conversion.lisp @@ -1,11 +1,7 @@ -;******************************************************** -; file: number-conversion.lisp -; description: Conversion of numbers C->CL -; date: Sun May 28 2006 - 22:04 -; author: Liam M. Healy -; modified: Sat Sep 15 2007 - 22:34 -;******************************************************** -;;; $Id: $ +;; Conversion of numbers C->CL +;; Liam Healy, Sun May 28 2006 - 22:04 +;; Time-stamp: <2008-01-28 22:09:08EST number-conversion.lisp> +;; $Id: $ (in-package :gsl) @@ -13,24 +9,30 @@ ;;;; Built-in numerical types ;;;;**************************************************************************** -(defmacro float-to-cl (float &optional (index 0)) +(export '(fcref dcref scref icref)) + +(defmacro fcref (float &optional (index 0)) + "Reference C float(s)." `(cffi:mem-aref ,float :float ,index)) -(defmacro double-to-cl (double &optional (index 0)) +(defmacro dcref (double &optional (index 0)) + "Reference C double(s)." `(cffi:mem-aref ,double :double ,index)) -(defmacro size-to-cl (size &optional (index 0)) +(defmacro scref (size &optional (index 0)) + "Reference C size(s)." `(cffi:mem-aref ,size :size ,index)) -(defmacro int-to-cl (integer &optional (index 0)) +(defmacro icref (integer &optional (index 0)) + "Reference C integer(s)." `(cffi:mem-aref ,integer :int ,index)) (defun cl-convert-function (type) (case type - (:float 'float-to-cl) - (:double 'double-to-cl) - (:size 'size-to-cl) - (:int 'int-to-cl) + (:float 'fcref) + (:double 'dcref) + (:size 'scref) + (:int 'icref) (gsl-complex 'complex-to-cl))) ;;;;**************************************************************************** @@ -49,8 +51,8 @@ gsl-complex (* index (cffi:foreign-type-size 'gsl-complex))) 'gsl-complex 'dat))) - (complex (double-to-cl carr 0) - (double-to-cl carr 1)))) + (complex (dcref carr 0) + (dcref carr 1)))) ;;;;**************************************************************************** ;;;; Conversion form diff --git a/linear-least-squares.lisp b/linear-least-squares.lisp index f0971047..d6db05af 100644 --- a/linear-least-squares.lisp +++ b/linear-least-squares.lisp @@ -1,6 +1,6 @@ ;; Linear least squares, or linear regression ;; Liam Healy <2008-01-21 12:41:46EST linear-least-squares.lisp> -;; Time-stamp: <2008-01-26 19:48:03EST linear-least-squares.lisp> +;; Time-stamp: <2008-01-28 22:22:22EST linear-least-squares.lisp> ;; $Id: $ (in-package :gsl) @@ -218,7 +218,7 @@ (rank :size) ((pointer parameters) :pointer) (covariance :pointer) (chisq :double) (workspace :pointer)) - :return ((double-to-cl chisq) (size-to-cl rank)) + :return ((dcref chisq) (scref rank)) :documentation ; FDL "Compute the best-fit parameters c of the weighted model y = X c for the observations y and weights diff --git a/minimization-multi.lisp b/minimization-multi.lisp index 7878cd07..a50e4a29 100644 --- a/minimization-multi.lisp +++ b/minimization-multi.lisp @@ -1,6 +1,6 @@ ;; Multivariate minimization. ;; Liam Healy <Tue Jan 8 2008 - 21:28> -;; Time-stamp: <2008-01-27 22:55:36EST minimization-multi.lisp> +;; Time-stamp: <2008-01-28 22:42:05EST minimization-multi.lisp> ;; $Id: $ (in-package :gsl) @@ -335,10 +335,9 @@ (defun parabaloid-and-derivative (arguments-gv-pointer fnval derivative-gv-pointer) - (with-c-double (fnval fv) - (setf fv (parabaloid arguments-gv-pointer)) - (parabaloid-derivative - arguments-gv-pointer derivative-gv-pointer))) + (setf (dcref fnval) (parabaloid arguments-gv-pointer)) + (parabaloid-derivative + arguments-gv-pointer derivative-gv-pointer)) (def-minimization-functions parabaloid 2 parabaloid-derivative parabaloid-and-derivative) diff --git a/ordinary-differential-equations/ode-example.lisp b/ordinary-differential-equations/ode-example.lisp index b291438b..af9df18e 100644 --- a/ordinary-differential-equations/ode-example.lisp +++ b/ordinary-differential-equations/ode-example.lisp @@ -1,6 +1,6 @@ ;; Example ODE ;; Liam Healy Sat Sep 29 2007 - 17:49 -;; Time-stamp: <2008-01-20 17:40:48EST ode-example.lisp> +;; Time-stamp: <2008-01-28 22:21:07EST ode-example.lisp> ;; $Id: $ ;;; van der Pol as given in Section 25.5 of the GSL manual. To @@ -35,11 +35,11 @@ (declare (special mu)) (with-ode-integration (time step-size (dependent dep0 dep1) 2) (setf dep0 1.0d0 dep1 0.0d0) - (loop (when (or (>= (double-to-cl time) max-time) (> iter *max-iter*)) (return)) + (loop (when (or (>= (dcref time) max-time) (> iter *max-iter*)) (return)) (apply-evolution evolve control stepper vanderpol time max-time step-size dependent) (incf iter) (format t "~&~12,6f~10t~12,6f~24t~12,6f" - (double-to-cl time) dep0 dep1))))) + (dcref time) dep0 dep1))))) diff --git a/ordinary-differential-equations/ode-system.lisp b/ordinary-differential-equations/ode-system.lisp index 6cb4d02d..ad3b4043 100644 --- a/ordinary-differential-equations/ode-system.lisp +++ b/ordinary-differential-equations/ode-system.lisp @@ -1,6 +1,6 @@ ;; ODE system setup ;; Liam Healy, Sun Apr 15 2007 - 14:19 -;; Time-stamp: <2008-01-20 18:06:12EST ode-system.lisp> +;; Time-stamp: <2008-01-28 22:21:08EST ode-system.lisp> ;; $Id: $ (in-package :gsl) @@ -36,7 +36,7 @@ &body body) "Environment for integration of ordinary differential equations. The variables time and step-size will become C doubles in the body; - to convert back, use double-to-cl. The dependent variable may + to convert back, use #'dcref The dependent variable may be specified as a list being the same as the first argument to with-c-double." (let ((ctime (make-symbol "CTIME")) @@ -49,8 +49,8 @@ ((,(if (listp dependent) (first dependent) dependent) :double ,dimensions) (,ctime :double) (,cstep :double)) (setf - (double-to-cl ,cstep) ,step-size - (double-to-cl ,ctime) ,time) + (dcref ,cstep) ,step-size + (dcref ,ctime) ,time) ,(if (listp dependent) `(with-c-double ,dependent (symbol-macrolet ((,time ,ctime) (,step-size ,cstep)) diff --git a/simulated-annealing.lisp b/simulated-annealing.lisp index f1cbfb67..0e4f9449 100644 --- a/simulated-annealing.lisp +++ b/simulated-annealing.lisp @@ -1,6 +1,6 @@ ;; Simulated Annealing ;; Liam Healy Sun Feb 11 2007 - 17:23 -;; Time-stamp: <2008-01-20 22:37:12EST simulated-annealing.lisp> +;; Time-stamp: <2008-01-28 22:19:40EST simulated-annealing.lisp> ;; $Id: $ (in-package :gsl) @@ -175,7 +175,7 @@ (let ((*sa-function-calls* 0)) (rng-environment-setup) (cffi:with-foreign-object (initial :double) - (setf (double-to-cl initial) 15.5d0) + (setf (dcref initial) 15.5d0) (with-simulated-annealing-parameters (params 200 10 10.0d0 1.0d0 0.002d0 1.005d0 2.0d-6) (simulated-annealing diff --git a/special-functions/coulomb.lisp b/special-functions/coulomb.lisp index 07b80aed..d7ab52e9 100644 --- a/special-functions/coulomb.lisp +++ b/special-functions/coulomb.lisp @@ -42,7 +42,7 @@ (exp-F :double) (exp-G :double)) :return ((val F) (val Fp) (val G) (val Gp) - (double-to-cl exp-F) (double-to-cl exp-G) + (dcref exp-F) (dcref exp-G) (err F) (err Fp) (err G) (err Gp)) :documentation "The Coulomb wave functions @math{F_L(\eta,x)}, @@ -65,7 +65,7 @@ @math{L = Lmin \dots Lmin + kmax}, storing the results in @var{fc-array}. In the case of overflow the exponent is stored in the second value returned." :invalidate (fc-array) - :return (fc-array (double-to-cl F-exponent))) + :return (fc-array (dcref F-exponent))) (defun-gsl coulomb-wave-FG-array (L-min eta x fc-array gc-array) "gsl_sf_coulomb_wave_FG_array" @@ -77,7 +77,7 @@ @math{G_L(\eta,x)} for @math{L = Lmin \dots Lmin + kmax} storing the results in @var{fc_array} and @var{gc_array}. In the case of overflow the exponents are stored in @var{F_exponent} and @var{G_exponent}." - :return (fc-array gc-array (double-to-cl F-exponent) (double-to-cl G-exponent))) + :return (fc-array gc-array (dcref F-exponent) (dcref G-exponent))) (defun-gsl coulomb-wave-FGp-array (L-min eta x fc-array fcp-array gc-array gcp-array) "gsl_sf_coulomb_wave_FGp_array" @@ -94,7 +94,7 @@ and @var{G_exponent}." :return (fc-array fcp-array gc-array gcp-array - (double-to-cl F-exponent) (double-to-cl G-exponent))) + (dcref F-exponent) (dcref G-exponent))) (defun-gsl coulomb-wave-sphF-array (L-min eta x fc-array) "gsl_sf_coulomb_wave_sphF_array" @@ -107,7 +107,7 @@ stored in @var{F_exponent}. This function reduces to spherical Bessel functions in the limit @math{\eta \to 0}." :invalidate (fc-array) - :return (fc-array (double-to-cl F-exponent))) + :return (fc-array (dcref F-exponent))) ;;;;**************************************************************************** ;;;; Coulomb Wave Function Normalization Constant diff --git a/special-functions/gamma.lisp b/special-functions/gamma.lisp index b96533ee..b39e4fd2 100644 --- a/special-functions/gamma.lisp +++ b/special-functions/gamma.lisp @@ -41,7 +41,7 @@ function is computed using the real Lanczos method. The value of the gamma function can be reconstructed using the relation @math{\Gamma(x) = sgn * \exp(resultlg)}." - :return ((val ret) (double-to-cl sign) (err ret))) + :return ((val ret) (dcref sign) (err ret))) (defun-gsl gamma* (x) "gsl_sf_gammastar_e" ((x :double) (ret sf-result)) @@ -128,7 +128,7 @@ \log(|(a)_x|)} and @math{sgn = \sgn((a)_x)} where @math{(a)_x := \Gamma(a + x)/\Gamma(a)}, subject to @math{a}, @math{a+x} not being negative integers." - :return ((val ret) (double-to-cl sign) (err ret))) + :return ((val ret) (dcref sign) (err ret))) (defun-gsl relative-pochammer (a x) "gsl_sf_pochrel_e" ((a :double) (x :double) (ret sf-result)) -- GitLab