diff --git a/data/both.lisp b/data/both.lisp index 27b82a9ad3306792efba9abe962dbeb721851290..cc3309925c3508930f67ba384914e0bd327ed537 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 28e9cd73e676cd1516511ec9bbd5ae98a4c6dfcd..368398003f82906d7079d5f032057a95a676d645 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 2329d09c9363e55a06176e3fdcf7a5d67ae5e9bb..78abe820ad2b8e4518ab03fa7d957151842ec3aa 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 ccf3a35c3b5a93c21c2d9c9ffa5ec4491eda3238..c886f1779eec16f6cae752c15c2cba255e2077ab 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 4056d1881da652216d75c6ff26eac9366d55af8a..e4f764b8c7a484b7bdb258a03b0411e658102903 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 8e3c7f1edd30e09c200d48f9c6ab8d93f1c67164..d0b13fe2d80b15309e884fed97364ceb388aaa06 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 6682c3c27eb3c4c2c8c59e4b12cfed26fe64511f..e8521a978f53a9b98a9a87f78205933aeb6ccc51 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 0000000000000000000000000000000000000000..d222db1ef6c29d719e0b73ff7474ec6aa74b3f3f --- /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 ba58b98a1286bbf097438bdf1976ea13e5ca64df..52ea63b111f9113e3376e30fa594af09b6c88cfe 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 8de44e907d6791dcf302c858977a00b94dfae91d..d68fc4378690e706aa61d2591fe326bd47789964 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 32762f4497b5db13c64d73262ec199aed3c1da86..67038445990a41c7a9b4167ef899f1c07b8cd7c6 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 c494cbd837ef3aac303113f7498e82fe0f6e5f26..808d7b2de06606855e1f58fb17c512df1a9e1f98 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 74748f8ad505f3395c10b2e80752a93088de77c0..a71ba5fccd64fe5b23b763b646499efbad0578a5 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"