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

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
No related branches found
No related tags found
No related merge requests found
;; 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: <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. ;;; GSL objects are represented in GSLL as and instance of a 'mobject.
;;; The macro demobject takes care of defining the appropriate ;;; The macro demobject takes care of defining the appropriate
...@@ -54,6 +54,8 @@ ...@@ -54,6 +54,8 @@
;;; a single one with the singular form, like 'function. ;;; a single one with the singular form, like 'function.
;;; switch ;;; switch
;;; Same as for defmfun. ;;; Same as for defmfun.
;;; ri-c-return
;;; The c-return for the reinitialize-instance function.
(defmacro defmobject (defmacro defmobject
(class prefix allocation-args description (class prefix allocation-args description
...@@ -61,7 +63,7 @@ ...@@ -61,7 +63,7 @@
arglists-function inputs gsl-version allocator allocate-inputs freer arglists-function inputs gsl-version allocator allocate-inputs freer
((:callbacks cbinfo)) ((:callbacks cbinfo))
(superclasses (if cbinfo '(callback-included) '(mobject))) (superclasses (if cbinfo '(callback-included) '(mobject)))
singular switch) singular switch ri-c-return)
"Define the class, the allocate, initialize-instance and "Define the class, the allocate, initialize-instance and
reinitialize-instance methods, and the make-* function for the GSL object." reinitialize-instance methods, and the make-* function for the GSL object."
(let* ((settingp (make-symbol "SETTINGP")) (let* ((settingp (make-symbol "SETTINGP"))
...@@ -111,7 +113,7 @@ ...@@ -111,7 +113,7 @@
initialize-suffix initialize-args inputs initialize-suffix initialize-args inputs
cbinfo cbinfo
superclasses superclasses
switch)) switch ri-c-return))
(export '(,maker ,class)) (export '(,maker ,class))
,@(when cbinfo `((record-callbacks-for-class ',class ',cbinfo))) ,@(when cbinfo `((record-callbacks-for-class ',class ',cbinfo)))
,@(when cbinfo (make-mobject-defmcallbacks cbinfo class)) ,@(when cbinfo (make-mobject-defmcallbacks cbinfo class))
...@@ -127,6 +129,12 @@ ...@@ -127,6 +129,12 @@
:name ',class :gsl-name ,prefix :name ',class :gsl-name ,prefix
:gsl-version ',gsl-version)))))) :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 (defun make-initialize-instance
(class cl-alloc-args cl-initialize-args prefix freer) (class cl-alloc-args cl-initialize-args prefix freer)
`(defmethod initialize-instance :after `(defmethod initialize-instance :after
...@@ -144,29 +152,13 @@ ...@@ -144,29 +152,13 @@
,(or freer (format nil "~a_free" prefix)) ,(or freer (format nil "~a_free" prefix))
:pointer mpointer :void))))) :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 (defun make-reinitialize-instance
(class cl-initialize-args initialize-name prefix (class cl-initialize-args initialize-name prefix
initialize-suffix initialize-args inputs initialize-suffix initialize-args inputs
cbinfo superclasses switch) cbinfo superclasses switch ri-c-return)
"Expand the reinitialize-instance form." "Expand the reinitialize-instance form."
(flet ((add-suffix (suffix) (format nil "~a_~a" prefix suffix))) (flet ((add-suffix (suffix) (format nil "~a_~a" prefix suffix)))
(let* ((cbstruct (make-symbol "CBSTRUCT")) (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-switched-foreign initialize-suffix))) (initialize-suffix-switched-foreign initialize-suffix)))
`((defmfun reinitialize-instance `((defmfun reinitialize-instance
...@@ -178,22 +170,18 @@ ...@@ -178,22 +170,18 @@
,(or initialize-name ,(or initialize-name
(if initialize-suffix-switched-foreign (if initialize-suffix-switched-foreign
(mapcar #'add-suffix initialize-suffix) (mapcar #'add-suffix initialize-suffix)
(add-suffix (add-suffix initialize-suffix)))
(if initialize-suffix-with-creturn
(first initialize-suffix)
initialize-suffix))))
,(if initialize-suffix-switched-foreign ,(if initialize-suffix-switched-foreign
(mapcar (lambda (ia) (mapcar (lambda (ia)
`(((mpointer object) :pointer) `(((mpointer object) :pointer)
,@(callback-replace-arg cbstruct ia cbinfo))) ,@(callback-replace-arg cbstruct ia cbinfo)))
initialize-args) initialize-args)
`(((mpointer object) :pointer) `(((mpointer object) :pointer)
,@(callback-replace-arg cbstruct initialize-args cbinfo))) ,@(callback-replace-arg cbstruct initialize-args cbinfo)))
:definition :method :definition :method
,@(when cbinfo '(:callback-object object)) ,@(when cbinfo '(:callback-object object))
:qualifier :after :qualifier :after
,@(when initialize-suffix-with-creturn ,@(when ri-c-return `(:c-return ,ri-c-return))
`(:c-return ,(second initialize-suffix)))
,@(when switch (list :switch switch)) ,@(when switch (list :switch switch))
:return (object) :return (object)
,@(when inputs `(:inputs ,inputs)) ,@(when inputs `(:inputs ,inputs))
......
;; Generators of random numbers. ;; Generators of random numbers.
;; Liam Healy, Sat Jul 15 2006 - 14:43 ;; 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$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -26,7 +26,8 @@ ...@@ -26,7 +26,8 @@
For example, the original Fortran source code for the *ranlux* For example, the original Fortran source code for the *ranlux*
generator used a seed of 314159265, and so choosing s equal to zero generator used a seed of 314159265, and so choosing s equal to zero
reproduces this when using *ranlux*." reproduces this when using *ranlux*."
:initialize-suffix ("set" :void) :initialize-suffix "set"
:ri-c-return :void
:initialize-args ((value :ulong))) :initialize-args ((value :ulong)))
(defmethod print-object ((object random-number-generator) stream) (defmethod print-object ((object random-number-generator) stream)
......
;; Quasi-random sequences in arbitrary dimensions. ;; Quasi-random sequences in arbitrary dimensions.
;; Liam Healy, Sun Jul 16 2006 - 15:54 ;; 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$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -15,7 +15,8 @@ ...@@ -15,7 +15,8 @@
"Make and optionally initialize the generator q to its starting point. "Make and optionally initialize the generator q to its starting point.
Note that quasi-random sequences do not use a seed and always produce Note that quasi-random sequences do not use a seed and always produce
the same set of values." the same set of values."
:initialize-suffix ("init" :void) :initialize-suffix "init"
:ri-c-return :void
:initialize-args nil) :initialize-args nil)
(defmfun qrng-get (generator return-vector) (defmfun qrng-get (generator return-vector)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment