Commit adbbbbcd authored by Liam Healy's avatar Liam Healy

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.
parent d310adfd
;; 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
......
;; 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)
......
;; 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.
......
;; 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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment