diff --git a/data/maref.lisp b/data/maref.lisp index b5f41a570ff3553a7a4d777d4ba46334c3df3f94..23acf9fbbfbe9cf1a9ffcf01021184087607e81a 100644 --- a/data/maref.lisp +++ b/data/maref.lisp @@ -1,9 +1,10 @@ ;; Get/set array or elements: cl-array, maref ;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp -;; Time-stamp: <2009-12-21 09:42:47EST maref.lisp> +;; Time-stamp: <2009-12-21 14:10:40EST maref.lisp> ;; $Id: $ (in-package :gsl) +(export 'maref) ;;; Normally we won't need to set or get directly from the GSL ;;; vector/matrix pointer. However, it is necessary to have access to @@ -31,16 +32,24 @@ (list (c-array:cl-cffi tp)))))) c-array:*array-element-types*))) -(defmethod maref - ((pointer #.+foreign-pointer-class+) index &optional index2 - (type 'double-float)) - (if index2 - (maref-function-picker +(defgeneric maref (object index &optional index2 type) + (:documentation + "An element of the data. The object may be a foreign-array object, a pointer to + a GSL vector or matrix, or an ordinary CL array of one or two dimensions.") + (:method ((object marray) index &optional index2 type) + (declare (ignore type)) + (if index2 + (grid:gref object index index2) + (grid:gref object index))) + (:method ((pointer #.+foreign-pointer-class+) index &optional index2 + (type 'double-float)) + (if index2 + (maref-function-picker type matrix (:pointer pointer sizet index sizet index2)) - (maref-function-picker + (maref-function-picker type vector - (:pointer pointer sizet index)))) + (:pointer pointer sizet index))))) ;;; Index the GSL function names to maref #.(cons 'progn @@ -60,16 +69,25 @@ 'matrix tp))) c-array:*array-element-types*))) -(defmethod (setf maref) - (value (pointer #.+foreign-pointer-class+) index &optional index2 - (type 'double-float)) - (if index2 - (maref-function-picker - type matrix - (:pointer pointer sizet index sizet index2) value) - (maref-function-picker - type vector - (:pointer pointer sizet index) value))) +(defgeneric (setf maref) (value object index &optional index2 type) + (:documentation + "Set an element of the data. The object may be a foreign-array object, + a pointer to a GSL vector or matrix, or an ordinary CL array + of one or two dimensions.") + (:method (value (object marray) index &optional index2 type) + (declare (ignore type)) + (if index2 + (setf (grid:gref object index index2) value) + (setf (grid:gref object index) value))) + (:method (value (pointer #.+foreign-pointer-class+) index &optional index2 + (type 'double-float)) + (if index2 + (maref-function-picker + type matrix + (:pointer pointer sizet index sizet index2) value) + (maref-function-picker + type vector + (:pointer pointer sizet index) value)))) ;;; Index the GSL function names to (setf maref) #.(cons 'progn diff --git a/data/permutation.lisp b/data/permutation.lisp index d0b13fe2d80b15309e884fed97364ceb388aaa06..5d403fc302230c1805c971895a16f10136125373 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 10:21:32EST permutation.lisp> +;; Time-stamp: <2009-12-21 14:13:53EST permutation.lisp> ;; $Id$ (in-package :gsl) @@ -314,7 +314,7 @@ (save-test permutation (let ((perm-1 (make-permutation 4 t))) ;maref - (maref perm-1 2)) + (grid:gref perm-1 2)) (let ((perm-1 (make-permutation 4 t))) ;cl-array (cl-array perm-1)) (let ((perm-1 (make-permutation 4 t))) ;permutation-reverse diff --git a/grid/element-reference.lisp b/grid/element-reference.lisp index 9c00719273e1211b599287b3f07c004ccc34ba1e..0a652205c0982f2eecc69f0f0958579009a1acdb 100644 --- a/grid/element-reference.lisp +++ b/grid/element-reference.lisp @@ -1,10 +1,10 @@ ;; Get/set array or elements: cl-array, maref ;; Liam Healy 2009-12-21 09:40:27EST element-reference.lisp -;; Time-stamp: <2009-12-21 09:47:31EST element-reference.lisp> +;; Time-stamp: <2009-12-21 13:46:59EST element-reference.lisp> (in-package :c-array) -(export '(cl-array maref)) +(export '(cl-array)) ;;; These functions handle the details of converting between the C ;;; representation of arrays and Common Lisp arrays. The function @@ -40,44 +40,16 @@ object)) ;;;;**************************************************************************** -;;;; Get or set elements of the array: maref, (setf maref) +;;;; Get or set elements of the array: gref, (setf gref) ;;;;**************************************************************************** -(defgeneric maref (object index &optional index2 type) - (:documentation - "An element of the data. The object may be a foreign-array - object or an ordinary CL array of one or two dimensions.") - (:method ((object foreign-array) index &optional index2 type) - (declare (ignore type)) - #-native (copy-c-to-cl object) - (if index2 - (aref (cl-array object) index index2) - (aref (cl-array object) index))) - (:method ((object array) index &optional index2 type) - ;; For compatibility, work on CL arrays as well. - (declare (ignore type)) - (if index2 - (aref object index index2) - (aref object index)))) +(defmethod grid:gref ((object foreign-array) &rest indices) + #-native (copy-c-to-cl object) + (apply 'aref (cl-array object) indices)) ;;; Alternative to complete copy is to mark which elements have ;;; changed and just copy them. Is it worth it? -(defgeneric (setf maref) (value object index &optional index2 type) - (:documentation - "Set an element of the data. The object may be a - foreign-array object or an ordinary CL array of one or two - dimensions.") - (:method (value (object foreign-array) index &optional index2 type) - (declare (ignore type)) - (if index2 - (setf (aref (slot-value object 'cl-array) index index2) value) - (setf (aref (slot-value object 'cl-array) index) value)) - #-native (setf (c-invalid object) t)) - (:method (value (object array) index &optional index2 type) - ;; For compatibility, work on CL arrays as well. - (declare (ignore type)) - (if index2 - (setf (aref object index index2) value) - (setf (aref object index) value)))) - +(defmethod (setf grid:gref) (value (object foreign-array) &rest indices) + (apply '(setf aref) value (cl-array object) indices) + #-native (setf (c-invalid object) t)) diff --git a/grid/foreign-array.lisp b/grid/foreign-array.lisp index 13dc3d06cb4b7be65c402925447ad30940882213..6e903f189e585fa17fe2efc37a7adcfc7a222fef 100644 --- a/grid/foreign-array.lisp +++ b/grid/foreign-array.lisp @@ -1,6 +1,6 @@ ;; Foreign (C or C-compatible) arrays ;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp -;; Time-stamp: <2009-12-21 09:04:05EST foreign-array.lisp> +;; Time-stamp: <2009-12-21 14:02:16EST foreign-array.lisp> (in-package :c-array) @@ -19,7 +19,7 @@ (defgeneric (setf c-invalid) (value object) ; do nothing (:method (value (object t)) value)) -(defclass foreign-array () +(defclass foreign-array (grid:grid) ((cl-array :initarg :cl-array :documentation "The Lisp array.") #-native (c-pointer :accessor c-pointer :documentation "A pointer to the C array.") @@ -60,7 +60,7 @@ total-size (array-total-size cl-array)) #-native (let ((cptr (cffi:foreign-alloc - (c-array:cl-cffi (element-type object)) + (cl-cffi (element-type object)) :count (total-size object)))) (setf (c-pointer object) cptr) (tg:finalize object (lambda () (cffi:foreign-free cptr)))) @@ -71,7 +71,7 @@ (setf original-array oa offset (* index-offset - (cffi:foreign-type-size (c-array:cl-cffi (element-type object)))))))) + (cffi:foreign-type-size (cl-cffi (element-type object)))))))) (defparameter *print-contents* t "Print the contents of the foreign-array.") @@ -96,7 +96,7 @@ (defun element-size (object) "The size of each element as stored in C." - (cffi:foreign-type-size (c-array:cl-cffi (element-type object)))) + (cffi:foreign-type-size (cl-cffi (element-type object)))) ;;;;**************************************************************************** ;;;; Syncronize C and CL @@ -120,7 +120,7 @@ (total-size object)) (setf (c-invalid object) nil))) -;;; Called right before maref +;;; Called right before gref #-native (defun copy-c-to-cl (object) "Copy the C array to the CL array." @@ -138,7 +138,7 @@ "Copy length elements from array (starting at index-offset) of type lisp-type to the memory area that starts at pointer, coercing the elements if necessary." - (let ((cffi-type (c-array:component-type lisp-type))) + (let ((cffi-type (component-type lisp-type))) (loop :repeat length for array-index :from index-offset for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1) @@ -156,7 +156,7 @@ "Copy length elements from array (starting at index-offset) of type lisp-type from the memory area that starts at pointer, coercing the elements if necessary." - (let ((cffi-type (c-array:component-type lisp-type))) + (let ((cffi-type (component-type lisp-type))) (loop :repeat length for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1) for array-index :from index-offset diff --git a/grid/methods.lisp b/grid/methods.lisp new file mode 100644 index 0000000000000000000000000000000000000000..6433e14b9b8c0ce541d73df0930f0d8d4f277175 --- /dev/null +++ b/grid/methods.lisp @@ -0,0 +1,19 @@ +;; Methods for grid functions +;; Liam Healy 2009-12-21 11:19:00EST methods.lisp +;; Time-stamp: <2009-12-21 13:48:59EST methods.lisp> + +(in-package :c-array) + +(defmethod grid:grid-rank ((object foreign-array)) + (length (dimensions object))) + +(defmethod grid:grid-dimensions ((object foreign-array)) + (dimensions object)) + +(defmethod grid:make-grid-data + ((type (eql 'foreign-array)) dimensions rest-spec + &key (initial-element nil initial-element-p)) + ;; Nothing to do here, because the data is inserted in + ;; initialize-instance :after for foreign-array. + nil) + diff --git a/gsll.asd b/gsll.asd index 52ea63b111f9113e3376e30fa594af09b6c88cfe..d340eeec8ab1f628a3b36d0dabd116dc690f33b7 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2009-12-21 10:22:26EST gsll.asd> +;; Time-stamp: <2009-12-21 14:16:54EST gsll.asd> (when (asdf:find-system :fsbv nil) (pushnew :fsbv *features*)) @@ -14,7 +14,7 @@ :version "0" :author "Liam M. Healy" :licence "LLGPL v3, FDL" - :depends-on (cffi cffi-grovel trivial-garbage cl-utilities #+fsbv fsbv) + :depends-on (grid cffi cffi-grovel trivial-garbage cl-utilities #+fsbv fsbv) :components ((:module grid ; temporary :components @@ -27,6 +27,7 @@ :depends-on ("pkgdcl" "complex-types" "symbol-type")) (:file "foreign-friendly" :depends-on ("pkgdcl")) (:file "foreign-array" :depends-on ("pkgdcl" "foreign-friendly")) + (:file "methods" :depends-on ("pkgdcl")) (:file "element-reference" :depends-on ("pkgdcl")) (:file "copy" :depends-on ("pkgdcl")))) (:module init diff --git a/init/init.lisp b/init/init.lisp index 80d46bb45b4f2a25f4ad5f7d7cbc1003bd94db92..e1ab245a8e6592054b6b7cb359992323db408014 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: <2009-12-21 10:45:40EST init.lisp> +;; Time-stamp: <2009-12-21 13:58:51EST init.lisp> ;; $Id$ (defpackage gsll @@ -9,10 +9,10 @@ (:import-from :c-array #:cl-array #:dimensions #:total-size #:element-type #:dim0 #:dim1 - #:c-pointer #:maref #:copy #:clone) + #:c-pointer #:copy #:clone) (:export #:cl-array #:dimensions #:total-size #:element-type #:dim0 #:dim1 - #:maref #:copy #:clone)) + #:copy #:clone)) (cffi:define-foreign-library libgslcblas (:darwin diff --git a/tests/permutation.lisp b/tests/permutation.lisp index 6e27e59e8321bcbe75973c5734865347529ebd32..bc8a3a1db93e2739d8275998d6746f730ec9ee3e 100644 --- a/tests/permutation.lisp +++ b/tests/permutation.lisp @@ -8,7 +8,7 @@ (LET ((PERM-1 (MAKE-PERMUTATION 4 T))) - (MAREF PERM-1 + (grid:gref PERM-1 2)))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(0 1 2 3)) (MULTIPLE-VALUE-LIST