From 06f99392e28ebe17f016244f509fcae27ede0b1e Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Mon, 21 Dec 2009 10:33:31 -0500 Subject: [PATCH] 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. --- data/both.lisp | 4 ++-- data/combination.lisp | 4 ++-- data/copy-cl.lisp | 46 ++++++++++++++++------------------------ data/marray.lisp | 6 +++--- data/matrix.lisp | 4 ++-- data/permutation.lisp | 4 ++-- data/vector.lisp | 4 ++-- grid/copy.lisp | 26 +++++++++++++++++++++++ gsll.asd | 5 +++-- histogram/histogram.lisp | 6 +++--- init/mobject.lisp | 12 ++--------- random/generators.lisp | 4 ++-- random/quasi.lisp | 4 ++-- 13 files changed, 69 insertions(+), 60 deletions(-) create mode 100644 grid/copy.lisp diff --git a/data/both.lisp b/data/both.lisp index 27b82a9a..cc330992 100644 --- a/data/both.lisp +++ b/data/both.lisp @@ -1,6 +1,6 @@ ;; 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)) diff --git a/data/combination.lisp b/data/combination.lisp index 28e9cd73..36839800 100644 --- a/data/combination.lisp +++ b/data/combination.lisp @@ -1,6 +1,6 @@ ;; 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)) diff --git a/data/copy-cl.lisp b/data/copy-cl.lisp index 2329d09c..78abe820 100644 --- a/data/copy-cl.lisp +++ b/data/copy-cl.lisp @@ -1,6 +1,6 @@ ;; 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 diff --git a/data/marray.lisp b/data/marray.lisp index ccf3a35c..c886f177 100644 --- a/data/marray.lisp +++ b/data/marray.lisp @@ -1,6 +1,6 @@ ;; 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 diff --git a/data/matrix.lisp b/data/matrix.lisp index 4056d188..e4f764b8 100644 --- a/data/matrix.lisp +++ b/data/matrix.lisp @@ -1,6 +1,6 @@ ;; 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 diff --git a/data/permutation.lisp b/data/permutation.lisp index 8e3c7f1e..d0b13fe2 100644 --- a/data/permutation.lisp +++ b/data/permutation.lisp @@ -1,6 +1,6 @@ ;; 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)) diff --git a/data/vector.lisp b/data/vector.lisp index 6682c3c2..e8521a97 100644 --- a/data/vector.lisp +++ b/data/vector.lisp @@ -1,6 +1,6 @@ ;; 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 diff --git a/grid/copy.lisp b/grid/copy.lisp new file mode 100644 index 00000000..d222db1e --- /dev/null +++ b/grid/copy.lisp @@ -0,0 +1,26 @@ +;; 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.")) diff --git a/gsll.asd b/gsll.asd index ba58b98a..52ea63b1 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; 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 diff --git a/histogram/histogram.lisp b/histogram/histogram.lisp index 8de44e90..d68fc437 100644 --- a/histogram/histogram.lisp +++ b/histogram/histogram.lisp @@ -1,6 +1,6 @@ ;; 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 diff --git a/init/mobject.lisp b/init/mobject.lisp index 32762f44..67038445 100644 --- a/init/mobject.lisp +++ b/init/mobject.lisp @@ -1,6 +1,6 @@ ;; 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)) diff --git a/random/generators.lisp b/random/generators.lisp index c494cbd8..808d7b2d 100644 --- a/random/generators.lisp +++ b/random/generators.lisp @@ -1,6 +1,6 @@ ;; 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)) diff --git a/random/quasi.lisp b/random/quasi.lisp index 74748f8a..a71ba5fc 100644 --- a/random/quasi.lisp +++ b/random/quasi.lisp @@ -1,6 +1,6 @@ ;; 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" -- GitLab