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