Commit d5c1871f authored by Liam Healy's avatar Liam Healy

BLAS1 function #'scale with real or complex scalar

There are two BLAS1 functions "gsl_blas_csscal" and "gsl_blas_zdscal"
that scale complex vectors with a real scalar alpha.  In order to
distinguish a call to #'scale between these and the equivalent
functions gsl_blas_cscal and gsl_blas_zscal that take complex scalars,
it is necessary to specialize on the scalar class (float or complex).
Modified defmfun so that the pseudo-classes :component-float-type and
:element-c-type are recognized and the appropriate substitution is
made.  Compiled without errors or warnings but not tested.
parent e2b8ed84
;; Macro for defining GSL functions.
;; Liam Healy 2008-04-16 20:49:50EDT defmfun.lisp
;; Time-stamp: <2008-07-21 22:48:03EDT defmfun.lisp>
;; Time-stamp: <2008-08-02 19:18:11EDT defmfun.lisp>
;; $Id$
(in-package :gsl)
......@@ -284,22 +284,34 @@
(string-downcase (symbol-name category)) :category
base-name))))))))
(defun number-class-from-type (type)
"Find a class name that contains this type."
;; Not exhaustive; just trying to separate reals and complex.
(cond ((subtypep type 'complex) 'complex)
((subtypep type 'float) 'float)
(t (error "Can't pass type ~a." type))))
(defun actual-class-arglist (arglist element-type &optional replace-both)
"Replace the prototype arglist with an actual arglist."
(loop for arg in arglist
with replacing = t
do
(when (and replacing (member arg '(&optional)))
(setf replacing nil))
collect
(if (and replacing (listp arg))
(list (first arg)
with replacing = t
do
(when (and replacing (member arg '(&optional)))
(setf replacing nil))
collect
(if (and replacing (listp arg))
(list (first arg)
(case (second arg)
(:element-c-type (number-class-from-type element-type))
(:component-float-type
(number-class-from-type (component-float-type element-type)))
(otherwise
(data-class-name
(if (and (eq (second arg) 'both) replace-both)
replace-both
(second arg))
element-type))
arg)))
element-type))))
arg)))
(defun arglist-plain-and-categories (arglist)
"Get arglist without classes and a list of categories."
......@@ -420,7 +432,8 @@
for cl-type = (cffi-cl (st-type sd))
append
(when (and cl-type (subtypep cl-type 'complex)
(member (st-symbol sd) cl-arguments))
(member (st-symbol sd)
(arglist-plain-and-categories cl-arguments)))
(list (list (st-symbol sd)
(gensym (string (st-symbol sd)))
(st-type sd))))))
......
;; BLAS level 1, Vector operations
;; Liam Healy, Wed Apr 26 2006 - 15:23
;; Time-stamp: <2008-07-21 22:53:55EDT blas1.lisp>
;; Time-stamp: <2008-08-02 19:19:02EDT blas1.lisp>
;; $Id$
(in-package :gsl)
......@@ -100,10 +100,11 @@
:documentation ; FDL
"Copy the elements of the vector x into the vector y.")
(defmfun scale (alpha (x vector))
;; Alpha is the same type as the elements of vector.
(defmfun scale ((alpha :element-c-type) (x vector))
;; Alpha is the same type as the elements of vector, so for complex
;; vectors it must be complex.
("gsl_blas_" :type "scal")
((alpha :element-c-type) ((mpointer x) :pointer))
((alpha :element-c-type) ((mpointer x) :pointer))
:definition :generic
:element-types :float-complex
:inputs (x)
......@@ -111,8 +112,8 @@
:documentation ; FDL
"Rescale the vector x by the multiplicative factor alpha.")
(defmfun scale (alpha (x vector))
;; Alpha is a float.
(defmfun scale ((alpha :component-float-type) (x vector))
;; Alpha is a float and the vector is complex
("gsl_blas_" :type :component-float-type "scal")
((alpha :component-float-type) ((mpointer x) :pointer))
:definition :methods
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment