Commit 8555fb6a authored by Liam Healy's avatar Liam Healy

List argument to defmobject :initialize-suffix

A list argument to defmobject :initialize-suffix now means what a list
argument to defmfun to defmfun c-arguments does: there are two foreign
functions corresponding to the Lisp function; in this case, to
reinitialize-instance.  The old meaning of having the second element
specify the c-return reinitialize-instance has been eliminated;
instead, this information is conveyed in a new key argument
:ri-c-return.
parent 13447017
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2009-08-23 19:45:04EDT mobject.lisp>
;; Time-stamp: <2009-08-25 20:45:31EDT mobject.lisp>
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
;;; The macro demobject takes care of defining the appropriate
......@@ -54,6 +54,8 @@
;;; a single one with the singular form, like 'function.
;;; switch
;;; Same as for defmfun.
;;; ri-c-return
;;; The c-return for the reinitialize-instance function.
(defmacro defmobject
(class prefix allocation-args description
......@@ -61,7 +63,7 @@
arglists-function inputs gsl-version allocator allocate-inputs freer
((:callbacks cbinfo))
(superclasses (if cbinfo '(callback-included) '(mobject)))
singular switch)
singular switch ri-c-return)
"Define the class, the allocate, initialize-instance and
reinitialize-instance methods, and the make-* function for the GSL object."
(let* ((settingp (make-symbol "SETTINGP"))
......@@ -111,7 +113,7 @@
initialize-suffix initialize-args inputs
cbinfo
superclasses
switch))
switch ri-c-return))
(export '(,maker ,class))
,@(when cbinfo `((record-callbacks-for-class ',class ',cbinfo)))
,@(when cbinfo (make-mobject-defmcallbacks cbinfo class))
......@@ -127,6 +129,12 @@
:name ',class :gsl-name ,prefix
:gsl-version ',gsl-version))))))
(defun initialize-suffix-switched-foreign (initialize-suffix)
"The specified initialize-suffix indicates that there are two
foreign functions that can be called; which one is called
is dependent on the presence or absense of certain arguments."
(and initialize-suffix (listp initialize-suffix)))
(defun make-initialize-instance
(class cl-alloc-args cl-initialize-args prefix freer)
`(defmethod initialize-instance :after
......@@ -144,29 +152,13 @@
,(or freer (format nil "~a_free" prefix))
:pointer mpointer :void)))))
(defun initialize-suffix-switched-foreign (initialize-suffix)
"The specified initialize-suffix indicates that there are two
foreign functions that can be called; which one is called
is dependent on the presence or absense of certain arguments."
(and initialize-suffix
(listp initialize-suffix)
(every 'stringp initialize-suffix)))
(defun make-reinitialize-instance
(class cl-initialize-args initialize-name prefix
initialize-suffix initialize-args inputs
cbinfo superclasses switch)
cbinfo superclasses switch ri-c-return)
"Expand the reinitialize-instance form."
(flet ((add-suffix (suffix) (format nil "~a_~a" prefix suffix)))
(let* ((cbstruct (make-symbol "CBSTRUCT"))
(initialize-suffix-with-creturn
;; If initialize-suffix is a list, the second value
;; gives the return type. See random/quasi.lisp
;; defmobject quasi-random-number-generator for an
;; example.
(and initialize-suffix
(listp initialize-suffix)
(symbolp (second initialize-suffix))))
(initialize-suffix-switched-foreign
(initialize-suffix-switched-foreign initialize-suffix)))
`((defmfun reinitialize-instance
......@@ -178,22 +170,18 @@
,(or initialize-name
(if initialize-suffix-switched-foreign
(mapcar #'add-suffix initialize-suffix)
(add-suffix
(if initialize-suffix-with-creturn
(first initialize-suffix)
initialize-suffix))))
(add-suffix initialize-suffix)))
,(if initialize-suffix-switched-foreign
(mapcar (lambda (ia)
`(((mpointer object) :pointer)
,@(callback-replace-arg cbstruct ia cbinfo)))
initialize-args)
`(((mpointer object) :pointer)
,@(callback-replace-arg cbstruct initialize-args cbinfo)))
,@(callback-replace-arg cbstruct initialize-args cbinfo)))
:definition :method
,@(when cbinfo '(:callback-object object))
:qualifier :after
,@(when initialize-suffix-with-creturn
`(:c-return ,(second initialize-suffix)))
,@(when ri-c-return `(:c-return ,ri-c-return))
,@(when switch (list :switch switch))
:return (object)
,@(when inputs `(:inputs ,inputs))
......
;; Generators of random numbers.
;; Liam Healy, Sat Jul 15 2006 - 14:43
;; Time-stamp: <2009-05-25 10:07:43EDT generators.lisp>
;; Time-stamp: <2009-08-25 19:38:06EDT generators.lisp>
;; $Id$
(in-package :gsl)
......@@ -26,7 +26,8 @@
For example, the original Fortran source code for the *ranlux*
generator used a seed of 314159265, and so choosing s equal to zero
reproduces this when using *ranlux*."
:initialize-suffix ("set" :void)
:initialize-suffix "set"
:ri-c-return :void
:initialize-args ((value :ulong)))
(defmethod print-object ((object random-number-generator) stream)
......
;; Quasi-random sequences in arbitrary dimensions.
;; Liam Healy, Sun Jul 16 2006 - 15:54
;; Time-stamp: <2009-05-25 09:44:53EDT quasi.lisp>
;; Time-stamp: <2009-08-25 19:38:06EDT quasi.lisp>
;; $Id$
(in-package :gsl)
......@@ -15,7 +15,8 @@
"Make and optionally initialize the generator q to its starting point.
Note that quasi-random sequences do not use a seed and always produce
the same set of values."
:initialize-suffix ("init" :void)
:initialize-suffix "init"
:ri-c-return :void
:initialize-args nil)
(defmfun qrng-get (generator return-vector)
......
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