From bdbb354bd2aababa78cc1a40acfe6cd5f0a790db Mon Sep 17 00:00:00 2001
From: Liam Healy <liam@thinkpad.local>
Date: Thu, 15 Jul 2010 23:18:43 -0400
Subject: [PATCH] Copy with #'grid:copy methods

Copy with #'grid:copy methods and eliminate copy-to-destination and
copy-making-destination.  For non-grid objects, the presence or
absence of destination selects different foreign functions.
---
 data/combination.lisp    |  20 ++++--
 data/permutation.lisp    |  17 +++--
 histogram/histogram.lisp |  50 ++++++++-----
 init/forms.lisp          |   6 +-
 init/init.lisp           |   6 +-
 init/mobject.lisp        |  28 +-------
 random/generators.lisp   |  26 ++++---
 random/quasi.lisp        |  25 ++++---
 tests/permutation.lisp   | 150 +++++++++++++++------------------------
 9 files changed, 153 insertions(+), 175 deletions(-)

diff --git a/data/combination.lisp b/data/combination.lisp
index 9dec8981..2e1ad1b9 100644
--- a/data/combination.lisp
+++ b/data/combination.lisp
@@ -1,8 +1,8 @@
 ;; Combinations
 ;; Liam Healy, Sun Mar 26 2006 - 11:51
-;; Time-stamp: <2010-07-07 14:30:07EDT combination.lisp>
+;; Time-stamp: <2010-07-15 23:06:33EDT combination.lisp>
 ;;
-;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
+;; Copyright 2006, 2007, 2008, 2009, 2010 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
 ;;
 ;; This program is free software: you can redistribute it and/or modify
@@ -94,19 +94,29 @@
   "Initialize the combination c to the lexicographically
    last combination, i.e. (n-k,n-k+1,...,n-1).")
 
