From 8d5cd4a5cc6f443224318eafbd5d257180a2667d Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Mon, 7 Dec 2009 22:35:57 -0500 Subject: [PATCH] Split off grid directory Eventually, the definitions used for dealing with types and foreign arrays that aren't specific to GSL will be split off into another system, so that it will be easier to build other foreign library interfaces using these definitions. As a start, the grid/ directory defines a package 'c-array and some of the type definitions formerly in init/. Everything compiles and tests as before, on SBCL TOTAL: 1627 assertions passed, 6 failed, 0 execution errors. --- data/foreign-array.lisp | 12 +- data/maref.lisp | 6 +- data/marray.lisp | 6 +- fast-fourier-transforms/example.lisp | 6 +- {init => grid}/complex-types.lisp | 7 +- grid/pkgdcl.lisp | 8 + grid/types.lisp | 42 ++---- gsll.asd | 15 +- init/defmfun-array.lisp | 20 +-- init/element-types.lisp | 4 +- init/funcallable.lisp | 4 +- init/generate-examples.lisp | 6 +- init/interface.lisp | 4 +- init/number-conversion.lisp | 14 +- init/types.lisp | 121 +-------------- linear-algebra/matrix-generation.lisp | 6 +- mathematical/complex.lisp | 206 +++++++++++++------------- polynomial.lisp | 16 +- 18 files changed, 199 insertions(+), 304 deletions(-) rename {init => grid}/complex-types.lisp (89%) create mode 100644 grid/pkgdcl.lisp diff --git a/data/foreign-array.lisp b/data/foreign-array.lisp index cc6ad08d..48b6771a 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: <2009-03-18 14:45:50EDT foreign-array.lisp> +;; Time-stamp: <2009-12-06 21:56:58EST foreign-array.lisp> ;; $Id: $ (in-package :gsl) @@ -60,7 +60,7 @@ total-size (array-total-size cl-array)) #-native (let ((cptr (cffi:foreign-alloc - (cl-cffi (element-type object)) + (c-array: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 (cl-cffi (element-type object)))))))) + (cffi:foreign-type-size (c-array: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 (cl-cffi (element-type object)))) + (cffi:foreign-type-size (c-array:cl-cffi (element-type object)))) ;;;;**************************************************************************** ;;;; Syncronize C and CL @@ -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 (component-type lisp-type))) + (let ((cffi-type (c-array: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 (component-type lisp-type))) + (let ((cffi-type (c-array: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/data/maref.lisp b/data/maref.lisp index deef9f63..e6b643e5 100644 --- a/data/maref.lisp +++ b/data/maref.lisp @@ -1,6 +1,6 @@ ;; Get/set array or elements: cl-array, maref ;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp -;; Time-stamp: <2009-01-17 17:15:19EST maref.lisp> +;; Time-stamp: <2009-12-06 19:51:39EST maref.lisp> ;; $Id: $ (in-package :gsl) @@ -101,8 +101,8 @@ category tp) ,@ffrestargs ,@(if value-symbol - (list (cl-cffi tp) value-symbol) - (list (cl-cffi tp)))))) + (list (c-array:cl-cffi tp) value-symbol) + (list (c-array:cl-cffi tp)))))) *array-element-types*))) (defmethod maref diff --git a/data/marray.lisp b/data/marray.lisp index 4844b7c5..cd092936 100644 --- a/data/marray.lisp +++ b/data/marray.lisp @@ -1,6 +1,6 @@ ;; A "marray" is an array in both GSL and CL ;; Liam Healy 2008-04-06 21:23:41EDT -;; Time-stamp: <2009-06-06 09:58:56EDT marray.lisp> +;; Time-stamp: <2009-12-06 19:50:09EST marray.lisp> (in-package :gsl) @@ -88,7 +88,7 @@ ;; e.g. (data-class-name 'vector '(unsigned-byte 8)) ;; -> VECTOR-UNSIGNED-BYTE-8 (if (member category '(vector matrix)) - (intern (format nil "~a-~a" category (cl-single element-type)) + (intern (format nil "~a-~a" category (c-array:cl-single element-type)) :gsl) category)) @@ -216,7 +216,7 @@ (contents-from-pointer pointer (if (subtypep class-name 'matrix) 'gsl-matrix-c 'gsl-vector-c) - (lookup-type class-name *class-element-type*))))) + (c-array:lookup-type class-name *class-element-type*))))) ;; Some functions in solve-minimize-fit return a pointer to a GSL ;; vector of double-floats. This function turns that into a diff --git a/fast-fourier-transforms/example.lisp b/fast-fourier-transforms/example.lisp index dbf58b40..93b0c70b 100644 --- a/fast-fourier-transforms/example.lisp +++ b/fast-fourier-transforms/example.lisp @@ -1,6 +1,6 @@ ;; Example FFT: transform a pulse (using the "clean" fft interface) ;; Sumant Oemrawsingh, Sat Oct 31 2009 - 00:24 -;; Time-stamp: <2009-11-19 23:18:31EST example.lisp> +;; Time-stamp: <2009-12-06 22:05:01EST example.lisp> (in-package :gsl) @@ -60,7 +60,7 @@ ;; (make-urand-vector '(complex double-float) 5) (defun make-urand-vector (element-type dimension &key (stride 1)) "Make a vector with random elements." - (let ((vec (make-marray `(complex ,(component-float-type element-type)) + (let ((vec (make-marray `(complex ,(c-array:component-float-type element-type)) :dimensions (list (* stride dimension))))) (loop for i from 0 below (* stride dimension) by stride do @@ -74,7 +74,7 @@ "The real vector consisting of the real part of the complex vector." (let ((real-vector (make-marray - (component-float-type (element-type complex-vector)) + (c-array:component-float-type (element-type complex-vector)) :dimensions (dimensions complex-vector)))) (loop for i below (total-size complex-vector) do (setf (maref real-vector i) diff --git a/init/complex-types.lisp b/grid/complex-types.lisp similarity index 89% rename from init/complex-types.lisp rename to grid/complex-types.lisp index 99cdfbd4..12a548cf 100644 --- a/init/complex-types.lisp +++ b/grid/complex-types.lisp @@ -1,8 +1,10 @@ ;; Complex number types ;; Liam Healy 2009-01-13 21:24:05EST complex-types.lisp -;; Time-stamp: <2009-11-16 12:35:49EST complex-types.lisp> +;; Time-stamp: <2009-12-06 22:05:59EST complex-types.lisp> -(in-package :gsl) +(in-package :c-array) + +(export '(complex-double-c complex-float-c component-float-type component-type)) ;;;;**************************************************************************** ;;;; Complex types @@ -48,3 +50,4 @@ (defun component-type (eltype) (cl-cffi (component-float-type eltype))) + diff --git a/grid/pkgdcl.lisp b/grid/pkgdcl.lisp new file mode 100644 index 00000000..0ed9e128 --- /dev/null +++ b/grid/pkgdcl.lisp @@ -0,0 +1,8 @@ +;; Declaration of package +;; Liam Healy 2009-12-06 19:41:09EST pkgdcl.lisp +;; Time-stamp: <2009-12-06 19:41:51EST pkgdcl.lisp> + +(in-package :cl-user) + +(defpackage c-array + (:use :common-lisp :cffi)) diff --git a/grid/types.lisp b/grid/types.lisp index bd5c72f8..899d61bc 100644 --- a/grid/types.lisp +++ b/grid/types.lisp @@ -1,21 +1,13 @@ ;; Number types used by GSL functions, and specification conversion ;; Liam Healy 2008-12-31 21:06:34EST types.lisp -;; Time-stamp: <2009-12-06 10:55:10EST types.lisp> +;; Time-stamp: <2009-12-07 22:26:05EST types.lisp> ;; $Id: $ -(in-package :gsl) +(in-package :c-array) -;;;;**************************************************************************** -;;;; Unsigned address types size_t -;;;;**************************************************************************** - -(case (cffi:foreign-type-size :long) - (8 - (push :int64 *features*) - #+fsbv (fsbv:defsynonym sizet :uint64)) - (4 - (push :int32 *features*) - #+fsbv (fsbv:defsynonym sizet :uint32))) +(export '(*cstd-integer-types* + *cstd-cl-type-mapping* floating-point-association all-types + lookup-type cl-single cl-cffi cffi-cl number-class)) ;;;;**************************************************************************** ;;;; Type specification conversion @@ -106,20 +98,6 @@ (mapcar #'first *fp-type-mapping*) (subseq ,splice-list 0 (length *fp-type-mapping*)))) -(defparameter *blas-splice-fp-types* - ;; Ordered by: real shortest to longest, then complex shortest to longest. - ;; Must match *fp-type-mapping*. - '("s" "d" #+long-double nil - "c" "z" #+long-double nil) - "The list of floating point types that can be spliced into BLAS function names.") - -(defparameter *cstd-blas-mapping* - ;; The floating types are associated by order, so it is important that - ;; order of *fp-type-mapping* and *blas-splice-fp-types* match, - ;; though the latter may be longer. - (floating-point-association *blas-splice-fp-types*) - "Mapping the C standard types to the BLAS splice name.") - ;;;;**************************************************************************** ;;;; Conversions ;;;;**************************************************************************** @@ -137,6 +115,15 @@ ;;(error "Did not find ~a in ~a" symbol (mapcar #'first alist)) )) +;;; (cl-single '(unsigned-byte 8)) +;;; UNSIGNED-BYTE-8 +(defun cl-single (cl-type) + "The element type name as a single symbol." + (intern (if (atom cl-type) + (princ-to-string cl-type) + (format nil "~{~a~^-~}" cl-type)) + :gsl)) + (defun cl-cffi (cl-type) "The CFFI element type from the CL type." (lookup-type (clean-type cl-type) *cstd-cl-type-mapping* t)) @@ -151,3 +138,4 @@ (defun number-class (type) "Find the class corresponding to the numeric type." (find-if (lambda (class) (subtypep type class)) *cl-numeric-classes*)) + diff --git a/gsll.asd b/gsll.asd index b27f230f..32d6d53a 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2009-11-09 16:04:42EST gsll.asd> +;; Time-stamp: <2009-12-06 22:14:49EST gsll.asd> (when (asdf:find-system :fsbv nil) (pushnew :fsbv *features*)) @@ -16,7 +16,13 @@ :licence "LLGPL v3, FDL" :depends-on (cffi cffi-grovel trivial-garbage cl-utilities #+fsbv fsbv) :components - ((:module init + ((:module grid ; temporary + :components + ((:file "pkgdcl") + (:file "types" :depends-on ("pkgdcl")) + (:file "complex-types" :depends-on ("types")))) + (:module init + :depends-on (grid) :components ((:file "init") (cffi-grovel:grovel-file "libgsl" :pathname #+unix "libgsl-unix") @@ -35,8 +41,7 @@ (cffi-grovel:grovel-file "callback-struct" :depends-on ("types" "libgsl")) (:file "funcallable" :depends-on ("utility")) - (:file "complex-types" :depends-on ("types")) - (:file "element-types" :depends-on ("init" "complex-types")) + (:file "element-types" :depends-on ("init")) (:file "interface" :depends-on ("init" "conditions" "element-types" "number-conversion")) @@ -74,7 +79,7 @@ (:file "array-tests" :depends-on ("both")) (:file "permutation" :depends-on ("marray" "array-structs")) (:file "combination" :depends-on ("marray" "array-structs")))) - (:file "polynomial" :depends-on (init data)) + (:file "polynomial" :depends-on (grid init data)) (:module special-functions :depends-on (init) :components diff --git a/init/defmfun-array.lisp b/init/defmfun-array.lisp index 0edea019..f2cade59 100644 --- a/init/defmfun-array.lisp +++ b/init/defmfun-array.lisp @@ -1,6 +1,6 @@ ;; Helpers for defining GSL functions on arrays ;; Liam Healy 2009-01-07 22:01:16EST defmfun-array.lisp -;; Time-stamp: <2009-11-30 16:13:13EST defmfun-array.lisp> +;; Time-stamp: <2009-12-06 22:05:00EST defmfun-array.lisp> ;; $Id: $ (in-package :gsl) @@ -80,9 +80,9 @@ gsl-function-name))) (remf key-args :documentation) (when (eq c-return :element-c-type) - (setf (getf key-args :c-return) (cl-cffi eltype))) + (setf (getf key-args :c-return) (c-array:cl-cffi eltype))) (when (eq c-return :component-float-type) - (setf (getf key-args :c-return) (component-type eltype))) + (setf (getf key-args :c-return) (c-array:component-type eltype))) (if (optional-args-to-switch-gsl-functions arglist gsl-name) ;; The methods have optional argument(s) and ;; multiple GSL functions for presence/absence of @@ -115,7 +115,7 @@ (if (listp base-name) (if (symbolp (first base-name)) ;; An explicit listing of types with function names - (getf base-name (cl-single type)) + (getf base-name (c-array:cl-single type)) (let ((blas (search "blas" (first base-name) :test 'string-equal))) (apply #'concatenate 'string (substitute @@ -126,7 +126,7 @@ (cl-gsl type (not blas) blas) :type (substitute (if (subtypep type 'complex) - (cl-gsl (component-float-type type) nil blas) + (cl-gsl (c-array:component-float-type type) nil blas) "") :component-float-type (substitute (string-downcase (symbol-name category)) :category @@ -145,9 +145,9 @@ (if (and replacing (listp arg)) (list (first arg) (case (second arg) - (:element-type (number-class element-type)) + (:element-type (c-array:number-class element-type)) (:component-float-type - (number-class (component-float-type element-type))) + (c-array:number-class (c-array:component-float-type element-type))) (otherwise (data-class-name (if (and (eq (second arg) 'both) replace-both) @@ -158,7 +158,7 @@ ;; specially for array methods. (if (and (listp arg) (numberp (second arg))) (let ((actual-type - (cffi-cl + (c-array:cffi-cl (st-type (find (first arg) carg-actual :key 'st-symbol))))) (list (first arg) ; Optional arg default numerical value (if actual-type @@ -198,6 +198,6 @@ actual element type." (mapcar (lambda (v) - (subst (cl-cffi element-type) :element-c-type - (subst (component-type element-type) :component-float-type v))) + (subst (c-array:cl-cffi element-type) :element-c-type + (subst (c-array:component-type element-type) :component-float-type v))) c-arguments)) diff --git a/init/element-types.lisp b/init/element-types.lisp index ae7141be..bf044868 100644 --- a/init/element-types.lisp +++ b/init/element-types.lisp @@ -1,6 +1,6 @@ ;; Mapping of element type names ;; Liam Healy 2008-04-13 11:22:46EDT element-types.lisp -;; Time-stamp: <2009-01-13 21:31:12EST element-types.lisp> +;; Time-stamp: <2009-12-06 19:50:12EST element-types.lisp> ;; $Id$ (in-package :gsl) @@ -10,7 +10,7 @@ ;;;;**************************************************************************** (defparameter *array-element-types* - (remove-duplicates (all-types *cstd-cl-type-mapping* t) :test 'equal) + (remove-duplicates (c-array:all-types c-array:*cstd-cl-type-mapping* t) :test 'equal) "All the array element types supported.") (defparameter *array-element-types-no-complex* diff --git a/init/funcallable.lisp b/init/funcallable.lisp index e83227d6..730ee54a 100644 --- a/init/funcallable.lisp +++ b/init/funcallable.lisp @@ -1,6 +1,6 @@ ;; Generate a lambda that calls the user function; will be called by callback. ;; Liam Healy -;; Time-stamp: <2009-04-04 21:45:11EDT funcallable.lisp> +;; Time-stamp: <2009-12-06 19:52:32EST funcallable.lisp> ;; $Id$ (in-package :gsl) @@ -64,7 +64,7 @@ (floor linear-index (first dims))) (list linear-index nil))) - ',(cffi-cl (parse-callback-argspec argspec 'element-type))) + ',(c-array:cffi-cl (parse-callback-argspec argspec 'element-type))) `(cffi:mem-aref ,foreign-variable-name ',(parse-callback-argspec argspec 'element-type) diff --git a/init/generate-examples.lisp b/init/generate-examples.lisp index a33b97ed..c1a6670b 100644 --- a/init/generate-examples.lisp +++ b/init/generate-examples.lisp @@ -1,6 +1,6 @@ ;; Define examples. ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp -;; Time-stamp: <2009-11-14 10:22:05EST generate-examples.lisp> +;; Time-stamp: <2009-12-06 22:05:00EST generate-examples.lisp> ;; $Id: $ ;;; Define examples that can be displayed by users with the function @@ -80,7 +80,7 @@ length using the pool data for the type and starting at the specified point in the pool." (mapcar - (lambda (num) (coerce num (component-float-type type))) + (lambda (num) (coerce num (c-array:component-float-type type))) (subseq (cond ((subtypep type 'unsigned-byte) *unsigned-byte-pool*) ((subtypep type 'signed-byte) *signed-byte-pool*) @@ -127,7 +127,7 @@ (if float-type (first (make-list-from-pool - (component-float-type default-element-type) 1 starting-element)) + (c-array:component-float-type default-element-type) 1 starting-element)) (apply #'complex (make-list-from-pool default-element-type 1 starting-element))) diff --git a/init/interface.lisp b/init/interface.lisp index 113b2539..22f10417 100644 --- a/init/interface.lisp +++ b/init/interface.lisp @@ -1,6 +1,6 @@ ;; Macros to interface GSL functions, including definitions necessary for defmfun. ;; Liam Healy -;; Time-stamp: <2009-11-12 18:11:41EST interface.lisp> +;; Time-stamp: <2009-12-06 19:52:33EST interface.lisp> (in-package :gsl) @@ -102,7 +102,7 @@ (defun cl-argument-types (cl-arguments c-arguments-types) "Create CL argument and types from the C arguments." (loop for sd in c-arguments-types - for cl-type = (cffi-cl (st-type sd)) + for cl-type = (c-array:cffi-cl (st-type sd)) append (when (and cl-type (member (st-symbol sd) (cl-symbols cl-arguments))) (list (list (st-symbol sd) cl-type))))) diff --git a/init/number-conversion.lisp b/init/number-conversion.lisp index 45f00fd7..4580390f 100644 --- a/init/number-conversion.lisp +++ b/init/number-conversion.lisp @@ -1,6 +1,6 @@ ;; Conversion of numbers C->CL ;; Liam Healy, Sun May 28 2006 - 22:04 -;; Time-stamp: <2009-04-27 21:24:36EDT number-conversion.lisp> +;; Time-stamp: <2009-12-07 22:30:23EST number-conversion.lisp> ;; $Id$ (in-package :gsl) @@ -25,14 +25,14 @@ ;;; GSL complex struct is defined in init/complex-types.lisp. (defun complex-to-cl - (gsl-complex &optional (index 0) (complex-type 'complex-double-c)) + (gsl-complex &optional (index 0) (complex-type 'c-array:complex-double-c)) "Make a CL complex number from the GSL pointer to a complex struct or an array of complex structs and an index into the array." (let ((carr (cffi:foreign-slot-value (cffi:inc-pointer gsl-complex (* index (cffi:foreign-type-size complex-type))) - complex-type 'dat))) + complex-type 'c-array::dat))) (complex (dcref carr 0) (dcref carr 1)))) @@ -50,8 +50,8 @@ `((val ,(st-symbol decl) 'sf-result-e10) (e10 ,(st-symbol decl)) (err ,(st-symbol decl) 'sf-result-e10))) - (complex-double-c - `((complex-to-cl ,(st-symbol decl) 0 'complex-double-c))) - (complex-float-c - `((complex-to-cl ,(st-symbol decl) 0 'complex-float-c))) + (c-array:complex-double-c + `((complex-to-cl ,(st-symbol decl) 0 'c-array:complex-double-c))) + (c-array:complex-float-c + `((complex-to-cl ,(st-symbol decl) 0 'c-array:complex-float-c))) (t `((cffi:mem-aref ,(st-symbol decl) ',(st-actual-type decl)))))) diff --git a/init/types.lisp b/init/types.lisp index baef60e3..fc638033 100644 --- a/init/types.lisp +++ b/init/types.lisp @@ -1,6 +1,6 @@ ;; Number types used by GSL functions, and specification conversion ;; Liam Healy 2008-12-31 21:06:34EST types.lisp -;; Time-stamp: <2009-11-30 16:13:18EST types.lisp> +;; Time-stamp: <2009-12-07 22:26:03EST types.lisp> ;; $Id: $ (in-package :gsl) @@ -21,28 +21,12 @@ ;;;; Type specification conversion ;;;;**************************************************************************** -;; cffi-features:no-long-long doesn't work for me, but ought to be checked? - -;;; The different element type forms: -;;; C standard full, or "CFFI" :unsigned-char -;;; GSL splice name "uchar" -;;; C explicit :uint8 (not used here) -;;; CL '(unsigned-byte 8) -;;; Single 'unsigned-byte-8 - ;;; Functions to perform conversions -;;; CL -> single in function #'cl-single ;;; CL -> GSL in function #'cl-gsl -;;; CL -> CFFI (Cstd) in function #'cl-cffi -;;; CFFI (Cstd) -> CL in function #'cffi-cl ;;; Sources of equivalence -;;; Cstd -> CL in alist *cstd-cl-type-mapping* ;;; Cstd -> GSL in alist *cstd-gsl-mapping* -;;; :long-double may be pushed onto *features* if -;;; the implementation supports long doubles in CFFI. - ;;;;**************************************************************************** ;;;; Basic definition ;;;;**************************************************************************** @@ -52,33 +36,6 @@ ;;; *cstd-cl-type-mapping* and *cstd-gsl-mapping* which are used by ;;; the conversion functions. -(defparameter *cstd-integer-types* - '(:char :unsigned-char - :short :unsigned-short - :int :unsigned-int - :long :unsigned-long - #+int64 - :long-long - #+int64 - :unsigned-long-long) - ;; http://common-lisp.net/project/cffi/manual/html_node/Built_002dIn-Types.html - "List of integer types supported by CFFI, from the CFFI docs.") - -(defparameter *fp-type-mapping* - '((:float . single-float) (:double . double-float) - ;; For those implementations that support a separate long-double - ;; type assume this mapping: - #+long-double (:long-double . long-float) - (complex-float-c . (complex single-float)) - (complex-double-c . (complex double-float)) - ;; For those implementations that support a separate long-double - ;; type assume this mapping: - #+long-double - (complex-long-double-c . (complex long-float))) - ;; Ordered by: real shortest to longest, then complex shortest to longest. - "List of floating point types supported by CFFI from the CFFI docs - plus corresponding complex types.") - (defparameter *gsl-splice-int-types* ;; list | grep -i 'gsl_vector.*_alloc\b' '("char" "int" "long" "short" "uchar" "uint" "ulong" "ushort") @@ -92,35 +49,6 @@ "complex_float" "complex" #+long-double "complex_long_double") "The list of floating point types that can be spliced into function names.") -;;; Mapping alists used by conversion functions. - -;;; Used by #'cl-gsl -(defparameter *cstd-cl-type-mapping* - (append - *fp-type-mapping* - (mapcar - (lambda (type) - (cons - type - (list - (if (string-equal type "uns" :end1 3) - 'unsigned-byte - 'signed-byte) - (* 8 (cffi:foreign-type-size type))))) - *cstd-integer-types*)) - ;; Be careful when reverse associating, as there may be several C - ;; types that map to a single CL type. - "An alist of the C standard types as keywords, and the CL type - The exception is complex types, which don't have a definition - in the C standard; in that case, the C type is the GSL struct - definition.") - -(defmacro floating-point-association (splice-list) - `(mapcar - #'cons - (mapcar #'first *fp-type-mapping*) - (subseq ,splice-list 0 (length *fp-type-mapping*)))) - (defparameter *cstd-gsl-mapping* (append ;; The integer types @@ -140,11 +68,11 @@ "long-long")) (concatenate 'string (subseq ut 0 (- (length ut) 9)) "llong") ut)))) - *cstd-integer-types*)) + c-array:*cstd-integer-types*)) ;; The floating types are associated by order, so it is important that ;; order of *fp-type-mapping* and *gsl-splice-fp-types* match, ;; though the latter may be longer. - (floating-point-association *gsl-splice-fp-types*)) + (c-array:floating-point-association *gsl-splice-fp-types*)) "Mapping the C standard types to the GSL splice name.") (defparameter *blas-splice-fp-types* @@ -158,58 +86,21 @@ ;; The floating types are associated by order, so it is important that ;; order of *fp-type-mapping* and *blas-splice-fp-types* match, ;; though the latter may be longer. - (floating-point-association *blas-splice-fp-types*) + (c-array:floating-point-association *blas-splice-fp-types*) "Mapping the C standard types to the BLAS splice name.") ;;;;**************************************************************************** ;;;; Conversions ;;;;**************************************************************************** -(defun all-types (alist &optional right-side) - "A list of all types defined by symbol or definition." - (mapcar (if right-side #'rest #'first) alist)) - -(defun lookup-type (symbol alist &optional reverse) - "Lookup the symbol defined in the alist." - (or - (if reverse - (first (rassoc symbol alist :test #'equal)) - (rest (assoc symbol alist))) - ;;(error "Did not find ~a in ~a" symbol (mapcar #'first alist)) - )) - -;;; (cl-single '(unsigned-byte 8)) -;;; UNSIGNED-BYTE-8 -(defun cl-single (cl-type) - "The element type name as a single symbol." - (intern (if (atom cl-type) - (princ-to-string cl-type) - (format nil "~{~a~^-~}" cl-type)) - :gsl)) - ;;; (cl-gsl '(unsigned-byte 8)) ;;; "uchar" (defun cl-gsl (cl-type &optional prepend-underscore blas) "The GSL splice string from the CL type." (let ((string - (lookup-type - (lookup-type cl-type *cstd-cl-type-mapping* t) + (c-array:lookup-type + (c-array:lookup-type cl-type c-array:*cstd-cl-type-mapping* t) (if blas *cstd-blas-mapping* *cstd-gsl-mapping*)))) (if (and prepend-underscore (plusp (length string))) (concatenate 'string "_" string) string))) - -(defun cl-cffi (cl-type) - "The CFFI element type from the CL type." - (lookup-type (clean-type cl-type) *cstd-cl-type-mapping* t)) - -(defun cffi-cl (cffi-type) - "The CL type from the CFFI element type." - (unless (eq cffi-type :pointer) - (lookup-type cffi-type *cstd-cl-type-mapping*))) - -;;; For future use -(defparameter *cl-numeric-classes* '(ratio integer rational float real complex number)) -(defun number-class (type) - "Find the class corresponding to the numeric type." - (find-if (lambda (class) (subtypep type class)) *cl-numeric-classes*)) diff --git a/linear-algebra/matrix-generation.lisp b/linear-algebra/matrix-generation.lisp index 4bee4340..a87459de 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: <2009-10-15 22:51:23EDT matrix-generation.lisp> +;; Time-stamp: <2009-12-06 19:50:10EST matrix-generation.lisp> (in-package :gsl) @@ -62,7 +62,7 @@ "Make a matrix of the specified dimensions, with contents based on a function of the element indices i, j." (set-matrix - (make-marray (cl-single element-type) :dimensions (list dim0 dim1)) + (make-marray (c-array:cl-single element-type) :dimensions (list dim0 dim1)) function pass-element)) @@ -71,7 +71,7 @@ "Make a vector of the specified dimension, with contents based on a function of the element index." (let ((vector - (make-marray (cl-single element-type) :dimensions dim))) + (make-marray (c-array:cl-single element-type) :dimensions dim))) (dotimes (i dim vector) (setf (maref vector i) (coerce (funcall function i) element-type))))) diff --git a/mathematical/complex.lisp b/mathematical/complex.lisp index 95feed44..0fd6dd18 100644 --- a/mathematical/complex.lisp +++ b/mathematical/complex.lisp @@ -13,26 +13,26 @@ (defmfun argument (number) "gsl_complex_arg" - ((number complex-double-c)) + ((number c-array:complex-double-c)) :c-return :double :documentation "The angle of the complex number.") (defmfun modulus (number) "gsl_complex_abs" - ((number complex-double-c)) + ((number c-array:complex-double-c)) :c-return :double :documentation "The magnitude, or modulus of the complex number.") (defmfun modulus2 (number) "gsl_complex_abs2" - ((number complex-double-c)) + ((number c-array:complex-double-c)) :c-return :double :documentation "The magnitude squared of the complex number.") (defmfun log-modulus (number) "gsl_complex_logabs" - ((number complex-double-c)) + ((number c-array:complex-double-c)) :c-return :double :documentation "The logarithm of the magnitude of the complex number.") @@ -46,78 +46,78 @@ (defmfun cx-add (c1 c2) "gsl_complex_add" - ((c1 complex-double-c) (c2 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (c2 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-sub (c1 c2) "gsl_complex_sub" - ((c1 complex-double-c) (c2 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (c2 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-mul (c1 c2) "gsl_complex_mul" - ((c1 complex-double-c) (c2 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (c2 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-div (c1 c2) "gsl_complex_div" - ((c1 complex-double-c) (c2 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (c2 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-add-real (c1 num) "gsl_complex_add_real" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-sub-real (c1 num) "gsl_complex_sub_real" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-mul-real (c1 num) "gsl_complex_mul_real" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-div-real (c1 num) "gsl_complex_div_real" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-add-imag (c1 num) "gsl_complex_add_imag" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-sub-imag (c1 num) "gsl_complex_sub_imag" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-mul-imag (c1 num) "gsl_complex_mul_imag" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-div-imag (c1 num) "gsl_complex_div_imag" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-conjugate (c1) "gsl_complex_conjugate" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-inverse (c1) "gsl_complex_inverse" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-negative (c1) "gsl_complex_negative" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) ;;;;**************************************************************************** ;;; Complex functions @@ -129,43 +129,43 @@ (defmfun cx-sqrt (c1) "gsl_complex_sqrt" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-sqrt-real (num) "gsl_complex_sqrt_real" ((num :double)) - :c-return complex-double-c) + :c-return c-array:complex-double-c) (defmfun cx-expt (c1 c2) "gsl_complex_pow" - ((c1 complex-double-c) (c2 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (c2 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-expt-real (c1 num) "gsl_complex_pow_real" - ((c1 complex-double-c) (num :double)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (num :double)) + :c-return c-array:complex-double-c) (defmfun cx-exp (c1) "gsl_complex_exp" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-log (c1) "gsl_complex_log" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-log10 (c1) "gsl_complex_log10" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-logb (c1 c2) "gsl_complex_log_b" - ((c1 complex-double-c) (c2 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c) (c2 c-array:complex-double-c)) + :c-return c-array:complex-double-c) ;;;;**************************************************************************** ;;; Trigonometric functions @@ -177,33 +177,33 @@ (defmfun cx-sin (c1) "gsl_complex_sin" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-cos (c1) "gsl_complex_cos" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-sec (c1) "gsl_complex_sec" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-csc (c1) "gsl_complex_csc" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-tan (c1) "gsl_complex_tan" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-cot (c1) "gsl_complex_cot" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) ;;;;**************************************************************************** ;;; Inverse trigonometric functions @@ -215,53 +215,53 @@ (defmfun cx-arcsin (c1) "gsl_complex_arcsin" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arcsin-real (num) "gsl_complex_arcsin_real" ((num :double)) - :c-return complex-double-c) + :c-return c-array:complex-double-c) (defmfun cx-arccos (c1) "gsl_complex_arccos" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arccos-real (num) "gsl_complex_arccos_real" ((num :double)) - :c-return complex-double-c) + :c-return c-array:complex-double-c) (defmfun cx-arcsec (c1) "gsl_complex_arcsec" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arcsec-real (num) "gsl_complex_arcsec_real" ((num :double)) - :c-return complex-double-c) + :c-return c-array:complex-double-c) (defmfun cx-arccsc (c1) "gsl_complex_arccsc" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arccsc-real (num) "gsl_complex_arccsc_real" ((num :double)) - :c-return complex-double-c) + :c-return c-array:complex-double-c) (defmfun cx-arctan (c1) "gsl_complex_arctan" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arccot (c1) "gsl_complex_arccot" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) ;;;;**************************************************************************** ;;; Hyperbolic functions @@ -269,33 +269,33 @@ (defmfun cx-sinh (c1) "gsl_complex_sinh" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-cosh (c1) "gsl_complex_cosh" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-sech (c1) "gsl_complex_sech" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-csch (c1) "gsl_complex_csch" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-tanh (c1) "gsl_complex_tanh" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-coth (c1) "gsl_complex_coth" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) ;;;;**************************************************************************** ;;; Inverse trigonometric functions @@ -303,40 +303,40 @@ (defmfun cx-arcsinh (c1) "gsl_complex_arcsinh" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arccosh (c1) "gsl_complex_arccosh" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arccosh-real (num) "gsl_complex_arccosh_real" ((num :double)) - :c-return complex-double-c) + :c-return c-array:complex-double-c) (defmfun cx-arcsech (c1) "gsl_complex_arcsech" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arccsch (c1) "gsl_complex_arccsch" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arctanh (c1) "gsl_complex_arctanh" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) (defmfun cx-arctanh-real (num) "gsl_complex_arctanh_real" ((num :double)) - :c-return complex-double-c) + :c-return c-array:complex-double-c) (defmfun cx-arccoth (c1) "gsl_complex_arccoth" - ((c1 complex-double-c)) - :c-return complex-double-c) + ((c1 c-array:complex-double-c)) + :c-return c-array:complex-double-c) diff --git a/polynomial.lisp b/polynomial.lisp index 8cd963ef..bfd0ee52 100644 --- a/polynomial.lisp +++ b/polynomial.lisp @@ -1,6 +1,6 @@ ;; Polynomials ;; Liam Healy, Tue Mar 21 2006 - 18:33 -;; Time-stamp: <2009-05-25 12:42:18EDT polynomial.lisp> +;; Time-stamp: <2009-12-06 22:16:07EST polynomial.lisp> ;; $Id$ (in-package :gsl) @@ -32,11 +32,11 @@ &key) "gsl_poly_complex_eval" (((c-pointer coefficients) :pointer) ((dim0 coefficients) sizet) - (x complex-double-c)) + (x c-array:complex-double-c)) :definition :method :gsl-version (1 11) :inputs (coefficients) - :c-return complex-double-c + :c-return c-array:complex-double-c :documentation ; FDL "Evaluate the polyonomial with coefficients at the complex value x.") @@ -46,11 +46,11 @@ &key) "gsl_complex_poly_complex_eval" (((c-pointer coefficients) :pointer) ((dim0 coefficients) sizet) - (x complex-double-c)) + (x c-array:complex-double-c)) :definition :method :gsl-version (1 11) :inputs (coefficients) - :c-return complex-double-c + :c-return c-array:complex-double-c :documentation ; FDL "Evaluate the polyonomial with coefficients at the complex value x.") @@ -113,7 +113,7 @@ (defmfun solve-quadratic-complex (a b c) "gsl_poly_complex_solve_quadratic" ((a :double) (b :double) (c :double) - (root1 (:pointer complex-double-c)) (root2 (:pointer complex-double-c))) + (root1 (:pointer c-array:complex-double-c)) (root2 (:pointer c-array:complex-double-c))) :c-return :number-of-answers :documentation ; FDL "The complex roots of the quadratic equation a x^2 + b x + c = 0. @@ -139,8 +139,8 @@ (defmfun solve-cubic-complex (a b c) "gsl_poly_complex_solve_cubic" ((a :double) (b :double) (c :double) - (root1 (:pointer complex-double-c)) (root2 (:pointer complex-double-c)) - (root3 (:pointer complex-double-c))) + (root1 (:pointer c-array:complex-double-c)) (root2 (:pointer c-array:complex-double-c)) + (root3 (:pointer c-array:complex-double-c))) :c-return :number-of-answers :documentation ; FDL "Find the complex roots of the cubic equation, x^3 + a x^2 + b x + c = 0 -- GitLab