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