From adbbbbcdb2aefb449c7e40438f648268743c8968 Mon Sep 17 00:00:00 2001
From: Liam Healy <liam@thinkpad.local>
Date: Tue, 23 Dec 2008 21:28:22 -0500
Subject: [PATCH] GSL object makers with mixed arguments

GSL objects made with defmobject and that have use at least one
argument in some way for both initialization and reinitialization, or
for using functions of those arguments, are accomodated with an
optional argument 'arglists-function to defmobject.  This should be a
function that produces three arglists: for the maker, the
initialization method, and the reinitialization method.  The order of
arguments generated for other cases is now preserved with :from-end in
#'variables-used-in-c-arguments.  Examples for interpolation and
acceleration (lookup), still commented out.
---
 init/defmfun.lisp                |  5 ++--
 init/gsl-objects.lisp            | 44 ++++++++++++++++++++------------
 interpolation/interpolation.lisp | 20 ++++++++++++++-
 interpolation/lookup.lisp        | 12 ++++++++-
 4 files changed, 60 insertions(+), 21 deletions(-)

diff --git a/init/defmfun.lisp b/init/defmfun.lisp
index e55704f1..872b60ce 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-12-14 19:36:08EST defmfun.lisp>
+;; Time-stamp: <2008-12-21 22:50:20EST defmfun.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -504,7 +504,8 @@
   (remove-duplicates
    (mapcan (lambda (carg)
 	     (stupid-code-walk-find-variables (st-symbol carg)))
-	   c-arguments)))
+	   c-arguments)
+   :from-end t))
 
 (defun native-pointer (array-symbols body)
   "Wrap the body with a form that obtains the native pointer
diff --git a/init/gsl-objects.lisp b/init/gsl-objects.lisp
index 5da09102..8e382595 100644
--- a/init/gsl-objects.lisp
+++ b/init/gsl-objects.lisp
@@ -1,6 +1,6 @@
 ;; Definition of GSL objects and ways to use them.
 ;; Liam Healy, Sun Dec  3 2006 - 10:21
-;; Time-stamp: <2008-12-21 21:35:42EST gsl-objects.lisp>
+;; Time-stamp: <2008-12-23 19:30:28EST gsl-objects.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -12,14 +12,16 @@
 
 (defmacro defmobject
     (class prefix allocation-args description docstring
-     &optional initialize-suffix initialize-args)
-  (let ((mptr (make-symbol "MPOINTER"))
-	(maker (intern (format nil "MAKE-~:@(~a~)" class) :gsl))
-	(cl-alloc-args
-	 (variables-used-in-c-arguments allocation-args))
-	(cl-initialize-args
-	 (variables-used-in-c-arguments initialize-args))
-	(settingp (make-symbol "SETTINGP")))
+     &optional initialize-suffix initialize-args arglists-function)
+  (let* ((settingp (make-symbol "SETTINGP"))
+	 (arglists
+	  (when arglists-function
+	    (funcall (coerce arglists-function 'function) settingp)))
+	 (mptr (make-symbol "MPOINTER"))
+	 (maker (intern (format nil "MAKE-~:@(~a~)" class) :gsl))
+	 (cl-alloc-args (variables-used-in-c-arguments allocation-args))
+	 (cl-initialize-args
+	  (variables-used-in-c-arguments initialize-args)))
     `(progn
        (defclass ,class (mobject)
 	 ()
@@ -53,21 +55,29 @@
 
        (export ',maker)
        (defun ,maker
-	   (,@cl-alloc-args
-	    ,@(when initialize-suffix
-		    (append
-		     (list '&optional
-			   (list (first cl-initialize-args) nil settingp))
-		     (rest cl-initialize-args))))
+	   ,(if arglists
+		(first arglists)
+		`(,@cl-alloc-args
+		  ,@(when initialize-suffix
+			  (append
+			   (list '&optional
+				 (list (first cl-initialize-args) nil settingp))
+			   (rest cl-initialize-args)))))
 	 ,(format nil "Create the GSL object representing a ~a (class ~a).~&~a"
 		  description class docstring)
 	 (let ((object
-		(make-instance ',class ,@(symbol-keyword-symbol cl-alloc-args))))
+		(make-instance
+		 ',class
+		 ,@(if arglists
+		       (second arglists)
+		       (symbol-keyword-symbol cl-alloc-args)))))
 	   ,@(when initialize-suffix
 		   `((when ,settingp
 		       (reinitialize-instance
 			object
-			,@(symbol-keyword-symbol cl-initialize-args)))))
+			,@(if arglists
+			      (third arglists)
+			      (symbol-keyword-symbol cl-initialize-args))))))
 	   object)))))
 
 (defun symbol-keyword-symbol (symbol)
diff --git a/interpolation/interpolation.lisp b/interpolation/interpolation.lisp
index b3fda1c1..b45e9237 100644
--- a/interpolation/interpolation.lisp
+++ b/interpolation/interpolation.lisp
@@ -1,10 +1,28 @@
 ;; Interpolation allocation, initialization, and freeing.
 ;; Liam Healy, Sun Nov  4 2007 - 17:24
-;; Time-stamp: <2008-08-23 08:55:23EDT interpolation.lisp>
+;; Time-stamp: <2008-12-23 21:18:01EST interpolation.lisp>
 ;; $Id$
 
 (in-package :gsl)
 
+#|
+(defmobject interpolation "gsl_interp"
+  ((type :pointer) (size sizet))
+  "interpolation"			; FDL
+  "Make an interpolation object of type for size data-points,
+   and optionally initialize the interpolation object interp for the
+  data (xa,ya) where xa and ya are vectors.  The interpolation object does not save
+  the data arrays xa and ya and only stores the static state
+  computed from the data.  The xa data array is always assumed to be
+  strictly ordered; the behavior for other arrangements is not defined."
+  "init"
+  (((c-pointer xa) :pointer) ((c-pointer ya) :pointer) ((dim0 xa) sizet))
+  (lambda (set)
+  `((type &optional xa-or-size (ya nil ,set))
+    (:type type :size (if ,set (dim0 ya) xa-or-size))
+    (:xa xa-or-size :ya ya))))
+|#
+
 ;;; A spline is an interpolation that also stores the arrays xa and ya,
 ;;; so they need not be supplied on each call.
 
diff --git a/interpolation/lookup.lisp b/interpolation/lookup.lisp
index eb480c18..992e32e0 100644
--- a/interpolation/lookup.lisp
+++ b/interpolation/lookup.lisp
@@ -1,12 +1,22 @@
 ;; Index lookup and acceleration
 ;; Liam Healy, Sun Nov  4 2007 - 18:09
-;; Time-stamp: <2008-08-23 11:03:01EDT lookup.lisp>
+;; Time-stamp: <2008-12-21 22:20:36EST lookup.lisp>
 ;; $Id$
 
 (in-package :gsl)
 
 (defgo-s (acceleration) allocate-acceleration free-acceleration nil 0)
 
+#|
+(defmobject acceleration "gsl_interp_accel"
+  ()
+  "acceleration for interpolation"			; FDL
+  "Allocate an accelerator object, which is a
+   kind of iterator for interpolation lookups.  It tracks the state of
+   lookups, thus allowing for application of various acceleration
+   strategies.")
+|#
+
 (defmfun interpolation-search (x-array x low-index high-index)
   "gsl_interp_bsearch"
   ((x-array :pointer) (x :double) (low-index sizet) (high-index sizet))
-- 
GitLab