-(defmfun grid::copy-to-destination ((source combination) (destination combination))
+(defmfun comb-copy (source destination)
   "gsl_combination_memcpy"
   (((mpointer destination) :pointer)
    ((mpointer source) :pointer))
-  :definition :method
   :inputs (source)
   :outputs (destination)
   :return (destination)
-  :index copy
+  :export nil
+  :index grid:copy
   :documentation			; FDL
   "Copy the elements of the combination source into the
   combination destination.  The two combinations must have the same size.")
 
+(defmethod grid:copy
+    ((source combination) &rest args &key grid-type destination &allow-other-keys)
+  (if grid-type
+      (call-next-method)
+      (comb-copy
+       source
+       :destination
+       (or destination
+	   (make-combination (combination-range source) (size source))))))
+
 ;;;;****************************************************************************
 ;;;; Combination properties
 ;;;;****************************************************************************
diff --git a/data/permutation.lisp b/data/permutation.lisp
index 5073620a..bcaa660c 100644
--- a/data/permutation.lisp
+++ b/data/permutation.lisp
@@ -1,8 +1,8 @@
 ;; Permutations
 ;; Liam Healy, Sun Mar 26 2006 - 11:51
-;; Time-stamp: <2010-07-14 10:27:05EDT permutation.lisp>
+;; Time-stamp: <2010-07-15 23:05:04EDT permutation.lisp>
 ;;
-;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
+;; Copyright 2006, 2007, 2008, 2009, 2010 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
 ;;
 ;; This program is free software: you can redistribute it and/or modify
@@ -79,19 +79,26 @@
   "Initialize the permutation p to the identity, i.e.
    (0,1,2,...,n-1).")
 
-(defmfun grid::copy-to-destination ((source permutation) (destination permutation))
+(defmfun perm-copy (source destination)
   "gsl_permutation_memcpy"
   (((mpointer destination) :pointer)
    ((mpointer source) :pointer))
-  :definition :method
   :inputs (source)
   :outputs (destination)
   :return (destination)
-  :index copy
+  :export nil
+  :index grid:copy
   :documentation			; FDL
   "Copy the elements of the permutation source into the
    permutation destination.  The two permutations must have the same size.")
 
+(defmethod grid:copy
+    ((source permutation) &rest args &key grid-type destination &allow-other-keys)
+  (if grid-type
+      (call-next-method)
+      (perm-copy
+       source :destination (or destination (make-permutation (size source))))))
+
 (defmfun swap-elements ((p permutation) i j)
   "gsl_permutation_swap"
   (((mpointer p) :pointer) (i sizet) (j sizet))
diff --git a/histogram/histogram.lisp b/histogram/histogram.lisp
index 50857f37..50aae82e 100644
--- a/histogram/histogram.lisp
+++ b/histogram/histogram.lisp
@@ -1,8 +1,8 @@
 ;; The histogram structure
 ;; Liam Healy, Mon Jan  1 2007 - 11:32
-;; Time-stamp: <2010-07-07 14:30:30EDT histogram.lisp>
+;; Time-stamp: <2010-07-15 22:27:24EDT histogram.lisp>
 ;;
-;; Copyright 2007, 2008, 2009 Liam M. Healy
+;; Copyright 2007, 2008, 2009, 2010 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
 ;;
 ;; This program is free software: you can redistribute it and/or modify
@@ -79,40 +79,52 @@
   :definition :method
   :return (histogram))
 
-(defmfun grid::copy-to-destination ((source histogram) (destination histogram))
+(defmfun histo-copy (source destination)
   "gsl_histogram_memcpy"
   (((mpointer destination) :pointer) ((mpointer source) :pointer))
-  :definition :method
   :return (destination)
-  :index copy
+  :export nil
+  :index grid: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 grid::copy-to-destination ((source histogram2d) (destination histogram2d))
+(defmfun histo-clone (source)
+  "gsl_histogram_clone"
+  (((mpointer source) :pointer))
+  :c-return (crtn :pointer)
+  :return ((make-instance 'histogram :mpointer crtn))
+  :export nil
+  :index grid:copy)
+
+(defmethod grid:copy ((source histogram) &key destination &allow-other-keys)
+  (if destination
+      (histo-clone destination)
+      (histo-copy source)))
+
+(defmfun histo2d-copy (source destination)
   "gsl_histogram2d_memcpy"
   (((mpointer destination) :pointer) ((mpointer source) :pointer))
-  :definition :method
   :return (destination)
-  :index copy
+  :export nil
+  :index grid: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 grid::copy-making-destination ((source histogram))
-  "gsl_histogram_clone"
-  (((mpointer source) :pointer))
-  :definition :method
-  :c-return :pointer
-  :index copy)
-
-(defmfun grid::copy-making-destination ((source histogram2d))
+(defmfun histo2d-clone (source)
   "gsl_histogram2d_clone"
   (((mpointer source) :pointer))
-  :definition :method
-  :c-return :pointer
-  :index copy)
+  :c-return (crtn :pointer)
+  :return ((make-instance 'histogram2d :mpointer crtn))
+  :export nil
+  :index grid:copy)
+
+(defmethod grid:copy ((source histogram2d) &key destination &allow-other-keys)
+  (if destination
+      (histo2d-clone destination)
+      (histo2d-copy source)))
diff --git a/init/forms.lisp b/init/forms.lisp
index f72054e4..31c22932 100644
--- a/init/forms.lisp
+++ b/init/forms.lisp
@@ -1,8 +1,8 @@
 ;; Lisp forms
 ;; Liam Healy 2009-03-07 15:49:25EST forms.lisp
-;; Time-stamp: <2010-07-13 22:32:44EDT forms.lisp>
+;; Time-stamp: <2010-07-15 22:18:06EDT forms.lisp>
 ;;
-;; Copyright 2009 Liam M. Healy
+;; Copyright 2009, 2010 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
 ;;
 ;; This program is free software: you can redistribute it and/or modify
@@ -24,7 +24,7 @@
 ;;;; Arglists
 ;;;;****************************************************************************
 
-(defparameter *defmfun-llk* '(&optional &key &aux &rest)
+(defparameter *defmfun-llk* '(&optional &key &aux &rest &allow-other-keys)
   "Possible lambda-list keywords.")
 
 (defparameter *defmfun-optk* '(&optional &key)
diff --git a/init/init.lisp b/init/init.lisp
index dac4fbc6..e072aae1 100644
--- a/init/init.lisp
+++ b/init/init.lisp
@@ -1,6 +1,6 @@
 ;; Load GSL
 ;; Liam Healy Sat Mar  4 2006 - 18:53
-;; Time-stamp: <2010-07-01 21:39:45EDT init.lisp>
+;; Time-stamp: <2010-07-15 22:26:30EDT init.lisp>
 ;;
 ;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
@@ -25,11 +25,11 @@
    :grid
    #:cl-array #:dimensions #:element-type
    #:foreign-array #:matrix #:dim0 #:dim1 #:^
-   #:copy #:clone)
+   #:copy)
   (:shadowing-import-from :grid #:foreign-pointer)
   (:export
    #:cl-array #:dimensions #:element-type #:dim0 #:dim1
-   #:copy #:clone))
+   #:copy))
 
 (cffi:define-foreign-library libgslcblas
     (:darwin
diff --git a/init/mobject.lisp b/init/mobject.lisp
index df8f5841..78d28832 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: <2010-07-11 17:07:40EDT mobject.lisp>
+;; Time-stamp: <2010-07-15 22:33:56EDT mobject.lisp>
 ;;
 ;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
@@ -345,29 +345,3 @@
 (export 'order)
 (defgeneric order (object)
   (:documentation "The order of the GSL object."))
-
-;;;;****************************************************************************
-;;;; Making objects from existing objects
-;;;;****************************************************************************
-
-#|
-(defmethod grid::copy-making-destination :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,
-      (if (typep object 'grid:foreign-array)
-	  (call-next-method)
-	  (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))))
-
-(defmethod grid:clone :around ((object mobject))
-  (make-instance (class-of object) :mpointer (call-next-method)))
-|#
diff --git a/random/generators.lisp b/random/generators.lisp
index 045b245b..e938813e 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: <2010-07-07 14:30:30EDT generators.lisp>
+;; Time-stamp: <2010-07-15 22:43:39EDT generators.lisp>
 ;;
 ;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
@@ -176,23 +176,29 @@
 ;;;; Copying state
 ;;;;****************************************************************************
 
-(defmfun grid::copy-to-destination
-    ((source random-number-generator) (destination random-number-generator))
+(defmfun rng-copy (source destination)
   "gsl_rng_memcpy"
   (((mpointer destination) :pointer) ((mpointer source) :pointer))
-  :definition :method
-  :index copy
+  :export nil
+  :index grid: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 grid::copy-making-destination ((instance random-number-generator))
-  "gsl_rng_clone" (((mpointer instance) :pointer))
-  :definition :method
-  :c-return :pointer
-  :index copy)
+(defmfun rng-clone (source)
+  "gsl_rng_clone" (((mpointer source) :pointer))
+  :c-return (crtn :pointer)
+  :return ((make-instance 'random-number-generator :mpointer crtn))
+  :export nil
+  :index grid:copy)
+
+(defmethod grid:copy
+    ((source random-number-generator) &key destination &allow-other-keys)
+  (if destination
+      (rng-clone destination)
+      (rng-copy source)))
 
 ;;;;****************************************************************************
 ;;;; Examples and unit test
diff --git a/random/quasi.lisp b/random/quasi.lisp
index 6544eba2..2def9355 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: <2010-07-07 14:30:06EDT quasi.lisp>
+;; Time-stamp: <2010-07-15 22:41:48EDT quasi.lisp>
 ;;
 ;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
@@ -64,23 +64,28 @@
   :export nil
   :index gsl-random-state)
 
-(defmfun grid::copy-to-destination
-    ((source quasi-random-number-generator)
-     (destination quasi-random-number-generator))
+(defmfun quasi-copy (source destination)
   "gsl_qrng_memcpy"
   (((mpointer destination) :pointer) ((mpointer source) :pointer))
-  :definition :method
-  :index copy
+  :export nil
+  :index grid: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 grid::copy-making-destination ((instance quasi-random-number-generator))
+(defmfun quasi-clone (instance)
   "gsl_qrng_clone" (((mpointer instance) :pointer))
-  :definition :method
-  :c-return :pointer
-  :index copy)
+  :c-return (crtn :pointer)
+  :return ((make-instance 'quasi-random-number-generator :mpointer crtn))
+  :export nil
+  :index grid:copy)
+
+(defmethod grid:copy
+    ((source quasi-random-number-generator) &key destination &allow-other-keys)
+  (if destination
+      (quasi-clone destination)
+      (quasi-copy source)))
 
 (def-rng-type +niederreiter2+
     ;; FDL
diff --git a/tests/permutation.lisp b/tests/permutation.lisp
index 2ddb2375..435f0eb7 100644
--- a/tests/permutation.lisp
+++ b/tests/permutation.lisp
@@ -1,6 +1,6 @@
 ;; Regression test PERMUTATION for GSLL, automatically generated
 ;;
-;; Copyright 2009 Liam M. Healy
+;; Copyright 2009, 2010 Liam M. Healy
 ;; Distributed under the terms of the GNU General Public License
 ;;
 ;; This program is free software: you can redistribute it and/or modify
@@ -19,30 +19,22 @@
 (in-package :gsl)
 
 (LISP-UNIT:DEFINE-TEST PERMUTATION
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 2)
-				     (MULTIPLE-VALUE-LIST
-				      (LET ((PERM-1
-					     (MAKE-PERMUTATION
-					      4 T)))
-					(grid:gref PERM-1
-						   2))))
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(0 1 2 3))
-				     (MULTIPLE-VALUE-LIST
-				      (LET ((PERM-1
-					     (MAKE-PERMUTATION
-					      4 T)))
-					(GRID:COPY-TO
-					 PERM-1))))
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(3 2 1 0))
-				     (MULTIPLE-VALUE-LIST
-				      (LET ((PERM-1
-					     (MAKE-PERMUTATION
-					      4 T)))
-					(SET-IDENTITY
-					 PERM-1)
-					(GRID:COPY-TO
-					 (PERMUTATION-REVERSE
-					  PERM-1)))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST 2)
+   (MULTIPLE-VALUE-LIST
+    (LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
+      (grid:gref PERM-1 2))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST #(0 1 2 3))
+   (MULTIPLE-VALUE-LIST
+    (LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
+      (GRID:COPY-TO PERM-1))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST #(3 2 1 0))
+   (MULTIPLE-VALUE-LIST
+    (LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
+      (SET-IDENTITY PERM-1)
+      (GRID:COPY-TO (PERMUTATION-REVERSE PERM-1)))))
   (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
    (LIST #(0 3 1 2))
    (MULTIPLE-VALUE-LIST
@@ -53,72 +45,44 @@
       (permutation-next perm-1)
       (permutation-next perm-1)
       (grid:copy-to (permutation-inverse perm-1)))))
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(0 3 2 1))
-				     (MULTIPLE-VALUE-LIST
-				      (LET ((PERM-1
-					     (MAKE-PERMUTATION
-					      4 T)))
-					(SET-IDENTITY
-					 PERM-1)
-					(SWAP-ELEMENTS
-					 PERM-1 1 3)
-					(GRID:COPY-TO
-					 PERM-1))))
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(33 44 11 22))
-				     (MULTIPLE-VALUE-LIST
-				      (LET ((PERM-1
-					     (MAKE-PERMUTATION
-					      4 T))
-					    (INTVEC
-					     (GRID:MAKE-FOREIGN-ARRAY
-					      '(SIGNED-BYTE
-						32)
-					      :INITIAL-CONTENTS
-					      '(11 22 33
-						44))))
-					(SET-IDENTITY
-					 PERM-1)
-					(SWAP-ELEMENTS
-					 PERM-1 1 3)
-					(SWAP-ELEMENTS
-					 PERM-1 0 2)
-					(PERMUTE
-					 PERM-1 INTVEC)
-					(GRID:COPY-TO
-					 INTVEC))))
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 3)
-				     (MULTIPLE-VALUE-LIST
-				      (LET ((PERM-1
-					     (MAKE-PERMUTATION
-					      4 T)))
-					(SET-IDENTITY
-					 PERM-1)
-					(SWAP-ELEMENTS
-					 PERM-1 1 3)
-					(INVERSIONS
-					 PERM-1))))
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 3)
-				     (MULTIPLE-VALUE-LIST
-				      (LET ((PERM-1
-					     (MAKE-PERMUTATION
-					      4 T)))
-					(SET-IDENTITY
-					 PERM-1)
-					(SWAP-ELEMENTS
-					 PERM-1 1 3)
-					(LINEAR-CYCLES
-					 PERM-1))))
-  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 2)
-				     (MULTIPLE-VALUE-LIST
-				      (LET ((PERM-1
-					     (MAKE-PERMUTATION
-					      4 T)))
-					(SET-IDENTITY
-					 PERM-1)
-					(SWAP-ELEMENTS
-					 PERM-1 1 3)
-					(SWAP-ELEMENTS
-					 PERM-1 0 2)
-					(CANONICAL-CYCLES
-					 PERM-1)))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST #(0 3 2 1))
+   (MULTIPLE-VALUE-LIST
+    (LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
+      (SET-IDENTITY PERM-1)
+      (SWAP-ELEMENTS PERM-1 1 3)
+      (GRID:COPY-TO PERM-1))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST #(33 44 11 22))
+   (MULTIPLE-VALUE-LIST
+    (LET ((PERM-1 (MAKE-PERMUTATION 4 T))
+	  (INTVEC (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32)
+					   :INITIAL-CONTENTS '(11 22 33 44))))
+      (SET-IDENTITY PERM-1)
+      (SWAP-ELEMENTS PERM-1 1 3)
+      (SWAP-ELEMENTS PERM-1 0 2)
+      (PERMUTE PERM-1 INTVEC)
+      (GRID:COPY-TO INTVEC))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST 3)
+   (MULTIPLE-VALUE-LIST
+    (LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
+      (SET-IDENTITY PERM-1)
+      (SWAP-ELEMENTS PERM-1 1 3)
+      (INVERSIONS PERM-1))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST 3)
+   (MULTIPLE-VALUE-LIST
+    (LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
+      (SET-IDENTITY PERM-1)
+      (SWAP-ELEMENTS PERM-1 1 3)
+      (LINEAR-CYCLES PERM-1))))
+  (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
+   (LIST 2)
+   (MULTIPLE-VALUE-LIST
+    (LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
+      (SET-IDENTITY PERM-1)
+      (SWAP-ELEMENTS PERM-1 1 3)
+      (SWAP-ELEMENTS PERM-1 0 2)
+      (CANONICAL-CYCLES PERM-1)))))
 
-- 
GitLab