diff --git a/data/foreign-array.lisp b/data/foreign-array.lisp index 91285b1f503227be7ad50c6596cbdbd8025e2780..df72f9140c62b2d6778dd3bee17b769b19a8884d 100644 --- a/data/foreign-array.lisp +++ b/data/foreign-array.lisp @@ -1,6 +1,6 @@ ;; Foreign arrays (usually in C) ;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp -;; Time-stamp: <2008-12-28 21:39:02EST foreign-array.lisp> +;; Time-stamp: <2008-12-29 14:34:24EST foreign-array.lisp> ;; $Id: $ (in-package :gsl) @@ -63,10 +63,16 @@ (* index-offset (cffi:foreign-type-size (cl-cffi (element-type object)))))))) +(defparameter *print-contents* t + "Print the contents of the foreign-array.") + (defmethod print-object ((object foreign-array) stream) (print-unreadable-object (object stream :type t) - #-native (copy-c-to-cl object) - (princ (cl-array object) stream))) + (if *print-contents* + (progn + #-native (copy-c-to-cl object) + (princ (cl-array object) stream)) + (format stream "dimensions ~a" (dimensions object))))) (defun dim0 (object) "The first dimension of the object." @@ -95,7 +101,7 @@ "Copy the CL array to the C array." (when (c-invalid object) (copy-array-to-pointer - (cl-array object) + (slot-value object 'cl-array) (c-pointer object) (element-type object) 0 @@ -108,7 +114,7 @@ "Copy the C array to the CL array." (when (cl-invalid object) (copy-array-from-pointer - (cl-array object) + (slot-value object 'cl-array) (c-pointer object) (element-type object) 0 @@ -144,7 +150,8 @@ for array-index :from index-offset do (setf (row-major-aref array array-index) - (complex - (cffi:mem-aref pointer cffi-type pointer-index) - (cffi:mem-aref pointer cffi-type (1+ pointer-index))))))) - + (if (subtypep lisp-type 'complex) + (complex + (cffi:mem-aref pointer cffi-type pointer-index) + (cffi:mem-aref pointer cffi-type (1+ pointer-index))) + (cffi:mem-aref pointer cffi-type pointer-index)))))) diff --git a/gsll.asd b/gsll.asd index 3398ec8c477cd08be68700046d35e9a8c6dac5e6..4dfd81f7098f215d04db1f28e05b7abd31908b8b 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2008-12-28 16:46:47EST gsll.asd> +;; Time-stamp: <2008-12-29 13:35:30EST gsll.asd> ;; $Id$ (asdf:defsystem "gsll" @@ -40,8 +40,8 @@ (:file "maref" :depends-on (marray vector matrix)) (:file "both" :depends-on (marray vector matrix)) (:file "array-tests" :depends-on (both)) - (:file "permutation" :depends-on (foreign-array)) - (:file "combination" :depends-on (foreign-array)))) + (:file "permutation" :depends-on (marray)) + (:file "combination" :depends-on (marray)))) (:file "polynomial" :depends-on (init data)) (:module special-functions :depends-on (init) diff --git a/init/mobject.lisp b/init/mobject.lisp index f87a3971e537296a290213887b7a9c34b8eb218b..a38d0fab68f449ad5c5f08d631cdc4d51857620a 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-28 20:45:50EST mobject.lisp> +;; Time-stamp: <2008-12-29 17:37:25EST mobject.lisp> ;; $Id$ ;;; GSL objects are represented in GSLL as and instance of a 'mobject. @@ -136,9 +136,11 @@ (:documentation "The name given to the GSL object.")) ;;; Pointer type -(defconstant +foreign-pointer-class+ (class-name (class-of (cffi:null-pointer))) - "The class in which foreign pointers fall. This will be assumed to be a - GSL vector or matrix.") +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant +foreign-pointer-class+ (class-name (class-of (cffi:null-pointer))) + "The class in which foreign pointers fall.") + (defconstant +foreign-pointer-type+ (type-of (cffi:null-pointer)) + "The type of foreign pointers.")) ;;; Some functions in solve-minimize-fit return a pointer to a GSL ;;; vector with double-floats. This function will return a contents @@ -151,7 +153,6 @@ "Create a contents list from the GSL object of type struct-type referenced by pointer.")) -;;; CLISP bug? doesn't know about +foreign-pointer-class+ defined above -#-clisp (defmethod mpointer ((object #.+foreign-pointer-class+)) + (check-type object #.+foreign-pointer-type+) object)