Skip to content
Snippets Groups Projects
Commit a3fd5514 authored by lhealy's avatar lhealy Committed by Liam Healy
Browse files

BLAS1 function #'2norm compiles; not tested.

git-svn-id: svn+ssh://common-lisp.net/project/gsll/svn/branches/ffa@70 af03a46b-e846-0410-96e5-d5653c316fd0
parent a945e9c1
No related branches found
No related tags found
No related merge requests found
;; 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)
......
;; 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))
......
;; 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)
;;;;****************************************************************************
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment