Skip to content
Snippets Groups Projects
Commit adbbbbcd authored by Liam Healy's avatar Liam Healy
Browse files

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
No related branches found
No related tags found
No related merge requests found
;; Macro for defining GSL functions. ;; Macro for defining GSL functions.
;; Liam Healy 2008-04-16 20:49:50EDT defmfun.lisp ;; 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$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -504,7 +504,8 @@ ...@@ -504,7 +504,8 @@
(remove-duplicates (remove-duplicates
(mapcan (lambda (carg) (mapcan (lambda (carg)
(stupid-code-walk-find-variables (st-symbol carg))) (stupid-code-walk-find-variables (st-symbol carg)))
c-arguments))) c-arguments)
:from-end t))
(defun native-pointer (array-symbols body) (defun native-pointer (array-symbols body)
"Wrap the body with a form that obtains the native pointer "Wrap the body with a form that obtains the native pointer
......
;; Definition of GSL objects and ways to use them. ;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21 ;; 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$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -12,14 +12,16 @@ ...@@ -12,14 +12,16 @@
(defmacro defmobject (defmacro defmobject
(class prefix allocation-args description docstring (class prefix allocation-args description docstring
&optional initialize-suffix initialize-args) &optional initialize-suffix initialize-args arglists-function)
(let ((mptr (make-symbol "MPOINTER")) (let* ((settingp (make-symbol "SETTINGP"))
(maker (intern (format nil "MAKE-~:@(~a~)" class) :gsl)) (arglists
(cl-alloc-args (when arglists-function
(variables-used-in-c-arguments allocation-args)) (funcall (coerce arglists-function 'function) settingp)))
(cl-initialize-args (mptr (make-symbol "MPOINTER"))
(variables-used-in-c-arguments initialize-args)) (maker (intern (format nil "MAKE-~:@(~a~)" class) :gsl))
(settingp (make-symbol "SETTINGP"))) (cl-alloc-args (variables-used-in-c-arguments allocation-args))
(cl-initialize-args
(variables-used-in-c-arguments initialize-args)))
`(progn `(progn
(defclass ,class (mobject) (defclass ,class (mobject)
() ()
...@@ -53,21 +55,29 @@ ...@@ -53,21 +55,29 @@
(export ',maker) (export ',maker)
(defun ,maker (defun ,maker
(,@cl-alloc-args ,(if arglists
,@(when initialize-suffix (first arglists)
(append `(,@cl-alloc-args
(list '&optional ,@(when initialize-suffix
(list (first cl-initialize-args) nil settingp)) (append
(rest cl-initialize-args)))) (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" ,(format nil "Create the GSL object representing a ~a (class ~a).~&~a"
description class docstring) description class docstring)
(let ((object (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 initialize-suffix
`((when ,settingp `((when ,settingp
(reinitialize-instance (reinitialize-instance
object object
,@(symbol-keyword-symbol cl-initialize-args))))) ,@(if arglists
(third arglists)
(symbol-keyword-symbol cl-initialize-args))))))
object))))) object)))))
(defun symbol-keyword-symbol (symbol) (defun symbol-keyword-symbol (symbol)
......
;; Interpolation allocation, initialization, and freeing. ;; Interpolation allocation, initialization, and freeing.
;; Liam Healy, Sun Nov 4 2007 - 17:24 ;; 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$ ;; $Id$
(in-package :gsl) (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, ;;; A spline is an interpolation that also stores the arrays xa and ya,
;;; so they need not be supplied on each call. ;;; so they need not be supplied on each call.
......
;; Index lookup and acceleration ;; Index lookup and acceleration
;; Liam Healy, Sun Nov 4 2007 - 18:09 ;; 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$ ;; $Id$
(in-package :gsl) (in-package :gsl)
(defgo-s (acceleration) allocate-acceleration free-acceleration nil 0) (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) (defmfun interpolation-search (x-array x low-index high-index)
"gsl_interp_bsearch" "gsl_interp_bsearch"
((x-array :pointer) (x :double) (low-index sizet) (high-index sizet)) ((x-array :pointer) (x :double) (low-index sizet) (high-index sizet))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment