Commit 65a33d3e authored by Liam Healy's avatar Liam Healy

New directory "calculus" and small changes

New directory "calculus" to hold numerical-differentiation,
numerical-integeration, and monte-carlo.  Converted some return array
arguments in BLAS to optional arguments.  Define a condition
'obsolete-gsl-version to use in #'complete-definition.  Try to
incorporate cygwin into init.lisp; needs testing by a cygwin user.
parent b484c1d1
This diff is collapsed.
;; Helpers that define a single GSL function interface
;; Liam Healy 2009-01-07 22:02:20EST defmfun-single.lisp
;; Time-stamp: <2009-01-14 22:03:12EST defmfun-single.lisp>
;; Time-stamp: <2009-01-15 22:27:56EST defmfun-single.lisp>
;; $Id: $
(in-package :gsl)
;;;;****************************************************************************
;;;; A single function
;;;;****************************************************************************
(defun defgeneric-method-p (name)
"When defining :method in a defgeneric, (nil foo) is used for
the name, and foo will be returned from this function."
......@@ -57,6 +53,23 @@
(native-pointer-protect array-symbols body)
body))
(define-condition obsolete-gsl-version (error)
((name :initarg :name :reader name)
(gsl-name :initarg :gsl-name :reader gsl-name)
(gsl-version :initarg :gsl-version :reader gsl-version))
(:report
(lambda (condition stream)
(apply 'format stream
"Function ~a (~a) is not available in the ~
~%currently loaded releases ~a of GSL; it was introduced in release ~d.~d."
(name condition)
(gsl-name condition)
*gsl-version*
(gsl-version condition))))
(:documentation
"An error indicating that the currently loaded version of the GSL libary
does not have the function defined."))
(defun complete-definition
(definition name arglist gsl-name c-arguments key-args
&optional
......@@ -107,12 +120,8 @@
,@(when qualifier (list qualifier))
(&rest args)
(declare (ignore args))
(error
,(apply 'format
nil
"Function ~a (~a) is not available in your current version ~
~a of GSL; it was introduced in version ~d.~d."
name gsl-name *gsl-version* gsl-version))))))
(error 'obsolete-gsl-version
:name ',name :gsl-name ,gsl-name :gsl-version ',gsl-version)))))
(defun wrap-letlike (when binding wrapping body)
(if when
......
;; Load GSL
;; Liam Healy Sat Mar 4 2006 - 18:53
;; Time-stamp: <2008-12-27 09:33:09EST init.lisp>
;; Time-stamp: <2009-01-15 22:10:30EST init.lisp>
;; $Id$
(defpackage gsll
......@@ -8,19 +8,27 @@
(:use :common-lisp :cffi :cl-utilities))
(cffi:define-foreign-library libgslcblas
(:darwin
(:or "/opt/local/lib/libgslcblas.dylib" "/sw/lib/libgslcblas.dylib"
"/usr/local/lib/libgslcblas.dylib"))
(:darwin
(:or "/opt/local/lib/libgslcblas.dylib" "/sw/lib/libgslcblas.dylib"
"/usr/local/lib/libgslcblas.dylib"))
(:cygwin (:or "/bin/cyggslcblas-0.dll"))
(:unix (:or "/usr/lib/libgslcblas.so.0" "/usr/lib/libgslcblas.so"
"/usr/lib64/libgslcblas.so.0" "/usr/lib64/libgslcblas.so"))
(t (:default "libgslcblas")))
(cffi:use-foreign-library libgslcblas)
;; When calling libgsl from emacs built for windows and slime, and
;; using clisp built for cygwin, we have to load lapack/cygblas.dll
;; before loading cyggsl-0.dll
#+(and clisp cygwin)
(cffi:load-foreign-library "/lib/lapack/cygblas.dll")
(cffi:define-foreign-library libgsl
(:darwin
(:or "/opt/local/lib/libgsl.dylib" "/sw/lib/libgsl.dylib"
"/usr/local/lib/libgsl.dylib"))
(:darwin
(:or "/opt/local/lib/libgsl.dylib" "/sw/lib/libgsl.dylib"
"/usr/local/lib/libgsl.dylib"))
(:cygwin (:or "/bin/cyggsl-0.dll"))
(:unix (:or "/usr/lib/libgsl.so.0" "/usr/lib/libgsl.so"
"/usr/lib64/libgsl.so.0" "/usr/lib64/libgsl.so"))
(t (:default "libgsl")))
......
;; BLAS level 1, Vector operations
;; Liam Healy, Wed Apr 26 2006 - 15:23
;; Time-stamp: <2008-12-26 16:30:16EST blas1.lisp>
;; Time-stamp: <2009-01-15 21:28:41EST blas1.lisp>
;; $Id$
(in-package :gsl)
......@@ -92,7 +92,10 @@
:documentation ; FDL
"Copy the elements of the vector x into the vector y.")
(defmfun axpy (alpha (x vector) (y vector))
(defmfun axpy
(alpha (x vector)
&optional
(y (make-marray element-type :dimensions (dimensions x))))
;; This gets an error for complex types because you can't pass a
;; struct in CFFI yet.
("gsl_blas_" :type "axpy")
......
;; BLAS level 2, Matrix-vector operations
;; Liam Healy, Wed Apr 26 2006 - 21:08
;; Time-stamp: <2008-12-29 22:14:14EST blas2.lisp>
;; Time-stamp: <2009-01-15 21:45:11EST blas2.lisp>
;; $Id$
(in-package :gsl)
......@@ -27,10 +27,18 @@
;;;; Functions
;;;;****************************************************************************
(defun matrix-product-dimensions (a b)
(if (typep b 'matrix)
(list (first (dimensions a))
(second (dimensions a)))
(first (dimensions a))))
;;; To do: the y should be an optional argument, default to a zero vector.
(defmfun matrix-product
((A matrix) (x vector) (y vector)
&optional (alpha 1) (beta 1) (TransA :notrans) TransB)
((A matrix) (x vector)
&optional
(y (make-marray element-type :dimensions (matrix-product-dimensions A x)))
(alpha 1) (beta 1) (TransA :notrans) TransB)
("gsl_blas_" :type "gemv")
((transa cblas-transpose) (alpha :element-c-type) ((mpointer A) :pointer)
((mpointer x) :pointer) (beta :element-c-type) ((mpointer y) :pointer))
......@@ -113,8 +121,10 @@
matrix A are taken as unity and are not referenced.")
(defmfun matrix-product-symmetric
((A matrix) (x vector) (y vector)
&optional (alpha 1) (beta 1) (uplo :upper) (side :left))
((A matrix) (x vector)
&optional
(y (make-marray element-type :dimensions (matrix-product-dimensions A x)))
(alpha 1) (beta 1) (uplo :upper) (side :left))
("gsl_blas_" :type "symv")
((uplo cblas-uplo) (alpha :element-c-type) ((mpointer A) :pointer)
((mpointer x) :pointer) (beta :element-c-type) ((mpointer y) :pointer))
......@@ -139,8 +149,10 @@
and diagonal of A are used.")
(defmfun matrix-product-hermitian
((A matrix) (x vector) (y vector)
&optional (alpha 1) (beta 1) (uplo :upper) (side :left))
((A matrix) (x vector)
&optional
(y (make-marray element-type :dimensions (matrix-product-dimensions A x)))
(alpha 1) (beta 1) (uplo :upper) (side :left))
;; This always signals an error because you can't pass a
;; struct in CFFI yet.
("gsl_blas_" :type "hemv")
......
;; BLAS level 3, Matrix-matrix operations
;; Liam Healy, Wed Apr 26 2006 - 21:08
;; Time-stamp: <2008-12-29 21:57:02EST blas3.lisp>
;; Time-stamp: <2009-01-15 21:49:10EST blas3.lisp>
;; $Id$
(in-package :gsl)
......@@ -20,8 +20,10 @@
;;;;****************************************************************************
(defmfun matrix-product
((A matrix) (B matrix) (C matrix)
&optional (alpha 1) (beta 1) (TransA :notrans) (TransB :notrans))
((A matrix) (B matrix)
&optional
(C (make-marray element-type :dimensions (matrix-product-dimensions A B)))
(alpha 1) (beta 1) (TransA :notrans) (TransB :notrans))
("gsl_blas_" :type "gemm")
((TransA cblas-transpose) (TransB cblas-transpose)
(alpha :element-c-type) ((mpointer A) :pointer)
......@@ -32,8 +34,10 @@
:outputs (C))
(defmfun matrix-product-symmetric
((A matrix) (B matrix) (C matrix)
&optional (alpha 1) (beta 1) (uplo :upper) (side :left))
((A matrix) (B matrix)
&optional
(C (make-marray element-type :dimensions (matrix-product-dimensions A B)))
(alpha 1) (beta 1) (uplo :upper) (side :left))
("gsl_blas_" :type "symm")
((side cblas-side) (uplo cblas-uplo) (alpha :element-c-type)
((mpointer A) :pointer) ((mpointer B) :pointer)
......@@ -44,8 +48,10 @@
:outputs (C))
(defmfun matrix-product-hermitian
((A matrix) (B matrix) (C matrix)
&optional (alpha 1) (beta 1) (uplo :upper) (side :left))
((A matrix) (B matrix)
&optional
(C (make-marray element-type :dimensions (matrix-product-dimensions A B)))
(alpha 1) (beta 1) (uplo :upper) (side :left))
;; This always signals an error because you can't pass a
;; struct in CFFI yet.
("gsl_blas_" :type "hemm")
......
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