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

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