diff --git a/init/defmfun.lisp b/init/defmfun.lisp index e55704f1a60fb6d15a7ab7c2460f503122ebba7f..872b60ceb01edfc12e114b32759edc98169bf4ea 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 5da09102cb0d9024aa0f76e2d5d2af7625fd8e31..8e38259586691620d34a0d29165744771b46f8be 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 b3fda1c1dcf18b547256e3cfc52c49dfed7c6474..b45e9237a9c8bdbf4b23774f355a24b436076193 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 eb480c18fcbce1bbea388297e643643e346640f6..992e32e0d87a50e06610ddfb7ee3ed9b375ef69a 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))