Commit 419e70d4 authored by Liam Healy's avatar Liam Healy

Redefine #'copy

Redefine #'copy so that it has one required argument (source) and one
optional argument (destination).  For marrays, create a destination
using make-marray, if one was not given, and then use the memcpy
functions to fill the values.  For all other mobjects, copy will copy
objects by calling one of two generic functions, #'copy-to-destination
and #'copy-making-destination, depending on whether a destination was
supplied.  The former is defined if a GSL _memcpy function exists.
The latter will look for a GSL _clone function, then make a CL
instance with the pointer returned as mpointer.  If there is no clone
function, it will attempt to make a new object using make-load-form,
so will fail if that method has not been defined.

Added a check to defmfun that signals an error if a variable is used
in the C arguments other than top-level that is not used in the CL
arglist.  This should not happen and is usually an indication of a
typo.
parent 7eadb203
;; Tests of array functions
;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp
;; Time-stamp: <2009-01-05 22:26:34EST array-tests.lisp>
;; Time-stamp: <2009-01-11 22:19:58EST array-tests.lisp>
;; $Id: $
;;; Generate each file with #'write-test-to-file, e.g.
......@@ -38,16 +38,10 @@
(cl-array m1)))
(generate-all-array-tests vector-copy t
(let ((v1 (array-default 3))
(v2 (array-default 3 t)))
(copy v2 v1)
(cl-array v2)))
(cl-array (copy (array-default 3))))
(generate-all-array-tests matrix-copy t
(let ((m1 (array-default '(3 3)))
(m2 (array-default '(3 3) t)))
(copy m2 m1)
(cl-array m2)))
(cl-array (copy (array-default '(3 3)))))
(generate-all-array-tests vector-swap t
(let ((v1 (array-default 3))
......
;; Functions for both vectors and matrices.
;; Liam Healy 2008-04-26 20:48:44EDT both.lisp
;; Time-stamp: <2009-01-04 11:30:47EST both.lisp>
;; Time-stamp: <2009-01-11 22:37:48EST both.lisp>
;; $Id$
(in-package :gsl)
......@@ -53,15 +53,16 @@
:c-return :void
:documentation "Set all elements to 0.")
(defmfun copy ((destination both) (source both))
(defmfun copy
((source both)
&optional
(destination
(make-marray element-type :dimensions (dimensions source))))
("gsl_" :category :type "_memcpy")
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :generic
:definition :methods
:inputs (source)
:outputs (destination)
:documentation ; FDL
"Copy the elements of the source into the
destination. The two must have the same size.")
:outputs (destination))
(defmfun swap ((a both) (b both))
("gsl_" :category :type "_swap")
......
;; Combinations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2009-01-11 14:23:51EST combination.lisp>
;; Time-stamp: <2009-01-11 21:18:14EST combination.lisp>
;; $Id$
(in-package :gsl)
......@@ -79,13 +79,15 @@
"Initialize the combination c to the lexicographically
last combination, i.e. (n-k,n-k+1,...,n-1).")
(defmfun copy (destination source)
(defmfun copy-to-destination ((source permutation) (destination permutation))
"gsl_combination_memcpy"
(((mpointer destination) :pointer)
((mpointer source) :pointer))
:definition :method
:inputs (source)
:outputs (destination)
:return (destination)
:index copy
:documentation ; FDL
"Copy the elements of the combination source into the
combination destination. The two combinations must have the same size.")
......
;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2009-01-11 14:18:42EST permutation.lisp>
;; Time-stamp: <2009-01-11 21:18:15EST permutation.lisp>
;; $Id$
(in-package :gsl)
......@@ -63,7 +63,7 @@
"Initialize the permutation p to the identity, i.e.
(0,1,2,...,n-1).")
(defmfun copy ((destination permutation) (source permutation))
(defmfun copy-to-destination ((source permutation) (destination permutation))
"gsl_permutation_memcpy"
(((mpointer destination) :pointer)
((mpointer source) :pointer))
......@@ -71,6 +71,7 @@
:inputs (source)
:outputs (destination)
:return (destination)
:index copy
:documentation ; FDL
"Copy the elements of the permutation source into the
permutation destination. The two permutations must have the same size.")
......
;; The histogram structure
;; Liam Healy, Mon Jan 1 2007 - 11:32
;; Time-stamp: <2008-12-26 12:31:18EST histogram.lisp>
;; Time-stamp: <2009-01-11 22:40:23EST histogram.lisp>
;; $Id$
(in-package :gsl)
......@@ -65,44 +65,41 @@
:definition :method
:return (histogram))
(defmfun copy ((destination histogram) (source histogram))
(defmfun copy-to-destination ((source histogram) (destination histogram))
"gsl_histogram_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
:return (destination)
:index copy
:documentation ; FDL
"Copy the histogram source into the pre-existing
histogram destination, making the latter into
an exact copy of the former.
The two histograms must be of the same size.")
(defmfun copy ((destination histogram2d) (source histogram2d))
(defmfun copy-to-destination ((source histogram2d) (destination histogram2d))
"gsl_histogram2d_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
:return (destination)
:index copy
:documentation ; FDL
"Copy the histogram source into the pre-existing
histogram destination, making the latter into
an exact copy of the former.
The two histograms must be of the same size.")
(defmfun clone ((source histogram))
(defmfun copy-making-destination ((source histogram))
"gsl_histogram_clone"
(((mpointer source) :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.")
:c-return :pointer
:index copy)
(defmfun clone (source)
(defmfun copy-making-destination ((source histogram2d))
"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.")
:c-return :pointer
:index copy)
;; Helpers that define a single GSL function interface
;; Liam Healy 2009-01-07 22:02:20EST defmfun-single.lisp
;; Time-stamp: <2009-01-11 10:07:06EST defmfun-single.lisp>
;; Time-stamp: <2009-01-11 22:37:31EST defmfun-single.lisp>
;; $Id: $
(in-package :gsl)
......@@ -137,7 +137,10 @@
(variables-used-in-c-arguments c-arguments)))
(allocated-decl
(mapcar
(lambda (s) (find s c-arguments :key #'st-symbol))
(lambda (s)
(or (find s c-arguments :key #'st-symbol)
;; Catch programming errors, usually typos
(error "Could not find ~a among the arguments" s)))
allocated))
(clret (or ; better as a symbol macro
(substitute cret-name :c-return return)
......
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2008-12-29 22:33:11EST mobject.lisp>
;; Time-stamp: <2009-01-11 22:13:07EST mobject.lisp>
;; $Id$
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
......@@ -12,6 +12,10 @@
(in-package :gsl)
;;;;****************************************************************************
;;;; The class definition
;;;;****************************************************************************
(defclass mobject ()
((mpointer :initarg :mpointer :reader mpointer
:documentation "A pointer to the GSL representation of the object.")))
......@@ -117,22 +121,14 @@
(list (intern (symbol-name symbol) :keyword)
symbol)))
;;; To make-load-form
;;; (make-basis-spline (bspline-order bspline) (number-of-breakpoints bspline))
;;; Then initialize by making a vector from (breakpoint i bspline)
;;; and calling knots.
;;;;****************************************************************************
;;;; Generic functions
;;;;****************************************************************************
(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))))
(export 'name)
(defgeneric name (object)
(:documentation "The name given to the GSL object."))
......@@ -158,3 +154,55 @@
(defmethod mpointer ((object #.+foreign-pointer-class+))
(check-type object #.+foreign-pointer-type+)
object)
;;;;****************************************************************************
;;;; Making objects from existing objects
;;;;****************************************************************************
(export 'copy)
(defgeneric copy (object &optional destination)
(:documentation "Create a duplicate object.")
;; This method is used for all GSL objects except arrays.
(:method ((object mobject) &optional destination)
(if destination
(copy-to-destination object destination)
(copy-making-destination object))))
(defgeneric copy-to-destination (object destination)
;; This copies values into an existing object. Methods are defined
;; for non-array GSL objects that have _memcpy functions defined.
;; Defined for
;; random-number-generator, quasi-random-number-generator,
;; histogram, histogram2d, permutation, combination.
(:documentation "Copy contents into existing object."))
(defgeneric copy-making-destination (object)
(:documentation "Create new duplicate object.")
(:method :around ((object mobject))
(if (next-method-p)
;; The subclass method should only return the malloced
;; mpointer (as from a "_clone" function); it will be put into
;; the CL object here. The initial-instance method for these
;; objects must be written to do nothing if the mpointer is
;; already defined.
;; Defined for
;; histogram, histogram2d,
;; random-number-generator, quasi-random-number-generator,
(make-instance (class-of object) :mpointer (call-next-method))
;; The subclass does not supply a method, so this will be called
;; by default. We can only try to make something from the load form.
(eval (make-load-form object)))))
;;; 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))))
;;; To make-load-form
;;; (make-basis-spline (bspline-order bspline) (number-of-breakpoints bspline))
;;; Then initialize by making a vector from (breakpoint i bspline)
;;; and calling knots.
;; Generators of random numbers.
;; Liam Healy, Sat Jul 15 2006 - 14:43
;; Time-stamp: <2008-12-26 18:17:35EST generators.lisp>
;; Time-stamp: <2009-01-11 23:01:36EST generators.lisp>
;; $Id$
(in-package :gsl)
......@@ -150,22 +150,23 @@
;;;; Copying state
;;;;****************************************************************************
(defmfun copy
((destination random-number-generator) (source random-number-generator))
(defmfun copy-to-destination
((source random-number-generator) (destination random-number-generator))
"gsl_rng_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
:index copy
:documentation ; FDL
"Copy the random number generator source into the
pre-existing generator destination,
making destination into an exact copy
of source. The two generators must be of the same type.")
(defmfun clone ((instance random-number-generator))
(defmfun copy-making-destination ((instance random-number-generator))
"gsl_rng_clone" (((mpointer instance) :pointer))
:definition :method
:c-return (mptr :pointer)
:return ((make-instance 'random-number-generator :mpointer mptr)))
:c-return :pointer
:index copy)
;;;;****************************************************************************
;;;; Examples and unit test
......
;; Quasi-random sequences in arbitrary dimensions.
;; Liam Healy, Sun Jul 16 2006 - 15:54
;; Time-stamp: <2008-12-27 11:10:20EST quasi.lisp>
;; Time-stamp: <2009-01-11 23:02:11EST quasi.lisp>
;; $Id$
(in-package :gsl)
......@@ -47,24 +47,23 @@
:export nil
:index gsl-random-state)
(defmfun copy
((destination quasi-random-number-generator)
(source quasi-random-number-generator))
(defmfun copy-to-destination
((source quasi-random-number-generator)
(destination quasi-random-number-generator))
"gsl_qrng_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
:index copy
:documentation ; FDL
"Copy the quasi-random sequence generator src into the
pre-existing generator dest, making dest into an exact copy
of src. The two generators must be of the same type.")
(defmfun clone ((instance quasi-random-number-generator))
(defmfun copy-making-destination ((instance quasi-random-number-generator))
"gsl_qrng_clone" (((mpointer instance) :pointer))
:definition :method
: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.")
:c-return :pointer
:index copy)
(def-rng-type *niederreiter2*
;; FDL
......
This diff is collapsed.
This diff is collapsed.
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