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