Commit 38d9c4f4 authored by Liam Healy's avatar Liam Healy

Permit alternate origin of mpointer; #'clone

Redesign #'defmobject so that a new method #'allocate is defined that
calls the standard GSL allocate function for each object.  Shrink the
initialize-instance :after method to call #'allocate if the mpointer
isn't given, and then set the finalizer.  This way, an :mpointer made
by something other than the allocate function may be supplied to the
make-instance, and the object will be made correctly.  This is used by
#'clone functions in histogram and random number generators.  Not
compiled or tested, but macroexpansions look right.
parent 0d2f9357
;; The histogram structure
;; Liam Healy, Mon Jan 1 2007 - 11:32
;; Time-stamp: <2008-12-25 14:30:48EST histogram.lisp>
;; Time-stamp: <2008-12-25 22:49:25EST histogram.lisp>
;; $Id$
(in-package :gsl)
......@@ -85,17 +85,12 @@
an exact copy of the former.
The two histograms must be of the same size.")
;;; Could be part of copy when the second argument is optional?
(export 'clone)
(defgeneric clone (object)
(:documentation "Create a duplicate object."))
;;; This returns a bare C pointer, which isn't too useful.
(defmfun clone ((source histogram))
"gsl_histogram_clone"
(((mpointer source) :pointer))
:c-return :pointer
:definition :method
:c-return (mptr :pointer)
:return ((make-instance 'histogram :mpointer mptr))
:documentation ; FDL
"Create a new histogram which is an
exact copy of the histogram source, and return the pointer.")
......@@ -104,6 +99,8 @@
"gsl_histogram2d_clone"
(((mpointer source) :pointer))
:definition :method
:c-return (mptr :pointer)
:return ((make-instance 'histogram2d :mpointer mptr))
:documentation ; FDL
"Create a new histogram which is an
exact copy of the histogram source, and return the pointer.")
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2008-12-25 12:03:18EST gsl-objects.lisp>
;; Time-stamp: <2008-12-25 23:01:24EST gsl-objects.lisp>
;; $Id$
(in-package :gsl)
#|
(defclass mobject ()
((mpointer :accessor mpointer
((mpointer :initarg :mpointer :reader mpointer
:documentation "A pointer to the GSL representation of the object.")))
(defmacro defmobject
(class prefix allocation-args description
&optional docstring initialize-suffix initialize-args arglists-function
......@@ -23,7 +24,6 @@
(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
......@@ -35,22 +35,25 @@
(:documentation
,(format nil "The GSL representation of the ~a." description)))
(defmfun initialize-instance ((object ,class) &key ,@cl-alloc-args)
(defmfun allocate ((object ,class) &key ,@cl-alloc-args)
,(if (listp prefix) (second prefix) (format nil "~a_alloc" prefix))
,allocation-args
:definition :method
:qualifier :after
:c-return (,mptr :pointer)
:after ((setf (slot-value object 'mpointer) ,mptr)
(tg:finalize
object
(lambda ()
(foreign-funcall ,(format nil "~a_free" realprefix)
:pointer ,mptr :void))))
:return (object)
:export nil
:c-return :pointer
:index ,maker)
(defmethod initialize-instance :after
((object ,class) &key mpointer ,@cl-alloc-args)
(unless mpointer
(setf mpointer
(allocate object ,@(symbol-keyword-symbol cl-alloc-args))))
(trivial-garbage:finalize
object
(lambda ()
(cffi:foreign-funcall
,(format nil "~a_free" realprefix)
:pointer mpointer :void))))
,@(when initialize-suffix
`((defmfun reinitialize-instance
,(if initialize-args
......@@ -107,6 +110,17 @@
;;; and calling knots.
|#
(defgeneric allocate (object &key &allow-other-keys)
(:documentation
"Use GSL to allocate memory. Returns pointer but does not bind mpointer slot."))
;;; Could be part of copy when the second argument is optional?
(export 'clone)
(defgeneric clone (object)
(:documentation "Create a duplicate object.")
(:method :around ((object mobject))
(make-instance (class-of object) :mpointer (call-next-method))))
;;;;;;;;;;;;;;;;;;;;;;;; OLD ;;;;;;;;;;;;;;;;;;;;;;;;;;;
......
;; Generators of random numbers.
;; Liam Healy, Sat Jul 15 2006 - 14:43
;; Time-stamp: <2008-12-25 14:28:48EST generators.lisp>
;; Time-stamp: <2008-12-25 22:49:25EST generators.lisp>
;; $Id$
(in-package :gsl)
......@@ -163,11 +163,11 @@
making destination into an exact copy
of source. The two generators must be of the same type.")
;;; This returns a bare C pointer, which isn't too useful.
(defmfun clone ((instance random-number-generator))
"gsl_rng_clone" (((generator instance) :pointer))
:c-return :pointer
:definition :method)
:definition :method
:c-return (mptr :pointer)
:return ((make-instance 'random-number-generator :mpointer mptr)))
;;;;****************************************************************************
;;;; Examples and unit test
......
;; Quasi-random sequences in arbitrary dimensions.
;; Liam Healy, Sun Jul 16 2006 - 15:54
;; Time-stamp: <2008-12-25 14:28:57EST quasi.lisp>
;; Time-stamp: <2008-12-25 22:49:26EST quasi.lisp>
;; $Id$
(in-package :gsl)
......@@ -56,14 +56,13 @@
pre-existing generator dest, making dest into an exact copy
of src. The two generators must be of the same type.")
;;; This returns a bare C pointer, which isn't too useful.
(defmfun clone ((instance quasi-random-number-generator))
"gsl_qrng_clone" (((generator instance) :pointer))
:definition :method
:c-return :pointer
:c-return (mptr :pointer)
:return ((make-instance 'quasi-random-number-generator :mpointer mptr))
:documentation ; FDL
"Create a new generator which is an exact copy of the original.
Don't use; use #'make-random-number-generator, #'copy instead.")
"Create a new generator which is an exact copy of the original.")
(def-rng-type *niederreiter2*
;; FDL
......
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