Commit 46260bed authored by Liam Healy's avatar Liam Healy

Default optional/key argument values for arrays

When used as the default optional/key argument values for arrays, the
value symbol 'element-type is replaced with the actual element type
for the method.  This replaces the :make-marray form.  When used as
the default optional/key argument values for arrays, the form
(eltcase element-type form element-type form ...)
will be replaced by the appropriate form.  This replaces the direct
appending of the (element-type form element-type form) list.
SBCL same tests pass.
parent 79a0f72c
;; Matrices
;; Liam Healy 2008-04-15 21:57:52EDT matrix.lisp
;; Time-stamp: <2009-01-05 22:44:13EST matrix.lisp>
;; Time-stamp: <2009-01-08 21:50:38EST matrix.lisp>
;; $Id$
(in-package :gsl)
......@@ -58,7 +58,7 @@
(defmfun row
((matrix matrix) i
&optional (vector :make-marray vector (dim1 matrix)))
&optional (vector (make-marray element-type :dimensions (dim1 matrix))))
("gsl_matrix" :type "_get_row")
(((mpointer vector) :pointer) ((mpointer matrix) :pointer) (i sizet))
:definition :generic
......@@ -83,7 +83,7 @@
(defmfun column
((matrix matrix) i
&optional (vector :make-marray vector (dim0 matrix)))
&optional (vector (make-marray element-type :dimensions (dim0 matrix))))
("gsl_matrix" :type "_get_col")
(((mpointer vector) :pointer) ((mpointer matrix) :pointer) (i sizet))
:definition :generic
......@@ -157,7 +157,8 @@
(defmfun matrix-transpose
((source matrix)
&optional
(destination :make-marray matrix (reverse (dimensions source))))
(destination
(make-marray element-type :dimensions (reverse (dimensions source)))))
("gsl_matrix" :type "_transpose_memcpy")
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :generic
......
;; Eigenvectors and eigenvalues
;; Liam Healy, Sun May 21 2006 - 19:52
;; Time-stamp: <2009-01-05 22:33:35EST eigensystems.lisp>
;; Time-stamp: <2009-01-08 21:49:15EST eigensystems.lisp>
;; $Id$
(in-package :gsl)
......@@ -46,9 +46,9 @@
(defmfun eigenvalues
((A matrix)
&optional
(eigenvalues :make-marray vector (dim0 A))
(ws complex (make-eigen-herm (dim0 A))
t (make-eigen-symm (dim0 A))))
(eigenvalues (make-marray element-type :dimensions (dim0 A)))
(ws (eltcase complex (make-eigen-herm (dim0 A))
t (make-eigen-symm (dim0 A)))))
(double-float "gsl_eigen_symm"
complex-double-float "gsl_eigen_herm")
(((mpointer A) :pointer)
......@@ -71,10 +71,10 @@
(defmfun eigenvalues-eigenvectors
((A matrix)
&optional
(eigenvalues :make-marray vector (dim0 A))
(eigenvectors :make-marray matrix (dimensions A))
(ws complex (make-eigen-hermv (dim0 A))
t (make-eigen-symmv (dim0 A))))
(eigenvalues (make-marray element-type :dimensions (dim0 A)))
(eigenvectors (make-marray element-type :dimensions (dimensions A)))
(ws (eltcase complex (make-eigen-hermv (dim0 A))
t (make-eigen-symmv (dim0 A)))))
(double-float "gsl_eigen_symmv"
complex-double-float "gsl_eigen_hermv")
(((mpointer A) :pointer) ((mpointer eigenvalues) :pointer)
......
;; Helpers for defining GSL functions on arrays
;; Liam Healy 2009-01-07 22:01:16EST defmfun-array.lisp
;; Time-stamp: <2009-01-07 22:01:56EST defmfun-array.lisp>
;; Time-stamp: <2009-01-08 22:02:50EST defmfun-array.lisp>
;; $Id: $
(in-package :gsl)
......@@ -156,23 +156,30 @@
replace-both
(second arg))
element-type))))
(cond ((and (listp arg) (numberp (second arg)))
;; Optional arg default numerical value
(list (first arg)
(coerce (second arg) element-type)))
((and (listp arg) (eql (second arg) :make-marray))
;; Optional arg replace class
(list (first arg)
`(make-marray ',element-type
:dimensions ,(fourth arg))))
((and (listp arg) (> (length arg) 4))
;; Optional arg switch default based on element type
(list (first arg)
(loop for (type sexp) on (rest arg) by #'cddr
until (subtypep element-type type)
finally (return sexp))))
(t arg)))))
;; Default values for optional/key arguments are treated
;; specially for array methods.
(if (and (listp arg) (numberp (second arg)))
(list (first arg) ; Optional arg default numerical value
;; coerce to the right type
(coerce (second arg) element-type))
(if (listp arg)
(if (and (listp (second arg))
(eq (first (second arg)) 'eltcase))
;; "eltcase" switch to the matching form
`(,(first arg)
,(element-type-select (rest (second arg)) element-type))
;; 'element-type is bound to the element-type.
(list
(first arg)
(subst `',element-type 'element-type
(second arg))))
arg)))))
(defun element-type-select (form element-type)
"Find the actual form to use as the default based on the list in form."
(loop for (type result) on form by #'cddr
thereis (when (subtypep element-type type) result)))
(defun arglist-plain-and-categories
(arglist &optional (include-llk t))
"Get arglist without classes and a list of categories."
......
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