diff --git a/data/copy-cl.lisp b/data/copy-cl.lisp deleted file mode 100644 index dc326882cb0a061690ff8b22a54cb78ea099aa4e..0000000000000000000000000000000000000000 --- a/data/copy-cl.lisp +++ /dev/null @@ -1,96 +0,0 @@ -;; Copy grid:foreign-arrays to/from CL arrays -;; Liam Healy 2009-02-11 19:28:44EST copy-cl.lisp -;; Time-stamp: <2010-06-30 19:57:28EDT copy-cl.lisp> -;; -;; Copyright 2009 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 -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; The function #'copy can be used to copy the contents to or from a -;;; CL array. If the destination isn't literally supplied, it can be -;;; a symbol 'array indicating that the grid:foreign-array is to be copied to a CL -;;; array, or an element type like 'double-float, indicating the -;;; contents of the CL array is to be copied to a new grid:foreign-array with the -;;; given element type. - -;;; Contrast this with the function #'cl-array or the initarg -;;; :cl-array to #'grid:make-foreign-array. The function returns the cl-array -;;; without copying, and so might be faster but also makes the -;;; original grid:foreign-array object vulnerable if an element is changed, which -;;; officially has unpredictable results. Likewise, the initarg will -;;; use the given CL array directly in the created grid:foreign-array without -;;; copying. - -(in-package :gsl) - -;;; These make destination but are methods of copy-to-destination so -;;; that the class argument may be supplied. - -(defmethod grid:copy-to-destination ((source mvector) (destination array)) - (unless (equal (dimensions source) (array-dimensions destination)) - (error 'grid:array-mismatch)) - (loop for i below (dim0 source) - do (setf (aref destination i) (grid:gref source i))) - destination) - -(defmethod grid:copy-to-destination ((source matrix) (destination array)) - (unless (equal (dimensions source) (array-dimensions destination)) - (error 'grid:array-mismatch)) - (loop for i below (dim0 source) do - (loop for j below (dim1 source) do - (setf (aref destination i j) (grid:gref source i j)))) - destination) - -(defmethod grid:copy-to-destination ((source array) (destination mvector)) - (unless (equal (array-dimensions source) (dimensions destination)) - (error 'grid:array-mismatch)) - (loop for i below (length source) - do (setf (grid:gref destination i) (aref source i))) - destination) - -(defmethod grid:copy-to-destination ((source array) (destination matrix)) - (unless (equal (array-dimensions source) (dimensions destination)) - (error 'grid:array-mismatch)) - (loop for i below (array-dimension source 0) do - (loop for j below (array-dimension source 1) do - (setf (grid:gref destination i j) (aref source i j)))) - destination) - -(defmethod grid:copy-to-destination ((source grid:foreign-array) (destclass (eql 'array))) - (let ((destination - (grid:make-ffa (element-type source) :dimensions (dimensions source)))) - (grid:copy-to-destination source destination))) - -;;; Copy to a named grid:foreign-array element-type, where the type is a symbol -(defmethod grid:copy-to-destination ((source array) (destclass symbol)) - (let ((destination - (grid:make-foreign-array destclass :dimensions (array-dimensions source)))) - (grid:copy-to-destination source destination))) - -;;; Copy to a named grid:foreign-array element-type, where the type is a list -(defmethod grid:copy-to-destination ((source array) (destclass list)) - (let ((destination - (grid:make-foreign-array destclass :dimensions (array-dimensions source)))) - (grid:copy-to-destination source destination))) - -;;; Examples and tests - -(generate-all-array-tests vector-copy-to-cl-and-back t - (cl-array (copy (copy (array-default 3) 'array) 'default-element-type))) - -(generate-all-array-tests matrix-copy-to-cl-and-back t - (cl-array (copy (copy (array-default '(3 3)) 'array) 'default-element-type))) - - diff --git a/gsll-tests.asd b/gsll-tests.asd index 53c62b4cadcbb8cd2891200a8da39ebc9c41e349..203910cb1703ca3e95edf3f95d41c57b868dbb96 100644 --- a/gsll-tests.asd +++ b/gsll-tests.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2010-05-22 18:08:01EDT gsll-tests.asd> +;; Time-stamp: <2010-07-06 22:26:35EDT gsll-tests.asd> ;; ;; Copyright 2007, 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -113,7 +113,6 @@ (:file "mathematical") (:file "mathieu") (:file "matrix-copy") - (:file "matrix-copy-to-cl-and-back") (:file "matrix-div") (:file "matrix-max-index") (:file "matrix-max") @@ -194,7 +193,6 @@ (:file "transport") (:file "trigonometry") (:file "vector-copy") - (:file "vector-copy-to-cl-and-back") (:file "vector-div") (:file "vector-max-index") (:file "vector-max") diff --git a/gsll.asd b/gsll.asd index 3e5133ef7644b66b593f09aadbfc357251f1326f..7fa043974d8b759ee939f781e88a0da70534f917 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2010-06-29 21:42:42EDT gsll.asd> +;; Time-stamp: <2010-07-06 22:26:15EDT gsll.asd> ;; ;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -78,7 +78,6 @@ (:file "vector" :depends-on ("foreign-array" "array-structs")) (:file "matrix" :depends-on ("foreign-array" "vector" "array-structs")) (:file "both" :depends-on ("foreign-array" "vector" "matrix")) - ;(:file "copy-cl") (:file "array-tests" :depends-on ("both")) (:file "permutation" :depends-on ("foreign-array" "array-structs")) (:file "combination" :depends-on ("foreign-array" "array-structs")))) diff --git a/linear-algebra/matrix-generation.lisp b/linear-algebra/matrix-generation.lisp index 9430e1f291c2d81c77ef1f9d367d1d1663152cca..cbee5404afe4cc98b885875ee92609415711668c 100644 --- a/linear-algebra/matrix-generation.lisp +++ b/linear-algebra/matrix-generation.lisp @@ -1,6 +1,6 @@ ;; Generate matrices used in tests of linear algebra functions ;; Liam Healy 2009-09-19 18:28:31EDT matrix-generation.lisp -;; Time-stamp: <2010-06-29 22:15:24EDT matrix-generation.lisp> +;; Time-stamp: <2010-07-06 22:29:07EDT matrix-generation.lisp> ;; ;; Copyright 2009, 2010 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -38,7 +38,8 @@ based on a function of the element indices i, j." (grid:map-grid :source function - :destination-gtype `((foreign-array ,(if dim1 2 1)) ,element-type) + :destination-specification + `((foreign-array ,dim0 ,dim1) ,element-type) :source-dims (if dim1 (list dim0 dim1) (list dim0)))) (defun constant-matrix diff --git a/tests/matrix-copy-to-cl-and-back.lisp b/tests/matrix-copy-to-cl-and-back.lisp deleted file mode 100644 index 821bc5dffed32c6db3e9b4bf11e097e9064fb6dd..0000000000000000000000000000000000000000 --- a/tests/matrix-copy-to-cl-and-back.lisp +++ /dev/null @@ -1,183 +0,0 @@ -;; Regression test MATRIX-COPY-TO-CL-AND-BACK for GSLL, automatically generated -;; -;; Copyright 2009 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 -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -(in-package :gsl) - -(LISP-UNIT:DEFINE-TEST MATRIX-COPY-TO-CL-AND-BACK - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #2A((-34.5 8.24 3.29) - (-8.93 34.12 -6.15) - (49.27 -13.49 32.5))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS - '((-34.5 8.24 3.29) - (-8.93 34.12 -6.15) - (49.27 -13.49 32.5))) - 'ARRAY) - 'SINGLE-FLOAT)))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #2A((-34.5d0 8.24d0 3.29d0) - (-8.93d0 34.12d0 -6.15d0) - (49.27d0 -13.49d0 32.5d0))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '((-34.5d0 8.24d0 3.29d0) - (-8.93d0 34.12d0 -6.15d0) - (49.27d0 -13.49d0 32.5d0))) - 'ARRAY) - 'DOUBLE-FLOAT)))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #2A((#C(-34.5 8.24) #C(3.29 -8.93) #C(34.12 -6.15)) - (#C(-8.93 34.12) #C(-6.15 49.27) #C(-13.49 32.5)) - (#C(49.27 -13.49) #C(32.5 42.73) - #C(-17.24 43.31)))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(COMPLEX SINGLE-FLOAT) - :INITIAL-CONTENTS - '((-34.5 8.24 3.29 -8.93 34.12 -6.15) - (-8.93 34.12 -6.15 49.27 -13.49 - 32.5) - (49.27 -13.49 32.5 42.73 -17.24 - 43.31))) - 'ARRAY) - '(COMPLEX SINGLE-FLOAT))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #2A((#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0) - #C(34.12d0 -6.15d0)) - (#C(-8.93d0 34.12d0) #C(-6.15d0 49.27d0) - #C(-13.49d0 32.5d0)) - (#C(49.27d0 -13.49d0) #C(32.5d0 42.73d0) - #C(-17.24d0 43.31d0)))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(COMPLEX DOUBLE-FLOAT) - :INITIAL-CONTENTS - '((-34.5d0 8.24d0 3.29d0 -8.93d0 - 34.12d0 -6.15d0) - (-8.93d0 34.12d0 -6.15d0 49.27d0 - -13.49d0 32.5d0) - (49.27d0 -13.49d0 32.5d0 42.73d0 - -17.24d0 43.31d0))) - 'ARRAY) - '(COMPLEX DOUBLE-FLOAT))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))) - 'ARRAY) - '(SIGNED-BYTE 8))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((67 44 189) (116 163 140) (161 215 98))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(UNSIGNED-BYTE 8) :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))) - 'ARRAY) - '(UNSIGNED-BYTE 8))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 16) :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))) - 'ARRAY) - '(SIGNED-BYTE 16))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((67 44 189) (116 163 140) (161 215 98))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(UNSIGNED-BYTE 16) :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))) - 'ARRAY) - '(UNSIGNED-BYTE 16))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32) :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))) - 'ARRAY) - '(SIGNED-BYTE 32))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((67 44 189) (116 163 140) (161 215 98))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(UNSIGNED-BYTE 32) :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))) - 'ARRAY) - '(UNSIGNED-BYTE 32))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 64) :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))) - 'ARRAY) - '(SIGNED-BYTE 64))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((67 44 189) (116 163 140) (161 215 98))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(UNSIGNED-BYTE 64) :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))) - 'ARRAY) - '(UNSIGNED-BYTE 64)))))) - diff --git a/tests/vector-copy-to-cl-and-back.lisp b/tests/vector-copy-to-cl-and-back.lisp deleted file mode 100644 index 27554c7e7a0540a617f36d29487c7d95b57fc60f..0000000000000000000000000000000000000000 --- a/tests/vector-copy-to-cl-and-back.lisp +++ /dev/null @@ -1,172 +0,0 @@ -;; Regression test VECTOR-COPY-TO-CL-AND-BACK for GSLL, automatically generated -;; -;; Copyright 2009 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 -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -(in-package :gsl) - -(LISP-UNIT:DEFINE-TEST VECTOR-COPY-TO-CL-AND-BACK - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-34.5 8.24 3.29)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS - '(-34.5 8.24 3.29)) - 'ARRAY) - 'SINGLE-FLOAT)))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-34.5d0 8.24d0 3.29d0)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(-34.5d0 8.24d0 3.29d0)) - 'ARRAY) - 'DOUBLE-FLOAT)))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(#C(-34.5 8.24) #C(3.29 -8.93) #C(34.12 -6.15))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(COMPLEX SINGLE-FLOAT) - :INITIAL-CONTENTS - '(-34.5 8.24 3.29 -8.93 34.12 -6.15)) - 'ARRAY) - '(COMPLEX SINGLE-FLOAT))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #(#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0) - #C(34.12d0 -6.15d0))) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY '(COMPLEX DOUBLE-FLOAT) - :INITIAL-CONTENTS - '(-34.5d0 8.24d0 3.29d0 -8.93d0 - 34.12d0 -6.15d0)) - 'ARRAY) - '(COMPLEX DOUBLE-FLOAT))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY - '(SIGNED-BYTE 8) - :INITIAL-CONTENTS - '(-64 -68 71)) - 'ARRAY) - '(SIGNED-BYTE - 8))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY - '(UNSIGNED-BYTE - 8) - :INITIAL-CONTENTS - '(67 44 189)) - 'ARRAY) - '(UNSIGNED-BYTE - 8))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY - '(SIGNED-BYTE - 16) - :INITIAL-CONTENTS - '(-64 -68 71)) - 'ARRAY) - '(SIGNED-BYTE - 16))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY - '(UNSIGNED-BYTE - 16) - :INITIAL-CONTENTS - '(67 44 189)) - 'ARRAY) - '(UNSIGNED-BYTE - 16))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY - '(SIGNED-BYTE - 32) - :INITIAL-CONTENTS - '(-64 -68 71)) - 'ARRAY) - '(SIGNED-BYTE - 32))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY - '(UNSIGNED-BYTE - 32) - :INITIAL-CONTENTS - '(67 44 189)) - 'ARRAY) - '(UNSIGNED-BYTE - 32))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY - '(SIGNED-BYTE - 64) - :INITIAL-CONTENTS - '(-64 -68 71)) - 'ARRAY) - '(SIGNED-BYTE - 64))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189)) - (MULTIPLE-VALUE-LIST - (CL-ARRAY - (COPY - (COPY - (GRID:MAKE-FOREIGN-ARRAY - '(UNSIGNED-BYTE - 64) - :INITIAL-CONTENTS - '(67 44 189)) - 'ARRAY) - '(UNSIGNED-BYTE - 64)))))) -