Commit 06f99392 authored by Liam Healy's avatar Liam Healy

Move copy-to-destination to grid

The generic function definition for copy-to-destination is now in
grid/ and the c-array package.  This will make it accessible to
non-GSLL foreign library interfaces, but the new location is a bit
deceptive because a new method needn't be a subclass of foreign-array.
parent f3a45c98
;; Functions for both vectors and matrices.
;; Liam Healy 2008-04-26 20:48:44EDT both.lisp
;; Time-stamp: <2009-11-18 10:46:49EST both.lisp>
;; Time-stamp: <2009-12-21 10:21:28EST both.lisp>
(in-package :gsl)
......@@ -53,7 +53,7 @@
:c-return :void
:documentation "Set all elements to 0.")
(defmfun copy-to-destination
(defmfun c-array:copy-to-destination
((source both) (destination both))
("gsl_" :category :type "_memcpy")
(((mpointer destination) :pointer) ((mpointer source) :pointer))
......
;; Combinations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2009-12-21 08:24:35EST combination.lisp>
;; Time-stamp: <2009-12-21 10:21:30EST combination.lisp>
;; $Id$
(in-package :gsl)
......@@ -76,7 +76,7 @@
"Initialize the combination c to the lexicographically
last combination, i.e. (n-k,n-k+1,...,n-1).")
(defmfun copy-to-destination ((source combination) (destination combination))
(defmfun c-array:copy-to-destination ((source combination) (destination combination))
"gsl_combination_memcpy"
(((mpointer destination) :pointer)
((mpointer source) :pointer))
......
;; Copy marrays to/from CL arrays
;; Liam Healy 2009-02-11 19:28:44EST copy-cl.lisp
;; Time-stamp: <2009-12-21 08:14:31EST copy-cl.lisp>
;; Time-stamp: <2009-12-21 10:27:07EST copy-cl.lisp>
;; $Id: $
;;; The function #'copy can be used to copy the contents to or from a
......@@ -20,65 +20,55 @@
(in-package :gsl)
(define-condition array-mismatch (error)
()
(:report
(lambda (condition stream)
(declare (ignore condition))
(format stream "Arrays must be of equal size for copying.")))
(:documentation
"An error indicating that the two arrays do not have
the same dimensions."))
(defmethod copy-to-destination ((source mvector) (destination array))
;;; These make destination but are methods of copy-to-destination so
;;; that the class argument may be supplied.
(defmethod c-array:copy-to-destination ((source mvector) (destination array))
(unless (equal (dimensions source) (array-dimensions destination))
(error 'array-mismatch))
(error 'c-array:array-mismatch))
(loop for i below (dim0 source)
do (setf (aref destination i) (maref source i)))
destination)
(defmethod copy-to-destination ((source matrix) (destination array))
(defmethod c-array:copy-to-destination ((source matrix) (destination array))
(unless (equal (dimensions source) (array-dimensions destination))
(error 'array-mismatch))
(error 'c-array:array-mismatch))
(loop for i below (dim0 source) do
(loop for j below (dim1 source) do
(setf (aref destination i j) (maref source i j))))
destination)
(defmethod copy-to-destination ((source array) (destination mvector))
(defmethod c-array:copy-to-destination ((source array) (destination mvector))
(unless (equal (array-dimensions source) (dimensions destination))
(error 'array-mismatch))
(error 'c-array:array-mismatch))
(loop for i below (length source)
do (setf (maref destination i) (aref source i)))
destination)
(defmethod copy-to-destination ((source array) (destination matrix))
(defmethod c-array:copy-to-destination ((source array) (destination matrix))
(unless (equal (array-dimensions source) (dimensions destination))
(error 'array-mismatch))
(error 'c-array:array-mismatch))
(loop for i below (array-dimension source 0) do
(loop for j below (array-dimension source 1) do
(setf (maref destination i j) (aref source i j))))
destination)
;;; These make destination but are methods of copy-to-destination so
;;; that the class argument may be supplied.
(defmethod copy-to-destination ((source marray) (destclass (eql 'array)))
(defmethod c-array:copy-to-destination ((source marray) (destclass (eql 'array)))
(let ((destination
(c-array:make-ffa (element-type source) :dimensions (dimensions source))))
(copy-to-destination source destination)))
(c-array:copy-to-destination source destination)))
;;; Copy to a named marray element-type, where the type is a symbol
(defmethod copy-to-destination ((source array) (destclass symbol))
(defmethod c-array:copy-to-destination ((source array) (destclass symbol))
(let ((destination
(make-marray destclass :dimensions (array-dimensions source))))
(copy-to-destination source destination)))
(c-array:copy-to-destination source destination)))
;;; Copy to a named marray element-type, where the type is a list
(defmethod copy-to-destination ((source array) (destclass list))
(defmethod c-array:copy-to-destination ((source array) (destclass list))
(let ((destination
(make-marray destclass :dimensions (array-dimensions source))))
(copy-to-destination source destination)))
(c-array:copy-to-destination source destination)))
;;; Examples and tests
......
;; A "marray" is an array in both GSL and CL
;; Liam Healy 2008-04-06 21:23:41EDT
;; Time-stamp: <2009-12-21 08:32:09EST marray.lisp>
;; Time-stamp: <2009-12-21 10:21:31EST marray.lisp>
(in-package :gsl)
......@@ -204,9 +204,9 @@
pointer
;; Default assumption when destination isn't given in #'copy is
;; that this should make a vector-double-float.
(copy-to-destination pointer 'vector-double-float)))
(c-array:copy-to-destination pointer 'vector-double-float)))
(defmethod copy-to-destination
(defmethod c-array:copy-to-destination
((pointer #.+foreign-pointer-class+) (class-name symbol))
(foreign-pointer-method
pointer
......
;; Matrices
;; Liam Healy 2008-04-15 21:57:52EDT matrix.lisp
;; Time-stamp: <2009-06-06 10:07:26EDT matrix.lisp>
;; Time-stamp: <2009-12-21 10:21:29EST matrix.lisp>
(in-package :gsl)
......@@ -28,7 +28,7 @@
collect (loop for j below dim1
collect (maref pointer i j element-type)))))
(defmethod copy-to-destination
(defmethod c-array:copy-to-destination
((object matrix) (pointer #.+foreign-pointer-class+))
(foreign-pointer-method
pointer
......
;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2009-12-21 08:17:05EST permutation.lisp>
;; Time-stamp: <2009-12-21 10:21:32EST permutation.lisp>
;; $Id$
(in-package :gsl)
......@@ -61,7 +61,7 @@
"Initialize the permutation p to the identity, i.e.
(0,1,2,...,n-1).")
(defmfun copy-to-destination ((source permutation) (destination permutation))
(defmfun c-array:copy-to-destination ((source permutation) (destination permutation))
"gsl_permutation_memcpy"
(((mpointer destination) :pointer)
((mpointer source) :pointer))
......
;; Vectors
;; Liam Healy 2008-04-13 09:39:02EDT vector.lisp
;; Time-stamp: <2009-06-06 10:04:13EDT vector.lisp>
;; Time-stamp: <2009-12-21 10:21:27EST vector.lisp>
(in-package :gsl)
......@@ -24,7 +24,7 @@
(loop for i below (cffi:foreign-slot-value pointer struct-type 'size)
collect (maref pointer i nil element-type)))
(defmethod copy-to-destination
(defmethod c-array:copy-to-destination
((object mvector) (pointer #.+foreign-pointer-class+))
(foreign-pointer-method
pointer
......
;; Copy objects
;; Liam Healy 2009-12-21 10:16:04EST copy.lisp
;; Time-stamp: <2009-12-21 10:24:07EST copy.lisp>
;; $Id: $
(in-package :c-array)
(export '(copy-to-destination array-mismatch))
(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."))
(define-condition array-mismatch (error)
()
(:report
(lambda (condition stream)
(declare (ignore condition))
(format stream "Arrays must be of equal size for copying.")))
(:documentation
"An error indicating that the two arrays do not have
the same dimensions."))
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-12-21 09:44:15EST gsll.asd>
;; Time-stamp: <2009-12-21 10:22:26EST gsll.asd>
(when (asdf:find-system :fsbv nil)
(pushnew :fsbv *features*))
......@@ -27,7 +27,8 @@
:depends-on ("pkgdcl" "complex-types" "symbol-type"))
(:file "foreign-friendly" :depends-on ("pkgdcl"))
(:file "foreign-array" :depends-on ("pkgdcl" "foreign-friendly"))
(:file "element-reference" :depends-on ("pkgdcl"))))
(:file "element-reference" :depends-on ("pkgdcl"))
(:file "copy" :depends-on ("pkgdcl"))))
(:module init
:depends-on (grid)
:components
......
;; The histogram structure
;; Liam Healy, Mon Jan 1 2007 - 11:32
;; Time-stamp: <2009-01-25 10:03:15EST histogram.lisp>
;; Time-stamp: <2009-12-21 10:21:26EST histogram.lisp>
;; $Id$
(in-package :gsl)
......@@ -64,7 +64,7 @@
:definition :method
:return (histogram))
(defmfun copy-to-destination ((source histogram) (destination histogram))
(defmfun c-array:copy-to-destination ((source histogram) (destination histogram))
"gsl_histogram_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
......@@ -76,7 +76,7 @@
an exact copy of the former.
The two histograms must be of the same size.")
(defmfun copy-to-destination ((source histogram2d) (destination histogram2d))
(defmfun c-array:copy-to-destination ((source histogram2d) (destination histogram2d))
"gsl_histogram2d_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
......
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2009-11-07 11:21:10EST mobject.lisp>
;; Time-stamp: <2009-12-21 10:21:27EST mobject.lisp>
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
;;; The macro demobject takes care of defining the appropriate
......@@ -341,17 +341,9 @@
(defun copy (object &optional destination)
"Create a duplicate object."
(if destination
(copy-to-destination object destination)
(c-array: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))
......
;; Generators of random numbers.
;; Liam Healy, Sat Jul 15 2006 - 14:43
;; Time-stamp: <2009-08-25 19:38:06EDT generators.lisp>
;; Time-stamp: <2009-12-21 10:21:25EST generators.lisp>
;; $Id$
(in-package :gsl)
......@@ -161,7 +161,7 @@
;;;; Copying state
;;;;****************************************************************************
(defmfun copy-to-destination
(defmfun c-array:copy-to-destination
((source random-number-generator) (destination random-number-generator))
"gsl_rng_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
......
;; Quasi-random sequences in arbitrary dimensions.
;; Liam Healy, Sun Jul 16 2006 - 15:54
;; Time-stamp: <2009-08-25 19:38:06EDT quasi.lisp>
;; Time-stamp: <2009-12-21 10:21:25EST quasi.lisp>
;; $Id$
(in-package :gsl)
......@@ -49,7 +49,7 @@
:export nil
:index gsl-random-state)
(defmfun copy-to-destination
(defmfun c-array:copy-to-destination
((source quasi-random-number-generator)
(destination quasi-random-number-generator))
"gsl_qrng_memcpy"
......
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