diff --git a/calculus/monte-carlo.lisp b/calculus/monte-carlo.lisp index 853b9bfa8e309c0f45c965553a1741bf8cac01dd..e88f4b814feb323aa57f856af938424e04ea220d 100644 --- a/calculus/monte-carlo.lisp +++ b/calculus/monte-carlo.lisp @@ -1,6 +1,6 @@ ;; Monte Carlo Integration ;; Liam Healy Sat Feb 3 2007 - 17:42 -;; Time-stamp: <2009-04-04 22:34:29EDT monte-carlo.lisp> +;; Time-stamp: <2009-04-26 23:21:18EDT monte-carlo.lisp> ;; $Id$ (in-package :gsl) @@ -44,7 +44,7 @@ ((dim0 lower-limits) sizet) (number-of-samples sizet) ((mpointer generator) :pointer) ((mpointer state) :pointer) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :inputs (lower-limits upper-limits) :callbacks (callback fnstruct-dimension (dimension) @@ -130,7 +130,7 @@ ((dim0 lower-limits) sizet) (number-of-samples sizet) ((mpointer generator) :pointer) ((mpointer state) :pointer) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :inputs (lower-limits upper-limits) :callbacks (callback fnstruct-dimension (dimension) @@ -226,7 +226,7 @@ ((dim0 lower-limits) sizet) (number-of-samples sizet) ((mpointer generator) :pointer) ((mpointer state) :pointer) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :inputs (lower-limits upper-limits) :callbacks (callback fnstruct-dimension (dimension) diff --git a/calculus/numerical-differentiation.lisp b/calculus/numerical-differentiation.lisp index 60be5847b2edd3968db76f1c0e7154e3c4f5ca82..3da56a910bc1add5423e2c68542a98594778a154 100644 --- a/calculus/numerical-differentiation.lisp +++ b/calculus/numerical-differentiation.lisp @@ -1,19 +1,16 @@ ;; Numerical differentiation. ;; Liam Healy Mon Nov 12 2007 - 22:07 -;; Time-stamp: <2009-04-04 22:24:31EDT numerical-differentiation.lisp> +;; Time-stamp: <2009-04-26 23:23:53EDT numerical-differentiation.lisp> ;; $Id$ (in-package :gsl) -;;; The example at the end needs to be made into a regression test. -;;; GSL function "callback" passing is identical to -;;; numerical-integration, so those definitions have been used. -;;; Some improvement could be made in naming/organization. +;;; /usr/include/gsl/gsl_diff.h (defmfun central-derivative (function x step) "gsl_deriv_central" ((callback :pointer) (x :double) (step :double) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -36,7 +33,7 @@ (defmfun forward-derivative (function x step) "gsl_deriv_forward" ((callback :pointer) (x :double) (step :double) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -61,7 +58,7 @@ (defmfun backward-derivative (function x step) "gsl_deriv_backward" ((callback :pointer) (x :double) (step :double) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) diff --git a/calculus/numerical-integration-with-tables.lisp b/calculus/numerical-integration-with-tables.lisp index c885afef9e30848c546d81532b2afc317bee837d..080d7e47532e39168080105c3f53f2435d57969d 100644 --- a/calculus/numerical-integration-with-tables.lisp +++ b/calculus/numerical-integration-with-tables.lisp @@ -1,6 +1,6 @@ ;; Numerical integration techniques that require tables ;; Liam Healy 2009-04-04 15:24:05EDT -;; Time-stamp: <2009-04-04 22:27:18EDT numerical-integration-with-tables.lisp> +;; Time-stamp: <2009-04-26 23:20:16EDT numerical-integration-with-tables.lisp> ;; $Id: $ (in-package :gsl) @@ -48,7 +48,7 @@ ((mpointer table) :pointer) (absolute-error :double) (relative-error :double) (limit sizet) ((mpointer workspace) :pointer) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -109,7 +109,7 @@ (absolute-error :double) (relative-error :double) (limit sizet) ((mpointer workspace) :pointer) ((mpointer table) :pointer) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -153,7 +153,7 @@ (limit sizet) ((mpointer workspace) :pointer) ((mpointer cycle-workspace) :pointer) ((mpointer table) :pointer) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) diff --git a/calculus/numerical-integration.lisp b/calculus/numerical-integration.lisp index fa6a784614297595ac9e8ef1185c2600dfd906c9..cd0e880af0a36df5a6ac90ce64c379055646b677 100644 --- a/calculus/numerical-integration.lisp +++ b/calculus/numerical-integration.lisp @@ -1,6 +1,6 @@ ;; Numerical integration ;; Liam Healy, Wed Jul 5 2006 - 23:14 -;; Time-stamp: <2009-04-04 22:25:57EDT numerical-integration.lisp> +;; Time-stamp: <2009-04-26 23:19:49EDT numerical-integration.lisp> ;; $Id$ (in-package :gsl) @@ -34,7 +34,8 @@ ((callback :pointer) (a :double) (b :double) (absolute-error :double) (relative-error :double) - (result :double) (abserr :double) (neval sizet)) + (result (:pointer :double)) (abserr (:pointer :double)) + (neval (:pointer sizet))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -78,7 +79,7 @@ (a :double) (b :double) (absolute-error :double) (relative-error :double) (limit sizet) (method integrate-method) ((mpointer workspace) :pointer) - (result :double) (abserr :double)) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -114,7 +115,8 @@ ((callback :pointer) (a :double) (b :double) (absolute-error :double) (relative-error :double) (limit sizet) - ((mpointer workspace) :pointer) (result :double) (abserr :double)) + ((mpointer workspace) :pointer) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -146,7 +148,8 @@ ((callback :pointer) ((c-pointer points) :pointer) ((dim0 points) sizet) (absolute-error :double) (relative-error :double) (limit sizet) - ((mpointer workspace) :pointer) (result :double) (abserr :double)) + ((mpointer workspace) :pointer) + (result (:pointer :double)) (abserr (:pointer :double))) :inputs (points) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) @@ -176,7 +179,8 @@ "gsl_integration_qagi" ((callback :pointer) (absolute-error :double) (relative-error :double) (limit sizet) - ((mpointer workspace) :pointer) (result :double) (abserr :double)) + ((mpointer workspace) :pointer) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -200,7 +204,8 @@ "gsl_integration_qagiu" ((callback :pointer) (a :double) (absolute-error :double) (relative-error :double) (limit sizet) - ((mpointer workspace) :pointer) (result :double) (abserr :double)) + ((mpointer workspace) :pointer) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -220,7 +225,8 @@ "gsl_integration_qagil" ((callback :pointer) (b :double) (absolute-error :double) (relative-error :double) (limit sizet) - ((mpointer workspace) :pointer) (result :double) (abserr :double)) + ((mpointer workspace) :pointer) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) @@ -245,7 +251,8 @@ ((callback :pointer) (a :double) (b :double) (c :double) (absolute-error :double) (relative-error :double) (limit sizet) - ((mpointer workspace) :pointer) (result :double) (abserr :double)) + ((mpointer workspace) :pointer) + (result (:pointer :double)) (abserr (:pointer :double))) :callbacks (callback fnstruct nil (function :double (:input :double) :slug)) :callback-dynamic (nil (function)) diff --git a/chebyshev.lisp b/chebyshev.lisp index 3eb896919f52869140c2a15770b29cec6f2f3779..e0879d69414c87e2a4df9c6fa061a0d12a37630b 100644 --- a/chebyshev.lisp +++ b/chebyshev.lisp @@ -1,6 +1,6 @@ ;; Chebyshev Approximations ;; Liam Healy Sat Nov 17 2007 - 20:36 -;; Time-stamp: <2009-04-04 22:27:16EDT chebyshev.lisp> +;; Time-stamp: <2009-04-26 23:25:30EDT chebyshev.lisp> ;; $Id$ (in-package :gsl) @@ -63,10 +63,10 @@ (defmfun evaluate-chebyshev-error (chebyshev x &optional order) ("gsl_cheb_eval_err" "gsl_cheb_eval_n_err") - ((((mpointer chebyshev) :pointer) (x :double) (result :double) - (abserr :double)) + ((((mpointer chebyshev) :pointer) (x :double) + (result (:pointer :double)) (abserr (:pointer :double))) (((mpointer chebyshev) :pointer) (order sizet) (x :double) - (result :double) (abserr :double))) + (result (:pointer :double)) (abserr (:pointer :double)))) :documentation ; FDL "Evaluate the Chebyshev series at a point x, returning result and an estimate of its absolute error. If order is supplied, diff --git a/data/array-tests.lisp b/data/array-tests.lisp index 4d8d554dc5b828fa63b22e744b8de55307fdef25..e656bfec192f113d9d567f731480871ee1d31de9 100644 --- a/data/array-tests.lisp +++ b/data/array-tests.lisp @@ -1,6 +1,6 @@ ;; Tests of array functions ;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp -;; Time-stamp: <2009-04-15 23:28:05EDT array-tests.lisp> +;; Time-stamp: <2009-05-03 16:59:30EDT array-tests.lisp> ;; $Id: $ ;;; Generate each file with #'write-test-to-file, e.g. @@ -15,17 +15,13 @@ ;;;; Bulk operations ;;;;**************************************************************************** -(generate-all-array-tests vector-set-all-add :no-complex - (let ((v1 (array-default 3 t)) - (v2 (array-default 3))) - (set-all v1 (scalar-default)) - (cl-array (elt+ v1 v2)))) +(generate-all-array-tests vector-set-all #+fsbv t #-fsbv :no-complex + (let ((v1 (array-default 3 t))) + (cl-array (set-all v1 (scalar-default))))) -(generate-all-array-tests matrix-set-all-add :no-complex - (let ((m1 (array-default '(3 3) t)) - (m2 (array-default '(3 3)))) - (set-all m1 (scalar-default)) - (cl-array (elt+ m1 m2)))) +(generate-all-array-tests matrix-set-all #+fsbv t #-fsbv :no-complex + (let ((m1 (array-default '(3 3) t))) + (cl-array (set-all m1 (scalar-default))))) (generate-all-array-tests vector-set-zero t (let ((v1 (array-default 3))) @@ -59,6 +55,8 @@ ;;;; Arithmetic operations ;;;;**************************************************************************** +;;; In GSL versions >= 1.12, :no-complex can be changed to T. + (generate-all-array-tests vector-add :no-complex (let ((v1 (array-default 3)) (v2 (array-default 3))) diff --git a/data/both.lisp b/data/both.lisp index 91c346388db4ed0f20e977bad4d5ea029d6f2a8b..9bfbfac0fb693944c91c36a7a3561d8218f33117 100644 --- a/data/both.lisp +++ b/data/both.lisp @@ -1,6 +1,6 @@ ;; Functions for both vectors and matrices. ;; Liam Healy 2008-04-26 20:48:44EDT both.lisp -;; Time-stamp: <2009-03-18 11:08:31EDT both.lisp> +;; Time-stamp: <2009-05-03 11:24:50EDT both.lisp> ;; $Id$ (in-package :gsl) @@ -39,6 +39,7 @@ ("gsl_" :category :type "_set_all") (((mpointer object) :pointer) (value :element-c-type)) :definition :generic + :element-types #+fsbv t #-fsbv :no-complex :inputs (object) :outputs (object) :c-return :void @@ -90,6 +91,7 @@ ("gsl_" :category :type "_set") (((mpointer object) :pointer) (index sizet) (value :element-c-type)) :definition :generic + :element-types #+fsbv t #-fsbv :no-complex :inputs (object) :outputs (object) :c-return :void @@ -247,7 +249,9 @@ (defmfun minmax ((a both)) ("gsl_" :category :type "_minmax") - (((mpointer a) :pointer) (min :element-c-type) (max :element-c-type)) + (((mpointer a) :pointer) + (min (:pointer :element-c-type)) + (max (:pointer :element-c-type))) :definition :generic :element-types :no-complex :inputs (a) @@ -268,7 +272,7 @@ (defmfun min-index ((a matrix)) ("gsl_" :category :type "_min_index") - (((mpointer a) :pointer) (imin sizet) (jmin sizet)) + (((mpointer a) :pointer) (imin (:pointer sizet)) (jmin (:pointer sizet))) :definition :methods :element-types :no-complex :inputs (a) @@ -287,7 +291,7 @@ (defmfun max-index ((a matrix)) ("gsl_" :category :type "_max_index") - (((mpointer a) :pointer) (imax sizet) (jmax sizet)) + (((mpointer a) :pointer) (imin (:pointer sizet)) (jmin (:pointer sizet))) :definition :methods :element-types :no-complex :inputs (a) @@ -295,7 +299,7 @@ (defmfun minmax-index ((a vector)) ("gsl_" :category :type "_minmax_index") - (((mpointer a) :pointer) (imin sizet) (imax sizet)) + (((mpointer a) :pointer) (imin (:pointer sizet)) (jmin (:pointer sizet))) :definition :generic :element-types :no-complex :inputs (a) @@ -308,7 +312,9 @@ (defmfun minmax-index ((a matrix)) ("gsl_" :category :type "_minmax_index") - (((mpointer a) :pointer) (imin sizet) (jmin sizet) (imax sizet) (jmax sizet)) + (((mpointer a) :pointer) + (imin (:pointer sizet)) (jmin (:pointer sizet)) + (imax (:pointer sizet)) (jmax (:pointer sizet))) :definition :methods :element-types :no-complex :inputs (a) diff --git a/data/permutation.lisp b/data/permutation.lisp index a77d851616d68a52afe7a0b19bfa866395bad2f6..375178bcbd476e7226e245fcd96d8100c9abc06e 100644 --- a/data/permutation.lisp +++ b/data/permutation.lisp @@ -1,6 +1,6 @@ ;; Permutations ;; Liam Healy, Sun Mar 26 2006 - 11:51 -;; Time-stamp: <2009-03-17 20:27:01EDT permutation.lisp> +;; Time-stamp: <2009-04-26 22:47:28EDT permutation.lisp> ;; $Id$ (in-package :gsl) @@ -223,7 +223,7 @@ (defmfun permute-inverse (p (data #.+foreign-pointer-class+) &optional (size 1) (stride 1)) "gsl_permute_inverse" - (((mpointer p) :pointer) (data :pointer) (stride sizet) (n sizet)) + (((mpointer p) :pointer) (data :pointer) (stride sizet) (stride sizet)) :definition :method :inputs (p data) :outputs (data) diff --git a/documentation/index.html b/documentation/index.html index cacee1448a41be43b48634bce517a378855dce26..74a4402943de7c21b13e70f3cb2ac09602e77f7c 100644 --- a/documentation/index.html +++ b/documentation/index.html @@ -115,6 +115,8 @@ version 0.10.0 or newer; callbacks and <code>foreign-funcall</code> must be supp <li><a href="http://www.cliki.net/asdf">ASDF</a></li> <li><a href="http://repo.or.cz/w/lisp-unit.git">lisp-unit</a>, <i>(Optional)</i> necessary to run <code>gsll-tests</code> +<li><a href="http://repo.or.cz/w/fsbv.git">FSBV</a>, <i>(Optional)</i> necessary + for functions using complex scalars </li> </ul> @@ -135,7 +137,9 @@ version 0.10.0 or newer; callbacks and <code>foreign-funcall</code> must be supp <p>Download/update: <ul> <li><code>git clone git://repo.or.cz/gsll.git</code></li> - <li><code>git pull</code> in the <code>gsll</code> directory + <li><code>git clone git://repo.or.cz/fsbv.git</code></li> + <li><code>git pull</code> in the <code>gsll</code> and + <code>fsbv</code> directories afterwards to update</li> </ul> <p>The <a href="http://repo.or.cz/w/gsll.git"> repository web page</a> @@ -147,11 +151,24 @@ Then in Lisp, load the system: <ul> <li><code>(asdf:operate 'asdf:load-op :gsll)</code></li> </ul> + <p>If you wish to run the test suite, you must get lisp-unit and make + it known to ASDF: + <ul> + <li><code>git clone git://repo.or.cz/lisp-unit.git</code></li> + </ul> + <p>The test suite may be run with + <ul> + <li><code>(asdf:operate 'asdf:load-op :gsll-tests)</code></li> + <li><code>(in-package :gsl)</code></li> + <li><code>(lisp-unit:run-tests)</code></li> + </ul> + <p>Please see <a href="status.text">status.text</a> for known failures. <h3>With <a href="http://common-lisp.net/project/clbuild/">clbuild</a></h3> <p> Add the following to <code>wnpp-projects</code>: <ul> <li><code>gsll get_git git://repo.or.cz/gsll.git</code></li> + <li><code>fsbv get_git git://repo.or.cz/fsbv.git</code></li> <li><code>trivial-garbage get_darcs http://common-lisp.net/~loliveira/darcs/trivial-garbage</code></li> </ul> <p>and add @@ -166,30 +183,20 @@ from within the clbuild directory: </ul> <h3>With Debian or Ubuntu</h3> <ul> - <li><code>sudo aptitude install libgsl0-dev cl-cffi</code></li> + <li><code>sudo aptitude install libgsl0-dev cl-cffi libffi-dev</code></li> <li><code>git clone git://repo.or.cz/gsll.git</code></li> + <li><code>git clone git://repo.or.cz/fsbv.git</code></li> <li><code>darcs get http://common-lisp.net/~loliveira/darcs/trivial-garbage</code></li> <li><code>clc-register-user-package trivial-garbage/trivial-garbage.asd</code></li> <li><code>clc-register-user-package gsll/gsll.asd</code></li> <li><code>clc-register-user-package gsll/gsll-tests.asd</code></li> + <li><code>clc-register-user-package fsbv/fsbv.asd</code></li> </ul> <p> After starting your Lisp implementation, <ul> - <li><code>(clc:clc-require :gsll)</code></li> + <li><code>(clc:clc-require :gsll-tests)</code></li> </ul> - <h3>Test suite</h3> - <p>You must get the test suite lisp-unit: - <ul> - <li><code>git clone git://repo.or.cz/lisp-unit.git</code></li> - </ul> - <p>The test suite may be run with - <ul> - <li><code>(asdf:operate 'asdf:load-op :gsll-tests)</code></li> - <li><code>(in-package :gsl)</code></li> - <li><code>(lisp-unit:run-tests)</code></li> - </ul> - <p>Please see <a href="status.text">status.text</a> for known failures. <h3>License</h3> <p> This software is distributed under @@ -386,7 +393,7 @@ and arrays used internally or for function return. <!-- Created: Feb 25 2005 --> <!-- hhmts start --> <small> -Time-stamp: <2009-04-04 18:01:52EDT index.html> +Time-stamp: <2009-05-03 16:52:48EDT index.html> </small> <!-- hhmts end --> </div> diff --git a/gsll-tests.asd b/gsll-tests.asd index 7c2a6689d374de564754fa01045dfbebf199cbde..5c721d57b845b7c1676c0d297f8f4e2f7051c1d9 100644 --- a/gsll-tests.asd +++ b/gsll-tests.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2009-04-15 23:26:17EDT gsll-tests.asd> +;; Time-stamp: <2009-05-03 16:59:16EDT gsll-tests.asd> (asdf:defsystem "gsll-tests" :name "gsll-tests" @@ -102,12 +102,12 @@ (:file "matrix-sub") (:file "matrix-add") (:file "matrix-mult") - (:file "matrix-product-hermitian") + #+fsbv (:file "matrix-product-hermitian") (:file "matrix-product") (:file "matrix-product-nonsquare") (:file "matrix-product-symmetric") (:file "matrix-product-triangular") - (:file "matrix-set-all-add") + (:file "matrix-set-all") (:file "matrix-set-zero") (:file "matrix-standard-deviation") (:file "matrix-standard-deviation-with-fixed-mean") @@ -180,7 +180,7 @@ (:file "vector-add") (:file "vector-mult") (:file "vector-reverse") - (:file "vector-set-all-add") + (:file "vector-set-all") (:file "vector-set-zero") (:file "vector-standard-deviation") (:file "vector-standard-deviation-with-fixed-mean") diff --git a/gsll.asd b/gsll.asd index da8432d67e3ca096808931716b869fbdc2c8af54..7c1b961822c86d4afbce26206b1c4f82b266ec2e 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,15 +1,18 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2009-04-04 22:32:18EDT gsll.asd> +;; Time-stamp: <2009-05-03 09:37:17EDT gsll.asd> ;; $Id$ +(when (asdf:find-system :fsbv nil) + (pushnew :fsbv *features*)) + (asdf:defsystem "gsll" :name "gsll" :description "GNU Scientific Library for Lisp." :version "0" :author "Liam M. Healy" :licence "LLGPL v3, FDL" - :depends-on (cffi trivial-garbage) + :depends-on (cffi trivial-garbage #+fsbv fsbv) :components ((:module init :components @@ -33,6 +36,7 @@ (:file "defmfun" :depends-on (init forms element-types interface)) (:file "defmfun-array" :depends-on (defmfun callback-included)) (:file "defmfun-single" :depends-on (defmfun mobject callback)) + (:file "body-expand" :depends-on (defmfun mobject callback)) (:file "generate-examples" :depends-on (init)))) (:module floating-point :depends-on (init) @@ -43,6 +47,7 @@ :depends-on (init) :components ((:file "mathematical") + #+fsbv (:file "complex"))) (:module data :depends-on (init) diff --git a/histogram/statistics.lisp b/histogram/statistics.lisp index 2ab7d47871bcbfe936fb72c9acddbdb062555383..2fb48e2aea37b6d45cf6cae87a817c3b3f83a62c 100644 --- a/histogram/statistics.lisp +++ b/histogram/statistics.lisp @@ -1,10 +1,13 @@ ;; Statistics of histograms. ;; Liam Healy, Mon Jan 1 2007 - 16:13 -;; Time-stamp: <2008-12-26 14:46:23EST statistics.lisp> +;; Time-stamp: <2009-04-26 23:15:55EDT statistics.lisp> ;; $Id$ (in-package :gsl) +;;; /usr/include/gsl/gsl_histogram.h +;;; /usr/include/gsl/gsl_histogram2d.h + (defmfun mmax ((histogram histogram)) "gsl_histogram_max_val" (((mpointer histogram) :pointer)) @@ -50,7 +53,7 @@ (defmfun max-index ((histogram histogram2d)) "gsl_histogram2d_max_bin" (((mpointer histogram) :pointer) - (xindex sizet) (yindex sizet)) + (xindex (:pointer sizet)) (yindex (:pointer sizet))) :definition :method :c-return :void :documentation ; FDL @@ -71,7 +74,7 @@ (defmfun min-index ((histogram histogram2d)) "gsl_histogram2d_min_bin" (((mpointer histogram) :pointer) - (xindex sizet) (yindex sizet)) + (xindex (:pointer sizet)) (yindex (:pointer sizet))) :definition :method :c-return :void :documentation ; FDL diff --git a/histogram/updating-accessing.lisp b/histogram/updating-accessing.lisp index 14be3f90bd919696e7627e19308f6f03d9bfab63..b7344d49cfc1c958821b3c7c8670b242a08c3f8a 100644 --- a/histogram/updating-accessing.lisp +++ b/histogram/updating-accessing.lisp @@ -1,10 +1,13 @@ ;; Updating and accessing histogram elements. ;; Liam Healy, Mon Jan 1 2007 - 14:43 -;; Time-stamp: <2008-12-26 11:58:11EST updating-accessing.lisp> +;; Time-stamp: <2009-04-26 23:13:17EDT updating-accessing.lisp> ;; $Id$ (in-package :gsl) +;;; /usr/include/gsl/gsl_histogram.h +;;; /usr/include/gsl/gsl_histogram2d.h + (defmfun increment (histogram value &optional weight) ("gsl_histogram_increment" "gsl_histogram_accumulate") ((((mpointer histogram) :pointer) (value :double)) @@ -37,7 +40,7 @@ (defmfun range (histogram i) "gsl_histogram_get_range" (((mpointer histogram) :pointer) (i sizet) - (lower :double) (upper :double)) + (lower (:pointer :double)) (upper (:pointer :double))) :documentation ; FDL "Find the upper and lower range limits of the i-th bin of the histogram. If the index i is valid then the @@ -79,9 +82,9 @@ (defmfun histogram-find (histogram x-value &optional y-value) ("gsl_histogram_find" "gsl_histogram2d_find") - ((((mpointer histogram) :pointer) (x-value :double) (bin sizet)) + ((((mpointer histogram) :pointer) (x-value :double) (bin (:pointer sizet))) (((mpointer histogram) :pointer) (x-value :double) (y-value :double) - (xbin sizet) (ybin sizet))) + (xbin (:pointer sizet)) (ybin (:pointer sizet)))) :documentation ; FDL "Finds the bin number which covers the coordinate value in the histogram. The bin is located using a binary search. The diff --git a/init/body-expand.lisp b/init/body-expand.lisp new file mode 100644 index 0000000000000000000000000000000000000000..f9daf3e4072211ad3aff98fd698edce760cfea6a --- /dev/null +++ b/init/body-expand.lisp @@ -0,0 +1,195 @@ +;; Expand the body of a defmfun +;; Liam Healy 2009-04-13 22:07:13EDT body-expand.lisp +;; Time-stamp: <2009-05-03 16:31:28EDT body-expand.lisp> +;; $Id: $ + +(in-package :gsl) + +(defun creturn-st (c-return) + "The symbol-type of the return from the C function." + (make-st + (if (listp c-return) + (st-symbol c-return) + (make-symbol "CRETURN")) + (if (member c-return *special-c-return*) + :int + (if (listp c-return) (st-type c-return) c-return)))) + +(defparameter *c-types-passed-by-value* + '(complex-float-c complex-double-c)) + +(defun variables-passed-by-value (c-arguments-st) + "Create a list of (symbol newsymbol-st) for each structure + variable in the C argument list." + (loop for sd in c-arguments-st + collect + (when (member (st-type sd) *c-types-passed-by-value*) + (list (st-symbol sd) + (make-st + (make-symbol (string (st-symbol sd))) + (st-type sd)))))) + +(defun substitute-symbols (substlist st-list) + "Substitute in the new symbols for the old in the st list." + (loop for pair in substlist + with answer = st-list + do + (setf answer + (subst + (st-symbol (second pair)) + (first pair) + answer + :test 'st-symbol)) + finally (return answer))) + +;;; This function should never be called even when FSBV is absent, +;;; because the potential callers should all have #-fsbv +;;; conditionalization. It is here just so that body-expand can +;;; compile when FSBV is absent. +#-fsbv +(defmacro no-fsbv-error (function-name &rest args) + (declare (ignore args)) + `(error + "System FSBV is not present, so function ~a cannot be used." + ,function-name)) + +#+fsbv +(defun make-defcfun-for-fsbv (gsl-name ff-args) + "Make a fsbv:defcfun form so that function will be prepped." + (multiple-value-bind (args return-type) + (fsbv:defcfun-args-from-ff-args ff-args) + (let ((gsl-name-symbol (make-symbol gsl-name)) + (symbargs + (mapcar (lambda (st) (make-st (gensym "ARG") (st-type st))) + args))) + (values + `(fsbv:defcfun (,gsl-name-symbol gsl-name) ,return-type + "Function definition generated for FSBV prepping; will actually + be called by fsbv:foreign-funcall" + ,@symbargs) + gsl-name-symbol)))) + +(defun ffexpand (pass-by-value-p gsl-name args) + "Expand the foreign funcall." + (if pass-by-value-p + #+fsbv + (multiple-value-bind (form symbol) + (make-defcfun-for-fsbv gsl-name args) + (declare (special fsbv-functions)) + (push form fsbv-functions) + `(fsbv:foreign-funcall ,symbol ,@args)) + #-fsbv + `(no-fsbv-error no-fsbv-error ,@args) + `(cffi:foreign-funcall ,gsl-name ,@args))) + +(defun body-expand (name arglist gsl-name c-arguments key-args) + "Expand the body (computational part) of the defmfun." + (with-defmfun-key-args key-args + (let* ((creturn-st (creturn-st c-return)) + (allocated-return ; Allocated and then returned from CL function + (mapcar + (lambda (s) + (or (find s c-arguments :key #'st-symbol) + ;; Catch programming errors, usually typos + (error "Could not find ~a among the arguments" s))) + (remove-if + (lambda (s) + (member s (arglist-plain-and-categories arglist nil))) + (variables-used-in-c-arguments c-arguments)))) + (pbv (variables-passed-by-value c-arguments)) ; passed by value + (clret (or ; better as a symbol macro + (substitute + (st-symbol creturn-st) :c-return + (mapcar (lambda (sym) + (let ((it (find sym allocated-return :key 'st-symbol))) + (if it + (first (cl-convert-form it)) + sym))) + return)) + (mappend + #'cl-convert-form + (callback-remove-arg allocated-return cbinfo 'st-symbol)) + outputs + (unless (eq c-return :void) + (list (st-symbol creturn-st)))))) + (wrap-letlike + allocated-return + (mapcar (lambda (d) (wfo-declare d cbinfo)) + allocated-return) + 'cffi:with-foreign-objects + `(,@(append + (callback-symbol-set + callback-dynamic cbinfo (first callback-dynamic-variables)) + before + (when callback-object (callback-set-dynamic callback-object arglist))) + ,@(callback-set-slots + cbinfo callback-dynamic-variables callback-dynamic) + (let ((,(st-symbol creturn-st) + ,(ffexpand (some 'identity pbv) + gsl-name + (append + (mappend + (lambda (arg) + (list (cond + ((member (st-symbol arg) allocated-return) :pointer) + (t (st-type arg))) + (st-symbol arg))) + (mapcar 'st-pointer-generic-pointer c-arguments)) + (list(st-type creturn-st)))))) + ,@(case c-return + (:void `((declare (ignore ,(st-symbol creturn-st))))) + (:error-code ; fill in arguments + `((check-gsl-status ,(st-symbol creturn-st) + ',(or (defgeneric-method-p name) name))))) + #-native + ,@(when outputs + (mapcar + (lambda (x) `(setf (cl-invalid ,x) t (c-invalid ,x) nil)) + outputs)) + ,@(when (eq (st-type creturn-st) :pointer) + `((check-null-pointer + ,(st-symbol creturn-st) + ,@'('memory-allocation-failure "No memory allocated.")))) + ,@after + (values + ,@(defmfun-return + c-return (st-symbol creturn-st) clret + allocated-return + return return-supplied-p + enumeration outputs)))))))) + +(defun defmfun-return + (c-return cret-name clret allocated return return-supplied-p enumeration outputs) + "Generate the return computation expression for defmfun." + (case c-return + (:number-of-answers + (mappend + (lambda (vbl seq) + `((when (> ,cret-name ,seq) ,vbl))) + clret + (loop for i below (length clret) collect i))) + (:success-failure + (if (equal clret outputs) + ;; success-failure more important than passed-in + `((success-failure ,cret-name)) + (remove cret-name ; don't return c-return itself + `(,@clret (success-failure ,cret-name))))) + (:success-continue + (if (equal clret outputs) + ;; success-failure more important than passed-in + `((success-continue ,cret-name)) + (remove cret-name ; don't return c-return itself + `(,@clret (success-continue ,cret-name))))) + (:true-false + `((not (zerop ,cret-name)))) + (:enumerate + `((cffi:foreign-enum-keyword ',enumeration ,cret-name))) + (t (unless + (or + (and (eq c-return :error-code) + (not outputs) + (not allocated) + (not return-supplied-p)) + (and (null return) return-supplied-p)) + clret)))) + diff --git a/init/complex-types.lisp b/init/complex-types.lisp index add28082f44db1c55e3c843cf15fa514e1b98d0d..e48637e715fdf1215269f8c4ac00f3f37a2d76af 100644 --- a/init/complex-types.lisp +++ b/init/complex-types.lisp @@ -1,6 +1,6 @@ ;; Complex number types ;; Liam Healy 2009-01-13 21:24:05EST complex-types.lisp -;; Time-stamp: <2009-01-14 22:45:53EST complex-types.lisp> +;; Time-stamp: <2009-05-03 10:00:23EDT complex-types.lisp> ;; $Id: $ (in-package :gsl) @@ -27,12 +27,22 @@ ;;; cannot use functions that call or return complex scalars. ;;; See /usr/include/gsl/gsl_complex.h -(cffi:defcstruct complex-float-c +#+fsbv +(fsbv:defcstruct + (complex-float-c :constructor complex :deconstructor (realpart imagpart)) (dat :float :count 2)) -(cffi:defcstruct complex-double-c +#-fsbv +(cffi:defcstruct complex-float-c (dat :float :count 2)) + +#+fsbv +(fsbv:defcstruct + (complex-double-c :constructor complex :deconstructor (realpart imagpart)) (dat :double :count 2)) +#-fsbv +(cffi:defcstruct complex-double-c (dat :double :count 2)) + #+long-double (cffi:defcstruct complex-long-double-c (dat :long-double :count 2)) @@ -55,38 +65,3 @@ (second eltype) eltype)) -(define-condition pass-complex-by-value (error) - () - (:report - (lambda (condition stream) - (declare (ignore condition)) - (format stream "Cannot pass complex scalars to GSL functions."))) - (:documentation - "An error indicating that this implementation and platform are - unable to pass complex numbers to the GSL libary by value.")) - -(defun pack-complex-as-double (number) - "Pack a number of type (complex single-float) into a double-float, - which may be accepted as a struct of type gsl_complex_float. - This is hideously non-portable." - (integer-as-float - (dpb - (float-as-integer (imagpart number) t) - (byte 32 32) - (dpb - (float-as-integer (realpart number) t) - (byte 32 0) - 0)) - 'double-float)) - -(defun passing-complex-by-value (cfind) - "Substitution in defmfun so that complex numbers can be passed by - value to the GSL structs defined above. This is non-portable." - (if (eq (component-float-type (cffi-cl (third cfind))) 'single-float) - ;; single-float - `(:double (pack-complex-as-double ,(first cfind))) - ;; double-float - `(:double - (realpart ,(first cfind)) - :double - (imagpart ,(first cfind))))) diff --git a/init/defmfun-array.lisp b/init/defmfun-array.lisp index 080b144a23f378674932807f10f9b686294fd028..bc6a9adca51e6e6a7ad03ebe392dcc129a3ce33c 100644 --- a/init/defmfun-array.lisp +++ b/init/defmfun-array.lisp @@ -1,6 +1,6 @@ ;; Helpers for defining GSL functions on arrays ;; Liam Healy 2009-01-07 22:01:16EST defmfun-array.lisp -;; Time-stamp: <2009-03-07 15:54:48EST defmfun-array.lisp> +;; Time-stamp: <2009-04-26 22:27:10EDT defmfun-array.lisp> ;; $Id: $ (in-package :gsl) @@ -191,30 +191,15 @@ ;; argument, then map this function onto each. (mapcar (lambda (carg) (actual-array-c-type category carg nil)) c-arguments) - (mapcar - (lambda (v) - (if (st-arrayp v) - (make-st (st-symbol v) - (intern - (apply #'concatenate - 'string - (mapcar #'string - (substitute category :category (st-type v)))) - :gsl)) - v)) - c-arguments))) + c-arguments)) (defun actual-element-c-type (element-type c-arguments) "Replace the generic element type :element-c-type with the actual element type." (mapcar (lambda (v) - (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-cffi element-type))) - v)) + (subst (cl-cffi element-type) :element-c-type + (subst (component-type element-type) :component-float-type v))) c-arguments)) ;;; (actual-class-arglist '((v1 vector) (v2 vector) (m matrix) x) '(unsigned-byte 16)) diff --git a/init/defmfun-single.lisp b/init/defmfun-single.lisp index a4aff06153d74b1e1e1b9ac04b6ed17497ac010b..3a8031101fb2fb33a1ce9a065f1f8859c7ec87f4 100644 --- a/init/defmfun-single.lisp +++ b/init/defmfun-single.lisp @@ -1,6 +1,6 @@ ;; Helpers that define a single GSL function interface ;; Liam Healy 2009-01-07 22:02:20EST defmfun-single.lisp -;; Time-stamp: <2009-04-04 21:56:30EDT defmfun-single.lisp> +;; Time-stamp: <2009-04-13 22:09:35EDT defmfun-single.lisp> ;; $Id: $ (in-package :gsl) @@ -11,17 +11,6 @@ (if (and (listp name) (null (first name))) (second name))) -(defun complex-scalars (cl-arguments c-arguments-types) - (loop for sd in c-arguments-types - for cl-type = (cffi-cl (st-type sd)) - append - (when (and cl-type (subtypep cl-type 'complex) - (member (st-symbol sd) - (arglist-plain-and-categories cl-arguments))) - (list (list (st-symbol sd) - (gensym (string (st-symbol sd))) - (st-type sd)))))) - (defun stupid-code-walk-find-variables (sexp) "This will work with the simplest s-expression forms only to find variables used." @@ -140,125 +129,3 @@ (intersection (union inputs outputs) (arglist-plain-and-categories arglist nil)) (body-expand name arglist gsl-name c-arguments key-args)))) - -(defun body-expand (name arglist gsl-name c-arguments key-args) - "Expand the body (computational part) of the defmfun." - (with-defmfun-key-args key-args - (let* ((cret-type (if (member c-return *special-c-return*) - :int - (if (listp c-return) (st-type c-return) c-return))) - (cret-name - (if (listp c-return) (st-symbol c-return) (make-symbol "CRETURN"))) - (complex-args (complex-scalars arglist c-arguments)) - (allocated ; Foreign objects to be allocated - (remove-if - (lambda (s) - (member s (arglist-plain-and-categories arglist nil))) - (variables-used-in-c-arguments c-arguments))) - (allocated-decl - (mapcar - (lambda (s) - (or (find s c-arguments :key #'st-symbol) - ;; Catch programming errors, usually typos - (error "Could not find ~a among the arguments" s))) - allocated)) - (clret (or ; better as a symbol macro - (substitute - cret-name :c-return - (mapcar (lambda (sym) - (let ((it (find sym allocated-decl :key 'st-symbol))) - (if it - (first (cl-convert-form it)) - sym))) - return)) - (mappend - #'cl-convert-form - (callback-remove-arg allocated-decl cbinfo 'st-symbol)) - outputs - (unless (eq c-return :void) - (list cret-name))))) - (if (and complex-args (not *pass-complex-scalar-as-two-reals*)) - '(error 'pass-complex-by-value) ; arglist should be declared ignore - (wrap-letlike - allocated-decl - (mapcar (lambda (d) (wfo-declare d cbinfo)) - allocated-decl) - 'cffi:with-foreign-objects - `(,@(append - (callback-symbol-set - callback-dynamic cbinfo (first callback-dynamic-variables)) - before - (when callback-object (callback-set-dynamic callback-object arglist))) - ,@(callback-set-slots - cbinfo callback-dynamic-variables callback-dynamic) - (let ((,cret-name - (cffi:foreign-funcall - ,gsl-name - ,@(mappend - (lambda (arg) - (let ((cfind ; variable is complex - (find (st-symbol arg) complex-args :key 'first))) - (if cfind ; make two successive scalars - (passing-complex-by-value cfind) - ;; otherwise use without conversion - (list (if (member (st-symbol arg) allocated) - :pointer - (st-type arg)) - (st-symbol arg))))) - c-arguments) - ,cret-type))) - ,@(case c-return - (:void `((declare (ignore ,cret-name)))) - (:error-code ; fill in arguments - `((check-gsl-status ,cret-name - ',(or (defgeneric-method-p name) name))))) - #-native - ,@(when outputs - (mapcar - (lambda (x) `(setf (cl-invalid ,x) t (c-invalid ,x) nil)) - outputs)) - ,@(when (eq cret-type :pointer) - `((check-null-pointer - ,cret-name - ,@'('memory-allocation-failure "No memory allocated.")))) - ,@after - (values - ,@(defmfun-return - c-return cret-name clret allocated - return return-supplied-p - enumeration outputs))))))))) - -(defun defmfun-return - (c-return cret-name clret allocated return return-supplied-p enumeration outputs) - "Generate the return computation expression for defmfun." - (case c-return - (:number-of-answers - (mappend - (lambda (vbl seq) - `((when (> ,cret-name ,seq) ,vbl))) - clret - (loop for i below (length clret) collect i))) - (:success-failure - (if (equal clret outputs) - ;; success-failure more important than passed-in - `((success-failure ,cret-name)) - (remove cret-name ; don't return c-return itself - `(,@clret (success-failure ,cret-name))))) - (:success-continue - (if (equal clret outputs) - ;; success-failure more important than passed-in - `((success-continue ,cret-name)) - (remove cret-name ; don't return c-return itself - `(,@clret (success-continue ,cret-name))))) - (:true-false - `((not (zerop ,cret-name)))) - (:enumerate - `((cffi:foreign-enum-keyword ',enumeration ,cret-name))) - (t (unless - (or - (and (eq c-return :error-code) - (not outputs) - (not allocated) - (not return-supplied-p)) - (and (null return) return-supplied-p)) - clret)))) diff --git a/init/defmfun.lisp b/init/defmfun.lisp index e47961ec3d52b51e07b3b98c0797fcdb94e6bb5e..b044d6e87f036355483d3d03390461b82db4c115 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: <2009-04-04 22:00:20EDT defmfun.lisp> +;; Time-stamp: <2009-05-03 15:38:45EDT defmfun.lisp> ;; $Id$ (in-package :gsl) @@ -84,7 +84,7 @@ index export documentation inputs outputs before after enumeration qualifier gsl-version switch cbinfo callback-dynamic callback-object) - (special indexed-functions callback-dynamic-variables)) + (special indexed-functions callback-dynamic-variables #+fsbv fsbv-functions)) ,@body)) (defun optional-args-to-switch-gsl-functions (arglist gsl-name) @@ -97,9 +97,9 @@ (listp (first gsl-name))))) (defun expand-defmfun-wrap (name arglist gsl-name c-arguments key-args) - (let (indexed-functions callback-dynamic-variables) + (let (indexed-functions callback-dynamic-variables #+fsbv fsbv-functions) ;; workaround for compiler errors that don't see 'indexed-function is used - (declare (ignorable indexed-functions callback-dynamic-variables)) + (declare (ignorable indexed-functions callback-dynamic-variables #+fsbv fsbv-functions)) (with-defmfun-key-args key-args (setf indexed-functions (list) callback-dynamic-variables @@ -119,7 +119,8 @@ (make-symbol-cardinals (list name 'dynfn) num-callbacks :gsl) (make-symbol-cardinals - (list name 'cbfn) num-callbacks :gsl)))))) + (list name 'cbfn) num-callbacks :gsl))))) + #+fsbv fsbv-functions #+fsbv (list)) (wrap-index-export (cond ((eq definition :generic) @@ -156,6 +157,8 @@ cbinfo (second callback-dynamic-variables) (first callback-dynamic-variables)) + #+fsbv + ,@fsbv-functions ,@index-export)))) ;;;;**************************************************************************** diff --git a/init/interface.lisp b/init/interface.lisp index 47b173b5707d1b16d433ca2f264418260534b52d..791c93acd7627eec83903a18c6f1d73f13338e6a 100644 --- a/init/interface.lisp +++ b/init/interface.lisp @@ -1,6 +1,6 @@ ;; Macros to interface GSL functions, including definitions necessary for defmfun. ;; Liam Healy -;; Time-stamp: <2009-04-04 22:44:06EDT interface.lisp> +;; Time-stamp: <2009-04-25 23:31:38EDT interface.lisp> ;; $Id$ (in-package :gsl) @@ -44,29 +44,29 @@ (defun st-type (decl) (second decl)) -(defun st-arrayp (decl) - (listp (st-type decl))) +(defun st-pointerp (decl) + "If this st represents a pointer, return the type of the object." + (if + (eq (st-type decl) :pointer) + t ; return T for type if unknown type + (if (and (listp (st-type decl)) + (eq (first (st-type decl)) :pointer)) + (second (st-type decl))))) -(defun st-array-pointer-last-p (decl) - (listp (st-type decl))) +(defun st-actual-type (decl) + (or (st-pointerp decl) (st-type decl))) -(defun st-eltype (decl) - (first (st-type decl))) - -(defun st-dim (decl) - (second (st-type decl))) - -(defun st-pointer-last-p (decl) - (third (st-type decl))) +(defun st-pointer-generic-pointer (decl) + (if (st-pointerp decl) + (make-st (st-symbol decl) :pointer) + decl)) (defun wfo-declare (d cbinfo) `(,(st-symbol d) - ,@(if (st-arrayp d) - `(',(st-eltype d) ,(st-dim d)) - (if (eq (st-symbol d) - (parse-callback-static cbinfo 'foreign-argument)) - `(',(parse-callback-static cbinfo 'callback-fnstruct)) - `(',(st-type d)))))) + ,@(if (eq (st-symbol d) + (parse-callback-static cbinfo 'foreign-argument)) + `(',(parse-callback-static cbinfo 'callback-fnstruct)) + `(',(st-actual-type d))))) ;;;;**************************************************************************** ;;;; Checking results from GSL functions diff --git a/init/number-conversion.lisp b/init/number-conversion.lisp index 8bdbcd700a363cb01c2cf0916baeef192541e27c..45f00fd7a63cc8553614147de6033a61e715eb56 100644 --- a/init/number-conversion.lisp +++ b/init/number-conversion.lisp @@ -1,6 +1,6 @@ ;; Conversion of numbers C->CL ;; Liam Healy, Sun May 28 2006 - 22:04 -;; Time-stamp: <2009-01-13 21:40:26EST number-conversion.lisp> +;; Time-stamp: <2009-04-27 21:24:36EDT number-conversion.lisp> ;; $Id$ (in-package :gsl) @@ -42,7 +42,7 @@ (defun cl-convert-form (decl) "Generate a form that calls the appropriate converter from C/GSL to CL." - (case (st-type decl) + (case (st-actual-type decl) (sf-result `((val ,(st-symbol decl)) (err ,(st-symbol decl)))) @@ -54,4 +54,4 @@ `((complex-to-cl ,(st-symbol decl) 0 'complex-double-c))) (complex-float-c `((complex-to-cl ,(st-symbol decl) 0 'complex-float-c))) - (t `((cffi:mem-aref ,(st-symbol decl) ',(st-type decl)))))) + (t `((cffi:mem-aref ,(st-symbol decl) ',(st-actual-type decl)))))) diff --git a/init/types.lisp b/init/types.lisp index 9720bcba5fdf4b59fe2927c611a946eab8c72a7e..969aba87d4ec95cd7ff80c0df307e51189628858 100644 --- a/init/types.lisp +++ b/init/types.lisp @@ -1,6 +1,6 @@ ;; Number types used by GSL functions, and specification conversion ;; Liam Healy 2008-12-31 21:06:34EST types.lisp -;; Time-stamp: <2009-01-13 22:00:26EST types.lisp> +;; Time-stamp: <2009-05-03 09:42:01EDT types.lisp> ;; $Id: $ (in-package :gsl) @@ -13,10 +13,12 @@ (cffi:foreign-type-size :long) (8 (push :int64 *features*) - (cffi:defctype sizet :uint64)) + (cffi:defctype sizet :uint64) + #+fsbv (fsbv:defsynonym sizet :uint64)) (4 (push :int32 *features*) - (cffi:defctype sizet :uint32)) + (cffi:defctype sizet :uint32) + #+fsbv (fsbv:defsynonym sizet :uint32)) (t (error "Size of :long unrecognized"))) ;;;;**************************************************************************** diff --git a/linear-algebra/blas1.lisp b/linear-algebra/blas1.lisp index 8d2d841dd78fa8a0397fc3ccc7535a283c7e1791..3d37e4a8d1e1dc5fe3d908fd995d149abb160e8b 100644 --- a/linear-algebra/blas1.lisp +++ b/linear-algebra/blas1.lisp @@ -1,14 +1,16 @@ ;; BLAS level 1, Vector operations ;; Liam Healy, Wed Apr 26 2006 - 15:23 -;; Time-stamp: <2009-01-15 21:28:41EST blas1.lisp> +;; Time-stamp: <2009-05-03 11:28:12EDT blas1.lisp> ;; $Id$ (in-package :gsl) +;;; /usr/include/gsl/gsl_blas.h + (defmfun dot ((vec1 vector) (vec2 vector)) ("gsl_blas_" :type "dot" :suffix) (((mpointer vec1) :pointer) ((mpointer vec2) :pointer) - (result :element-c-type)) + (result (:pointer :element-c-type))) :definition :generic :element-types :float-complex :inputs (vec1 vec2) @@ -30,7 +32,7 @@ (defmfun cdot ((x vector) (y vector)) ("gsl_blas_" :type "dotc") (((mpointer x) :pointer) ((mpointer y) :pointer) - (result :element-c-type)) + (result (:pointer :element-c-type))) :definition :generic :element-types :complex :inputs (x y) @@ -101,7 +103,7 @@ ("gsl_blas_" :type "axpy") ((alpha :element-c-type) ((mpointer x) :pointer) ((mpointer y) :pointer)) :definition :generic - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :inputs (x y) :outputs (y) :documentation ; FDL @@ -113,7 +115,7 @@ ("gsl_blas_" :type "scal") ((alpha :element-c-type) ((mpointer x) :pointer)) :definition :generic - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :c-return :void :inputs (x) :outputs (x) @@ -192,12 +194,12 @@ (generate-all-array-tests dot :float-complex (let ((v1 (array-default 8)) - (v2 (array-default 8))) + (v2 (array-default 8))) (dot v1 v2))) (generate-all-array-tests cdot :complex (let ((v1 (array-default 8)) - (v2 (array-default 8))) + (v2 (array-default 8))) (cdot v1 v2))) (generate-all-array-tests euclidean-norm :float-complex @@ -230,7 +232,7 @@ (scalar (scalar-default))) (cl-array (axpy scalar v1 v2)))) -(generate-all-array-tests scale :float-complex +(generate-all-array-tests scale #+fsbv :float-complex #-fsbv :float (let ((v1 (array-default 8)) (scalar (scalar-default))) (cl-array (scale scalar v1)))) diff --git a/linear-algebra/blas2.lisp b/linear-algebra/blas2.lisp index 7f43287ceb8a6c9e018334464bd6bfae93ee4b6f..2f655a324100916d781b7bb6e6533ab4d039c17f 100644 --- a/linear-algebra/blas2.lisp +++ b/linear-algebra/blas2.lisp @@ -1,6 +1,6 @@ ;; BLAS level 2, Matrix-vector operations ;; Liam Healy, Wed Apr 26 2006 - 21:08 -;; Time-stamp: <2009-03-15 17:09:00EDT blas2.lisp> +;; Time-stamp: <2009-05-03 12:38:28EDT blas2.lisp> ;; $Id$ (in-package :gsl) @@ -15,14 +15,23 @@ "CBLAS_TRANSPOSE from /usr/include/gsl/gsl_cblas.h." (:notrans 111) :trans :conjtrans) +#+fsbv +(fsbv:defcenum-aux cblas-transpose) + (cffi:defcenum cblas-uplo "/usr/include/gsl/gsl_cblas.h." (:upper 121) :lower) +#+fsbv +(fsbv:defcenum-aux cblas-uplo) + (cffi:defcenum cblas-diag "/usr/include/gsl/gsl_cblas.h." (:nonunit 131) :unit) +#+fsbv +(fsbv:defcenum-aux cblas-diag) + ;;;;**************************************************************************** ;;;; Functions ;;;;**************************************************************************** @@ -33,17 +42,18 @@ (second (dimensions b))) (first (dimensions a)))) -;;; To do: the y should be an optional argument, default to a zero vector. (defmfun matrix-product ((A matrix) (x vector) &optional - (y (make-marray element-type :dimensions (matrix-product-dimensions A x))) + (y (make-marray + element-type :dimensions (matrix-product-dimensions A x) + :initial-element 0)) (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)) :definition :generic - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :inputs (A x y) :outputs (y) :documentation ; FDL @@ -70,7 +80,7 @@ :outputs (x) :documentation ; FDL "If the second argument is a vector, compute - the matrix-vector product x =alpha op(A) x + the matrix-vector product x = op(A) x for the triangular matrix A, where op(A) = A, A^T, A^H for TransA = :NoTrans, :Trans, :ConjTrans. When Uplo is :Upper then the upper triangle of A is used, and when @@ -80,7 +90,7 @@ matrix A are taken as unity and are not referenced. If the second argument is a matrix, compute the matrix-matrix product B = alpha op(A) B - if Side is :Left and B = \alpha B op(A) if Side is + if Side is :Left and B = alpha B op(A) if Side is :Right. The matrix A is triangular and op(A) = A, A^T, A^H for TransA = :NoTrans, :Trans, :ConjTrans When Uplo is :Upper then the upper triangle of A is used, and when @@ -123,7 +133,8 @@ (defmfun matrix-product-symmetric ((A matrix) (x vector) &optional - (y (make-marray element-type :dimensions (matrix-product-dimensions A x))) + (y (make-marray element-type :dimensions (matrix-product-dimensions A x) + :initial-element 0)) (alpha 1) (beta 1) (uplo :upper) (side :left)) ("gsl_blas_" :type "symv") ((uplo cblas-uplo) (alpha :element-c-type) ((mpointer A) :pointer) @@ -148,13 +159,13 @@ are used, and when Uplo is :Lower then the lower triangle and diagonal of A are used.") +#+fsbv (defmfun matrix-product-hermitian ((A matrix) (x vector) &optional - (y (make-marray element-type :dimensions (matrix-product-dimensions A x))) + (y (make-marray element-type :dimensions (matrix-product-dimensions A x) + :initial-element 0)) (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") ((uplo cblas-uplo) (alpha :element-c-type) ((mpointer A) :pointer) ((mpointer x) :pointer) (beta :element-c-type) ((mpointer y) :pointer)) @@ -184,12 +195,13 @@ ((alpha :element-c-type) ((mpointer A) :pointer) ((mpointer x) :pointer) ((mpointer y) :pointer)) :definition :generic - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :inputs (x y A) :outputs (A) :documentation ; FDL "The rank-1 update A = alpha x y^T + A of the matrix A.") +#+fsbv (defmfun conjugate-rank-1-update (alpha (x vector) (y vector) (A matrix)) ("gsl_blas_" :type "gerc") ((alpha :element-c-type) ((mpointer A) :pointer) @@ -226,6 +238,7 @@ used, and when Uplo is CblasLower then the lower triangle and diagonal of C are used.") +#+fsbv (defmfun hermitian-rank-1-update ((x vector) (A matrix) &optional (alpha 1) (beta 1) (uplo :upper) (trans :notrans)) @@ -279,6 +292,7 @@ then the upper triangle and diagonal of C are used, and when Uplo is :lower then the lower triangle and diagonal of C are used.") +#+fsbv (defmfun hermitian-rank-2-update ((x vector) (y vector) (A matrix) &optional (alpha 1) (beta 1) (uplo :upper) (trans :notrans)) @@ -311,7 +325,7 @@ ;;;; Examples and unit test ;;;;**************************************************************************** -(generate-all-array-tests matrix-product :float-complex +(generate-all-array-tests matrix-product #+fsbv :float-complex #-fsbv :float (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (v2 (array-default 3)) @@ -319,13 +333,15 @@ (s2 (scalar-default))) (cl-array (matrix-product m1 v1 v2 s1 s2)))) -(generate-all-array-tests matrix-product-triangular :float-complex +(generate-all-array-tests matrix-product-triangular + #+fsbv :float-complex #-fsbv :float (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (s1 (scalar-default))) (cl-array (matrix-product-triangular m1 v1 s1)))) -(generate-all-array-tests inverse-matrix-product :float-complex +(generate-all-array-tests inverse-matrix-product + #+fsbv :float-complex #-fsbv :float (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (s1 (scalar-default))) @@ -339,6 +355,7 @@ (s2 (scalar-default))) (cl-array (matrix-product-symmetric m1 v1 v3 s1 s2)))) +#+fsbv (generate-all-array-tests matrix-product-hermitian :complex (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) diff --git a/linear-algebra/blas3.lisp b/linear-algebra/blas3.lisp index 186792bb83d620a3424e65971bb7a4ad91a30a51..95dcfd36dfc73b4147f01ae40aa696e8534bc74f 100644 --- a/linear-algebra/blas3.lisp +++ b/linear-algebra/blas3.lisp @@ -1,6 +1,6 @@ ;; BLAS level 3, Matrix-matrix operations ;; Liam Healy, Wed Apr 26 2006 - 21:08 -;; Time-stamp: <2009-03-15 17:15:40EDT blas3.lisp> +;; Time-stamp: <2009-05-03 11:18:02EDT blas3.lisp> ;; $Id$ (in-package :gsl) @@ -15,6 +15,9 @@ "/usr/include/gsl/gsl_cblas.h." (:left 141) :right) +#+fsbv +(fsbv:defcenum-aux cblas-side) + ;;;;**************************************************************************** ;;;; Functions ;;;;**************************************************************************** @@ -22,35 +25,40 @@ (defmfun matrix-product ((A matrix) (B matrix) &optional - (C (make-marray element-type :dimensions (matrix-product-dimensions A B))) + (C (make-marray + element-type + :dimensions (matrix-product-dimensions A B) :initial-element 0)) (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) ((mpointer B) :pointer) (beta :element-c-type) ((mpointer C) :pointer)) :definition :methods - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :inputs (A B C) :outputs (C)) (defmfun matrix-product-symmetric ((A matrix) (B matrix) &optional - (C (make-marray element-type :dimensions (matrix-product-dimensions A B))) + (C (make-marray element-type :dimensions (matrix-product-dimensions A B) + :initial-element 0)) (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) (beta :element-c-type) ((mpointer C) :pointer)) :definition :methods - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :inputs (A B C) :outputs (C)) +#+fsbv (defmfun matrix-product-hermitian ((A matrix) (B matrix) &optional - (C (make-marray element-type :dimensions (matrix-product-dimensions A B))) + (C (make-marray element-type :dimensions (matrix-product-dimensions A B) + :initial-element 0)) (alpha 1) (beta 1) (uplo :upper) (side :left)) ;; This always signals an error because you can't pass a ;; struct in CFFI yet. @@ -72,7 +80,7 @@ (diag cblas-diag) (alpha :element-c-type) ((mpointer A) :pointer) ((mpointer B) :pointer)) :definition :methods - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :inputs (A B) :outputs (B)) @@ -87,7 +95,7 @@ (TransA cblas-transpose) (diag cblas-diag) (alpha :element-c-type) ((mpointer A) :pointer) ((mpointer B) :pointer)) :definition :methods - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :inputs (A B) :outputs (B)) @@ -99,10 +107,11 @@ (alpha :element-c-type) ((mpointer A) :pointer) (beta :element-c-type) ((mpointer C) :pointer)) :definition :methods - :element-types :float-complex + :element-types #+fsbv :float-complex #-fsbv :float :inputs (A C) :outputs (C)) +#+fsbv (defmfun hermitian-rank-1-update ((A matrix) (C matrix) &optional (alpha 1) (beta 1) (uplo :upper) (trans :notrans)) @@ -128,6 +137,7 @@ :inputs (A B C) :outputs (C)) +#+fsbv (defmfun hermitian-rank-2-update ((A matrix) (B matrix) (C matrix) &optional (alpha 1) (beta 1) (uplo :upper) (trans :notrans)) @@ -145,7 +155,7 @@ ;;;; Examples and unit test ;;;;**************************************************************************** -(generate-all-array-tests matrix-product :float-complex +(generate-all-array-tests matrix-product #+fsbv :float-complex #-fsbv :float (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) (m3 (array-default '(3 3))) @@ -158,13 +168,15 @@ (m2 (array-default '(3 2)))) (cl-array (matrix-product m1 m2)))) -(generate-all-array-tests matrix-product-triangular :float-complex +(generate-all-array-tests matrix-product-triangular + #+fsbv :float-complex #-fsbv :float (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) (s1 (scalar-default))) (cl-array (matrix-product-triangular m1 m2 s1)))) -(generate-all-array-tests inverse-matrix-product :float-complex +(generate-all-array-tests inverse-matrix-product + #+fsbv :float-complex #-fsbv :float (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) (s1 (scalar-default))) @@ -178,6 +190,7 @@ (s2 (scalar-default))) (cl-array (matrix-product-symmetric m1 m2 m3 s1 s2)))) +#+fsbv (generate-all-array-tests matrix-product-hermitian :complex (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) diff --git a/linear-algebra/lu.lisp b/linear-algebra/lu.lisp index 637e8b7ecc7d318d845ddf2cb36c7d5207731430..7de390e64d22ceb374b1b4056154d1875980cb04 100644 --- a/linear-algebra/lu.lisp +++ b/linear-algebra/lu.lisp @@ -1,14 +1,17 @@ ;; LU decomposition ;; Liam Healy, Thu Apr 27 2006 - 12:42 -;; Time-stamp: <2009-03-17 20:42:37EDT lu.lisp> +;; Time-stamp: <2009-04-26 23:04:02EDT lu.lisp> ;; $Id$ (in-package :gsl) +;;; /usr/include/gsl/gsl_linalg.h + (defmfun LU-decomposition ((A matrix) &optional (permutation (make-permutation (dim0 A)))) ("gsl_linalg" :complex "_LU_decomp") - (((mpointer A) :pointer) ((mpointer permutation) :pointer) (signum :int)) + (((mpointer A) :pointer) ((mpointer permutation) :pointer) + (signum (:pointer :int))) :definition :generic :inputs (A) :outputs (A permutation) @@ -94,7 +97,7 @@ (defmfun LU-determinant ((LU matrix) signum) ("gsl_linalg" :complex "_LU_det") - (((mpointer LU) :pointer) (signum :int)) + (((mpointer LU) :pointer) (signum (:pointer :int))) :definition :generic :inputs (LU) :element-types :doubles @@ -119,7 +122,7 @@ (defmfun LU-sgndet ((LU matrix) signum) ("gsl_linalg" :complex "_LU_sgndet") - (((mpointer LU) :pointer) (signum :int)) + (((mpointer LU) :pointer) (signum (:pointer :int))) :definition :generic :inputs (LU) :element-types :doubles diff --git a/linear-algebra/qrpt.lisp b/linear-algebra/qrpt.lisp index b2bf31a570ba2d2aa15b311936d77ccd3e91f021..4f58c2527ff41b71f0011f11b818e9c7897617db 100644 --- a/linear-algebra/qrpt.lisp +++ b/linear-algebra/qrpt.lisp @@ -1,16 +1,18 @@ ;; QR with column pivoting ;; Liam Healy, Fri Apr 28 2006 - 16:53 -;; Time-stamp: <2009-02-23 22:11:10EST qrpt.lisp> +;; Time-stamp: <2009-04-26 23:05:14EDT qrpt.lisp> ;; $Id$ (in-package :gsl) +;;; /usr/include/gsl/gsl_linalg.h + (defmfun QRPT-decomposition (A tau p &optional (norm (make-marray 'double-float :dimensions (dim1 A)))) "gsl_linalg_QRPT_decomp" (((mpointer A) :pointer) ((mpointer tau) :pointer) ((mpointer p) :pointer) - (signum :int) ((mpointer norm) :pointer)) + (signum (:pointer :int)) ((mpointer norm) :pointer)) :inputs (A) :outputs (A tau p norm) :return (A tau signum p) @@ -40,7 +42,7 @@ "gsl_linalg_QRPT_decomp2" (((mpointer A) :pointer) ((mpointer q) :pointer) ((mpointer r) :pointer) ((mpointer tau) :pointer) - ((mpointer p) :pointer) (signum :int) + ((mpointer p) :pointer) (signum (:pointer :int)) ((mpointer norm) :pointer)) :inputs (A) :outputs (q r norm) diff --git a/polynomial.lisp b/polynomial.lisp index 2597d817c074f25a06e78bff650ca72020e9dfb9..c4e4d5afb73244cf003fcdc4dca8fe393da6610d 100644 --- a/polynomial.lisp +++ b/polynomial.lisp @@ -1,6 +1,6 @@ ;; Polynomials ;; Liam Healy, Tue Mar 21 2006 - 18:33 -;; Time-stamp: <2009-04-02 21:58:22EDT polynomial.lisp> +;; Time-stamp: <2009-05-03 09:37:35EDT polynomial.lisp> ;; $Id$ (in-package :gsl) @@ -26,11 +26,10 @@ :documentation ; FDL "Evaluate the polyonomial with coefficients at the point x.") -#| -;;; These won't work until we can take returned complex (structs). +#+fsbv (defmfun evaluate ((coefficients vector-double-float) (x complex) - &key &allow-other-keys) + &key) "gsl_poly_complex_eval" (((c-pointer coefficients) :pointer) ((dim0 coefficients) sizet) (x complex-double-c)) @@ -41,9 +40,10 @@ :documentation ; FDL "Evaluate the polyonomial with coefficients at the complex value x.") +#+fsbv (defmfun evaluate ((coefficients vector-complex-double-float) (x complex) - &key &allow-other-keys) + &key) "gsl_complex_poly_complex_eval" (((c-pointer coefficients) :pointer) ((dim0 coefficients) sizet) (x complex-double-c)) @@ -53,7 +53,6 @@ :c-return complex-double-c :documentation ; FDL "Evaluate the polyonomial with coefficients at the complex value x.") -|# ;;;;**************************************************************************** ;;;; Divided Difference Representation of Polynomials @@ -103,7 +102,8 @@ (defmfun solve-quadratic (a b c) "gsl_poly_solve_quadratic" - ((a :double) (b :double) (c :double) (root1 :double) (root2 :double)) + ((a :double) (b :double) (c :double) + (root1 (:pointer :double)) (root2 (:pointer :double))) :c-return :number-of-answers :documentation ; FDL "The real roots of the quadratic equation a x^2 + b x + c = 0. @@ -113,7 +113,7 @@ (defmfun solve-quadratic-complex (a b c) "gsl_poly_complex_solve_quadratic" ((a :double) (b :double) (c :double) - (root1 complex-double-c) (root2 complex-double-c)) + (root1 (:pointer complex-double-c)) (root2 (:pointer complex-double-c))) :c-return :number-of-answers :documentation ; FDL "The complex roots of the quadratic equation a x^2 + b x + c = 0. @@ -127,7 +127,8 @@ (defmfun solve-cubic (a b c) "gsl_poly_solve_cubic" ((a :double) (b :double) (c :double) - (root1 :double) (root2 :double) (root3 :double)) + (root1 (:pointer :double)) + (root2 (:pointer :double)) (root3 (:pointer :double))) :c-return :number-of-answers :documentation ; FDL "Find the real roots of the cubic equation, x^3 + a x^2 + b x + c = 0 @@ -138,7 +139,8 @@ (defmfun solve-cubic-complex (a b c) "gsl_poly_complex_solve_cubic" ((a :double) (b :double) (c :double) - (root1 complex-double-c) (root2 complex-double-c) (root3 complex-double-c)) + (root1 (:pointer complex-double-c)) (root2 (:pointer complex-double-c)) + (root3 (:pointer complex-double-c))) :c-return :number-of-answers :documentation ; FDL "Find the complex roots of the cubic equation, x^3 + a x^2 + b x + c = 0 diff --git a/random/gaussian-bivariate.lisp b/random/gaussian-bivariate.lisp index 1ecf094605a3731598f03530f4dfde73d24e1e3e..c1000cd68ffd7baf5f70d84fde4e85ba1fecd91a 100644 --- a/random/gaussian-bivariate.lisp +++ b/random/gaussian-bivariate.lisp @@ -1,6 +1,6 @@ ;; Gaussian bivariate distribution ;; Liam Healy, Sat Sep 2 2006 - 16:32 -;; Time-stamp: <2009-02-16 10:10:33EST gaussian-bivariate.lisp> +;; Time-stamp: <2009-04-26 23:06:34EDT gaussian-bivariate.lisp> ;; $Id$ (in-package :gsl) @@ -10,7 +10,7 @@ (defmfun bivariate-gaussian (generator sigma-x sigma-y rho) "gsl_ran_bivariate_gaussian" (((mpointer generator) :pointer) (sigma-x :double) (sigma-y :double) (rho :double) - (x :double) (y :double)) + (x (:pointer :double)) (y (:pointer :double))) :c-return :void :documentation ; FDL "Generate a pair of correlated Gaussian variates, with diff --git a/random/spherical-vector.lisp b/random/spherical-vector.lisp index 9eeddb564ce3cf2cc2a1aefaa627ba86e337eda8..d563ba6b19172d889ec4655891dc1514dd4cc3e0 100644 --- a/random/spherical-vector.lisp +++ b/random/spherical-vector.lisp @@ -1,6 +1,6 @@ ;; Spherical Vector distribution ;; Liam Healy, Sun Oct 22 2006 -;; Time-stamp: <2009-02-16 10:10:32EST spherical-vector.lisp> +;; Time-stamp: <2009-04-26 23:08:37EDT spherical-vector.lisp> ;; $Id$ (in-package :gsl) @@ -11,7 +11,8 @@ (defmfun direction-2d (generator) "gsl_ran_dir_2d" - (((mpointer generator) :pointer) (x :double) (y :double)) + (((mpointer generator) :pointer) + (x (:pointer :double)) (y (:pointer :double))) :c-return :void :documentation ; FDL "A random direction vector v = (x,y) in @@ -20,7 +21,8 @@ (defmfun direction-2d-trig-method (generator) "gsl_ran_dir_2d_trig_method" - (((mpointer generator) :pointer) (x :double) (y :double)) + (((mpointer generator) :pointer) + (x (:pointer :double)) (y (:pointer :double))) :c-return :void :documentation ; FDL "A random direction vector v = (x,y) in @@ -29,7 +31,8 @@ (defmfun direction-3d (generator) "gsl_ran_dir_3d" - (((mpointer generator) :pointer) (x :double) (y :double) (z :double)) + (((mpointer generator) :pointer) + (x (:pointer :double)) (y (:pointer :double)) (z (:pointer :double))) :c-return :void :documentation ; FDL "A random direction vector v = diff --git a/series-acceleration.lisp b/series-acceleration.lisp index b5ea3abffee999228586b295bd289caec2ac5da0..dd4dcd1890680152ded0dc66f48c6f6ce750a82c 100644 --- a/series-acceleration.lisp +++ b/series-acceleration.lisp @@ -1,6 +1,6 @@ ;; Series acceleration. ;; Liam Healy, Wed Nov 21 2007 - 18:41 -;; Time-stamp: <2009-01-26 21:31:38EST series-acceleration.lisp> +;; Time-stamp: <2009-04-26 23:27:40EDT series-acceleration.lisp> ;; $Id$ (in-package :gsl) @@ -36,7 +36,7 @@ (defmfun accelerate (array levin) "gsl_sum_levin_u_accel" (((c-pointer array) :pointer) ((dim0 array) sizet) ((mpointer levin) :pointer) - (accelerated-sum :double) (absolute-error :double)) + (accelerated-sum (:pointer :double)) (abserr (:pointer :double))) :inputs (array) :documentation ; FDL "From the terms of a series in array, compute the extrapolated @@ -64,7 +64,7 @@ (defmfun accelerate-truncated (array levin) "gsl_sum_levin_utrunc_accel" (((c-pointer array) :pointer) ((dim0 array) sizet) ((mpointer levin) :pointer) - (accelerated-sum :double) (absolute-error :double)) + (accelerated-sum (:pointer :double)) (abserr (:pointer :double))) :inputs (array) :documentation ; FDL "From the terms of a series in array, compute the extrapolated diff --git a/solve-minimize-fit/linear-least-squares.lisp b/solve-minimize-fit/linear-least-squares.lisp index 83347e27d9ba3053c2bde84bd7eb1404f3d3eaf8..6d1c4d6fff0b370029ee7ba13d892ba008fdc50c 100644 --- a/solve-minimize-fit/linear-least-squares.lisp +++ b/solve-minimize-fit/linear-least-squares.lisp @@ -1,6 +1,6 @@ ;; Linear least squares, or linear regression ;; Liam Healy <2008-01-21 12:41:46EST linear-least-squares.lisp> -;; Time-stamp: <2009-03-20 14:58:52EDT linear-least-squares.lisp> +;; Time-stamp: <2009-04-26 23:36:23EDT linear-least-squares.lisp> ;; $Id$ (in-package :gsl) @@ -22,16 +22,18 @@ (x y &optional weight (x-stride 1) (y-stride 1) (weight-stride 1)) ("gsl_fit_linear" "gsl_fit_wlinear") ((((c-pointer x) :pointer) (x-stride sizet) - ((c-pointer y) :pointer) (y-stride sizet) - ((dim0 x) sizet) (c0 :double) (c1 :double) - (cov00 :double) (cov01 :double) (cov11 :double) - (sumsq :double)) + ((c-pointer y) :pointer) (y-stride sizet) + ((dim0 x) sizet) + (c0 (:pointer :double)) (c1 (:pointer :double)) + (cov00 (:pointer :double)) (cov01 (:pointer :double)) + (cov11 (:pointer :double)) (sumsq (:pointer :double))) (((c-pointer x) :pointer) (x-stride sizet) - ((c-pointer weight) :pointer) (weight-stride sizet) - ((c-pointer y) :pointer) (y-stride sizet) - ((dim0 x) sizet) (c0 :double) (c1 :double) - (cov00 :double) (cov01 :double) (cov11 :double) - (chisq :double))) + ((c-pointer weight) :pointer) (weight-stride sizet) + ((c-pointer y) :pointer) (y-stride sizet) + ((dim0 x) sizet) + (c0 (:pointer :double)) (c1 (:pointer :double)) + (cov00 (:pointer :double)) (cov01 (:pointer :double)) + (cov11 (:pointer :double)) (sumsq (:pointer :double)))) :inputs (x weight y) :switch (weight weight-stride) :documentation ; FDL @@ -53,7 +55,7 @@ "gsl_fit_linear_est" ((x :double) (c0 :double) (c1 :double) (cov00 :double) (cov01 :double) (cov11 :double) - (y :double) (y-error :double)) + (y (:pointer :double)) (y-error (:pointer :double))) :documentation ; FDL "Use the best-fit linear regression coefficients c0, c1 and their covariance @@ -70,13 +72,15 @@ ("gsl_fit_mul" "gsl_fit_wmul") ((((c-pointer x) :pointer) (x-stride sizet) ((c-pointer y) :pointer) (y-stride sizet) - ((dim0 x) sizet) (c1 :double) (cov11 :double) - (sumsq :double)) + ((dim0 x) sizet) + (c1 (:pointer :double)) (cov11 (:pointer :double)) + (sumsq (:pointer :double))) (((c-pointer x) :pointer) (x-stride sizet) ((c-pointer weight) :pointer) (weight-stride sizet) ((c-pointer y) :pointer) (y-stride sizet) - ((dim0 x) sizet) (c1 :double) (cov11 :double) - (chisq :double))) + ((dim0 x) sizet) + (c1 (:pointer :double)) (cov11 (:pointer :double)) + (sumsq (:pointer :double)))) :inputs (x y weight) :switch (weight weight-stride) :documentation ; FDL @@ -95,7 +99,7 @@ (defmfun multiplier-estimate (x c1 cov11) "gsl_fit_mul_est" ((x :double) (c1 :double) (cov11 :double) - (y :double) (y-error :double)) + (y (:pointer :double)) (y-error (:pointer :double))) :documentation ; FDL "Use the best-fit linear regression coefficient c1 and its covariance cov11 to compute the fitted function @@ -171,14 +175,14 @@ ((mpointer observations) :pointer) ((mpointer parameters) :pointer) ((mpointer covariance) :pointer) - (chisq :double) + (chisq (:pointer :double)) ((mpointer workspace) :pointer)) (((mpointer model) :pointer) ((mpointer weight) :pointer) ((mpointer observations) :pointer) ((mpointer parameters) :pointer) ((mpointer covariance) :pointer) - (chisq :double) + (chisq (:pointer :double)) ((mpointer workspace) :pointer))) :inputs (model weight observations) :outputs (parameters covariance) @@ -211,19 +215,19 @@ ((((mpointer model) :pointer) ((mpointer observations) :pointer) (tolerance :double) - (rank sizet) + (rank (:pointer sizet)) ((mpointer parameters) :pointer) ((mpointer covariance) :pointer) - (chisq :double) + (chisq (:pointer :double)) ((mpointer workspace) :pointer)) (((mpointer model) :pointer) ((mpointer weight) :pointer) ((mpointer observations) :pointer) (tolerance :double) - (rank sizet) + (rank (:pointer sizet)) ((mpointer parameters) :pointer) ((mpointer covariance) :pointer) - (chisq :double) + (chisq (:pointer :double)) ((mpointer workspace) :pointer))) :inputs (model weight observations) :outputs (parameters covariance) @@ -252,7 +256,8 @@ (defmfun multi-linear-estimate (x coefficients covariance) "gsl_multifit_linear_est" (((mpointer x) :pointer) ((mpointer coefficients) :pointer) - ((mpointer covariance) :pointer) (y :double) (y-error :double)) + ((mpointer covariance) :pointer) + (y (:pointer :double)) (y-error (:pointer :double))) :inputs (x coefficients covariance) :documentation ; FDL "Use the best-fit multilinear regression coefficients diff --git a/special-functions/coulomb.lisp b/special-functions/coulomb.lisp index e2a85b128eac9da714dd9fe0540fa0aa9047f2b4..9f5362b7f34286325cfd852d16a4ca770547d8a6 100644 --- a/special-functions/coulomb.lisp +++ b/special-functions/coulomb.lisp @@ -1,10 +1,12 @@ ;; Coulumb functions ;; Liam Healy, Sat Mar 18 2006 - 23:23 -;; Time-stamp: <2009-01-11 10:14:54EST coulomb.lisp> +;; Time-stamp: <2009-04-26 22:57:18EDT coulomb.lisp> ;; $Id$ (in-package :gsl) +;;; /usr/include/gsl/gsl_sf_coulomb.h + ;;;;**************************************************************************** ;;;; Normalized Hydrogenic Bound States ;;;;**************************************************************************** @@ -33,7 +35,7 @@ "gsl_sf_coulomb_wave_FG_e" ((eta :double) (x :double) (L-F :double) (k :int) (F sf-result) (Fp sf-result) (G sf-result) (Gp sf-result) - (exp-F :double) (exp-G :double)) + (exp-F (:pointer :double)) (exp-G (:pointer :double))) :return ((val F) (val Fp) (val G) (val Gp) (dcref exp-F) (dcref exp-G) @@ -53,7 +55,7 @@ &aux (fc-array (vdf size-or-array))) "gsl_sf_coulomb_wave_F_array" ((L-min :double) ((1- (dim0 fc-array)) :int) (eta :double) (x :double) - ((c-pointer fc-array) :pointer) (F-exponent :double)) + ((c-pointer fc-array) :pointer) (F-exponent (:pointer :double))) :outputs (fc-array) :return (fc-array (dcref F-exponent)) :documentation ; FDL @@ -70,7 +72,7 @@ "gsl_sf_coulomb_wave_FG_array" ((L-min :double) ((1- (dim0 fc-array)) :int) (eta :double) (x :double) ((c-pointer fc-array) :pointer) ((c-pointer gc-array) :pointer) - (F-exponent :double) (G-exponent :double)) + (F-exponent (:pointer :double)) (G-exponent (:pointer :double))) :outputs (fc-array gc-array) :return (fc-array gc-array (dcref F-exponent) (dcref G-exponent)) :documentation ; FDL @@ -93,7 +95,7 @@ ((L-min :double) ((1- (dim0 fc-array)) :int) (eta :double) (x :double) ((c-pointer fc-array) :pointer) ((c-pointer fcp-array) :pointer) ((c-pointer gc-array) :pointer) ((c-pointer gcp-array) :pointer) - (F-exponent :double) (G-exponent :double)) + (F-exponent (:pointer :double)) (G-exponent (:pointer :double))) :outputs (fc-array fcp-array gc-array gcp-array) :return (fc-array fcp-array gc-array gcp-array @@ -111,7 +113,7 @@ &aux (fc-array (vdf size-or-array))) "gsl_sf_coulomb_wave_sphF_array" ((L-min :double) ((1- (dim0 fc-array)) :int) (eta :double) (x :double) - ((c-pointer fc-array) :pointer) (F-exponent :double)) + ((c-pointer fc-array) :pointer) (F-exponent (:pointer :double))) :outputs (fc-array) :return (fc-array (dcref F-exponent)) :documentation ; FDL diff --git a/special-functions/gamma.lisp b/special-functions/gamma.lisp index ce2ba1c7ab1a637da1c401544e4af594acaed9b4..6bc055388449ff1adc77f99df5378c66c30ecb61 100644 --- a/special-functions/gamma.lisp +++ b/special-functions/gamma.lisp @@ -1,6 +1,6 @@ ;; Gamma functions ;; Liam Healy, Thu Apr 27 2006 - 22:06 -;; Time-stamp: <2008-10-23 23:02:09EDT gamma.lisp> +;; Time-stamp: <2009-04-26 22:59:46EDT gamma.lisp> ;; $Id$ (in-package :gsl) @@ -9,6 +9,8 @@ ;;; Should functions returning sf-result and something else return the ;;; error at the end? +;;; /usr/include/gsl/gsl_sf_gamma.h + ;;;;**************************************************************************** ;;;; Gamma functions ;;;;**************************************************************************** @@ -33,7 +35,8 @@ is computed using the real Lanczos method.") (defmfun log-gamma-sign (x) - "gsl_sf_lngamma_sgn_e" ((x :double) (ret sf-result) (sign :double)) + "gsl_sf_lngamma_sgn_e" + ((x :double) (ret sf-result) (sign (:pointer :double))) :return ((val ret) (dcref sign) (err ret)) :documentation ; FDL "Compute the sign of the gamma function and the logarithm of @@ -127,7 +130,7 @@ (defmfun log-pochammer-sign (a x) "gsl_sf_lnpoch_sgn_e" - ((a :double) (x :double) (ret sf-result) (sign :double)) + ((a :double) (x :double) (ret sf-result) (sign (:pointer :double))) :documentation ; FDL "The logarithm of the Pochhammer symbol and its sign. The computed parameters are result = diff --git a/tests/axpy.lisp b/tests/axpy.lisp index be0969284d2e83e23d6efb56f5bdec50b419a7ea..86db499bdbbf7e1cd11a4d6968cb2191ad757dbe 100644 --- a/tests/axpy.lisp +++ b/tests/axpy.lisp @@ -36,6 +36,7 @@ -49.08d0))) (SCALAR -39.66d0)) (CL-ARRAY (AXPY SCALAR V1 V2))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(1808.3204 1422.3015) #C(-589.3992 234.75043) @@ -59,6 +60,7 @@ 31.67))) (SCALAR #C(-39.66 -49.46))) (CL-ARRAY (AXPY SCALAR V1 V2))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(1808.3204d0 1422.3016000000002d0) diff --git a/tests/inverse-matrix-product.lisp b/tests/inverse-matrix-product.lisp index bfac7c9df004a9c65a198af63c72415d10e5ecff..d84e0ba58975247a13a2f50614b697bf443ee2e9 100644 --- a/tests/inverse-matrix-product.lisp +++ b/tests/inverse-matrix-product.lisp @@ -42,6 +42,7 @@ (-49.08d0 -39.66d0 -49.46d0)))) (S1 19.68d0)) (CL-ARRAY (INVERSE-MATRIX-PRODUCT M1 M2 S1))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(-28.191956 35.052914) #C(-13.378113 28.736774) @@ -71,6 +72,7 @@ -5.55 -8.82)))) (S1 #C(19.68 -5.55))) (CL-ARRAY (INVERSE-MATRIX-PRODUCT M1 M2 S1))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(-28.191956546692666d0 35.052909000810466d0) diff --git a/tests/matrix-product-nonsquare.lisp b/tests/matrix-product-nonsquare.lisp index 14ee6e713b52b2ffb36e536b7313358ced229567..1b580601a9abaac0f98ef497798eb744670d42cd 100644 --- a/tests/matrix-product-nonsquare.lisp +++ b/tests/matrix-product-nonsquare.lisp @@ -30,6 +30,7 @@ (32.5d0 42.73d0) (-17.24d0 43.31d0))))) (CL-ARRAY (MATRIX-PRODUCT M1 M2))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(-1422.0259 2305.5098) @@ -51,6 +52,7 @@ (32.5 42.73 -17.24 43.31) (-17.24 43.31 -16.12 -8.25))))) (CL-ARRAY (MATRIX-PRODUCT M1 M2))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(-1422.0258d0 2305.5097000000005d0) diff --git a/tests/matrix-product-triangular.lisp b/tests/matrix-product-triangular.lisp index 5f98794b2411cea6d364d16c8c736f7904762fd3..4f5dc56eae337a932575694994ce61acddd11194 100644 --- a/tests/matrix-product-triangular.lisp +++ b/tests/matrix-product-triangular.lisp @@ -42,6 +42,7 @@ (-49.08d0 -39.66d0 -49.46d0)))) (S1 19.68d0)) (CL-ARRAY (MATRIX-PRODUCT-TRIANGULAR M1 M2 S1))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(-66397.9 18986.908) #C(-56335.145 48514.305) @@ -72,6 +73,7 @@ -5.55 -8.82)))) (S1 #C(19.68 -5.55))) (CL-ARRAY (MATRIX-PRODUCT-TRIANGULAR M1 M2 S1))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(-66397.89753899998d0 18986.908142999997d0) @@ -130,6 +132,7 @@ '(42.73d0 -17.24d0 43.31d0))) (S1 -16.12d0)) (CL-ARRAY (MATRIX-PRODUCT-TRIANGULAR M1 V1 S1))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(-1483.223 1289.3523) #C(-57.63159 1675.6711) @@ -151,6 +154,7 @@ 21.44))) (S1 #C(-16.12 -8.25))) (CL-ARRAY (MATRIX-PRODUCT-TRIANGULAR M1 V1 S1))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(-1483.2230999999997d0 1289.3523999999998d0) diff --git a/tests/matrix-product.lisp b/tests/matrix-product.lisp index 7389dc1c6bbb8645399ede4377979270b85762cc..de5af1a036c54e3f2b672cc154ec5fe72d6093df 100644 --- a/tests/matrix-product.lisp +++ b/tests/matrix-product.lisp @@ -54,6 +54,7 @@ (S1 -41.67d0) (S2 42.0d0)) (CL-ARRAY (MATRIX-PRODUCT M1 M2 M3 S1 S2))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(140927.64 -143005.16) #C(72986.305 -201162.86) @@ -93,6 +94,7 @@ (S1 #C(-41.67 42.0)) (S2 #C(42.0 -20.81))) (CL-ARRAY (MATRIX-PRODUCT M1 M2 M3 S1 S2))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #2A((#C(140927.638311d0 -143005.14965699997d0) @@ -171,6 +173,7 @@ (S1 -49.08d0) (S2 -39.66d0)) (CL-ARRAY (MATRIX-PRODUCT M1 V1 V2 S1 S2))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(124163.57 -3332.2988) #C(119793.48 -166378.0) @@ -198,6 +201,7 @@ (S1 #C(-49.08 -39.66)) (S2 #C(-39.66 -49.46))) (CL-ARRAY (MATRIX-PRODUCT M1 V1 V2 S1 S2))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(124163.58013199999d0 -3332.2974459999896d0) diff --git a/tests/matrix-set-all-add.lisp b/tests/matrix-set-all-add.lisp deleted file mode 100644 index 49fdd5627d0e4a0d167f86562b2950249fe967cb..0000000000000000000000000000000000000000 --- a/tests/matrix-set-all-add.lisp +++ /dev/null @@ -1,142 +0,0 @@ -;; Regression test MATRIX-SET-ALL-ADD for GSLL, automatically generated - -(in-package :gsl) - -(LISP-UNIT:DEFINE-TEST MATRIX-SET-ALL-ADD - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #2A((8.23 50.97 46.02) - (33.8 76.85 36.579998) - (92.0 29.24 75.229996))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3))) - (M2 - (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS - '((-34.5 8.24 3.29) - (-8.93 34.12 -6.15) - (49.27 -13.49 32.5))))) - (SET-ALL M1 42.73) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #2A((8.229999999999997d0 50.97d0 46.019999999999996d0) - (33.8d0 76.85d0 36.58d0) - (92.0d0 29.239999999999995d0 - 75.22999999999999d0))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3))) - (M2 - (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '((-34.5d0 8.24d0 3.29d0) - (-8.93d0 34.12d0 -6.15d0) - (49.27d0 -13.49d0 32.5d0))))) - (SET-ALL M1 42.73d0) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-32 -36 103) (-59 84 22) (105 27 -101))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 8) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))))) - (SET-ALL M1 32) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((95 72 217) (144 191 168) (189 243 126))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 8) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 8) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))))) - (SET-ALL M1 28) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-32 -36 103) (-59 84 22) (105 27 155))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 16) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))))) - (SET-ALL M1 32) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((95 72 217) (144 191 168) (189 243 126))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 16) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 16) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))))) - (SET-ALL M1 28) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-32 -36 103) (-59 84 22) (105 27 155))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 32) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))))) - (SET-ALL M1 32) - (CL-ARRAY (ELT+ M1 M2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((95 72 217) (144 191 168) (189 243 126))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 32) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 32) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))))) - (SET-ALL M1 28) - (CL-ARRAY (ELT+ M1 M2))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((-32 -36 103) (-59 84 22) (105 27 155))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(SIGNED-BYTE 64) - :INITIAL-CONTENTS - '((-64 -68 71) (-91 52 -10) - (73 -5 123))))) - (SET-ALL M1 32) - (CL-ARRAY (ELT+ M1 M2))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #2A((95 72 217) (144 191 168) (189 243 126))) - (MULTIPLE-VALUE-LIST - (LET ((M1 - (MAKE-MARRAY '(UNSIGNED-BYTE 64) :DIMENSIONS - '(3 3))) - (M2 - (MAKE-MARRAY '(UNSIGNED-BYTE 64) - :INITIAL-CONTENTS - '((67 44 189) (116 163 140) - (161 215 98))))) - (SET-ALL M1 28) - (CL-ARRAY (ELT+ M1 M2)))))) - diff --git a/tests/matrix-set-all.lisp b/tests/matrix-set-all.lisp new file mode 100644 index 0000000000000000000000000000000000000000..ce5782110a14e54efed2e9c3e48018f779e781ff --- /dev/null +++ b/tests/matrix-set-all.lisp @@ -0,0 +1,105 @@ +;; Regression test MATRIX-SET-ALL for GSLL, automatically generated + +(in-package :gsl) + +(LISP-UNIT:DEFINE-TEST MATRIX-SET-ALL + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #2A((-34.5 -34.5 -34.5) + (-34.5 -34.5 -34.5) + (-34.5 -34.5 -34.5))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3)))) + (CL-ARRAY (SET-ALL M1 -34.5))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #2A((-34.5d0 -34.5d0 -34.5d0) + (-34.5d0 -34.5d0 -34.5d0) + (-34.5d0 -34.5d0 -34.5d0))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3)))) + (CL-ARRAY (SET-ALL M1 -34.5d0))))) + #+fsbv + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #2A((#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24)) + (#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24)) + (#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24)))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) + :DIMENSIONS '(3 3)))) + (CL-ARRAY (SET-ALL M1 #C(-34.5 8.24)))))) + #+fsbv + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #2A((#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0) + #C(-34.5d0 8.24d0)) + (#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0) + #C(-34.5d0 8.24d0)) + (#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0) + #C(-34.5d0 8.24d0)))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) + :DIMENSIONS '(3 3)))) + (CL-ARRAY (SET-ALL M1 #C(-34.5d0 8.24d0)))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(SIGNED-BYTE 8) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((67 67 67) (67 67 67) (67 67 67))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(UNSIGNED-BYTE 8) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((67 67 67) (67 67 67) (67 67 67))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(UNSIGNED-BYTE 16) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((67 67 67) (67 67 67) (67 67 67))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(UNSIGNED-BYTE 32) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #2A((67 67 67) (67 67 67) (67 67 67))) + (MULTIPLE-VALUE-LIST + (LET ((M1 + (MAKE-MARRAY '(UNSIGNED-BYTE 64) :DIMENSIONS + '(3 3)))) + (CL-ARRAY (SET-ALL M1 67)))))) + diff --git a/tests/scale.lisp b/tests/scale.lisp index e40fe7c5f7107fde2ec6715695bad719ed56681d..50e49f0f4665d5c85dd8b5412094ccc4170a29d9 100644 --- a/tests/scale.lisp +++ b/tests/scale.lisp @@ -62,6 +62,7 @@ -13.49d0))) (SCALAR 32.5d0)) (CL-ARRAY (SCALE SCALAR V1))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(-1473.3452 -1206.385) #C(488.5039 -149.64331) @@ -78,6 +79,7 @@ -49.08))) (SCALAR #C(32.5 42.73))) (CL-ARRAY (SCALE SCALAR V1))))) + #+fsbv (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(#C(-1473.3452d0 -1206.385d0) diff --git a/tests/vector-set-all-add.lisp b/tests/vector-set-all-add.lisp deleted file mode 100644 index af7b307fb852ce6407f72817bd174bd922328125..0000000000000000000000000000000000000000 --- a/tests/vector-set-all-add.lisp +++ /dev/null @@ -1,146 +0,0 @@ -;; Regression test VECTOR-SET-ALL-ADD for GSLL, automatically generated - -(in-package :gsl) - -(LISP-UNIT:DEFINE-TEST VECTOR-SET-ALL-ADD - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-43.43 -0.69000053 -5.6400003)) - (MULTIPLE-VALUE-LIST - (LET ((V1 (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS - '(-34.5 8.24 3.29)))) - (SET-ALL V1 -8.93) - (CL-ARRAY (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-43.43d0 -0.6899999999999995d0 -5.64d0)) - (MULTIPLE-VALUE-LIST - (LET ((V1 (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(-34.5d0 8.24d0 3.29d0)))) - (SET-ALL V1 -8.93d0) - (CL-ARRAY (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(101 97 -20)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(SIGNED-BYTE - 8) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(SIGNED-BYTE - 8) - :INITIAL-CONTENTS - '(-64 -68 - 71)))) - (SET-ALL V1 -91) - (CL-ARRAY - (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 160 49)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 8) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 8) - :INITIAL-CONTENTS - '(67 44 - 189)))) - (SET-ALL V1 116) - (CL-ARRAY - (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-155 -159 -20)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY '(SIGNED-BYTE 16) - :INITIAL-CONTENTS '(-64 -68 71)))) - (SET-ALL V1 -91) - (CL-ARRAY (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 160 305)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 16) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 16) - :INITIAL-CONTENTS - '(67 44 - 189)))) - (SET-ALL V1 116) - (CL-ARRAY - (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-155 -159 -20)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY '(SIGNED-BYTE 32) - :INITIAL-CONTENTS '(-64 -68 71)))) - (SET-ALL V1 -91) - (CL-ARRAY (ELT+ V1 V2))))) - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 160 305)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 32) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 32) - :INITIAL-CONTENTS - '(67 44 - 189)))) - (SET-ALL V1 116) - (CL-ARRAY - (ELT+ V1 V2))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(-155 -159 -20)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS '3)) - (V2 - (MAKE-MARRAY '(SIGNED-BYTE 64) - :INITIAL-CONTENTS '(-64 -68 71)))) - (SET-ALL V1 -91) - (CL-ARRAY (ELT+ V1 V2))))) - #+int64 - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(183 160 305)) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 64) - :DIMENSIONS - '3)) - (V2 - (MAKE-MARRAY - '(UNSIGNED-BYTE - 64) - :INITIAL-CONTENTS - '(67 44 - 189)))) - (SET-ALL V1 116) - (CL-ARRAY - (ELT+ V1 V2)))))) - diff --git a/tests/vector-set-all.lisp b/tests/vector-set-all.lisp new file mode 100644 index 0000000000000000000000000000000000000000..331e3dfee42d7eaa14b348d5611e58ff14c88162 --- /dev/null +++ b/tests/vector-set-all.lisp @@ -0,0 +1,122 @@ +;; Regression test VECTOR-SET-ALL for GSLL, automatically generated + +(in-package :gsl) + +(LISP-UNIT:DEFINE-TEST VECTOR-SET-ALL + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #(-34.5 -34.5 -34.5)) + (MULTIPLE-VALUE-LIST + (LET ((V1 (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '3))) + (CL-ARRAY (SET-ALL V1 -34.5))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #(-34.5d0 -34.5d0 -34.5d0)) + (MULTIPLE-VALUE-LIST + (LET ((V1 (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '3))) + (CL-ARRAY (SET-ALL V1 -34.5d0))))) + #+fsbv + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST #(#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24))) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) + :DIMENSIONS '3))) + (CL-ARRAY (SET-ALL V1 #C(-34.5 8.24)))))) + #+fsbv + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST + #(#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0) + #C(-34.5d0 8.24d0))) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) + :DIMENSIONS '3))) + (CL-ARRAY (SET-ALL V1 #C(-34.5d0 8.24d0)))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(-64 -64 -64)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(SIGNED-BYTE + 8) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(67 67 67)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(UNSIGNED-BYTE + 8) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(-64 -64 -64)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(SIGNED-BYTE + 16) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(67 67 67)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(UNSIGNED-BYTE + 16) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(-64 -64 -64)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(SIGNED-BYTE + 32) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(67 67 67)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(UNSIGNED-BYTE + 32) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + 67))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(-64 -64 -64)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(SIGNED-BYTE + 64) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + -64))))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST #(67 67 67)) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (MAKE-MARRAY + '(UNSIGNED-BYTE + 64) + :DIMENSIONS + '3))) + (CL-ARRAY + (SET-ALL V1 + 67)))))) +