diff --git a/data/array-tests.lisp b/data/array-tests.lisp index 76270b3b2c01da6c1d748f577bc921281f4df5d1..5b65ab4a1111b3568f5e8d0d169c44ca87348e83 100644 --- a/data/array-tests.lisp +++ b/data/array-tests.lisp @@ -1,6 +1,6 @@ ;; Tests of array functions ;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp -;; Time-stamp: <2009-01-05 22:26:34EST array-tests.lisp> +;; Time-stamp: <2009-01-11 22:19:58EST array-tests.lisp> ;; $Id: $ ;;; Generate each file with #'write-test-to-file, e.g. @@ -38,16 +38,10 @@ (cl-array m1))) (generate-all-array-tests vector-copy t - (let ((v1 (array-default 3)) - (v2 (array-default 3 t))) - (copy v2 v1) - (cl-array v2))) + (cl-array (copy (array-default 3)))) (generate-all-array-tests matrix-copy t - (let ((m1 (array-default '(3 3))) - (m2 (array-default '(3 3) t))) - (copy m2 m1) - (cl-array m2))) + (cl-array (copy (array-default '(3 3))))) (generate-all-array-tests vector-swap t (let ((v1 (array-default 3)) diff --git a/data/both.lisp b/data/both.lisp index 8a853009d050d3ca36c406c0347c1978db423bc5..b7cc72f02c333c867a9c756a5b0762805412bed1 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-01-04 11:30:47EST both.lisp> +;; Time-stamp: <2009-01-11 22:37:48EST both.lisp> ;; $Id$ (in-package :gsl) @@ -53,15 +53,16 @@ :c-return :void :documentation "Set all elements to 0.") -(defmfun copy ((destination both) (source both)) +(defmfun copy + ((source both) + &optional + (destination + (make-marray element-type :dimensions (dimensions source)))) ("gsl_" :category :type "_memcpy") (((mpointer destination) :pointer) ((mpointer source) :pointer)) - :definition :generic + :definition :methods :inputs (source) - :outputs (destination) - :documentation ; FDL - "Copy the elements of the source into the - destination. The two must have the same size.") + :outputs (destination)) (defmfun swap ((a both) (b both)) ("gsl_" :category :type "_swap") diff --git a/data/combination.lisp b/data/combination.lisp index 5156b3dcba8648e89504226a1931028b3db4da8d..a9832f6f7498aa3cf1387e720b1ae3654a4335c2 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-01-11 14:23:51EST combination.lisp> +;; Time-stamp: <2009-01-11 21:18:14EST combination.lisp> ;; $Id$ (in-package :gsl) @@ -79,13 +79,15 @@ "Initialize the combination c to the lexicographically last combination, i.e. (n-k,n-k+1,...,n-1).") -(defmfun copy (destination source) +(defmfun copy-to-destination ((source permutation) (destination permutation)) "gsl_combination_memcpy" (((mpointer destination) :pointer) ((mpointer source) :pointer)) :definition :method :inputs (source) :outputs (destination) + :return (destination) + :index copy :documentation ; FDL "Copy the elements of the combination source into the combination destination. The two combinations must have the same size.") diff --git a/data/permutation.lisp b/data/permutation.lisp index 5c39f75ccccbdd4a64d576dab9d174de3cdeb76c..b1c78118db828be64702dad6061097e62475a9ea 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-01-11 14:18:42EST permutation.lisp> +;; Time-stamp: <2009-01-11 21:18:15EST permutation.lisp> ;; $Id$ (in-package :gsl) @@ -63,7 +63,7 @@ "Initialize the permutation p to the identity, i.e. (0,1,2,...,n-1).") -(defmfun copy ((destination permutation) (source permutation)) +(defmfun copy-to-destination ((source permutation) (destination permutation)) "gsl_permutation_memcpy" (((mpointer destination) :pointer) ((mpointer source) :pointer)) @@ -71,6 +71,7 @@ :inputs (source) :outputs (destination) :return (destination) + :index copy :documentation ; FDL "Copy the elements of the permutation source into the permutation destination. The two permutations must have the same size.") diff --git a/histogram/histogram.lisp b/histogram/histogram.lisp index 2bb5e86d36f2f2e6672fd95f9163dc51eeb03186..280a2b8d9df7e0aed82e42c96493319e2701284f 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: <2008-12-26 12:31:18EST histogram.lisp> +;; Time-stamp: <2009-01-11 22:40:23EST histogram.lisp> ;; $Id$ (in-package :gsl) @@ -65,44 +65,41 @@ :definition :method :return (histogram)) -(defmfun copy ((destination histogram) (source histogram)) +(defmfun copy-to-destination ((source histogram) (destination histogram)) "gsl_histogram_memcpy" (((mpointer destination) :pointer) ((mpointer source) :pointer)) :definition :method :return (destination) + :index 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 copy ((destination histogram2d) (source histogram2d)) +(defmfun copy-to-destination ((source histogram2d) (destination histogram2d)) "gsl_histogram2d_memcpy" (((mpointer destination) :pointer) ((mpointer source) :pointer)) :definition :method :return (destination) + :index 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 clone ((source histogram)) +(defmfun copy-making-destination ((source histogram)) "gsl_histogram_clone" (((mpointer source) :pointer)) :definition :method - :c-return (mptr :pointer) - :return ((make-instance 'histogram :mpointer mptr)) - :documentation ; FDL - "Create a new histogram which is an - exact copy of the histogram source, and return the pointer.") + :c-return :pointer + :index copy) -(defmfun clone (source) +(defmfun copy-making-destination ((source histogram2d)) "gsl_histogram2d_clone" (((mpointer source) :pointer)) :definition :method - :c-return (mptr :pointer) - :return ((make-instance 'histogram2d :mpointer mptr)) - :documentation ; FDL - "Create a new histogram which is an - exact copy of the histogram source, and return the pointer.") + :c-return :pointer + :index copy) + diff --git a/init/defmfun-single.lisp b/init/defmfun-single.lisp index 7aeff7d9bbb35c0d87083c3027ac208189d53c79..46de9da6af14788e04bfe506f82421c7ef186b8c 100644 --- a/init/defmfun-single.lisp +++ b/init/defmfun-single.lisp @@ -1,6 +1,6 @@ ;; Helpers that define a single GSL function interface ;; Liam Healy 2009-01-07 22:02:20EST defmfun-single.lisp -;; Time-stamp: <2009-01-11 10:07:06EST defmfun-single.lisp> +;; Time-stamp: <2009-01-11 22:37:31EST defmfun-single.lisp> ;; $Id: $ (in-package :gsl) @@ -137,7 +137,10 @@ (variables-used-in-c-arguments c-arguments))) (allocated-decl (mapcar - (lambda (s) (find s c-arguments :key #'st-symbol)) + (lambda (s) + (or (find s c-arguments :key #'st-symbol) + ;; Catch programming errors, usually typos + (error "Could not find ~a among the arguments" s))) allocated)) (clret (or ; better as a symbol macro (substitute cret-name :c-return return) diff --git a/init/mobject.lisp b/init/mobject.lisp index 53b58f69ba3388891d850f0dd919ab420fbc1991..5a6160781c3b2ba1d8f795dfcf036714bde1f037 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: <2008-12-29 22:33:11EST mobject.lisp> +;; Time-stamp: <2009-01-11 22:13:07EST mobject.lisp> ;; $Id$ ;;; GSL objects are represented in GSLL as and instance of a 'mobject. @@ -12,6 +12,10 @@ (in-package :gsl) +;;;;**************************************************************************** +;;;; The class definition +;;;;**************************************************************************** + (defclass mobject () ((mpointer :initarg :mpointer :reader mpointer :documentation "A pointer to the GSL representation of the object."))) @@ -117,22 +121,14 @@ (list (intern (symbol-name symbol) :keyword) symbol))) -;;; To make-load-form -;;; (make-basis-spline (bspline-order bspline) (number-of-breakpoints bspline)) -;;; Then initialize by making a vector from (breakpoint i bspline) -;;; and calling knots. +;;;;**************************************************************************** +;;;; Generic functions +;;;;**************************************************************************** (defgeneric allocate (object &key &allow-other-keys) (:documentation "Use GSL to allocate memory. Returns pointer but does not bind mpointer slot.")) -;;; Could be part of copy when the second argument is optional? -(export 'clone) -(defgeneric clone (object) - (:documentation "Create a duplicate object.") - (:method :around ((object mobject)) - (make-instance (class-of object) :mpointer (call-next-method)))) - (export 'name) (defgeneric name (object) (:documentation "The name given to the GSL object.")) @@ -158,3 +154,55 @@ (defmethod mpointer ((object #.+foreign-pointer-class+)) (check-type object #.+foreign-pointer-type+) object) + +;;;;**************************************************************************** +;;;; Making objects from existing objects +;;;;**************************************************************************** + +(export 'copy) +(defgeneric copy (object &optional destination) + (:documentation "Create a duplicate object.") + ;; This method is used for all GSL objects except arrays. + (:method ((object mobject) &optional destination) + (if destination + (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)) + (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, + (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))))) + +;;; Could be part of copy when the second argument is optional? +(export 'clone) +(defgeneric clone (object) + (:documentation "Create a duplicate object.") + (:method :around ((object mobject)) + (make-instance (class-of object) :mpointer (call-next-method)))) + + +;;; To make-load-form +;;; (make-basis-spline (bspline-order bspline) (number-of-breakpoints bspline)) +;;; Then initialize by making a vector from (breakpoint i bspline) +;;; and calling knots. + diff --git a/random/generators.lisp b/random/generators.lisp index 830f311252c971cda50fc2053f94541b9ad59e86..a068776db8e4a93a4e2605d595c6d4602af905d5 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: <2008-12-26 18:17:35EST generators.lisp> +;; Time-stamp: <2009-01-11 23:01:36EST generators.lisp> ;; $Id$ (in-package :gsl) @@ -150,22 +150,23 @@ ;;;; Copying state ;;;;**************************************************************************** -(defmfun copy - ((destination random-number-generator) (source random-number-generator)) +(defmfun copy-to-destination + ((source random-number-generator) (destination random-number-generator)) "gsl_rng_memcpy" (((mpointer destination) :pointer) ((mpointer source) :pointer)) :definition :method + :index 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 clone ((instance random-number-generator)) +(defmfun copy-making-destination ((instance random-number-generator)) "gsl_rng_clone" (((mpointer instance) :pointer)) :definition :method - :c-return (mptr :pointer) - :return ((make-instance 'random-number-generator :mpointer mptr))) + :c-return :pointer + :index copy) ;;;;**************************************************************************** ;;;; Examples and unit test diff --git a/random/quasi.lisp b/random/quasi.lisp index 7f4595add8a9b3c6068abcd5c3458f76e9b474e8..37a016e84530a7faa82a95349c70e79fbe8f74b6 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: <2008-12-27 11:10:20EST quasi.lisp> +;; Time-stamp: <2009-01-11 23:02:11EST quasi.lisp> ;; $Id$ (in-package :gsl) @@ -47,24 +47,23 @@ :export nil :index gsl-random-state) -(defmfun copy - ((destination quasi-random-number-generator) - (source quasi-random-number-generator)) +(defmfun copy-to-destination + ((source quasi-random-number-generator) + (destination quasi-random-number-generator)) "gsl_qrng_memcpy" (((mpointer destination) :pointer) ((mpointer source) :pointer)) :definition :method + :index 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 clone ((instance quasi-random-number-generator)) +(defmfun copy-making-destination ((instance quasi-random-number-generator)) "gsl_qrng_clone" (((mpointer instance) :pointer)) :definition :method - :c-return (mptr :pointer) - :return ((make-instance 'quasi-random-number-generator :mpointer mptr)) - :documentation ; FDL - "Create a new generator which is an exact copy of the original.") + :c-return :pointer + :index copy) (def-rng-type *niederreiter2* ;; FDL diff --git a/tests/matrix-copy.lisp b/tests/matrix-copy.lisp index 5dbee57cb77c5d2c57438985458b12d4b6bead87..e5e51c90bae9fa526d35556f04c2ab0a81e414cc 100644 --- a/tests/matrix-copy.lisp +++ b/tests/matrix-copy.lisp @@ -9,30 +9,23 @@ (-8.93 34.12 -6.15) (49.27 -13.49 32.5))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS - '((-34.5 8.24 3.29) - (-8.93 34.12 -6.15) - (49.27 -13.49 32.5)))) - (M2 - (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS + '((-34.5 8.24 3.29) (-8.93 34.12 -6.15) + (49.27 -13.49 32.5))))))) (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 - (LET ((M1 - (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '((-34.5d0 8.24d0 3.29d0) - (-8.93d0 34.12d0 -6.15d0) - (49.27d0 -13.49d0 32.5d0)))) - (M2 - (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '((-34.5d0 8.24d0 3.29d0) + (-8.93d0 34.12d0 -6.15d0) + (49.27d0 -13.49d0 32.5d0))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(-34.5 8.24) #C(3.29 -8.93) #C(34.12 -6.15)) @@ -40,20 +33,14 @@ (#C(49.27 -13.49) #C(32.5 42.73) #C(-17.24 43.31)))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(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)))) - (M2 - (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) - :DIMENSIONS '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(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))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0) @@ -63,123 +50,78 @@ (#C(49.27d0 -13.49d0) #C(32.5d0 42.73d0) #C(-17.24d0 43.31d0)))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(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)))) - (M2 - (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) - :DIMENSIONS '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(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))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123)))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 8) :DIMENSIONS - '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS + '((-64 -68 71) (-91 52 -10) + (73 -5 123))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((67 44 189) (116 163 140) (161 215 98))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 8) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98)))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 8) :DIMENSIONS - '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(UNSIGNED-BYTE 8) :INITIAL-CONTENTS + '((67 44 189) (116 163 140) + (161 215 98))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 16) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123)))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS - '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(SIGNED-BYTE 16) :INITIAL-CONTENTS + '((-64 -68 71) (-91 52 -10) + (73 -5 123))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((67 44 189) (116 163 140) (161 215 98))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 16) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98)))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 16) :DIMENSIONS - '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(UNSIGNED-BYTE 16) :INITIAL-CONTENTS + '((67 44 189) (116 163 140) + (161 215 98))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 32) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123)))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS - '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(SIGNED-BYTE 32) :INITIAL-CONTENTS + '((-64 -68 71) (-91 52 -10) + (73 -5 123))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((67 44 189) (116 163 140) (161 215 98))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 32) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98)))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 32) :DIMENSIONS - '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) - #+int64 + (CL-ARRAY + (COPY + (MAKE-MARRAY '(UNSIGNED-BYTE 32) :INITIAL-CONTENTS + '((67 44 189) (116 163 140) + (161 215 98))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((-64 -68 71) (-91 52 -10) (73 -5 123))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 64) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123)))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS - '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2)))) - #+int64 + (CL-ARRAY + (COPY + (MAKE-MARRAY '(SIGNED-BYTE 64) :INITIAL-CONTENTS + '((-64 -68 71) (-91 52 -10) + (73 -5 123))))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((67 44 189) (116 163 140) (161 215 98))) (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 64) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98)))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 64) :DIMENSIONS - '(3 3)))) - (COPY M2 M1) - (CL-ARRAY M2))))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(UNSIGNED-BYTE 64) :INITIAL-CONTENTS + '((67 44 189) (116 163 140) + (161 215 98)))))))) diff --git a/tests/vector-copy.lisp b/tests/vector-copy.lisp index de9548ae9b3002fb402eae5156bd85f0f9c88d5d..322a669fa28d91e80a84a2121cffeb477c14112e 100644 --- a/tests/vector-copy.lisp +++ b/tests/vector-copy.lisp @@ -6,185 +6,107 @@ (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-34.5 8.24 3.29)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS - '(-34.5 8.24 3.29))) - (V2 (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS + '(-34.5 8.24 3.29)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-34.5d0 8.24d0 3.29d0)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(-34.5d0 8.24d0 3.29d0))) - (V2 (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(-34.5d0 8.24d0 3.29d0)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(-34.5 8.24) #C(3.29 -8.93) #C(34.12 -6.15))) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) - :INITIAL-CONTENTS - '(-34.5 8.24 3.29 -8.93 34.12 - -6.15))) - (V2 - (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) - :DIMENSIONS '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) + :INITIAL-CONTENTS + '(-34.5 8.24 3.29 -8.93 34.12 + -6.15)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0) #C(34.12d0 -6.15d0))) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) - :INITIAL-CONTENTS - '(-34.5d0 8.24d0 3.29d0 -8.93d0 - 34.12d0 -6.15d0))) - (V2 - (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) - :DIMENSIONS '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) + :INITIAL-CONTENTS + '(-34.5d0 8.24d0 3.29d0 -8.93d0 34.12d0 + -6.15d0)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(SIGNED-BYTE - 8) - :INITIAL-CONTENTS - '(-64 -68 - 71))) - (V2 - (MAKE-MARRAY - '(SIGNED-BYTE - 8) - :DIMENSIONS - '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY + '(SIGNED-BYTE 8) + :INITIAL-CONTENTS + '(-64 -68 + 71)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 8) - :INITIAL-CONTENTS - '(67 44 - 189))) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 8) - :DIMENSIONS - '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY + '(UNSIGNED-BYTE + 8) + :INITIAL-CONTENTS + '(67 44 189)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(SIGNED-BYTE - 16) - :INITIAL-CONTENTS - '(-64 -68 - 71))) - (V2 - (MAKE-MARRAY - '(SIGNED-BYTE - 16) - :DIMENSIONS - '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY + '(SIGNED-BYTE 16) + :INITIAL-CONTENTS + '(-64 -68 + 71)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 16) - :INITIAL-CONTENTS - '(67 44 - 189))) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 16) - :DIMENSIONS - '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY + '(UNSIGNED-BYTE + 16) + :INITIAL-CONTENTS + '(67 44 189)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(SIGNED-BYTE - 32) - :INITIAL-CONTENTS - '(-64 -68 - 71))) - (V2 - (MAKE-MARRAY - '(SIGNED-BYTE - 32) - :DIMENSIONS - '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) + (CL-ARRAY + (COPY + (MAKE-MARRAY + '(SIGNED-BYTE 32) + :INITIAL-CONTENTS + '(-64 -68 + 71)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 32) - :INITIAL-CONTENTS - '(67 44 - 189))) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 32) - :DIMENSIONS - '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) - #+int64 + (CL-ARRAY + (COPY + (MAKE-MARRAY + '(UNSIGNED-BYTE + 32) + :INITIAL-CONTENTS + '(67 44 189)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(-64 -68 71)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(SIGNED-BYTE - 64) - :INITIAL-CONTENTS - '(-64 -68 - 71))) - (V2 - (MAKE-MARRAY - '(SIGNED-BYTE - 64) - :DIMENSIONS - '3))) - (COPY V2 V1) - (CL-ARRAY V2)))) - #+int64 + (CL-ARRAY + (COPY + (MAKE-MARRAY + '(SIGNED-BYTE 64) + :INITIAL-CONTENTS + '(-64 -68 + 71)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(67 44 189)) (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 64) - :INITIAL-CONTENTS - '(67 44 - 189))) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 64) - :DIMENSIONS - '3))) - (COPY V2 V1) - (CL-ARRAY V2))))) + (CL-ARRAY + (COPY + (MAKE-MARRAY + '(UNSIGNED-BYTE + 64) + :INITIAL-CONTENTS + '(67 44 189)))))))