diff --git a/data/data.lisp b/data/data.lisp index 9a9144ea6d77860f7abfc933e6032c3bd91c7a45..47be212c45e8f3b0e5248a0824c75c9ee58eb477 100644 --- a/data/data.lisp +++ b/data/data.lisp @@ -1,6 +1,6 @@ ;; Data using ffa ;; Liam Healy 2008-04-06 21:23:41EDT data-ffa.lisp -;; Time-stamp: <2008-07-12 14:19:59EDT data.lisp> +;; Time-stamp: <2008-07-20 22:28:15EDT data.lisp> ;; $Id$ (in-package :gsl) @@ -130,10 +130,7 @@ ;;;;**************************************************************************** (defun component-type (eltype) - (if (subtypep eltype 'complex) - ;; complex: use the component type - (cl-ffa (second eltype)) - (cl-ffa eltype))) + (cl-ffa (component-float-type eltype))) (defun component-size (object) (if (subtypep (element-type object) 'complex) diff --git a/init/defmfun.lisp b/init/defmfun.lisp index 3064a033c2bf13e7556ecb1177dd54d97eae744e..bcc6d229a996f4f0f21b97e8f9141313bdf11288 100644 --- a/init/defmfun.lisp +++ b/init/defmfun.lisp @@ -1,6 +1,6 @@ ;; Macro for defining GSL functions. ;; Liam Healy 2008-04-16 20:49:50EDT defmfun.lisp -;; Time-stamp: <2008-07-17 22:46:01EDT defmfun.lisp> +;; Time-stamp: <2008-07-20 22:33:28EDT defmfun.lisp> ;; $Id$ (in-package :gsl) @@ -34,8 +34,10 @@ ;;; element-types ;;; Permissible types for elements of arrays. May be ;;; NIL meaning all of *array-element-types*, :no-complex -;;; meaning that list without the complex types, or a list -;;; of element types. +;;; meaning that list without the complex types, +;;; :float meaning only the float types, :complex only +;;; the complex types, :float-complex both float and complex, +;;; or a list of element types. ;;; index Name under which this function should be cross-referenced; t ;;; to use name, nil to not index. ;;; export Whether to export the symbol. @@ -241,6 +243,8 @@ (remf key-args :documentation) (when (eq c-return :element-c-type) (setf (getf key-args :c-return) (cl-ffa eltype))) + (when (eq c-return :component-float-type) + (setf (getf key-args :c-return) (cl-ffa (component-type eltype)))) (expand-defmfun-plain (if (eq new-definition :method) (list nil name) name) (actual-class-arglist arglist eltype replace-both) @@ -255,6 +259,7 @@ ((nil t) *array-element-types*) (:no-complex *array-element-types-no-complex*) (:float *float-types*) + (:complex *complex-types*) (:float-complex *float-complex-types*) (t element-types))))) @@ -269,13 +274,17 @@ (substitute (if (subtypep type 'complex) "u" "") :suffix (substitute - (cl-gsl type t blas) :type + (cl-gsl type + (unless ; should really check it preceeds + (member :component-float-type base-name)) + blas) :type (substitute - (string-downcase (symbol-name category)) - :category - base-name))))))) - -(defun blas-name-final-token ()) + (if (subtypep type 'complex) + (cl-gsl (component-float-type type) t blas) + "") :component-float-type + (substitute + (string-downcase (symbol-name category)) :category + base-name)))))))) (defun actual-class-arglist (arglist element-type &optional replace-both) "Replace the prototype arglist with an actual arglist." @@ -328,8 +337,11 @@ actual element type." (mapcar (lambda (v) - (if (eq (st-type v) :element-c-type) - (make-st (st-symbol v) (cl-ffa element-type)) + (if (member (st-type v) '(:element-c-type :component-float-type)) + (make-st (st-symbol v) + (if (eq (st-type v) :component-float-type) + (component-type element-type) + (cl-ffa element-type))) v)) c-arguments)) diff --git a/init/element-types.lisp b/init/element-types.lisp index 93fb2f0175d009313302fef22bc09bd4603b9be1..4180676d655508117407f5f675e50da70e49a890 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: <2008-07-17 22:29:47EDT element-types.lisp> +;; Time-stamp: <2008-07-20 22:34:41EDT element-types.lisp> ;; $Id$ ;;; The different element type forms: @@ -245,6 +245,13 @@ (cffi:mem-aref datslot comptype 1) (imagpart number)) gsl)) +(defun component-float-type (eltype) + "The float type of this type." + (if (subtypep eltype 'complex) + ;; complex: use the component type + (second eltype) + eltype)) + ;;; Use GSL to create the complex. This actually does work on ;;; SBCL/amd64, but it shouldn't. #+(or) @@ -288,6 +295,10 @@ (remove-if-not (lambda (tp) (subtypep tp 'float)) *array-element-types*) "All the array element types supported except for complex types.") +(defparameter *complex-types* + (remove-if-not (lambda (tp) (subtypep tp 'complex)) *array-element-types*) + "All the supported complex array element types.") + ;;;;**************************************************************************** ;;;; Types for CFFI (will eventually be in CFFI) ;;;;****************************************************************************