packages feed

linear-algebra-cblas (empty) → 0.1

raw patch · 66 files changed

+18371/−0 lines, 66 filesdep +QuickCheckdep +basedep +ieee754setup-changed

Dependencies added: QuickCheck, base, ieee754, storable-complex, test-framework, test-framework-quickcheck2, vector

Files

+ COPYING view
@@ -0,0 +1,30 @@+Copyright (c) Patrick Perry <patperry@gmail.com> 2010+Copyright (c) Carter Schonwald <carter atsign wellposed dot com> 2012+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ NEWS view
@@ -0,0 +1,100 @@+Changes in 0.8.0.1++Changes in 0.8:++* Use GADTs to and remove the element type from the typeclasses.  This+  makes the function signatures a lot nicer to read and write.+  +* Put structural operations ( swap, copy, vconj ) in Elem.  This removes the+  BLAS1 constraint from the structural functions like getRow.+  +* Allowing reading from immutable types in arbitrary monads.+  +* Add binding to "ger".++* Add functional dependency m -> a in Write{Vector,Matrix,Banded} a m+  +* Add test coverage for all code paths in matrix multiplication and solve+  routines.  Fix bugs in bindings to gemv and hemm.+  +* Specialize multiplication and solve routines for Doubles so that they+  ignore complex conjugacy information.+  +Changes in 0.7.6:++* Fix a memory-trashing segfault.++Changes in 0.7.5:++* Export all unsafe functions in Unsafe.BLAS.++* Use enumerations instead of Bools in data types.++Changes in 0.7:++* Get rid of most functional dependencies in favor of type families.+  There is one remaining functional dependency that cannot be gotten+  rid of until GHC implements equality constraints in superclass+  contexts.++* Put the right superclass constraints in  ReadMatrix/ReadBanded.++* Fix freeze/thaw functions.++* Fix a bug in getting a row view of a banded matrix.++* Make sure no NaNs/Infinities/Denormals are used when testing.++* Documentation.++* Export functions for writing QuickCheck tests.++* Remove Perm and Diag.  These will be in the LAPACK bindings.++* Get rid of "UnsafeIOToM" type class.++* Lots of INLINE everywhere.  This should improve performance.++* Switch to autoconf for build system.++* Massive code cleanup.+++Changes in 0.6:++* Massive overhaul of the types.  It is now possible to do mutable operations+  in the ST monad.  Access control is done via type classes now instead of+  phantom types.+  +* No more orphan instances.++* Change some function names.  You should never have to "import qualified"+  anything now.+  +* Put row/col operations in the Matrix type classes.  Generic matrix types+  now provide access to rows and columns.+  ++Changes in 0.5:++* Add Banded matrix data type, as well as Tri Banded and Herm Banded.++* Add support for trapezoidal dense matrices (Tri Matrix (m,n) e, where+  m is not the same as n).  Note that trapezoidal banded matrices are+  *NOT* supported.++* Add Diag matrix data type for diagonal matrices.++* Add Perm matrix data type, for permutation matrices.++* Enhance the RMatrix and RSolve type classes with an API that allows +  specifying where to store the result of a computation.+  +* Enhance the IMatrix, RMatrix, ISolve, and RSolve type classes to add+  "scale and multiply" operations.+  +* Remove the scale parameter for Tri and Herm matrix data types.++* Flatten the data types for DVector and DMatrix.++* Some inlining and unpacking performance improvements.
+ README view
@@ -0,0 +1,17 @@++To build the package, there is no need to run the configure script.  Just+use the standard cabal commands:++    runhaskell Setup.lhs configure+    runhaskell Setup.lhs build+    runhaskell Setup.lhs install+    +The package uses a script to find what BLAS and LAPACK libraries to link with.+To link with a custom BLAS or LAPACK, add the "--with-blas=<lib>" +or "--with-lapack=<lib>" argument to --configure-option.  For example,++    runhaskell Setup.lhs configure --configure-option="--with-blas=<lib>"++To build this package from the git repository, first run+    aclocal -I m4+    autoreconf
+ Setup.lhs view
@@ -0,0 +1,14 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> import Distribution.Simple.LocalBuildInfo+> import Distribution.PackageDescription+> import System.Cmd+> import System.FilePath+>+> main = defaultMainWithHooks autoconfUserHooks { runTests = runTests' }+>+> runTests' :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()+> runTests' _ _ _ lbi = system testprog >> return ()+>   where testprog = (buildDir lbi)+>                        </> "test-hs-linear-algebra"+>                        </> "test-hs-linear-algebra"
+ TODO view
@@ -0,0 +1,67 @@++One great way to help is just to use the library, and give me feedback from+your experience.  What do you like?  What don't you like?  What is fast?+What is slow?  This stuff is really important for me to know.++If you are interested in hacking on the library, there is tons of work to do.+Here is a partial list.  Let me know what you would like to work on, and I can+give you some guidance on the best way to approach the task.++Small projects+--------------++* Write tests.  Look at the HPC output (from `make hpc` in the `tests` +  directory), to find what functions are not being tested.++* Write benchmarks, especially ones that allow comparisons with C or Fortran.  +  The LU decomposition in the examples directory is a good starting point.++* Write a tutorial or blog post about the library.++* The tests for solving triangular systems fail when an ill-conditioned +  matrix gets generated.  I have investigated some of the failing cases+  in R, and have determined this isn't a bug.  Ideally, we should only+  test with well-conditioned systems. ++* Add conversions from Herm Matrix to Matrix.++* Add conversions from Tri Matrix to Matrix.++* investigate test failure+  weightedMeanVector (equal weights): [OK, passed 100 tests]+VectorList 1 [fromList [0.0] :: Data.Vector.Storable.Vector]+fromList [0.0] :: Data.Vector.Storable.Vector+UnbiasedCov+  covMatrix: [Failed]++* Check arguments in shiftDiagWithScale (Matrix)++* Don't use conjugateTo with same argument in conjTransTo++* Optimize unsafeGetRow (use BLAS1)++Medium projects+---------------++* I haven't really tested it, but probably the library doesn't build on+  Windows.  See if it is possible to build the library on windows.  If+  not, figure out how to do so.  This may involve using something other+  than autoconf on windows.++* Write tests for STBanded.  The easiest way to do this is to mimic what is+  done in the STMatrix tests.+++Big Projects+------------++* Support for packed storage of symmetric and triangular matrices.  +  Add a Data.Matrix.Packed class with a heirarchy similar to +  Data.Matrix.Banded. Provide MMatrix/IMatrix instances for +  Tri Packed and Herm Packed.++* Switch over from error calls to extensible exceptions from base-4.0;+  Throw "dimension mismatch" exceptions rather than just calling+  error.  This allows for better reporting.  In particular, the covariance+  match computations should catch any dimension mismatch exceptions and then+  provide a more user-friendly message.
+ aclocal.m4 view
@@ -0,0 +1,16 @@+# generated automatically by aclocal 1.13.1 -*- Autoconf -*-++# Copyright (C) 1996-2012 Free Software Foundation, Inc.++# This file is free software; the Free Software Foundation+# gives unlimited permission to copy and/or distribute it,+# with or without modifications, as long as this notice is preserved.++# This program is distributed in the hope that it will be useful,+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A+# PARTICULAR PURPOSE.++m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])])+m4_include([m4/ax_check_blas.m4])+m4_include([m4/ax_check_lapack.m4])
+ cbits/config.h.in view
@@ -0,0 +1,31 @@+/* cbits/config.h.in.  Generated from configure.ac by autoheader.  */++/* Define to a macro mangling the given Fortan function name */+#undef F77_FUNC++/* Define if you have a BLAS library. */+#undef HAVE_BLAS++/* Define if you have LAPACK library. */+#undef HAVE_LAPACK++/* Define to 1 if you have the `m' library (-lm). */+#undef HAVE_LIBM++/* Define to the address where bug reports for this package should be sent. */+#undef PACKAGE_BUGREPORT++/* Define to the full name of this package. */+#undef PACKAGE_NAME++/* Define to the full name and version of this package. */+#undef PACKAGE_STRING++/* Define to the one symbol short name of this package. */+#undef PACKAGE_TARNAME++/* Define to the home page for this package. */+#undef PACKAGE_URL++/* Define to the version of this package. */+#undef PACKAGE_VERSION
+ cbits/vmath-double.c view
@@ -0,0 +1,342 @@++#include "config.h"+#include <math.h>+#include <string.h>+#include "vmath.h"++#define la_int int++extern void+F77_FUNC(daxpy) (const la_int *n, const double *da, const double *dx,+	         const la_int *incx, double *dy, const la_int *incy);++++static void+vdClear (int n, double *z)+{+        memset(z, 0, n * sizeof(double));+}++static void+vdCopy (int n, const double *x, double *z)+{+        if (x != z) {+                memcpy(z, x, n * sizeof(double));+        }+}++void+vdScale (int n, double alpha, const double *x, double *z)+{+        if (alpha == 1) {+                vdCopy(n, x, z);+        } else if (alpha == 0) {+                vdClear(n, z);+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = alpha * x[i];+                }+        }+        +        /* Note: Using dscal sometimes gives differences in the least+         * significant bit of the answer */+}++void+vdShift (int n, double alpha, const double *x, double *z)+{+        if (alpha == 0) {+                vdCopy(n, x, z);+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = alpha + x[i];+                }+        }+}++void+vdNeg (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = -x[i];+        }+}++void+vdAbs (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = fabs(x[i]);+        }+}++static double+dsgn (double x)+{+        if (x == 0 || isnan(x)) {+                return x;+        } else {+                return copysign(1, x);+        }+}++void+vdSgn (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = dsgn(x[i]);+        }+}++void+vdInv (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = 1.0 / x[i];+        }+}++static void+vdAxpy (int n, double alpha, const double *x, const double *y, double *z)+{+        la_int one = 1;+        double done = 1.0;+        +        if (alpha == 0) {+                vdCopy(n, y, z);+        } else if (y == z) {+                F77_FUNC(daxpy) (&n, &alpha, x, &one, z, &one);+        } else if (alpha == 1 && x == z) {+                F77_FUNC(daxpy) (&n, &done, y, &one, z, &one);+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = alpha * x[i] + y[i];+                }+        }+}++void+vdAxpby (int n, double alpha, const double *x, double beta, const double *y, double *z)+{+        if (alpha == 0) {+                vdScale(n, beta, y, z);+        } else if (alpha == 1) {+                vdAxpy(n, beta, y, x, z);+        } else if (beta == 0) {+                vdScale(n, alpha, x, z);+        } else if (beta == 1) {+                vdAxpy(n, alpha, x, y, z);+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = alpha * x[i] + beta * y[i];+                }+        }+}++void+vdAdd (int n, const double *x, const double *y, double *z)+{+        vdAxpy(n, 1, x, y, z);+}++void vdSub (int n, const double *x, const double *y, double *z)+{+        vdAxpy(n, -1, y, x, z);+}++void+vdMul (int n, const double *x, const double *y, double *z)+{+        /* Note: using dtbmv sometimes gives different answers in the lower+         * bits of precision */+        +        /*if (y == z) {+                blas_dtbmv(BlasUpper, BlasNoTrans, BlasNonUnit, n, 0, x, 1,+                           z, 1);+        } else if (x == z) {+                blas_dtbmv(BlasUpper, BlasNoTrans, BlasNonUnit, n, 0, y, 1,+                           z, 1);+        } else { */+                +        int i;+        for (i = 0; i < n; i++) {+                z[i] = x[i] * y[i];+        }+}++void+vdDiv (int n, const double *x, const double *y, double *z)+{+        /* Note: using dtbsv gives slightly different answers+         */+        /*if (y == z) {+                blas_dtbsv(BlasUpper, BlasNoTrans, BlasNonUnit, n, 0, x, 1,+                           z, 1);+        } else */+        +        if (x == z) {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = z[i] / y[i];+                }+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = x[i] / y[i];+                }+        }+}++void+vdExp (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = exp(x[i]);+        }+}++void+vdSqrt (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = sqrt(x[i]);+        }+}++void+vdLog (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = log(x[i]);+        }        +}++void+vdPow (int n, const double *x, const double *y, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = pow(x[i], y[i]);+        }        +}++void+vdSin (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = sin(x[i]);+        }                +}++void+vdCos (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = cos(x[i]);+        }                        +}++void+vdTan (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = tan(x[i]);+        }                                +}++void+vdASin (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = asin(x[i]);+        }                                        +}++void+vdACos (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = acos(x[i]);+        }                                                +}++void+vdATan (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = atan(x[i]);+        }+}++void+vdSinh (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = sinh(x[i]);+        }                +}++void+vdCosh (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = cosh(x[i]);+        }                        +}++void+vdTanh (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = tanh(x[i]);+        }                                +}++void+vdASinh (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = asinh(x[i]);+        }                                        +}++void+vdACosh (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = acosh(x[i]);+        }                                                +}++void+vdATanh (int n, const double *x, double *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = atanh(x[i]);+        }+}+
+ cbits/vmath-zomplex.c view
@@ -0,0 +1,369 @@++#include "config.h"+#include <complex.h>+#include <string.h>+#include "vmath.h"++#define la_int int++extern void+F77_FUNC(zaxpy) (const la_int *n, const void *za, const void *zx,+	         const la_int *incx, void *zy, const la_int *incy);+++static double complex+complex_mul (double complex x, double complex y)+{+	double xr = creal(x), xi = cimag(x);+	double yr = creal(y), yi = cimag(y);+	double zr = xr * yr - xi * yi;+	double zi = xr * yi + xi * yr;+        double complex z = zr + I * zi;	+	return z;+}+++static void+vzClear (int n, double complex *z)+{+        memset(z, 0, n * 2 * sizeof(double));+}++static void+vzCopy (int n, const double complex *x, double complex *z)+{+        if (x != z) {+                memcpy(z, x, n * 2 * sizeof(double));+        }+}++void+vzConj (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = conj(x[i]);+        }+}++void+vzScale (int n, const double complex *palpha, const double complex *x, double complex *z)+{+        double complex alpha = *palpha;+        +        if (alpha == 1) {+                vzCopy(n, x, z);+        } else if (alpha == 0) {+                vzClear(n, z);+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = complex_mul(alpha, x[i]);+                }+        }+        +        /* Note: Using zscal sometimes gives differences in the least+         * significant bit of the answer */+}++void+vzShift (int n, const double complex *palpha, const double complex *x, double complex *z)+{+        double complex alpha = *palpha;+        +        if (alpha == 0) {+                vzCopy(n, x, z);+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = alpha + x[i];+                }+        }+}++void+vzNeg (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = -x[i];+        }+}++void+vzAbs (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = cabs(x[i]) + 0*I;+        }+}++static void+zsgn (const double complex x, double complex *z)+{+        if (x == 0) {+                *z = x;+        } else {+                double r = cabs(x);+                *z = creal(x)/r + cimag(x)/r*I;+        }+}++void+vzSgn (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                zsgn(x[i], &(z[i]));+        }+}++void+vzInv (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = 1.0 / x[i];+        }+}++static void+vzAxpy (int n, const double complex *palpha, const double complex *x, const double complex *y, double complex *z)+{+        double complex alpha = *palpha;+        la_int one = 1;+        +        if (alpha == 0) {+                vzCopy(n, y, z);+        } else if (y == z) {+                F77_FUNC(zaxpy) (&n, palpha, x, &one, z, &one);+        } else if (alpha == 1 && x == z) {+                F77_FUNC(zaxpy) (&n, palpha, y, &one, z, &one);+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = alpha * x[i] + y[i];+                }+        }+}++void+vzAxpby (int n, const double complex *palpha, const double complex *x, const double complex *pbeta, const double complex *y, double complex *z)+{+        double complex alpha = *palpha;+        double complex beta = *pbeta;        +                +        if (alpha == 0) {+                vzScale(n, pbeta, y, z);+        } else if (alpha == 1) {+                vzAxpy(n, pbeta, y, x, z);+        } else if (beta == 0) {+                vzScale(n, palpha, x, z);+        } else if (beta == 1) {+                vzAxpy(n, palpha, x, y, z);+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = alpha * x[i] + beta * y[i];+                }+        }+}++void+vzAdd (int n, const double complex *x, const double complex *y, double complex *z)+{+        vdAdd(2 * n, (const double *)x, (const double *)y, (double *)z);+}++void vzSub (int n, const double complex *x, const double complex *y, double complex *z)+{+        vdSub(2 * n, (const double *)x, (const double *)y, (double *)z);+}++void+vzMul (int n, const double complex *x, const double complex *y, double complex *z)+{+        /* Note: using ztbmv sometimes gives different answers in the lower+         * bits of precision */+        /*+        if (y == z) {+                blas_ztbmv(BlasUpper, BlasNoTrans, BlasNonUnit, n, 0, x, 1,+                           z, 1);+        } else if (x == z) {+                blas_ztbmv(BlasUpper, BlasNoTrans, BlasNonUnit, n, 0, y, 1,+                           z, 1);+        } */+        int i;+        for (i = 0; i < n; i++) {+                z[i] = complex_mul(x[i], y[i]);+        }+}++void+vzDiv (int n, const double complex *x, const double complex *y, double complex *z)+{+        /* Note: using dtbsv gives slightly different answers+         */+        /*+        if (y == z) {+                blas_ztbsv(BlasUpper, BlasNoTrans, BlasNonUnit, n, 0, x, 1,+                           z, 1);+        } else */+        if (x == z) {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = z[i] / y[i];+                }+        } else {+                int i;+                for (i = 0; i < n; i++) {+                        z[i] = x[i] / y[i];+                }+        }+}++void+vzExp (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = cexp(x[i]);+        }+}++void+vzSqrt (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = csqrt(x[i]);+        }+}++void+vzLog (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = clog(x[i]);+        }        +}++void+vzPow (int n, const double complex *x, const double complex *y, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = cpow(x[i], y[i]);+        }        +}++void+vzSin (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = csin(x[i]);+        }                +}++void+vzCos (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = ccos(x[i]);+        }                        +}++void+vzTan (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = ctan(x[i]);+        }                                +}++void+vzASin (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = casin(x[i]);+        }                                        +}++void+vzACos (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = cacos(x[i]);+        }                                                +}++void+vzATan (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = catan(x[i]);+        }+}++void+vzSinh (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = csinh(x[i]);+        }                +}++void+vzCosh (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = ccosh(x[i]);+        }                        +}++void+vzTanh (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = ctanh(x[i]);+        }                                +}++void+vzASinh (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = casinh(x[i]);+        }                                        +}++void+vzACosh (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = cacosh(x[i]);+        }                                                +}++void+vzATanh (int n, const double complex *x, double complex *z)+{+        int i;+        for (i = 0; i < n; i++) {+                z[i] = catanh(x[i]);+        }+}+
+ configure view
@@ -0,0 +1,5684 @@+#! /bin/sh+# Guess values for system-dependent variables and create Makefiles.+# Generated by GNU Autoconf 2.69 for Haskell Linear Algebra 0.8.+#+# Report bugs to <patperry@gmail.com>.+#+#+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.+#+#+# This configure script is free software; the Free Software Foundation+# gives unlimited permission to copy, distribute and modify it.+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+  setopt NO_GLOB_SUBST+else+  case `(set -o) 2>/dev/null` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+++as_nl='+'+export as_nl+# Printing a long string crashes Solaris 7 /usr/bin/printf.+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo+# Prefer a ksh shell builtin over an external printf program on Solaris,+# but without wasting forks for bash or zsh.+if test -z "$BASH_VERSION$ZSH_VERSION" \+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='print -r --'+  as_echo_n='print -rn --'+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='printf %s\n'+  as_echo_n='printf %s'+else+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'+    as_echo_n='/usr/ucb/echo -n'+  else+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'+    as_echo_n_body='eval+      arg=$1;+      case $arg in #(+      *"$as_nl"*)+	expr "X$arg" : "X\\(.*\\)$as_nl";+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;+      esac;+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"+    '+    export as_echo_n_body+    as_echo_n='sh -c $as_echo_n_body as_echo'+  fi+  export as_echo_body+  as_echo='sh -c $as_echo_body as_echo'+fi++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# IFS+# We need space, tab and new line, in precisely that order.  Quoting is+# there to prevent editors from complaining about space-tab.+# (If _AS_PATH_WALK were called with IFS unset, it would disable word+# splitting by setting IFS to empty value.)+IFS=" ""	$as_nl"++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# We did not find ourselves, most probably we were run as `sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+  as_myself=$0+fi+if test ! -f "$as_myself"; then+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi++# Unset variables that we do not need and which cause bugs (e.g. in+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"+# suppresses any "Segmentation fault" message there.  '((' could+# trigger a bug in pdksh 5.2.14.+for as_var in BASH_ENV ENV MAIL MAILPATH+do eval test x\${$as_var+set} = xset \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# CDPATH.+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH++# Use a proper internal environment variable to ensure we don't fall+  # into an infinite loop, continuously re-executing ourselves.+  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then+    _as_can_reexec=no; export _as_can_reexec;+    # We cannot yet assume a decent shell, so we have to provide a+# neutralization value for shells without unset; and this also+# works around shells that cannot unset nonexistent variables.+# Preserve -v and -x to the replacement shell.+BASH_ENV=/dev/null+ENV=/dev/null+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+case $- in # ((((+  *v*x* | *x*v* ) as_opts=-vx ;;+  *v* ) as_opts=-v ;;+  *x* ) as_opts=-x ;;+  * ) as_opts= ;;+esac+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}+# Admittedly, this is quite paranoid, since all the known shells bail+# out after a failed `exec'.+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2+as_fn_exit 255+  fi+  # We don't want this to propagate to other subprocesses.+          { _as_can_reexec=; unset _as_can_reexec;}+if test "x$CONFIG_SHELL" = x; then+  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '\${1+\"\$@\"}'='\"\$@\"'+  setopt NO_GLOB_SUBST+else+  case \`(set -o) 2>/dev/null\` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+"+  as_required="as_fn_return () { (exit \$1); }+as_fn_success () { as_fn_return 0; }+as_fn_failure () { as_fn_return 1; }+as_fn_ret_success () { return 0; }+as_fn_ret_failure () { return 1; }++exitcode=0+as_fn_success || { exitcode=1; echo as_fn_success failed.; }+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :++else+  exitcode=1; echo positional parameters were not saved.+fi+test x\$exitcode = x0 || exit 1+test -x / || exit 1"+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"+  if (eval "$as_required") 2>/dev/null; then :+  as_have_required=yes+else+  as_have_required=no+fi+  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :++else+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+as_found=false+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  as_found=:+  case $as_dir in #(+	 /*)+	   for as_base in sh bash ksh sh5; do+	     # Try only shells that exist, to save several forks.+	     as_shell=$as_dir/$as_base+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&+		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :+  CONFIG_SHELL=$as_shell as_have_required=yes+		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :+  break 2+fi+fi+	   done;;+       esac+  as_found=false+done+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&+	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :+  CONFIG_SHELL=$SHELL as_have_required=yes+fi; }+IFS=$as_save_IFS+++      if test "x$CONFIG_SHELL" != x; then :+  export CONFIG_SHELL+             # We cannot yet assume a decent shell, so we have to provide a+# neutralization value for shells without unset; and this also+# works around shells that cannot unset nonexistent variables.+# Preserve -v and -x to the replacement shell.+BASH_ENV=/dev/null+ENV=/dev/null+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+case $- in # ((((+  *v*x* | *x*v* ) as_opts=-vx ;;+  *v* ) as_opts=-v ;;+  *x* ) as_opts=-x ;;+  * ) as_opts= ;;+esac+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}+# Admittedly, this is quite paranoid, since all the known shells bail+# out after a failed `exec'.+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2+exit 255+fi++    if test x$as_have_required = xno; then :+  $as_echo "$0: This script requires a shell more modern than all"+  $as_echo "$0: the shells that I found on your system."+  if test x${ZSH_VERSION+set} = xset ; then+    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"+    $as_echo "$0: be upgraded to zsh 4.3.4 or later."+  else+    $as_echo "$0: Please tell bug-autoconf@gnu.org and patperry@gmail.com+$0: about your system, including any error possibly output+$0: before this message. Then install a modern shell, or+$0: manually run the script under such a shell if you do+$0: have one."+  fi+  exit 1+fi+fi+fi+SHELL=${CONFIG_SHELL-/bin/sh}+export SHELL+# Unset more variables known to interfere with behavior of common tools.+CLICOLOR_FORCE= GREP_OPTIONS=+unset CLICOLOR_FORCE GREP_OPTIONS++## --------------------- ##+## M4sh Shell Functions. ##+## --------------------- ##+# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p++# as_fn_executable_p FILE+# -----------------------+# Test if FILE is an executable regular file.+as_fn_executable_p ()+{+  test -f "$1" && test -x "$1"+} # as_fn_executable_p+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else+  as_fn_append ()+  {+    eval $1=\$$1\$2+  }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else+  as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  }+fi # as_fn_arith+++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  $as_echo "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits+++  as_lineno_1=$LINENO as_lineno_1a=$LINENO+  as_lineno_2=$LINENO as_lineno_2a=$LINENO+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)+  sed -n '+    p+    /[$]LINENO/=+  ' <$as_myself |+    sed '+      s/[$]LINENO.*/&-/+      t lineno+      b+      :lineno+      N+      :loop+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/+      t loop+      s/-\n.*//+    ' >$as_me.lineno &&+  chmod +x "$as_me.lineno" ||+    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }++  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have+  # already done that, so ensure we don't try to do so again and fall+  # in an infinite loop.  This has already happened in practice.+  _as_can_reexec=no; export _as_can_reexec+  # Don't try to exec as it changes $[0], causing all sort of problems+  # (the dirname of $[0] is not the place where we might find the+  # original and so on.  Autoconf is especially sensitive to this).+  . "./$as_me.lineno"+  # Exit status is that of the last command.+  exit+}++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+  rm -f conf$$.dir/conf$$.file+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  if ln -s conf$$.file conf$$ 2>/dev/null; then+    as_ln_s='ln -s'+    # ... but there are two gotchas:+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.+    # In both cases, we have to default to `cp -pR'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -pR'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -pR'+  fi+else+  as_ln_s='cp -pR'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null++if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++as_test_x='test -x'+as_executable_p=as_fn_executable_p++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++test -n "$DJDIR" || exec 7<&0 </dev/null+exec 6>&1++# Name of the host.+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,+# so uname gets run too.+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`++#+# Initializations.+#+ac_default_prefix=/usr/local+ac_clean_files=+ac_config_libobj_dir=.+LIBOBJS=+cross_compiling=no+subdirs=+MFLAGS=+MAKEFLAGS=++# Identity of this package.+PACKAGE_NAME='Haskell Linear Algebra'+PACKAGE_TARNAME='haskell-linear-algebra'+PACKAGE_VERSION='0.8'+PACKAGE_STRING='Haskell Linear Algebra 0.8'+PACKAGE_BUGREPORT='patperry@gmail.com'+PACKAGE_URL=''++ac_unique_file="linear-algebra.cabal"+ac_subst_vars='LTLIBOBJS+LIBOBJS+BUILD_PACKAGE_BOOL+LAPACK_LIBS+BLAS_LIBS+OBJEXT+EXEEXT+ac_ct_CC+CPPFLAGS+LDFLAGS+CFLAGS+CC+target_alias+host_alias+build_alias+LIBS+ECHO_T+ECHO_N+ECHO_C+DEFS+mandir+localedir+libdir+psdir+pdfdir+dvidir+htmldir+infodir+docdir+oldincludedir+includedir+localstatedir+sharedstatedir+sysconfdir+datadir+datarootdir+libexecdir+sbindir+bindir+program_transform_name+prefix+exec_prefix+PACKAGE_URL+PACKAGE_BUGREPORT+PACKAGE_STRING+PACKAGE_VERSION+PACKAGE_TARNAME+PACKAGE_NAME+PATH_SEPARATOR+SHELL'+ac_subst_files=''+ac_user_opts='+enable_option_checking+with_compiler+with_blas+with_lapack+'+      ac_precious_vars='build_alias+host_alias+target_alias+CC+CFLAGS+LDFLAGS+LIBS+CPPFLAGS'+++# Initialize some variables set by options.+ac_init_help=+ac_init_version=false+ac_unrecognized_opts=+ac_unrecognized_sep=+# The variables have the same names as the options, with+# dashes changed to underlines.+cache_file=/dev/null+exec_prefix=NONE+no_create=+no_recursion=+prefix=NONE+program_prefix=NONE+program_suffix=NONE+program_transform_name=s,x,x,+silent=+site=+srcdir=+verbose=+x_includes=NONE+x_libraries=NONE++# Installation directory options.+# These are left unexpanded so users can "make install exec_prefix=/foo"+# and all the variables that are supposed to be based on exec_prefix+# by default will actually change.+# Use braces instead of parens because sh, perl, etc. also accept them.+# (The list follows the same order as the GNU Coding Standards.)+bindir='${exec_prefix}/bin'+sbindir='${exec_prefix}/sbin'+libexecdir='${exec_prefix}/libexec'+datarootdir='${prefix}/share'+datadir='${datarootdir}'+sysconfdir='${prefix}/etc'+sharedstatedir='${prefix}/com'+localstatedir='${prefix}/var'+includedir='${prefix}/include'+oldincludedir='/usr/include'+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'+infodir='${datarootdir}/info'+htmldir='${docdir}'+dvidir='${docdir}'+pdfdir='${docdir}'+psdir='${docdir}'+libdir='${exec_prefix}/lib'+localedir='${datarootdir}/locale'+mandir='${datarootdir}/man'++ac_prev=+ac_dashdash=+for ac_option+do+  # If the previous option needs an argument, assign it.+  if test -n "$ac_prev"; then+    eval $ac_prev=\$ac_option+    ac_prev=+    continue+  fi++  case $ac_option in+  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;+  *=)   ac_optarg= ;;+  *)    ac_optarg=yes ;;+  esac++  # Accept the important Cygnus configure options, so we can diagnose typos.++  case $ac_dashdash$ac_option in+  --)+    ac_dashdash=yes ;;++  -bindir | --bindir | --bindi | --bind | --bin | --bi)+    ac_prev=bindir ;;+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)+    bindir=$ac_optarg ;;++  -build | --build | --buil | --bui | --bu)+    ac_prev=build_alias ;;+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)+    build_alias=$ac_optarg ;;++  -cache-file | --cache-file | --cache-fil | --cache-fi \+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)+    ac_prev=cache_file ;;+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)+    cache_file=$ac_optarg ;;++  --config-cache | -C)+    cache_file=config.cache ;;++  -datadir | --datadir | --datadi | --datad)+    ac_prev=datadir ;;+  -datadir=* | --datadir=* | --datadi=* | --datad=*)+    datadir=$ac_optarg ;;++  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \+  | --dataroo | --dataro | --datar)+    ac_prev=datarootdir ;;+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)+    datarootdir=$ac_optarg ;;++  -disable-* | --disable-*)+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid feature name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=no ;;++  -docdir | --docdir | --docdi | --doc | --do)+    ac_prev=docdir ;;+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)+    docdir=$ac_optarg ;;++  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)+    ac_prev=dvidir ;;+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)+    dvidir=$ac_optarg ;;++  -enable-* | --enable-*)+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid feature name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=\$ac_optarg ;;++  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \+  | --exec | --exe | --ex)+    ac_prev=exec_prefix ;;+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \+  | --exec=* | --exe=* | --ex=*)+    exec_prefix=$ac_optarg ;;++  -gas | --gas | --ga | --g)+    # Obsolete; use --with-gas.+    with_gas=yes ;;++  -help | --help | --hel | --he | -h)+    ac_init_help=long ;;+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)+    ac_init_help=recursive ;;+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)+    ac_init_help=short ;;++  -host | --host | --hos | --ho)+    ac_prev=host_alias ;;+  -host=* | --host=* | --hos=* | --ho=*)+    host_alias=$ac_optarg ;;++  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)+    ac_prev=htmldir ;;+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \+  | --ht=*)+    htmldir=$ac_optarg ;;++  -includedir | --includedir | --includedi | --included | --include \+  | --includ | --inclu | --incl | --inc)+    ac_prev=includedir ;;+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \+  | --includ=* | --inclu=* | --incl=* | --inc=*)+    includedir=$ac_optarg ;;++  -infodir | --infodir | --infodi | --infod | --info | --inf)+    ac_prev=infodir ;;+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)+    infodir=$ac_optarg ;;++  -libdir | --libdir | --libdi | --libd)+    ac_prev=libdir ;;+  -libdir=* | --libdir=* | --libdi=* | --libd=*)+    libdir=$ac_optarg ;;++  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \+  | --libexe | --libex | --libe)+    ac_prev=libexecdir ;;+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \+  | --libexe=* | --libex=* | --libe=*)+    libexecdir=$ac_optarg ;;++  -localedir | --localedir | --localedi | --localed | --locale)+    ac_prev=localedir ;;+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)+    localedir=$ac_optarg ;;++  -localstatedir | --localstatedir | --localstatedi | --localstated \+  | --localstate | --localstat | --localsta | --localst | --locals)+    ac_prev=localstatedir ;;+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)+    localstatedir=$ac_optarg ;;++  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)+    ac_prev=mandir ;;+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)+    mandir=$ac_optarg ;;++  -nfp | --nfp | --nf)+    # Obsolete; use --without-fp.+    with_fp=no ;;++  -no-create | --no-create | --no-creat | --no-crea | --no-cre \+  | --no-cr | --no-c | -n)+    no_create=yes ;;++  -no-recursion | --no-recursion | --no-recursio | --no-recursi \+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)+    no_recursion=yes ;;++  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \+  | --oldin | --oldi | --old | --ol | --o)+    ac_prev=oldincludedir ;;+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)+    oldincludedir=$ac_optarg ;;++  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)+    ac_prev=prefix ;;+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)+    prefix=$ac_optarg ;;++  -program-prefix | --program-prefix | --program-prefi | --program-pref \+  | --program-pre | --program-pr | --program-p)+    ac_prev=program_prefix ;;+  -program-prefix=* | --program-prefix=* | --program-prefi=* \+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)+    program_prefix=$ac_optarg ;;++  -program-suffix | --program-suffix | --program-suffi | --program-suff \+  | --program-suf | --program-su | --program-s)+    ac_prev=program_suffix ;;+  -program-suffix=* | --program-suffix=* | --program-suffi=* \+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)+    program_suffix=$ac_optarg ;;++  -program-transform-name | --program-transform-name \+  | --program-transform-nam | --program-transform-na \+  | --program-transform-n | --program-transform- \+  | --program-transform | --program-transfor \+  | --program-transfo | --program-transf \+  | --program-trans | --program-tran \+  | --progr-tra | --program-tr | --program-t)+    ac_prev=program_transform_name ;;+  -program-transform-name=* | --program-transform-name=* \+  | --program-transform-nam=* | --program-transform-na=* \+  | --program-transform-n=* | --program-transform-=* \+  | --program-transform=* | --program-transfor=* \+  | --program-transfo=* | --program-transf=* \+  | --program-trans=* | --program-tran=* \+  | --progr-tra=* | --program-tr=* | --program-t=*)+    program_transform_name=$ac_optarg ;;++  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)+    ac_prev=pdfdir ;;+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)+    pdfdir=$ac_optarg ;;++  -psdir | --psdir | --psdi | --psd | --ps)+    ac_prev=psdir ;;+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)+    psdir=$ac_optarg ;;++  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil)+    silent=yes ;;++  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)+    ac_prev=sbindir ;;+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \+  | --sbi=* | --sb=*)+    sbindir=$ac_optarg ;;++  -sharedstatedir | --sharedstatedir | --sharedstatedi \+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \+  | --sharedst | --shareds | --shared | --share | --shar \+  | --sha | --sh)+    ac_prev=sharedstatedir ;;+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \+  | --sha=* | --sh=*)+    sharedstatedir=$ac_optarg ;;++  -site | --site | --sit)+    ac_prev=site ;;+  -site=* | --site=* | --sit=*)+    site=$ac_optarg ;;++  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)+    ac_prev=srcdir ;;+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)+    srcdir=$ac_optarg ;;++  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \+  | --syscon | --sysco | --sysc | --sys | --sy)+    ac_prev=sysconfdir ;;+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)+    sysconfdir=$ac_optarg ;;++  -target | --target | --targe | --targ | --tar | --ta | --t)+    ac_prev=target_alias ;;+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)+    target_alias=$ac_optarg ;;++  -v | -verbose | --verbose | --verbos | --verbo | --verb)+    verbose=yes ;;++  -version | --version | --versio | --versi | --vers | -V)+    ac_init_version=: ;;++  -with-* | --with-*)+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid package name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=\$ac_optarg ;;++  -without-* | --without-*)+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid package name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=no ;;++  --x)+    # Obsolete; use --with-x.+    with_x=yes ;;++  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \+  | --x-incl | --x-inc | --x-in | --x-i)+    ac_prev=x_includes ;;+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)+    x_includes=$ac_optarg ;;++  -x-libraries | --x-libraries | --x-librarie | --x-librari \+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)+    ac_prev=x_libraries ;;+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)+    x_libraries=$ac_optarg ;;++  -*) as_fn_error $? "unrecognized option: \`$ac_option'+Try \`$0 --help' for more information"+    ;;++  *=*)+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`+    # Reject names that are not valid shell variable names.+    case $ac_envvar in #(+      '' | [0-9]* | *[!_$as_cr_alnum]* )+      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;+    esac+    eval $ac_envvar=\$ac_optarg+    export $ac_envvar ;;++  *)+    # FIXME: should be removed in autoconf 3.0.+    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&+      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2+    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"+    ;;++  esac+done++if test -n "$ac_prev"; then+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`+  as_fn_error $? "missing argument to $ac_option"+fi++if test -n "$ac_unrecognized_opts"; then+  case $enable_option_checking in+    no) ;;+    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;+    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;+  esac+fi++# Check all directory arguments for consistency.+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \+		datadir sysconfdir sharedstatedir localstatedir includedir \+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \+		libdir localedir mandir+do+  eval ac_val=\$$ac_var+  # Remove trailing slashes.+  case $ac_val in+    */ )+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`+      eval $ac_var=\$ac_val;;+  esac+  # Be sure to have absolute directory names.+  case $ac_val in+    [\\/$]* | ?:[\\/]* )  continue;;+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;+  esac+  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"+done++# There might be people who depend on the old broken behavior: `$host'+# used to hold the argument of --host etc.+# FIXME: To remove some day.+build=$build_alias+host=$host_alias+target=$target_alias++# FIXME: To remove some day.+if test "x$host_alias" != x; then+  if test "x$build_alias" = x; then+    cross_compiling=maybe+  elif test "x$build_alias" != "x$host_alias"; then+    cross_compiling=yes+  fi+fi++ac_tool_prefix=+test -n "$host_alias" && ac_tool_prefix=$host_alias-++test "$silent" = yes && exec 6>/dev/null+++ac_pwd=`pwd` && test -n "$ac_pwd" &&+ac_ls_di=`ls -di .` &&+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||+  as_fn_error $? "working directory cannot be determined"+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||+  as_fn_error $? "pwd does not report name of working directory"+++# Find the source files, if location was not specified.+if test -z "$srcdir"; then+  ac_srcdir_defaulted=yes+  # Try the directory containing this script, then the parent directory.+  ac_confdir=`$as_dirname -- "$as_myself" ||+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_myself" : 'X\(//\)[^/]' \| \+	 X"$as_myself" : 'X\(//\)$' \| \+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_myself" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  srcdir=$ac_confdir+  if test ! -r "$srcdir/$ac_unique_file"; then+    srcdir=..+  fi+else+  ac_srcdir_defaulted=no+fi+if test ! -r "$srcdir/$ac_unique_file"; then+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."+  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"+fi+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"+ac_abs_confdir=`(+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"+	pwd)`+# When building in place, set srcdir=.+if test "$ac_abs_confdir" = "$ac_pwd"; then+  srcdir=.+fi+# Remove unnecessary trailing slashes from srcdir.+# Double slashes in file names in object file debugging info+# mess up M-x gdb in Emacs.+case $srcdir in+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;+esac+for ac_var in $ac_precious_vars; do+  eval ac_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_env_${ac_var}_value=\$${ac_var}+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_cv_env_${ac_var}_value=\$${ac_var}+done++#+# Report the --help message.+#+if test "$ac_init_help" = "long"; then+  # Omit some internal or obsolete options to make the list less imposing.+  # This message is too long to be a string in the A/UX 3.1 sh.+  cat <<_ACEOF+\`configure' configures Haskell Linear Algebra 0.8 to adapt to many kinds of systems.++Usage: $0 [OPTION]... [VAR=VALUE]...++To assign environment variables (e.g., CC, CFLAGS...), specify them as+VAR=VALUE.  See below for descriptions of some of the useful variables.++Defaults for the options are specified in brackets.++Configuration:+  -h, --help              display this help and exit+      --help=short        display options specific to this package+      --help=recursive    display the short help of all the included packages+  -V, --version           display version information and exit+  -q, --quiet, --silent   do not print \`checking ...' messages+      --cache-file=FILE   cache test results in FILE [disabled]+  -C, --config-cache      alias for \`--cache-file=config.cache'+  -n, --no-create         do not create output files+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']++Installation directories:+  --prefix=PREFIX         install architecture-independent files in PREFIX+                          [$ac_default_prefix]+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX+                          [PREFIX]++By default, \`make install' will install all the files in+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify+an installation prefix other than \`$ac_default_prefix' using \`--prefix',+for instance \`--prefix=\$HOME'.++For better control, use the options below.++Fine tuning of the installation directories:+  --bindir=DIR            user executables [EPREFIX/bin]+  --sbindir=DIR           system admin executables [EPREFIX/sbin]+  --libexecdir=DIR        program executables [EPREFIX/libexec]+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]+  --libdir=DIR            object code libraries [EPREFIX/lib]+  --includedir=DIR        C header files [PREFIX/include]+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]+  --infodir=DIR           info documentation [DATAROOTDIR/info]+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]+  --mandir=DIR            man documentation [DATAROOTDIR/man]+  --docdir=DIR            documentation root+                          [DATAROOTDIR/doc/haskell-linear-algebra]+  --htmldir=DIR           html documentation [DOCDIR]+  --dvidir=DIR            dvi documentation [DOCDIR]+  --pdfdir=DIR            pdf documentation [DOCDIR]+  --psdir=DIR             ps documentation [DOCDIR]+_ACEOF++  cat <<\_ACEOF+_ACEOF+fi++if test -n "$ac_init_help"; then+  case $ac_init_help in+     short | recursive ) echo "Configuration of Haskell Linear Algebra 0.8:";;+   esac+  cat <<\_ACEOF++Optional Packages:+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)+  --with-compiler=<cmd>   use Haskell compiler <cmd>+  --with-blas=<lib>       use BLAS library <lib>+  --with-lapack=<lib>     use LAPACK library <lib>++Some influential environment variables:+  CC          C compiler command+  CFLAGS      C compiler flags+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a+              nonstandard directory <lib dir>+  LIBS        libraries to pass to the linker, e.g. -l<library>+  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if+              you have headers in a nonstandard directory <include dir>++Use these variables to override the choices made by `configure' or to help+it to find libraries and programs with nonstandard names/locations.++Report bugs to <patperry@gmail.com>.+_ACEOF+ac_status=$?+fi++if test "$ac_init_help" = "recursive"; then+  # If there are subdirs, report their specific --help.+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue+    test -d "$ac_dir" ||+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||+      continue+    ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix++    cd "$ac_dir" || { ac_status=$?; continue; }+    # Check for guested configure.+    if test -f "$ac_srcdir/configure.gnu"; then+      echo &&+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive+    elif test -f "$ac_srcdir/configure"; then+      echo &&+      $SHELL "$ac_srcdir/configure" --help=recursive+    else+      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2+    fi || ac_status=$?+    cd "$ac_pwd" || { ac_status=$?; break; }+  done+fi++test -n "$ac_init_help" && exit $ac_status+if $ac_init_version; then+  cat <<\_ACEOF+Haskell Linear Algebra configure 0.8+generated by GNU Autoconf 2.69++Copyright (C) 2012 Free Software Foundation, Inc.+This configure script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it.+_ACEOF+  exit+fi++## ------------------------ ##+## Autoconf initialization. ##+## ------------------------ ##++# ac_fn_c_try_compile LINENO+# --------------------------+# Try to compile conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_compile ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  rm -f conftest.$ac_objext+  if { { ac_try="$ac_compile"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_compile") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    grep -v '^ *+' conftest.err >conftest.er1+    cat conftest.er1 >&5+    mv -f conftest.er1 conftest.err+  fi+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext; then :+  ac_retval=0+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_retval=1+fi+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_compile++# ac_fn_c_try_link LINENO+# -----------------------+# Try to link conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_link ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  rm -f conftest.$ac_objext conftest$ac_exeext+  if { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    grep -v '^ *+' conftest.err >conftest.er1+    cat conftest.er1 >&5+    mv -f conftest.er1 conftest.err+  fi+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 test -x conftest$ac_exeext+       }; then :+  ac_retval=0+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_retval=1+fi+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would+  # interfere with the next link command; also delete a directory that is+  # left behind by Apple's compiler.  We do this before executing the actions.+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_link++# ac_fn_c_check_func LINENO FUNC VAR+# ----------------------------------+# Tests whether FUNC exists, setting the cache variable VAR accordingly+ac_fn_c_check_func ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5+$as_echo_n "checking for $2... " >&6; }+if eval \${$3+:} false; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+/* Define $2 to an innocuous variant, in case <limits.h> declares $2.+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */+#define $2 innocuous_$2++/* System header to define __stub macros and hopefully few prototypes,+    which can conflict with char $2 (); below.+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since+    <limits.h> exists even on freestanding compilers.  */++#ifdef __STDC__+# include <limits.h>+#else+# include <assert.h>+#endif++#undef $2++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char $2 ();+/* The GNU C library defines this for functions which it implements+    to always fail with ENOSYS.  Some functions are actually named+    something starting with __ and the normal name is an alias.  */+#if defined __stub_$2 || defined __stub___$2+choke me+#endif++int+main ()+{+return $2 ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  eval "$3=yes"+else+  eval "$3=no"+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+fi+eval ac_res=\$$3+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno++} # ac_fn_c_check_func+cat >config.log <<_ACEOF+This file contains any messages produced by compilers while+running configure, to aid debugging if configure makes a mistake.++It was created by Haskell Linear Algebra $as_me 0.8, which was+generated by GNU Autoconf 2.69.  Invocation command line was++  $ $0 $@++_ACEOF+exec 5>>config.log+{+cat <<_ASUNAME+## --------- ##+## Platform. ##+## --------- ##++hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`+uname -m = `(uname -m) 2>/dev/null || echo unknown`+uname -r = `(uname -r) 2>/dev/null || echo unknown`+uname -s = `(uname -s) 2>/dev/null || echo unknown`+uname -v = `(uname -v) 2>/dev/null || echo unknown`++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`++/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`++_ASUNAME++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    $as_echo "PATH: $as_dir"+  done+IFS=$as_save_IFS++} >&5++cat >&5 <<_ACEOF+++## ----------- ##+## Core tests. ##+## ----------- ##++_ACEOF+++# Keep a trace of the command line.+# Strip out --no-create and --no-recursion so they do not pile up.+# Strip out --silent because we don't want to record it for future runs.+# Also quote any args containing shell meta-characters.+# Make two passes to allow for proper duplicate-argument suppression.+ac_configure_args=+ac_configure_args0=+ac_configure_args1=+ac_must_keep_next=false+for ac_pass in 1 2+do+  for ac_arg+  do+    case $ac_arg in+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \+    | -silent | --silent | --silen | --sile | --sil)+      continue ;;+    *\'*)+      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    case $ac_pass in+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;+    2)+      as_fn_append ac_configure_args1 " '$ac_arg'"+      if test $ac_must_keep_next = true; then+	ac_must_keep_next=false # Got value, back to normal.+      else+	case $ac_arg in+	  *=* | --config-cache | -C | -disable-* | --disable-* \+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \+	  | -with-* | --with-* | -without-* | --without-* | --x)+	    case "$ac_configure_args0 " in+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;+	    esac+	    ;;+	  -* ) ac_must_keep_next=true ;;+	esac+      fi+      as_fn_append ac_configure_args " '$ac_arg'"+      ;;+    esac+  done+done+{ ac_configure_args0=; unset ac_configure_args0;}+{ ac_configure_args1=; unset ac_configure_args1;}++# When interrupted or exit'd, cleanup temporary files, and complete+# config.log.  We remove comments because anyway the quotes in there+# would cause problems or look ugly.+# WARNING: Use '\'' to represent an apostrophe within the trap.+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.+trap 'exit_status=$?+  # Save into config.log some information that might help in debugging.+  {+    echo++    $as_echo "## ---------------- ##+## Cache variables. ##+## ---------------- ##"+    echo+    # The following way of writing the cache mishandles newlines in values,+(+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done+  (set) 2>&1 |+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      sed -n \+	"s/'\''/'\''\\\\'\'''\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"+      ;; #(+    *)+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+)+    echo++    $as_echo "## ----------------- ##+## Output variables. ##+## ----------------- ##"+    echo+    for ac_var in $ac_subst_vars+    do+      eval ac_val=\$$ac_var+      case $ac_val in+      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+      esac+      $as_echo "$ac_var='\''$ac_val'\''"+    done | sort+    echo++    if test -n "$ac_subst_files"; then+      $as_echo "## ------------------- ##+## File substitutions. ##+## ------------------- ##"+      echo+      for ac_var in $ac_subst_files+      do+	eval ac_val=\$$ac_var+	case $ac_val in+	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+	esac+	$as_echo "$ac_var='\''$ac_val'\''"+      done | sort+      echo+    fi++    if test -s confdefs.h; then+      $as_echo "## ----------- ##+## confdefs.h. ##+## ----------- ##"+      echo+      cat confdefs.h+      echo+    fi+    test "$ac_signal" != 0 &&+      $as_echo "$as_me: caught signal $ac_signal"+    $as_echo "$as_me: exit $exit_status"+  } >&5+  rm -f core *.core core.conftest.* &&+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&+    exit $exit_status+' 0+for ac_signal in 1 2 13 15; do+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal+done+ac_signal=0++# confdefs.h avoids OS command line length limits that DEFS can exceed.+rm -f -r conftest* confdefs.h++$as_echo "/* confdefs.h */" > confdefs.h++# Predefined preprocessor variables.++cat >>confdefs.h <<_ACEOF+#define PACKAGE_NAME "$PACKAGE_NAME"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_VERSION "$PACKAGE_VERSION"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_STRING "$PACKAGE_STRING"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_URL "$PACKAGE_URL"+_ACEOF+++# Let the site file select an alternate cache file if it wants to.+# Prefer an explicitly selected file to automatically selected ones.+ac_site_file1=NONE+ac_site_file2=NONE+if test -n "$CONFIG_SITE"; then+  # We do not want a PATH search for config.site.+  case $CONFIG_SITE in #((+    -*)  ac_site_file1=./$CONFIG_SITE;;+    */*) ac_site_file1=$CONFIG_SITE;;+    *)   ac_site_file1=./$CONFIG_SITE;;+  esac+elif test "x$prefix" != xNONE; then+  ac_site_file1=$prefix/share/config.site+  ac_site_file2=$prefix/etc/config.site+else+  ac_site_file1=$ac_default_prefix/share/config.site+  ac_site_file2=$ac_default_prefix/etc/config.site+fi+for ac_site_file in "$ac_site_file1" "$ac_site_file2"+do+  test "x$ac_site_file" = xNONE && continue+  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5+$as_echo "$as_me: loading site script $ac_site_file" >&6;}+    sed 's/^/| /' "$ac_site_file" >&5+    . "$ac_site_file" \+      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "failed to load site script $ac_site_file+See \`config.log' for more details" "$LINENO" 5; }+  fi+done++if test -r "$cache_file"; then+  # Some versions of bash will fail to source /dev/null (special files+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5+$as_echo "$as_me: loading cache $cache_file" >&6;}+    case $cache_file in+      [\\/]* | ?:[\\/]* ) . "$cache_file";;+      *)                      . "./$cache_file";;+    esac+  fi+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5+$as_echo "$as_me: creating cache $cache_file" >&6;}+  >$cache_file+fi++# Check that the precious variables saved in the cache have kept the same+# value.+ac_cache_corrupted=false+for ac_var in $ac_precious_vars; do+  eval ac_old_set=\$ac_cv_env_${ac_var}_set+  eval ac_new_set=\$ac_env_${ac_var}_set+  eval ac_old_val=\$ac_cv_env_${ac_var}_value+  eval ac_new_val=\$ac_env_${ac_var}_value+  case $ac_old_set,$ac_new_set in+    set,)+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,set)+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,);;+    *)+      if test "x$ac_old_val" != "x$ac_new_val"; then+	# differences in whitespace do not lead to failure.+	ac_old_val_w=`echo x $ac_old_val`+	ac_new_val_w=`echo x $ac_new_val`+	if test "$ac_old_val_w" != "$ac_new_val_w"; then+	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}+	  ac_cache_corrupted=:+	else+	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}+	  eval $ac_var=\$ac_old_val+	fi+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5+$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}+      fi;;+  esac+  # Pass precious variables to config.status.+  if test "$ac_new_set" = set; then+    case $ac_new_val in+    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;+    *) ac_arg=$ac_var=$ac_new_val ;;+    esac+    case " $ac_configure_args " in+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;+    esac+  fi+done+if $ac_cache_corrupted; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}+  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5+fi+## -------------------- ##+## Main body of script. ##+## -------------------- ##++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu++++++++# Check whether --with-compiler was given.+if test "${with_compiler+set}" = set; then :+  withval=$with_compiler;+fi+++# Checks for programs++# Checks for libraries+ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+if test -n "$ac_tool_prefix"; then+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.+set dummy ${ac_tool_prefix}gcc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}gcc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++fi+if test -z "$ac_cv_prog_CC"; then+  ac_ct_CC=$CC+  # Extract the first word of "gcc", so it can be a program name with args.+set dummy gcc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_ac_ct_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$ac_ct_CC"; then+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="gcc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+$as_echo "$ac_ct_CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+else+  CC="$ac_cv_prog_CC"+fi++if test -z "$CC"; then+          if test -n "$ac_tool_prefix"; then+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.+set dummy ${ac_tool_prefix}cc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}cc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++  fi+fi+if test -z "$CC"; then+  # Extract the first word of "cc", so it can be a program name with args.+set dummy cc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+  ac_prog_rejected=no+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then+       ac_prog_rejected=yes+       continue+     fi+    ac_cv_prog_CC="cc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++if test $ac_prog_rejected = yes; then+  # We found a bogon in the path, so make sure we never use it.+  set dummy $ac_cv_prog_CC+  shift+  if test $# != 0; then+    # We chose a different compiler from the bogus one.+    # However, it has the same basename, so the bogon will be chosen+    # first if we set CC to just the basename; use the full file name.+    shift+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"+  fi+fi+fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++fi+if test -z "$CC"; then+  if test -n "$ac_tool_prefix"; then+  for ac_prog in cl.exe+  do+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.+set dummy $ac_tool_prefix$ac_prog; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++    test -n "$CC" && break+  done+fi+if test -z "$CC"; then+  ac_ct_CC=$CC+  for ac_prog in cl.exe+do+  # Extract the first word of "$ac_prog", so it can be a program name with args.+set dummy $ac_prog; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_ac_ct_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$ac_ct_CC"; then+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="$ac_prog"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+$as_echo "$ac_ct_CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++  test -n "$ac_ct_CC" && break+done++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+fi++fi+++test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "no acceptable C compiler found in \$PATH+See \`config.log' for more details" "$LINENO" 5; }++# Provide some information about the compiler.+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5+set X $ac_compile+ac_compiler=$2+for ac_option in --version -v -V -qversion; do+  { { ac_try="$ac_compiler $ac_option >&5"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    sed '10a\+... rest of stderr output deleted ...+         10q' conftest.err >conftest.er1+    cat conftest.er1 >&5+  fi+  rm -f conftest.er1 conftest.err+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+done++cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"+# Try to create an executable without -o first, disregard a.out.+# It will help us diagnose broken compilers, and finding out an intuition+# of exeext.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5+$as_echo_n "checking whether the C compiler works... " >&6; }+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`++# The possible output files:+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"++ac_rmfiles=+for ac_file in $ac_files+do+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;+  esac+done+rm -f $ac_rmfiles++if { { ac_try="$ac_link_default"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link_default") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; then :+  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'+# in a Makefile.  We should not override ac_cv_exeext if it was cached,+# so that the user can short-circuit this test for compilers unknown to+# Autoconf.+for ac_file in $ac_files ''+do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )+	;;+    [ab].out )+	# We found the default executable, but exeext='' is most+	# certainly right.+	break;;+    *.* )+	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;+	then :; else+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	fi+	# We set ac_cv_exeext here because the later test for it is not+	# safe: cross compilers may not add the suffix if given an `-o'+	# argument, so we may need to know it at that point already.+	# Even if this section looks crufty: it has the advantage of+	# actually working.+	break;;+    * )+	break;;+  esac+done+test "$ac_cv_exeext" = no && ac_cv_exeext=++else+  ac_file=''+fi+if test -z "$ac_file"; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+$as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error 77 "C compiler cannot create executables+See \`config.log' for more details" "$LINENO" 5; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5+$as_echo "yes" >&6; }+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5+$as_echo_n "checking for C compiler default output file name... " >&6; }+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5+$as_echo "$ac_file" >&6; }+ac_exeext=$ac_cv_exeext++rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out+ac_clean_files=$ac_clean_files_save+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5+$as_echo_n "checking for suffix of executables... " >&6; }+if { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; then :+  # If both `conftest.exe' and `conftest' are `present' (well, observable)+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will+# work properly (i.e., refer to `conftest.exe'), while it won't with+# `rm'.+for ac_file in conftest.exe conftest conftest.*; do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	  break;;+    * ) break;;+  esac+done+else+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details" "$LINENO" 5; }+fi+rm -f conftest conftest$ac_cv_exeext+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5+$as_echo "$ac_cv_exeext" >&6; }++rm -f conftest.$ac_ext+EXEEXT=$ac_cv_exeext+ac_exeext=$EXEEXT+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdio.h>+int+main ()+{+FILE *f = fopen ("conftest.out", "w");+ return ferror (f) || fclose (f) != 0;++  ;+  return 0;+}+_ACEOF+ac_clean_files="$ac_clean_files conftest.out"+# Check that the compiler produces executables we can run.  If not, either+# the compiler is broken, or we cross compile.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5+$as_echo_n "checking whether we are cross compiling... " >&6; }+if test "$cross_compiling" != yes; then+  { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+  if { ac_try='./conftest$ac_cv_exeext'+  { { case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_try") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; }; then+    cross_compiling=no+  else+    if test "$cross_compiling" = maybe; then+	cross_compiling=yes+    else+	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "cannot run C compiled programs.+If you meant to cross compile, use \`--host'.+See \`config.log' for more details" "$LINENO" 5; }+    fi+  fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5+$as_echo "$cross_compiling" >&6; }++rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out+ac_clean_files=$ac_clean_files_save+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5+$as_echo_n "checking for suffix of object files... " >&6; }+if ${ac_cv_objext+:} false; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+rm -f conftest.o conftest.obj+if { { ac_try="$ac_compile"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_compile") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; then :+  for ac_file in conftest.o conftest.obj conftest.*; do+  test -f "$ac_file" || continue;+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`+       break;;+  esac+done+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "cannot compute suffix of object files: cannot compile+See \`config.log' for more details" "$LINENO" 5; }+fi+rm -f conftest.$ac_cv_objext conftest.$ac_ext+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5+$as_echo "$ac_cv_objext" >&6; }+OBJEXT=$ac_cv_objext+ac_objext=$OBJEXT+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }+if ${ac_cv_c_compiler_gnu+:} false; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{+#ifndef __GNUC__+       choke me+#endif++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_compiler_gnu=yes+else+  ac_compiler_gnu=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+ac_cv_c_compiler_gnu=$ac_compiler_gnu++fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5+$as_echo "$ac_cv_c_compiler_gnu" >&6; }+if test $ac_compiler_gnu = yes; then+  GCC=yes+else+  GCC=+fi+ac_test_CFLAGS=${CFLAGS+set}+ac_save_CFLAGS=$CFLAGS+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5+$as_echo_n "checking whether $CC accepts -g... " >&6; }+if ${ac_cv_prog_cc_g+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_save_c_werror_flag=$ac_c_werror_flag+   ac_c_werror_flag=yes+   ac_cv_prog_cc_g=no+   CFLAGS="-g"+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_prog_cc_g=yes+else+  CFLAGS=""+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :++else+  ac_c_werror_flag=$ac_save_c_werror_flag+	 CFLAGS="-g"+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_prog_cc_g=yes+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+   ac_c_werror_flag=$ac_save_c_werror_flag+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5+$as_echo "$ac_cv_prog_cc_g" >&6; }+if test "$ac_test_CFLAGS" = set; then+  CFLAGS=$ac_save_CFLAGS+elif test $ac_cv_prog_cc_g = yes; then+  if test "$GCC" = yes; then+    CFLAGS="-g -O2"+  else+    CFLAGS="-g"+  fi+else+  if test "$GCC" = yes; then+    CFLAGS="-O2"+  else+    CFLAGS=+  fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }+if ${ac_cv_prog_cc_c89+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_cv_prog_cc_c89=no+ac_save_CC=$CC+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdarg.h>+#include <stdio.h>+struct stat;+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */+struct buf { int x; };+FILE * (*rcsopen) (struct buf *, struct stat *, int);+static char *e (p, i)+     char **p;+     int i;+{+  return p[i];+}+static char *f (char * (*g) (char **, int), char **p, ...)+{+  char *s;+  va_list v;+  va_start (v,p);+  s = g (p, va_arg (v,int));+  va_end (v);+  return s;+}++/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has+   function prototypes and stuff, but not '\xHH' hex character constants.+   These don't provoke an error unfortunately, instead are silently treated+   as 'x'.  The following induces an error, until -std is added to get+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an+   array size at least.  It's necessary to write '\x00'==0 to get something+   that's true only with -std.  */+int osf4_cc_array ['\x00' == 0 ? 1 : -1];++/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters+   inside strings and character constants.  */+#define FOO(x) 'x'+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];++int test (int i, double x);+struct s1 {int (*f) (int a);};+struct s2 {int (*f) (double a);};+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);+int argc;+char **argv;+int+main ()+{+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];+  ;+  return 0;+}+_ACEOF+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"+do+  CC="$ac_save_CC $ac_arg"+  if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_prog_cc_c89=$ac_arg+fi+rm -f core conftest.err conftest.$ac_objext+  test "x$ac_cv_prog_cc_c89" != "xno" && break+done+rm -f conftest.$ac_ext+CC=$ac_save_CC++fi+# AC_CACHE_VAL+case "x$ac_cv_prog_cc_c89" in+  x)+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5+$as_echo "none needed" >&6; } ;;+  xno)+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5+$as_echo "unsupported" >&6; } ;;+  *)+    CC="$CC $ac_cv_prog_cc_c89"+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;+esac+if test "x$ac_cv_prog_cc_c89" != xno; then :++fi++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cos in -lm" >&5+$as_echo_n "checking for cos in -lm... " >&6; }+if ${ac_cv_lib_m_cos+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lm  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char cos ();+int+main ()+{+return cos ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_m_cos=yes+else+  ac_cv_lib_m_cos=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cos" >&5+$as_echo "$ac_cv_lib_m_cos" >&6; }+if test "x$ac_cv_lib_m_cos" = xyes; then :+  cat >>confdefs.h <<_ACEOF+#define HAVE_LIBM 1+_ACEOF++  LIBS="-lm $LIBS"++fi++++ax_blas_ok=no+++# Check whether --with-blas was given.+if test "${with_blas+set}" = set; then :+  withval=$with_blas;+fi++case $with_blas in+	yes | "") ;;+	no) ax_blas_ok=disable ;;+	-* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$with_blas" ;;+	*) BLAS_LIBS="-l$with_blas" ;;+esac++++++++ax_blas_save_LIBS="$LIBS"+LIBS="$LIBS $FLIBS"++# First, check BLAS_LIBS environment variable+if test x$ax_blas_ok = xno; then+  if test x$BLAS_LIBS != x; then+    save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in $BLAS_LIBS" >&5+$as_echo_n "checking for sgemm_ in $BLAS_LIBS... " >&6; }+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ax_blas_ok=yes+else+  BLAS_LIBS=""+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_blas_ok" >&5+$as_echo "$ax_blas_ok" >&6; }+    LIBS="$save_LIBS"+  fi+fi++# BLAS linked to by default?  (happens on some supercomputers)+if test x$ax_blas_ok = xno; then+  save_LIBS="$LIBS"; LIBS="$LIBS"+  ac_fn_c_check_func "$LINENO" "sgemm_" "ac_cv_func_sgemm_"+if test "x$ac_cv_func_sgemm_" = xyes; then :+  ax_blas_ok=yes+fi++  LIBS="$save_LIBS"+fi++# BLAS in ATLAS library? (http://math-atlas.sourceforge.net/)+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ATL_xerbla in -latlas" >&5+$as_echo_n "checking for ATL_xerbla in -latlas... " >&6; }+if ${ac_cv_lib_atlas_ATL_xerbla+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-latlas  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char ATL_xerbla ();+int+main ()+{+return ATL_xerbla ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_atlas_ATL_xerbla=yes+else+  ac_cv_lib_atlas_ATL_xerbla=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_atlas_ATL_xerbla" >&5+$as_echo "$ac_cv_lib_atlas_ATL_xerbla" >&6; }+if test "x$ac_cv_lib_atlas_ATL_xerbla" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lf77blas" >&5+$as_echo_n "checking for sgemm_ in -lf77blas... " >&6; }+if ${ac_cv_lib_f77blas_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lf77blas -latlas $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_f77blas_sgemm_=yes+else+  ac_cv_lib_f77blas_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_f77blas_sgemm_" >&5+$as_echo "$ac_cv_lib_f77blas_sgemm_" >&6; }+if test "x$ac_cv_lib_f77blas_sgemm_" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cblas_dgemm in -lcblas" >&5+$as_echo_n "checking for cblas_dgemm in -lcblas... " >&6; }+if ${ac_cv_lib_cblas_cblas_dgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcblas -lf77blas -latlas $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char cblas_dgemm ();+int+main ()+{+return cblas_dgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_cblas_cblas_dgemm=yes+else+  ac_cv_lib_cblas_cblas_dgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_cblas_cblas_dgemm" >&5+$as_echo "$ac_cv_lib_cblas_cblas_dgemm" >&6; }+if test "x$ac_cv_lib_cblas_cblas_dgemm" = xyes; then :+  ax_blas_ok=yes+           BLAS_LIBS="-lcblas -lf77blas -latlas"+fi++fi++fi++fi++# BLAS in Intel MKL library?+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lmkl" >&5+$as_echo_n "checking for sgemm_ in -lmkl... " >&6; }+if ${ac_cv_lib_mkl_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lmkl  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_mkl_sgemm_=yes+else+  ac_cv_lib_mkl_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mkl_sgemm_" >&5+$as_echo "$ac_cv_lib_mkl_sgemm_" >&6; }+if test "x$ac_cv_lib_mkl_sgemm_" = xyes; then :+  ax_blas_ok=yes;BLAS_LIBS="-lmkl"+fi++fi++# BLAS in Apple vecLib library?+if test x$ax_blas_ok = xno; then+  save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"+  unset ac_cv_func_sgemm_+  ac_fn_c_check_func "$LINENO" "sgemm_" "ac_cv_func_sgemm_"+if test "x$ac_cv_func_sgemm_" = xyes; then :+  ax_blas_ok=yes;BLAS_LIBS="-lblas"+fi++  LIBS="$save_LIBS"+fi++# BLAS in PhiPACK libraries? (requires generic BLAS lib, too)+if test $ax_blas_ok = no; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lblas" >&5+$as_echo_n "checking for sgemm_ in -lblas... " >&6; }+if ${ac_cv_lib_blas_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_blas_sgemm_=yes+else+  ac_cv_lib_blas_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_blas_sgemm_" >&5+$as_echo "$ac_cv_lib_blas_sgemm_" >&6; }+if test "x$ac_cv_lib_blas_sgemm_" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dgemm_ in -ldgemm" >&5+$as_echo_n "checking for dgemm_ in -ldgemm... " >&6; }+if ${ac_cv_lib_dgemm_dgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-ldgemm -lblas $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char dgemm_ ();+int+main ()+{+return dgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_dgemm_dgemm_=yes+else+  ac_cv_lib_dgemm_dgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dgemm_dgemm_" >&5+$as_echo "$ac_cv_lib_dgemm_dgemm_" >&6; }+if test "x$ac_cv_lib_dgemm_dgemm_" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lsgemm" >&5+$as_echo_n "checking for sgemm_ in -lsgemm... " >&6; }+if ${ac_cv_lib_sgemm_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsgemm -lblas $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_sgemm_sgemm_=yes+else+  ac_cv_lib_sgemm_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sgemm_sgemm_" >&5+$as_echo "$ac_cv_lib_sgemm_sgemm_" >&6; }+if test "x$ac_cv_lib_sgemm_sgemm_" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lsgemm -ldgemm -lblas"+fi++fi++fi++fi++# BLAS in Alpha CXML library?+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lcxml" >&5+$as_echo_n "checking for sgemm_ in -lcxml... " >&6; }+if ${ac_cv_lib_cxml_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcxml  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_cxml_sgemm_=yes+else+  ac_cv_lib_cxml_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_cxml_sgemm_" >&5+$as_echo "$ac_cv_lib_cxml_sgemm_" >&6; }+if test "x$ac_cv_lib_cxml_sgemm_" = xyes; then :+  ax_blas_ok=yes;BLAS_LIBS="-lcxml"+fi++fi++# BLAS in Alpha DXML library? (now called CXML, see above)+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -ldxml" >&5+$as_echo_n "checking for sgemm_ in -ldxml... " >&6; }+if ${ac_cv_lib_dxml_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-ldxml  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_dxml_sgemm_=yes+else+  ac_cv_lib_dxml_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dxml_sgemm_" >&5+$as_echo "$ac_cv_lib_dxml_sgemm_" >&6; }+if test "x$ac_cv_lib_dxml_sgemm_" = xyes; then :+  ax_blas_ok=yes;BLAS_LIBS="-ldxml"+fi++fi++# BLAS in Sun Performance library?+if test x$ax_blas_ok = xno; then+  if test "x$GCC" != xyes; then # only works with Sun CC+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for acosp in -lsunmath" >&5+$as_echo_n "checking for acosp in -lsunmath... " >&6; }+if ${ac_cv_lib_sunmath_acosp+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsunmath  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char acosp ();+int+main ()+{+return acosp ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_sunmath_acosp=yes+else+  ac_cv_lib_sunmath_acosp=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sunmath_acosp" >&5+$as_echo "$ac_cv_lib_sunmath_acosp" >&6; }+if test "x$ac_cv_lib_sunmath_acosp" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lsunperf" >&5+$as_echo_n "checking for sgemm_ in -lsunperf... " >&6; }+if ${ac_cv_lib_sunperf_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsunperf -lsunmath $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_sunperf_sgemm_=yes+else+  ac_cv_lib_sunperf_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sunperf_sgemm_" >&5+$as_echo "$ac_cv_lib_sunperf_sgemm_" >&6; }+if test "x$ac_cv_lib_sunperf_sgemm_" = xyes; then :+  BLAS_LIBS="-xlic_lib=sunperf -lsunmath"+       ax_blas_ok=yes+fi++fi++  fi+fi++# BLAS in SCSL library?  (SGI/Cray Scientific Library)+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lscs" >&5+$as_echo_n "checking for sgemm_ in -lscs... " >&6; }+if ${ac_cv_lib_scs_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lscs  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_scs_sgemm_=yes+else+  ac_cv_lib_scs_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_scs_sgemm_" >&5+$as_echo "$ac_cv_lib_scs_sgemm_" >&6; }+if test "x$ac_cv_lib_scs_sgemm_" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lscs"+fi++fi++# BLAS in SGIMATH library?+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lcomplib.sgimath" >&5+$as_echo_n "checking for sgemm_ in -lcomplib.sgimath... " >&6; }+if ${ac_cv_lib_complib_sgimath_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcomplib.sgimath  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_complib_sgimath_sgemm_=yes+else+  ac_cv_lib_complib_sgimath_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_complib_sgimath_sgemm_" >&5+$as_echo "$ac_cv_lib_complib_sgimath_sgemm_" >&6; }+if test "x$ac_cv_lib_complib_sgimath_sgemm_" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"+fi++fi++# BLAS in IBM ESSL library? (requires generic BLAS lib, too)+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lblas" >&5+$as_echo_n "checking for sgemm_ in -lblas... " >&6; }+if ${ac_cv_lib_blas_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_blas_sgemm_=yes+else+  ac_cv_lib_blas_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_blas_sgemm_" >&5+$as_echo "$ac_cv_lib_blas_sgemm_" >&6; }+if test "x$ac_cv_lib_blas_sgemm_" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lessl" >&5+$as_echo_n "checking for sgemm_ in -lessl... " >&6; }+if ${ac_cv_lib_essl_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lessl -lblas $FLIBS $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_essl_sgemm_=yes+else+  ac_cv_lib_essl_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_essl_sgemm_" >&5+$as_echo "$ac_cv_lib_essl_sgemm_" >&6; }+if test "x$ac_cv_lib_essl_sgemm_" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lessl -lblas"+fi++fi++fi++# Generic BLAS library?+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm_ in -lblas" >&5+$as_echo_n "checking for sgemm_ in -lblas... " >&6; }+if ${ac_cv_lib_blas_sgemm_+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm_ ();+int+main ()+{+return sgemm_ ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_blas_sgemm_=yes+else+  ac_cv_lib_blas_sgemm_=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_blas_sgemm_" >&5+$as_echo "$ac_cv_lib_blas_sgemm_" >&6; }+if test "x$ac_cv_lib_blas_sgemm_" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lblas"+fi++fi++LIBS="$ax_blas_save_LIBS"++++++if test x$ax_blas_ok = xyes; then+  ax_blas_underscore=yes+else+++++++ax_blas_save_LIBS="$LIBS"+LIBS="$LIBS $FLIBS"++# First, check BLAS_LIBS environment variable+if test x$ax_blas_ok = xno; then+  if test x$BLAS_LIBS != x; then+    save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in $BLAS_LIBS" >&5+$as_echo_n "checking for sgemm in $BLAS_LIBS... " >&6; }+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ax_blas_ok=yes+else+  BLAS_LIBS=""+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_blas_ok" >&5+$as_echo "$ax_blas_ok" >&6; }+    LIBS="$save_LIBS"+  fi+fi++# BLAS linked to by default?  (happens on some supercomputers)+if test x$ax_blas_ok = xno; then+  save_LIBS="$LIBS"; LIBS="$LIBS"+  ac_fn_c_check_func "$LINENO" "sgemm" "ac_cv_func_sgemm"+if test "x$ac_cv_func_sgemm" = xyes; then :+  ax_blas_ok=yes+fi++  LIBS="$save_LIBS"+fi++# BLAS in ATLAS library? (http://math-atlas.sourceforge.net/)+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ATL_xerbla in -latlas" >&5+$as_echo_n "checking for ATL_xerbla in -latlas... " >&6; }+if ${ac_cv_lib_atlas_ATL_xerbla+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-latlas  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char ATL_xerbla ();+int+main ()+{+return ATL_xerbla ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_atlas_ATL_xerbla=yes+else+  ac_cv_lib_atlas_ATL_xerbla=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_atlas_ATL_xerbla" >&5+$as_echo "$ac_cv_lib_atlas_ATL_xerbla" >&6; }+if test "x$ac_cv_lib_atlas_ATL_xerbla" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lf77blas" >&5+$as_echo_n "checking for sgemm in -lf77blas... " >&6; }+if ${ac_cv_lib_f77blas_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lf77blas -latlas $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_f77blas_sgemm=yes+else+  ac_cv_lib_f77blas_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_f77blas_sgemm" >&5+$as_echo "$ac_cv_lib_f77blas_sgemm" >&6; }+if test "x$ac_cv_lib_f77blas_sgemm" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cblas_dgemm in -lcblas" >&5+$as_echo_n "checking for cblas_dgemm in -lcblas... " >&6; }+if ${ac_cv_lib_cblas_cblas_dgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcblas -lf77blas -latlas $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char cblas_dgemm ();+int+main ()+{+return cblas_dgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_cblas_cblas_dgemm=yes+else+  ac_cv_lib_cblas_cblas_dgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_cblas_cblas_dgemm" >&5+$as_echo "$ac_cv_lib_cblas_cblas_dgemm" >&6; }+if test "x$ac_cv_lib_cblas_cblas_dgemm" = xyes; then :+  ax_blas_ok=yes+           BLAS_LIBS="-lcblas -lf77blas -latlas"+fi++fi++fi++fi++# BLAS in Intel MKL library?+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lmkl" >&5+$as_echo_n "checking for sgemm in -lmkl... " >&6; }+if ${ac_cv_lib_mkl_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lmkl  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_mkl_sgemm=yes+else+  ac_cv_lib_mkl_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mkl_sgemm" >&5+$as_echo "$ac_cv_lib_mkl_sgemm" >&6; }+if test "x$ac_cv_lib_mkl_sgemm" = xyes; then :+  ax_blas_ok=yes;BLAS_LIBS="-lmkl"+fi++fi++# BLAS in Apple vecLib library?+if test x$ax_blas_ok = xno; then+  save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"+  unset ac_cv_func_sgemm+  ac_fn_c_check_func "$LINENO" "sgemm" "ac_cv_func_sgemm"+if test "x$ac_cv_func_sgemm" = xyes; then :+  ax_blas_ok=yes;BLAS_LIBS="-lblas"+fi++  LIBS="$save_LIBS"+fi++# BLAS in PhiPACK libraries? (requires generic BLAS lib, too)+if test $ax_blas_ok = no; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lblas" >&5+$as_echo_n "checking for sgemm in -lblas... " >&6; }+if ${ac_cv_lib_blas_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_blas_sgemm=yes+else+  ac_cv_lib_blas_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_blas_sgemm" >&5+$as_echo "$ac_cv_lib_blas_sgemm" >&6; }+if test "x$ac_cv_lib_blas_sgemm" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dgemm in -ldgemm" >&5+$as_echo_n "checking for dgemm in -ldgemm... " >&6; }+if ${ac_cv_lib_dgemm_dgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-ldgemm -lblas $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char dgemm ();+int+main ()+{+return dgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_dgemm_dgemm=yes+else+  ac_cv_lib_dgemm_dgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dgemm_dgemm" >&5+$as_echo "$ac_cv_lib_dgemm_dgemm" >&6; }+if test "x$ac_cv_lib_dgemm_dgemm" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lsgemm" >&5+$as_echo_n "checking for sgemm in -lsgemm... " >&6; }+if ${ac_cv_lib_sgemm_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsgemm -lblas $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_sgemm_sgemm=yes+else+  ac_cv_lib_sgemm_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sgemm_sgemm" >&5+$as_echo "$ac_cv_lib_sgemm_sgemm" >&6; }+if test "x$ac_cv_lib_sgemm_sgemm" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lsgemm -ldgemm -lblas"+fi++fi++fi++fi++# BLAS in Alpha CXML library?+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lcxml" >&5+$as_echo_n "checking for sgemm in -lcxml... " >&6; }+if ${ac_cv_lib_cxml_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcxml  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_cxml_sgemm=yes+else+  ac_cv_lib_cxml_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_cxml_sgemm" >&5+$as_echo "$ac_cv_lib_cxml_sgemm" >&6; }+if test "x$ac_cv_lib_cxml_sgemm" = xyes; then :+  ax_blas_ok=yes;BLAS_LIBS="-lcxml"+fi++fi++# BLAS in Alpha DXML library? (now called CXML, see above)+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -ldxml" >&5+$as_echo_n "checking for sgemm in -ldxml... " >&6; }+if ${ac_cv_lib_dxml_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-ldxml  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_dxml_sgemm=yes+else+  ac_cv_lib_dxml_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dxml_sgemm" >&5+$as_echo "$ac_cv_lib_dxml_sgemm" >&6; }+if test "x$ac_cv_lib_dxml_sgemm" = xyes; then :+  ax_blas_ok=yes;BLAS_LIBS="-ldxml"+fi++fi++# BLAS in Sun Performance library?+if test x$ax_blas_ok = xno; then+  if test "x$GCC" != xyes; then # only works with Sun CC+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for acosp in -lsunmath" >&5+$as_echo_n "checking for acosp in -lsunmath... " >&6; }+if ${ac_cv_lib_sunmath_acosp+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsunmath  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char acosp ();+int+main ()+{+return acosp ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_sunmath_acosp=yes+else+  ac_cv_lib_sunmath_acosp=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sunmath_acosp" >&5+$as_echo "$ac_cv_lib_sunmath_acosp" >&6; }+if test "x$ac_cv_lib_sunmath_acosp" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lsunperf" >&5+$as_echo_n "checking for sgemm in -lsunperf... " >&6; }+if ${ac_cv_lib_sunperf_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsunperf -lsunmath $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_sunperf_sgemm=yes+else+  ac_cv_lib_sunperf_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sunperf_sgemm" >&5+$as_echo "$ac_cv_lib_sunperf_sgemm" >&6; }+if test "x$ac_cv_lib_sunperf_sgemm" = xyes; then :+  BLAS_LIBS="-xlic_lib=sunperf -lsunmath"+       ax_blas_ok=yes+fi++fi++  fi+fi++# BLAS in SCSL library?  (SGI/Cray Scientific Library)+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lscs" >&5+$as_echo_n "checking for sgemm in -lscs... " >&6; }+if ${ac_cv_lib_scs_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lscs  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_scs_sgemm=yes+else+  ac_cv_lib_scs_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_scs_sgemm" >&5+$as_echo "$ac_cv_lib_scs_sgemm" >&6; }+if test "x$ac_cv_lib_scs_sgemm" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lscs"+fi++fi++# BLAS in SGIMATH library?+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lcomplib.sgimath" >&5+$as_echo_n "checking for sgemm in -lcomplib.sgimath... " >&6; }+if ${ac_cv_lib_complib_sgimath_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcomplib.sgimath  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_complib_sgimath_sgemm=yes+else+  ac_cv_lib_complib_sgimath_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_complib_sgimath_sgemm" >&5+$as_echo "$ac_cv_lib_complib_sgimath_sgemm" >&6; }+if test "x$ac_cv_lib_complib_sgimath_sgemm" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"+fi++fi++# BLAS in IBM ESSL library? (requires generic BLAS lib, too)+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lblas" >&5+$as_echo_n "checking for sgemm in -lblas... " >&6; }+if ${ac_cv_lib_blas_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_blas_sgemm=yes+else+  ac_cv_lib_blas_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_blas_sgemm" >&5+$as_echo "$ac_cv_lib_blas_sgemm" >&6; }+if test "x$ac_cv_lib_blas_sgemm" = xyes; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lessl" >&5+$as_echo_n "checking for sgemm in -lessl... " >&6; }+if ${ac_cv_lib_essl_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lessl -lblas $FLIBS $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_essl_sgemm=yes+else+  ac_cv_lib_essl_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_essl_sgemm" >&5+$as_echo "$ac_cv_lib_essl_sgemm" >&6; }+if test "x$ac_cv_lib_essl_sgemm" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lessl -lblas"+fi++fi++fi++# Generic BLAS library?+if test x$ax_blas_ok = xno; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sgemm in -lblas" >&5+$as_echo_n "checking for sgemm in -lblas... " >&6; }+if ${ac_cv_lib_blas_sgemm+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char sgemm ();+int+main ()+{+return sgemm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_blas_sgemm=yes+else+  ac_cv_lib_blas_sgemm=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_blas_sgemm" >&5+$as_echo "$ac_cv_lib_blas_sgemm" >&6; }+if test "x$ac_cv_lib_blas_sgemm" = xyes; then :+  ax_blas_ok=yes; BLAS_LIBS="-lblas"+fi++fi++LIBS="$ax_blas_save_LIBS"++++++  if test x$ax_blas_ok = xyes; then+    ax_blas_undersore=no+  fi+fi+++if test x$ax_blas_ok = xyes; then+++$as_echo "#define HAVE_BLAS 1" >>confdefs.h+++    if test x$ax_blas_underscore = xyes; then+      $as_echo "#define F77_FUNC(name) name ## _" >>confdefs.h++    else+      $as_echo "#define F77_FUNC(name) name" >>confdefs.h++    fi+  :+else+  ax_blas_ok=no++fi+++++ax_lapack_ok=no+++# Check whether --with-lapack was given.+if test "${with_lapack+set}" = set; then :+  withval=$with_lapack;+fi++case $with_lapack in+        yes | "") ;;+        no) ax_lapack_ok=disable ;;+        -* | */* | *.a | *.so | *.so.* | *.o) LAPACK_LIBS="$with_lapack" ;;+        *) LAPACK_LIBS="-l$with_lapack" ;;+esac++# Get fortran linker name of LAPACK function to check for.+if test x"$ax_blas_underscore" = xyes; then+    cheev=cheev_+else+    cheev=cheev+fi++# We cannot use LAPACK if BLAS is not found+if test "x$ax_blas_ok" != xyes; then+        ax_lapack_ok=noblas+        LAPACK_LIBS=""+fi++# First, check LAPACK_LIBS environment variable+if test "x$LAPACK_LIBS" != x; then+        save_LIBS="$LIBS"; LIBS="$LAPACK_LIBS $BLAS_LIBS $LIBS"+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $cheev in $LAPACK_LIBS" >&5+$as_echo_n "checking for $cheev in $LAPACK_LIBS... " >&6; }+        cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char $cheev ();+int+main ()+{+return $cheev ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ax_lapack_ok=yes+else+  LAPACK_LIBS=""+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_lapack_ok" >&5+$as_echo "$ax_lapack_ok" >&6; }+        LIBS="$save_LIBS"+        if test $ax_lapack_ok = no; then+                LAPACK_LIBS=""+        fi+fi++# LAPACK linked to by default?  (is sometimes included in BLAS lib)+if test $ax_lapack_ok = no; then+        save_LIBS="$LIBS"; LIBS="$LIBS $BLAS_LIBS"+        as_ac_var=`$as_echo "ac_cv_func_$cheev" | $as_tr_sh`+ac_fn_c_check_func "$LINENO" "$cheev" "$as_ac_var"+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :+  ax_lapack_ok=yes+fi++        LIBS="$save_LIBS"+fi++# Generic LAPACK library?+for lapack in lapack lapack_rs6k; do+        if test $ax_lapack_ok = no; then+                save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"+                as_ac_Lib=`$as_echo "ac_cv_lib_$lapack''_$cheev" | $as_tr_sh`+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $cheev in -l$lapack" >&5+$as_echo_n "checking for $cheev in -l$lapack... " >&6; }+if eval \${$as_ac_Lib+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-l$lapack  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char $cheev ();+int+main ()+{+return $cheev ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  eval "$as_ac_Lib=yes"+else+  eval "$as_ac_Lib=no"+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+eval ac_res=\$$as_ac_Lib+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :+  ax_lapack_ok=yes; LAPACK_LIBS="-l$lapack"+fi++                LIBS="$save_LIBS"+        fi+done++++# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:+if test x"$ax_lapack_ok" = xyes; then++$as_echo "#define HAVE_LAPACK 1" >>confdefs.h++        :+else+        ax_lapack_ok=no++fi+++if test "$ax_lapack_ok" = yes; then+  BUILD_PACKAGE_BOOL=True+else+  BUILD_PACKAGE_BOOL=False+fi+++ac_config_headers="$ac_config_headers cbits/config.h"++ac_config_files="$ac_config_files linear-algebra.buildinfo"++cat >confcache <<\_ACEOF+# This file is a shell script that caches the results of configure+# tests run on this system so they can be shared between configure+# scripts and configure runs, see configure's option --config-cache.+# It is not useful on other systems.  If it contains results you don't+# want to keep, you may remove or edit it.+#+# config.status only pays attention to the cache file if you give it+# the --recheck option to rerun configure.+#+# `ac_cv_env_foo' variables (set or unset) will be overridden when+# loading this file, other *unset* `ac_cv_foo' will be assigned the+# following values.++_ACEOF++# The following way of writing the cache mishandles newlines in values,+# but we know of no workaround that is simple, portable, and efficient.+# So, we kill variables containing newlines.+# Ultrix sh set writes to stderr and can't be redirected directly,+# and sets the high bit in the cache file unless we assign to the vars.+(+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done++  (set) 2>&1 |+    case $as_nl`(ac_space=' '; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      # `set' does not quote correctly, so add quotes: double-quote+      # substitution turns \\\\ into \\, and sed turns \\ into \.+      sed -n \+	"s/'/'\\\\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"+      ;; #(+    *)+      # `set' quotes correctly as required by POSIX, so do not add quotes.+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+) |+  sed '+     /^ac_cv_env_/b end+     t clear+     :clear+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/+     t end+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/+     :end' >>confcache+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else+  if test -w "$cache_file"; then+    if test "x$cache_file" != "x/dev/null"; then+      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5+$as_echo "$as_me: updating cache $cache_file" >&6;}+      if test ! -f "$cache_file" || test -h "$cache_file"; then+	cat confcache >"$cache_file"+      else+        case $cache_file in #(+        */* | ?:*)+	  mv -f confcache "$cache_file"$$ &&+	  mv -f "$cache_file"$$ "$cache_file" ;; #(+        *)+	  mv -f confcache "$cache_file" ;;+	esac+      fi+    fi+  else+    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}+  fi+fi+rm -f confcache++test "x$prefix" = xNONE && prefix=$ac_default_prefix+# Let make expand exec_prefix.+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'++DEFS=-DHAVE_CONFIG_H++ac_libobjs=+ac_ltlibobjs=+U=+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue+  # 1. Remove the extension, and $U if already installed.+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'+  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR+  #    will be set to the directory where LIBOBJS objects are built.+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'+done+LIBOBJS=$ac_libobjs++LTLIBOBJS=$ac_ltlibobjs++++: "${CONFIG_STATUS=./config.status}"+ac_write_fail=0+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files $CONFIG_STATUS"+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}+as_write_fail=0+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1+#! $SHELL+# Generated by $as_me.+# Run this file to recreate the current configuration.+# Compiler output produced by configure, useful for debugging+# configure, is in config.log if it exists.++debug=false+ac_cs_recheck=false+ac_cs_silent=false++SHELL=\${CONFIG_SHELL-$SHELL}+export SHELL+_ASEOF+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+  setopt NO_GLOB_SUBST+else+  case `(set -o) 2>/dev/null` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+++as_nl='+'+export as_nl+# Printing a long string crashes Solaris 7 /usr/bin/printf.+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo+# Prefer a ksh shell builtin over an external printf program on Solaris,+# but without wasting forks for bash or zsh.+if test -z "$BASH_VERSION$ZSH_VERSION" \+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='print -r --'+  as_echo_n='print -rn --'+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='printf %s\n'+  as_echo_n='printf %s'+else+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'+    as_echo_n='/usr/ucb/echo -n'+  else+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'+    as_echo_n_body='eval+      arg=$1;+      case $arg in #(+      *"$as_nl"*)+	expr "X$arg" : "X\\(.*\\)$as_nl";+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;+      esac;+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"+    '+    export as_echo_n_body+    as_echo_n='sh -c $as_echo_n_body as_echo'+  fi+  export as_echo_body+  as_echo='sh -c $as_echo_body as_echo'+fi++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# IFS+# We need space, tab and new line, in precisely that order.  Quoting is+# there to prevent editors from complaining about space-tab.+# (If _AS_PATH_WALK were called with IFS unset, it would disable word+# splitting by setting IFS to empty value.)+IFS=" ""	$as_nl"++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# We did not find ourselves, most probably we were run as `sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+  as_myself=$0+fi+if test ! -f "$as_myself"; then+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi++# Unset variables that we do not need and which cause bugs (e.g. in+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"+# suppresses any "Segmentation fault" message there.  '((' could+# trigger a bug in pdksh 5.2.14.+for as_var in BASH_ENV ENV MAIL MAILPATH+do eval test x\${$as_var+set} = xset \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# CDPATH.+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH+++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  $as_echo "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error+++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else+  as_fn_append ()+  {+    eval $1=\$$1\$2+  }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else+  as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  }+fi # as_fn_arith+++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+  rm -f conf$$.dir/conf$$.file+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  if ln -s conf$$.file conf$$ 2>/dev/null; then+    as_ln_s='ln -s'+    # ... but there are two gotchas:+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.+    # In both cases, we have to default to `cp -pR'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -pR'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -pR'+  fi+else+  as_ln_s='cp -pR'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null+++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p+if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi+++# as_fn_executable_p FILE+# -----------------------+# Test if FILE is an executable regular file.+as_fn_executable_p ()+{+  test -f "$1" && test -x "$1"+} # as_fn_executable_p+as_test_x='test -x'+as_executable_p=as_fn_executable_p++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++exec 6>&1+## ----------------------------------- ##+## Main body of $CONFIG_STATUS script. ##+## ----------------------------------- ##+_ASEOF+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# Save the log message, to keep $0 and so on meaningful, and to+# report actual input values of CONFIG_FILES etc. instead of their+# values after options handling.+ac_log="+This file was extended by Haskell Linear Algebra $as_me 0.8, which was+generated by GNU Autoconf 2.69.  Invocation command line was++  CONFIG_FILES    = $CONFIG_FILES+  CONFIG_HEADERS  = $CONFIG_HEADERS+  CONFIG_LINKS    = $CONFIG_LINKS+  CONFIG_COMMANDS = $CONFIG_COMMANDS+  $ $0 $@++on `(hostname || uname -n) 2>/dev/null | sed 1q`+"++_ACEOF++case $ac_config_files in *"+"*) set x $ac_config_files; shift; ac_config_files=$*;;+esac++case $ac_config_headers in *"+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;+esac+++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+# Files that config.status was made for.+config_files="$ac_config_files"+config_headers="$ac_config_headers"++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+ac_cs_usage="\+\`$as_me' instantiates files and other configuration actions+from templates according to the current configuration.  Unless the files+and actions are specified as TAGs, all are instantiated by default.++Usage: $0 [OPTION]... [TAG]...++  -h, --help       print this help, then exit+  -V, --version    print version number and configuration settings, then exit+      --config     print configuration, then exit+  -q, --quiet, --silent+                   do not print progress messages+  -d, --debug      don't remove temporary files+      --recheck    update $as_me by reconfiguring in the same conditions+      --file=FILE[:TEMPLATE]+                   instantiate the configuration file FILE+      --header=FILE[:TEMPLATE]+                   instantiate the configuration header FILE++Configuration files:+$config_files++Configuration headers:+$config_headers++Report bugs to <patperry@gmail.com>."++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"+ac_cs_version="\\+Haskell Linear Algebra config.status 0.8+configured by $0, generated by GNU Autoconf 2.69,+  with options \\"\$ac_cs_config\\"++Copyright (C) 2012 Free Software Foundation, Inc.+This config.status script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it."++ac_pwd='$ac_pwd'+srcdir='$srcdir'+test -n "\$AWK" || AWK=awk+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# The default lists apply if the user does not specify any file.+ac_need_defaults=:+while test $# != 0+do+  case $1 in+  --*=?*)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`+    ac_shift=:+    ;;+  --*=)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=+    ac_shift=:+    ;;+  *)+    ac_option=$1+    ac_optarg=$2+    ac_shift=shift+    ;;+  esac++  case $ac_option in+  # Handling of the options.+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)+    ac_cs_recheck=: ;;+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )+    $as_echo "$ac_cs_version"; exit ;;+  --config | --confi | --conf | --con | --co | --c )+    $as_echo "$ac_cs_config"; exit ;;+  --debug | --debu | --deb | --de | --d | -d )+    debug=: ;;+  --file | --fil | --fi | --f )+    $ac_shift+    case $ac_optarg in+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+    '') as_fn_error $? "missing file argument" ;;+    esac+    as_fn_append CONFIG_FILES " '$ac_optarg'"+    ac_need_defaults=false;;+  --header | --heade | --head | --hea )+    $ac_shift+    case $ac_optarg in+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"+    ac_need_defaults=false;;+  --he | --h)+    # Conflict between --help and --header+    as_fn_error $? "ambiguous option: \`$1'+Try \`$0 --help' for more information.";;+  --help | --hel | -h )+    $as_echo "$ac_cs_usage"; exit ;;+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil | --si | --s)+    ac_cs_silent=: ;;++  # This is an error.+  -*) as_fn_error $? "unrecognized option: \`$1'+Try \`$0 --help' for more information." ;;++  *) as_fn_append ac_config_targets " $1"+     ac_need_defaults=false ;;++  esac+  shift+done++ac_configure_extra_args=++if $ac_cs_silent; then+  exec 6>/dev/null+  ac_configure_extra_args="$ac_configure_extra_args --silent"+fi++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+if \$ac_cs_recheck; then+  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+  shift+  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6+  CONFIG_SHELL='$SHELL'+  export CONFIG_SHELL+  exec "\$@"+fi++_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+exec 5>>config.log+{+  echo+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX+## Running $as_me. ##+_ASBOX+  $as_echo "$ac_log"+} >&5++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1++# Handling of arguments.+for ac_config_target in $ac_config_targets+do+  case $ac_config_target in+    "cbits/config.h") CONFIG_HEADERS="$CONFIG_HEADERS cbits/config.h" ;;+    "linear-algebra.buildinfo") CONFIG_FILES="$CONFIG_FILES linear-algebra.buildinfo" ;;++  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;+  esac+done+++# If the user did not use the arguments to specify the items to instantiate,+# then the envvar interface is used.  Set only those that are not.+# We use the long form for the default assignment because of an extremely+# bizarre bug on SunOS 4.1.3.+if $ac_need_defaults; then+  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers+fi++# Have a temporary directory for convenience.  Make it in the build tree+# simply because there is no reason against having it here, and in addition,+# creating and moving files from /tmp can sometimes cause problems.+# Hook for its removal unless debugging.+# Note that there is a small window in which the directory will not be cleaned:+# after its creation but before its name has been assigned to `$tmp'.+$debug ||+{+  tmp= ac_tmp=+  trap 'exit_status=$?+  : "${ac_tmp:=$tmp}"+  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status+' 0+  trap 'as_fn_exit 1' 1 2 13 15+}+# Create a (secure) tmp directory for tmp files.++{+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&+  test -d "$tmp"+}  ||+{+  tmp=./conf$$-$RANDOM+  (umask 077 && mkdir "$tmp")+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5+ac_tmp=$tmp++# Set up the scripts for CONFIG_FILES section.+# No need to generate them if there are no CONFIG_FILES.+# This happens for instance with `./config.status config.h'.+if test -n "$CONFIG_FILES"; then+++ac_cr=`echo X | tr X '\015'`+# On cygwin, bash can eat \r inside `` if the user requested igncr.+# But we know of no other shell where ac_cr would be empty at this+# point, so we can use a bashism as a fallback.+if test "x$ac_cr" = x; then+  eval ac_cr=\$\'\\r\'+fi+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then+  ac_cs_awk_cr='\\r'+else+  ac_cs_awk_cr=$ac_cr+fi++echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&+_ACEOF+++{+  echo "cat >conf$$subs.awk <<_ACEOF" &&+  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&+  echo "_ACEOF"+} >conf$$subs.sh ||+  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`+ac_delim='%!_!# '+for ac_last_try in false false false false false :; do+  . ./conf$$subs.sh ||+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5++  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`+  if test $ac_delim_n = $ac_delim_num; then+    break+  elif $ac_last_try; then+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5+  else+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+  fi+done+rm -f conf$$subs.sh++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&+_ACEOF+sed -n '+h+s/^/S["/; s/!.*/"]=/+p+g+s/^[^!]*!//+:repl+t repl+s/'"$ac_delim"'$//+t delim+:nl+h+s/\(.\{148\}\)..*/\1/+t more1+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/+p+n+b repl+:more1+s/["\\]/\\&/g; s/^/"/; s/$/"\\/+p+g+s/.\{148\}//+t nl+:delim+h+s/\(.\{148\}\)..*/\1/+t more2+s/["\\]/\\&/g; s/^/"/; s/$/"/+p+b+:more2+s/["\\]/\\&/g; s/^/"/; s/$/"\\/+p+g+s/.\{148\}//+t delim+' <conf$$subs.awk | sed '+/^[^""]/{+  N+  s/\n//+}+' >>$CONFIG_STATUS || ac_write_fail=1+rm -f conf$$subs.awk+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACAWK+cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&+  for (key in S) S_is_set[key] = 1+  FS = ""++}+{+  line = $ 0+  nfields = split(line, field, "@")+  substed = 0+  len = length(field[1])+  for (i = 2; i < nfields; i++) {+    key = field[i]+    keylen = length(key)+    if (S_is_set[key]) {+      value = S[key]+      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)+      len += length(value) + length(field[++i])+      substed = 1+    } else+      len += 1 + keylen+  }++  print line+}++_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then+  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"+else+  cat+fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \+  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5+_ACEOF++# VPATH may cause trouble with some makes, so we remove sole $(srcdir),+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and+# trailing colons and then remove the whole line if VPATH becomes empty+# (actually we leave an empty line to preserve line numbers).+if test "x$srcdir" = x.; then+  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{+h+s///+s/^/:/+s/[	 ]*$/:/+s/:\$(srcdir):/:/g+s/:\${srcdir}:/:/g+s/:@srcdir@:/:/g+s/^:*//+s/:*$//+x+s/\(=[	 ]*\).*/\1/+G+s/\n//+s/^[^=]*=[	 ]*$//+}'+fi++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+fi # test -n "$CONFIG_FILES"++# Set up the scripts for CONFIG_HEADERS section.+# No need to generate them if there are no CONFIG_HEADERS.+# This happens for instance with `./config.status Makefile'.+if test -n "$CONFIG_HEADERS"; then+cat >"$ac_tmp/defines.awk" <<\_ACAWK ||+BEGIN {+_ACEOF++# Transform confdefs.h into an awk script `defines.awk', embedded as+# here-document in config.status, that substitutes the proper values into+# config.h.in to produce config.h.++# Create a delimiter string that does not exist in confdefs.h, to ease+# handling of long lines.+ac_delim='%!_!# '+for ac_last_try in false false :; do+  ac_tt=`sed -n "/$ac_delim/p" confdefs.h`+  if test -z "$ac_tt"; then+    break+  elif $ac_last_try; then+    as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5+  else+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+  fi+done++# For the awk script, D is an array of macro values keyed by name,+# likewise P contains macro parameters if any.  Preserve backslash+# newline sequences.++ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*+sed -n '+s/.\{148\}/&'"$ac_delim"'/g+t rset+:rset+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /+t def+d+:def+s/\\$//+t bsnl+s/["\\]/\\&/g+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\+D["\1"]=" \3"/p+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p+d+:bsnl+s/["\\]/\\&/g+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\+D["\1"]=" \3\\\\\\n"\\/p+t cont+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p+t cont+d+:cont+n+s/.\{148\}/&'"$ac_delim"'/g+t clear+:clear+s/\\$//+t bsnlc+s/["\\]/\\&/g; s/^/"/; s/$/"/p+d+:bsnlc+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p+b cont+' <confdefs.h | sed '+s/'"$ac_delim"'/"\\\+"/g' >>$CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+  for (key in D) D_is_set[key] = 1+  FS = ""+}+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {+  line = \$ 0+  split(line, arg, " ")+  if (arg[1] == "#") {+    defundef = arg[2]+    mac1 = arg[3]+  } else {+    defundef = substr(arg[1], 2)+    mac1 = arg[2]+  }+  split(mac1, mac2, "(") #)+  macro = mac2[1]+  prefix = substr(line, 1, index(line, defundef) - 1)+  if (D_is_set[macro]) {+    # Preserve the white space surrounding the "#".+    print prefix "define", macro P[macro] D[macro]+    next+  } else {+    # Replace #undef with comments.  This is necessary, for example,+    # in the case of _POSIX_SOURCE, which is predefined and required+    # on some systems where configure will not decide to define it.+    if (defundef == "undef") {+      print "/*", prefix defundef, macro, "*/"+      next+    }+  }+}+{ print }+_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+  as_fn_error $? "could not setup config headers machinery" "$LINENO" 5+fi # test -n "$CONFIG_HEADERS"+++eval set X "  :F $CONFIG_FILES  :H $CONFIG_HEADERS    "+shift+for ac_tag+do+  case $ac_tag in+  :[FHLC]) ac_mode=$ac_tag; continue;;+  esac+  case $ac_mode$ac_tag in+  :[FHL]*:*);;+  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;+  :[FH]-) ac_tag=-:-;;+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;+  esac+  ac_save_IFS=$IFS+  IFS=:+  set x $ac_tag+  IFS=$ac_save_IFS+  shift+  ac_file=$1+  shift++  case $ac_mode in+  :L) ac_source=$1;;+  :[FH])+    ac_file_inputs=+    for ac_f+    do+      case $ac_f in+      -) ac_f="$ac_tmp/stdin";;+      *) # Look for the file first in the build tree, then in the source tree+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,+	 # because $ac_f cannot contain `:'.+	 test -f "$ac_f" ||+	   case $ac_f in+	   [\\/$]*) false;;+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;+	   esac ||+	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;+      esac+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac+      as_fn_append ac_file_inputs " '$ac_f'"+    done++    # Let's still pretend it is `configure' which instantiates (i.e., don't+    # use $as_me), people would be surprised to read:+    #    /* config.h.  Generated by config.status.  */+    configure_input='Generated from '`+	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'+	`' by configure.'+    if test x"$ac_file" != x-; then+      configure_input="$ac_file.  $configure_input"+      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5+$as_echo "$as_me: creating $ac_file" >&6;}+    fi+    # Neutralize special characters interpreted by sed in replacement strings.+    case $configure_input in #(+    *\&* | *\|* | *\\* )+       ac_sed_conf_input=`$as_echo "$configure_input" |+       sed 's/[\\\\&|]/\\\\&/g'`;; #(+    *) ac_sed_conf_input=$configure_input;;+    esac++    case $ac_tag in+    *:-:* | *:-) cat >"$ac_tmp/stdin" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;+    esac+    ;;+  esac++  ac_dir=`$as_dirname -- "$ac_file" ||+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$ac_file" : 'X\(//\)[^/]' \| \+	 X"$ac_file" : 'X\(//\)$' \| \+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$ac_file" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  as_dir="$ac_dir"; as_fn_mkdir_p+  ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix+++  case $ac_mode in+  :F)+  #+  # CONFIG_FILE+  #++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# If the template does not know about datarootdir, expand it.+# FIXME: This hack should be removed a few years after 2.60.+ac_datarootdir_hack=; ac_datarootdir_seen=+ac_sed_dataroot='+/datarootdir/ {+  p+  q+}+/@datadir@/p+/@docdir@/p+/@infodir@/p+/@localedir@/p+/@mandir@/p'+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in+*datarootdir*) ac_datarootdir_seen=yes;;+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}+_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+  ac_datarootdir_hack='+  s&@datadir@&$datadir&g+  s&@docdir@&$docdir&g+  s&@infodir@&$infodir&g+  s&@localedir@&$localedir&g+  s&@mandir@&$mandir&g+  s&\\\${datarootdir}&$datarootdir&g' ;;+esac+_ACEOF++# Neutralize VPATH when `$srcdir' = `.'.+# Shell code in configure.ac might set extrasub.+# FIXME: do we really want to maintain this feature?+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_sed_extra="$ac_vpsub+$extrasub+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+:t+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b+s|@configure_input@|$ac_sed_conf_input|;t t+s&@top_builddir@&$ac_top_builddir_sub&;t t+s&@top_build_prefix@&$ac_top_build_prefix&;t t+s&@srcdir@&$ac_srcdir&;t t+s&@abs_srcdir@&$ac_abs_srcdir&;t t+s&@top_srcdir@&$ac_top_srcdir&;t t+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t+s&@builddir@&$ac_builddir&;t t+s&@abs_builddir@&$ac_abs_builddir&;t t+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t+$ac_datarootdir_hack+"+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \+  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5++test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&+  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&+  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \+      "$ac_tmp/out"`; test -z "$ac_out"; } &&+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined.  Please make sure it is defined" >&5+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined.  Please make sure it is defined" >&2;}++  rm -f "$ac_tmp/stdin"+  case $ac_file in+  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;+  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;+  esac \+  || as_fn_error $? "could not create $ac_file" "$LINENO" 5+ ;;+  :H)+  #+  # CONFIG_HEADER+  #+  if test x"$ac_file" != x-; then+    {+      $as_echo "/* $configure_input  */" \+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"+    } >"$ac_tmp/config.h" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5+    if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then+      { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5+$as_echo "$as_me: $ac_file is unchanged" >&6;}+    else+      rm -f "$ac_file"+      mv "$ac_tmp/config.h" "$ac_file" \+	|| as_fn_error $? "could not create $ac_file" "$LINENO" 5+    fi+  else+    $as_echo "/* $configure_input  */" \+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \+      || as_fn_error $? "could not create -" "$LINENO" 5+  fi+ ;;+++  esac++done # for ac_tag+++as_fn_exit 0+_ACEOF+ac_clean_files=$ac_clean_files_save++test $ac_write_fail = 0 ||+  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5+++# configure is writing to config.log, and then calls config.status.+# config.status does its own redirection, appending to config.log.+# Unfortunately, on DOS this fails, as config.log is still kept open+# by configure, so config.status won't be able to write to it; its+# output is simply discarded.  So we exec the FD to /dev/null,+# effectively closing config.log, so it can be properly (re)opened and+# appended to by config.status.  When coming back to configure, we+# need to make the FD available again.+if test "$no_create" != yes; then+  ac_cs_success=:+  ac_config_status_args=+  test "$silent" = yes &&+    ac_config_status_args="$ac_config_status_args --quiet"+  exec 5>/dev/null+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false+  exec 5>>config.log+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which+  # would make configure fail if this is the last instruction.+  $ac_cs_success || as_fn_exit 1+fi+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}+fi+
+ configure.ac view
@@ -0,0 +1,25 @@+AC_PREREQ([2.61])+AC_INIT([Haskell Linear Algebra], [0.8], [patperry@gmail.com])++AC_CONFIG_SRCDIR([linear-algebra.cabal])+AC_CONFIG_MACRO_DIR([m4])++AC_ARG_WITH(compiler, +    [AC_HELP_STRING([--with-compiler=<cmd>], [use Haskell compiler <cmd>])])++# Checks for programs++# Checks for libraries+AC_CHECK_LIB([m],[cos])+AX_CHECK_LAPACK++if test "$ax_lapack_ok" = yes; then+  BUILD_PACKAGE_BOOL=True+else +  BUILD_PACKAGE_BOOL=False+fi+AC_SUBST([BUILD_PACKAGE_BOOL])++AC_CONFIG_HEADERS([cbits/config.h])+AC_CONFIG_FILES([linear-algebra.buildinfo])+AC_OUTPUT
+ examples/LU.hs view
@@ -0,0 +1,64 @@+module LU ( luFactor, luFactorM ) where++import Control.Monad( zipWithM_ )+import Control.Monad.ST( ST, runST )++import Numeric.LinearAlgebra+import qualified Numeric.LinearAlgebra.Matrix as M+import qualified Numeric.LinearAlgebra.Vector as V+++luFactor :: (BLAS3 e) => Matrix e -> Either Int (Matrix e, [Int])+luFactor a = runST $ do+    ma <- M.newCopy a+    luFactorM ma >>=+        either (return . Left) (\pivots -> do+            a' <- M.unsafeFreeze ma+            return $ Right (a',pivots)+        )++{-+ - Recursive LU factorization with row pivoting.  Takes a matrix+ - A and factors it as P A = L U, where P is a permutation matrix, + - L is a lower triangular matrix with ones along the diagonal, and + - U is an upper triangular matrix.  On successful return, the values of+ - L and U are stored in A, and a list of the row swaps are returned.+ - On failure, the index of the failing column is returned.+ -}      +luFactorM :: (BLAS3 e) => STMatrix s e -> ST s (Either Int [Int])+luFactorM a = do+    (m,n) <- M.getDim a+    let mn = min m n+        nleft = mn `div` 2+    +    case undefined of+        _ | mn > 1 ->     +            M.withSplitColsAtM nleft a $ \a_1 a_2 ->+            M.withSplitRowsAtM nleft a_1 $ \a11 a21 ->+            M.withSplitRowsAtM nleft a_2 $ \a12 a22 ->+            luFactorM a_1 >>=+                either (return . Left) (\pivots -> do+                    zipWithM_ (M.swapRows a_2) [ 0.. ] pivots+                    M.triSolvMatrixM_ LeftSide NoTrans (Tri Lower Unit a11) a12+                    M.addMulMatrixWithScalesM_ (-1) NoTrans a21 NoTrans a12 1 a22+                    luFactorM a22 >>=+                        either (return . Left . (nleft+)) (\pivots' -> do+                            zipWithM_ (M.swapRows a21) [ 0.. ] pivots'+                            return $ Right (pivots ++ map (nleft+) pivots')+                        )+                )+        +        _ | mn == 1 ->+            M.withColM a 0 $ \x ->+                V.getWhichMaxAbs x >>= \(i,e) ->+                    if (e /= 0) +                        then do+                            V.scaleM_ (1/e) x+                            V.read x 0 >>= V.write x i+                            V.write x 0 e+                            return $ Right [i]+                        else+                            return $ Left 0++        _ | otherwise ->+            return $ Right []
+ lib/Foreign/BLAS.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.BLAS+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- BLAS operations.+--++module Foreign.BLAS (+    -- * BLAS typeclasses+    module Foreign.BLAS.Level1,+    module Foreign.BLAS.Level2,+    module Foreign.BLAS.Level3,+    -- * Enums+    module Foreign.BLAS.Types,    +    ) where++import Foreign.BLAS.Types+import Foreign.BLAS.Level1+import Foreign.BLAS.Level2+import Foreign.BLAS.Level3
+ lib/Foreign/BLAS/Double.hsc view
@@ -0,0 +1,135 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.BLAS.Double+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Foreign.BLAS.Double +    where+    +import Foreign+import Foreign.C.Types +import Foreign.BLAS.Types++#include "config.h"+#include "f77_func-hsc.h"+++---------------------------- Level 1 Routines -------------------------------++foreign import ccall unsafe #f77_func ddot+    ddot :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO Double++foreign import ccall unsafe #f77_func dnrm2+    dnrm2  :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO Double++foreign import ccall unsafe #f77_func dasum+    dasum  :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO Double++foreign import ccall unsafe #f77_func idamax+    idamax_hidden :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO CInt +-- for some reason ffi stuff wasn't working with return type IO LAInt +idamax :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO LAInt+idamax a b c  =  do res <-  idamax_hidden a b c +                    return $! LAInt res +++foreign import ccall unsafe #f77_func dscal+    dscal  :: Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dswap+    dswap  :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dcopy+    dcopy  :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func daxpy+    daxpy  :: Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func drotg+    drotg  :: Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe #f77_func drot+    drot :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe #f77_func drotmg+    drotmg :: Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe #f77_func drotm+    drotm :: Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> IO ()+++---------------------------- Level 2 Routines -------------------------------++foreign import ccall unsafe #f77_func dgemv+    dgemv :: BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dgbmv+    dgbmv ::  BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dtrmv+    dtrmv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dtpmv+    dtpmv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dtpsv+    dtpsv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dtbmv+    dtbmv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()+                 +foreign import ccall unsafe #f77_func dtrsv+    dtrsv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dtbsv+    dtbsv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()+    +foreign import ccall unsafe #f77_func dsymv+    dsymv ::  BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()+    +foreign import ccall unsafe #f77_func dsbmv+    dsbmv ::  BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()+    +foreign import ccall unsafe #f77_func dger+    dger  ::  Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()+        +foreign import ccall unsafe #f77_func dsyr+    dsyr  ::  BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dsyr2+    dsyr2 ::  BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dspmv+    dspmv ::  BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dspr+    dspr  ::  BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> IO ()++foreign import ccall unsafe #f77_func dspr2+    dspr2 ::  BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> IO ()+++---------------------------- Level 3 Routines -------------------------------++foreign import ccall unsafe #f77_func dgemm+    dgemm  ::  BLASTrans -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dsymm+    dsymm  ::  BLASSide -> BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dtrmm+    dtrmm  ::  BLASSide -> BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dtrsm+    dtrsm  ::  BLASSide -> BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dsyrk+    dsyrk  ::  BLASUplo -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()+           +foreign import ccall unsafe #f77_func dsyr2k           +    dsyr2k ::  BLASUplo -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> IO ()
+ lib/Foreign/BLAS/Level1.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.BLAS.Level1+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Vector operations.+--++module Foreign.BLAS.Level1 (+    BLAS1(..),+    ) where+     +import Foreign( Storable, Ptr, peek, with )+import Foreign.Storable.Complex()+import Data.Complex( Complex(..) )++import Foreign.VMath.VFractional( VFractional )+import Foreign.BLAS.Double  +import Foreign.BLAS.Zomplex+        +-- | Types with vector-vector operations.+class (Storable a, VFractional a) => BLAS1 a where+    copy  :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()    +    swap  :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    dotc  :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO a+    dotu  :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO a    +    nrm2  :: Int -> Ptr a -> Int -> IO Double+    asum  :: Int -> Ptr a -> Int -> IO Double+    iamax :: Int -> Ptr a -> Int -> IO Int+    +    scal  :: Int -> a -> Ptr a -> Int -> IO () ++    axpy  :: Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()++    rotg  :: Ptr a -> Ptr a -> Ptr a -> Ptr a -> IO ()+    rot   :: Int -> Ptr a -> Int -> Ptr a -> Int -> Double -> Double -> IO ()+++withEnum :: (Enum a, Storable a) => Int -> (Ptr a -> IO b) -> IO b+withEnum = with . toEnum+{-# INLINE withEnum #-}++instance BLAS1 Double where+    copy n px incx py incy =+        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            dcopy pn px pincx py pincy+    {-# INLINE copy #-}++    swap n px incx py incy = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            dswap pn px pincx py pincy+    {-# INLINE swap #-}++    dotc n px incx py incy = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            ddot pn px pincx py pincy+    {-# INLINE dotc #-}++    dotu = dotc+    {-# INLINE dotu #-}+    +    nrm2 n px incx = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+            dnrm2 pn px pincx+    {-# INLINE nrm2 #-}++    asum n px incx = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+            dasum pn px pincx+    {-# INLINE asum #-}++    iamax n px incx = +        withEnum n $ \pn ->+        withEnum incx $ \pincx -> do+            i <- idamax pn px pincx+            return $! fromEnum (i - 1)+    {-# INLINE iamax #-}++    axpy n alpha px incx py incy = +        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            daxpy pn palpha px pincx py pincy+    {-# INLINE axpy #-}+    +    scal n alpha px incx = +        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+            dscal pn palpha px pincx+    {-# INLINE scal #-}++    rotg = drotg+    {-# INLINE rotg #-}+    +    rot n px incx py incy c s = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        with c $ \pc ->+        with s $ \ps ->+            drot pn px pincx py pincy pc ps+    {-# INLINE rot #-}+++instance BLAS1 (Complex Double) where+    copy n px incx py incy =+        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            zcopy pn px pincx py pincy+    {-# INLINE copy #-}++    swap n px incx py incy = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            zswap pn px pincx py pincy+    {-# INLINE swap #-}+    +    dotc n px incx py incy =+        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        with 0 $ \pdotc -> do+            zdotc pdotc pn px pincx py pincy+            peek pdotc+    {-# INLINE dotc #-}++    dotu n px incx py incy =+        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        with 0 $ \pdotu -> do+            zdotu pdotu pn px pincx py pincy+            peek pdotu+    {-# INLINE dotu #-}++    nrm2 n px incx = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+            znrm2 pn px pincx+    {-# INLINE nrm2 #-}++    asum n px incx = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+            zasum pn px pincx+    {-# INLINE asum #-}++    iamax n px incx = +        withEnum n $ \pn ->+        withEnum incx $ \pincx -> do+            i <- izamax pn px pincx+            return $! fromEnum (i - 1)+    {-# INLINE iamax #-}++    axpy n alpha px incx py incy = +        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            zaxpy pn palpha px pincx py pincy+    {-# INLINE axpy #-}+    +    scal n alpha px incx = +        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+            zscal pn palpha px pincx+    {-# INLINE scal #-}++    rotg = zrotg+    {-# INLINE rotg #-}+    +    rot n px incx py incy c s = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        with c $ \pc ->+        with s $ \ps ->+            zdrot pn px pincx py pincy pc ps+    {-# INLINE rot #-}
+ lib/Foreign/BLAS/Level2.hs view
@@ -0,0 +1,396 @@+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.BLAS.Level2+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Matrix-Vector operations.+--++module Foreign.BLAS.Level2 (+    BLAS2(..),+    ) where+     +import Data.Complex +import Foreign( Ptr, Storable, with )++import Foreign.BLAS.Types+import Foreign.BLAS.Level1+import Foreign.BLAS.Double+import Foreign.BLAS.Zomplex+   +-- | Types with matrix-vector operations.+class (BLAS1 a) => BLAS2 a where+    gbmv :: Trans -> Int -> Int -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    gemv :: Trans -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    gerc :: Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    geru :: Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()++    hbmv :: Uplo -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    hemv :: Uplo -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    her  :: Uplo -> Int -> Double -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    her2 :: Uplo -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    hpmv :: Uplo -> Int -> a -> Ptr a -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()    +    hpr  :: Uplo -> Int -> Double -> Ptr a -> Int -> Ptr a -> IO ()+    hpr2 :: Uplo -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> IO ()++    tbmv :: Uplo -> Trans -> Diag -> Int -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    tbsv :: Uplo -> Trans -> Diag -> Int -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    tpmv :: Uplo -> Trans -> Diag -> Int -> Ptr a -> Ptr a -> Int -> IO ()    +    tpsv :: Uplo -> Trans -> Diag -> Int -> Ptr a -> Ptr a -> Int -> IO ()        +    trmv :: Uplo -> Trans -> Diag -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    trsv :: Uplo -> Trans -> Diag -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+++withEnum :: (Enum a, Storable a) => Int -> (Ptr a -> IO b) -> IO b+withEnum = with . toEnum+{-# INLINE withEnum #-}++instance BLAS2 Double where+    gemv transa m n alpha pa lda px incx beta py incy =+        withTrans transa $ \ptransa ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            dgemv ptransa pm pn palpha pa plda px pincx pbeta py pincy+    {-# INLINE gemv #-}+    +    gbmv transa m n kl ku alpha pa lda px incx beta py incy =+        withTrans transa $ \ptransa ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum kl $ \pkl ->+        withEnum ku $ \pku ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            dgbmv ptransa pm pn pkl pku palpha pa plda px pincx pbeta py pincy+    {-# INLINE gbmv #-}++    trmv uplo trans diag n pa lda px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+            dtrmv puplo ptrans pdiag pn pa plda px pincx+    {-# INLINE trmv #-}++    tpmv uplo trans diag n pap px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+            dtpmv puplo ptrans pdiag pn pap px pincx+    {-# INLINE tpmv #-}++    tpsv uplo trans diag n pap px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+            dtpsv puplo ptrans pdiag pn pap px pincx+    {-# INLINE tpsv #-}+     +    tbmv uplo trans diag n k pa lda px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+            dtbmv puplo ptrans pdiag pn pk pa plda px pincx+    {-# INLINE tbmv #-}++    trsv uplo trans diag n pa lda px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+            dtrsv puplo ptrans pdiag pn pa plda px pincx+    {-# INLINE trsv #-}++    tbsv uplo trans diag n k pa lda px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+            dtbsv puplo ptrans pdiag pn pk pa plda px pincx+    {-# INLINE tbsv #-}++    hemv uplo n alpha pa lda px incx beta py incy =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            dsymv puplo pn palpha pa plda px pincx pbeta py pincy+    {-# INLINE hemv #-}++    hbmv uplo n k alpha pa lda px incx beta py incy =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            dsbmv puplo pn pk palpha pa plda px pincx pbeta py pincy+    {-# INLINE hbmv #-}++    gerc m n alpha px incx py incy pa lda =+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        withEnum lda $ \plda ->+            dger pm pn palpha px pincx py pincy pa plda+    {-# INLINE gerc #-}++    geru = gerc+    {-# INLINE geru #-}++    her uplo n alpha px incx pa lda =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum lda $ \plda ->+            dsyr puplo pn palpha px pincx pa plda+    {-# INLINE her #-}++    her2 uplo n alpha px incx py incy pa lda =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        withEnum lda $ \plda ->+            dsyr2 puplo pn palpha px pincx py pincy pa plda+    {-# INLINE her2 #-}++    hpmv uplo n alpha pap px incx beta py incy =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            dspmv puplo pn palpha pap px pincx pbeta py pincy+    {-# INLINE hpmv #-}++    hpr uplo n alpha px incx pap =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+            dspr puplo pn palpha px pincx pap+    {-# INLINE hpr #-}++    hpr2 uplo n alpha px incx py incy pap =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            dspr2 puplo pn palpha px pincx py pincy pap+    {-# INLINE hpr2 #-}+    ++instance BLAS2 (Complex Double) where+    gemv transa m n alpha pa lda px incx beta py incy =+        withTrans transa $ \ptransa ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            zgemv ptransa pm pn palpha pa plda px pincx pbeta py pincy+    {-# INLINE gemv #-}+    +    gbmv transa m n kl ku alpha pa lda px incx beta py incy =+        withTrans transa $ \ptransa ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum kl $ \pkl ->+        withEnum ku $ \pku ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            zgbmv ptransa pm pn pkl pku palpha pa plda px pincx pbeta py pincy+    {-# INLINE gbmv #-}++    trmv uplo trans diag n pa lda px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+            ztrmv puplo ptrans pdiag pn pa plda px pincx+    {-# INLINE trmv #-}++    tpmv uplo trans diag n pap px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+            ztpmv puplo ptrans pdiag pn pap px pincx+    {-# INLINE tpmv #-}++    tpsv uplo trans diag n pap px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+            ztpsv puplo ptrans pdiag pn pap px pincx+    {-# INLINE tpsv #-}+     +    tbmv uplo trans diag n k pa lda px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+            ztbmv puplo ptrans pdiag pn pk pa plda px pincx+    {-# INLINE tbmv #-}++    trsv uplo trans diag n pa lda px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+            ztrsv puplo ptrans pdiag pn pa plda px pincx+    {-# INLINE trsv #-}++    tbsv uplo trans diag n k pa lda px incx =+        withUplo uplo $ \puplo ->+        withTrans trans $ \ptrans ->+        withDiag diag $ \pdiag ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+            ztbsv puplo ptrans pdiag pn pk pa plda px pincx+    {-# INLINE tbsv #-}++    hemv uplo n alpha pa lda px incx beta py incy =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            zhemv puplo pn palpha pa plda px pincx pbeta py pincy+    {-# INLINE hemv #-}++    hbmv uplo n k alpha pa lda px incx beta py incy =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            zhbmv puplo pn pk palpha pa plda px pincx pbeta py pincy+    {-# INLINE hbmv #-}++    gerc m n alpha px incx py incy pa lda =+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        withEnum lda $ \plda ->+            zgerc pm pn palpha px pincx py pincy pa plda+    {-# INLINE gerc #-}++    geru m n alpha px incx py incy pa lda =+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        withEnum lda $ \plda ->+            zgeru pm pn palpha px pincx py pincy pa plda+    {-# INLINE geru #-}++    her uplo n alpha px incx pa lda =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum lda $ \plda ->+            zher puplo pn palpha px pincx pa plda+    {-# INLINE her #-}++    her2 uplo n alpha px incx py incy pa lda =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+        withEnum lda $ \plda ->+            zher2 puplo pn palpha px pincx py pincy pa plda+    {-# INLINE her2 #-}++    hpmv uplo n alpha pap px incx beta py incy =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        with beta $ \pbeta ->+        withEnum incy $ \pincy ->+            zhpmv puplo pn palpha pap px pincx pbeta py pincy+    {-# INLINE hpmv #-}++    hpr uplo n alpha px incx pap =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+            zhpr puplo pn palpha px pincx pap+    {-# INLINE hpr #-}++    hpr2 uplo n alpha px incx py incy pap =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum incx $ \pincx ->+        withEnum incy $ \pincy ->+            zhpr2 puplo pn palpha px pincx py pincy pap+    {-# INLINE hpr2 #-}
+ lib/Foreign/BLAS/Level3.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.BLAS.Level3+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Matrix-Matrix operations.+--++module Foreign.BLAS.Level3 (+    BLAS3(..),+    ) where+     +import Data.Complex +import Foreign( Ptr, Storable, with )++import Foreign.BLAS.Types+import Foreign.BLAS.Level2+import Foreign.BLAS.Double+import Foreign.BLAS.Zomplex++-- | Types with matrix-matrix operations.        +class (BLAS2 a) => BLAS3 a where+    gemm  :: Trans -> Trans -> Int -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    symm  :: Side -> Uplo -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    hemm  :: Side -> Uplo -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    trmm  :: Side -> Uplo -> Trans -> Diag -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    trsm  :: Side -> Uplo -> Trans -> Diag -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    syrk  :: Uplo -> Trans -> Int -> Int -> a -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    syr2k :: Uplo -> Trans -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    herk  :: Uplo -> Trans -> Int -> Int -> a -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    her2k :: Uplo -> Trans -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+  ++withEnum :: (Enum a, Storable a) => Int -> (Ptr a -> IO b) -> IO b+withEnum = with . toEnum+{-# INLINE withEnum #-}+  +    +instance BLAS3 Double where+    gemm transa transb m n k alpha pa lda pb ldb beta pc ldc =+        withTrans transa $ \ptransa ->+        withTrans transb $ \ptransb ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            dgemm ptransa ptransb pm pn pk palpha pa plda pb pldb pbeta pc pldc+    {-# INLINE gemm #-}++    symm side uplo m n alpha pa lda pb ldb beta pc ldc =+        withSide side $ \pside ->+        withUplo uplo $ \puplo ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            dsymm pside puplo pm pn palpha pa plda pb pldb pbeta pc pldc+    {-# INLINE symm #-}++    hemm = symm+    {-# INLINE hemm #-}++    trmm side uplo transa diag m n alpha pa lda pb ldb =+        withSide side $ \pside ->+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withDiag diag $ \pdiag ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+            dtrmm pside puplo ptransa pdiag pm pn palpha pa plda pb pldb+    {-# INLINE trmm #-}++    trsm side uplo transa diag m n alpha pa lda pb ldb =+        withSide side $ \pside ->+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withDiag diag $ \pdiag ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+            dtrsm pside puplo ptransa pdiag pm pn palpha pa plda pb pldb+    {-# INLINE trsm #-}++    syrk uplo transa n k alpha pa lda beta pc ldc =+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            dsyrk puplo ptransa pn pk palpha pa plda pbeta pc pldc+    {-# INLINE syrk #-}++    syr2k uplo transa n k alpha pa lda pb ldb beta pc ldc =+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            dsyr2k puplo ptransa pn pk palpha pa plda pb pldb pbeta pc pldc+    {-# INLINE syr2k #-}++    herk = syrk+    {-# INLINE herk #-}++    her2k = syr2k+    {-# INLINE her2k #-}++    +instance BLAS3 (Complex Double) where+    gemm transa transb m n k alpha pa lda pb ldb beta pc ldc =+        withTrans transa $ \ptransa ->+        withTrans transb $ \ptransb ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            zgemm ptransa ptransb pm pn pk palpha pa plda pb pldb pbeta pc pldc+    {-# INLINE gemm #-}++    symm side uplo m n alpha pa lda pb ldb beta pc ldc =+        withSide side $ \pside ->+        withUplo uplo $ \puplo ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            zsymm pside puplo pm pn palpha pa plda pb pldb pbeta pc pldc+    {-# INLINE symm #-}++    hemm side uplo m n alpha pa lda pb ldb beta pc ldc =+        withSide side $ \pside ->+        withUplo uplo $ \puplo ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            zhemm pside puplo pm pn palpha pa plda pb pldb pbeta pc pldc+    {-# INLINE hemm #-}++    trmm side uplo transa diag m n alpha pa lda pb ldb =+        withSide side $ \pside ->+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withDiag diag $ \pdiag ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+            ztrmm pside puplo ptransa pdiag pm pn palpha pa plda pb pldb+    {-# INLINE trmm #-}++    trsm side uplo transa diag m n alpha pa lda pb ldb =+        withSide side $ \pside ->+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withDiag diag $ \pdiag ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+            ztrsm pside puplo ptransa pdiag pm pn palpha pa plda pb pldb+    {-# INLINE trsm #-}++    syrk uplo transa n k alpha pa lda beta pc ldc =+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            zsyrk puplo ptransa pn pk palpha pa plda pbeta pc pldc+    {-# INLINE syrk #-}++    syr2k uplo transa n k alpha pa lda pb ldb beta pc ldc =+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            zsyr2k puplo ptransa pn pk palpha pa plda pb pldb pbeta pc pldc+    {-# INLINE syr2k #-}++    herk uplo transa n k alpha pa lda beta pc ldc =+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            zherk puplo ptransa pn pk palpha pa plda pbeta pc pldc+    {-# INLINE herk #-}++    her2k uplo transa n k alpha pa lda pb ldb beta pc ldc =+        withUplo uplo $ \puplo ->+        withTrans transa $ \ptransa ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        with alpha $ \palpha ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        with beta $ \pbeta ->+        withEnum ldc $ \pldc ->+            zher2k puplo ptransa pn pk palpha pa plda pb pldb pbeta pc pldc+    {-# INLINE her2k #-}
+ lib/Foreign/BLAS/Types.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.BLAS.Types+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Foreign.BLAS.Types (+    BLASTrans(..),+    Trans(..),+    withTrans,+    +    BLASUplo(..),+    Uplo(..),+    withUplo,+    +    BLASDiag(..),+    Diag(..),+    withDiag,+    +    BLASSide(..),+    Side(..),+    withSide,+    +    LAInt(..),+    ) where++import Foreign+import Foreign.C.Types+import Foreign.C.String++newtype BLASTrans = BLASTrans CString+data Trans = NoTrans | Trans | ConjTrans deriving (Eq, Show)++withTrans :: Trans -> (BLASTrans -> IO a) -> IO a+withTrans trans f = flip withCString (f . BLASTrans) $ case trans of+    NoTrans   -> "N"+    Trans     -> "T"+    ConjTrans -> "C"++newtype BLASUplo = BLASUplo CString+data Uplo = Upper | Lower deriving (Eq, Show)++withUplo :: Uplo -> (BLASUplo -> IO a) -> IO a+withUplo uplo f = flip withCString (f . BLASUplo) $ case uplo of+    Upper -> "U"+    Lower -> "L"++newtype BLASSide = BLASSide CString+data Side = LeftSide | RightSide deriving (Eq, Show)++withSide :: Side -> (BLASSide -> IO a) -> IO a+withSide side f = flip withCString (f . BLASSide) $ case side of+    LeftSide  -> "L"+    RightSide -> "R"++newtype BLASDiag = BLASDiag CString+data Diag = NonUnit | Unit deriving (Eq, Show)++withDiag :: Diag -> (BLASDiag -> IO a) -> IO a+withDiag diag f = flip withCString (f . BLASDiag) $ case diag of+    NonUnit -> "N"+    Unit    -> "U"++newtype LAInt = LAInt CInt deriving (Eq, Show, Enum, Num, Ord, Storable)
+ lib/Foreign/BLAS/Zomplex.hsc view
@@ -0,0 +1,146 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.BLAS.Zomplex+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Foreign.BLAS.Zomplex +    where++import Data.Complex( Complex )+import Foreign+import Foreign.BLAS.Types+import Foreign.C.Types++#include "config.h"+#include "f77_func-hsc.h"+#define la_int int++---------------------------- Level 1 Routines -------------------------------++foreign import ccall unsafe #f77_func zdotu+    zdotu :: Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zdotc+    zdotc :: Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()+++foreign import ccall unsafe #f77_func dznrm2+    znrm2  :: Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO Double++foreign import ccall unsafe #f77_func dzasum+    zasum  :: Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO Double++foreign import ccall unsafe #f77_func izamax+    izamax_hidden :: Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO CInt +izamax :: Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO LAInt    +izamax a b c = do +                res <- izamax_hidden a b c +                return $! LAInt res +++foreign import ccall unsafe #f77_func zscal+    zscal  :: Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zswap+    zswap  :: Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zcopy+    zcopy  :: Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zaxpy+    zaxpy  :: Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zrotg+    zrotg  :: Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe #f77_func zdrot+    zdrot :: Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr Double -> Ptr Double -> IO ()+++---------------------------- Level 2 Routines -------------------------------++foreign import ccall unsafe #f77_func zgemv+    zgemv :: BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zgbmv+    zgbmv ::  BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func ztrmv+    ztrmv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func ztpmv+    ztpmv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func ztpsv+    ztpsv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func ztbmv+    ztbmv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()+                 +foreign import ccall unsafe #f77_func ztrsv+    ztrsv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func ztbsv+    ztbsv ::  BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()+    +foreign import ccall unsafe #f77_func zhemv+    zhemv ::  BLASUplo -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zhbmv+    zhbmv ::  BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()+    +foreign import ccall unsafe #f77_func zgeru+    zgeru  ::  Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zgerc+    zgerc  ::  Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()+        +foreign import ccall unsafe #f77_func zher+    zher  ::  BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zher2+    zher2 ::  BLASUplo -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zhpmv+    zhpmv ::  BLASUplo -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zhpr+    zhpr  ::  BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe #f77_func zhpr2+    zhpr2 ::  BLASUplo -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> IO ()+++---------------------------- Level 3 Routines -------------------------------++foreign import ccall unsafe #f77_func zgemm+    zgemm  ::  BLASTrans -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zsymm+    zsymm  ::  BLASSide -> BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zhemm+    zhemm  ::  BLASSide -> BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func ztrmm+    ztrmm  ::  BLASSide -> BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func ztrsm+    ztrsm  ::  BLASSide -> BLASUplo -> BLASTrans -> BLASDiag -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zsyrk+    zsyrk  ::  BLASUplo -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()+           +foreign import ccall unsafe #f77_func zsyr2k           +    zsyr2k ::  BLASUplo -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zherk+    zherk  ::  BLASUplo -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()+           +foreign import ccall unsafe #f77_func zher2k           +    zher2k ::  BLASUplo -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt -> IO ()
+ lib/Foreign/LAPACK.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.LAPACK+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Types with a Linear Algebra PACKage.+--+module Foreign.LAPACK (+    -- * LAPACK typeclass+    LAPACK(..),+    -- * Enums+    module Foreign.LAPACK.Types,+    ) where++import Control.Monad( forM_, when )+import Control.Exception( assert )+import Data.Complex( Complex )+import Foreign+import Foreign.BLAS+import Foreign.LAPACK.Types+import Foreign.LAPACK.Double+import Foreign.LAPACK.Zomplex+++-- | Types with LAPACK operations.+class (BLAS3 e) => LAPACK e where+    geqrf :: Int -> Int -> Ptr e -> Int -> Ptr e -> IO ()+    gelqf :: Int -> Int -> Ptr e -> Int -> Ptr e -> IO ()+    +    heevr :: EigJob -> EigRange -> Uplo -> Int -> Ptr e -> Int -> Double+          -> Ptr Double -> Ptr e -> Int -> Ptr Int -> IO Int+    +    larfg :: Int -> Ptr e -> Ptr e -> Int -> IO e+    potrf :: Uplo -> Int -> Ptr e -> Int -> IO Int+    potrs :: Uplo -> Int -> Int -> Ptr e -> Int -> Ptr e -> Int -> IO ()+    pptrf :: Uplo -> Int -> Ptr e -> IO Int+    pptrs :: Uplo -> Int -> Int -> Ptr e -> Ptr e -> Int -> IO ()+    +    unmqr :: Side -> Trans -> Int -> Int -> Int -> Ptr e -> Int -> Ptr e -> Ptr e -> Int -> IO ()+    unmlq :: Side -> Trans -> Int -> Int -> Int -> Ptr e -> Int -> Ptr e -> Ptr e -> Int -> IO ()+++callWithWork :: (Storable e) => (Ptr e -> Ptr LAInt -> Ptr LAInt -> IO ()) -> IO LAInt+callWithWork call =+    alloca $ \pquery ->+    with (-1) $ \pnone ->+    alloca $ \pinfo -> do+        call pquery pnone pinfo+        lwork <- (ceiling . max 1) `fmap` (peek (castPtr pquery) :: IO Double)+        allocaArray lwork $ \pwork ->+            withEnum lwork $ \plwork -> do+                call pwork plwork pinfo+                peek pinfo++callWithWorkIWork :: (Storable e)+    => (Ptr e -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> IO ())+    -> IO LAInt+callWithWorkIWork call =+    alloca $ \pquery ->+    alloca $ \piquery ->+    with (-1) $ \pnone ->+    alloca $ \pinfo -> do+        call pquery pnone piquery pnone pinfo+        lwork <- (ceiling . max 1) `fmap` (peek (castPtr pquery) :: IO Double)+        liwork <- max 1 `fmap` peek piquery+        allocaArray lwork $ \pwork ->+            withEnum lwork $ \plwork ->+                allocaArray (fromEnum liwork) $ \piwork ->+                    with liwork $ \pliwork -> do+                        call pwork plwork piwork pliwork pinfo+                        peek pinfo++callWithWorkRWorkIWork :: (Storable e)+    => (Ptr e -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> IO ())+    -> IO LAInt+callWithWorkRWorkIWork call =+    alloca $ \pquery ->+    alloca $ \prquery ->+    alloca $ \piquery ->+    with (-1) $ \pnone ->+    alloca $ \pinfo -> do+        call pquery pnone prquery pnone piquery pnone pinfo+        lwork <- (ceiling . max 1) `fmap` (peek (castPtr pquery) :: IO Double)+        lrwork <- (ceiling . max 1) `fmap` peek prquery+        liwork <- max 1 `fmap` peek piquery+        allocaArray lwork $ \pwork ->+            withEnum lwork $ \plwork ->+                allocaArray lrwork $ \prwork ->+                    withEnum lrwork $ \plrwork ->+                        allocaArray (fromEnum liwork) $ \piwork ->+                            with liwork $ \pliwork -> do+                                call pwork plwork prwork plrwork piwork pliwork pinfo+                                peek pinfo+++checkInfo :: (Num info,Eq info ) => info -> IO ()+checkInfo info = assert (info == 0) $ return ()++withEnum :: (Enum a, Storable a) => Int -> (Ptr a -> IO b) -> IO b+withEnum = with . toEnum+{-# INLINE withEnum #-}+        ++instance LAPACK Double where+    geqrf m n pa lda ptau =+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+            checkInfo =<< callWithWork (dgeqrf pm pn pa plda ptau)++    gelqf m n pa lda ptau =+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+            checkInfo =<< callWithWork (dgelqf pm pn pa plda ptau)++    heevr jobz range uplo n pa lda abstol pw pz ldz psuppz =+        withEigJob jobz $ \pjobz ->+        withEigRange range $ \prange pvl pvu pil piu ->+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+        with abstol $ \pabstol ->+        alloca $ \pm ->+        withEnum ldz $ \pldz -> +        allocaArray nsuppz $ \psuppz' -> do+            checkInfo =<<+                (callWithWorkIWork $+                    dsyevr pjobz prange puplo pn pa plda pvl pvu pil piu+                           pabstol pm pw pz pldz psuppz')+            m <- fromEnum `fmap` peek pm+            when (psuppz /= nullPtr) $+                forM_ [ 0..2*m - 1 ] $ \i -> do+                    s <- peekElemOff psuppz' i+                    pokeElemOff psuppz i (fromEnum s)+            return m+      where+        nsuppz = if psuppz == nullPtr then 0 else 2 * max 1 n++    unmqr side trans m n k pa lda ptau pc ldc =+        withSide side $ \pside ->+        withTrans trans $ \ptrans ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        withEnum lda $ \plda ->+        withEnum ldc $ \pldc ->+            checkInfo =<< callWithWork (dormqr pside ptrans pm pn pk pa plda ptau pc pldc)++    unmlq side trans m n k pa lda ptau pc ldc =+        withSide side $ \pside ->+        withTrans trans $ \ptrans ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        withEnum lda $ \plda ->+        withEnum ldc $ \pldc ->+            checkInfo =<< callWithWork (dormlq pside ptrans pm pn pk pa plda ptau pc pldc)++    larfg n palpha px incx = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        alloca $ \ptau -> do+            dlarfg pn palpha px pincx ptau+            peek ptau++    potrf uplo n pa lda =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+        alloca $ \pinfo -> do+            dpotrf puplo pn pa plda pinfo+            info <- fromEnum `fmap` peek pinfo+            assert (info >= 0) $ return info            ++    potrs uplo n nrhs pa lda pb ldb =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum nrhs $ \pnrhs ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        alloca $ \pinfo -> do+            dpotrs puplo pn pnrhs pa plda pb pldb pinfo+            checkInfo =<< peek pinfo++    pptrf uplo n pa =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        alloca $ \pinfo -> do+            dpptrf puplo pn pa pinfo+            info <- fromEnum `fmap` peek pinfo+            assert (info >= 0) $ return info            ++    pptrs uplo n nrhs pa pb ldb =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum nrhs $ \pnrhs ->+        withEnum ldb $ \pldb ->+        alloca $ \pinfo -> do+            dpptrs puplo pn pnrhs pa pb pldb pinfo+            checkInfo =<< peek pinfo+++instance LAPACK (Complex Double) where+    geqrf m n pa lda ptau =+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+            checkInfo =<< callWithWork (zgeqrf pm pn pa plda ptau)++    gelqf m n pa lda ptau =+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+            checkInfo =<< callWithWork (zgelqf pm pn pa plda ptau)++    heevr jobz range uplo n pa lda abstol pw pz ldz psuppz =+        withEigJob jobz $ \pjobz ->+        withEigRange range $ \prange pvl pvu pil piu ->+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+        with abstol $ \pabstol ->+        alloca $ \pm ->+        withEnum ldz $ \pldz -> +        allocaArray nsuppz $ \psuppz' -> do+            checkInfo =<<+                (callWithWorkRWorkIWork $+                    zheevr pjobz prange puplo pn pa plda pvl pvu pil piu+                           pabstol pm pw pz pldz psuppz')+            m <- fromEnum `fmap` peek pm+            when (psuppz /= nullPtr) $+                forM_ [ 0..2*m - 1 ] $ \i -> do+                    s <- peekElemOff psuppz' i+                    pokeElemOff psuppz i (fromEnum s)+            return m+      where+        nsuppz = if psuppz == nullPtr then 0 else 2 * max 1 n++    unmqr side trans m n k pa lda ptau pc ldc =+        withSide side $ \pside ->+        withTrans trans $ \ptrans ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        withEnum lda $ \plda ->+        withEnum ldc $ \pldc ->+            checkInfo =<< callWithWork (zunmqr pside ptrans pm pn pk pa plda ptau pc pldc)++    unmlq side trans m n k pa lda ptau pc ldc =+        withSide side $ \pside ->+        withTrans trans $ \ptrans ->+        withEnum m $ \pm ->+        withEnum n $ \pn ->+        withEnum k $ \pk ->+        withEnum lda $ \plda ->+        withEnum ldc $ \pldc ->+            checkInfo =<< callWithWork (zunmlq pside ptrans pm pn pk pa plda ptau pc pldc)++    larfg n palpha px incx = +        withEnum n $ \pn ->+        withEnum incx $ \pincx ->+        alloca $ \ptau -> do+            zlarfg pn palpha px pincx ptau+            peek ptau++    potrf uplo n pa lda =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum lda $ \plda ->+        alloca $ \pinfo -> do+            zpotrf puplo pn pa plda pinfo+            info <- fromEnum `fmap` peek pinfo+            assert (info >= 0) $ return info++    potrs uplo n nrhs pa lda pb ldb =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum nrhs $ \pnrhs ->+        withEnum lda $ \plda ->+        withEnum ldb $ \pldb ->+        alloca $ \pinfo -> do+            zpotrs puplo pn pnrhs pa plda pb pldb pinfo+            checkInfo =<< peek pinfo++    pptrf uplo n pa =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        alloca $ \pinfo -> do+            zpptrf puplo pn pa pinfo+            info <- fromEnum `fmap` peek pinfo+            assert (info >= 0) $ return info++    pptrs uplo n nrhs pa pb ldb =+        withUplo uplo $ \puplo ->+        withEnum n $ \pn ->+        withEnum nrhs $ \pnrhs ->+        withEnum ldb $ \pldb ->+        alloca $ \pinfo -> do+            zpptrs puplo pn pnrhs pa pb pldb pinfo+            checkInfo =<< peek pinfo
+ lib/Foreign/LAPACK/Double.hsc view
@@ -0,0 +1,64 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.LAPACK.Double+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Foreign.LAPACK.Double+    where++import Foreign( Ptr )+import Foreign.BLAS.Types+import Foreign.LAPACK.Types++#include "f77_func-hsc.h"+++foreign import ccall unsafe #f77_func dgeqrf+    dgeqrf :: Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double+           -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dgelqf+    dgelqf :: Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double+           -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dlarfg+    dlarfg :: Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr Double+           -> IO ()++foreign import ccall unsafe #f77_func dormqr+    dormqr :: BLASSide -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt+           -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt+           -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dormlq+    dormlq :: BLASSide -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt+           -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt+           -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dpotrf+    dpotrf :: BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr LAInt+           -> IO ()+           +foreign import ccall unsafe #f77_func dpotrs+    dpotrs :: BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr LAInt+           -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dpptrf+    dpptrf :: BLASUplo -> Ptr LAInt -> Ptr Double -> Ptr LAInt+           -> IO ()+           +foreign import ccall unsafe #f77_func dpptrs+    dpptrs :: BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr Double+           -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func dsyevr+    dsyevr :: LAEigJob -> LAEigRange -> BLASUplo -> Ptr LAInt -> Ptr Double+           -> Ptr LAInt ->  Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr LAInt+           -> Ptr Double -> Ptr LAInt -> Ptr Double -> Ptr Double -> Ptr LAInt+           -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt+           -> Ptr LAInt -> IO ()
+ lib/Foreign/LAPACK/Types.hs view
@@ -0,0 +1,76 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.LAPACK.Types+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Foreign.LAPACK.Types (+    LAEigJob(..),+    EigJob(..),+    withEigJob,+    +    LAEigRange(..),+    EigRange(..),+    withEigRange,+    +    ) where++import Foreign+import Foreign.C.String++import Foreign.BLAS.Types( LAInt )++newtype LAEigJob = LAEigJob CString++-- | A type of eigenvalue computation.+data EigJob = NoEigVectors -- ^ no eigenvectors (eigenvalues only)+            | EigVectors   -- ^ eigenvalues and eigenvectors+    deriving (Eq, Show)++withEigJob :: EigJob -> (LAEigJob -> IO a) -> IO a+withEigJob evjob f = flip withCString (f . LAEigJob) $ case evjob of+    NoEigVectors -> "N"+    EigVectors   -> "V"++newtype LAEigRange = LAEigRange CString++-- | A range of eigenvalues to compute.+data EigRange = AllEigs                       -- ^ All eigenvalues are computed+              | EigValueRange !Double !Double -- ^ Eigenvalues in the half-open+                                              --   interval @(vl,vu]@ are+                                              --   computed+              | EigIndexRange !Int    !Int    -- ^ Eigenvalues with indices in+                                              --   the closed interval+                                              --   @[il,iu]@ are computed.+                                              --   Index @0@ corresponds to+                                              --   the smallest eigenvalue.+    deriving (Eq, Show)+             +withEigRange :: EigRange+             -> (LAEigRange -> Ptr Double -> Ptr Double -> Ptr LAInt -> Ptr LAInt -> IO a)+             -> IO a+withEigRange eigrange f = case eigrange of+    AllEigs ->+        withCString "A" $ \pA ->+        alloca $ \pvl ->+        alloca $ \pvu ->+        alloca $ \pil ->+        alloca $ \piu ->+            f (LAEigRange pA) pvl pvu pil piu+    EigValueRange vl vu ->+        withCString "V" $ \pV ->+        with vl $ \pvl ->+        with vu $ \pvu ->+        alloca $ \pil ->+        alloca $ \piu ->+            f (LAEigRange pV) pvl pvu pil piu+    EigIndexRange il iu ->+        withCString "I" $ \pI ->+        alloca $ \pvl ->+        alloca $ \pvu ->+        with (toEnum $ il + 1) $ \pil ->+        with (toEnum $ iu + 1) $ \piu ->+            f (LAEigRange pI) pvl pvu pil piu
+ lib/Foreign/LAPACK/Zomplex.hsc view
@@ -0,0 +1,74 @@+{-# LANGUAGE  ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.LAPACK.Zomplex+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Foreign.LAPACK.Zomplex+    where++import Data.Complex( Complex )+import Foreign( Ptr )+import Foreign.BLAS.Types+import Foreign.LAPACK.Types++#include "f77_func-hsc.h"+++foreign import ccall unsafe #f77_func zgeqrf+    zgeqrf :: Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double)+           -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double)+           -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zgelqf+    zgelqf :: Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double)+           -> Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double)+           -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zheevr+    zheevr :: LAEigJob -> LAEigRange -> BLASUplo -> Ptr LAInt+           -> Ptr (Complex Double) -> Ptr LAInt -> Ptr Double -> Ptr Double+           -> Ptr LAInt -> Ptr LAInt -> Ptr Double -> Ptr LAInt -> Ptr Double+           -> Ptr (Complex Double) -> Ptr LAInt -> Ptr LAInt+           -> Ptr (Complex Double) -> Ptr LAInt -> Ptr Double -> Ptr LAInt+           -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt -> IO ()++foreign import ccall unsafe #f77_func zlarfg+    zlarfg :: Ptr LAInt -> Ptr (Complex Double) -> Ptr (Complex Double)+           -> Ptr LAInt -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe #f77_func zpotrf+    zpotrf :: BLASUplo -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt+           -> Ptr LAInt -> IO ()+           +foreign import ccall unsafe #f77_func zpotrs+    zpotrs :: BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double)+           -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt -> Ptr LAInt+           -> IO ()++foreign import ccall unsafe #f77_func zpptrf+    zpptrf :: BLASUplo -> Ptr LAInt -> Ptr (Complex Double)+           -> Ptr LAInt -> IO ()+           +foreign import ccall unsafe #f77_func zpptrs+    zpptrs :: BLASUplo -> Ptr LAInt -> Ptr LAInt -> Ptr (Complex Double)+           -> Ptr (Complex Double) -> Ptr LAInt -> Ptr LAInt+           -> IO ()++foreign import ccall unsafe #f77_func zunmqr+    zunmqr :: BLASSide -> BLASTrans -> Ptr LAInt -> Ptr LAInt+           -> Ptr LAInt -> Ptr (Complex Double) -> Ptr LAInt+           -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr LAInt+           -> Ptr (Complex Double) -> Ptr LAInt -> Ptr LAInt+           -> IO ()++foreign import ccall unsafe #f77_func zunmlq+    zunmlq :: BLASSide -> BLASTrans -> Ptr LAInt -> Ptr LAInt -> Ptr LAInt+           -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double)+           -> Ptr (Complex Double) -> Ptr LAInt -> Ptr (Complex Double)+           -> Ptr LAInt -> Ptr LAInt -> IO ()+
+ lib/Foreign/VMath.hs view
@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.VMath+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Vector math operations.+--++module Foreign.VMath (+    -- * Vector Math typeclasses+    module Foreign.VMath.VNum,+    module Foreign.VMath.VFractional,    +    module Foreign.VMath.VFloating    +    ) where++import Foreign.VMath.VNum+import Foreign.VMath.VFractional+import Foreign.VMath.VFloating
+ lib/Foreign/VMath/Double.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# CFILES cbits/vmath-double.c #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.VMath.Double+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Foreign.VMath.Double+    where+        +import Foreign.Ptr( Ptr )++---------------------------- Vector Routines --------------------------------++foreign import ccall unsafe "vdShift"+    vdShift :: Int -> Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdAdd"+    vdAdd :: Int -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdSub"+    vdSub :: Int -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdAxpby"+    vdAxpby :: Int -> Double -> Ptr Double -> Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdScale"+    vdScale :: Int -> Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdMul"+    vdMul :: Int -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdNeg"+    vdNeg :: Int -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdAbs"+    vdAbs :: Int -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdSgn"+    vdSgn :: Int -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdInv"+    vdInv :: Int -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdDiv"+    vdDiv :: Int -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "vdExp"+    vdExp :: Int -> Ptr Double -> Ptr Double -> IO ()+    +foreign import ccall unsafe "vdSqrt"    +    vdSqrt :: Int -> Ptr Double -> Ptr Double -> IO ()+    +foreign import ccall unsafe "vdLog"+    vdLog :: Int -> Ptr Double -> Ptr Double -> IO ()+    +foreign import ccall unsafe "vdPow"+    vdPow :: Int -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()            +    +foreign import ccall unsafe "vdSin"+    vdSin :: Int -> Ptr Double -> Ptr Double -> IO ()                +    +foreign import ccall unsafe "vdCos"+    vdCos :: Int -> Ptr Double -> Ptr Double -> IO ()+    +foreign import ccall unsafe "vdTan"    +    vdTan :: Int -> Ptr Double -> Ptr Double -> IO ()                        ++foreign import ccall unsafe "vdASin"+    vdASin :: Int -> Ptr Double -> Ptr Double -> IO ()                +    +foreign import ccall unsafe "vdACos"+    vdACos :: Int -> Ptr Double -> Ptr Double -> IO ()+    +foreign import ccall unsafe "vdATan"    +    vdATan :: Int -> Ptr Double -> Ptr Double -> IO ()                        ++foreign import ccall unsafe "vdSinh"+    vdSinh :: Int -> Ptr Double -> Ptr Double -> IO ()                +    +foreign import ccall unsafe "vdCosh"+    vdCosh :: Int -> Ptr Double -> Ptr Double -> IO ()+    +foreign import ccall unsafe "vdTanh"    +    vdTanh :: Int -> Ptr Double -> Ptr Double -> IO ()                        ++foreign import ccall unsafe "vdASinh"+    vdASinh :: Int -> Ptr Double -> Ptr Double -> IO ()                +    +foreign import ccall unsafe "vdACosh"+    vdACosh :: Int -> Ptr Double -> Ptr Double -> IO ()+    +foreign import ccall unsafe "vdATanh"    +    vdATanh :: Int -> Ptr Double -> Ptr Double -> IO ()                        ++
+ lib/Foreign/VMath/VFloating.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.VMath.VFloating+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Vector Floating operations.+--++module Foreign.VMath.VFloating (+    VFloating(..)+    ) where+     +import Foreign( Ptr, Storable, peek, poke, advancePtr )+import Data.Complex( Complex(..) )++import Foreign.VMath.VFractional+import Foreign.VMath.Double  +import Foreign.VMath.Zomplex++-- | Types with vectorized 'Floating' operations.+class (VFractional a, Floating a) => VFloating a where+    vExp :: Int -> Ptr a -> Ptr a -> IO ()+    vSqrt :: Int -> Ptr a -> Ptr a -> IO ()+    vLog :: Int -> Ptr a -> Ptr a -> IO ()        +    vPow :: Int -> Ptr a -> Ptr a -> Ptr a -> IO ()            +    vSin :: Int -> Ptr a -> Ptr a -> IO ()                +    vCos :: Int -> Ptr a -> Ptr a -> IO ()                    +    vTan :: Int -> Ptr a -> Ptr a -> IO ()                        +    vASin :: Int -> Ptr a -> Ptr a -> IO ()                +    vACos :: Int -> Ptr a -> Ptr a -> IO ()                    +    vATan :: Int -> Ptr a -> Ptr a -> IO ()                        +    vSinh :: Int -> Ptr a -> Ptr a -> IO ()                +    vCosh :: Int -> Ptr a -> Ptr a -> IO ()                    +    vTanh :: Int -> Ptr a -> Ptr a -> IO ()                        +    vASinh :: Int -> Ptr a -> Ptr a -> IO ()                +    vACosh :: Int -> Ptr a -> Ptr a -> IO ()                    +    vATanh :: Int -> Ptr a -> Ptr a -> IO ()++    vExp = vop exp+    vSqrt = vop sqrt+    vLog = vop log+    vPow = vop2 (**)+    vSin = vop sin+    vCos = vop cos+    vTan = vop tan+    vASin = vop asin+    vACos = vop acos+    vATan = vop atan+    vSinh = vop sinh+    vCosh = vop cosh+    vTanh = vop tanh+    vASinh = vop asinh+    vACosh = vop acosh+    vATanh = vop atanh+    +    +vop :: (Storable a, Storable b)+    => (a -> b) -> Int -> Ptr a -> Ptr b -> IO ()+vop f n src dst | n <= 0    = return ()+                | otherwise = do+    a <- peek src+    poke dst $ f a+    vop f (n-1) (src `advancePtr` 1) (dst `advancePtr` 1)+{-# INLINE vop #-}++vop2 :: (Storable a1, Storable a2, Storable b)+     => (a1 -> a2 -> b) -> Int -> Ptr a1 -> Ptr a2 -> Ptr b -> IO ()+vop2 f n src1 src2 dst | n <= 0    = return ()+                       | otherwise = do+    a1 <- peek src1+    a2 <- peek src2+    poke dst $ f a1 a2+    vop2 f (n-1) (src1 `advancePtr` 1) (src2 `advancePtr` 1)+         (dst `advancePtr` 1)+{-# INLINE vop2 #-}+    +instance VFloating Double where+    vExp = vdExp+    {-# INLINE vExp #-}+    vSqrt = vdSqrt+    {-# INLINE vSqrt #-}+    vLog = vdLog+    {-# INLINE vLog #-}+    vPow = vdPow+    {-# INLINE vPow #-}+    vSin = vdSin+    {-# INLINE vSin #-}+    vCos = vdCos+    {-# INLINE vCos #-}+    vTan = vdTan+    {-# INLINE vTan #-}+    vASin = vdASin+    {-# INLINE vASin #-}+    vACos = vdACos+    {-# INLINE vACos #-}+    vATan = vdATan+    {-# INLINE vATan #-}+    vSinh = vdSinh+    {-# INLINE vSinh #-}+    vCosh = vdCosh+    {-# INLINE vCosh #-}+    vTanh = vdTanh+    {-# INLINE vTanh #-}+    vASinh = vdASinh+    {-# INLINE vASinh #-}+    vACosh = vdACosh+    {-# INLINE vACosh #-}+    vATanh = vdATanh+    {-# INLINE vATanh #-}+++instance VFloating (Complex Double) where+    vSqrt = vzSqrt+    {-# INLINE vSqrt #-}+    vLog = vzLog+    {-# INLINE vLog #-}+    +    {- These functions have branch cuts in the wrong places +    vExp = vzExp+    {-# INLINE vExp #-}+    vPow = vzPow+    {-# INLINE vPow #-}+    vSin = vzSin+    {-# INLINE vSin #-}+    vCos = vzCos+    {-# INLINE vCos #-}+    vTan = vzTan+    {-# INLINE vTan #-}+    vASin = vzASin+    {-# INLINE vASin #-}+    vACos = vzACos+    {-# INLINE vACos #-}+    vATan = vzATan+    {-# INLINE vATan #-}+    vSinh = vzSinh+    {-# INLINE vSinh #-}+    vCosh = vzCosh+    {-# INLINE vCosh #-}+    vTanh = vzTanh+    {-# INLINE vTanh #-}+    vASinh = vzASinh+    {-# INLINE vASinh #-}+    vACosh = vzACosh+    {-# INLINE vACosh #-}+    vATanh = vzATanh+    {-# INLINE vATanh #-}+    -}
+ lib/Foreign/VMath/VFractional.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.VMath.VFractional+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Vector Fractional operations.+--++module Foreign.VMath.VFractional+    where+     +import Foreign( Ptr )+import Data.Complex( Complex(..) )++import Foreign.VMath.VNum+import Foreign.VMath.Double  +import Foreign.VMath.Zomplex+        +-- | Types with vectorized 'Fractional' operations.+class (VNum a, Fractional a) => VFractional a where+    vInv :: Int -> Ptr a -> Ptr a -> IO ()    +    vDiv :: Int -> Ptr a -> Ptr a -> Ptr a -> IO ()++instance VFractional Double where+    vInv = vdInv+    {-# INLINE vInv #-}+    vDiv = vdDiv+    {-# INLINE vDiv #-}++instance VFractional (Complex Double) where+    vInv = vzInv+    {-# INLINE vInv #-}+    vDiv = vzDiv+    {-# INLINE vDiv #-}
+ lib/Foreign/VMath/VNum.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleInstances, BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.VMath.VNum+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Vector Num operations.+--++module Foreign.VMath.VNum+    where+     +import Foreign( Storable, Ptr, with, )+import Foreign.Storable.Complex()+import Data.Complex( Complex(..) )++import Foreign.BLAS.Double( dcopy )+import Foreign.VMath.Double+import Foreign.VMath.Zomplex+        +-- | Types with vectorized 'Num' operations.+class (Storable a, Num a) => VNum a where+    vShift :: Int -> a -> Ptr a -> Ptr a -> IO ()        +    vAdd :: Int -> Ptr a -> Ptr a -> Ptr a -> IO ()+    vSub :: Int -> Ptr a -> Ptr a -> Ptr a -> IO ()+    vAxpby :: Int -> a -> Ptr a -> a -> Ptr a -> Ptr a -> IO ()++    vScale :: Int -> a -> Ptr a -> Ptr a -> IO ()    +    vMul :: Int -> Ptr a -> Ptr a -> Ptr a -> IO ()++    vConj :: Int -> Ptr a -> Ptr a -> IO ()    +    vNeg :: Int -> Ptr a -> Ptr a -> IO ()+    vAbs :: Int -> Ptr a -> Ptr a -> IO ()+    vSgn :: Int -> Ptr a -> Ptr a -> IO ()+++instance VNum Double where+    vShift = vdShift    +    {-# INLINE vShift #-}+    vAdd = vdAdd+    {-# INLINE vAdd #-}+    vSub = vdSub+    {-# INLINE vSub #-}+    vAxpby = vdAxpby+    {-# INLINE vAxpby #-}+    vScale = vdScale+    {-# INLINE vScale #-}+    vMul = vdMul+    {-# INLINE vMul #-}+    vConj n src dst = +        with (toEnum n) $ \pn ->+        with 1 $ \pone ->+            dcopy pn src pone dst pone+    {-# INLINE vConj #-}+    vNeg = vdNeg+    {-# INLINE vNeg #-}+    vAbs = vdAbs+    {-# INLINE vAbs #-}+    vSgn = vdSgn+    {-# INLINE vSgn #-}++instance VNum (Complex Double) where+    vShift n alpha pX pZ = with alpha $ \pAlpha ->+        vzShift n pAlpha pX pZ+    {-# INLINE vShift #-}+    vAdd = vzAdd+    {-# INLINE vAdd #-}+    vSub = vzSub+    {-# INLINE vSub #-}+    vAxpby n alpha pX beta pY pZ =+        with alpha $ \pAlpha ->+        with beta $ \pBeta ->+            vzAxpby n pAlpha pX pBeta pY pZ+    {-# INLINE vAxpby #-}+    vScale n alpha pX pZ = with alpha $ \pAlpha ->+        vzScale n pAlpha pX pZ+    {-# INLINE vScale #-}+    vMul = vzMul+    {-# INLINE vMul #-}+    vConj = vzConj+    {-# INLINE vConj #-}+    vNeg = vzNeg+    {-# INLINE vNeg #-}+    vAbs = vzAbs+    {-# INLINE vAbs #-}+    vSgn = vzSgn+    {-# INLINE vSgn #-}
+ lib/Foreign/VMath/Zomplex.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# CFILES cbits/vmath-zomplex.c #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Foreign.VMath.Zomplex+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Foreign.VMath.Zomplex+    where+        +import Data.Complex ( Complex )+import Foreign.Ptr  ( Ptr )++foreign import ccall unsafe "vzConj"+    vzConj :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzShift"+    vzShift :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzAdd"+    vzAdd :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzSub"+    vzSub :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzAxpby"+    vzAxpby :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzScale"+    vzScale :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzMul"+    vzMul :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzNeg"+    vzNeg :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzAbs"+    vzAbs :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzSgn"+    vzSgn :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzInv"+    vzInv :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzDiv"+    vzDiv :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "vzExp"+    vzExp :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()+    +foreign import ccall unsafe "vzSqrt"    +    vzSqrt :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()+    +foreign import ccall unsafe "vzLog"+    vzLog :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()+    +foreign import ccall unsafe "vzPow"+    vzPow :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()            +    +foreign import ccall unsafe "vzSin"+    vzSin :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()                +    +foreign import ccall unsafe "vzCos"+    vzCos :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()+    +foreign import ccall unsafe "vzTan"    +    vzTan :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()                        ++foreign import ccall unsafe "vzASin"+    vzASin :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()                +    +foreign import ccall unsafe "vzACos"+    vzACos :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()+    +foreign import ccall unsafe "vzATan"    +    vzATan :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()                        ++foreign import ccall unsafe "vzSinh"+    vzSinh :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()                +    +foreign import ccall unsafe "vzCosh"+    vzCosh :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()+    +foreign import ccall unsafe "vzTanh"    +    vzTanh :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()                        ++foreign import ccall unsafe "vzASinh"+    vzASinh :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()                +    +foreign import ccall unsafe "vzACosh"+    vzACosh :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()+    +foreign import ccall unsafe "vzATanh"    +    vzATanh :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()                        +
+ lib/Numeric/LinearAlgebra.hs view
@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Linear algebra types and operations+--++module Numeric.LinearAlgebra (+    -- * Vector types+    Vector,+    RVector,+    STVector,+    IOVector,+    +    -- * Matrix types+    Matrix,+    RMatrix,+    STMatrix,+    IOMatrix,+    +    -- * Packed matrix types+    Packed,+    RPacked,+    STPacked,+    IOPacked,+    +    module Numeric.LinearAlgebra.Types,+    ) where++import Numeric.LinearAlgebra.Types+import Numeric.LinearAlgebra.Vector( Vector, RVector, STVector, IOVector )+import Numeric.LinearAlgebra.Matrix( Matrix, RMatrix, STMatrix, IOMatrix )+import Numeric.LinearAlgebra.Packed( Packed, RPacked, STPacked, IOPacked )
+ lib/Numeric/LinearAlgebra/Internal.hs view
@@ -0,0 +1,271 @@+{-# LANGUAGE CPP, ForeignFunctionInterface, MagicHash #-}++{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Internal+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+++module Numeric.LinearAlgebra.Internal (+    clearArray,+    bzero,+    inlinePerformIO,+    checkedRow,+    checkedCol,+    checkedDiag,+    checkedSubmatrix,+    checkMatMatOp,+    checkMatVecMult,+    checkMatMatMult,+    checkMatVecMultAdd,+    checkMatMatMultAdd,+    checkMatVecSolv,+    checkMatMatSolv,+    checkMatVecSolvTo,+    checkMatMatSolvTo,+    checkSquare,+    checkFat,+    checkTall,+    checkBinaryOp,+    checkTernaryOp,+    diagStart,+    diagLen,    +    ) where+++import Foreign                  ( Ptr, Storable(..), castPtr, sizeOf )+import Foreign.C.Types          ( CSize(..) )+import Text.Printf ( printf )+++#if defined(__GLASGOW_HASKELL__)+import GHC.IO                   ( unsafeDupablePerformIO )+#else+import System.IO.Unsafe         ( unsafePerformIO )+#endif+++clearArray :: Storable e => Ptr e -> Int -> IO ()+clearArray = clearArray' undefined+    where+    clearArray' :: Storable e => e -> Ptr e -> Int -> IO ()+    clearArray' e ptr n =+        let nbytes = fromIntegral (n * sizeOf e)+        in do+            bzero ptr nbytes+{-# INLINE clearArray #-}+++bzero :: Ptr a -> Int -> IO ()+bzero ptr n =+    let ptr' = castPtr ptr+        n'   = fromIntegral n+    in bzero_ ptr' n'+        +foreign import ccall "strings.h bzero"+    bzero_ :: Ptr () -> CSize -> IO ()+    ++inlinePerformIO :: IO a -> a+#if defined(__GLASGOW_HASKELL__)+inlinePerformIO a = unsafeDupablePerformIO a+#else+inlinePerformIO = unsafePerformIO+#endif+{-# INLINE inlinePerformIO #-}++checkedRow ::  (Int,Int) -> (Int -> v) -> Int -> v+checkedRow (m,n) row i +    | i < 0 || i >= m =+        error $ printf+            "Error in row index.  Tried to get row `%d' in a matrix with shape `(%d,%d)'" i m n+    | otherwise =+        row i++checkedCol :: (Int,Int) -> (Int -> v) -> Int -> v+checkedCol (m,n) col j +    | j < 0 || j >= n =+        error $ printf+            "Error in column index.  Tried to get column `%d' in a matrix with shape `(%d,%d)'" j m n+    | otherwise =+        col j++checkedDiag :: (Int,Int) -> (Int -> v) ->  Int -> v+checkedDiag (m,n) diag i+    | i < 0 && negate i >= m =+        error $ printf+            "Tried to get sub-diagonal `%d' of a matrix with shape `(%d,%d)'" (negate i) m n+    | i > 0 && i >= n =+        error $ printf+            "Tried to get super-diagonal `%d' of a matrix with shape `(%d,%d)'" i m n        +    | otherwise = +        diag i++diagStart :: Int -> (Int,Int)+diagStart i+    | i <= 0 =+        (negate i, 0)+    | otherwise =+        (0, i)+        +diagLen :: (Int,Int) -> Int -> Int+diagLen (m,n) i+    | m <= n =+        if i <= 0 +            then max (m + i) 0+            else min (n - i) m+    | otherwise =+        if i > 0+            then max (n - i) 0+            else min (m + i) n++checkedSubmatrix :: (Int,Int) -> ((Int,Int) -> (Int,Int) -> a) -> (Int,Int) -> (Int,Int) -> a+checkedSubmatrix (m,n) sub (i,j) (m',n')+    | or [ i < 0, m' < 0, i + m' > m, +           j < 0, n' < 0, j + n' > n ] =+        error $ printf ("tried to create submatrix of a `(%d,%d)' matrix " +++                        " using offset `(%d,%d)' and shape (%d,%d)") m n i j m' n'+    | otherwise =+        sub (i,j) (m',n')+++checkMatMatOp :: String -> (Int,Int) -> (Int,Int) -> a -> a+checkMatMatOp name mn1 mn2+    | mn1 /= mn2 =+        error $ printf+            ("%s: x and y have different shapes.  x has shape `%s',"+             ++ " and y has shape `%s'") name (show mn1) (show mn2)+    | otherwise = id+        +checkMatVecMult :: (Int,Int) -> Int -> a -> a+checkMatVecMult mn n+    | snd mn /= n =+        error $ printf+            ("Tried to multiply a matrix with shape `%s' by a vector of dimension `%d'")+            (show mn) n+    | otherwise = id+        +checkMatMatMult :: (Int,Int) -> (Int,Int) -> a -> a+checkMatMatMult mk kn+    | snd mk /= fst kn =+        error $ printf+            ("Tried to multiply a matrix with shape `%s' by a matrix with shape `%s'")+            (show mk) (show kn)+    | otherwise = id++checkMatVecMultAdd :: (Int,Int) -> Int -> Int -> a -> a+checkMatVecMultAdd mn n m+    | snd mn /= n =+        error $ printf+            ("Tried to multiply a matrix with shape `%s' by a vector of dimension `%d'")+            (show mn) n+    | fst mn /= m =+        error $ printf+            ("Tried to add a vector of dimension `%d' to a vector of dimension `%d'")+            (fst mn) m+    | otherwise = id++checkMatMatMultAdd :: (Int,Int) -> (Int,Int) -> (Int,Int) -> a -> a+checkMatMatMultAdd mk kn mn+    | snd mk /= fst kn =+        error $ printf+            ("Tried to multiply a matrix with shape `%s' by a matrix with shape `%s'")+            (show mk) (show kn)+    | (fst mk, snd kn) /= mn =+        error $ printf+            ("Tried to add a matrix with shape `%s' to a matrix with shape `%s'")+            (show (fst mk, snd kn)) (show mn)+    | otherwise = id++checkMatVecSolv :: (Int,Int) -> Int -> a -> a+checkMatVecSolv mn m+    | fst mn /= m =+        error $ printf+            ("Tried to solve a matrix with shape `%s' for a vector of dimension `%d'")+            (show mn) m+    | otherwise = id++checkMatVecSolvTo :: (Int,Int) -> Int -> Int -> a -> a+checkMatVecSolvTo mn m n+    | fst mn /= m =+        error $ printf+            ("Tried to solve a matrix with shape `%s' for a vector of dimension `%d'")+            (show mn) m+    | snd mn /= n =+        error $ printf+            ("Tried to store a vector of dimension `%s' in a vector of dimension `%d'")+            (show $ snd mn) n+    | otherwise = id++checkMatMatSolv :: (Int,Int) -> (Int,Int) -> a -> a+checkMatMatSolv mn mk+    | fst mn /= fst mk =+        error $ printf+            ("Tried to solve a matrix with shape `%s' for a matrix with shape `%s'")+            (show mn) (show mk)+    | otherwise = id++checkMatMatSolvTo :: (Int,Int) -> (Int,Int) -> (Int,Int) -> a -> a+checkMatMatSolvTo mk mn kn+    | fst mn /= fst mk =+        error $ printf+            ("Tried to solve a matrix with shape `%s' for a matrix with shape `%s'")+            (show mk) (show mn)+    | kn /= (snd mk, snd mn) =+        error $ printf+            ("Tried to store a matrix with shape `%s' in a matrix with shape `%s'")+            (show (snd mk, snd mn)) (show kn)+    | otherwise = id++checkSquare :: String -> (Int,Int) -> a -> a+checkSquare str (m,n)+    | m /= n =+        error $ printf+            "%s <matrix of shape (%d,%d)>: matrix shape must be square."+            str m n+    | otherwise = id++checkFat :: String -> (Int,Int) -> a -> a+checkFat str (m,n)+    | m > n =+        error $ printf+            "%s <matrix of shape (%d,%d)>: matrix must have at least as many columns as rows."+            str m n+    | otherwise = id++checkTall :: String -> (Int,Int) -> a -> a+checkTall str (m,n)+    | m < n =+        error $ printf+            "%s <matrix of shape (%d,%d)>: matrix must have at least as many rows as columns."+            str m n+    | otherwise = id++checkBinaryOp :: (Eq i, Show i) => i -> i -> a -> a+checkBinaryOp m n+    | m /= n =+        error $ printf+            ("Shapes in binary operation do not match. "+            ++ " First operand has shape `%s' and second has shapw `%s'.")+            (show m)+            (show n)+    | otherwise = id+{-# INLINE checkBinaryOp #-}++checkTernaryOp :: (Eq i, Show i) => i -> i -> i -> a -> a+checkTernaryOp l m n+    | l == m && l == n = id+    | otherwise =+        error $ printf+            ("Shapes in ternary operation do not match. "+            ++ " First operand has shape `%s', second has shapw `%s',"+            ++ " and third has shape `%s'.")+            (show l)+            (show m)+            (show n)+{-# INLINE checkTernaryOp #-}
+ lib/Numeric/LinearAlgebra/Matrix.hs view
@@ -0,0 +1,421 @@+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Immutable dense matrices.++module Numeric.LinearAlgebra.Matrix (+    -- * Immutable matrices+    Matrix,+    dim,++    -- * Matrix construction+    fromList,+    fromCols,+    fromRows,+    constant,+    zero,++    -- * Accessing matrices+    at,+    indices,+    elems,+    assocs,++    -- * Incremental matrix updates+    update,+    unsafeUpdate,+    accum,+    unsafeAccum,++    -- * Derived matrices+    map,+    zipWith,++    -- * Matrix views+    slice,+    takeRows,+    dropRows,+    splitRowsAt,+    takeCols,+    dropCols,+    splitColsAt,++    -- * Matrix rows and columns+    col,+    cols,+    row,+    rows,+    +    -- * Matrix diagonals+    diag,+    +    -- * Conversions to vectors+    toVector,+    +    -- * Conversions from vectors+    fromVector,+    fromCol,+    fromRow,++    -- * Matrix math operations+    shiftDiag,+    shiftDiagWithScale,    +    add,+    addWithScale,+    sub,+    scale,+    scaleRows,+    scaleCols,+    negate,+    conjugate,++    -- * Linear algebra+    trans,+    conjTrans,+    rank1Update,+    +    -- ** Matrix-Vector multiplication+    mulVector,+    mulVectorWithScale,+    addMulVectorWithScales,+    +    -- ** Matrix-Matrix multiplication+    mulMatrix,+    mulMatrixWithScale,+    addMulMatrixWithScales,++    -- * Conversions between foreign pointers+    unsafeFromForeignPtr,+    unsafeToForeignPtr,++    -- * Mutable interface+    module Numeric.LinearAlgebra.Matrix.ST,+    +    -- * Hermitian views+    module Numeric.LinearAlgebra.Matrix.Herm,+    +    -- * Triangular views+    module Numeric.LinearAlgebra.Matrix.Tri,+    +    -- * Cholesky factorizations+    module Numeric.LinearAlgebra.Matrix.Cholesky,+    +    -- * Eigenvalues and eigenvectors+    module Numeric.LinearAlgebra.Matrix.Eigen,++    -- * Basic multivariate statistics+    module Numeric.LinearAlgebra.Matrix.Statistics,++    ) where++import Prelude hiding ( map, zipWith, negate, )+import Control.Monad( zipWithM_ )+import Control.Monad.ST( ST )+import Foreign( Storable )+import Text.Printf( printf )++import Foreign.BLAS( BLAS1, BLAS2, BLAS3, Trans(..) )+import Foreign.VMath( VNum )+++import Numeric.LinearAlgebra.Matrix.Base+import Numeric.LinearAlgebra.Matrix.Herm+import Numeric.LinearAlgebra.Matrix.Tri+import Numeric.LinearAlgebra.Matrix.ST+import Numeric.LinearAlgebra.Matrix.Cholesky+import Numeric.LinearAlgebra.Matrix.Eigen+import Numeric.LinearAlgebra.Matrix.Statistics+import Numeric.LinearAlgebra.Vector( Vector )+import qualified Numeric.LinearAlgebra.Vector as V+++infixl 7 `scale`, `scaleRows`, `scaleCols`+infixl 6 `add`, `shiftDiag`, `sub`+++-- | Create a matrix of the given dimension with the given vectors as+-- columns.+fromCols :: (Storable e) => (Int,Int) -> [Vector e] -> Matrix e+fromCols mn cs = create $ do+    a <- new_ mn+    withColsM a $ \cs' -> zipWithM_ V.copyTo cs' cs+    return a++-- | Create a matrix of the given dimension with the given vectors as+-- rows.+fromRows :: (Storable e) => (Int,Int) -> [Vector e] -> Matrix e+fromRows (m,n) rs = create $ do+    a <- new_ (m,n)+    sequence_ [ setRow a i r | (i,r) <- zip [ 0..m-1 ] rs ]+    return a++-- | Get the given row of the matrix.+row :: (BLAS1 e) => Matrix e -> Int -> Vector e+row a i+    | i < 0 || i >= m = error $+        printf ("row <matrix with dim (%d,%d)> %d:"+                ++ " index out of range") m n i+    | otherwise =+        unsafeRow a i+  where+    (m,n) = dim a+{-# INLINE row #-}++-- | Version of 'row' that doesn't range-check indices.+unsafeRow :: (BLAS1 e) => Matrix e -> Int -> Vector e+unsafeRow a@(Matrix v _ n lda) i+    | lda == 1 = v+    | otherwise = V.create $ do+        r <- V.new_ n+        unsafeRowTo r a i+        return r++-- | Get a list of the rows in a matrix+rows :: (BLAS1 e) => Matrix e -> [Vector e]+rows a = [ unsafeRow a i | i <- [ 0..m-1 ] ]+  where+    (m,_) = dim a+++-- | Get the diagonal of the matrix.+diag :: (Storable e) => Matrix e -> Vector e+diag a = V.create $ do+    x <- V.new_ mn+    diagTo x a+    return x+  where+    (m,n) = dim a+    mn = min m n++-- | @shiftDiag d a@ returns @diag(d) + a@.+shiftDiag :: (BLAS1 e) => Vector e -> Matrix e -> Matrix e+shiftDiag s a = create $ do+    a' <- newCopy a+    shiftDiagM_ s a'+    return a'++-- | @shiftDiagWithScale alpha d a@ returns @alpha * diag(d) + a@.+shiftDiagWithScale :: (BLAS1 e) => e -> Vector e -> Matrix e -> Matrix e+shiftDiagWithScale e s a = create $ do+    a' <- newCopy a+    shiftDiagWithScaleM_ e s a'+    return a'++-- | @add a b@ returns @a + b@.+add :: (VNum e) => Matrix e -> Matrix e -> Matrix e+add = result2 addTo++-- | @sub a b@ returns @a - b@.+sub :: (VNum e) => Matrix e -> Matrix e -> Matrix e+sub = result2 subTo++-- | @scale k a@ returns @k * a@.+scale :: (BLAS1 e) => e -> Matrix e -> Matrix e+scale k a = create $ do+    a' <- newCopy a+    scaleM_ k a'+    return a'++-- | @addWithScale alpha x y@ returns @alpha * x + y@.+addWithScale :: (BLAS1 e) => e -> Matrix e -> Matrix e -> Matrix e+addWithScale alpha x y = create $ do+    y' <- newCopy y+    addWithScaleM_ alpha x y'+    return y'++-- | @scaleRows s a@ returns @diag(s) * a@.+scaleRows :: (BLAS1 e) => Vector e -> Matrix e -> Matrix e+scaleRows s a = create $ do+    a' <- newCopy a+    scaleRowsM_ s a'+    return a'++-- | @scaleCols s a@ returns @a * diag(s)@.+scaleCols :: (BLAS1 e) => Vector e -> Matrix e -> Matrix e+scaleCols s a = create $ do+    a' <- newCopy a+    scaleColsM_ s a'+    return a'++-- | @negate a@ returns @-a@.+negate :: (VNum e) => Matrix e -> Matrix e+negate = result negateTo++-- | @conjugate a@ returns @conjugate(a)@.+conjugate :: (VNum e) => Matrix e -> Matrix e+conjugate = result conjugateTo++-- | @trans a@ retunrs @trans(a)@.+trans :: (BLAS1 e)+      => Matrix e+      -> Matrix e+trans a = let+    (m,n) = dim a+    in create $ do+        a' <- new_ (n,m)+        transTo a' a+        return a'++-- | @conjTrans a@ retunrs @conj(trans(a))@.+conjTrans :: (BLAS1 e)+          => Matrix e+          -> Matrix e+conjTrans a = let+    (m,n) = dim a+    in create $ do+        a' <- new_ (n,m)+        conjTransTo a' a+        return a'++-- | @rank1Update alpha x y a@ returns @alpha * x * y^H + a@.+rank1Update :: (BLAS2 e)+            => e+            -> Vector e+            -> Vector e+            -> Matrix e+            -> Matrix e+rank1Update alpha x y a =+    create $ do+        a' <- newCopy a+        rank1UpdateM_ alpha x y a'+        return a'++-- | @mulVector transa a x@+-- returns @op(a) * x@, where @op(a)@ is determined by @transa@.                   +mulVector :: (BLAS2 e)+          => Trans -> Matrix e+          -> Vector e+          -> Vector e+mulVector transa a x = let+    m = case transa of NoTrans -> (fst . dim) a+                       _       -> (snd . dim) a+    in V.create $ do+        y <- V.new_ m+        mulVectorTo y transa a x+        return y++-- | @mulVectorWithScale alpha transa a x@+-- retunrs @alpha * op(a) * x@, where @op(a)@ is determined by @transa@.                   +mulVectorWithScale :: (BLAS2 e)+                   => e+                   -> Trans -> Matrix e+                   -> Vector e+                   -> Vector e+mulVectorWithScale alpha transa a x = let+    m = case transa of NoTrans -> (fst . dim) a+                       _       -> (snd . dim) a+    in V.create $ do+        y <- V.new_ m+        mulVectorWithScaleTo y alpha transa a x+        return y+                       +-- | @addMulVectorWithScales alpha transa a x beta y@+-- returns @alpha * op(a) * x + beta * y@, where @op(a)@ is+-- determined by @transa@.+addMulVectorWithScales :: (BLAS2 e)+                       => e+                       -> Trans -> Matrix e+                       -> Vector e+                       -> e+                       -> Vector e+                       -> Vector e+addMulVectorWithScales alpha transa a x beta y =+    V.create $ do+        y' <- V.newCopy y+        addMulVectorWithScalesM_ alpha transa a x beta y'+        return y'++-- | @mulMatrix transa a transb b@+-- returns @op(a) * op(b)@, where @op(a)@ and @op(b)@ are determined+-- by @transa@ and @transb@.                   +mulMatrix :: (BLAS3 e)+          => Trans -> Matrix e+          -> Trans -> Matrix e+          -> Matrix e+mulMatrix transa a transb b = let+    m = case transa of NoTrans -> (fst . dim) a+                       _       -> (snd . dim) a+    n = case transb of NoTrans -> (snd . dim) b+                       _       -> (fst . dim) b+    in create $ do+        c <- new_ (m,n)+        mulMatrixTo c transa a transb b+        return c++-- | @mulMatrixWithScale alpha transa a transb b@+-- returns @alpha * op(a) * op(b)@, where @op(a)@ and @op(b)@ are determined+-- by @transa@ and @transb@.                   +mulMatrixWithScale :: (BLAS3 e)+                   => e+                   -> Trans -> Matrix e+                   -> Trans -> Matrix e+                   -> Matrix e+mulMatrixWithScale alpha transa a transb b = let+    m = case transa of NoTrans -> (fst . dim) a+                       _       -> (snd . dim) a+    n = case transb of NoTrans -> (snd . dim) b+                       _       -> (fst . dim) b+    in create $ do+        c <- new_ (m,n)+        mulMatrixWithScaleTo c alpha transa a transb b+        return c++-- | @addMulMatrixWithScales alpha transa a transb b beta c@+-- returns @alpha * op(a) * op(b) + beta * c@, where @op(a)@ and+-- @op(b)@ are determined by @transa@ and @transb@.+addMulMatrixWithScales :: (BLAS3 e)+                       => e+                       -> Trans -> Matrix e+                       -> Trans -> Matrix e+                       -> e+                       -> Matrix e+                       -> Matrix e+addMulMatrixWithScales alpha transa a transb b beta c = +    create $ do+        c' <- newCopy c+        addMulMatrixWithScalesM_ alpha transa a transb b beta c'+        return c'++result :: (Storable e, Storable f)+       => (forall s . STMatrix s f -> Matrix e -> ST s a)+       -> Matrix e+       -> Matrix f+result f a = create $ newResult f a+{-# INLINE result #-}++result2 :: (Storable e, Storable f, Storable g)+        => (forall s . STMatrix s g -> Matrix e -> Matrix f -> ST s a)+        -> Matrix e+        -> Matrix f+        -> Matrix g+result2 f a1 a2 = create $ newResult2 f a1 a2+{-# INLINE result2 #-}++newResult :: (RMatrix m, Storable e, Storable f)+          => (STMatrix s f -> m e -> ST s a)+          -> m e+          -> ST s (STMatrix s f)+newResult f a = do+    mn <- getDim a+    c <- new_ mn+    _ <- f c a+    return c+{-# INLINE newResult #-}++newResult2 :: (RMatrix m1, RMatrix m2, Storable e, Storable f, Storable g)+           => (STMatrix s g -> m1 e -> m2 f -> ST s a)+           -> m1 e+           -> m2 f+           -> ST s (STMatrix s g)+newResult2 f a1 a2 = do+    mn <- getDim a1+    c <- new_ mn+    _ <- f c a1 a2+    return c+{-# INLINE newResult2 #-}
+ lib/Numeric/LinearAlgebra/Matrix/Base.hs view
@@ -0,0 +1,480 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix.Base+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Numeric.LinearAlgebra.Matrix.Base (+    Matrix(..),+    dim,+    +    fromList,+    fromRow,+    fromCol,+    zero,+    constant,+    +    at,+    unsafeAt,++    indices,+    elems,+    assocs,++    col,+    unsafeCol,+    cols,++    update,+    unsafeUpdate,+    accum,+    unsafeAccum,++    map,+    zipWith,+    unsafeZipWith,++    +    slice,+    unsafeSlice,+    +    splitRowsAt,+    dropRows,+    takeRows,++    splitColsAt,+    dropCols,+    takeCols,++    fromVector,+    toVector,++    isContig,+    unsafeFromForeignPtr,+    unsafeToForeignPtr,+    unsafeWith,++    ) where++import Prelude hiding ( read, map, zipWith )+import qualified Prelude as P++import Data.AEq( AEq(..) )+import Data.Typeable( Typeable )+import Foreign( ForeignPtr, Ptr, Storable )+import Text.Printf( printf )++import Numeric.LinearAlgebra.Vector( Vector )+import qualified Numeric.LinearAlgebra.Vector as V++-- | Immutable dense matrices.+data Matrix e =+      Matrix {-# UNPACK #-} !(Vector e) -- matrix data+             {-# UNPACK #-} !Int        -- row dimension+             {-# UNPACK #-} !Int        -- column dimension+             {-# UNPACK #-} !Int        -- leading dimension+  deriving (Typeable)++-- | Get the matrix dimensions (number of rows and number of columns).+dim :: (Storable e) => Matrix e -> (Int,Int)+dim (Matrix _ m n _) = (m,n)+{-# INLINE dim #-}++-- | Indicates if the elements of the matrix are stored contigously+isContig :: (Storable e) => Matrix e -> Bool+isContig (Matrix _ m _ lda) = lda == m || m == 0+{-# INLINE isContig #-}++-- | Create a matrix of the given dimension with elements initialized+-- to the values from the list, in column major order.+fromList :: (Storable e) => (Int,Int) -> [e] -> Matrix e+fromList (m,n) es+    | m < 0 || n < 0 = error $+        printf "fromList (%d,%d): negative dimension" m n+    | otherwise = let+        v = V.fromList (m*n) es+        lda = max 1 m+        in Matrix v m n lda+{-# INLINE fromList #-}++-- | Create a matrix of the given dimension with all elements initialized+-- to the given value+constant :: (Storable e) => (Int,Int) -> e -> Matrix e+constant (m,n) e+    | m < 0 || n < 0 = error $+        printf "constant (%d,%d): negative dimension" m n+    | otherwise = let+        v = V.constant (m*n) e+        lda = max 1 m+        in Matrix v m n lda+{-# INLINE constant #-}++-- | Create a zero of the given dimension with all elements initialized+-- to zero.+zero :: (Storable e, Num e) => (Int,Int) -> Matrix e+zero (m,n)+    | m < 0 || n < 0 = error $+        printf "zero (%d,%d): negative dimension" m n+    | otherwise = let+        v = V.zero (m*n)+        lda = max 1 m+        in Matrix v m n lda+{-# INLINE zero #-}++-- | Returns the element of a matrix at the specified index.+at :: (Storable e) => Matrix e -> (Int,Int) -> e+at a ij@(i,j)+    | i < 0 || i >= m || j < 0 || j >= n = error $+        printf ("at <matrix with dim (%d,%d)> (%d,%d):"+                ++ " invalid index") m n i j+    | otherwise =+        unsafeAt a ij+  where+      (m,n) = dim a+{-# INLINE at #-}++unsafeAt :: (Storable e) => Matrix e -> (Int,Int) -> e+unsafeAt (Matrix v _ _ lda) (i,j) = +    V.unsafeAt v (i + j * lda)+{-# INLINE unsafeAt #-}++-- | Get the indices of the elements in the matrix, in column-major order.+indices :: (Storable e) => Matrix e -> [(Int,Int)]+indices a = [ (i,j) | j <- [ 0..n-1 ], i <- [ 0..m-1 ] ]+  where (m,n) = dim a++-- | Returns a list of the elements of a matrix, in the same order as their+-- indices.+elems :: (Storable e) => Matrix e -> [e]+elems (Matrix v m _ lda)+    | lda == m  = V.elems v+    | otherwise = let+        breakCols [] = []+        breakCols es = let (c,es') = splitAt lda es in c:(breakCols es')++        dropJunk c = take m c++        in concatMap dropJunk $ breakCols (V.elems v)+{-# INLINE elems #-}++-- | Returns the contents of a matrix as a list of associations.+assocs :: (Storable e) => Matrix e -> [((Int,Int),e)]+assocs x = zip (indices x) (elems x)+{-# INLINE assocs #-}++-- | Version of 'update' that doesn't range-check indices.+unsafeUpdate :: (Storable e) => Matrix e -> [((Int,Int),e)] -> Matrix e+unsafeUpdate (Matrix v m n lda) ijes = let+    ies = [ (i + j * lda, e) | ((i,j),e) <- ijes ]+    v' = V.unsafeUpdate v ies+    in Matrix v' m n lda++-- | Create a new matrix by replacing the values at the specified indices.+update :: (Storable e) => Matrix e -> [((Int,Int),e)] -> Matrix e+update (Matrix v m n lda) ijes = let+    ies = [ if i < 0 || i >= m || j < 0 || j >= n+                then error $ printf+                         ("update"+                         ++ " <matrix with dim (%d,%d)>"+                         ++ " [ ..((%d,%d),_).. ]"+                         ++ ": invalid index")+                         m n i j+                else (i + j * lda, e)+          | ((i,j),e) <- ijes+          ]+    v' = V.unsafeUpdate v ies+    in Matrix v' m n lda++-- | Same as 'accum' but does not range-check indices.+unsafeAccum :: (Storable e)+            => (e -> e' -> e)+            -> Matrix e+            -> [((Int,Int), e')]+            -> Matrix e+unsafeAccum f (Matrix v m n lda) ijes = let+    ies = [ (i + j * lda, e) | ((i,j),e) <- ijes ]+    v' = V.unsafeAccum f v ies+    in Matrix v' m n lda++-- | @accum f@ takes a matrix and an association list and accumulates+-- pairs from the list into the matrix with the accumulating function @f@.+accum :: (Storable e)+      => (e -> e' -> e) +      -> Matrix e+      -> [((Int,Int), e')]+      -> Matrix e+accum f (Matrix v m n lda) ijes = let+    ies = [ if i < 0 || i >= m || j < 0 || j >= n+                then error $ printf+                         ("accum"+                         ++ " <matrix with dim (%d,%d)>"+                         ++ " [ ..((%d,%d),_).. ]"+                         ++ ": invalid index")+                         m n i j+                else (i + j * lda, e)+          | ((i,j),e) <- ijes+          ]+    v' = V.unsafeAccum f v ies+    in Matrix v' m n lda++-- | Construct a new matrix by applying a function to every element of+-- a matrix.+map :: (Storable e, Storable e')+    => (e -> e')+    -> Matrix e+    -> Matrix e'+map f a = fromList (dim a) $ P.map f (elems a)+{-# INLINE map #-}++-- | Construct a new matrix by applying a function to every pair of elements+-- of two matrices.  The two matrices must have identical dimensions.+zipWith :: (Storable e, Storable e', Storable f)+        => (e -> e' -> f)+        -> Matrix e+        -> Matrix e'+        -> Matrix f+zipWith f a a'+    | mn /= mn' = error $+        printf ("zipWith"+                ++ " <matrix with dim %s> "+                ++ " <matrix with dim %s>"+                ++ ": dimension mismatch"+                ) (show mn) (show mn')+    | otherwise =+        unsafeZipWith f a a'+  where+    mn  = dim a+    mn' = dim a'    +{-# INLINE zipWith #-}++-- | Version of 'zipWith' that does not check if the input matrices+-- have the same dimensions.+unsafeZipWith :: (Storable e, Storable e', Storable f)+              => (e -> e' -> f)+              -> Matrix e+              -> Matrix e'+              -> Matrix f+unsafeZipWith f a a' =+    fromList (dim a') $ P.zipWith f (elems a) (elems a')+{-# INLINE unsafeZipWith #-}++-- | Get the given column of the matrix.+col :: (Storable e) => Matrix e -> Int -> Vector e+col a j+    | j < 0 || j >= n = error $+        printf ("col <matrix with dim (%d,%d)> %d:"+                ++ " index out of range") m n j+    | otherwise =+        unsafeCol a j+  where+    (m,n) = dim a+{-# INLINE col #-}++-- | Version of 'col' that doesn't range-check indices.+unsafeCol :: (Storable e) => Matrix e -> Int -> Vector e+unsafeCol (Matrix v m _ lda) j = +    V.unsafeSlice (j*lda) m v+{-# INLINE unsafeCol #-}++-- | Get a list of the columns of the matrix.+cols :: (Storable e) => Matrix e -> [Vector e]+cols a = P.map (unsafeCol a) [ 0..n-1 ]+  where+    (_,n) = dim a+{-# INLINE cols #-}++-- | @slice (i,j) (m,n) a@ creates a submatrix view of @a@ starting at+-- element @(i,j)@ and having dimensions @(m,n)@.+slice :: (Storable e)+      => (Int,Int)+      -> (Int,Int)+      -> Matrix e+      -> Matrix e+slice (i,j) (m',n') a+    | (i < 0 || m' < 0 || i + m' > m +       || j < 0 || n' < 0 || j + n' > n) = error $+        printf ( "slice"+               ++ " (%d,%d)"+               ++ " (%d,%d)"+               ++ " <matrix with dim (%d,%d)>"+               ++ ": index out of range"+               ) i j m' n' m n+    | otherwise =+        unsafeSlice (i,j) (m',n') a+  where+    (m,n) = dim a+{-# INLINE slice #-}++-- | Version of 'slice' that doesn't range-check indices.+unsafeSlice :: (Storable e)+            => (Int,Int) -> (Int,Int) -> Matrix e -> Matrix e+unsafeSlice (i,j) (m',n') (Matrix v _ _ lda) = let+    o = i + j*lda+    l = if m' == 0+            then 0+            else lda * n'+    v' = V.unsafeSlice o l v+    in Matrix v' m' n' lda+{-# INLINE unsafeSlice #-}++-- | Create a view of a matrix by taking the initial rows.+takeRows :: (Storable e) => Int -> Matrix e -> Matrix e+takeRows i a = slice (0,0) (i,n) a+  where+    (_,n) = dim a++-- | Create a view of a matrix by dropping the initial rows.+dropRows :: (Storable e) => Int -> Matrix e -> Matrix e+dropRows i a = slice (i,0) (m-i,n) a+  where+    (m,n) = dim a++-- | Split a matrix into two blocks and returns views into the blocks.  If+-- @(a1, a2) = splitRowsAt i a@, then+-- @a1 = slice (0,0) (i,n) a@ and+-- @a2 = slice (i,0) (m-i,n) a@, where @(m,n)@ is the dimension of @a@.+splitRowsAt :: (Storable e) => Int -> Matrix e -> (Matrix e, Matrix e)+splitRowsAt i a+    | i < 0 || i > m = error $+        printf ("splitRowsAt %d <matrix with dim (%d,%d)>:"+                ++ " invalid index") i m n+    | otherwise = let+        a1 = unsafeSlice (0,0) (i,n)   a+        a2 = unsafeSlice (i,0) (m-i,n) a+    in (a1,a2)+  where+    (m,n) = dim a+{-# INLINE splitRowsAt #-}++-- | Create a view of a matrix by taking the initial columns.+takeCols :: (Storable e) => Int -> Matrix e -> Matrix e+takeCols j a = slice (0,0) (m,j) a+  where+    (m,_) = dim a++-- | Create a view of a matrix by dropping the initial columns.+dropCols :: (Storable e) => Int -> Matrix e -> Matrix e+dropCols j a = slice (0,j) (m,n-j) a+  where+    (m,n) = dim a++-- | Split a matrix into two blocks and returns views into the blocks.  If+-- @(a1, a2) = splitColsAt j a@, then+-- @a1 = slice (0,0) (m,j) a@ and+-- @a2 = slice (0,j) (m,n-j) a@, where @(m,n)@ is the dimension of @a@.+splitColsAt :: (Storable e) => Int -> Matrix e -> (Matrix e, Matrix e)+splitColsAt j a+    | j < 0 || j > n = error $+        printf ("splitColsAt %d <matrix with dim (%d,%d)>:"+                ++ " invalid index") j m n+    | otherwise = let+        a1 = unsafeSlice (0,0) (m,j)   a+        a2 = unsafeSlice (0,j) (m,n-j) a+    in (a1,a2)+  where+    (m,n) = dim a+{-# INLINE splitColsAt #-}+++-- | Convert a matrix to a vector by stacking its columns.+toVector :: (Storable e)+         => Matrix e+         -> Vector e+toVector a@(Matrix v m n _lda)+    | isContig a = v+    | otherwise  = V.fromList (m*n) $ elems a++-- | Cast a vector to a matrix of the given shape.+fromVector :: (Storable e)+           => (Int,Int)+           -> Vector e+           -> Matrix e+fromVector (m,n) v+    | nv /= m * n = error $+        printf ("fromVector"+               ++ " (%d,%d)"+               ++ " <vector with dim %d>"+               ++ ": dimension mismatch"+               ) m n nv+    | otherwise =+        Matrix v m n (max 1 m)+  where+    nv = V.dim v+{-# INLINE fromVector #-}++-- | Cast a vector to a matrix with one column.+fromCol :: (Storable e)+        => Vector e+        -> Matrix e+fromCol v = Matrix v m 1 (max 1 m)+  where+    m = V.dim v++-- | Cast a vector to a matrix with one row.+fromRow :: (Storable e)+        => Vector e+        -> Matrix e+fromRow v = Matrix v 1 n 1+  where+    n = V.dim v++instance (Storable e, Show e) => Show (Matrix e) where+    show x = "fromList " ++ show (dim x) ++ " " ++ show (elems x)+    {-# INLINE show #-}++instance (Storable e, Eq e) => Eq (Matrix e) where+    (==) = compareWith (==)+    {-# INLINE (==) #-}++instance (Storable e, AEq e) => AEq (Matrix e) where+    (===) = compareWith (===)+    {-# INLINE (===) #-}+    (~==) = compareWith (~==)+    {-# INLINE (~==) #-}++compareWith :: (Storable e, Storable e')+            => (e -> e' -> Bool)+            -> Matrix e+            -> Matrix e'+            -> Bool+compareWith cmp a a' =+    dim a == dim a'+    && and (P.zipWith cmp (elems a) (elems a'))+{-# INLINE compareWith #-}++-- | Create a matrix from a 'ForeignPtr' with offset, dimensions, and lda. The+-- data may not be modified through the ForeignPtr afterwards.+unsafeFromForeignPtr :: (Storable e)+                     => ForeignPtr e -- ^ pointer+                     -> Int	         -- ^ offset+                     -> (Int,Int)    -- ^ dimensions+                     -> Int          -- ^ leading dimension (lda)+                     -> Matrix e+unsafeFromForeignPtr p o (m,n) lda = let+    nv = if m == 0 then 0 else n * lda+    v = V.unsafeFromForeignPtr p o nv+    in Matrix v m n lda+{-# INLINE unsafeFromForeignPtr #-}++-- | Yield the underlying 'ForeignPtr' together with the offset to the data+-- the matrix dimensions, and the lda. The data may not be modified through+-- the 'ForeignPtr'.+unsafeToForeignPtr :: (Storable e)+                   => Matrix e+                   -> (ForeignPtr e, Int, (Int,Int), Int)+unsafeToForeignPtr (Matrix v m n lda) = let+    (f,o,_) = V.unsafeToForeignPtr v+    in (f, o, (m,n), lda)+{-# INLINE unsafeToForeignPtr #-}++-- | Execute an 'IO' action with a pointer to the first element in the+-- matrix and the leading dimension (lda).+unsafeWith :: (Storable e) => Matrix e -> (Ptr e -> Int -> IO a) -> IO a+unsafeWith (Matrix v _ _ lda) f =+    V.unsafeWith v $ \p -> f p lda+{-# INLINE unsafeWith #-}
+ lib/Numeric/LinearAlgebra/Matrix/Cholesky.hs view
@@ -0,0 +1,133 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix.Cholesky+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Cholesky factorizations of symmetric (Hermitian) positive-definite+-- matrices.+--++module Numeric.LinearAlgebra.Matrix.Cholesky (+    -- * Immutable interface+    cholFactor,+    cholSolveVector,+    cholSolveMatrix,+    +    -- * Mutable interface+    cholFactorM,+    cholSolveVectorM_,+    cholSolveMatrixM_,+    +    ) where++import Control.Monad( when )+import Control.Monad.ST( ST, runST, unsafeIOToST )+import Text.Printf( printf )++import qualified Foreign.LAPACK as LAPACK++import Numeric.LinearAlgebra.Types++import Numeric.LinearAlgebra.Matrix.Base( Matrix )+import Numeric.LinearAlgebra.Matrix.STBase( RMatrix, STMatrix )+import qualified Numeric.LinearAlgebra.Matrix.STBase as M++import Numeric.LinearAlgebra.Vector( Vector, STVector )+import qualified Numeric.LinearAlgebra.Vector as V+++-- | @cholFactor a@ tries to compute the Cholesky+-- factorization of @a@.  If @a@ is positive-definite then the routine+-- returns @Right@ with the factorization.  If the leading minor of order @i@+-- is not positive-definite then the routine returns @Left i@.+cholFactor :: (LAPACK e)+                 => Herm Matrix e+                 -> Either Int (Chol Matrix e)+cholFactor (Herm uplo a) = runST $ do+    ma <- M.newCopy a+    cholFactorM (Herm uplo ma)+        >>= either (return . Left) (\(Chol uplo' ma') -> do+                a' <- M.unsafeFreeze ma'+                return $ Right (Chol uplo' a')+                )++-- | @cholSolveVector a x@ returns @a \\ x@.+cholSolveVector :: (LAPACK e)+                      => Chol Matrix e+                      -> Vector e+                      -> Vector e+cholSolveVector a x = V.create $ do+    x' <- V.newCopy x+    cholSolveVectorM_ a x'+    return x'++-- | @cholSolveMatrix a b@ returns @a \\ b@.+cholSolveMatrix :: (LAPACK e)+                => Chol Matrix e+                -> Matrix e+                -> Matrix e+cholSolveMatrix a c = M.create $ do+    c' <- M.newCopy c+    cholSolveMatrixM_ a c'+    return c'++-- | @cholFactorM a@ tries to compute the Cholesky+-- factorization of @a@ in place.  If @a@ is positive-definite then the+-- routine returns @Right@ with the factorization, stored in the same+-- memory as @a@.  If the leading minor of order @i@ is not+-- positive-definite then the routine returns @Left i@.+-- In either case, the original storage of @a@ is destroyed.+cholFactorM :: (LAPACK e)+            => Herm (STMatrix s) e+            -> ST s (Either Int (Chol (STMatrix s) e))+cholFactorM (Herm uplo a) = do+    (ma,na) <- M.getDim a+    let n = na++    when (not $ (ma,na) == (n,n)) $ error $+        printf ("cholFactorM"+                ++ " (Herm _ <matrix with dim (%d,%d)>): nonsquare matrix"+               ) ma na++    unsafeIOToST $+        M.unsafeWith a $ \pa lda -> do+            info <- LAPACK.potrf uplo n pa lda+            return $ if info > 0 then Left info+                                 else Right (Chol uplo a)+++-- | @cholSolveVectorM_ a x@ sets @x := a \\ x@.+cholSolveVectorM_ :: (LAPACK e, RMatrix m)+                  => Chol m e+                  -> STVector s e+                  -> ST s ()+cholSolveVectorM_ a x =+    M.withFromColM x $ \x' ->+        cholSolveMatrixM_ a x'++-- | @cholSolveMatrixM_ a b@ sets @b := a \\ b@.+cholSolveMatrixM_ :: (LAPACK e, RMatrix m)+                  => Chol m e+                  -> STMatrix s e+                  -> ST s ()+cholSolveMatrixM_ (Chol uplo a) b = do+    (ma,na) <- M.getDim a+    (mb,nb) <- M.getDim b+    let (n,nrhs) = (mb,nb)+    +    when ((not . and) [ (ma,na) == (n,n)+                      , (mb,nb) == (n,nrhs)+                      ]) $ error $+        printf ("cholSolveMatrixM_"+                ++ " (Chol _ <matrix with dim (%d,%d)>)"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch")+               ma na mb nb++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        M.unsafeWith b $ \pb ldb ->+            LAPACK.potrs uplo n nrhs pa lda pb ldb
+ lib/Numeric/LinearAlgebra/Matrix/Eigen.hs view
@@ -0,0 +1,138 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix.Eigen+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Eigenvalue decompositions.+--+module Numeric.LinearAlgebra.Matrix.Eigen (+    hermEigen,+    hermEigenvalues,+    hermEigenM_,+    hermEigenvaluesM_,+    ) where++import Control.Monad( when )+import Control.Monad.ST( ST, runST, unsafeIOToST )+import Foreign( allocaArray, nullPtr )+import Text.Printf( printf )++import Foreign.LAPACK( LAPACK, EigJob(..), EigRange(..) )+import qualified Foreign.LAPACK as LAPACK++import Numeric.LinearAlgebra.Types( Herm(..) )+import Numeric.LinearAlgebra.Matrix.Base( Matrix )+import Numeric.LinearAlgebra.Matrix.STBase( STMatrix )+import qualified Numeric.LinearAlgebra.Matrix.STBase as M+import Numeric.LinearAlgebra.Vector( Vector, STVector )+import qualified Numeric.LinearAlgebra.Vector as V++-- | Compute the eigenvalues and eigenvectors of a Hermitian matrix.+-- Return the eigenvalues are in ascending order in the result vector; +-- store the corresponding eigenvectors are in the columns of the result+-- matrix.+hermEigen :: (LAPACK e) => Herm Matrix e -> (Vector Double, Matrix e)+hermEigen (Herm uplo a) = runST $ do+    (_,n) <- M.getDim a+    ma <- M.newCopy a+    mw <- V.new_ n+    mz <- M.new_ (n,n)+    hermEigenM_ (Herm uplo ma) mw mz+    w <- V.unsafeFreeze mw+    z <- M.unsafeFreeze mz+    return (w,z)+++-- | Return the eigenvalues of a Hermitian matrix in ascending order.+hermEigenvalues :: (LAPACK e) => Herm Matrix e -> Vector Double+hermEigenvalues (Herm uplo a) = V.create $ do+    (_,n) <- M.getDim a+    ma <- M.newCopy a+    w <- V.new_ n+    hermEigenvaluesM_ (Herm uplo ma) w+    return w+++-- | Compute and copy the eigenvalues and eigenvectors of a mutable+-- Hermitian matrix.  This destroys the original Hermitian matrix.+hermEigenM_ :: (LAPACK e)+                  => Herm (STMatrix s) e+                  -> STVector s Double+                  -> STMatrix s e+                  -> ST s ()+hermEigenM_ (Herm uplo a) w z = do+    (ma,na) <- M.getDim a+    (mz,nz) <- M.getDim z+    nw <- V.getDim w+    let n = na+    +    when (ma /= na) $ error $+        printf ("hermEigenM_"+                ++ " (Herm _ <matrix with dim (%d,%d)>): nonsquare matrix"+               ) ma na+    when ((not . and) [ (ma,na) == (n,n)+                      , nw == n+                      , (mz,nz) == (n,n)+                      ]) $ error $+        printf ("hermEigenM_"+                ++ " (Herm _ <matrix with dim (%d,%d)>)"+                ++ " <vector with dim %d>:"+                ++ " <matrix with dim (%d,%d)>"+                ++ " dimension mismatch")+               ma na nw mz nz++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        V.unsafeWith w $ \pw ->+        M.unsafeWith z $ \pz ldz ->+        allocaArray (2*n) $ \psuppz -> do+            _m <- LAPACK.heevr jobz range uplo n pa lda abstol pw pz ldz+                               psuppz+            return ()+  where+    jobz = EigVectors+    range = AllEigs+    abstol = 0+      ++-- | Compute and copy the eigenvalues of a mutable Hermitian matrix.  This+-- destroys the original Hermitian matrix.+hermEigenvaluesM_ :: (LAPACK e)+                        => Herm (STMatrix s) e+                        -> STVector s Double+                        -> ST s ()+hermEigenvaluesM_ (Herm uplo a) w = do+    (ma,na) <- M.getDim a+    nw <- V.getDim w+    let n = na+    +    when (ma /= na) $  error $+        printf ("hermEigenvaluesM_"+                ++ " (Herm _ <matrix with dim (%d,%d)>): nonsquare matrix"+               ) ma na++    when ((not . and) [ (ma,na) == (n,n)+                      , nw == n+                      ]) $ error $+        printf ("hermEigenvaluesM_"+                ++ " (Herm _ <matrix with dim (%d,%d)>)"+                ++ " <vector with dim %d>: dimension mismatch")+               ma na nw+               +    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        V.unsafeWith w $ \pw -> do+            _m <- LAPACK.heevr jobz range uplo n pa lda abstol pw pz ldz+                               psuppz+            return ()+    +  where+    jobz = NoEigVectors+    range = AllEigs+    abstol = 0+    pz = nullPtr+    ldz = 1+    psuppz = nullPtr
+ lib/Numeric/LinearAlgebra/Matrix/Herm.hs view
@@ -0,0 +1,446 @@+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix.Herm+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Hermitian views of matrices.+--++module Numeric.LinearAlgebra.Matrix.Herm (+    -- * Immutable interface+    +    -- ** Vector multiplication+    hermMulVector,+    hermMulVectorWithScale,+    addHermMulVectorWithScales,+    +    -- ** Matrix  multiplication+    hermMulMatrix,+    hermMulMatrixWithScale,+    addHermMulMatrixWithScales,++    -- ** Updates+    hermRank1Update,+    hermRank2Update,+    hermRankKUpdate,   +    hermRank2KUpdate,    ++    +    -- * Mutable interface+    hermCreate,+    +    -- ** Vector multiplication+    hermMulVectorTo,+    hermMulVectorWithScaleTo,+    addHermMulVectorWithScalesM_,+    +    -- ** Matrix multiplication+    hermMulMatrixTo,+    hermMulMatrixWithScaleTo,+    addHermMulMatrixWithScalesM_,++    -- ** Updates+    hermRank1UpdateM_,+    hermRank2UpdateM_,+    hermRankKUpdateM_,  +    hermRank2KUpdateM_,+    +    ) where++import Control.Monad( when )+import Control.Monad.ST( ST, runST, unsafeIOToST )+import Text.Printf( printf )++import Numeric.LinearAlgebra.Vector( Vector, RVector, STVector )+import qualified Numeric.LinearAlgebra.Vector as V+import Numeric.LinearAlgebra.Matrix.Base( Matrix )+import Numeric.LinearAlgebra.Matrix.STBase( STMatrix, RMatrix )+import qualified Numeric.LinearAlgebra.Matrix.STBase as M+import Numeric.LinearAlgebra.Types+import qualified Foreign.BLAS as BLAS+++-- | A safe way to create and work with a mutable Herm Matrix before returning +-- an immutable one for later perusal.+hermCreate :: (Storable e)+           => (forall s. ST s (Herm (STMatrix s) e))+           -> Herm Matrix e+hermCreate mh = runST $ do+    (Herm u ma) <- mh+    a <- M.unsafeFreeze ma+    return $ Herm u a++-- | @hermRank1Update alpha x a@ returns+-- @alpha * x * x^H + a@.+hermRank1Update :: (BLAS2 e)+                => Double -> Vector e -> Herm Matrix e -> Herm Matrix e+hermRank1Update alpha x (Herm uplo a) = runST $ do+    ma' <- M.newCopy a+    hermRank1UpdateM_ alpha x (Herm uplo ma')+    a' <- M.unsafeFreeze ma'+    return $ Herm uplo a'++-- | @hermRank2Update alpha x y a@ returns+-- @alpha * x * y^H + conj(alpha) * y * x^H + a@.+hermRank2Update :: (BLAS2 e)+                => e -> Vector e -> Vector e -> Herm Matrix e+                -> Herm Matrix e+hermRank2Update alpha x y (Herm uplo a) = runST $ do+    ma' <- M.newCopy a+    hermRank2UpdateM_ alpha x y (Herm uplo ma')+    a' <- M.unsafeFreeze ma'+    return $ Herm uplo a'++-- | @hermRankKUpdate alpha trans a beta c@ returns+-- @c := alpha * a * a^H + beta * c@ when @trans@ is @NoTrans@ and+-- @c := alpha * a^H * a + beta * c@ when @trans@ is @ConjTrans@.  The+-- function signals an error when @trans@ is @Trans@.+hermRankKUpdate :: (BLAS3 e)+                => e -> Trans -> Matrix e -> e -> Herm Matrix e+                -> Herm Matrix e+hermRankKUpdate alpha trans a beta (Herm uplo c) = runST $ do+    mc' <- M.newCopy c+    hermRankKUpdateM_ alpha trans a beta (Herm uplo mc')+    c' <- M.unsafeFreeze mc'+    return $ Herm uplo c'++-- | @hermRank2KUpdate alpha trans a b beta c@ returns+-- @c := alpha * a * b^H + conj(alpha) * b * a^H + beta * c@ when @trans@ is+-- @NoTrans@ and @c := alpha * b^H * a + conj(alpha) * a^H * b + beta * c@+-- when @trans@ is @ConjTrans@.  The function signals an error when @trans@+-- is @Trans@.+hermRank2KUpdate :: (BLAS3 e)+                 => e -> Trans -> Matrix e -> Matrix e -> e -> Herm Matrix e+                 -> Herm Matrix e+hermRank2KUpdate alpha trans a b beta (Herm uplo c) = runST $ do+    mc' <- M.newCopy c+    hermRank2KUpdateM_ alpha trans a b beta (Herm uplo mc')+    c' <- M.unsafeFreeze mc'+    return $ Herm uplo c'++-- | @hermRank1UpdateM_ alpha x a@ sets+-- @a := alpha * x * x^H + a@.+hermRank1UpdateM_ :: (RVector v, BLAS2 e)+                  => Double -> v e -> Herm (STMatrix s) e -> ST s ()+hermRank1UpdateM_ alpha x (Herm uplo a) = do+    nx <- V.getDim x+    (ma,na) <- M.getDim a+    let n = nx++    when ((not . and) [ nx == n, (ma,na) == (n,n) ]) $ error $+        printf ("hermRank1UpdateM_ _ <vector with dim %d>"+                 ++ " (Herm _ <matrix with dim (%d,%d)>):"+                 ++ " invalid dimensions") nx ma na++    unsafeIOToST $+        V.unsafeWith x $ \px ->+        M.unsafeWith a $ \pa lda ->+            BLAS.her uplo n alpha px 1 pa lda+++-- | @hermRank2UpdateM_ alpha x y a@ sets+-- @a := alpha * x * y^H + conj(alpha) * y * x^H + a@.+hermRank2UpdateM_ :: (RVector v1, RVector v2, BLAS2 e)+                  => e -> v1 e -> v2 e -> Herm (STMatrix s) e -> ST s ()+hermRank2UpdateM_ alpha x y (Herm uplo a) = do+    nx <- V.getDim x+    ny <- V.getDim y+    (ma,na) <- M.getDim a+    let n = nx+    +    when ((not . and) [ nx == n, ny == n, (ma,na) == (n,n) ]) $ error $+        printf ("hermRank2UpdateM_ _ <vector with dim %d>"+                 ++ " <vector with dim %d>"+                 ++ " (Herm _ <matrix with dim (%d,%d)>):"+                 ++ " invalid dimensions") nx ny ma na++    unsafeIOToST $+        V.unsafeWith x $ \px ->+        V.unsafeWith y $ \py ->+        M.unsafeWith a $ \pa lda ->+            BLAS.her2 uplo n alpha px 1 py 1 pa lda+++-- | @hermRankKUpdateM_ alpha trans a beta c@ sets+-- @c := alpha * a * a^H + beta * c@ when @trans@ is @NoTrans@ and+-- @c := alpha * a^H * a + beta * c@ when @trans@ is @ConjTrans@.  The+-- function signals an error when @trans@ is @Trans@.+hermRankKUpdateM_ :: (RMatrix m, BLAS3 e)+                  => e -> Trans -> m e -> e -> Herm (STMatrix s) e+                  -> ST s ()+hermRankKUpdateM_ alpha trans a beta (Herm uplo c) = do+    (ma,na) <- M.getDim a+    (mc,nc) <- M.getDim c+    let (n,k) = if trans == NoTrans then (ma,na) else (na,ma)++    when (trans == Trans) $ error $+        printf ("hermRankKUpdateM_ _ %s:"+                 ++ " trans argument must be NoTrans or ConjTrans")+               (show trans)+               +    when ((not . and) [ (mc,nc) == (n,n)+                      , case trans of NoTrans -> (ma,na) == (n,k)+                                      _       -> (ma,na) == (k,n)+                      ]) $ error $+            printf ("hermRankKUpdateM_ _ %s <matrix with dim (%d,%d)> _"+                    ++ " (Herm _ <matrix with dim (%d,%d)>):"+                    ++ " invalid dimensions") (show trans) ma na mc nc++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        M.unsafeWith c $ \pc ldc ->+            BLAS.herk uplo trans n k alpha pa lda beta pc ldc+++-- | @hermRank2KUpdateM_ alpha trans a b beta c@ sets+-- @c := alpha * a * b^H + conj(alpha) * b * a^H + beta * c@ when @trans@ is+-- @NoTrans@ and @c := alpha * b^H * a + conj(alpha) * a^H * b + beta * c@+-- when @trans@ is @ConjTrans@.  The function signals an error when @trans@+-- is @Trans@.+hermRank2KUpdateM_ :: (RMatrix m1, RMatrix m2, BLAS3 e)+                   => e -> Trans -> m1 e -> m2 e -> e -> Herm (STMatrix s) e+                   -> ST s ()+hermRank2KUpdateM_ alpha trans a b beta (Herm uplo c) = do+    (ma,na) <- M.getDim a+    (mb,nb) <- M.getDim b+    (mc,nc) <- M.getDim c+    let (n,k) = if trans == NoTrans then (ma,na) else (na,ma)++    when (trans == Trans) $ error $+        printf ("hermRank2KUpdateM_ _ %s:"+                 ++ " trans argument must be NoTrans or ConjTrans")+               (show trans)++    when ((not . and) [ (mc,nc) == (n,n)+                      , (mb,nb) == (ma,na)+                      , case trans of NoTrans -> (ma,na) == (n,k)+                                      _       -> (ma,na) == (k,n)+                      ]) $ error $+            printf ("hermRank2KUpdateM_ _ %s <matrix with dim (%d,%d)>"+                    ++ " <matrix with dim (%d,%d)> _"+                    ++ " (Herm _ <matrix with dim (%d,%d)>):"+                    ++ " invalid dimensions") (show trans) ma na mb nb mc nc++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        M.unsafeWith b $ \pb ldb ->+        M.unsafeWith c $ \pc ldc ->+            BLAS.her2k uplo trans n k alpha pa lda pb ldb beta pc ldc+++-- | @hermMulVector a x@ returns @a * x@.+hermMulVector :: (BLAS2 e)+              => Herm Matrix e+              -> Vector e+              -> Vector e+hermMulVector a x =+    V.create $ do+        n <- V.getDim x+        y <- V.new_ n+        hermMulVectorTo y a x+        return y++-- | @hermMulVectorWithScale alpha a x@ retunrs @alpha * a * x@.+hermMulVectorWithScale :: (BLAS2 e)+                       => e+                       -> Herm Matrix e+                       -> Vector e+                       -> Vector e+hermMulVectorWithScale alpha a x =+    V.create $ do+        n <- V.getDim x+        y <- V.new_ n+        hermMulVectorWithScaleTo y alpha a x+        return y+                       +-- | @addHermMulVectorWithScales alpha a x y@+-- returns @alpha * a * x + beta * y@.+addHermMulVectorWithScales :: (BLAS2 e)+                           => e+                           -> Herm Matrix e+                           -> Vector e+                           -> e+                           -> Vector e+                           -> Vector e+addHermMulVectorWithScales alpha a x beta y =+    V.create $ do+        y' <- V.newCopy y+        addHermMulVectorWithScalesM_ alpha a x beta y'+        return y'++-- | @hermMulMatrix side a b@+-- returns @alpha * a * b@ when @side@ is @LeftSide@ and+-- @alpha * b * a@ when @side@ is @RightSide@.+hermMulMatrix :: (BLAS3 e)+              => Side -> Herm Matrix e+              -> Matrix e+              -> Matrix e+hermMulMatrix side a b = +    M.create $ do+        mn <- M.getDim b+        c <- M.new_ mn+        hermMulMatrixTo c side a b+        return c++-- | @hermMulMatrixWithScale alpha side a b@+-- returns @alpha * a * b@ when @side@ is @LeftSide@ and+-- @alpha * b * a@ when @side@ is @RightSide@.+hermMulMatrixWithScale :: (BLAS3 e)+                       => e+                       -> Side -> Herm Matrix e+                       -> Matrix e+                       -> Matrix e+hermMulMatrixWithScale alpha side a b =+    M.create $ do+        mn <- M.getDim b+        c <- M.new_ mn+        hermMulMatrixWithScaleTo c alpha side a b+        return c++-- | @addHermMulMatrixWithScales alpha side a b beta c@+-- returns @alpha * a * b + beta * c@ when @side@ is @LeftSide@ and+-- @alpha * b * a + beta * c@ when @side@ is @RightSide@.+addHermMulMatrixWithScales :: (BLAS3 e)+                           => e+                           -> Side -> Herm Matrix e+                           -> Matrix e+                           -> e+                           -> Matrix e+                           -> Matrix e+addHermMulMatrixWithScales alpha side a b beta c = +    M.create $ do+        c' <- M.newCopy c+        addHermMulMatrixWithScalesM_ alpha side a b beta c'+        return c'++-- | @hermMulVectorTo dst a x@ sets @dst := a * x@.+hermMulVectorTo :: (RMatrix m, RVector v, BLAS2 e)+                => STVector s e+                -> Herm m e+                -> v e+                -> ST s ()+hermMulVectorTo dst = hermMulVectorWithScaleTo dst 1++-- | @hermMulVectorWithScaleTo dst alpha a x@+-- sets @dst := alpha * a * x@.+hermMulVectorWithScaleTo :: (RMatrix m, RVector v, BLAS2 e)+                         => STVector s e+                         -> e+                         -> Herm m e+                         -> v e+                         -> ST s ()+hermMulVectorWithScaleTo dst alpha a x =+    addHermMulVectorWithScalesM_ alpha a x 0 dst++-- | @addHermMulVectorWithScalesM_ alpha a x beta y@+-- sets @y := alpha * a * x + beta * y@.+addHermMulVectorWithScalesM_ :: (RMatrix m, RVector v, BLAS2 e)+                             => e+                             -> Herm m e+                             -> v e+                             -> e+                             -> STVector s e+                             -> ST s ()+addHermMulVectorWithScalesM_ alpha (Herm uplo a) x beta y = do+    (ma,na) <- M.getDim a+    nx <- V.getDim x+    ny <- V.getDim y+    let n = ny+    +    when (ma /= na) $ error $+        printf ("addHermMulVectorWithScalesM_ _"+                ++ " (Herm %s <matrix with dim (%d,%d)>)"+                ++ " %s <vector with dim %d>"+                ++ " _"+                ++ " <vector with dim %d>: Herm matrix is not square")+               (show uplo) ma na+               nx ny+               +    when ((not . and) [ (ma,na) == (n,n)+                      , nx == n+                      , ny == n+                      ]) $ error $+        printf ("addHermMulVectorWithScalesM_ _"+                ++ " (Herm %s <matrix with dim (%d,%d)>)"+                ++ " %s <vector with dim %d>"+                ++ " _"+                ++ " <vector with dim %d>: dimension mismatch")+               (show uplo) ma na+               nx ny++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        V.unsafeWith x $ \px ->+        V.unsafeWith y $ \py ->+            BLAS.hemv uplo n alpha pa lda px 1 beta py 1++-- | @hermMulMatrixTo dst side a b@+-- sets @dst := a * b@ when @side@ is @LeftSide@ and+-- @dst := b * a@ when @side@ is @RightSide@.+hermMulMatrixTo :: (RMatrix m1, RMatrix m2, BLAS3 e)+                => STMatrix s e+                -> Side -> Herm m1 e+                -> m2 e+                -> ST s ()+hermMulMatrixTo dst = hermMulMatrixWithScaleTo dst 1++-- | @hermMulMatrixWithScaleTo dst alpha side a b@+-- sets @dst := alpha * a * b@ when @side@ is @LeftSide@ and+-- @dst := alpha * b * a@ when @side@ is @RightSide@.+hermMulMatrixWithScaleTo :: (RMatrix m1, RMatrix m2, BLAS3 e)+                         => STMatrix s e+                         -> e+                         -> Side -> Herm m1 e+                         -> m2 e+                         -> ST s ()+hermMulMatrixWithScaleTo dst alpha side a b =+    addHermMulMatrixWithScalesM_ alpha side a b 0 dst++-- | @addHermMulMatrixWithScalesM_ alpha side a b beta c@+-- sets @c := alpha * a * b + beta * c@ when @side@ is @LeftSide@ and+-- @c := alpha * b * a + beta * c@ when @side@ is @RightSide@.+addHermMulMatrixWithScalesM_ :: (RMatrix m1, RMatrix m2, BLAS3 e)+                             => e+                             -> Side -> Herm m1 e+                             -> m2 e+                             -> e+                             -> STMatrix s e+                             -> ST s ()+addHermMulMatrixWithScalesM_ alpha side (Herm uplo a) b beta c = do+    (ma,na) <- M.getDim a+    (mb,nb) <- M.getDim b+    (mc,nc) <- M.getDim c+    let (m,n) = (mc,nc)+    +    when (ma /= na) $ error $+        printf ("addHermMulMatrixWithScalesM_ _"+                ++ " %s (Herm %s <matrix with dim (%d,%d)>)" +                ++ " <matrix with dim (%d,%d)>"+                ++ " _"+                ++ " <matrix with dim (%d,%d)>: Herm matrix is not square")+               (show side) (show uplo) ma na+               mb nb+               mc nc+    when ((not . and) [ case side of LeftSide  -> (ma,na) == (m,m)+                                     RightSide -> (ma,na) == (n,n)+                      , (mb, nb ) == (m,n)+                      , (mc, nc ) == (m,n)+                      ]) $ error $+        printf ("addHermMulMatrixWithScalesM_ _"+                ++ " %s (Herm %s <matrix with dim (%d,%d)>)" +                ++ " <matrix with dim (%d,%d)>"+                ++ " _"+                ++ " <matrix with dim (%d,%d)>: dimension mismatch")+               (show side) (show uplo) ma na+               mb nb+               mc nc++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        M.unsafeWith b $ \pb ldb ->+        M.unsafeWith c $ \pc ldc ->+            BLAS.hemm side uplo m n alpha pa lda pb ldb beta pc ldc
+ lib/Numeric/LinearAlgebra/Matrix/ST.hs view
@@ -0,0 +1,128 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix.ST+-- Copyright  : Copyright (c) , Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Mutable matrices in the ST monad.++module Numeric.LinearAlgebra.Matrix.ST (+    -- * Mutable matrices+    STMatrix,+    IOMatrix,+    create,+    +    -- * Read-only matrices+    RMatrix(..),+    +    -- * Creating new matrices+    new_,+    new,+    +    -- * Copying matrices+    newCopy,+    copyTo,++    -- * Matrix views+    withSlice,+    withTakeRows,+    withDropRows,+    withSplitRowsAt,+    withTakeCols,+    withDropCols,+    withSplitColsAt,+    withSliceM,+    withTakeRowsM,+    withDropRowsM,+    withSplitRowsAtM,+    withTakeColsM,+    withDropColsM,+    withSplitColsAtM,+    +    -- * Matrix rows and columns+    rowTo,+    unsafeRowTo,+    setRow,+    unsafeSetRow,+    withCol,++    withColM,+    withColsM,+    +    swapRows,+    unsafeSwapRows,+    swapCols,+    unsafeSwapCols,++    -- * Matrix diagonals+    diagTo,+    setDiag,++    -- * Reading and writing matrix elements+    read,+    write,+    modify,+    getIndices,+    getElems,+    getElems',+    getAssocs,+    getAssocs',+    setElems,+    setAssocs,++    -- * List-like operations+    mapTo,+    zipWithTo,++    -- * Matrix math operations+    shiftDiagM_,+    shiftDiagWithScaleM_,+    addTo,+    subTo,+    scaleM_,+    addWithScaleM_,+    scaleRowsM_,+    scaleColsM_,+    negateTo,+    conjugateTo,++    -- * Linear algebra+    transTo,+    conjTransTo,+    rank1UpdateM_,+    +    -- ** Matrix-Vector multiplication+    mulVectorTo,+    mulVectorWithScaleTo,+    addMulVectorWithScalesM_,+    +    -- ** Matrix-Matrix multiplication+    mulMatrixTo,+    mulMatrixWithScaleTo,+    addMulMatrixWithScalesM_,++    -- * Conversions between mutable and immutable matrices+    freeze,+    +    -- * Vector views of matrices+    maybeWithVectorM,+    +    -- * Matrix views of vectors+    withFromVector,+    withFromCol,+    withFromRow,++    withFromVectorM,+    withFromColM,+    withFromRowM,+    +    -- * Unsafe operations+    unsafeCopyTo,+    unsafeAddWithScaleM_,+    +    ) where++import Prelude()+import Numeric.LinearAlgebra.Matrix.STBase
+ lib/Numeric/LinearAlgebra/Matrix/STBase.hs view
@@ -0,0 +1,1250 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix.STBase+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : asinerimental+--++module Numeric.LinearAlgebra.Matrix.STBase+    where+      +import Control.Monad( forM_, when )+import Control.Monad.ST( ST, RealWorld, runST, unsafeInterleaveST,+    unsafeIOToST )+import Data.Maybe( fromMaybe )+import Data.Typeable( Typeable )+import Foreign( Ptr, advancePtr, peek, peekElemOff, pokeElemOff,+    mallocForeignPtrArray )+import Text.Printf( printf )+import Unsafe.Coerce( unsafeCoerce )++import Numeric.LinearAlgebra.Types+import qualified Foreign.BLAS as BLAS+import Numeric.LinearAlgebra.Matrix.Base hiding ( unsafeWith,+    unsafeToForeignPtr, unsafeFromForeignPtr, )+import qualified Numeric.LinearAlgebra.Matrix.Base as M+import Numeric.LinearAlgebra.Vector( STVector, RVector )+import qualified Numeric.LinearAlgebra.Vector as V++-- | Mutable dense matrices in the 'ST' monad.+newtype STMatrix s e = STMatrix { unSTMatrix :: Matrix e }+    deriving (Typeable)++-- | Mutable dense matrices in the 'IO' monad.+type IOMatrix = STMatrix RealWorld++-- | A safe way to create and work with a mutable matrix before returning +-- an immutable matrix for later perusal. This function avoids copying+-- the matrix before returning it - it uses 'unsafeFreeze' internally,+-- but this wrapper is a safe interface to that function. +create :: (Storable e) => (forall s . ST s (STMatrix s e)) -> Matrix e+create mx = runST $ mx >>= unsafeFreeze+{-# INLINE create #-}++-- | Converts a mutable matrix to an immutable one by taking a complete+-- copy of it.+freeze :: (RMatrix m, Storable e) => m e -> ST s (Matrix e)+freeze a = do+    a' <- newCopy a+    unsafeFreeze a'+{-# INLINE freeze #-}+++-- | Read-only matrices+class RMatrix m where+    -- | Get the dimensions of the matrix (number of rows and columns).+    getDim :: (Storable e) => m e -> ST s (Int,Int)+    +    -- | Same as 'withCol' but does not range-check index.+    unsafeWithCol :: (Storable e)+                  => m e+                  -> Int +                  -> (forall v. RVector v => v e -> ST s a)+                  -> ST s a++    -- | Perform an action with a list of views of the matrix columns.+    withCols :: (Storable e)+                 => m e+                 -> (forall v . RVector v => [v e] -> ST s a)+                 -> ST s a++    -- | Same as 'withSlice' but does not range-check index.+    unsafeWithSlice :: (Storable e)+                    => (Int,Int)+                    -> (Int,Int)+                    -> m e+                    -> (forall m'. RMatrix m' => m' e -> ST s a)+                    -> ST s a++    -- | Possibly view a matrix as a vector and perform an action on the+    -- view.  This only succeeds if the matrix is stored contiguously in+    -- memory, i.e. if the matrix contains a single column or the \"lda\"+    -- of the matrix is equal to the number of rows.+    maybeWithVector :: (Storable e)+                    => m e+                    -> (forall v . RVector v => v e -> ST s a)+                    -> Maybe (ST s a)++    -- | Converts a read-only matrix into an immutable matrix. This simply+    -- casts the matrix from one type to the other without copying.+    -- Note that because the matrix is possibly not copied, any subsequent+    -- modifications made to the read-only version of the matrix may be shared+    -- with the immutable version. It is safe to use, therefore, if the+    -- read-only version is never modified after the freeze operation.+    unsafeFreeze :: (Storable e) => m e -> ST s (Matrix e)++    -- | Unsafe cast from a read-only matrix to a mutable matrix.+    unsafeThaw :: (Storable e)+               => m e -> ST s (STMatrix s e)++    -- | Execute an 'IO' action with a pointer to the first element in the+    -- matrix and the leading dimension (lda).+    unsafeWith :: (Storable e) => m e -> (Ptr e -> Int -> IO a) -> IO a++instance RMatrix Matrix where+    getDim = return . dim+    {-# INLINE getDim #-}+    unsafeWithCol a j f = f (unsafeCol a j)+    {-# INLINE unsafeWithCol #-}+    withCols a f = f (cols a)+    {-# INLINE withCols #-}+    unsafeWithSlice ij mn a f = f (unsafeSlice ij mn a)+    {-# INLINE unsafeWithSlice #-}+    maybeWithVector a f | isContig a = Just $ f (toVector a)+                        | otherwise = Nothing+    {-# INLINE maybeWithVector #-}+    unsafeWith = M.unsafeWith+    {-# INLINE unsafeWith #-}+    unsafeFreeze = return+    {-# INLINE unsafeFreeze #-}+    unsafeThaw = return . STMatrix+    {-# INLINE unsafeThaw #-}+++instance RMatrix (STMatrix s) where+    getDim = return . dim . unSTMatrix+    {-# INLINE getDim #-}+    unsafeWithCol = unsafeWithCol . unSTMatrix+    {-# INLINE unsafeWithCol #-}+    withCols = withCols . unSTMatrix+    {-# INLINE withCols #-}+    unsafeWithSlice ij mn = unsafeWithSlice ij mn . unSTMatrix+    {-# INLINE unsafeWithSlice #-}+    maybeWithVector = maybeWithVector . unSTMatrix+    {-# INLINE maybeWithVector #-}+    unsafeWith = unsafeWith . unSTMatrix+    {-# INLINE unsafeWith #-}+    unsafeFreeze = return . unSTMatrix+    {-# INLINE unsafeFreeze #-}+    unsafeThaw v = return $ cast v+      where+        cast :: STMatrix s e -> STMatrix s' e+        cast = unsafeCoerce+    {-# INLINE unsafeThaw #-}++++-- | Perform an action with a view of a mutable matrix column+-- (no index checking).+unsafeWithColM :: (Storable e)+               => STMatrix s e+               -> Int+               -> (STVector s e -> ST s a)+               -> ST s a+unsafeWithColM a j f = +    unsafeWithCol a j $ \c -> do+        mc <- V.unsafeThaw c+        f mc+{-# INLINE unsafeWithColM #-}++-- | Perform an action with a list of views of the mutable matrix columns. See+-- also 'withCols'.+withColsM :: (Storable e)+               => STMatrix s e+               -> ([STVector s e] -> ST s a)+               -> ST s a+withColsM a f =+    withCols a $ \cs -> do+        mcs <- thawVecs cs+        f mcs+  where+    thawVecs [] = return []+    thawVecs (c:cs) = unsafeInterleaveST $ do+        mc <- V.unsafeThaw c+        mcs <- thawVecs cs+        return $ mc:mcs+{-# INLINE withColsM #-}+++-- | Possibly view a matrix as a vector and perform an action on the+-- view.  This succeeds when the matrix is stored contiguously in memory,+-- i.e. if the matrix contains a single column or the \"lda\" of the matrix+-- is equal to the number of rows.  See also 'maybeWithVector'.+maybeWithVectorM :: (Storable e)+                 => STMatrix s e+                 -> (STVector s e -> ST s a)+                 -> Maybe (ST s a)+maybeWithVectorM a f = +    maybeWithVector a $ \v -> do+        mv <- V.unsafeThaw v+        f mv+{-# INLINE maybeWithVectorM #-}+++-- | View a vector as a matrix of the given shape and pass it to+-- the specified function.+withFromVector :: (RVector v, Storable e)+                   => (Int,Int)+                   -> v e+                   -> (forall m . RMatrix m => m e -> ST s a)+                   -> ST s a+withFromVector mn@(m,n) v f = do+    nv <- V.getDim v+    when (nv /= m*n) $ error $+        printf ("withFromVector (%d,%d) <vector with dim %d>:"+                ++ " dimension mismatch") m n nv+    iv <- V.unsafeFreeze v+    f $ fromVector mn iv+{-# INLINE withFromVector #-}+++-- | View a mutable vector as a mutable matrix of the given shape and pass it+-- to the specified function.+withFromVectorM :: (Storable e)+                     => (Int,Int)+                     -> STVector s e+                     -> (STMatrix s e -> ST s a)+                     -> ST s a+withFromVectorM mn@(m,n) v f = do+    nv <- V.getDim v+    when (nv /= m*n) $ error $+        printf ("withFromVectorM (%d,%d) <vector with dim %d>:"+                ++ " dimension mismatch") m n nv+    withFromVector mn v $ \a -> do+        ma <- unsafeThaw a+        f ma+{-# INLINE withFromVectorM #-}+++-- | View a vector as a matrix with one column and pass it to+-- the specified function.+withFromCol :: (RVector v, Storable e)+                => v e+                -> (forall m . RMatrix m => m e -> ST s a)+                -> ST s a+withFromCol v f = do+    m <- V.getDim v+    withFromVector (m,1) v f+{-# INLINE withFromCol #-}+++-- | View a mutable vector as a mutable matrix with one column and pass it to+-- the specified function.+withFromColM :: (Storable e)+                  => STVector s e+                  -> (STMatrix s e -> ST s a)+                  -> ST s a+withFromColM v f = do+    m <- V.getDim v+    withFromVectorM (m, 1) v f+{-# INLINE withFromColM #-}+++-- | View a vector as a matrix with one row and pass it to+-- the specified function.+withFromRow :: (RVector v, Storable e)+                => v e+                -> (forall m . RMatrix m => m e -> ST s a)+                -> ST s a+withFromRow v f = do+    n <- V.getDim v+    withFromVector (1,n) v f+{-# INLINE withFromRow #-}++-- | View a mutable vector as a mutable matrix with one row and pass it to+-- the specified function.+withFromRowM :: (Storable e)+                  => STVector s e+                  -> (STMatrix s e -> ST s a)+                  -> ST s a+withFromRowM v f = do+    n <- V.getDim v+    withFromVectorM (1,n) v f+{-# INLINE withFromRowM #-}++-- | Perform an action with a view of a matrix column.+withCol :: (RMatrix m, Storable e)+            => m e+            -> Int+            -> (forall v . RVector v => v e -> ST s a)+            -> ST s a+withCol a j f = do+    (m,n) <- getDim a+    when (j < 0 || j >= n) $ error $+        printf ("withCol <matrix with dim (%d,%d)> %d:"+                ++ " index out of range") m n j++    unsafeWithCol a j f+{-# INLINE withCol #-}++-- | Like 'withCol', but perform the action with a mutable view.+withColM :: (Storable e)+         => STMatrix s e+         -> Int+         -> (STVector s e -> ST s a)+         -> ST s a+withColM a j f = do+    (m,n) <- getDim a+    when (j < 0 || j >= n) $ error $+        printf ("withColM <matrix with dim (%d,%d)> %d:"+                ++ " index out of range") m n j++    unsafeWithColM a j f+{-# INLINE withColM #-}++-- | Create a new matrix of given shape, but do not initialize the elements.+new_ :: (Storable e) => (Int,Int) -> ST s (STMatrix s e)+new_ (m,n) +    | m < 0 || n < 0 = error $+        printf "new_ (%d,%d): invalid dimensions" m n+    | otherwise = unsafeIOToST $ do+        f <- mallocForeignPtrArray (m*n)+        return $ STMatrix $ M.unsafeFromForeignPtr f 0 (m,n) (max 1 m)++-- | Create a matrix with every element initialized to the same value.+new :: (Storable e) => (Int,Int) -> e -> ST s (STMatrix s e)+new (m,n) e = do+    a <- new_ (m,n)+    setElems a $ replicate (m*n) e+    return a++-- | Creates a new matrix by copying another one.    +newCopy :: (RMatrix m, Storable e) => m e -> ST s (STMatrix s e)+newCopy a = do+    mn <- getDim a+    b <- new_ mn+    unsafeCopyTo b a+    return b++-- | @copyTo dst src@ replaces the values in @dst@ with those in+-- source.  The operands must be the same shape.+copyTo :: (RMatrix m, Storable e) => STMatrix s e -> m e -> ST s ()+copyTo = checkOp2 "copyTo" unsafeCopyTo+{-# INLINE copyTo #-}++-- | Same as 'copyTo' but does not range-check indices.+unsafeCopyTo :: (RMatrix m, Storable e) => STMatrix s e -> m e -> ST s ()+unsafeCopyTo = vectorOp2 V.unsafeCopyTo+{-# INLINE unsafeCopyTo #-}++-- | Get the indices of the elements in the matrix, in column-major order.+getIndices :: (RMatrix m, Storable e) => m e -> ST s [(Int,Int)]+getIndices a = do+    (m,n) <- getDim a+    return $ [ (i,j) | j <- [ 0..n-1 ], i <- [ 0..m-1 ] ]+  +-- | Lazily get the elements of the matrix, in column-major order.  +getElems :: (RMatrix m, Storable e) => m e -> ST s [e]+getElems a = case maybeWithVector a V.getElems of+    Just es -> es+    Nothing -> withCols a $ \xs ->+                   concat `fmap` mapM V.getElems xs++-- | Get the elements of the matrix, in column-major order.+getElems' :: (RMatrix m, Storable e) => m e -> ST s [e]+getElems' a = case maybeWithVector a V.getElems' of+    Just es -> es+    Nothing -> withCols a $ \xs ->+                   concat `fmap` mapM V.getElems' xs++-- | Lazily get the association list of the matrix, in column-major order.+getAssocs :: (RMatrix m, Storable e) => m e -> ST s [((Int,Int),e)]+getAssocs a = do+    is <- getIndices a+    es <- getElems a+    return $ zip is es++-- | Get the association list of the matrix, in column-major order.+getAssocs' :: (RMatrix m, Storable e) => m e -> ST s [((Int,Int),e)]+getAssocs' a = do+    is <- getIndices a+    es <- getElems' a+    return $ zip is es++-- | Set all of the values of the matrix from the elements in the list,+-- in column-major order.+setElems :: (Storable e) => STMatrix s e -> [e] -> ST s ()+setElems a es =+    case maybeWithVectorM a (`V.setElems` es) of+        Just st  -> st+        Nothing -> do+            (m,n) <- getDim a+            go m n 0 es+  where+    go _ n j [] | j == n = return ()+    go m n j [] | j < n = error $ +        printf ("setElems <matrix with dim (%d,%d>"+                ++ "<list with length %d>: not enough elements)") m n (j*m)+    go m n j es' =+        let (es1', es2') = splitAt m es'+        in do+            withColM a j (`V.setElems` es1')+            go m n (j+1) es2'++-- | Set the given values in the matrix.  If an index is repeated twice,+-- the value is implementation-defined.+setAssocs :: (Storable e) => STMatrix s e -> [((Int,Int),e)] -> ST s ()+setAssocs a ies =+    sequence_ [ write a i e | (i,e) <- ies ]++-- | Same as 'setAssocs' but does not range-check indices.+unsafeSetAssocs :: (Storable e) => STMatrix s e -> [((Int,Int),e)] -> ST s ()+unsafeSetAssocs a ies =+    sequence_ [ unsafeWrite a i e | (i,e) <- ies ]++-- | Set the specified row of the matrix to the given vector.+setRow :: (RVector v, Storable e)+       => STMatrix s e -> Int -> v e -> ST s ()+setRow a i x = do+    (m,n) <- getDim a+    nx <- V.getDim x+    +    when (i < 0 || i >= m) $ error $+        printf ("setRow <matrix with dim (%d,%d)> %d:"+                ++ " index out of range") m n i+    when (nx /= n) $ error $+        printf ("setRow <matrix with dim (%d,%d)> _"+                ++ " <vector with dim %d>:"+                ++ " dimension mismatch") m n nx++    unsafeSetRow a i x+{-# INLINE setRow #-}++-- | Same as 'setRow' but does not range-check index or check+-- vector dimension.+unsafeSetRow :: (RVector v, Storable e)+             => STMatrix s e -> Int -> v e -> ST s ()+unsafeSetRow a i x = do+    jes <- V.getAssocs x+    sequence_ [ unsafeWrite a (i,j) e | (j,e) <- jes ]+{-# INLINE unsafeSetRow #-}++-- | Exchange corresponding elements in the given rows.+swapRows :: (BLAS1 e)+         => STMatrix s e -> Int -> Int -> ST s ()+swapRows a i1 i2 = do+    (m,n) <- getDim a+    when (i1 < 0 || i1 >= m || i2 < 0 || i2 >= m) $ error $+        printf ("swapRows <matrix with dim (%d,%d)> %d %d"+                ++ ": index out of range") m n i1 i2+    unsafeSwapRows a i1 i2++-- | Same as 'swapRows' but does not range-check indices.+unsafeSwapRows :: (BLAS1 e)+               => STMatrix s e -> Int -> Int -> ST s ()+unsafeSwapRows a i1 i2 = when (i1 /= i2) $ do+    (_,n) <- getDim a+    unsafeIOToST $+        unsafeWith a $ \pa lda ->+            let px = pa `advancePtr` i1+                py = pa `advancePtr` i2+                incx = lda+                incy = lda+            in+                BLAS.swap n px incx py incy++-- | Exchange corresponding elements in the given columns.+swapCols :: (BLAS1 e)+         => STMatrix s e -> Int -> Int -> ST s ()+swapCols a j1 j2 = do+    (m,n) <- getDim a+    when (j1 < 0 || j1 >= n || j2 < 0 || j2 >= n) $ error $+        printf ("swapCols <matrix with dim (%d,%d)> %d %d"+                ++ ": index out of range") m n j1 j2+    unsafeSwapCols a j1 j2++-- | Same as 'swapCols' but does not range-check indices.+unsafeSwapCols :: (BLAS1 e)+               => STMatrix s e -> Int -> Int -> ST s ()+unsafeSwapCols a j1 j2 = when (j1 /= j2) $ do+    (m,_) <- getDim a+    unsafeIOToST $+        unsafeWith a $ \pa lda ->+            let px = pa `advancePtr` (j1*lda)+                py = pa `advancePtr` (j2*lda)+                incx = 1+                incy = 1+            in+                BLAS.swap m px incx py incy++-- | Copy the specified row of the matrix to the vector.+rowTo :: (RMatrix m, Storable e)+         => STVector s e -> m e -> Int -> ST s ()+rowTo x a i = do+    (m,n) <- getDim a+    nx <- V.getDim x+    when (i < 0 || i >= m) $ error $+        printf ("rowTo"+               ++ " _"+               ++ " <matrix with dim (%d,%d)>"+               ++ " %d:"+               ++ ": index out of range"+               ) m n i+    when (nx /= n) $ error $+        printf ("rowTo"+                ++ " <vector with dim %d>"+                ++ " <matrix with dim (%d,%d)>"+                ++ " _"+                ++ ": dimension mismatch") nx m n++    unsafeRowTo x a i+{-# INLINE rowTo #-}++-- | Same as 'rowTo' but does not range-check index or check dimension.+unsafeRowTo :: (RMatrix m, Storable e)+            =>  STVector s e -> m e -> Int ->ST s ()+unsafeRowTo x a i = do+    (_,n) <- getDim a+    forM_ [ 0..n-1 ] $ \j -> do+        e <- unsafeRead a (i,j)+        V.unsafeWrite x j e+{-# INLINE unsafeRowTo #-}++-- | Set the diagonal of the matrix to the given vector.+setDiag :: (RVector v, Storable e)+        => STMatrix s e -> v e -> ST s ()+setDiag a x = do+    (m,n) <- getDim a+    nx <- V.getDim x+    let mn = min m n+    +    when (nx /= mn) $ error $+        printf ("setRow <matrix with dim (%d,%d)>"+                ++ " <vector with dim %d>:"+                ++ " dimension mismatch") m n nx++    unsafeSetDiag a x+{-# INLINE setDiag #-}++-- | Same as 'setDiag' but does not range-check index or check dimension.+unsafeSetDiag :: (RVector v, Storable e)+              => STMatrix s e -> v e -> ST s ()+unsafeSetDiag a x = do+    ies <- V.getAssocs x+    sequence_ [ unsafeWrite a (i,i) e | (i,e) <- ies ]+{-# INLINE unsafeSetDiag #-}++-- | Copy the diagonal of the matrix to the vector.+diagTo :: (RMatrix m, Storable e)+       => STVector s e -> m e -> ST s ()+diagTo x a = do+    nx <- V.getDim x+    (m,n) <- getDim a+    let mn = min m n+    +    when (nx /= mn) $ error $+        printf ("diagTo"+                ++ " <vector with dim %d>"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch") nx m n++    unsafeDiagTo x a+{-# INLINE diagTo #-}++-- | Same as 'diagTo' but does not range-check index or check dimensions.+unsafeDiagTo :: (RMatrix m, Storable e)+             => STVector s e -> m e -> ST s ()+unsafeDiagTo x a = do+    (m,n) <- getDim a+    let mn = min m n+    forM_ [ 0..mn-1 ] $ \i -> do+        e <- unsafeRead a (i,i)+        V.unsafeWrite x i e+{-# INLINE unsafeDiagTo #-}++-- | Get the element stored at the given index.+read :: (RMatrix m, Storable e) => m e -> (Int,Int) -> ST s e+read a (i,j) = do+    (m,n) <- getDim a+    when (i < 0 || i >= m || j < 0 || j >= n) $ error $+        printf ("read <matrix with dim (%d,%d)> (%d,%d):"+                ++ " index out of range") m n i j+    unsafeRead a (i,j)+{-# INLINE read #-}++-- | Same as 'read' but does not range-check index.+unsafeRead :: (RMatrix m, Storable e) => m e -> (Int,Int) -> ST s e+unsafeRead a (i,j) = unsafeIOToST $+    unsafeWith a $ \p lda ->+        peekElemOff p (i + j * lda)+{-# INLINE unsafeRead #-}++-- | Set the element stored at the given index.+write :: (Storable e)+      => STMatrix s e -> (Int,Int) -> e -> ST s ()+write a (i,j) e = do+    (m,n) <- getDim a+    when (i < 0 || i >= m || j < 0 || j >= n) $ error $+        printf ("write <matrix with dim (%d,%d)> (%d,%d):"+                ++ " index out of range") m n i j+    unsafeWrite a (i,j) e+    +{-# INLINE write #-}++-- | Same as 'write' but does not range-check index.+unsafeWrite :: (Storable e)+            => STMatrix s e -> (Int,Int) -> e -> ST s ()+unsafeWrite a (i,j) e = unsafeIOToST $+    unsafeWith a $ \p lda ->+        pokeElemOff p (i + j * lda) e+{-# INLINE unsafeWrite #-}++-- | Modify the element stored at the given index.+modify :: (Storable e)+       => STMatrix s e -> (Int,Int) -> (e -> e) -> ST s ()+modify a (i,j) f = do+    (m,n) <- getDim a+    when (i < 0 || i >= m || j < 0 || j >= n) $ error $+        printf ("modify <matrix with dim (%d,%d)> (%d,%d):"+                ++ " index out of range") m n i j+    unsafeModify a (i,j) f+{-# INLINE modify #-}++-- | Same as 'modify' but does not range-check index.+unsafeModify :: (Storable e)+             => STMatrix s e -> (Int,Int) -> (e -> e) -> ST s ()+unsafeModify a (i,j) f = unsafeIOToST $+    unsafeWith a $ \p lda -> +        let o = i + j * lda+        in do+            e <- peekElemOff p o+            pokeElemOff p o $ f e+{-# INLINE unsafeModify #-}++-- | @mapTo dst f src@ replaces @dst@ elementwise with @f(src)@.+mapTo :: (RMatrix m, Storable e, Storable f)+      => STMatrix s f+      -> (e -> f)+      -> m e+      -> ST s ()+mapTo dst f src = (checkOp2 "mapTo _" $ \z x -> unsafeMapTo z f x) dst src+{-# INLINE mapTo #-}+             +-- | Same as 'mapTo' but does not check dimensions.+unsafeMapTo :: (RMatrix m, Storable e, Storable f)+            => STMatrix s f+            -> (e -> f)+            -> m e+            -> ST s ()+unsafeMapTo dst f src =+    fromMaybe colwise $ maybeWithVectorM dst $ \vdst ->+    fromMaybe colwise $ maybeWithVector  src $ \vsrc ->+        V.unsafeMapTo vdst f vsrc+  where+    colwise = withColsM dst $ \zs ->+              withCols   src $ \xs ->+                  sequence_ [ V.unsafeMapTo z f x+                            | (z,x) <- zip zs xs+                            ]++-- | @zipWithTo dst f x y@ replaces @dst@ elementwise with @f(x, y)@.+zipWithTo :: (RMatrix m1, RMatrix m2, Storable e1, Storable e2, Storable f)+          => STMatrix s f+          -> (e1 -> e2 -> f)+          -> m1 e1+          -> m2 e2+          -> ST s ()+zipWithTo dst f x y = +    (checkOp3 "zipWithTo _" $ \dst1 x1 y1 -> unsafeZipWithTo dst1 f x1 y1)+        dst x y+{-# INLINE zipWithTo #-}++-- | Same as 'zipWithTo' but does not check dimensions.+unsafeZipWithTo :: (RMatrix m1, RMatrix m2, Storable e1, Storable e2, Storable f)+                => STMatrix s f+                -> (e1 -> e2 -> f)+                -> m1 e1+                -> m2 e2+                -> ST s ()+unsafeZipWithTo dst f x y =+    fromMaybe colwise $ maybeWithVectorM dst $ \vdst ->+    fromMaybe colwise $ maybeWithVector    x $ \vx ->+    fromMaybe colwise $ maybeWithVector    y $ \vy ->+        V.unsafeZipWithTo vdst f vx vy+  where+    colwise = withColsM dst $ \vdsts ->+              withCols   x $ \vxs ->+              withCols   y $ \vys ->+              +                  sequence_ [ V.unsafeZipWithTo vdst f vx vy+                            | (vdst,vx,vy) <- zip3 vdsts vxs vys+                            ]++-- | Set every element in the matrix to a default value.  For+-- standard numeric types (including 'Double', 'Complex Double', and 'Int'),+-- the default value is '0'.+clear :: (Storable e) => STMatrix s e -> ST s ()+clear a = fromMaybe colwise $ maybeWithVectorM a V.clear+  where+    colwise = withColsM a $ mapM_ V.clear++-- | @withSlice (i,j) (m,n) a@ performs an action with a view of the+-- submatrix of @a@ starting at index @(i,j)@ and having dimension @(m,n)@.+withSlice :: (RMatrix m, Storable e)+          => (Int,Int)+          -> (Int,Int)+          -> m e+          -> (forall m'. RMatrix m' => m' e -> ST s a)+          -> ST s a+withSlice ij mn a f = do+    ia <- unsafeFreeze a+    f $ slice ij mn ia++-- | Like 'withSlice', but perform the action with a mutable view.+withSliceM :: (Storable e)+           => (Int,Int)+           -> (Int,Int)+           -> STMatrix s e+           -> (STMatrix s e -> ST s a)+           -> ST s a+withSliceM ij mn a f =+    withSlice ij mn a $ \a' -> do+        ma <- unsafeThaw a'+        f ma++-- | Perform an action with a view gotten from taking the given number of+-- rows from the start of the matrix.+withTakeRows :: (RMatrix m, Storable e)+             => Int+             -> m e+             -> (forall m'. RMatrix m' => m' e -> ST s a)+             -> ST s a+withTakeRows i a f = do+    ia <- unsafeFreeze a+    f $ takeRows i ia++-- | Like 'withTakeRows', but perform the action with a mutable view.+withTakeRowsM :: (Storable e)+              => Int+              -> STMatrix s e+              -> (STMatrix s e -> ST s a)+              -> ST s a+withTakeRowsM i a f =+    withTakeRows i a $ \a' -> do+        ma <- unsafeThaw a'+        f ma++-- | Perform an action with a view gotten from dropping the given number of+-- rows from the start of the matrix.+withDropRows :: (RMatrix m, Storable e)+             => Int+             -> m e+             -> (forall m'. RMatrix m' => m' e -> ST s a)+             -> ST s a+withDropRows n a f = do+    ia <- unsafeFreeze a+    f $ dropRows n ia++-- | Like 'withDropRows', but perform the action with a mutable view.+withDropRowsM :: (Storable e)+              => Int+              -> STMatrix s e+              -> (STMatrix s e -> ST s a)+              -> ST s a+withDropRowsM i a f =+    withDropRows i a $ \a' -> do+        ma <- unsafeThaw a'+        f ma++-- | Perform an action with views from splitting the matrix rows at the given+-- index.+withSplitRowsAt :: (RMatrix m, Storable e)+                => Int+                -> m e+                -> (forall m1 m2. (RMatrix m1, RMatrix m2) => m1 e -> m2 e -> ST s a)+                -> ST s a+withSplitRowsAt i a f = do+    ia <- unsafeFreeze a+    uncurry f $ splitRowsAt i ia++-- | Like 'withSplitRowsAt', but perform the action with a mutable view.+withSplitRowsAtM :: (Storable e)+                 => Int+                 -> STMatrix s e+                 -> (STMatrix s e -> STMatrix s e -> ST s a)+                 -> ST s a+withSplitRowsAtM i a f =+    withSplitRowsAt i a $ \a1' a2' -> do+        ma1 <- unsafeThaw a1'+        ma2 <- unsafeThaw a2'        +        f ma1 ma2+    +-- | Perform an action with a view gotten from taking the given number of+-- columns from the start of the matrix.+withTakeCols :: (RMatrix m, Storable e)+             => Int+             -> m e+             -> (forall m'. RMatrix m' => m' e -> ST s a)+             -> ST s a+withTakeCols i a f = do+    ia <- unsafeFreeze a+    f $ takeCols i ia++-- | Like 'withTakeCols', but perform the action with a mutable view.+withTakeColsM :: (Storable e)+              => Int+              -> STMatrix s e+              -> (STMatrix s e -> ST s a)+              -> ST s a+withTakeColsM i a f =+    withTakeCols i a $ \a' -> do+        ma <- unsafeThaw a'+        f ma++-- | Perform an action with a view gotten from dropping the given number of+-- columns from the start of the matrix.+withDropCols :: (RMatrix m, Storable e)+             => Int+             -> m e+             -> (forall m'. RMatrix m' => m' e -> ST s a)+             -> ST s a+withDropCols n a f = do+    ia <- unsafeFreeze a+    f $ dropCols n ia++-- | Like 'withDropCols', but perform the action with a mutable view.+withDropColsM :: (Storable e)+              => Int+              -> STMatrix s e+              -> (STMatrix s e -> ST s a)+              -> ST s a+withDropColsM i a f =+    withDropCols i a $ \a' -> do+        ma <- unsafeThaw a'+        f ma++-- | Perform an action with views from splitting the matrix columns at the given+-- index.+withSplitColsAt :: (RMatrix m, Storable e)+                => Int+                -> m e+                -> (forall m1 m2. (RMatrix m1, RMatrix m2) => m1 e -> m2 e -> ST s a)+                -> ST s a+withSplitColsAt i a f = do+    ia <- unsafeFreeze a+    uncurry f $ splitColsAt i ia++-- | Like 'withSplitColsAt', but perform the action with mutable views.    +withSplitColsAtM :: (Storable e)+                 => Int+                 -> STMatrix s e+                 -> (STMatrix s e -> STMatrix s e -> ST s a)+                 -> ST s a+withSplitColsAtM i a f =+    withSplitColsAt i a $ \a1' a2' -> do+        ma1 <- unsafeThaw a1'+        ma2 <- unsafeThaw a2'        +        f ma1 ma2+++-- | Add a vector to the diagonal of a matrix.+shiftDiagM_ :: (RVector v, BLAS1 e)+              => v e -> STMatrix s e -> ST s ()+shiftDiagM_ s a = do+    (m,n) <- getDim a+    ns <- V.getDim s+    let mn = min m n+    +    when (ns /= mn) $ error $+        printf ("shiftDiagM_"+                ++ " <vector with dim %d>"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch")+                ns+                m n+    +    shiftDiagWithScaleM_ 1 s a+    ++-- | Add a scaled vector to the diagonal of a matrix.+shiftDiagWithScaleM_ :: (RVector v, BLAS1 e)+                       => e -> v e -> STMatrix s e -> ST s ()+shiftDiagWithScaleM_ e s a = do+    (m,n) <- getDim a+    ns <- V.getDim s+    let mn = min m n++    when (ns /= mn) $ error $+        printf ("shiftDiagWithScaleM_"+                ++ " _"+                ++ " <vector with dim %d>"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch")+                ns+                m n++    unsafeIOToST $+        V.unsafeWith s $ \ps ->+        unsafeWith a $ \pa lda ->+            BLAS.axpy mn e ps 1 pa (lda+1)+++-- | Add two matrices.+addTo :: (RMatrix m1, RMatrix m2, VNum e)+      =>  STMatrix s e -> m1 e -> m2 e -> ST s ()+addTo = checkOp3 "addTo" $ vectorOp3 V.addTo++-- | Subtract two matrices.+subTo :: (RMatrix m1, RMatrix m2, VNum e)+      => STMatrix s e -> m1 e -> m2 e -> ST s ()+subTo = checkOp3 "subTo" $ vectorOp3 V.subTo++-- | Conjugate the entries of a matrix.+conjugateTo :: (RMatrix m, VNum e)+            => STMatrix s e -> m e -> ST s ()+conjugateTo = checkOp2 "conjugateTo" $+    vectorOp2 V.conjugateTo++-- | Negate the entries of a matrix.+negateTo :: (RMatrix m, VNum e)+         => STMatrix s e -> m e -> ST s ()+negateTo = checkOp2 "negateTo" $+    vectorOp2 V.negateTo++-- | Scale the entries of a matrix by the given value.+scaleM_ :: (BLAS1 e)+          => e -> STMatrix s e -> ST s ()+scaleM_ e = vectorOp (V.scaleM_ e)++-- | @addWithScaleM_ alpha x y@ sets @y := alpha * x + y@.+addWithScaleM_ :: (RMatrix m, BLAS1 e)+               => e -> m e -> STMatrix s e -> ST s ()+addWithScaleM_ e = checkOp2 "addWithScaleM_" $+    unsafeAddWithScaleM_ e++unsafeAddWithScaleM_ :: (RMatrix m, BLAS1 e)+                     => e -> m e -> STMatrix s e -> ST s ()+unsafeAddWithScaleM_ alpha x y =+    fromMaybe colwise $ maybeWithVector  x $ \vx ->+    fromMaybe colwise $ maybeWithVectorM y $ \vy ->+        V.unsafeAddWithScaleM_ alpha vx vy+  where+    colwise = withCols   x $ \vxs ->+              withColsM y $ \vys ->+                  sequence_ [ V.unsafeAddWithScaleM_ alpha vx vy+                            | (vx,vy) <- zip vxs vys ]                ++-- | Scale the rows of a matrix; @scaleRowsM_ s a@ sets+-- @a := diag(s) * a@.+scaleRowsM_ :: (RVector v, BLAS1 e)+              => v e -> STMatrix s e -> ST s ()+scaleRowsM_  s a = do+    (m,n) <- getDim a+    ns <- V.getDim s+    when (ns /= m) $ error $+        printf ("scaleRowsM_"+                ++ " <vector with dim %d>"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch")+                ns+                m n++    unsafeIOToST $+        V.unsafeWith s $ \ps ->+        unsafeWith a   $ \pa lda ->+            go m n lda pa ps 0+  where+    go m n lda pa ps i | i == m    = return ()+                       | otherwise = do+                             e <- peek ps+                             BLAS.scal n e pa lda+                             go m n lda (pa `advancePtr` 1)+                                        (ps `advancePtr` 1)+                                        (i+1)++-- | Scale the columns of a matrix; @scaleColBysM_ s a@ sets+-- @a := a * diag(s)@.+scaleColsM_ :: (RVector v, BLAS1 e)+            => v e -> STMatrix s e -> ST s ()+scaleColsM_ s a = do+    (m,n) <- getDim a+    ns <- V.getDim s+    when (ns /= n) $ error $+        printf ("scaleColsM_"+                ++ " <vector with dim %d>"+                ++ " <matrix with dim (%d,%d)>"        +                ++ ": dimension mismatch") +                ns+                m n++    es <- V.getElems s+    withColsM a $ \xs ->+        sequence_ [ V.scaleM_ e x+                  | (e,x) <- zip es xs+                  ]+++-- | @rank1UpdateM_ alpha x y a@ sets @a := alpha * x * y^H + a@.+rank1UpdateM_ :: (RVector v1, RVector v2, BLAS2 e)+              => e -> v1 e -> v2 e -> STMatrix s e -> ST s ()+rank1UpdateM_ alpha x y a = do+    (m,n) <- getDim a    +    nx <- V.getDim x+    ny <- V.getDim y+    +    when (nx /= m || ny /= n) $ error $+        printf ("rank1UpdateTo"+                ++ " _"+                ++ " <vector with dim %d>"+                ++ " <vector with dim %d>"+                ++ ": dimension mismatch"+                ++ "<matrix with dim (%d,%d)>"                )+                nx+                ny+                m n+    +    unsafeIOToST $+        V.unsafeWith x $ \px ->+        V.unsafeWith y $ \py ->+        unsafeWith a $ \pa lda ->+            BLAS.gerc m n alpha px 1 py 1 pa lda+++-- | @transTo dst a@ sets @dst := trans(a)@.+transTo :: (RMatrix m, BLAS1 e)+        => STMatrix s e+        -> m e+        -> ST s ()+transTo a' a = do+    (ma,na) <- getDim a+    (ma',na') <- getDim a'+    let (m,n) = (ma,na)++    when ((ma,na) /= (na',ma')) $ error $+        printf ( "transTo"+               ++ " <matrix with dim (%d,%d)>"+               ++ " <matrix with dim (%d,%d)>"+               ++ ": dimension mismatch"+               )+               ma' na'+               ma na+    +    unsafeIOToST $+        unsafeWith a' $ \pa' lda' ->+        unsafeWith a $ \pa lda -> let+            go j px py | j == n = return ()+                       | otherwise = do+                           BLAS.copy m px 1 py lda'+                           go (j+1) (px `advancePtr` lda) (py `advancePtr` 1)+            in go 0 pa pa'+++-- | @conjTransTo dst a@ sets @dst := conjugate(trans(a))@.+conjTransTo :: (RMatrix m, BLAS1 e)+            => STMatrix s e+            -> m e+            -> ST s ()+conjTransTo a' a = do+    transTo a' a+    conjugateTo a' a'++-- | @mulVectorTo dst transa a x@+-- sets @dst := op(a) * x@, where @op(a)@ is determined by @transa@.                   +mulVectorTo :: (RMatrix m, RVector v, BLAS2 e)+            => STVector s e+            -> Trans -> m e+            -> v e+            -> ST s ()+mulVectorTo dst = mulVectorWithScaleTo dst 1++-- | @mulVectorWithScaleTo dst alpha transa a x@+-- sets @dst := alpha * op(a) * x@, where @op(a)@ is determined by @transa@.                   +mulVectorWithScaleTo :: (RMatrix m, RVector v, BLAS2 e)+                     => STVector s e+                     -> e+                     -> Trans -> m e+                     -> v e+                     -> ST s ()+mulVectorWithScaleTo dst alpha t a x =+    addMulVectorWithScalesM_ alpha t a x 0 dst++-- | @addMulVectorWithScalesM_ alpha transa a x beta y@+-- sets @y := alpha * op(a) * x + beta * y@, where @op(a)@ is+-- determined by @transa@.+addMulVectorWithScalesM_ :: (RMatrix m, RVector v, BLAS2 e)+                         => e+                         -> Trans -> m e+                         -> v e+                         -> e+                         -> STVector s e+                         -> ST s ()+addMulVectorWithScalesM_ alpha transa a x beta y = do+    (ma,na) <- getDim a+    nx <- V.getDim x+    ny <- V.getDim y+    let (m,n) = (ny,nx)++    when ((not . and) [ case transa of NoTrans -> (ma,na) == (m,n)+                                       _       -> (ma,na) == (n,m)+                      , nx == n+                      , ny == m+                      ]) $ error $+        printf ("addMulVectorWithScalesTo"+                ++ " _"+                ++ " %s"+                ++ " <matrix with dim (%d,%d)>" +                ++ " <vector with dim %d>"+                ++ " _"+                ++ " <vector with dim %d>"+                ++ ": dimension mismatch")+               (show transa)+               ma na+               nx+               ny++    unsafeIOToST $+        unsafeWith a $ \pa lda ->+        V.unsafeWith x $ \px ->+        V.unsafeWith y $ \py ->+            if n == 0+                then BLAS.scal m beta py 1+                else BLAS.gemv transa ma na alpha pa lda px 1 beta py 1++-- | @mulMatrixTo dst transa a transb b@+-- sets @dst := op(a) * op(b)@, where @op(a)@ and @op(b)@ are determined+-- by @transa@ and @transb@.                   +mulMatrixTo :: (RMatrix m1, RMatrix m2, BLAS3 e)+            => STMatrix s e+            -> Trans -> m1 e+            -> Trans -> m2 e+            -> ST s ()+mulMatrixTo dst = mulMatrixWithScaleTo dst 1++-- | @mulMatrixWithScaleTo alpha transa a transb b c@+-- sets @c := alpha * op(a) * op(b)@, where @op(a)@ and @op(b)@ are determined+-- by @transa@ and @transb@.                   +mulMatrixWithScaleTo :: (RMatrix m1, RMatrix m2, BLAS3 e)+                     => STMatrix s e+                     -> e+                     -> Trans -> m1 e+                     -> Trans -> m2 e+                     -> ST s ()+mulMatrixWithScaleTo dst alpha ta a tb b =+    addMulMatrixWithScalesM_ alpha ta a tb b 0 dst++-- | @addMulMatrixWithScalesM_ alpha transa a transb b beta c@+-- sets @c := alpha * op(a) * op(b) + beta * c@, where @op(a)@ and+-- @op(b)@ are determined by @transa@ and @transb@.+addMulMatrixWithScalesM_ :: (RMatrix m1, RMatrix m2, BLAS3 e)+                         => e+                         -> Trans -> m1 e+                         -> Trans -> m2 e+                         -> e+                         -> STMatrix s e+                         -> ST s ()+addMulMatrixWithScalesM_ alpha transa a transb b beta c = do+    (ma,na) <- getDim a+    (mb,nb) <- getDim b+    (mc,nc) <- getDim c+    let (m,n) = (mc,nc)+        k = case transa of NoTrans -> na+                           _       -> ma++    when ((not . and) [ case transa of NoTrans -> (ma,na) == (m,k)+                                       _       -> (ma,na) == (k,m)+                      , case transb of NoTrans -> (mb,nb) == (k,n)+                                       _       -> (mb,nb) == (n,k)+                      , (mc, nc) == (m,n)+                      ]) $ error $+        printf ("addMulMatrixWithScalesM_"+                ++ " _"+                ++ " %s <matrix with dim (%d,%d)>" +                ++ " %s <matrix with dim (%d,%d)>"+                ++ " _"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch")+               (show transa) ma na+               (show transb) mb nb+               mc nc++    unsafeIOToST $+        unsafeWith a $ \pa lda ->+        unsafeWith b $ \pb ldb ->+        unsafeWith c $ \pc ldc ->+            BLAS.gemm transa transb m n k alpha pa lda pb ldb beta pc ldc++checkOp2 :: (RMatrix x, RMatrix y, Storable e, Storable f)+         => String+         -> (x e -> y f -> ST s a)+         -> x e+         -> y f+         -> ST s a+checkOp2 str f x y = do+    (m1,n1) <- getDim x+    (m2,n2) <- getDim y+    when ((m1,n1) /= (m2,n2)) $ error $+        printf ("%s <matrix with dim (%d,%d)> <matrix with dim (%d,%d)>:"+                ++ " dimension mismatch") str m1 n1 m2 n2+    f x y+{-# INLINE checkOp2 #-}++checkOp3 :: (RMatrix x, RMatrix y, RMatrix z, Storable e, Storable f, Storable g)+         => String+         -> (x e -> y f -> z g -> ST s a)+         -> x e+         -> y f+         -> z g+         -> ST s a+checkOp3 str f x y z = do+    (m1,n1) <- getDim x+    (m2,n2) <- getDim y+    (m3,n3) <- getDim z+    when((m1,n1) /= (m2,n2) || (m1,n1) /= (m3,n3)) $ error $+        printf ("%s <matrix with dim (%d,%d)> <matrix with dim (%d,%d)>:"+                ++ " <matrix with dim (%d,%d)> dimension mismatch")+               str m1 n1 m2 n2 m3 n3+    f x y z+{-# INLINE checkOp3 #-}++vectorOp :: (Storable e)+         => (STVector s e -> ST s ())+         -> STMatrix s e -> ST s ()+vectorOp f x =+    fromMaybe colwise $ maybeWithVectorM x $ \vx -> f vx+  where+    colwise = withColsM x $ \vxs ->+                  sequence_ [ f vx | vx <- vxs ]++vectorOp2 :: (RMatrix m, Storable e, Storable f)+          => (forall v . RVector v => STVector s f -> v e -> ST s ())+          -> STMatrix s f -> m e -> ST s ()+vectorOp2 f dst x =+    fromMaybe colwise $ maybeWithVectorM dst $ \vdst ->+    fromMaybe colwise $ maybeWithVector    x $ \vx ->+        f vdst vx+  where+    colwise = withColsM dst $ \vdsts ->+              withCols   x   $ \vxs ->+                  sequence_ [ f vdst vx | (vdst,vx) <- zip vdsts vxs ]+{-# INLINE vectorOp2 #-}++vectorOp3 :: (RMatrix m1, RMatrix m2, Storable e1, Storable e2, Storable f)+          => (forall v1 v2 . (RVector v1, RVector v2) => +                  STVector s f -> v1 e1 -> v2 e2 -> ST s ())+          -> STMatrix s f -> m1 e1 -> m2 e2 -> ST s ()+vectorOp3 f dst x y =+    fromMaybe colwise $ maybeWithVectorM dst $ \vdst ->+    fromMaybe colwise $ maybeWithVector    x $ \vx ->+    fromMaybe colwise $ maybeWithVector    y $ \vy ->+        f vdst vx vy+  where+    colwise = withColsM dst $ \vdsts ->+              withCols   x   $ \vxs ->+              withCols   y   $ \vys ->+                  sequence_ [ f vdst vx vy+                            | (vdst,vx,vy) <- zip3 vdsts vxs vys ]+{-# INLINE vectorOp3 #-}
+ lib/Numeric/LinearAlgebra/Matrix/Statistics.hs view
@@ -0,0 +1,180 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix.Statistics+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Basic multivariate statistics.+--++module Numeric.LinearAlgebra.Matrix.Statistics (+    defaultCovUplo,++    -- * Immutable interface+    cov,+    covWithMean,+    weightedCov,+    weightedCovWithMean,++    -- * Mutable interface+    covTo,+    covWithMeanTo,+    weightedCovTo,+    weightedCovWithMeanTo,++    ) where++import Control.Monad( when )+import Control.Monad.ST( ST )+import Data.List( foldl' )+import Text.Printf( printf )++import Numeric.LinearAlgebra.Types++import Numeric.LinearAlgebra.Vector( Vector, RVector )+import qualified Numeric.LinearAlgebra.Vector as V++import Numeric.LinearAlgebra.Matrix.Base( Matrix )+import Numeric.LinearAlgebra.Matrix.STBase( STMatrix )+import qualified Numeric.LinearAlgebra.Matrix.STBase as M+import qualified Numeric.LinearAlgebra.Matrix.Herm as M+++-- | Returns the default storage scheme for covariance matrices.+defaultCovUplo :: Uplo+defaultCovUplo = Lower+++-- | Returns the sample covariance matrix as a hermitian matrix with storage+-- scheme equal to 'defaultCovUplo'.  The first argument gives the dimension+-- of the vectors.+cov :: (BLAS3 e)+          => Int -> CovMethod -> [Vector e] -> Herm Matrix e+cov p t xs = M.hermCreate $ do+    c <- Herm uplo `fmap` M.new_ (p,p)+    covTo c t xs+    return c+  where+    uplo = defaultCovUplo++-- | Given the pre-computed mean, returns the sample covariance matrix+-- with storage scheme equal to 'defaultCovUplo'.+covWithMean :: (BLAS3 e)+                  => Vector e -> CovMethod -> [Vector e] -> Herm Matrix e+covWithMean mu t xs = M.hermCreate $ do+    p <- V.getDim mu    +    c <- Herm uplo `fmap` M.new_ (p,p)+    covWithMeanTo c mu t xs+    return c+  where+    uplo = defaultCovUplo++-- | Returns the weighed sample covariance matrix with storage scheme equal+-- to 'defaultCovUplo'. The first argument gives the dimension of the vectors.+weightedCov :: (BLAS3 e)+                  => Int -> CovMethod -> [(Double, Vector e)] -> Herm Matrix e+weightedCov p t wxs = M.hermCreate $ do+    c <- Herm uplo `fmap` M.new_ (p,p)+    weightedCovTo c t wxs+    return c+  where+    uplo = defaultCovUplo++-- | Given the pre-computed mean, returns the weighed sample covariance matrix+-- with storage scheme equal to 'defaultCovUplo'.+weightedCovWithMean :: (BLAS3 e)+                    => Vector e -> CovMethod -> [(Double, Vector e)]+                    -> Herm Matrix e+weightedCovWithMean mu t wxs = M.hermCreate $ do+    p <- V.getDim mu    +    c <- Herm uplo `fmap` M.new_ (p,p)+    weightedCovWithMeanTo c mu t wxs+    return c+  where+    uplo = defaultCovUplo++-- | Computes and copies the sample covariance matrix to the given+-- destination.+covTo :: (RVector v, BLAS3 e)+      => Herm (STMatrix s) e -> CovMethod -> [v e] -> ST s ()+covTo c@(Herm _ a) t xs = do+    (p,_) <- M.getDim a+    mu <- V.new p 1+    V.meanTo mu xs+    covWithMeanTo c mu t xs+    ++-- | Given the pre-computed mean, computes and copies the sample covariance+-- matrix to the given destination.+covWithMeanTo :: (RVector v1, RVector v2, BLAS3 e)+              => Herm (STMatrix s) e -> v1 e -> CovMethod -> [v2 e] -> ST s ()+covWithMeanTo c@(Herm _ a) mu t xs = do+    (ma,na) <- M.getDim a+    p <- V.getDim mu+    +    when ((ma,na) /= (p,p)) $ error $+        printf ("covWithMeanTo"+                ++ " (Herm _ <matrix with dim (%d,%d)>)"+                ++ " <vector with dim %d>"+                ++ " _ _"+                ++ ": dimension mismatch")+               ma na p++    xt <- M.new_ (p,n)+    M.withColsM xt $ \xs' ->+        sequence_ [ V.subTo x' mu x+                  | (x,x') <- zip xs xs'+                  ]+    M.hermRankKUpdateM_ (1/df) NoTrans xt 0 c+  where++    n = length xs+    df = fromIntegral $ case t of { MLCov -> n ; UnbiasedCov -> n - 1 }++-- | Computes and copies the weighed sample covariance matrix to the+-- given destination.+weightedCovTo :: (RVector v, BLAS3 e)+              => Herm (STMatrix s) e -> CovMethod -> [(Double, v e)] -> ST s ()+weightedCovTo c@(Herm _ a) t wxs = do+    (p,_) <- M.getDim a+    mu <- V.new p 1+    V.weightedMeanTo mu wxs+    weightedCovWithMeanTo c mu t wxs+    ++-- | Given the pre-computed mean, computes and copies the weighed sample+-- covariance matrix to the given destination.+weightedCovWithMeanTo :: (RVector v1, RVector v2, BLAS3 e)+                      => Herm (STMatrix s) e+                      -> v1 e -> CovMethod -> [(Double, v2 e)]+                      -> ST s ()+weightedCovWithMeanTo c@(Herm _ a) mu t wxs = do+    (ma,na) <- M.getDim a+    p <- V.getDim mu++    when ((ma,na) /= (p,p)) $ error $+        printf ("weightedCovWithMeanTo"+                ++ " (Herm _ <matrix with dim (%d,%d)>):"+                ++ " <vector with dim %d>"+                ++ " _ _"+                ++ " dimension mismatch")+               ma na p++    xt <- M.new_ (p,n)+    M.withColsM xt $ \xs' ->+        sequence_ [  V.subTo x' mu x+                  >> V.scaleM_ (realToFrac $ sqrt (w / invscale)) x'+                  |  (w,x,x') <- zip3 ws xs xs'+                  ]+    M.hermRankKUpdateM_ 1 NoTrans xt 0 c+  where+    (ws0,xs) = unzip wxs+    w_sum = foldl' (+) 0 ws0+    ws = if w_sum == 0 then ws0 else map (/w_sum) ws0+    w2s_sum = foldl' (+) 0 $ map (^^(2::Int)) ws+    invscale = case t of +                   MLCov -> 1+                   UnbiasedCov -> (1 - w2s_sum)+    n = length ws0
+ lib/Numeric/LinearAlgebra/Matrix/Tri.hs view
@@ -0,0 +1,343 @@+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Matrix.Tri+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Triangular views of matrices.+--++module Numeric.LinearAlgebra.Matrix.Tri (+    -- * Immutable interface+    +    -- ** Vector multiplication+    triMulVector,+    +    -- ** Matrix multiplication+    triMulMatrix,+    triMulMatrixWithScale,++    -- ** Vector solving+    triSolvVector,+    +    -- ** Matrix solving+    triSolvMatrix,+    triSolvMatrixWithScale,++    -- * Mutable interface+    triCreate,+    +    -- ** Vector multiplication+    triMulVectorM_,+    +    -- ** Matrix multiplication+    triMulMatrixM_,+    triMulMatrixWithScaleM_,++    -- ** Vector solving+    triSolvVectorM_,++    -- ** Matrix solving+    triSolvMatrixM_,+    triSolvMatrixWithScaleM_,++    ) where++import Control.Monad( when )+import Control.Monad.ST( ST, runST, unsafeIOToST )+import Text.Printf( printf )++import Numeric.LinearAlgebra.Vector( Vector, STVector )+import qualified Numeric.LinearAlgebra.Vector as V+import Numeric.LinearAlgebra.Matrix.Base( Matrix )+import Numeric.LinearAlgebra.Matrix.STBase( STMatrix, RMatrix )+import qualified Numeric.LinearAlgebra.Matrix.STBase as M+import Numeric.LinearAlgebra.Types+import qualified Foreign.BLAS as BLAS+++-- | A safe way to create and work with a mutable Tri Matrix before returning +-- an immutable one for later perusal.+triCreate :: (Storable e)+           => (forall s. ST s (Tri (STMatrix s) e))+           -> Tri Matrix e+triCreate mt = runST $ do+    (Tri u d ma) <- mt+    a <- M.unsafeFreeze ma+    return $ Tri u d a++-- | @triMulVector trans a x@ returns @op(a) * x@, where @op(a)@ is+-- determined by @trans@.+triMulVector :: (BLAS2 e)+             => Trans+             -> Tri Matrix e+             -> Vector e+             -> Vector e+triMulVector trans a x =+    V.create $ do+        x' <- V.newCopy x+        triMulVectorM_ trans a x'+        return x'++-- | @triMulMatrix side a b@+-- returns @alpha * op(a) * b@ when @side@ is @LeftSide@ and+-- @alpha * b * op(a)@ when @side@ is @RightSide@.  Operation+-- @op(a)@ is determined by @trans@.+triMulMatrix :: (BLAS3 e)+              => Side+              -> Trans -> Tri Matrix e+              -> Matrix e+              -> Matrix e+triMulMatrix side trans a b = +    M.create $ do+        b' <- M.newCopy b+        triMulMatrixM_ side trans a b'+        return b'++-- | @triMulMatrixWithScale alpha side trans a b@+-- returns @alpha * op(a) * b@ when @side@ is @LeftSide@ and+-- @alpha * b * op(a)@ when @side@ is @RightSide@.  Operation+-- @op(a)@ is determined by @trans@.+triMulMatrixWithScale :: (BLAS3 e)+                       => e+                       -> Side+                       -> Trans -> Tri Matrix e+                       -> Matrix e+                       -> Matrix e+triMulMatrixWithScale alpha side trans a b =+    M.create $ do+        b' <- M.newCopy b+        triMulMatrixWithScaleM_ alpha side trans a b'+        return b'++-- | @triMulVectorM_ a x@ sets @x := op(a) * x@, where @op(a)@ is determined+-- by @trans@.+triMulVectorM_ :: (RMatrix m, BLAS2 e)+               => Trans -> Tri m e+               -> STVector s e+               -> ST s ()+triMulVectorM_ trans (Tri uplo diag a) x = do+    (ma,na) <- M.getDim a+    nx <- V.getDim x+    let n = nx+    +    when (ma /= na) $ error $+        printf ("triMulVectorM_"+                ++ " _"+                ++ " (Tri _ _ <matrix with dim (%d,%d)>)"+                ++ " _"+                ++ ": matrix is not square")+               ma na+               +    when ((not . and) [ (ma,na) == (n,n)+                      , nx == n+                      ]) $ error $+        printf ("triMulVectorM_"+                ++ " _"+                ++ " (Tri _ _ <matrix with dim (%d,%d)>)"+                ++ " <vector with dim %d>"+                ++ ": dimension mismatch")+               ma na+               nx++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        V.unsafeWith x $ \px ->+            BLAS.trmv uplo trans diag n pa lda px 1+++-- | @triMulMatrixM_ side trans a b@+-- sets @b := op(a) * b@ when @side@ is @LeftSide@ and+-- @b := b * op(a)@ when @side@ is @RightSide@.  Operation+-- @op(a)@ is determined by @trans@.+triMulMatrixM_ :: (RMatrix m, BLAS3 e)+               => Side +               -> Trans -> Tri m e+               -> STMatrix s e+               -> ST s ()+triMulMatrixM_ = triMulMatrixWithScaleM_ 1++-- | @triMulMatrixWithScaleM_ alpha side trans a b@+-- sets @b := alpha * op(a) * b@ when @side@ is @LeftSide@ and+-- @b := alpha * b * op(a)@ when @side@ is @RightSide@.  Operation+-- @op(a)@ is determined by @trans@.+triMulMatrixWithScaleM_ :: (RMatrix m, BLAS3 e)+                         => e+                         -> Side+                         -> Trans -> Tri m e+                         -> STMatrix s e+                         -> ST s ()+triMulMatrixWithScaleM_ alpha side trans (Tri uplo diag a) b = do+    (ma,na) <- M.getDim a+    (mb,nb) <- M.getDim b+    let (m,n) = (mb,nb)+    +    when (ma /= na) $ error $+        printf ("triMulMatrixWithScaleM_"+                ++ " _"+                ++ " _"+                ++ " _"+                ++ " (Tri _ _ <matrix with dim (%d,%d)>)"+                ++ " _"+                ++ ": matrix is not square")+               ma na++    when ((not . and) [ case side of LeftSide  -> (ma,na) == (m,m)+                                     RightSide -> (ma,na) == (n,n)+                      , (mb, nb ) == (m,n)+                      ]) $ error $+        printf ("triMulMatrixWithScaleM_"+                ++ " _"+                ++ " %s"+                ++ " _"+                ++ " (Tri _ _ <matrix with dim (%d,%d)>)"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch")+               (show side)+               ma na+               mb nb++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        M.unsafeWith b $ \pb ldb ->+            BLAS.trmm side uplo trans diag m n alpha pa lda pb ldb+++-- | @triSolvVector trans a x@ returns @op(a) \\ x@, where @op(a)@ is+-- determined by @trans@.+triSolvVector :: (BLAS2 e)+             => Trans+             -> Tri Matrix e+             -> Vector e+             -> Vector e+triSolvVector trans a x =+    V.create $ do+        x' <- V.newCopy x+        triSolvVectorM_ trans a x'+        return x'++-- | @triSolvMatrix side a b@+-- returns @alpha * op(a) \\ b@ when @side@ is @LeftSide@ and+-- @alpha * b * op(a)@ when @side@ is @RightSide@.  Operation+-- @op(a)@ is determined by @trans@.+triSolvMatrix :: (BLAS3 e)+              => Side+              -> Trans -> Tri Matrix e+              -> Matrix e+              -> Matrix e+triSolvMatrix side trans a b = +    M.create $ do+        b' <- M.newCopy b+        triSolvMatrixM_ side trans a b'+        return b'++-- | @triSolvMatrixWithScale alpha side trans a b@+-- returns @alpha * op(a) \\ b@ when @side@ is @LeftSide@ and+-- @alpha * b * op(a)@ when @side@ is @RightSide@.  Operation+-- @op(a)@ is determined by @trans@.+triSolvMatrixWithScale :: (BLAS3 e)+                       => e+                       -> Side+                       -> Trans -> Tri Matrix e+                       -> Matrix e+                       -> Matrix e+triSolvMatrixWithScale alpha side trans a b =+    M.create $ do+        b' <- M.newCopy b+        triSolvMatrixWithScaleM_ alpha side trans a b'+        return b'++-- | @triSolvVectorM_ a x@ sets @x := op(a) \\ x@, where @op(a)@ is determined+-- by @trans@.+triSolvVectorM_ :: (RMatrix m, BLAS2 e)+               => Trans -> Tri m e+               -> STVector s e+               -> ST s ()+triSolvVectorM_ trans (Tri uplo diag a) x = do+    (ma,na) <- M.getDim a+    nx <- V.getDim x+    let n = nx+    +    when (ma /= na) $ error $+        printf ("triSolvVectorM_"+                ++ " _"+                ++ " (Tri _ _ <matrix with dim (%d,%d)>)"+                ++ " _"+                ++ ": matrix is not square")+               ma na+               +    when ((not . and) [ (ma,na) == (n,n)+                      , nx == n+                      ]) $ error $+        printf ("triSolvVectorM_"+                ++ " _"+                ++ " (Tri _ _ <matrix with dim (%d,%d)>)"+                ++ " <vector with dim %d>"+                ++ ": dimension mismatch")+               ma na+               nx++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        V.unsafeWith x $ \px ->+            BLAS.trsv uplo trans diag n pa lda px 1+++-- | @triSolvMatrixM_ side trans a b@+-- sets @b := op(a) \\ b@ when @side@ is @LeftSide@ and+-- @b := b * op(a)@ when @side@ is @RightSide@.  Operation+-- @op(a)@ is determined by @trans@.+triSolvMatrixM_ :: (RMatrix m, BLAS3 e)+               => Side +               -> Trans -> Tri m e+               -> STMatrix s e+               -> ST s ()+triSolvMatrixM_ = triSolvMatrixWithScaleM_ 1++-- | @triSolvMatrixWithScaleM_ alpha side trans a b@+-- sets @b := alpha * op(a) \\ b@ when @side@ is @LeftSide@ and+-- @b := alpha * b * op(a)@ when @side@ is @RightSide@.  Operation+-- @op(a)@ is determined by @trans@.+triSolvMatrixWithScaleM_ :: (RMatrix m, BLAS3 e)+                         => e+                         -> Side+                         -> Trans -> Tri m e+                         -> STMatrix s e+                         -> ST s ()+triSolvMatrixWithScaleM_ alpha side trans (Tri uplo diag a) b = do+    (ma,na) <- M.getDim a+    (mb,nb) <- M.getDim b+    let (m,n) = (mb,nb)+    +    when (ma /= na) $ error $+        printf ("triSolvMatrixWithScaleM_"+                ++ " _"+                ++ " _"+                ++ " _"+                ++ " (Tri _ _ <matrix with dim (%d,%d)>)"+                ++ " _"+                ++ ": matrix is not square")+               ma na++    when ((not . and) [ case side of LeftSide  -> (ma,na) == (m,m)+                                     RightSide -> (ma,na) == (n,n)+                      , (mb, nb ) == (m,n)+                      ]) $ error $+        printf ("triSolvMatrixWithScaleM_"+                ++ " _"+                ++ " %s"+                ++ " _"+                ++ " (Tri _ _ <matrix with dim (%d,%d)>)"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch")+               (show side)+               ma na+               mb nb++    unsafeIOToST $+        M.unsafeWith a $ \pa lda ->+        M.unsafeWith b $ \pb ldb ->+            BLAS.trsm side uplo trans diag m n alpha pa lda pb ldb
+ lib/Numeric/LinearAlgebra/Packed.hs view
@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Packed+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Packed matrices.+--+module Numeric.LinearAlgebra.Packed (+    -- * Immutable packed matrices+    Packed,+    dim,+    +    -- * Read-only packed matrices+    RPacked(..),+    +    -- * Conversions between vectors and packed matrices+    fromVector,+    toVector,++    -- * Mutable interface+    module Numeric.LinearAlgebra.Packed.ST,++    -- * Hermitian views+    module Numeric.LinearAlgebra.Packed.Herm,++    -- * Triangular views+    module Numeric.LinearAlgebra.Packed.Tri,++    -- * Cholesky factorizations+    module Numeric.LinearAlgebra.Packed.Cholesky,++    -- * Basic multivariate statistics+    module Numeric.LinearAlgebra.Packed.Statistics,++    ) where++import Numeric.LinearAlgebra.Packed.Base+import Numeric.LinearAlgebra.Packed.ST hiding ( RPacked(..) )+import Numeric.LinearAlgebra.Packed.Herm+import Numeric.LinearAlgebra.Packed.Tri+import Numeric.LinearAlgebra.Packed.Cholesky+import Numeric.LinearAlgebra.Packed.Statistics
+ lib/Numeric/LinearAlgebra/Packed/Base.hs view
@@ -0,0 +1,388 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Packed.Base+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Packed matrices.+--+module Numeric.LinearAlgebra.Packed.Base+    where++import Control.Monad( when )+import Control.Monad.ST( ST, RealWorld, runST, unsafeIOToST )+import Data.Typeable( Typeable )+import Foreign( Storable, Ptr )+import Text.Printf( printf )+import Unsafe.Coerce( unsafeCoerce )++import Numeric.LinearAlgebra.Types( Herm(..) )+import Numeric.LinearAlgebra.Vector( Vector, RVector, STVector )+import qualified Numeric.LinearAlgebra.Vector as V+import Foreign.BLAS( BLAS2 )+import qualified Foreign.BLAS as BLAS+++-- | Immutable packed matrices, stored in column-major order.+data Packed e = Packed !Int !(Vector e)+    deriving (Typeable)+    +-- | Mutable packed matrices in the 'ST' monad.+newtype STPacked s e = STPacked { unSTPacked :: Packed e }+    deriving (Typeable)+    +-- | Mutable packed matrices in the 'IO' monad.+type IOPacked = STPacked RealWorld++-- | The dimension of the packed matrix.+dim :: (Storable e) => Packed e -> Int+dim (Packed n _) = n+{-# INLINE dim #-}++-- | Allocate a mutable packed matrix of the given dimension.+new_ :: (Storable e) => Int -> ST s (STPacked s e)+new_ n+    | n < 0 = error $+        printf "new_ %d: negative dimension" n+    | otherwise = do+        mx <- V.new_ (n*(n+1) `div` 2)+        x <- V.unsafeFreeze mx+        return $ STPacked $ Packed n x+{-# INLINE new_ #-}++-- | Create a packed matrix view of a vector, ensurint that the+-- vector has dimension @n * (n+1)/2@, where @n@ is the desired dimension.+fromVector :: (Storable e) => Int -> Vector e -> Packed e+fromVector n x+    | not $ 2 * nx == n * (n+1) = error $+        printf ("fromVector %d <vector with dim %d>: dimension mismatch")+               n nx+    | otherwise =+        unsafeFromVector n x+  where+    nx = V.dim x+{-# INLINE fromVector #-}++-- | Create a packed matrix view of a vector, wihtout checking+-- the dimension of the vector.+unsafeFromVector :: (Storable e) => Int -> Vector e -> Packed e+unsafeFromVector = Packed+{-# INLINE unsafeFromVector #-}++-- | Returns the dimension and underlying vector storage of a+-- packed matrix.+toVector :: (Storable e) => Packed e -> (Int, Vector e)+toVector (Packed n v) = (n,v)+{-# INLINE toVector #-}++{-+-- | Create a packed matrix view of a vector, ensurint that the+-- vector has dimension @n * (n+1)/2@, where @n@ is the desired dimension.+fromSTVector :: (Storable e) => Int -> STVector s e -> STPacked s e+fromSTVector n x+    | not $ 2 * nx == n * (n+1) = error $+        printf ("fromVectorST %d <vector with dim %d>: dimension mismatch")+               n nx+    | otherwise =+        STPacked $ unsafeFromVector n x+  where+    nx = V.dim x+{-# INLINE fromSTVector #-}++-- | Create a packed matrix view of a vector, wihtout checking+-- the dimension of the vector.+unsafeFromSTVector :: (Storable e) => Int -> STVector s e -> STPacked s e+unsafeFromSTVector = STPacked+{-# INLINE unsafeFromSTVector #-}++-- | Returns the dimension and underlying vector storage of a+-- packed matrix.+toSTVector :: (Storable e) => STPacked s e -> (Int, STVector s e)+toSTVector (STPacked n v) = (n,v)+{-# INLINE toSTVector #-}+-}++-- | Read-only packed matrices.+class RPacked p where+    -- | Returns the dimension of the packed matrix.+    getDim :: (Storable e) => p e -> ST s Int++    -- | Perform an action with the underlying vector storage of+    -- the packed matrix.+    withVector :: (Storable e)+               => p e+               -> (forall v . RVector v => v e -> ST s a)+               -> ST s a+    +    -- | Perform an IO action with a pointer to the first element of+    -- the packed matrix.+    unsafeWith :: (Storable e) => p e -> (Ptr e -> IO a) -> IO a++    -- | Converts a read-only packed matrix into an immutable one. This simply+    -- casts the matrix from one type to the other without copying the matrix.+    -- Note that because the matrix is possibly not copied, any subsequent+    -- modifications made to the mutable version of the matrix may be shared+    -- with the immutable version. It is safe to use, therefore, if the mutable+    -- version is never modified after the freeze operation.+    unsafeFreeze :: (Storable e) => p e -> ST s (Packed e)++    unsafeThaw :: (Storable e) => p e -> ST s (STPacked s e)+    ++-- | View a vector as a packed matrix and pass it to a function.+withFromVector :: (RVector v, Storable e)+               => Int+               -> v e+               -> (forall p . RPacked p => p e -> ST s a)+               -> ST s a+withFromVector n v f = do+    iv <- V.unsafeFreeze v+    f $ fromVector n iv+{-# INLINE withFromVector #-}++-- | View a mutable vector as a mutable packed matrix and pass it+-- to a function.+withFromVectorM :: (Storable e)+                => Int+                -> STVector s e+                -> (STPacked s e -> ST s a)+                -> ST s a+withFromVectorM n v f =+    withFromVector n v $ \p -> do+        mp <- unsafeThaw p+        f mp+{-# INLINE withFromVectorM #-}++-- | Perform an action with the underlying vector storage of+-- the mutable packed matrix.  See also 'withVectorView'.+withVectorM :: (Storable e)+            => STPacked s e+            -> (STVector s e -> ST s a)+            -> ST s a+withVectorM mp f =+    withVector mp $ \v -> do+        mv <- V.unsafeThaw v+        f mv+{-# INLINE withVectorM #-}++instance RPacked Packed where+    getDim = return . dim+    {-# INLINE getDim #-}+    withVector (Packed _ v) f = f v+    {-# INLINE withVector #-}+    unsafeWith (Packed _ v) = V.unsafeWith v+    {-# INLINE unsafeWith #-}+    unsafeFreeze = return+    {-# INLINE unsafeFreeze #-}+    unsafeThaw = return . STPacked+    {-# INLINE unsafeThaw #-}++instance RPacked (STPacked s) where+    getDim = getDim . unSTPacked+    {-# INLINE getDim #-}+    withVector = withVector . unSTPacked+    {-# INLINE withVector #-}+    unsafeWith = unsafeWith . unSTPacked+    {-# INLINE unsafeWith #-}+    unsafeFreeze = return . unSTPacked+    {-# INLINE unsafeFreeze #-}+    unsafeThaw p = return $ cast p+      where+        cast :: STPacked s e -> STPacked s' e+        cast = unsafeCoerce+    {-# INLINE unsafeThaw #-}+++-- | Create a new copy of a packed matrix.+newCopy :: (RPacked p, Storable e)+        => p e -> ST s (STPacked s e)+newCopy p = do+    n <- getDim p+    p' <- new_ n+    withVector p $ \v ->+        withVectorM p' $ \v' ->+            V.unsafeCopyTo v' v+    return p'+{-# INLINE newCopy #-}++-- | Converts a mutable packed matrix to an immutable one by taking a complete+-- copy of it.+freeze :: (RPacked p, Storable e) => p e -> ST s (Packed e)+freeze p = do+    p' <- newCopy p+    unsafeFreeze p'++-- | A safe way to create and work with a mutable Packed before returning +-- an immutable one for later perusal.+create :: (Storable e)+       => (forall s. ST s ((STPacked s) e))+       -> Packed e+create stmp = runST $ do+    mp <- stmp+    unsafeFreeze mp+++-- | A safe way to create and work with a mutable Herm Packed before returning +-- an immutable one for later perusal.+hermCreate :: (Storable e)+           => (forall s. ST s (Herm (STPacked s) e))+           -> Herm Packed e+hermCreate stmh = runST $ do+    (Herm u mp) <- stmh+    p <- unsafeFreeze mp+    return $ Herm u p++-- | @hermRank1Update alpha x a@ returns+-- @alpha * x * x^H + a@.+hermRank1Update :: (BLAS2 e)+                => Double -> Vector e -> Herm Packed e -> Herm Packed e+hermRank1Update alpha x (Herm uplo ap) = hermCreate $ do+    hp' <- Herm uplo `fmap` newCopy ap+    hermRank1UpdateM_ alpha x hp'+    return hp'++-- | @hermRank2Update alpha x y a@ returns+-- @alpha * x * y^H + conj(alpha) * y * x^H + a@.+hermRank2Update :: (BLAS2 e)+                => e -> Vector e -> Vector e -> Herm Packed e+                -> Herm Packed e+hermRank2Update alpha x y (Herm uplo ap) = hermCreate $ do+    hp' <- Herm uplo `fmap` newCopy ap+    hermRank2UpdateM_ alpha x y hp'+    return hp'++-- | @hermRank1UpdateM_ alpha x a@ sets+-- @a := alpha * x * x^H + a@.+hermRank1UpdateM_ :: (RVector v, BLAS2 e)+                  => Double -> v e -> Herm (STPacked s) e -> ST s ()+hermRank1UpdateM_ alpha x (Herm uplo a) = do+    nx <- V.getDim x+    na <- getDim a+    let n = nx++    when ((not . and) [ nx == n, na == n ]) $ error $+        printf ("hermRank1UpdateM_ _ <vector with dim %d>"+                 ++ " (Herm _ <packed matrix with dim %d>):"+                 ++ " invalid dimensions") nx na++    unsafeIOToST $+        V.unsafeWith x $ \px ->+        unsafeWith a $ \pa ->+            BLAS.hpr uplo n alpha px 1 pa+++-- | @hermRank2UpdateM_ alpha x y a@ sets+-- @a := alpha * x * y^H + conj(alpha) * y * x^H + a@.+hermRank2UpdateM_ :: (RVector v1, RVector v2, BLAS2 e)+                  => e -> v1 e -> v2 e -> Herm (STPacked s) e -> ST s ()+hermRank2UpdateM_ alpha x y (Herm uplo a) = do+    nx <- V.getDim x+    ny <- V.getDim y+    na <- getDim a+    let n = nx+    +    when ((not . and) [ nx == n, ny == n, na == n ]) $ error $+        printf ("hermRank2UpdateM_ _ <vector with dim %d>"+                 ++ " <vector with dim %d>"+                 ++ " (Herm _ <packed matrix with dim %d>):"+                 ++ " invalid dimensions") nx ny na++    unsafeIOToST $+        V.unsafeWith x $ \px ->+        V.unsafeWith y $ \py ->        +        unsafeWith a $ \pa ->+            BLAS.hpr2 uplo n alpha px 1 py 1 pa+++-- | @hermMulVector a x@ returns @a * x@.+hermMulVector :: (BLAS2 e)+                    => Herm Packed e+                    -> Vector e+                    -> Vector e+hermMulVector a x =+    V.create $ do+        y <- V.new_ (V.dim x)+        hermMulVectorTo y a x+        return y++-- | @hermMulVectorWithScale alpha a x@ retunrs @alpha * a * x@.+hermMulVectorWithScale :: (BLAS2 e)+                       => e+                       -> Herm Packed e+                       -> Vector e+                       -> Vector e+hermMulVectorWithScale alpha a x =+    V.create $ do+        y <- V.new_ (V.dim x)+        hermMulVectorWithScaleTo y alpha a x+        return y+                       +-- | @addHermMulVectorWithScales alpha a x y@+-- returns @alpha * a * x + beta * y@.+addHermMulVectorWithScales :: (BLAS2 e)+                           => e+                           -> Herm Packed e+                           -> Vector e+                           -> e+                           -> Vector e+                           -> Vector e+addHermMulVectorWithScales alpha a x beta y =+    V.create $ do+        y' <- V.newCopy y+        addHermMulVectorWithScalesM_ alpha a x beta y'+        return y'++-- | @hermMulVectorTo dst a x@ sets @dst := a * x@.+hermMulVectorTo :: (RPacked p, RVector v, BLAS2 e)+                => STVector s e+                -> Herm p e+                -> v e+                -> ST s ()+hermMulVectorTo dst = hermMulVectorWithScaleTo dst 1++-- | @hermMulVectorWithScaleTo dst alpha a x@+-- sets @dst := alpha * a * x@.+hermMulVectorWithScaleTo :: (RPacked p, RVector v, BLAS2 e)+                         => STVector s e+                         -> e+                         -> Herm p e+                         -> v e+                         -> ST s ()+hermMulVectorWithScaleTo dst alpha a x =+    addHermMulVectorWithScalesM_ alpha a x 0 dst++-- | @addHermMulVectorWithScalesM_ alpha a x beta y@+-- sets @y := alpha * a * x + beta * y@.+addHermMulVectorWithScalesM_ :: (RPacked p, RVector v, BLAS2 e)+                             => e+                             -> Herm p e+                             -> v e+                             -> e+                             -> STVector s e+                             -> ST s ()+addHermMulVectorWithScalesM_ alpha (Herm uplo a) x beta y = do+    na <- getDim a+    nx <- V.getDim x+    ny <- V.getDim y+    let n = ny++    when ((not . and) [ na == n+                      , nx == n+                      , ny == n+                      ]) $ error $+        printf ("addHermMulVectorWithScalesM_ _"+                ++ " (Herm %s <packed matrix with dim %d>)"+                ++ " %s <vector with dim %d>"+                ++ " _"+                ++ " <vector with dim %d>: dimension mismatch")+               (show uplo) na+               nx ny++    unsafeIOToST $+        unsafeWith a $ \pa ->+        V.unsafeWith x $ \px ->+        V.unsafeWith y $ \py ->+            BLAS.hpmv uplo n alpha pa px 1 beta py 1
+ lib/Numeric/LinearAlgebra/Packed/Cholesky.hs view
@@ -0,0 +1,125 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Packed.Cholesky+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Cholesky factorizations of symmetric (Hermitian) positive-definite+-- matrices.+--++module Numeric.LinearAlgebra.Packed.Cholesky (+    -- * Immutable interface+    cholFactor,+    cholSolveVector,+    cholSolveMatrix,++    -- * Mutable interface+    cholFactorM,+    cholSolveVectorM_,+    cholSolveMatrixM_,+    ) where++import Control.Monad( when )+import Control.Monad.ST( ST, runST, unsafeIOToST )+import Text.Printf( printf )++import qualified Foreign.LAPACK as LAPACK++import Numeric.LinearAlgebra.Types++import Numeric.LinearAlgebra.Packed.Base( Packed, RPacked, STPacked )+import qualified Numeric.LinearAlgebra.Packed.Base as P++import Numeric.LinearAlgebra.Matrix( Matrix, STMatrix )+import qualified Numeric.LinearAlgebra.Matrix as M++import Numeric.LinearAlgebra.Vector( Vector, STVector )+import qualified Numeric.LinearAlgebra.Vector as V++-- | @cholFactor a@ tries to compute the Cholesky+-- factorization of @a@.  If @a@ is positive-definite then the routine+-- returns @Right@ with the factorization.  If the leading minor of order @i@+-- is not positive-definite then the routine returns @Left i@.+cholFactor :: (LAPACK e)+                 => Herm Packed e+                 -> Either Int (Chol Packed e)+cholFactor (Herm uplo a) = runST $ do+    ma <- P.newCopy a+    cholFactorM (Herm uplo ma)+        >>= either (return . Left) (\(Chol uplo' ma') -> do+                a' <- P.unsafeFreeze ma'+                return $ Right (Chol uplo' a')+                )++-- | @cholSolveVector a x@ returns @a \\ x@.+cholSolveVector :: (LAPACK e)+                      => Chol Packed e+                      -> Vector e+                      -> Vector e+cholSolveVector a x = V.create $ do+    x' <- V.newCopy x+    cholSolveVectorM_ a x'+    return x'++-- | @cholSolveMatrix a b@ returns @a \\ b@.+cholSolveMatrix :: (LAPACK e)+                      => Chol Packed e+                      -> Matrix e+                      -> Matrix e+cholSolveMatrix a c = M.create $ do+    c' <- M.newCopy c+    cholSolveMatrixM_ a c'+    return c'++-- | @cholFactorM a@ tries to compute the Cholesky+-- factorization of @a@ in place.  If @a@ is positive-definite then the+-- routine returns @Right@ with the factorization, stored in the same+-- memory as @a@.  If the leading minor of order @i@ is not+-- positive-definite then the routine returns @Left i@.+-- In either case, the original storage of @a@ is destroyed.+cholFactorM :: (LAPACK e)+             => Herm (STPacked s) e+             -> ST s (Either Int (Chol (STPacked s) e))+cholFactorM (Herm uplo a) = do+    n <- P.getDim a+    unsafeIOToST $+        P.unsafeWith a $ \pa -> do+            info <- LAPACK.pptrf uplo n pa+            return $ if info > 0 then Left info+                                 else Right (Chol uplo a)++-- | @cholSolveVectorM_ a x@ sets @x := a \\ x@.+cholSolveVectorM_ :: (LAPACK e, RPacked p)+                  => Chol p e+                  -> STVector s e+                  -> ST s ()+cholSolveVectorM_ a x =+    M.withFromColM x $ \x' ->+        cholSolveMatrixM_ a x'++-- | @cholSolveMatrixM_ a b@ sets @b := a \\ b@.+cholSolveMatrixM_ :: (LAPACK e, RPacked p)+                  => Chol p e+                  -> STMatrix s e+                  -> ST s ()+cholSolveMatrixM_ (Chol uplo a) b = do+    na <- P.getDim a+    (mb,nb) <- M.getDim b+    let (n,nrhs) = (mb,nb)++    when ((not . and) [ na == n+                      , (mb,nb) == (n,nrhs)+                      ]) $ error $+        printf ("cholSolveMatrixM_"+                ++ " (Chol _ <packed matrix with dim %d>)"+                ++ " <matrix with dim (%d,%d)>"+                ++ ": dimension mismatch")+               na mb nb++    unsafeIOToST $+        P.unsafeWith a $ \pa ->+        M.unsafeWith b $ \pb ldb ->+            LAPACK.pptrs uplo n nrhs pa pb ldb
+ lib/Numeric/LinearAlgebra/Packed/Herm.hs view
@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Packed.Herm+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Hermitian views of packed matrices.+--+module Numeric.LinearAlgebra.Packed.Herm (+    -- * Immutable interface++    -- ** Vector multiplication+    hermMulVector,+    hermMulVectorWithScale,+    addHermMulVectorWithScales,+    +    -- ** Updates+    hermRank1Update,+    hermRank2Update,++    -- * Mutable interface+    hermCreate,    ++    -- ** Vector multiplication+    hermMulVectorTo,+    hermMulVectorWithScaleTo,+    addHermMulVectorWithScalesM_,+    +    -- ** Updates+    hermRank1UpdateM_,+    hermRank2UpdateM_,++    ) where++import Numeric.LinearAlgebra.Packed.Base
+ lib/Numeric/LinearAlgebra/Packed/ST.hs view
@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Packed.ST+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Mutable packed matrices.+--+module Numeric.LinearAlgebra.Packed.ST (+    -- * Mutable packed matrices+    STPacked,+    IOPacked,+    create,++    -- * Read-only packed matrices+    RPacked(..),++    -- * Conversions between mutable and immutable packed matrices+    freeze,++    -- * Creating new packed matrices+    new_,+    +    -- * Copying matrices+    newCopy,++    -- * Vector views of packed matrices+    withVectorM,+    +    -- * Packed matrix views of vectors+    withFromVector,+    withFromVectorM,+    +    ) where++import Numeric.LinearAlgebra.Packed.Base+
+ lib/Numeric/LinearAlgebra/Packed/Statistics.hs view
@@ -0,0 +1,188 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Packed.Statistics+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Basic multivariate statistics.+--++module Numeric.LinearAlgebra.Packed.Statistics (+    defaultCovUplo,++    -- * Immutable interface+    cov,+    covWithMean,+    weightedCov,+    weightedCovWithMean,++    -- * Mutable interface+    covTo,+    covWithMeanTo,+    weightedCovTo,+    weightedCovWithMeanTo,++    ) where++import Control.Monad( when )+import Control.Monad.ST( ST )+import Data.List( foldl' )+import Text.Printf( printf )++import Numeric.LinearAlgebra.Types+import Numeric.LinearAlgebra.Packed.Base( Packed, STPacked )+import qualified Numeric.LinearAlgebra.Packed.Base as P++import Numeric.LinearAlgebra.Vector( Vector, RVector )+import qualified Numeric.LinearAlgebra.Vector as V++import qualified Numeric.LinearAlgebra.Matrix as M+++-- | Returns the default storage scheme for covariance matrices.+defaultCovUplo :: Uplo+defaultCovUplo = Lower++-- | Returns the sample covariance matrix hermitian matrix (in packed form)+-- with storage scheme equal to 'defaultCovUplo'.  The first argument gives+-- the dimension of the vectors.+cov :: (BLAS2 e)+    => Int -> CovMethod -> [Vector e] -> Herm Packed e+cov p t xs = P.hermCreate $ do+    c <- Herm uplo `fmap` P.new_ p+    covTo c t xs+    return c+  where+    uplo = defaultCovUplo++-- | Given the pre-computed mean, returns the sample covariance matrix+-- (in packed form) with storage scheme equal to 'defaultCovUplo'.+covWithMean :: (BLAS2 e)+            => Vector e -> CovMethod -> [Vector e] -> Herm Packed e+covWithMean mu t xs = P.hermCreate $ do+    c <- Herm uplo `fmap` P.new_ p+    covWithMeanTo c mu t xs+    return c+  where+    p = V.dim mu+    uplo = defaultCovUplo++-- | Returns the weighed sample covariance matrix (in packed form) with+-- storage scheme equal to 'defaultCovUplo'. The first argument gives the+-- dimension of the vectors.+weightedCov :: (BLAS2 e)+            => Int -> CovMethod -> [(Double, Vector e)] -> Herm Packed e+weightedCov p t wxs = P.hermCreate $ do+    c <- Herm uplo `fmap` P.new_ p+    weightedCovTo c t wxs+    return c+  where+    uplo = defaultCovUplo++-- | Given the pre-computed mean, returns the weighed sample covariance matrix+-- (in packed form) with storage scheme equal to 'defaultCovUplo'.+weightedCovWithMean :: (BLAS2 e)+                    => Vector e -> CovMethod -> [(Double, Vector e)]+                    -> Herm Packed e+weightedCovWithMean mu t wxs = P.hermCreate $ do+    c <- Herm uplo `fmap` P.new_ p+    weightedCovWithMeanTo c mu t wxs+    return c+  where+    p = V.dim mu+    uplo = defaultCovUplo++-- | Computes and copies the sample covariance matrix (in packed form)+-- to the given destination.+covTo :: (RVector v, BLAS2 e)+      => Herm (STPacked s) e -> CovMethod -> [v e] -> ST s ()+covTo c@(Herm _ a) t xs = do+    p <- P.getDim a+    mu <- V.new p 1+    V.meanTo mu xs+    covWithMeanTo c mu t xs+++-- | Given the pre-computed mean, computes and copies the sample covariance+-- matrix (in packed form) to the given destination.+covWithMeanTo :: (RVector v1, RVector v2, BLAS2 e)+              => Herm (STPacked s) e+              -> v1 e -> CovMethod -> [v2 e]+              -> ST s ()+covWithMeanTo c@(Herm _ a) mu t xs = do+    pa <- P.getDim a+    p <- V.getDim mu   +     +    when (pa /= p) $ error $+        printf ("covWithMeanTo"+                ++ " (Herm _ <packed matrix with dim %d>)"+                ++ " <vector with dim %d>"+                ++ " _ _"+                ++ ": dimension mismatch")+               pa p++    xt <- M.new_ (p,n)+    M.withColsM xt $ \xs' ->+        sequence_ [ V.subTo x' mu x+                  | (x,x') <- zip xs xs'+                  ]+    P.withVectorM a V.clear+    M.withColsM xt $ \xs' ->+        sequence_ [ P.hermRank1UpdateM_ scale x' c | x' <- xs' ]+  where+    n = length xs+    df = fromIntegral $ case t of { MLCov -> n ; UnbiasedCov -> n - 1 }+    scale = 1/df+++-- | Computes and copies the weighed sample covariance matrix (in packed+-- form) to the given destination.+weightedCovTo :: (RVector v, BLAS2 e)+              => Herm (STPacked s) e+              -> CovMethod -> [(Double, v e)] +              -> ST s ()+weightedCovTo c@(Herm _ a) t wxs = do+    p <- P.getDim a+    mu <- V.new p 1+    V.weightedMeanTo mu wxs+    weightedCovWithMeanTo c mu t wxs+++-- | Given the pre-computed mean, computes and copies the weighed sample+-- covariance matrix (in packed form) to the given destination.+weightedCovWithMeanTo :: (RVector v1, RVector v2, BLAS2 e)+                      => Herm (STPacked s) e+                      -> v1 e -> CovMethod -> [(Double, v2 e)]+                      -> ST s ()+weightedCovWithMeanTo c@(Herm _ a) mu t wxs = do+    pa <- P.getDim a+    p <- V.getDim mu+    +    when (pa /= p) $ error $+        printf ("weightedCovWithMeanTo"+                ++ " (Herm _ <packed matrix with dim %d>)"+                ++ " <vector with dim %d>"+                ++ " _ _"+                ++ ": dimension mismatch")+               pa p++    xt <- M.new_ (p,n)+    M.withColsM xt $ \xs' ->+        sequence_ [  V.subTo x' mu x+                  >> V.scaleM_ (realToFrac $ sqrt (w / invscale)) x'+                  |  (w,x,x') <- zip3 ws xs xs'+                  ]+    P.withVectorM a V.clear                      +    M.withCols xt $ \xs' ->+        sequence_ [ P.hermRank1UpdateM_ 1 x' c | x' <- xs' ]+  where+    (ws0,xs) = unzip wxs+    w_sum = foldl' (+) 0 ws0+    ws = if w_sum == 0 then ws0 else map (/w_sum) ws0+    w2s_sum = foldl' (+) 0 $ map (^^(2::Int)) ws+    invscale = case t of +                   MLCov -> 1+                   UnbiasedCov -> (1 - w2s_sum)+    n = length ws0
+ lib/Numeric/LinearAlgebra/Packed/Tri.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Packed.Tri+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Triangular views of packed matrices.+--++module Numeric.LinearAlgebra.Packed.Tri (+    -- * Immutable interface+    +    -- ** Vector multiplication+    triMulVector,+    +    -- ** Vector solving+    triSolvVector,+    +    -- * Mutable interface+    triCreate,+    +    -- ** Vector multiplication+    triMulVectorM_,+    +    -- ** Vector solving+    triSolvVectorM_,++    ) where++import Control.Monad( when )+import Control.Monad.ST( ST, runST, unsafeIOToST )+import Text.Printf( printf )++import Numeric.LinearAlgebra.Vector( Vector, STVector )+import qualified Numeric.LinearAlgebra.Vector as V+import Numeric.LinearAlgebra.Packed.Base( Packed, RPacked, STPacked )+import qualified Numeric.LinearAlgebra.Packed.Base as P+import Numeric.LinearAlgebra.Types+import qualified Foreign.BLAS as BLAS+++-- | A safe way to create and work with a mutable Tri Packed before returning +-- an immutable one for later perusal.+triCreate :: (Storable e)+          => (forall s. ST s (Tri (STPacked s) e))+          -> Tri Packed e+triCreate mt = runST $ do+    (Tri u d ma) <- mt+    a <- P.unsafeFreeze ma+    return $ Tri u d a++-- | @triMulVector trans a x@ returns @op(a) * x@, where @op(a)@ is+-- determined by @trans@.+triMulVector :: (BLAS2 e)+             => Trans+             -> Tri Packed e+             -> Vector e+             -> Vector e+triMulVector trans a x =+    V.create $ do+        x' <- V.newCopy x+        triMulVectorM_ trans a x'+        return x'++-- | @triMulVectorM_ a x@ sets @x := op(a) * x@, where @op(a)@ is determined+-- by @trans@.+triMulVectorM_ :: (RPacked p, BLAS2 e)+               => Trans -> Tri p e+               -> STVector s e+               -> ST s ()+triMulVectorM_ trans (Tri uplo diag a) x = do+    na <- P.getDim a+    nx <- V.getDim x+    let n = nx+    +    when (nx /= n) $ error $+        printf ("triMulVectorM_"+                ++ " _"+                ++ " (Tri _ _ <packed matrix with dim %d>)"+                ++ " <vector with dim %d>"+                ++ ": dimension mismatch")+               na+               nx++    unsafeIOToST $+        P.unsafeWith a $ \pa ->+        V.unsafeWith x $ \px ->+            BLAS.tpmv uplo trans diag n pa px 1+++-- | @triSolvVector trans a x@ returns @op(a) \\ x@, where @op(a)@ is+-- determined by @trans@.+triSolvVector :: (BLAS2 e)+             => Trans+             -> Tri Packed e+             -> Vector e+             -> Vector e+triSolvVector trans a x =+    V.create $ do+        x' <- V.newCopy x+        triSolvVectorM_ trans a x'+        return x'++-- | @triSolvVectorM_ a x@ sets @x := op(a) \\ x@, where @op(a)@ is determined+-- by @trans@.+triSolvVectorM_ :: (RPacked p, BLAS2 e)+               => Trans -> Tri p e+               -> STVector s e+               -> ST s ()+triSolvVectorM_ trans (Tri uplo diag a) x = do+    na <- P.getDim a+    nx <- V.getDim x+    let n = nx+    +    when (nx /= n) $ error $+        printf ("triMulVectorM_"+                ++ " _"+                ++ " (Tri _ _ <packed matrix with dim %d>)"+                ++ " <vector with dim %d>"+                ++ ": dimension mismatch")+               na+               nx++    unsafeIOToST $+        P.unsafeWith a $ \pa ->+        V.unsafeWith x $ \px ->+            BLAS.tpsv uplo trans diag n pa px 1
+ lib/Numeric/LinearAlgebra/Types.hs view
@@ -0,0 +1,92 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Types+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Basic type classes and enums.+--++module Numeric.LinearAlgebra.Types (++    -- * Matrix views+    Herm(..),+    Tri(..),++    -- * Matrix factorization views+    Chol(..),++    -- * Vector math types+    VNum,+    VFractional,+    VFloating,++    -- * BLAS element types+    BLAS1,+    BLAS2,+    BLAS3,+    +    -- * LAPACK element types+    LAPACK,+    +    -- * Enums+    Trans(..),+    Uplo(..),+    Side(..),+    Diag(..),++    -- * Algorithm-specific parameters+    CovMethod(..),++    -- * Re-export of Complex from Data.Complex+    module Data.Complex,++    -- * Re-export of Storable from Foreign.Storable+    module Foreign.Storable,+        +    ) where++import Foreign.VMath( VNum, VFractional, VFloating )+import Foreign.BLAS( Trans(..), Uplo(..), Side(..), Diag(..), BLAS1, BLAS2, BLAS3 )+import Foreign.LAPACK( LAPACK )+import Data.Complex( Complex(..) )+import Foreign.Storable( Storable() )++-- | A hermitian view of an underlying matrix.  The view can either be+-- of the upper or lower triangular part of the matrix.  The type arguments+-- are as follows:+--+--     * @m@: the underlyting matrix type.+--+--     * @e@: the element type of the matrix.+--+data Herm m e = Herm Uplo (m e) deriving (Show)++-- | A triangular view of an underlying matrix.  The view can either be+-- upper or lower triangular, with a unit or non-unit diagonal.  The type+-- arguments are as follows:+--+--     * @m@: the underlyting matrix type.+--+--     * @e@: the element type of the matrix.+--+data Tri m e = Tri Uplo Diag (m e) deriving (Show)++-- | A Cholesky decomposition view of a matrix.+data Chol m e = Chol Uplo (m e) deriving (Show)++-- | The method of scaling the sample covariance matrix.+data CovMethod =+      UnbiasedCov -- ^ This is the default behavior. Corresponds to a+                  -- scaling of @n/(n-1)@ in the unweighed case, and+                  -- @1/(1 - \\sum w_i^2)@ in the weighted case, where @w_i@+                  -- is the normalized weight. Note the unweighted and+                  -- weighted cases agree when @w_i = 1/n@.+                  +    | MLCov       -- ^ Returns the centered second moment matrix without+                  -- scaling the result.+    deriving (Eq, Show)+
+ lib/Numeric/LinearAlgebra/Vector.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Vector+-- Copyright  : Copyright (c) , Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Immutable dense vectors.++module Numeric.LinearAlgebra.Vector (+    -- * Immutable vectors+    Vector,+    dim,+    +    -- * Vector construction+    fromList,+    zero,+    constant,++    -- * Accessing vectors+    at,+    unsafeAt,+    indices,+    elems,+    assocs,++    -- * Incremental vector updates+    update,+    unsafeUpdate,+    accum,+    unsafeAccum,++    -- * Derived vectors+    map,+    zipWith,+    unsafeZipWith,+    concat,++    -- * Vector views+    slice,+    unsafeSlice,+    splitAt,+    drop,+    take,++    -- * Vector properties+    sumAbs,    +    norm2,+    whichMaxAbs,+    dot,+    unsafeDot,+    kronecker,++    -- * Vector math operations+    -- ** Num+    add,+    addWithScale,+    sub,+    scale,+    mul,+    negate,+    conjugate,+    abs,+    signum,++    -- ** Fractional+    div,+    recip,        ++    -- ** Floating+    sqrt,+    exp,+    log,+    pow,+    sin,+    cos,+    tan,+    asin,+    acos,+    atan,+    sinh,+    cosh,+    tanh,+    asinh,+    acosh,+    atanh,+    +    -- * Conversions between foreign pointers+    unsafeFromForeignPtr,+    unsafeToForeignPtr,+    +    -- * Mutable interface+    module Numeric.LinearAlgebra.Vector.ST,+    +    -- * Basic multivariate statistics+    module Numeric.LinearAlgebra.Vector.Statistics,++    ) where++import Prelude( Int, Double, ($), (*), return )+import Control.Monad.ST( runST, ST )+import Foreign( Storable )+import Foreign.BLAS( BLAS1, BLAS2 )+import Foreign.VMath( VNum, VFractional, VFloating )++import Numeric.LinearAlgebra.Vector.Base+import Numeric.LinearAlgebra.Vector.ST+import Numeric.LinearAlgebra.Vector.Statistics++infixr 8 `pow`+infixl 7 `div`+infixl 7 `mul`, `scale`, `kronecker`+infixl 6 `add`, `sub`+++-- | Compute the sum of absolute values of entries in the vector.+sumAbs :: (BLAS1 e) => Vector e -> Double+sumAbs v = runST $ getSumAbs v+{-# INLINE sumAbs #-}++-- | Compute the 2-norm (Euclidean norm) of a vector.+norm2 :: (BLAS1 e) => Vector e -> Double+norm2 v = runST $ getNorm2 v+{-# INLINE norm2 #-}++-- | Get the index and norm of the element with absulte value.  Not valid +-- if any of the vector entries are @NaN@.  Raises an exception if the +-- vector has length @0@.+whichMaxAbs :: (BLAS1 e) => Vector e -> (Int, e)+whichMaxAbs v = runST $ getWhichMaxAbs v+{-# INLINE whichMaxAbs #-}++-- | Compute the dot product of two vectors.+dot :: (BLAS1 e) => Vector e -> Vector e -> e+dot v v' = runST $ getDot v v'+{-# INLINE dot #-}++unsafeDot :: (BLAS1 e) => Vector e -> Vector e -> e+unsafeDot v v' = runST $ unsafeGetDot v v'+{-# INLINE unsafeDot #-}++-- | Compute the kronecker product of two vectors.+kronecker :: (BLAS2 e) => Vector e -> Vector e -> Vector e+kronecker x y = create $ do+    z <- new_ (dim x * dim y)+    kroneckerTo z x y+    return z++-- | @add x y@ returns @x + y@.+add :: (VNum e) => Vector e -> Vector e -> Vector e+add = result2 addTo++-- | @sub x y@ returns @x - y@.+sub :: (VNum e) => Vector e -> Vector e -> Vector e+sub = result2 subTo++-- | @scale k x@ returns @k * x@.+scale :: (BLAS1 e) => e -> Vector e -> Vector e+scale k x = create $ do+    x' <- newCopy x+    scaleM_ k x'+    return x'++-- | @addWithScale alpha x y@ return @alpha * x + y@.+addWithScale :: (BLAS1 e) => e -> Vector e -> Vector e -> Vector e+addWithScale alpha x y = create $ do+    y' <- newCopy y+    addWithScaleM_ alpha x y'+    return y'++-- | @mul x y@ returns @x * y@.+mul :: (VNum e) => Vector e -> Vector e -> Vector e+mul = result2 mulTo++-- | @negate x@ returns @-x@.+negate :: (VNum e) => Vector e -> Vector e+negate = result negateTo++-- | @conjugate x@ returns @conjugate(x)@.+conjugate :: (VNum e) => Vector e -> Vector e+conjugate = result conjugateTo++-- | @abs x@ returns @abs(x)@.+abs :: (VNum e) => Vector e -> Vector e+abs = result absTo++-- | @signum x@ returns @signum(x)@.+signum :: (VNum e) => Vector e -> Vector e+signum = result signumTo++-- | @div x y@ returns @x / y@.+div :: (VFractional e) => Vector e -> Vector e -> Vector e+div = result2 divTo++-- | @recip x y@ returns @1 / x@.+recip :: (VFractional e) => Vector e -> Vector e+recip = result recipTo++-- | @sqrt x@ returns @sqrt(x)@.+sqrt :: (VFloating e) => Vector e -> Vector e+sqrt = result sqrtTo++-- | @exp x@ returns @exp(x)@.+exp :: (VFloating e) => Vector e -> Vector e+exp = result expTo++-- | @log x@ returns @log(x)@.+log :: (VFloating e) => Vector e -> Vector e+log = result logTo++-- | @pow x y@ returns @x ** y@.+pow :: (VFloating e) => Vector e -> Vector e -> Vector e+pow = result2 powTo++-- | @sin x@ returns @sin(x)@.+sin :: (VFloating e) => Vector e -> Vector e+sin = result sinTo++-- | @cos x@ returns @cos(x)@.+cos :: (VFloating e) => Vector e -> Vector e+cos = result cosTo++-- | @tan x@ returns @tan(x)@.+tan :: (VFloating e) => Vector e -> Vector e+tan = result tanTo++-- | @asin x@ returns @asin(x)@.+asin :: (VFloating e) => Vector e -> Vector e+asin = result asinTo++-- | @acos x@ returns @acos(x)@.+acos :: (VFloating e) => Vector e -> Vector e+acos = result acosTo++-- | @atan x@ returns @atan(x)@.+atan :: (VFloating e) => Vector e -> Vector e+atan = result atanTo++-- | @sinh x@ returns @sinh(x)@.+sinh :: (VFloating e) => Vector e -> Vector e+sinh = result sinhTo++-- | @cosh x@ returns @cosh(x)@.+cosh :: (VFloating e) => Vector e -> Vector e+cosh = result coshTo++-- | @tanh x@ returns @tanh(x)@.+tanh :: (VFloating e) => Vector e -> Vector e+tanh = result tanhTo++-- | @asinh x@ returns @asinh(x)@.+asinh :: (VFloating e) => Vector e -> Vector e+asinh = result asinhTo++-- | @acosh x@ returns @acosh(x)@.+acosh :: (VFloating e) => Vector e -> Vector e+acosh = result acoshTo++-- | @atanh x@ returns @atanh(x)@.+atanh :: (VFloating e) => Vector e -> Vector e+atanh = result atanhTo+++result :: (Storable e, Storable f)+       => (forall s . STVector s f -> Vector e -> ST s a)+       -> Vector e+       -> Vector f+result f v = create $ newResult f v+{-# INLINE result #-}++result2 :: (Storable e, Storable f, Storable g)+        => (forall s . STVector s g -> Vector e -> Vector f -> ST s a)+        -> Vector e+        -> Vector f+        -> Vector g+result2 f v1 v2 = create $ newResult2 f v1 v2+{-# INLINE result2 #-}++newResult :: (RVector v, Storable e, Storable f)+          => (STVector s f -> v e -> ST s a)+          -> v e+          -> ST s (STVector s f)+newResult f v = do+    n <- getDim v+    z <- new_ n+    _ <- f z v+    return z+{-# INLINE newResult #-}++newResult2 :: (RVector v1, RVector v2, Storable e, Storable f, Storable g)+           => (STVector s g -> v1 e -> v2 f -> ST s a)+           -> v1 e+           -> v2 f+           -> ST s (STVector s g)+newResult2 f v1 v2 = do+    n <- getDim v1+    z <- new_ n+    _ <- f z v1 v2+    return z+{-# INLINE newResult2 #-}
+ lib/Numeric/LinearAlgebra/Vector/Base.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE Rank2Types #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Vector.Base+-- Copyright  : Copyright (c) , Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--++module Numeric.LinearAlgebra.Vector.Base (+    Vector,+    dim,+    +    fromList,+    zero,+    constant,+    +    at,+    unsafeAt,+    +    indices,+    elems,+    assocs,+    +    update,+    unsafeUpdate,+    accum,+    unsafeAccum,+    +    map,+    zipWith,+    unsafeZipWith,+    concat,+    +    slice,+    splitAt,+    drop,+    take,+    +    unsafeSlice,+    unsafeFromForeignPtr,+    unsafeToForeignPtr,+    unsafeWith,+    ) where++import Prelude hiding ( concat, drop, map, read, splitAt, take, zipWith, +    negate, signum, abs, div, recip, sqrt, exp, log, sin, cos, tan, asin,+    acos, atan, sinh, cosh, tanh, asinh, acosh, atanh )+import qualified Prelude as P++import Data.AEq( AEq(..) )+import Data.Vector.Storable( Vector )+import qualified Data.Vector.Storable as Vector+import Foreign( ForeignPtr, Ptr, Storable )+import Text.Printf( printf )+++-- | The dimension of a vector.  This is equal to the number of+-- elements in the vector.                          +dim :: (Storable e) => Vector e -> Int+dim = Vector.length+{-# INLINE dim #-}++-- | Create a vector of the given dimension with elements initialized+-- to the values from the list.  The list must have at least as many+-- elements as the dimension of the vector; elements in the list past+-- the dimension of the vector are discarded.+fromList :: (Storable e) => Int -> [e] -> Vector e+fromList n es = Vector.fromListN n $ es ++ repeat (error msg)+  where+    msg = printf ( "fromList"+                 ++ " %d"+                 ++ " <list with length less than %d>"+                 ++ ": not enough elements"+                 ) n n+{-# INLINE fromList #-}++-- | Create a zero vector of the given dimension with all elements initialized+-- to the given zero.+zero :: (Storable e, Num e) => Int -> Vector e+zero n = constant n 0+{-# INLINE zero #-}++-- | Create a vector of the given dimension with all elements initialized+-- to the given value.+constant :: (Storable e) => Int -> e -> Vector e+constant n e+    | n < 0 = error $+        printf ("constant %d: negative dimension") n+    | otherwise =+        Vector.fromListN n $ repeat e+{-# INLINE constant #-}++-- | Returns the element of a vector at the specified index.+at :: (Storable e) => Vector e -> Int -> e+at v i+    | i < 0 || i >= n = error $+        printf "at <vector with dim %d> %d: invalid index" n i+    | otherwise =+        unsafeAt v i+  where+    n = dim v+{-# INLINE at #-}++-- | Same as 'at' but does not range-check index.+unsafeAt :: (Storable e) => Vector e -> Int -> e+unsafeAt v i = Vector.unsafeIndex v i+{-# INLINE unsafeAt #-}++-- | Get the indices of the elements in the vector, @[ 0..n-1 ]@, where+-- @n@ is the dimension of the vector.+indices :: (Storable e) => Vector e -> [Int]+indices x = [ 0..n-1 ] where n = dim x+{-# INLINE indices #-}++-- | Returns a list of the elements of a vector, in the same order as their+-- indices.+elems :: (Storable e) => Vector e -> [e]+elems = Vector.toList+{-# INLINE elems #-}++-- | Returns the contents of a vector as a list of associations.+assocs :: (Storable e) => Vector e -> [(Int,e)]+assocs x = zip (indices x) (elems x)+{-# INLINE assocs #-}++-- | Same as 'update' but does not range-check indices.+unsafeUpdate :: (Storable e) => Vector e -> [(Int,e)] -> Vector e+unsafeUpdate = Vector.unsafeUpd++-- | Create a new vector by replacing the values at the specified indices.+update :: (Storable e) => Vector e -> [(Int,e)] -> Vector e+update = (Vector.//)++-- | @accum f@ takes a vector and an association list and accumulates+-- pairs from the list into the vector with the accumulating function @f@.+accum :: (Storable e)+      => (e -> e' -> e) +            -> Vector e+            -> [(Int, e')]+            -> Vector e+accum = Vector.accum+{-# INLINE accum #-}++-- | Same as 'accum' but does not range-check indices.+unsafeAccum :: (Storable e)+            => (e -> e' -> e)+            -> Vector e+            -> [(Int, e')]+            -> Vector e+unsafeAccum = Vector.unsafeAccum+{-# INLINE unsafeAccum #-}++-- | Construct a new vector by applying a function to every element of+-- a vector.+map :: (Storable e, Storable e')+    => (e -> e')+    -> Vector e+    -> Vector e'+map = Vector.map+{-# INLINE map #-}++-- | Construct a new vector by applying a function to every pair of elements+-- of two vectors.  The two vectors must have identical dimensions.+zipWith :: (Storable e, Storable e', Storable f)+        => (e -> e' -> f)+        -> Vector e+        -> Vector e'+        -> Vector f+zipWith f v v'+    | n /= n' = error $+        printf ("zipWith <function> <vector with dim %d>"+                ++ " <vector with dim %d>: lengths differ") n n'+    | otherwise =+        unsafeZipWith f v v'+  where+    n  = dim v+    n' = dim v'+{-# INLINE zipWith #-}++-- | Same as 'zipWith' but does not check if the input vectors+-- have the same dimensions.+unsafeZipWith :: (Storable e, Storable e', Storable f)+              => (e -> e' -> f)+              -> Vector e+              -> Vector e'+              -> Vector f+unsafeZipWith = Vector.zipWith+{-# INLINE unsafeZipWith #-}++-- | Create a new vector by concatenating a list of vectors.+concat :: (Storable e) => [Vector e] -> Vector e+concat = Vector.concat+{-# INLINE concat #-}++-- | Same as 'slice' but does not range-change indices.+unsafeSlice :: (Storable e)+            => Int+            -> Int+            -> Vector e+            -> Vector e            +unsafeSlice = Vector.unsafeSlice+{-# INLINE unsafeSlice #-}++-- | @slice i n v@ creates a subvector view of @v@ starting at+-- index @i@ and having dimension @n@.+slice :: (Storable e)+      => Int+      -> Int+      -> Vector e+      -> Vector e            +slice i n' v+    | i < 0 || n' < 0 || i + n' > n = error $+        printf "slice %d %d <vector with dim %d>: index out of range"+               i n' n+    | otherwise =+        unsafeSlice i n' v+  where+    n = dim v+{-# INLINE slice #-}++-- | @drop i v@ is equal to @slice i (n-i) v@, where @n@ is+-- the dimension of the vector.+drop :: (Storable e) => Int -> Vector e -> Vector e+drop i v = slice i (dim v - i) v+{-# INLINE drop #-}++-- | @take n v@ is equal to @slice 0 n v@.+take :: (Storable e) => Int -> Vector e -> Vector e+take n v = slice 0 n v+{-# INLINE take #-}++-- | Split a vector into two blocks and returns views into the blocks.  If+-- @(v1, v2) = splitAt i v@, then+-- @v1 = slice 0 i v@ and+-- @v2 = slice i (dim v - i) v@.+splitAt :: (Storable e) => Int -> Vector e -> (Vector e, Vector e)+splitAt i v +    | i < 0 || i > n = error $+        printf "splitAt %d <vector with dim %d>: invalid index" i n+    | otherwise = let+        v1 = unsafeSlice 0 i     v+        v2 = unsafeSlice i (n-i) v+        in (v1, v2)+  where+    n = dim v++-- | Create a vector from a 'ForeignPtr' with an offset and a dimension. The+-- data may not be modified through the ForeignPtr afterwards.+unsafeFromForeignPtr :: (Storable e)+                     => ForeignPtr e -- ^ pointer+                     -> Int	         -- ^ offset+                     -> Int	         -- ^ dimension+                     -> Vector e+unsafeFromForeignPtr = Vector.unsafeFromForeignPtr+{-# INLINE unsafeFromForeignPtr #-}++-- | Yield the underlying 'ForeignPtr' together with the offset to the data+-- and its length. The data may not be modified through the 'ForeignPtr'.+unsafeToForeignPtr :: (Storable e) => Vector e -> (ForeignPtr e, Int, Int)+unsafeToForeignPtr = Vector.unsafeToForeignPtr+{-# INLINE unsafeToForeignPtr #-}++-- | Pass a pointer to the vector's data to the 'IO' action. The data may+-- not be modified through the 'Ptr'.+unsafeWith :: (Storable e) => Vector e -> (Ptr e -> IO a) -> IO a+unsafeWith = Vector.unsafeWith+++instance (Storable e, AEq e) => AEq (Vector e) where+    (===) = compareWith (===)+    {-# INLINE (===) #-}+    (~==) = compareWith (~==)+    {-# INLINE (~==) #-}++compareWith :: (Storable e, Storable e')+            => (e -> e' -> Bool)+            -> Vector e+            -> Vector e'+            -> Bool+compareWith cmp v v' =+    dim v == dim v'+    && and (P.zipWith cmp (elems v) (elems v'))+{-# INLINE compareWith #-}+
+ lib/Numeric/LinearAlgebra/Vector/ST.hs view
@@ -0,0 +1,115 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Vector.ST+-- Copyright  : Copyright (c) , Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Mutable vectors in the ST monad.++module Numeric.LinearAlgebra.Vector.ST (+    -- * Mutable vectors+    STVector,+    IOVector,+    create,+    +    -- * Read-only vectors+    RVector(..),+    +    -- * Creating new vectors+    new_,+    new,+    +    -- * Copying vectors+    newCopy,+    copyTo,+    swap,++    -- * Reading and writing vector elements+    read,+    write,+    modify,+    getIndices,+    getElems,+    getElems',+    getAssocs,+    getAssocs',+    setElems,+    setAssocs,    +    clear,++    -- * List-like operations+    mapTo,+    zipWithTo,++    -- * Vector linear algebra+    getSumAbs,+    getNorm2,+    getWhichMaxAbs,+    getDot,+    scaleM_,+    addWithScaleM_,+    kroneckerTo,+    +    -- * Vector views    +    withSlice,+    withDrop,+    withTake,+    withSplitAt,+    +    withSliceM,+    withDropM,+    withTakeM,+    withSplitAtM,+    +    -- * Vector math operations+    -- ** Num+    addTo,+    subTo,+    mulTo,+    negateTo,+    conjugateTo,+    absTo,+    signumTo,++    -- ** Fractional+    divTo,+    recipTo,        ++    -- ** Floating+    sqrtTo,+    expTo,+    logTo,+    powTo,+    sinTo,+    cosTo,+    tanTo,+    asinTo,+    acosTo,+    atanTo,+    sinhTo,+    coshTo,+    tanhTo,+    asinhTo,+    acoshTo,+    atanhTo,++    -- * Conversions between mutable and immutable vectors+    freeze,+    +    -- * Unsafe operations+    unsafeCopyTo,+    unsafeSwap,+    unsafeRead,+    unsafeWrite,+    unsafeModify,+    unsafeMapTo,+    unsafeZipWithTo,+    unsafeAddWithScaleM_,+    unsafeGetDot,+    +    ) where++import Prelude()+import Numeric.LinearAlgebra.Vector.STBase
+ lib/Numeric/LinearAlgebra/Vector/STBase.hs view
@@ -0,0 +1,925 @@+{-# LANGUAGE Rank2Types, DeriveDataTypeable #-}+{-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Vector.STBase+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : asinerimental+--++module Numeric.LinearAlgebra.Vector.STBase (+    STVector,+    IOVector,+    RVector(..),+    +    create,+    freeze,+    +    new_,+    new,+    newCopy,+    +    clear,+    copyTo,+    unsafeCopyTo,+    swap,+    unsafeSwap,+    +    getIndices,+    getElems,+    getElems',+    getAssocs,+    getAssocs',+    setElems,+    setAssocs,+    unsafeSetAssocs,+    +    read,+    unsafeRead,+    write,+    unsafeWrite,+    modify,+    unsafeModify,+    unsafeSwapElems,++    mapTo,+    unsafeMapTo,+    zipWithTo,+    unsafeZipWithTo,+    +    withSlice,+    withDrop,+    withTake,+    withSplitAt,+    +    withSliceM,+    withDropM,+    withTakeM,+    withSplitAtM,+    +    getSumAbs,+    getNorm2,+    getWhichMaxAbs,+    getDot,+    unsafeGetDot,+    scaleM_,+    addWithScaleM_,+    unsafeAddWithScaleM_,+    kroneckerTo,+    +    addTo,+    subTo,+    mulTo,+    negateTo,+    conjugateTo,+    absTo,+    signumTo,+    divTo,+    recipTo,        +    sqrtTo,+    expTo,+    logTo,+    powTo,+    sinTo,+    cosTo,+    tanTo,+    asinTo,+    acosTo,+    atanTo,+    sinhTo,+    coshTo,+    tanhTo,+    asinhTo,+    acoshTo,+    atanhTo,+    ) where++import Prelude hiding ( drop, read, splitAt, take )++import Control.Monad( when, liftM2 )+import Control.Monad.ST( RealWorld, ST, runST, stToIO, unsafeIOToST )+import Data.Complex( Complex )+import Data.Typeable( Typeable )+import Foreign( Ptr, Storable, advancePtr, peek, poke, peekElemOff,+    pokeElemOff, copyArray, mallocForeignPtrArray )+import System.IO.Unsafe( unsafeInterleaveIO )+import Text.Printf( printf )+import Unsafe.Coerce( unsafeCoerce )++import Foreign.BLAS( BLAS1, BLAS2 )+import qualified Foreign.BLAS as BLAS+import Foreign.VMath( VNum, VFractional, VFloating )+import qualified Foreign.VMath as VMath++import Numeric.LinearAlgebra.Internal( clearArray )+import Numeric.LinearAlgebra.Vector.Base hiding ( unsafeWith )+import qualified Numeric.LinearAlgebra.Vector.Base as V+++-- | Mutable vectors in the 'ST' monad.+newtype STVector s e = STVector { unSTVector :: Vector e }+    deriving (Typeable)++-- | Mutable vectors in the 'IO' monad.  Note that 'IO' operations+-- aren't directly supported; to perform an operation in the 'IO'+-- monad, perform the action in 'ST' 'RealWorld' and then convert+-- it via 'stToIO'.+type IOVector s = STVector RealWorld++-- | A safe way to create and work with a mutable vector before returning +-- an immutable vector for later perusal. This function avoids copying+-- the vector before returning it - it uses 'unsafeFreeze' internally,+-- but this wrapper is a safe interface to that function.+create :: (Storable e) => (forall s . ST s (STVector s e)) -> Vector e+create stmv = runST $ do+    mv <- stmv+    unsafeFreeze mv+{-# INLINE create #-}++-- | Converts a mutable vector to an immutable one by taking a complete+-- copy of it.+freeze :: (RVector v, Storable e) => v e -> ST s (Vector e)+freeze mv = do+    mv' <- newCopy mv+    unsafeFreeze mv'+{-# INLINE freeze #-}++++-- | Read-only vectors+class RVector v where+    -- | Get the dimension of the vector.  This is equal to the number of+    -- elements in the vector.                          +    getDim :: (Storable e) => v e -> ST s Int++    -- | Same as 'withSlice' but does not range-check indices.+    unsafeWithSlice :: (Storable e)+                    => Int -> Int -> v e+                    -> (forall v'. RVector v' => v' e -> ST s a)+                    -> ST s a++    -- | Execute an 'IO' action with a pointer to the first element in the+    -- vector.+    unsafeWith :: (Storable e) => v e -> (Ptr e -> IO a) -> IO a++    -- | Converts a read-only vector into an immutable vector. This simply+    -- casts the vector from one type to the other without copying the vector.+    -- Note that because the vector is possibly not copied, any subsequent+    -- modifications made to the mutable version of the vector may be shared+    -- with the immutable version. It is safe to use, therefore, if the+    -- mutable version is never modified after the freeze operation.+    unsafeFreeze :: (Storable e) => v e -> ST s (Vector e)++    -- | Unsafe cast from a read-only vector to a mutable vector.+    unsafeThaw :: (Storable e)+               => v e -> ST s (STVector s e)+++instance RVector Vector where+    getDim = return . dim+    {-# INLINE getDim #-}++    unsafeWith = V.unsafeWith+    {-# INLINE unsafeWith #-}++    unsafeWithSlice i n' v f =+        f (V.unsafeSlice i n' v)+    {-# INLINE unsafeWithSlice #-}++    unsafeFreeze = return . id+    {-# INLINE unsafeFreeze #-}++    unsafeThaw = return . STVector+    {-# INLINE unsafeThaw #-}+++instance RVector (STVector s) where+    getDim = return . dim . unSTVector+    {-# INLINE getDim #-}++    unsafeWith v f = V.unsafeWith (unSTVector v) f+    {-# INLINE unsafeWith #-}++    unsafeWithSlice i n' v f =+        f $ unsafeSlice i n' (unSTVector v)+    {-# INLINE unsafeWithSlice #-}++    unsafeFreeze = return . unSTVector+    {-# INLINE unsafeFreeze #-}++    unsafeThaw v = return $ cast v+      where+        cast :: STVector s e -> STVector s' e+        cast = unsafeCoerce+    {-# INLINE unsafeThaw #-}+++-- | @withSlice i n v@ performs an action with a view of the+-- @n@-dimensional subvector of @v@ starting at index @i@.+withSlice :: (RVector v, Storable e)+          => Int+          -> Int+          -> v e+          -> (forall v'. RVector v' => v' e -> ST s a)+          -> ST s a+withSlice i n' v f = do+    n <- getDim v+    when (i < 0 || n' < 0 || i + n' > n) $ error $+        printf "withSlice %d %d <vector with dim %d>: index out of range"+               i n' n+    unsafeWithSlice i n' v f++-- | Same as 'withSliceM' but does not range-check indices.+unsafeWithSliceM :: (Storable e)+                 => Int+                 -> Int+                 -> STVector s e+                 -> (STVector s e -> ST s a)+                 -> ST s a+unsafeWithSliceM i n' v f =+    f $ STVector $ unsafeSlice i n' (unSTVector v)++-- | Like 'withSlice', but perform the action with a mutable view +-- of the vector.+withSliceM :: (Storable e)+           => Int+           -> Int+           -> STVector s e+           -> (STVector s e -> ST s a)+           -> ST s a+withSliceM i n' v f = do+    n <- getDim v+    when (i < 0 || n' < 0 || i + n' > n) $ error $+        printf "withSlice %d %d <vector with dim %d>: index out of range"+               i n' n+    unsafeWithSliceM i n' v f++-- | Like 'withDrop', but perform the action with a mutable view +-- of the vector.+withDropM :: (Storable e)+          => Int+          -> STVector s e+          -> (STVector s e -> ST s a)+          -> ST s a+withDropM i v f = do+    n <- getDim v+    withSliceM i (n-i) v f++-- | Like 'withTake', but perform the action with a mutable view +-- of the vector.+withTakeM :: (Storable e)+          => Int+          -> STVector s e+          -> (STVector s e -> ST s a)+          -> ST s a+withTakeM = withSliceM 0++-- | Like 'withSplitAt' but perform the action with mutable views+-- of the vector.+withSplitAtM :: (Storable e)+             => Int+             -> STVector s e+             -> (STVector s e -> STVector s e -> ST s a)+             -> ST s a+withSplitAtM i v f = do+    n <- getDim v+    withSliceM 0 i v $ \v1 ->+        withSliceM i (n-i) v $ \v2 ->+            f v1 v2++-- | Perform an action the a view gotten from dropping the given+-- number of elements from the start of the vector.+withDrop :: (RVector v, Storable e)+         => Int+         -> v e+         -> (forall v'. RVector v' => v' e -> ST s a)+         -> ST s a+withDrop i v f = do+    mv <- unsafeThaw v+    withDropM i mv f++-- | Perform an action with a view gotten from taking the given+-- number of elements from the start of the vector.+withTake :: (RVector v, Storable e)+         => Int+         -> v e+         -> (forall v'. RVector v' => v' e -> ST s a)+         -> ST s a+withTake n v f = do+    mv <- unsafeThaw v+    withTakeM n mv f++-- | Perform an action with views from splitting the vector at the+-- given index.+withSplitAt :: (RVector v, Storable e)+            => Int+            -> v e+            -> (forall v1' v2'. (RVector v1', RVector v2') => v1' e -> v2' e -> ST s a)+            -> ST s a+withSplitAt i v f = do+    mv <- unsafeThaw v+    withSplitAtM i mv f++-- | Creates a new vector of the given length.  The elements will be+-- uninitialized.+new_ :: (Storable e) => Int -> ST s (STVector s e)+new_ n+    | n < 0 =  error $+        printf "new_ %d: invalid dimension" n+    | otherwise = unsafeIOToST $ do+        f <- mallocForeignPtrArray n+        return $ STVector $ V.unsafeFromForeignPtr f 0 n++-- | Create a vector with every element initialized to the same value.+new :: (Storable e) => Int -> e -> ST s (STVector s e)+new n e = do+    x <- new_ n+    setElems x $ replicate n e+    return x++-- | Creates a new vector by copying another one.    +newCopy :: (RVector v, Storable e) => v e -> ST s (STVector s e)+newCopy x = do+    n <- getDim x+    y <- new_ n+    unsafeCopyTo y x+    return y++-- | @copyTo dst src@ replaces the values in @dst@ with those in+-- source.  The operands must be the same shape.+copyTo :: (RVector v, Storable e) => STVector s e -> v e -> ST s ()+copyTo = checkOp2 "copyTo" unsafeCopyTo+{-# INLINE copyTo #-}++-- | Same as 'copyTo' but does not check the dimensions.+unsafeCopyTo :: (RVector v, Storable e) => STVector s e -> v e -> ST s ()+unsafeCopyTo dst src = do+    n <- getDim dst+    unsafeIOToST $+        unsafeWith dst $ \pdst ->+        unsafeWith src $ \psrc ->+            copyArray pdst psrc n+{-# INLINE unsafeCopyTo #-}++-- | Swap the values stored in two vectors.+swap :: (BLAS1 e) => STVector s e -> STVector s e -> ST s ()+swap = checkOp2 "swap" unsafeSwap+{-# INLINE swap #-}++-- | Same as 'swap' but does not check the dimensions.+unsafeSwap :: (BLAS1 e) => STVector s e -> STVector s e -> ST s ()+unsafeSwap = strideCall2 BLAS.swap+{-# INLINE unsafeSwap #-}++-- | Get the indices of the elements in the vector, @[ 0..n-1 ]@, where+-- @n@ is the dimension of the vector.+getIndices :: (RVector v, Storable e) => v e -> ST s [Int]+getIndices v = do+    n <- getDim v+    return $ [ 0..n-1 ]+{-# INLINE getIndices #-}++-- | Lazily get the elements of the vector.+getElems :: (RVector v, Storable e) => v e -> ST s [e]+getElems v = let+    go end p' | p' == end = do+                  touch v+                  return []+              | otherwise = unsafeInterleaveIO $ do+                  e   <- peek p'+                  es  <- go end (p' `advancePtr` 1)+                  return $ e `seq` (e:es)+    in do+        n <- getDim v+        unsafeIOToST $+            unsafeWith v $ \p -> +                go (p `advancePtr` n) p+  where+    touch v' = unsafeWith v' $ const (return ())+{-# SPECIALIZE INLINE getElems :: STVector s Double -> ST s [Double] #-}+{-# SPECIALIZE INLINE getElems :: STVector s (Complex Double) -> ST s [Complex Double] #-}++-- | Get the elements of the vector.+getElems' :: (RVector v, Storable e) => v e -> ST s [e]+getElems' v = let+    go end p' es | p' == end =+                     return es+                 | otherwise = do+                     e <- peek p'+                     go end (p' `advancePtr` (-1)) (e:es)+    in do+        n <- getDim v+        unsafeIOToST $+            unsafeWith v $ \p ->+                go (p `advancePtr` (-1)) (p `advancePtr` (n-1)) []+{-# SPECIALIZE INLINE getElems' :: STVector s Double -> ST s [Double] #-}+{-# SPECIALIZE INLINE getElems' :: STVector s (Complex Double) -> ST s [Complex Double] #-}++-- | Lazily get the association list of the vector.+getAssocs :: (RVector v, Storable e) => v e -> ST s [(Int,e)]+getAssocs x = liftM2 zip (getIndices x) (getElems x)+{-# INLINE getAssocs #-}++-- | Get the association list of the vector.+getAssocs' :: (RVector v, Storable e) => v e -> ST s [(Int,e)]+getAssocs' x = liftM2 zip (getIndices x) (getElems' x)+{-# INLINE getAssocs' #-}++-- | Set all of the values of the vector from the elements in the list.+setElems  :: (Storable e) => STVector s e -> [e] -> ST s ()+setElems x es = let+    go n [] i _ | i < n = error $ +                    printf ("setElems <vector with dim %d>"+                            ++ " <list with length %d>:"+                            ++ " not enough elements") n i+    go n (_:_) i _ | i == n = error $ +                    printf ("setElems <vector with dim %d>"+                            ++ " <list with length at least %d>:"+                            ++ " too many elements") n (i+1)+    go _ []     _ _ = return ()+    go n (f:fs) i p = do+        poke p f+        go n fs (i+1) (p `advancePtr` 1)+    +    in do+        n <- getDim x+        unsafeIOToST $ unsafeWith x $ go n es 0++-- | Set the given values in the vector.  If an index is repeated twice,+-- the value is implementation-defined.+setAssocs :: (Storable e) => STVector s e -> [(Int,e)] -> ST s ()+setAssocs x ies =+    let go n p ((i,e):ies') = do+            when (i < 0 || i >= n) $ error $+                printf ("setAssocs <vector with dim %d>"+                        ++ " [ ..., (%d,_), ... ]: invalid index") n i+            pokeElemOff p i e+            go n p ies'+        go _ _ [] = return ()+    in do+        n <- getDim x+        unsafeIOToST $ unsafeWith x $ \p -> go n p ies++unsafeSetAssocs :: (Storable e) => STVector s e -> [(Int,e)] -> ST s ()+unsafeSetAssocs x ies =+    let go p ((i,e):ies') = do+            pokeElemOff p i e+            go p ies'+        go _ [] = return ()+    in unsafeIOToST $ unsafeWith x $ \p -> go p ies++-- | Get the element stored at the given index.+read :: (RVector v, Storable e) => v e -> Int -> ST s e+read x i = do+    n <- getDim x+    when (i < 0 || i >= n) $ error $+        printf ("read <vector with dim %d> %d:"+                ++ " invalid index") n i+    unsafeRead x i+{-# SPECIALIZE INLINE read :: STVector s Double -> Int -> ST s (Double) #-}+{-# SPECIALIZE INLINE read :: STVector s (Complex Double) -> Int -> ST s (Complex Double) #-}++-- | Same as 'read' but does not range check the index.+unsafeRead :: (RVector v, Storable e) => v e -> Int -> ST s e+unsafeRead x i =+    unsafeIOToST $ unsafeWith x $ \p -> peekElemOff p i+{-# SPECIALIZE INLINE unsafeRead :: STVector s Double -> Int -> ST s (Double) #-}+{-# SPECIALIZE INLINE unsafeRead :: STVector s (Complex Double) -> Int -> ST s (Complex Double) #-}++-- | Set the element stored at the given index.+write :: (Storable e) => STVector s e -> Int -> e -> ST s ()+write x i e = do+    n <- getDim x+    when (i < 0 || i >= n) $ error $+        printf ("write <vector with dim %d> %d:"+                ++ " invalid index") n i+    unsafeWrite x i e+{-# SPECIALIZE INLINE write :: STVector s Double -> Int -> Double -> ST s () #-}+{-# SPECIALIZE INLINE write :: STVector s (Complex Double) -> Int -> Complex Double -> ST s () #-}++-- | Same as 'write' but does not range check the index.+unsafeWrite :: (Storable e) => STVector s e -> Int -> e -> ST s ()+unsafeWrite x i e =+    unsafeIOToST $ unsafeWith x $ \p -> pokeElemOff p i e+{-# SPECIALIZE INLINE unsafeWrite :: STVector s Double -> Int -> Double -> ST s () #-}+{-# SPECIALIZE INLINE unsafeWrite :: STVector s (Complex Double) -> Int -> Complex Double -> ST s () #-}++-- | Modify the element stored at the given index.+modify :: (Storable e) => STVector s e -> Int -> (e -> e) -> ST s ()+modify x i f = do+    n <- getDim x+    when (i < 0 || i >= n) $ error $+        printf ("modify <vector with dim %d> %d:"+                ++ " invalid index") n i+    unsafeModify x i f+{-# SPECIALIZE INLINE modify :: STVector s Double -> Int -> (Double -> Double) -> ST s () #-}+{-# SPECIALIZE INLINE modify :: STVector s (Complex Double) -> Int -> (Complex Double -> Complex Double) -> ST s () #-}++-- | Same as 'modify' but does not range check the index.+unsafeModify :: (Storable e) => STVector s e -> Int -> (e -> e) -> ST s ()+unsafeModify x i f =+    unsafeIOToST $ unsafeWith x $ \p -> do+        e <- peekElemOff p i+        pokeElemOff p i $ f e+{-# SPECIALIZE INLINE unsafeModify :: STVector s Double -> Int -> (Double -> Double) -> ST s () #-}+{-# SPECIALIZE INLINE unsafeModify :: STVector s (Complex Double) -> Int -> (Complex Double -> Complex Double) -> ST s () #-}++unsafeSwapElems :: (Storable e) => STVector s e -> Int -> Int -> ST s ()+unsafeSwapElems x i1 i2 = unsafeIOToST $ unsafeWith x $ \p ->+    let p1 = p `advancePtr` i1+        p2 = p `advancePtr` i2+    in do+        e1  <- peek p1+        e2  <- peek p2+        poke p2 e1+        poke p1 e2+{-# SPECIALIZE INLINE unsafeSwapElems :: STVector s Double -> Int -> Int -> ST s () #-}+{-# SPECIALIZE INLINE unsafeSwapElems :: STVector s (Complex Double) -> Int -> Int -> ST s () #-}++-- | @mapTo dst f src@ replaces @dst@ elementwise with @f(src)@.+mapTo :: (RVector v, Storable e, Storable f)+      => STVector s f+      -> (e -> f)+      -> v e+      -> ST s ()+mapTo dst f src = (checkOp2 "mapTo _" $ \z x -> unsafeMapTo z f x) dst src+{-# INLINE mapTo #-}++-- | Same as 'mapTo' but does not check dimensions.+unsafeMapTo :: (RVector v, Storable e, Storable f)+            => STVector s f+            -> (e -> f)+            -> v e+            -> ST s ()+unsafeMapTo dst f src =+    let go end pdst psrc+            | pdst == end =+                return ()+            | otherwise = do+                e <- peek psrc+                poke pdst (f e)+                go end (pdst `advancePtr` 1) (psrc `advancePtr` 1)+    in do+        ndst <- getDim dst+        unsafeIOToST $+           unsafeWith dst $ \pdst ->+           unsafeWith src $ \psrc -> +               go (pdst `advancePtr` ndst) pdst psrc+  where++{-# INLINE unsafeMapTo #-}++-- | @zipWithTo dst f x y@ replaces @dst@ elementwise with @f(x,y)@.+zipWithTo :: (RVector v1, RVector v2, Storable e1, Storable e2, Storable f)+          => STVector s f+          -> (e1 -> e2 -> f)+          -> v1 e1+          -> v2 e2+          -> ST s ()+zipWithTo dst f x y = +    (checkOp3 "zipWithTo _" $ \dst1 x1 y1 -> unsafeZipWithTo dst1 f x1 y1)+        dst x y+{-# INLINE zipWithTo #-}++-- | Same as 'zipWithTo' but does not range-check dimensions.+unsafeZipWithTo :: (RVector v1, RVector v2, Storable e1, Storable e2, Storable f)+                => STVector s f+                -> (e1 -> e2 -> f)+                -> v1 e1+                -> v2 e2+                -> ST s ()+unsafeZipWithTo dst f src1 src2 =+    let go end pdst psrc1 psrc2 +            | pdst == end = +                return ()+            | otherwise = do+                e1 <- peek psrc1+                e2 <- peek psrc2+                poke pdst (f e1 e2)+                go end (pdst `advancePtr` 1) (psrc1 `advancePtr` 1)+                   (psrc2 `advancePtr` 1)+    in do+        ndst <- getDim dst+        unsafeIOToST $+           unsafeWith dst $ \pdst ->+           unsafeWith src1 $ \psrc1 ->+           unsafeWith src2 $ \psrc2 -> +               go (pdst `advancePtr` ndst) pdst psrc1 psrc2+{-# INLINE unsafeZipWithTo #-}+++-- | Set every element in the vector to a default value.  For+-- standard numeric types (including 'Double', 'Complex Double', and 'Int'),+-- the default value is '0'.+clear :: (Storable e) => STVector s e -> ST s ()+clear x = do+    n <- getDim x+    unsafeIOToST $ unsafeWith x $ \p -> clearArray p n++-- | @negateTo dst x@ replaces @dst@ with @negate(x)@.+negateTo :: (RVector v, VNum e) => STVector s e -> v e -> ST s ()+negateTo = checkOp2 "negateTo" $ \dst x -> +    call2 VMath.vNeg x dst+{-# INLINE negateTo #-}++-- | @absTo dst x@ replaces @dst@ with @abs(x)@.+absTo :: (RVector v, VNum e) => STVector s e -> v e -> ST s ()+absTo = checkOp2 "absTo" $ \dst x -> +    call2 VMath.vAbs x dst+{-# INLINE absTo #-}++-- | @signumTo dst x@ replaces @dst@ with @signum(x)@.+signumTo :: (RVector v, VNum e) => STVector s e -> v e -> ST s ()+signumTo = checkOp2 "signumTo" $ \dst x ->+    call2 VMath.vSgn x dst+{-# INLINE signumTo #-}+++-- | @conjugateTo dst x@ replaces @dst@ with @conjugate(x)@.+conjugateTo :: (RVector v, VNum e) => STVector s e -> v e -> ST s ()+conjugateTo = checkOp2 "conjugateTo" $ \dst x ->+    call2 VMath.vConj x dst+{-# INLINE conjugateTo #-}++-- | @addTo dst x y@ replaces @dst@ with @x+y@.+addTo :: (RVector v1, RVector v2, VNum e)+      =>  STVector s e -> v1 e -> v2 e -> ST s ()+addTo = checkOp3 "addTo" $ \dst x y -> call3 VMath.vAdd x y dst+{-# INLINE addTo #-}++-- | @subTo dst x y@ replaces @dst@ with @x-y@.+subTo :: (RVector v1, RVector v2, VNum e)+      => STVector s e -> v1 e -> v2 e -> ST s ()+subTo = checkOp3 "subTo" $ \dst x y -> call3 VMath.vSub x y dst+{-# INLINE subTo #-}++-- | @mulTo dst x y@ replaces @dst@ with @x*y@.+mulTo :: (RVector v1, RVector v2, VNum e)+      => STVector s e -> v1 e -> v2 e -> ST s ()+mulTo = checkOp3 "mulTo" $ \dst x y -> call3 VMath.vMul x y dst+{-# INLINE mulTo #-}+ +-- | @divTo dst x y@ replaces @dst@ with @x/y@.+divTo :: (RVector v1, RVector v2, VFractional e)+      => STVector s e -> v1 e -> v2 e -> ST s ()+divTo = checkOp3 "divTo" $ \dst x y -> call3 VMath.vDiv x y dst+{-# INLINE divTo #-}++-- | @recipTo dst x@ replaces @dst@ with @1/x@.+recipTo :: (RVector v, VFractional e)+        => STVector s e -> v e -> ST s ()+recipTo = checkOp2 "recipTo" $ \dst x -> call2 VMath.vInv x dst+{-# INLINE recipTo #-}++-- | @sqrtTo dst x@ replaces @dst@ with @sqrt(x)@.+sqrtTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+sqrtTo = checkOp2 "sqrtTo" $ \dst x -> call2 VMath.vSqrt x dst+{-# INLINE sqrtTo #-}++-- | @expTo dst x@ replaces @dst@ with @exp(x)@.+expTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+expTo = checkOp2 "expTo" $ \dst x -> call2 VMath.vExp x dst+{-# INLINE expTo #-}++-- | @logTo dst x@ replaces @dst@ with @log(x)@.+logTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+logTo = checkOp2 "logTo" $ \dst x -> call2 VMath.vLog x dst+{-# INLINE logTo #-}++-- | @powTo dst x y@ replaces @dst@ with @x ** y@.+powTo :: (RVector v1, RVector v2, VFloating e)+      => STVector s e -> v1 e -> v2 e -> ST s ()+powTo = checkOp3 "powTo" $ \dst x y -> call3 VMath.vPow x y dst+{-# INLINE powTo #-}++-- | @sinTo dst x@ replaces @dst@ with @sin(x)@.+sinTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+sinTo = checkOp2 "sinTo" $ \dst x -> call2 VMath.vSin x dst+{-# INLINE sinTo #-}++-- | @cosTo dst x@ replaces @dst@ with @cos(x)@.+cosTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+cosTo = checkOp2 "cosTo" $ \dst x -> call2 VMath.vCos x dst+{-# INLINE cosTo #-}++-- | @tanTo dst x@ replaces @dst@ with @tan(x)@.+tanTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+tanTo = checkOp2 "tanTo" $ \dst x -> call2 VMath.vTan x dst+{-# INLINE tanTo #-}++-- | @asinTo dst x@ replaces @dst@ with @asin(x)@.+asinTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+asinTo = checkOp2 "asinTo" $ \dst x -> call2 VMath.vASin x dst+{-# INLINE asinTo #-}++-- | @acosTo dst x@ replaces @dst@ with @acos(x)@.+acosTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+acosTo = checkOp2 "acosTo" $ \dst x -> call2 VMath.vACos x dst+{-# INLINE acosTo #-}++-- | @atanTo dst x@ replaces @dst@ with @atan(x)@.+atanTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+atanTo = checkOp2 "atanTo" $ \dst x -> call2 VMath.vATan x dst+{-# INLINE atanTo #-}++-- | @sinhTo dst x@ replaces @dst@ with @sinh(x)@.+sinhTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+sinhTo = checkOp2 "sinhTo" $ \dst x -> call2 VMath.vSinh x dst+{-# INLINE sinhTo #-}++-- | @coshTo dst x@ replaces @dst@ with @cosh(x)@.+coshTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+coshTo = checkOp2 "coshTo" $ \dst x -> call2 VMath.vCosh x dst+{-# INLINE coshTo #-}++-- | @tanhTo dst x@ replaces @dst@ with @tanh(x)@.+tanhTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+tanhTo = checkOp2 "tanhTo" $ \dst x -> call2 VMath.vTanh x dst+{-# INLINE tanhTo #-}++-- | @asinhTo dst x@ replaces @dst@ with @asinh(x)@.+asinhTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+asinhTo = checkOp2 "asinhTo" $ \dst x -> call2 VMath.vASinh x dst+{-# INLINE asinhTo #-}++-- | @acoshTo dst x@ replaces @dst@ with @acosh(x)@.+acoshTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+acoshTo = checkOp2 "acoshTo" $ \dst x -> call2 VMath.vACosh x dst+{-# INLINE acoshTo #-}++-- | @atanhTo dst x@ replaces @dst@ with @atanh(x)@.+atanhTo :: (RVector v, VFloating e) => STVector s e -> v e -> ST s ()+atanhTo = checkOp2 "atanhTo" $ \dst x -> call2 VMath.vATanh x dst+{-# INLINE atanhTo #-}+++-- | Gets the sum of the absolute values of the vector entries.+getSumAbs :: (RVector v, BLAS1 e) => v e -> ST s Double+getSumAbs = strideCall BLAS.asum+{-# INLINE getSumAbs #-}++-- | Gets the 2-norm of a vector.+getNorm2 :: (RVector v, BLAS1 e) => v e -> ST s Double+getNorm2 = strideCall BLAS.nrm2+{-# INLINE getNorm2 #-}++-- | Gets the index and norm of the element with maximum magnitude.  This is +-- undefined if any of the elements are @NaN@.  It will throw an exception if +-- the dimension of the vector is 0.+getWhichMaxAbs :: (RVector v, BLAS1 e) => v e -> ST s (Int, e)+getWhichMaxAbs x = do+    n <- getDim x+    when (n == 0) $ error $+        "getWhichMaxAbs <vector with dim 0>: empty vector"++    i <- strideCall BLAS.iamax x+    e <- unsafeRead x i+    return (i,e)+{-# INLINE getWhichMaxAbs #-}++-- | Computes the dot product of two vectors.+getDot :: (RVector v, RVector v', BLAS1 e)+       => v e -> v' e -> ST s e+getDot = checkOp2 "getDot" unsafeGetDot+{-# INLINE getDot #-}++-- | Same as 'getDot' but does not check dimensions.+unsafeGetDot :: (RVector x, RVector y, BLAS1 e)+             => x e -> y e -> ST s e+unsafeGetDot x y = (strideCall2 BLAS.dotc) y x+{-# INLINE unsafeGetDot #-}++-- | @scaleM k x@ sets @x := k * x@.+scaleM_ :: (Storable e, BLAS1 e) => e -> STVector s e -> ST s ()+scaleM_ k x = do+    n <- getDim x+    unsafeIOToST $+        unsafeWith x $ \px ->+            BLAS.scal n k px 1+{-# INLINE scaleM_ #-}++-- | @addWithScaleM_ alpha x y@ sets @y := alpha * x + y@.+addWithScaleM_ :: (RVector v, BLAS1 e) => e -> v e -> STVector s e -> ST s ()+addWithScaleM_ alpha x y =+    (checkOp2 "addWithScaleM_" $ \x1 y1 -> unsafeAddWithScaleM_ alpha x1 y1)+        x y+{-# INLINE addWithScaleM_ #-}++-- | Same as 'addWithScaleM_' but does not check dimensions.+unsafeAddWithScaleM_ :: (RVector v, BLAS1 e)+                     => e -> v e -> STVector s e -> ST s ()+unsafeAddWithScaleM_ alpha x y =+    (strideCall2 $ flip BLAS.axpy alpha) x y+{-# INLINE unsafeAddWithScaleM_ #-}++-- | @kroneckerTo dst x y@ sets @dst := x \otimes y@.+kroneckerTo :: (RVector v1, RVector v2, BLAS2 e)+            => STVector s e -> v1 e -> v2 e -> ST s ()+kroneckerTo dst x y = do+    m <- getDim x+    n <- getDim y+    dimdst <- getDim dst+    +    when (dimdst /= m * n) $ error $+        printf ("kroneckerTo"+                ++ " <vector with dim %d>"+                ++ " <vector with dim %d>"+                ++ " <vector with dim %d>:"+                ++ " dimension mismatch") dimdst m n ++    clear dst+    unsafeIOToST $+        unsafeWith dst $ \pdst ->+        unsafeWith x $ \px ->+        unsafeWith y $ \py ->+            BLAS.geru n m 1 py 1 px 1 pdst (max n 1)++call2 :: (RVector x, RVector y, Storable e, Storable f)+      => (Int -> Ptr e -> Ptr f -> IO a) +      -> x e -> y f -> ST s a+call2 f x y = do+    n <- getDim x+    unsafeIOToST $+        unsafeWith x $ \pX ->+        unsafeWith y $ \pY ->+            f n pX pY+{-# INLINE call2 #-}    ++call3 :: (RVector x, RVector y, RVector z, Storable e, Storable f, Storable g)+      => (Int -> Ptr e -> Ptr f -> Ptr g -> IO a) +      -> x e -> y f -> z g -> ST s a+call3 f x y z = do+    n <- getDim x+    unsafeIOToST $+        unsafeWith x $ \pX ->+        unsafeWith y $ \pY ->+        unsafeWith z $ \pZ ->           +            f n pX pY pZ+{-# INLINE call3 #-}   ++strideCall :: (RVector x, Storable e)+           => (Int -> Ptr e -> Int -> IO a) +           ->  x e -> ST s a+strideCall f x = do+    n <- getDim x+    unsafeIOToST $+        unsafeWith x $ \pX ->+            f n pX incX+  where+    incX = 1+{-# INLINE strideCall #-}++strideCall2 :: (RVector x, RVector y, Storable e, Storable f)+            => (Int -> Ptr e -> Int -> Ptr f -> Int -> IO a) +            -> x e -> y f -> ST s a+strideCall2 f x y = do+    n <- getDim x+    unsafeIOToST $+       unsafeWith x $ \pX ->+       unsafeWith y $ \pY ->+           f n pX incX pY incY+  where+    incX = 1+    incY = 1+{-# INLINE strideCall2 #-}    ++checkOp2 :: (RVector x, RVector y, Storable e, Storable f)+         => String+         -> (x e -> y f -> ST s a)+         -> x e+         -> y f+         -> ST s a+checkOp2 str f x y = do+    n1 <- getDim x+    n2 <- getDim y+    +    when (n1 /= n2) $ error $+        printf ("%s <vector with dim %d> <vector with dim %d>:"+                ++ " dimension mismatch") str n1 n2++    f x y+{-# INLINE checkOp2 #-}++checkOp3 :: (RVector x, RVector y, RVector z, Storable e, Storable f, Storable g)+         => String+         -> (x e -> y f -> z g -> ST s a)+         -> x e+         -> y f+         -> z g+         -> ST s a+checkOp3 str f x y z = do+    n1 <- getDim x+    n2 <- getDim y        +    n3 <- getDim z+    +    when (n1 /= n2 || n1 /= n3) $ error $+        printf ("%s <vector with dim %d> <vector with dim %d>"+                ++ " <vector with dim %d>:"+                ++ " dimension mismatch") str n1 n2 n3++    f x y z+{-# INLINE checkOp3 #-}+
+ lib/Numeric/LinearAlgebra/Vector/Statistics.hs view
@@ -0,0 +1,121 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Numeric.LinearAlgebra.Vector.Statistics+-- Copyright  : Copyright (c) 2010, Patrick Perry <patperry@gmail.com>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@gmail.com>+-- Stability  : experimental+--+-- Basic multivariate statistics.+--++module Numeric.LinearAlgebra.Vector.Statistics (+    -- * Immutable interface+    sum,+    mean,+    weightedSum,+    weightedMean,++    -- * Mutable interface+    addSumTo,+    meanTo,+    addWeightedSumTo,+    weightedMeanTo,++    ) where++import Prelude hiding ( sum )++import Control.Monad( forM_ )+import Control.Monad.ST( ST )++import Numeric.LinearAlgebra.Types++import Numeric.LinearAlgebra.Vector.Base( Vector )+import Numeric.LinearAlgebra.Vector.STBase( RVector, STVector )+import qualified Numeric.LinearAlgebra.Vector.STBase as V+++-- | Returns the sum of the vectors.  The first argument gives the dimension+-- of the vectors.+sum :: (BLAS1 e) => Int -> [Vector e] -> Vector e+sum p xs = V.create $ do+    s <- V.new_ p+    V.clear s+    addSumTo s xs+    return s++-- | Returns the mean of the vectors.  The first argument gives the dimension+-- of the vectors.+mean :: (BLAS1 e) => Int -> [Vector e] -> Vector e+mean p xs = V.create $ do+      m <- V.new_ p+      meanTo m xs+      return m++-- | Returns the weighted sum of the vectors.  The first argument gives the+-- dimension of the vectors.+weightedSum :: (BLAS1 e) => Int -> [(e, Vector e)] -> Vector e+weightedSum p wxs = V.create $ do+    s <- V.new_ p+    V.clear s+    addWeightedSumTo s wxs+    return s++-- | Returns the weighted mean of the vectors.  The first argument gives the+-- dimension of the vectors.+weightedMean :: (BLAS1 e)+             => Int -> [(Double, Vector e)] -> Vector e+weightedMean p wxs = V.create $ do+    m <- V.new_ p+    weightedMeanTo m wxs+    return m++-- | Adds the sum of the vectors to the target vector.+addSumTo :: (RVector v, BLAS1 e) => STVector s e -> [v e] -> ST s ()+addSumTo dst = addWeightedSumTo dst . zip (repeat 1)++-- | Sets the target vector to the mean of the vectors.+meanTo :: (RVector v, BLAS1 e)+       => STVector s e -> [v e] -> ST s()+meanTo dst = weightedMeanTo dst . zip (repeat 1)++-- | Adds the weigthed sum of the vectors to the target vector.+addWeightedSumTo :: (RVector v, BLAS1 e)+                 => STVector s e ->  [(e, v e)] -> ST s ()+addWeightedSumTo s wxs = do+    n <- V.getDim s+    err <- V.new n 0+    old_s <- V.new_ n+    diff <- V.new_ n+    val <- V.new_ n+    +    forM_ wxs $ \(w,x) -> do+        V.unsafeCopyTo old_s s -- old_s := s+        +        V.unsafeCopyTo val x   -- val := w * x+        V.scaleM_ w val++        V.addTo err err val    -- err := err + val+        V.addTo s s err        -- s := s + err+        +        V.subTo diff old_s s   -- diff := old_s - s+        V.addTo err diff val   -- err := diff + val++-- | Sets the target vector to the weighted mean of the vectors.+weightedMeanTo :: (RVector v, BLAS1 e)+               =>  STVector s e -> [(Double, v e)] -> ST s ()+weightedMeanTo m wxs = let+    go _ _ [] = return ()+    go diff w_sum ((w,x):wxs') | w == 0    = go diff w_sum wxs'+                               | otherwise = let w_sum' = w_sum + w+                                             in do+                                    V.subTo diff x m+                                    V.addWithScaleM_ +                                        (realToFrac $ w/w_sum') diff m+                                    go diff w_sum' wxs'+    in do+        n <- V.getDim m+        diff <- V.new_ n+        V.clear m+        go diff 0 wxs
+ lib/Test/QuickCheck/LinearAlgebra.hs view
@@ -0,0 +1,511 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.QuickCheck.LinearAlgebra+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+--+-- Test generators for linear algebra types.+--++module Test.QuickCheck.LinearAlgebra (+    -- Testable element types+    TestElem(..),+    +    -- * Generating random objects+    -- ** Dimensions+    dim,+    dim2,+    Dim(..),+    Dim2(..),+    +    -- ** Indices+    index,+    index2,    +    Index(..),+    Index2(..),     +    +    -- ** Elements+    elem,+    elems,+    -- realElem,+    -- realElems,+    +    -- ** Association lists+    assocs,+    assocs2,+    Assocs(..),    +    Assocs2(..),+    -- bandedAssocs,+    +    -- ** Vectors+    vector,+    VectorPair(..),+    VectorTriple(..),+    VectorList(..),+    WeightedVectorList(..),+    NonEmptyVectorList(..),+    NonEmptyWeightedVectorList(..),+    +    --  ** Matrices+    matrix,+    MatrixPair(..),+    MatrixTriple(..),+    -- hermMatrix,+    -- triMatrix,++    --  Banded matrices+    -- bandwidths,+    -- banded,+    -- bandedWith,+    -- hermBanded,+    -- triBanded,+    +    -- BandedAssocs(..),++    ) where++import Prelude hiding ( elem )++-- import BLAS.Types( UpLoEnum(..), DiagEnum(..) )+import Control.Monad+import Data.Complex( magnitude )+import Data.Maybe( fromJust )++import Test.QuickCheck hiding ( vector )+import qualified Test.QuickCheck as QC++import Numeric.LinearAlgebra.Types+import Numeric.LinearAlgebra.Vector( Vector )+import qualified Numeric.LinearAlgebra.Vector as V+import Numeric.LinearAlgebra.Matrix( Matrix )+import qualified Numeric.LinearAlgebra.Matrix as M+-- import Data.Matrix.Banded( Banded, maybeBandedFromMatrixStorage )+-- import Data.Matrix.Banded.ST( runSTBanded, unsafeThawBanded, +--     diagViewBanded )+++class TestElem e where+    maybeToReal :: e -> Maybe Double+    toReal :: e -> Double+    norm1 :: e -> Double+    norm :: e -> Double+    conjugate :: e -> e+    +    toReal = fromJust . maybeToReal+    +instance (TestElem Double) where+    maybeToReal = Just+    toReal = id+    norm1 = abs+    norm = abs+    conjugate = id+    +instance (TestElem (Complex Double)) where+    maybeToReal (x :+ y) | y == 0    = Just x+                         | otherwise = Nothing+    norm1 (x :+ y) = abs x + abs y+    norm z = magnitude z+    conjugate (x :+ y) = x :+ (-y)++{-+-- | Element types that can be tested with QuickCheck properties.+class (Storable e, Arbitrary e, CoArbitrary e) => TestElem e where+    -- | Inicates whether or not the value should be used in tests.  For+    -- 'Double's, @isTestElem e@ is defined as +    -- @not (isNaN e || isInfinite e || isDenormalized e)@.+    isTestElem :: e -> Bool++instance TestElem Double where+    isTestElem e = not (isNaN e || isInfinite e || isDenormalized e)+    {-# INLINE isTestElem #-}++instance TestElem (Complex Double) where+    isTestElem (x :+ y) = isTestElem x && isTestElem y+    {-# INLINE isTestElem #-}+-}++minit:: Int ->Int+minit  n=  n `mod` 20++-- | Generate a random element.+elem :: (Arbitrary e) => Gen e+elem = arbitrary++-- | Generate a list of elements suitable for testing with.+elems :: (Arbitrary e) => Int -> Gen [e]+elems n = replicateM n elem++-- Generate a random element that has no imaginary part.+-- realElem :: (TestElem e) => Gen e+-- realElem = liftM fromReal elem++-- Generate a list of elements for testing that have no imaginary part.+-- realElems :: (TestElem e) => Int -> Gen [e]+-- realElems n = replicateM n realElem++-- | Get an appropriate dimension for a random vector+dim :: Gen Int+dim = sized $ \s -> do+    (NonNegative n) <- resize (s `div` 4) $ arbitrary+    return (minit n)+ +-- | Get an appropriate dimension for a random matrix+dim2 :: Gen (Int,Int)+dim2 = sized $ \s -> do+    m <- resize (s `div` 2) $ dim+    n <- resize (s `div` 2) $ dim+    return (m,n)+ +-- | A vector dimension.   +newtype Dim = Dim Int+  deriving (Eq, Ord, Num, Integral, Real, Enum, Show, Read)++instance Arbitrary Dim where+    arbitrary = sized $ \s -> do+        (NonNegative n) <- resize (s `div` 4) $ arbitrary+        return $ Dim n+    +    shrink (Dim a) = +        [ Dim a' | (NonNegative a') <- shrink (NonNegative a) ]++-- | A matrix dimension.   +newtype Dim2 = Dim2 (Int,Int)+  deriving (Eq, Show, Read)++instance Arbitrary Dim2 where+    arbitrary = do+        mn <- dim2+        return $ Dim2 mn+++-- | Given a dimension generate a valid index.  The dimension must be positive.+index :: Int -> Gen Int+index n | n <= 0 = +            error $ "index " ++ (show n) ++ ":"+                  ++ " dimension must be positive (QuickCheck error)"+        | otherwise =+            choose (0,n-1)++-- | Given a matrix dimension generate a valid index.+index2 :: (Int,Int) -> Gen (Int,Int)+index2 (m,n) = do+    i <- index m+    j <- index n+    return (i,j)++-- | A dimension and a valid index for it.+data Index = Index Int Int deriving (Eq,Show)+instance Arbitrary Index where+    arbitrary = do+        n <- (1+) `fmap` dim+        i <- index n+        return $ Index n i++-- | A matrix dimension and a valid index for it.+data Index2 = Index2 (Int,Int) (Int,Int) deriving (Eq,Show)+instance Arbitrary Index2 where+    arbitrary = do+        (m',n') <- dim2+        let mn = (m' + 1, n' + 1)+        ij <- index2 mn+        return $ Index2 mn ij+    +    +-- | Generate an associations list for a vector of the given dimension.+assocs :: (Arbitrary e) => Int -> Gen [(Int,e)]+assocs n | n == 0    = return []+         | otherwise = do+    l <- choose(0, 2*n)+    is <- replicateM l $ index n+    es <- elems l+    return $ zip is es++-- | Generate an associations list for a matrix of the given shape.+assocs2 :: (Arbitrary e) => (Int,Int) -> Gen [((Int,Int),e)]+assocs2 (m,n) | m*n == 0  = return []+              | otherwise = do+    l <- choose(0, 2*m*n)+    is <- replicateM l $ index2 (m,n)+    es <- elems l+    return $ zip is es+++-- | A dimension and an associations list.+data Assocs e = Assocs Int [(Int,e)] deriving (Eq,Show)++instance (Arbitrary e) => Arbitrary (Assocs e) where+    arbitrary = do+        n   <- dim+        ies <- assocs n+        return $ Assocs n ies+    +    shrink (Assocs n ies) =+        [ Assocs n' $ filter ((< n') . fst) ies+        | n' <- shrink n+        ] +++        [ Assocs n ies'+        | ies' <- shrink ies+        ]++-- | A shape and an associations list.+data Assocs2 e = Assocs2 (Int,Int) [((Int,Int),e)] deriving (Eq,Show)+instance (Arbitrary e) => Arbitrary (Assocs2 e) where+    arbitrary = do+        mn   <- dim2+        ies  <- assocs2 mn+        return $ Assocs2 mn ies+++-- | Generate a random vector of the given size.+vector :: (Arbitrary e, Storable e) => Int -> Gen (Vector e)+vector n = do+    es <- elems n+    return $ V.fromList n es++instance (Arbitrary e, Storable e) => Arbitrary (Vector e) where+    arbitrary = dim >>= vector+    +    shrink x =+        [ V.slice 0 n x+        | (NonNegative n) <- shrink (NonNegative $ V.dim x)+        ]++-- | Two vectors with the same dimension.+data VectorPair e f = +    VectorPair (Vector e) (Vector f) deriving (Eq, Show)+instance (Arbitrary e, Storable e, Arbitrary f, Storable f) =>+    Arbitrary (VectorPair e f) where+        arbitrary = do+            x <- arbitrary+            y <- vector (V.dim x)+            return $ VectorPair x y+            +        shrink (VectorPair x y) =+            [ VectorPair (V.slice 0 n' x) (V.slice 0 n' y)+            | n' <- shrink (V.dim x)+            ]++-- | Three vectors with the same dimension.+data VectorTriple e f g =+    VectorTriple (Vector e) (Vector f) (Vector g) deriving (Eq, Show)+instance (Arbitrary e, Storable e, Arbitrary f, Storable f,+          Arbitrary g, Storable g) =>+    Arbitrary (VectorTriple e f g) where+        arbitrary = do+            x <- arbitrary+            y <- vector (V.dim x)+            z <- vector (V.dim x)+            return $ VectorTriple x y z++-- | A nonempty list of vectors with the same dimension.+data NonEmptyVectorList e = NonEmptyVectorList Int [Vector e] deriving (Eq, Show)+instance (Arbitrary e, Storable e) => Arbitrary (NonEmptyVectorList e) where+    arbitrary = do+        x <- arbitrary+        n <- choose (0,20)+        let p = V.dim x+        xs <- replicateM n $ vector p+        return $ NonEmptyVectorList p $ x:xs++-- | A nonempty list of (weight, vector) pairs, with the weights all non-negative+-- and the vectors all having the same dimension.+data NonEmptyWeightedVectorList e = NonEmptyWeightedVectorList Int [(e, Vector e)]+    deriving (Eq, Show)+instance (Arbitrary e, Storable e, Num e) => Arbitrary (NonEmptyWeightedVectorList e) where+    arbitrary = do+        (NonEmptyVectorList p xs) <- arbitrary+        ws <- replicateM (length xs) $ fmap abs arbitrary+        return $ NonEmptyWeightedVectorList p $ zip ws xs+        +-- | A list of vectors with the same dimension.+data VectorList e = VectorList Int [Vector e] deriving (Eq, Show)+instance (Arbitrary e, Storable e) => Arbitrary (VectorList e) where+    arbitrary = do+        (NonEmptyVectorList p (_:xs)) <- arbitrary+        return $ VectorList p xs++-- | A list of (weight, vector) pairs, with the weights all non-negative+-- and the vectors all having the same dimension.+data WeightedVectorList e = WeightedVectorList Int [(e, Vector e)]+    deriving (Eq, Show)+instance (Arbitrary e, Storable e, Num e) => Arbitrary (WeightedVectorList e) where+    arbitrary = do+        (NonEmptyWeightedVectorList p (_:wxs)) <- arbitrary+        return $ WeightedVectorList p wxs++-- | Generate a random matrix of the given size.+matrix :: (Arbitrary e, Storable e) => (Int,Int) -> Gen (Matrix e)+matrix (m,n) = +    oneof [ raw, sub ]+  where+    raw = do+        es <- elems $ m * n+        return $ M.fromList (m,n) es+    sub = do+        m' <- choose (m, 2*m)+        es <- elems $ m' * n+        return $ M.slice (0,0) (m,n) (M.fromList (m',n) es)++instance (Arbitrary e, Storable e) => Arbitrary (Matrix e) where+    arbitrary = dim2 >>= matrix+    +-- | Two matrices with the same dimension.+data MatrixPair e f = +    MatrixPair (Matrix e) (Matrix f) deriving (Eq, Show)+instance (Arbitrary e, Storable e, Arbitrary f, Storable f) =>+    Arbitrary (MatrixPair e f) where+        arbitrary = do+            x <- arbitrary+            y <- matrix (M.dim x)+            return $ MatrixPair x y++-- | Three matrices with the same dimension.+data MatrixTriple e f g =+    MatrixTriple (Matrix e) (Matrix f) (Matrix g) deriving (Eq, Show)+instance (Arbitrary e, Storable e, Arbitrary f, Storable f,+          Arbitrary g, Storable g) =>+    Arbitrary (MatrixTriple e f g) where+        arbitrary = do+            x <- arbitrary+            y <- matrix (M.dim x)+            z <- matrix (M.dim x)+            return $ MatrixTriple x y z++instance Arbitrary Trans where+    arbitrary = elements [ NoTrans, Trans, ConjTrans ]+{-++-- | Generate a triangular dense matrix.+triMatrix :: (TestElem e) => (Int,Int) -> Gen (Tri Matrix e)+triMatrix (m,n) = do+    a <- matrix (m,n)+    u <- QC.elements [ Lower, Upper  ]+    d <- QC.elements [ Unit, NonUnit ]+    return $ Tri u d a+    +-- | Generate a Hermitian dense matrix.+hermMatrix :: (TestElem e) => Int -> Gen (Herm Matrix e)+hermMatrix n = do+    a <- matrix (n,n)+    d <- realElems n+    let a' = runSTMatrix $ do+                 ma <- unsafeThawMatrix a+                 setElems (diagView ma 0) d+                 return ma+    u <- QC.elements [ Lower, Upper ]+    return $ Herm u a'++rawMatrix :: (TestElem e) => (Int,Int) -> Gen (Matrix e)+rawMatrix (m,n) = do+    es <- elems (m*n)+    return $ M.fromList (m,n) es+++subMatrix :: (TestElem e) => (Int,Int) -> Gen (SubMatrix e)+subMatrix (m,n) = +    oneof [ rawSubMatrix (m,n)+          , rawSubMatrix (n,m) >>= \(SubMatrix a (i,j) (m',n')) ->+                return $ SubMatrix (herm a) (j,i) (n',m')+          ]++rawSubMatrix :: (TestElem e) => (Int,Int) -> Gen (SubMatrix e)+rawSubMatrix (m,n) = do+    i <- choose (0,5)+    j <- choose (0,5)+    e <- choose (0,5)+    f <- choose (0,5)+    x <- rawMatrix (i+m+e, j+n+f)+    return $ SubMatrix x (i,j) (m,n)++instance (TestElem e) => Arbitrary (SubMatrix e) where+    arbitrary = do+        (m,n) <- shape+        (SubMatrix a ij mn) <- subMatrix (m,n)+        return $ SubMatrix a ij mn++-- | Generate valid bandwidth for a given matrix dimension size+bandwidth :: Int -> Gen Int+bandwidth n = if n == 0 then return 0 else choose (0,n-1)+    +-- | Generate valid bandwidths for the given matrix shape.+bandwidths :: (Int,Int) -> Gen (Int,Int)+bandwidths (m,n) = liftM2 (,) (bandwidth m) (bandwidth n)++-- | Generate a random banded matrix of the given shape.+banded :: (TestElem e) => (Int,Int) -> Gen (Banded e)+banded mn = do+    lu <- bandwidths mn+    bandedWith lu mn++-- | Generate a random banded matrix with the given bandwidths.+bandedWith :: (TestElem e) +           => (Int,Int) -> (Int,Int) -> Gen (Banded e)+bandedWith lu mn = frequency [ (3, rawBanded mn lu)  +                             , (2, hermedBanded mn lu)+                             ]++-- | Generate a triangular banded matrix.+triBanded :: (TestElem e) => Int -> Gen (Tri Banded e)+triBanded n = do+    a <- banded (n,n)+    u <- QC.elements [ Lower, Upper  ]+    d <- QC.elements [ Unit, NonUnit ]+    return $ Tri u d a+    +-- | Generate a Hermitian banded matrix.+hermBanded :: (TestElem e) => Int -> Gen (Herm Banded e)+hermBanded n = do+    a <- banded (n,n)+    d <- realElems n+    let a' = runSTBanded $ do+                 ma <- unsafeThawBanded a+                 setElems (diagViewBanded ma 0) d+                 return ma+    u <- QC.elements [ Lower, Upper ]+    return $ Herm u a'    ++rawBanded :: (TestElem e) => +    (Int,Int) -> (Int,Int) -> Gen (Banded e)+rawBanded (m,n) (kl,ku) = +    let bw = kl+ku+1+    in do+        a <- frequency [ (2, rawMatrix (bw,n))+                       , (1, rawSubMatrix (bw,n) >>= \(SubMatrix b ij _) ->+                                 return $ submatrix b ij (bw,n))     +                       ]+        return $ fromJust (maybeBandedFromMatrixStorage (m,n) (kl,ku) a)++hermedBanded :: (TestElem e) => +    (Int,Int) -> (Int,Int) -> Gen (Banded e)+hermedBanded (m,n) (kl,ku) = do+    x <- rawBanded (n,m) (ku,kl)+    return $ herm x++-- | Generate an associations list for a banded matrix of the given shape+-- and bandwidths.+bandedAssocs :: (TestElem e) => (Int,Int) -> (Int,Int) -> Gen [((Int,Int),e)]+bandedAssocs (m,n) (kl,ku) | m*n == 0  = return []+                           | otherwise = do+    (Nat l) <- arbitrary+    ijs     <- replicateM l $ index2 (kl+1+ku,n)+    let ijs' = mapMaybe (\(i,j) -> let i' = i - j - ku in+                                   if 0 <= i' && i' < m then Just (i',j)+                                                        else Nothing    ) ijs+    es      <- replicateM l elem+    return $ zip ijs' es+++-- | A shape, bandwidths, and an associations list.+data BandedAssocs e = BandedAssocs (Int,Int) (Int,Int) [((Int,Int),e)] deriving (Eq,Show)+instance (TestElem e) => Arbitrary (BandedAssocs e) where+    arbitrary = do+        mn  <- shape+        bw  <- bandwidths mn+        ies <- bandedAssocs mn bw+        return $ BandedAssocs mn bw ies+-}
+ linear-algebra-cblas.cabal view
@@ -0,0 +1,146 @@+name:            linear-algebra-cblas+version:         0.1+homepage:        http://github.com/cartazio/hs-cblas+synopsis:        A linear algebra library with bindings to BLAS and LAPACK+description:+    Note There are some known bugs in this code, do not use it in production!+    this package is meant mostly for easy cblas vs haskell benchmarks, not real use.+    .+    .+    The BLAS (Basic Linear Algebra Subprograms) are routines that provide+    standard building blocks for performing basic vector and matrix operations. +    The Level 1 BLAS perform scalar, vector and vector-vector operations, the +    Level 2 BLAS perform matrix-vector operations, and the Level 3 BLAS perform+    matrix-matrix operations. Because the BLAS are efficient, portable, and+    widely available, they are commonly used in the development of high quality+    linear algebra software, LAPACK for example.+    .+    For more information, see the Netlib BLAS webpage:+    <http://www.netlib.org/blas/> +    .+category:        Math+license:         BSD3+license-file:    COPYING+copyright:       (c) 2010. Patrick Perry <patperry@gmail.com>, Carter Schonwald <carter atsign wellposed dot com> 2012+author:          Patrick Perry, Carter Schonwald+maintainer:      Carter Schonwald <carter atsign wellposed dot com> +cabal-version:   >= 1.2.3+build-type:      Configure+tested-with:     GHC == 7.6.2++extra-source-files:     NEWS README TODO configure.ac configure+                        aclocal.m4 m4/ax_check_blas.m4+                        m4/ax_check_lapack.m4+                        linear-algebra.buildinfo.in cbits/config.h.in+                        tests/Makefile.in+                        +                        examples/LU.hs+                        +                                            +extra-tmp-files:        config.log config.status autom4te.cache+                        linear-algebra.buildinfo cbits/config.h+                        tests/Makefile++Library+    hs-source-dirs:     lib+    exposed-modules:    +                        Foreign.BLAS+                        Foreign.LAPACK+                        Foreign.VMath+                        +                        Numeric.LinearAlgebra++                        Numeric.LinearAlgebra.Matrix+                        Numeric.LinearAlgebra.Matrix.Cholesky+                        Numeric.LinearAlgebra.Matrix.Eigen+                        Numeric.LinearAlgebra.Matrix.Herm+                        Numeric.LinearAlgebra.Matrix.ST+                        Numeric.LinearAlgebra.Matrix.Statistics+                        Numeric.LinearAlgebra.Matrix.Tri++                        Numeric.LinearAlgebra.Packed                     +                        Numeric.LinearAlgebra.Packed.Cholesky                        +                        Numeric.LinearAlgebra.Packed.Herm+                        Numeric.LinearAlgebra.Packed.ST                   +                        Numeric.LinearAlgebra.Packed.Statistics+                        Numeric.LinearAlgebra.Packed.Tri++                        Numeric.LinearAlgebra.Vector+                        Numeric.LinearAlgebra.Vector.ST+                        Numeric.LinearAlgebra.Vector.Statistics+                        +                        Test.QuickCheck.LinearAlgebra+                        +    other-modules:      +                        Foreign.BLAS.Types+                        Foreign.BLAS.Level1+                        Foreign.BLAS.Level2+                        Foreign.BLAS.Level3+                        Foreign.BLAS.Double+                        Foreign.BLAS.Zomplex++                        Foreign.LAPACK.Types+                        Foreign.LAPACK.Double+                        Foreign.LAPACK.Zomplex+                        +                        Foreign.VMath.VNum+                        Foreign.VMath.VFractional+                        Foreign.VMath.VFloating+                        Foreign.VMath.Double+                        Foreign.VMath.Zomplex+                        +                        Numeric.LinearAlgebra.Types+                        Numeric.LinearAlgebra.Internal+                        Numeric.LinearAlgebra.Vector.Base+                        Numeric.LinearAlgebra.Vector.STBase                        +                        Numeric.LinearAlgebra.Matrix.Base+                        Numeric.LinearAlgebra.Matrix.STBase+                        Numeric.LinearAlgebra.Packed.Base+    +    includes:           cbits/config.h+                        cbits/f77_func-hsc.h+                        cbits/vmath.h+    include-dirs:       cbits++    c-sources:          cbits/vmath-double.c+                        cbits/vmath-zomplex.c+                        +    ghc-options:        -Wall -funbox-strict-fields +    +    extensions:         BangPatterns,+                        CPP,+                        DeriveDataTypeable,+                        FlexibleContexts,+                        FlexibleInstances,+                        GeneralizedNewtypeDeriving,+                        ForeignFunctionInterface, +                        Rank2Types+                         +    build-depends:      base >= 4 && < 5, ieee754, storable-complex,+                        vector >= 0.7, QuickCheck >= 2.1.1 && < 3++Executable test-hs-linear-algebra+    hs-source-dirs:     lib, tests+    main-is:            Main.hs+    other-modules:      Vector+                        STVector,+                        Matrix,+                        STMatrix,+                        Statistics,+                        Typed+                        Foreign.BLAS.Double+                        Foreign.BLAS.Zomplex+                        Foreign.LAPACK.Double+                        Foreign.LAPACK.Zomplex++    includes:           cbits/config.h+                        cbits/f77_func-hsc.h+                        cbits/vmath.h+    include-dirs:       cbits++    c-sources:          cbits/vmath-double.c+                        cbits/vmath-zomplex.c++    build-depends:      QuickCheck >= 2.1 && < 3,+                        test-framework >= 0.3.1,+                        test-framework-quickcheck2 >= 0.2.7
+ linear-algebra.buildinfo.in view
@@ -0,0 +1,7 @@++buildable: @BUILD_PACKAGE_BOOL@+ld-options: @LDFLAGS@ @LAPACK_LIBS@ @BLAS_LIBS@ @LIBS@++executable: test-hs-linear-algebra+buildable: @BUILD_PACKAGE_BOOL@+ld-options: @LDFLAGS@ @LAPACK_LIBS@ @BLAS_LIBS@ @LIBS@
+ m4/ax_check_blas.m4 view
@@ -0,0 +1,238 @@+# SYNOPSIS+#+#   AX_CHECK_BLAS([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])+#+# DESCRIPTION+#+#   This macro looks for a library that implements the BLAS linear-algebra+#   interface (see http://www.netlib.org/blas/). On success, it sets the+#   BLAS_LIBS output variable to hold the requisite library linkages.+#+#   To link with BLAS, you should link with:+#+#       $BLAS_LIBS $LIBS $FLIBS+#+#   in that order.+#+#   To call a BLAS function, use the F77_FUNC macro, defined in config.h+#+#   Many libraries are searched for, from ATLAS to CXML to ESSL. The user+#   may also use --with-blas=<lib> in order to use some specific BLAS+#   library <lib>.+#+#   ACTION-IF-FOUND is a list of shell commands to run if a BLAS library is+#   found, and ACTION-IF-NOT-FOUND is a list of commands to run it if it is+#   not found. If ACTION-IF-FOUND is not specified, the default action will+#   define HAVE_BLAS.+#+#   This macro requires autoconf 2.50 or later.+#+#   The macro is a modified version of ACX_BLAS, from the autoconf macro+#   archive.  The original macro depends on a Fortran compiler, and this+#   version does not.  This version has not been tested extensively, but+#   it is known to work with ATLAS and vecLib.+#+# LAST MODIFICATION+#+#   2009-10-8+#+# COPYLEFT+#+#   Copyright (c) 2009 Patrick O. Perry  <patperry@stanfordalumni.org>+#   Copyright (c) 2008 Steven G. Johnson <stevenj@alum.mit.edu>+#+#   This program is free software: you can redistribute it and/or modify it+#   under the terms of the GNU General Public License as published by the+#   Free Software Foundation, either version 3 of the License, or (at your+#   option) any later version.+#+#   This program is distributed in the hope that it will be useful, but+#   WITHOUT ANY WARRANTY; without even the implied warranty of+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General+#   Public License for more details.+#+#   You should have received a copy of the GNU General Public License along+#   with this program. If not, see <http://www.gnu.org/licenses/>.+#+#   As a special exception, the respective Autoconf Macro's copyright owner+#   gives unlimited permission to copy, distribute and modify the configure+#   scripts that are the output of Autoconf when processing the Macro. You+#   need not follow the terms of the GNU General Public License when using+#   or distributing such scripts, even though portions of the text of the+#   Macro appear in them. The GNU General Public License (GPL) does govern+#   all other use of the material that constitutes the Autoconf Macro.+#+#   This special exception to the GPL applies to versions of the Autoconf+#   Macro released by the Autoconf Macro Archive. When you make and+#   distribute a modified version of the Autoconf Macro, you may extend this+#   special exception to the GPL to apply to your modified version as well.++AC_DEFUN([AX_CHECK_BLAS], [+AC_PREREQ(2.50)+ax_blas_ok=no+ +AC_ARG_WITH([blas],+	[AC_HELP_STRING([--with-blas=<lib>], [use BLAS library <lib>])])+case $with_blas in+	yes | "") ;;+	no) ax_blas_ok=disable ;;+	-* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$with_blas" ;;+	*) BLAS_LIBS="-l$with_blas" ;;+esac++_AX_CHECK_BLAS([gemm_])+if test x$ax_blas_ok = xyes; then+  ax_blas_underscore=yes+else+  _AX_CHECK_BLAS([gemm])+  if test x$ax_blas_ok = xyes; then+    ax_blas_undersore=no+  fi+fi+AC_SUBST([BLAS_LIBS])++if test x$ax_blas_ok = xyes; then+  ifelse([$1],, [+    AC_DEFINE(HAVE_BLAS,1, [Define if you have a BLAS library.])+    AH_TEMPLATE([F77_FUNC], +                [Define to a macro mangling the given Fortan function name])+    if test x$ax_blas_underscore = xyes; then+      AC_DEFINE([F77_FUNC(name)], [name ## _])+    else+      AC_DEFINE([F77_FUNC(name)], [name])+    fi],+    [$1])+  :+else+  ax_blas_ok=no+  [$2]+fi++])dnl AX_CHECK_BLAS+++# _AX_CHECK_BLAS(GEMM)+# --------------------------------------------------------+# Look for a BLAS library in all of the standard places by checking for the +# functions s$GEMM and d$GEMM.  On success, define BLAS_LIBS, set+# ax_blas_ok to yes, and execute ACTION-IF-FOUND.  On failure, set ax_blas_ok+# to no and execute ACTION-IF-NOT-FOUND.+AC_DEFUN([_AX_CHECK_BLAS], [+AC_PREREQ([2.50])++m4_pushdef([sgemm],[[s$1]])+m4_pushdef([dgemm],[[d$1]])++ax_blas_save_LIBS="$LIBS"+LIBS="$LIBS $FLIBS"++# First, check BLAS_LIBS environment variable+if test x$ax_blas_ok = xno; then+  if test x$BLAS_LIBS != x; then+    save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"+    AC_MSG_CHECKING([for ]sgemm[ in $BLAS_LIBS])+    AC_TRY_LINK_FUNC(sgemm, [ax_blas_ok=yes], [BLAS_LIBS=""])+    AC_MSG_RESULT([$ax_blas_ok])+    LIBS="$save_LIBS"+  fi+fi++# BLAS linked to by default?  (happens on some supercomputers)+if test x$ax_blas_ok = xno; then+  save_LIBS="$LIBS"; LIBS="$LIBS"+  AC_CHECK_FUNC(sgemm, [ax_blas_ok=yes])+  LIBS="$save_LIBS"+fi++# BLAS in ATLAS library? (http://math-atlas.sourceforge.net/)+if test x$ax_blas_ok = xno; then+  AC_CHECK_LIB([atlas], [ATL_xerbla],+    [AC_CHECK_LIB([f77blas], sgemm,+       [AC_CHECK_LIB([cblas], [cblas_dgemm],+          [ax_blas_ok=yes+           BLAS_LIBS="-lcblas -lf77blas -latlas"],+          [],+          [-lf77blas -latlas])],+       [],+       [-latlas])])+fi++# BLAS in Intel MKL library?+if test x$ax_blas_ok = xno; then+  AC_CHECK_LIB([mkl], sgemm, [ax_blas_ok=yes;BLAS_LIBS="-lmkl"])+fi++# BLAS in Apple vecLib library?+if test x$ax_blas_ok = xno; then+  save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"+  unset ac_cv_func_[]sgemm+  AC_CHECK_FUNC(sgemm, [ax_blas_ok=yes;BLAS_LIBS="-lblas"])+  LIBS="$save_LIBS"+fi++# BLAS in PhiPACK libraries? (requires generic BLAS lib, too)+if test $ax_blas_ok = no; then+  AC_CHECK_LIB([blas], sgemm,+    [AC_CHECK_LIB([dgemm], dgemm,+      [AC_CHECK_LIB([sgemm], sgemm,+        [ax_blas_ok=yes; BLAS_LIBS="-lsgemm -ldgemm -lblas"],+        [],+        [-lblas])],+      [],+      [-lblas])])+fi++# BLAS in Alpha CXML library?+if test x$ax_blas_ok = xno; then+  AC_CHECK_LIB([cxml], sgemm, [ax_blas_ok=yes;BLAS_LIBS="-lcxml"])+fi+ +# BLAS in Alpha DXML library? (now called CXML, see above)+if test x$ax_blas_ok = xno; then+  AC_CHECK_LIB([dxml], sgemm, [ax_blas_ok=yes;BLAS_LIBS="-ldxml"])+fi+ +# BLAS in Sun Performance library?+if test x$ax_blas_ok = xno; then+  if test "x$GCC" != xyes; then # only works with Sun CC+    AC_CHECK_LIB([sunmath], [acosp],+      [AC_CHECK_LIB([sunperf], sgemm,+      [BLAS_LIBS="-xlic_lib=sunperf -lsunmath"+       ax_blas_ok=yes],+      [],+      [-lsunmath])])+  fi+fi+ +# BLAS in SCSL library?  (SGI/Cray Scientific Library)+if test x$ax_blas_ok = xno; then+  AC_CHECK_LIB([scs], sgemm, [ax_blas_ok=yes; BLAS_LIBS="-lscs"])+fi+ +# BLAS in SGIMATH library?+if test x$ax_blas_ok = xno; then+  AC_CHECK_LIB([complib.sgimath], sgemm,+    [ax_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"])+fi+ +# BLAS in IBM ESSL library? (requires generic BLAS lib, too)+if test x$ax_blas_ok = xno; then+  AC_CHECK_LIB([blas], sgemm,+    [AC_CHECK_LIB([essl], sgemm,+      [ax_blas_ok=yes; BLAS_LIBS="-lessl -lblas"],+      [],+      [-lblas $FLIBS])])+fi+ +# Generic BLAS library?+if test x$ax_blas_ok = xno; then+  AC_CHECK_LIB([blas], sgemm, [ax_blas_ok=yes; BLAS_LIBS="-lblas"])+fi+ +LIBS="$ax_blas_save_LIBS"++m4_popdef([sgemm])+m4_popdef([dgemm])++])dnl _AX_CHECK_BLAS+
+ m4/ax_check_lapack.m4 view
@@ -0,0 +1,131 @@+# SYNOPSIS+#+#   AX_CHECK_LAPACK([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])+#+# DESCRIPTION+#+#   This macro looks for a library that implements the LAPACK linear-algebra+#   interface (see http://www.netlib.org/lapack/). On success, it sets the+#   LAPACK_LIBS output variable to hold the requisite library linkages.+#+#   To link with LAPACK, you should link with:+#+#       $LAPACK_LIBS $BLAS_LIBS $LIBS+#+#   in that order. BLAS_LIBS is the output variable of the AX_BLAS macro,+#   called automatically. +#+#   The user may also use --with-lapack=<lib> in order to use some specific+#   LAPACK library <lib>.+#+#   ACTION-IF-FOUND is a list of shell commands to run if a LAPACK library+#   is found, and ACTION-IF-NOT-FOUND is a list of commands to run it if it+#   is not found. If ACTION-IF-FOUND is not specified, the default action+#   will define HAVE_LAPACK.+#+#   The macro is a modified version of ACX_LAPACK, from the autoconf macro+#   archive.  The original macro depends on a Fortran compiler, and this+#   version does not.  This version has not been tested extensively, but+#   it is known to work with ATLAS and vecLib.+#+# LAST MODIFICATION+#+#   2008-12-29+#+# COPYLEFT+#+#   Copyright (c) 2008 Patrick O. Perry  <patperry@stanfordalumni.org>+#   Copyright (c) 2008 Steven G. Johnson <stevenj@alum.mit.edu>+#+#   This program is free software: you can redistribute it and/or modify it+#   under the terms of the GNU General Public License as published by the+#   Free Software Foundation, either version 3 of the License, or (at your+#   option) any later version.+#+#   This program is distributed in the hope that it will be useful, but+#   WITHOUT ANY WARRANTY; without even the implied warranty of+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General+#   Public License for more details.+#+#   You should have received a copy of the GNU General Public License along+#   with this program. If not, see <http://www.gnu.org/licenses/>.+#+#   As a special exception, the respective Autoconf Macro's copyright owner+#   gives unlimited permission to copy, distribute and modify the configure+#   scripts that are the output of Autoconf when processing the Macro. You+#   need not follow the terms of the GNU General Public License when using+#   or distributing such scripts, even though portions of the text of the+#   Macro appear in them. The GNU General Public License (GPL) does govern+#   all other use of the material that constitutes the Autoconf Macro.+#+#   This special exception to the GPL applies to versions of the Autoconf+#   Macro released by the Autoconf Macro Archive. When you make and+#   distribute a modified version of the Autoconf Macro, you may extend this+#   special exception to the GPL to apply to your modified version as well.++AC_DEFUN([AX_CHECK_LAPACK], [+AC_REQUIRE([AX_CHECK_BLAS])+ax_lapack_ok=no++AC_ARG_WITH(lapack,+        [AC_HELP_STRING([--with-lapack=<lib>], [use LAPACK library <lib>])])+case $with_lapack in+        yes | "") ;;+        no) ax_lapack_ok=disable ;;+        -* | */* | *.a | *.so | *.so.* | *.o) LAPACK_LIBS="$with_lapack" ;;+        *) LAPACK_LIBS="-l$with_lapack" ;;+esac++# Get fortran linker name of LAPACK function to check for.+if test x"$ax_blas_underscore" = xyes; then+    cheev=cheev_+else+    cheev=cheev+fi++# We cannot use LAPACK if BLAS is not found+if test "x$ax_blas_ok" != xyes; then+        ax_lapack_ok=noblas+        LAPACK_LIBS=""+fi++# First, check LAPACK_LIBS environment variable+if test "x$LAPACK_LIBS" != x; then+        save_LIBS="$LIBS"; LIBS="$LAPACK_LIBS $BLAS_LIBS $LIBS"+        AC_MSG_CHECKING([for $cheev in $LAPACK_LIBS])+        AC_TRY_LINK_FUNC($cheev, [ax_lapack_ok=yes], [LAPACK_LIBS=""])+        AC_MSG_RESULT($ax_lapack_ok)+        LIBS="$save_LIBS"+        if test $ax_lapack_ok = no; then+                LAPACK_LIBS=""+        fi+fi++# LAPACK linked to by default?  (is sometimes included in BLAS lib)+if test $ax_lapack_ok = no; then+        save_LIBS="$LIBS"; LIBS="$LIBS $BLAS_LIBS"+        AC_CHECK_FUNC($cheev, [ax_lapack_ok=yes])+        LIBS="$save_LIBS"+fi++# Generic LAPACK library?+for lapack in lapack lapack_rs6k; do+        if test $ax_lapack_ok = no; then+                save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"+                AC_CHECK_LIB($lapack, $cheev,+                    [ax_lapack_ok=yes; LAPACK_LIBS="-l$lapack"], [], [])+                LIBS="$save_LIBS"+        fi+done++AC_SUBST(LAPACK_LIBS)++# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:+if test x"$ax_lapack_ok" = xyes; then+        ifelse([$1],,AC_DEFINE(HAVE_LAPACK,1,[Define if you have LAPACK library.]),[$1])+        :+else+        ax_lapack_ok=no+        $2+fi+])dnl AX_LAPACK
+ tests/Main.hs view
@@ -0,0 +1,19 @@++import Test.Framework+import Test.Framework.Providers.QuickCheck2++import Vector+import STVector+import Matrix+import STMatrix+import Statistics++main :: IO ()+main = defaultMain tests+  where+    tests = [ tests_Vector+            , tests_STVector+            , tests_Matrix+            , tests_STMatrix+            , tests_Statistics+            ]
+ tests/Makefile.in view
+ tests/Matrix.hs view
@@ -0,0 +1,433 @@+module Matrix (+    tests_Matrix+    ) where++import Control.Monad( replicateM, zipWithM_ )+import Data.AEq+import Data.List( transpose )+import Debug.Trace+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck hiding ( vector )+import qualified Test.QuickCheck as QC++import Numeric.LinearAlgebra+import qualified Numeric.LinearAlgebra.Matrix as M+import qualified Numeric.LinearAlgebra.Vector as V++import Test.QuickCheck.LinearAlgebra( TestElem(..), Dim2(..), Index2(..),+    Assocs2(..), MatrixPair(..) )+import qualified Test.QuickCheck.LinearAlgebra as Test++import Typed+++tests_Matrix = testGroup "Matrix"+    [ testPropertyI "dim . fromList" prop_dim_fromList+    , testPropertyI "at . fromList" prop_at_fromList+    , testPropertyI "fromCols" prop_fromCols    +    , testPropertyI "fromRows" prop_fromRows        +    , testPropertyI "constant" prop_constant+    , testPropertyI "indices" prop_indices+    , testPropertyI "elems" prop_elems+    , testPropertyI "assocs" prop_assocs+    , testPropertyI "update" prop_update+    , testPropertyI "accum" prop_accum+    , testPropertyI "map" prop_map+    , testPropertyI "zipWith" prop_zipWith+    , testPropertyI "col" prop_col+    , testPropertyI "cols" prop_cols+    , testPropertyD "row" prop_row+    , testPropertyD "rows" prop_rows+    , testPropertyI "diag" prop_diag+    , testPropertyI "slice" prop_slice+    , testPropertyI "splitRowsAt" prop_splitRowsAt+    , testPropertyI "splitColsAt" prop_splitColsAt+    , testPropertyI "viewVector" prop_viewVector+    , testPropertyDZ "shiftDiag" prop_shiftDiag prop_shiftDiag+    , testPropertyDZ "shiftDiagWithScale"+        prop_shiftDiagWithScale prop_shiftDiagWithScale+    , testPropertyDZ "add" prop_add prop_add+    , testPropertyDZ "sub" prop_sub prop_sub+    , testPropertyDZ "scale" prop_scale prop_scale+    , testPropertyDZ "scaleRows" prop_scaleRows prop_scaleRows+    , testPropertyDZ "scaleCols" prop_scaleCols prop_scaleCols+    , testPropertyDZ "negate" prop_negate prop_negate+    , testPropertyDZ "conjugate" prop_conjugate prop_conjugate+    , testPropertyDZ "trans" prop_trans prop_trans+    , testPropertyDZ "conjTrans" prop_conjTrans prop_conjTrans+    , testPropertyDZ "rank1Update" prop_rank1Update prop_rank1Update+    , testPropertyDZ "mulVector" prop_mulVector prop_mulVector+    , testPropertyDZ "mulVectorWithScale" prop_mulVectorWithScale prop_mulVectorWithScale+    , testPropertyDZ "addMulVectorWithScales" prop_addMulVectorWithScales prop_addMulVectorWithScales    +    , testPropertyDZ "mulMatrix" prop_mulMatrix prop_mulMatrix+    , testPropertyDZ "mulMatrixWithScale" prop_mulMatrixWithScale prop_mulMatrixWithScale+    , testPropertyDZ "addMulMatrixWithScales" prop_addMulMatrixWithScales prop_addMulMatrixWithScales    ++    ]++++------------------------- Matrix Construction ------------------------------++prop_dim_fromList t (Dim2 (m,n)) =+    forAll (QC.vector $ m*n) $ \es -> let+        a = typed t $ M.fromList (m,n) es+        in M.dim a == (m,n)+        +prop_at_fromList t (Dim2 (m,n)) =+    forAll (QC.vector $ m*n) $ \es -> let+        a = typed t $ M.fromList (m,n) es+        in and [ M.at a (i,j) === e+               | ((i,j),e) <- zip [ (i,j) | j <- [ 0..n-1 ], i <- [ 0..m-1 ] ]+                                  es+               ]++prop_fromCols t (Dim2 (m,n)) =+    forAll (replicateM n $ Test.vector m) $ \cs ->+        M.fromCols (m,n) cs === (typed t $ M.fromList (m,n) $+            concatMap V.elems cs)++prop_fromRows t (Dim2 (m,n)) =+    forAll (replicateM m $ Test.vector n) $ \rs ->+        M.fromRows (m,n) rs === (typed t $ M.fromList (m,n) $+            concat $ transpose $ map V.elems rs)++prop_constant t (Dim2 (m,n)) e =+    M.constant (m,n) e === M.fromList (m,n) (replicate (m*n) e)+  where+    _ = typed t [e]+++-------------------------- Accessing Matrices ------------------------------++prop_indices t x =+    M.indices x === [ (i,j) | j <- [ 0..n-1 ], i <- [ 0..m-1 ] ]+  where+    (m,n) = M.dim x+    _ = immutableMatrix x+    _ = typed t x++prop_elems t x =+    M.elems x === [ M.at x i | i <- M.indices x ]+  where+    _ = typed t x+    +prop_assocs t x =+    M.assocs x === zip (M.indices x) (M.elems x)+  where+    _ = typed t x+++------------------------- Incremental Updates ------------------------------+    +prop_update t (Assocs2 mn ies) =+    forAll (typed t `fmap` Test.matrix mn) $ \x -> let+        x' = M.update x ies+        is = M.indices x+        is1 = (fst . unzip) ies+        is0 = [ i | i <- is, i `notElem` is1 ]+        in and $+            [ M.at x' i `elem` [ e | (i',e) <- ies, i' == i ]+            | i <- is1+            ] +++            [ M.at x' i === M.at x i+            | i <- is0+            ]++prop_accum t (Blind f) (Assocs2 mn ies) =+    forAll (typed t `fmap` Test.matrix mn) $ \x -> let+        x' = M.accum f x ies+        in x' === M.fromList mn [ foldl f e [ e' | (i',e') <- ies, i' == i]+                                | (i,e) <- M.assocs x ]+  where+      _ = typed t $ (snd . unzip) ies++-------------------------- Derived Matrices ------------------------------+     +prop_map t (Blind f) x =+    M.map f x === M.fromList (M.dim x) (map f $ M.elems x)+  where+    _ = typed t x+    _ = typed t $ M.map f x++prop_zipWith t (Blind f) (MatrixPair x y) =+    M.zipWith f x y === (M.fromList (M.dim x) $+                                zipWith f (M.elems x) (M.elems y))+  where+    _ = typed t x+    _ = typed t y    +    _ = typed t $ M.zipWith f x y+     ++------------------------------ Matrix Views --------------------------------++prop_col t (Index2 (m,n) (_,j)) =+    forAll (typed t `fmap` Test.matrix (m,n)) $ \a ->+        M.col a j === V.fromList m [ M.at a (i,j) | i <- [ 0..m-1 ] ]++prop_cols t a =+    M.cols a === [ M.col a j | j <- [ 0..n-1 ] ]+  where+    (_,n) = M.dim a+    _ = typed t $ immutableMatrix a++prop_row t (Index2 (m,n) (i,_)) =+    forAll (typed t `fmap` Test.matrix (m,n)) $ \a ->+        M.row a i === V.fromList n [ M.at a (i,j) | j <- [ 0..n-1 ] ]++prop_rows t a =+    M.rows a === [ M.row a i | i <- [ 0..m-1 ] ]+  where+    (m,_) = M.dim a+    _ = typed t $ immutableMatrix a++prop_diag t a =+    M.diag a === V.fromList mn [ M.at a (i,i) | i <- [ 0..mn-1 ] ]+  where+    (m,n) = M.dim a+    mn = min m n+    _ = typed t $ immutableMatrix a++prop_slice t a =+    forAll (choose (0,m)) $ \m' ->+    forAll (choose (0,n)) $ \n' ->+    forAll (choose (0,m-m')) $ \i ->+    forAll (choose (0,n-n')) $ \j ->+        M.slice (i,j) (m',n') a+            === M.fromCols (m',n') [ V.slice i m' (M.col a j')+                                      | j' <- [ j..j+n'-1 ] ]+  where+    (m,n) = M.dim a+    _ = typed t a++prop_splitRowsAt t a =+    forAll (choose (0,m)) $ \i ->+        M.splitRowsAt i a+            === ( M.slice (0,0) (i,n) a+                , M.slice (i,0) (m-i,n) a+                )+  where+    (m,n) = M.dim a+    _  = typed t $ immutableMatrix a++prop_splitColsAt t a =+    forAll (choose (0,n)) $ \j ->+        M.splitColsAt j a+            === ( M.slice (0,0) (m,j) a+                , M.slice (0,j) (m,n-j) a+                )+  where+    (m,n) = M.dim a+    _  = typed t $ immutableMatrix a++prop_viewVector t (Dim2 (m,n)) =+    forAll (Test.vector $ m*n) $ \x -> let _ = typed t x in+        M.elems (M.fromVector (m,n) x) === V.elems x+++-------------------------- Num Matrix Operations --------------------------++prop_shiftDiag t a =+    forAll (Test.vector (min m n)) $ \d ->+        M.shiftDiag d a+            === M.accum (+) a [ ((i,i),e) | (i,e) <- V.assocs d ]+  where+    (m,n) = M.dim a+    _ = typed t a++prop_shiftDiagWithScale t k a =+    forAll (Test.vector (min m n)) $ \d ->+        M.shiftDiagWithScale k d a+            ~== M.accum (+) a [ ((i,i),k * e) | (i,e) <- V.assocs d ]+  where+    (m,n) = M.dim a+    _ = typed t a++prop_add t (MatrixPair x y) =+    x `M.add` y === M.zipWith (+) x y+  where+    _ = typed t x++prop_sub t (MatrixPair x y) =+    x `M.sub` y === M.zipWith (-) x y+  where+    _ = typed t x++prop_scale t k x =+    M.scale k x ~== M.map (k*) x+  where+    _ = typed t x++prop_scaleRows t a =+    forAll (Test.vector m) $ \s ->+        M.scaleRows s a+            ~== M.fromCols (m,n) [ V.mul s x | x <- M.cols a ]+  where+    (m,n) = M.dim a+    _ = typed t a++prop_scaleCols t a =+    forAll (Test.vector n) $ \s ->+        M.scaleCols s a+            ~== M.fromCols (m,n)+                    [ V.scale e x+                    | (e,x) <- zip (V.elems s) (M.cols a) ]+  where+    (m,n) = M.dim a+    _ = typed t a+    +prop_negate t x =+    M.negate x === M.map negate x+  where+    _ = typed t x++prop_conjugate t x =+    M.conjugate x === M.map conjugate x+  where+    _ = typed t x+++-------------------------- Linear Algebra --------------------------++prop_trans t a =+    M.trans a+        ===+        M.update (M.zero (swap $ M.dim a)) [ (swap ij, e) | (ij,e) <- M.assocs a ]+  where+    swap (i,j) = (j,i)+    _ = typed t a+    +prop_conjTrans t a =+    M.conjTrans a === M.conjugate (M.trans a)+  where+    _ = typed t a++prop_rank1Update t alpha a =+    forAll (Test.vector m) $ \x ->+    forAll (Test.vector n) $ \y -> let y' = V.conjugate y in+        M.rank1Update alpha x y a+            ~==+            M.update (M.zero (m,n))+                     [ ((i,j), alpha * V.at x i * V.at y' j + e)+                     | ((i,j),e) <- M.assocs a+                     ]+  where+    (m,n)= M.dim a+    _ = typed t a++data MulMatrixAddVector e =+    MulMatrixAddVector Trans (Matrix e) (Vector e) (Vector e) deriving (Show)+    +instance (Storable e, Arbitrary e) => Arbitrary (MulMatrixAddVector e) where+    arbitrary = do+        transa <- arbitrary+        a <- arbitrary+        let (ma,na) = M.dim a+            (m,n) = case transa of NoTrans -> (ma,na)+                                   _       -> (na,ma)+        x <- Test.vector n+        y <- Test.vector m+        return $ MulMatrixAddVector transa a x y+        +data MulMatrixVector e =+    MulMatrixVector Trans (Matrix e) (Vector e) deriving (Show)+instance (Storable e, Arbitrary e) => Arbitrary (MulMatrixVector e) where+    arbitrary = do+        (MulMatrixAddVector transa a x _) <- arbitrary+        return $ MulMatrixVector transa a x+        +prop_mulVector t (MulMatrixVector transa a x) =+    M.mulVector transa a x+        ~==+        case transa of+            NoTrans   -> V.fromList (fst $ M.dim a)+                                    [ V.dot x (V.conjugate r)+                                    | r <- M.rows a ]++            Trans     -> V.fromList (snd $ M.dim a)+                                    [ V.dot x (V.conjugate c)+                                    | c <- M.cols a ]+                                    +            ConjTrans -> V.fromList (snd $ M.dim a)+                                    [ V.dot x c+                                    | c <- M.cols a ]+  where+    _ = typed t a++prop_mulVectorWithScale t alpha (MulMatrixVector transa a x) =+    M.mulVectorWithScale alpha transa a x+        ~==+        M.mulVector transa a (V.scale alpha x)+  where+    _ = typed t a++prop_addMulVectorWithScales t alpha beta (MulMatrixAddVector transa a x y) =+    M.addMulVectorWithScales alpha transa a x beta y+        ~==+        V.add (M.mulVectorWithScale alpha transa a x)+              (V.scale beta y)+  where+    _ = typed t a++data MulMatrixAddMatrix e =+    MulMatrixAddMatrix Trans (Matrix e) Trans (Matrix e) (Matrix e) deriving (Show)+    +instance (Storable e, Arbitrary e) => Arbitrary (MulMatrixAddMatrix e) where+    arbitrary = do+        transa <- arbitrary+        transb <- arbitrary+        c <- arbitrary+        k <- fst `fmap` Test.dim2+        +        let (m,n) = M.dim c+            (ma,na) = case transa of NoTrans -> (m,k)+                                     _       -> (k,m)+            (mb,nb) = case transb of NoTrans -> (k,n)+                                     _       -> (n,k)+        a <- Test.matrix (ma,na)+        b <- Test.matrix (mb,nb)+        +        return $ MulMatrixAddMatrix transa a transb b c++data MulMatrixMatrix e =+    MulMatrixMatrix Trans (Matrix e) Trans (Matrix e) deriving (Show)+instance (Storable e, Arbitrary e) => Arbitrary (MulMatrixMatrix e) where+    arbitrary = do+        (MulMatrixAddMatrix transa a transb b _) <- arbitrary+        return $ MulMatrixMatrix transa a transb b++prop_mulMatrix t (MulMatrixMatrix transa a transb b) =+    M.mulMatrix transa a transb b+        ~==+        M.fromCols (m,n) [ M.mulVector transa a x | x <- M.cols b' ]+  where+    m = case transa of NoTrans -> (fst $ M.dim a)+                       _       -> (snd $ M.dim a)+    n = case transb of NoTrans -> (snd $ M.dim b)+                       _       -> (fst $ M.dim b)+    b' = case transb of NoTrans   -> b+                        Trans     -> M.trans b+                        ConjTrans -> M.conjTrans b+    _ = typed t a++prop_mulMatrixWithScale t alpha (MulMatrixMatrix transa a transb b) =+    M.mulMatrixWithScale alpha transa a transb b+        ~==+        M.scale alpha (M.mulMatrix transa a transb b)+  where+    _ = typed t a++prop_addMulMatrixWithScales t alpha beta (MulMatrixAddMatrix transa a transb b c) =+    M.addMulMatrixWithScales alpha transa a transb b beta c+        ~==+        M.add (M.scale alpha (M.mulMatrix transa a transb b))+              (M.scale beta c)+  where+    _ = typed t a++++testAEq a b =+    if a ~== b then True+               else trace ("expected: " ++ show b ++ "\nactual: " ++ show a) False
+ tests/STMatrix.hs view
@@ -0,0 +1,300 @@+{-# LANGUAGE NoMonomorphismRestriction, Rank2Types #-}+module STMatrix (+    tests_STMatrix,+    mutatesToMatrix,+    readOnlyMatrix,+    +    ) where++import Control.Monad+import Control.Monad.ST+import Data.AEq+import Data.Complex( magnitude )+import Debug.Trace+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck hiding ( vector )+import qualified Test.QuickCheck as QC++import Numeric.LinearAlgebra+import qualified Numeric.LinearAlgebra.Vector as V+import qualified Numeric.LinearAlgebra.Matrix as M++import Test.QuickCheck.LinearAlgebra( TestElem(..), Dim2(..), Index2(..),+    Assocs2(..), MatrixPair(..), MatrixTriple(..) )+import qualified Test.QuickCheck.LinearAlgebra as Test++import STVector( readOnlyVector )+import Typed+++tests_STMatrix = testGroup "STMatrix"+    [ testPropertyI "new_" prop_new_+    , testPropertyI "new" prop_new+    , testPropertyI "newCopy" prop_newCopy+    , testPropertyI "copyTo" prop_copyTo+    , testPropertyI "read" prop_read+    , testPropertyI "write" prop_write+    , testPropertyI "modify" prop_modify+    , testPropertyI "getElems" prop_getElems+    , testPropertyI "getElems'" prop_getElems'+    , testPropertyI "getAssocs" prop_getAssocs+    , testPropertyI "getAssocs'" prop_getAssocs'+    , testPropertyI "setElems" prop_setElems+    , testPropertyI "setAssocs" prop_setAssocs+    , testPropertyI "mapTo" prop_mapTo+    , testPropertyI "zipWithTo" prop_zipWithTo+    , testPropertyDZ "shiftDiagM_" prop_shiftDiagM_ prop_shiftDiagM_+    , testPropertyDZ "shiftDiagWithScaleToM_"+        prop_shiftDiagWithScaleM_ prop_shiftDiagWithScaleM_+    , testPropertyDZ "addTo" prop_addTo prop_addTo+    , testPropertyDZ "subTo" prop_subTo prop_subTo+    , testPropertyDZ "scaleM_" prop_scaleM_ prop_scaleM_+    , testPropertyDZ "addWithScaleM_" prop_addWithScaleM_ prop_addWithScaleM_+    , testPropertyDZ "scaleRowsM" prop_scaleRowsM_ prop_scaleRowsM_+    , testPropertyDZ "scaleColsM_" prop_scaleColsM_ prop_scaleColsM_+    , testPropertyDZ "negateTo" prop_negateTo prop_negateTo+    , testPropertyDZ "conjugateTo" prop_conjugateTo prop_conjugateTo+    , testPropertyDZ "swapRows" prop_swapRows prop_swapRows+    , testPropertyDZ "swapCols" prop_swapCols prop_swapCols+    ]+    +    +prop_new_ t (Dim2 n) = +    (M.dim $ typed t $ M.create $ M.new_ n) === n++prop_new t (Dim2 n) e = +    (M.create $ M.new n e) === (typed t $ M.constant n e)+    +prop_newCopy t x = +    (M.create $ M.newCopy x) === x+  where+    _ = typed t x+        +prop_copyTo t (MatrixPair x y) = runST $+    x `readOnlyMatrix` \mx ->+    y `mutatesToMatrix` x $ \my ->+        M.copyTo my mx+  where+    _ = typed t x++prop_read t (Index2 n i) =+    forAll (typed t `fmap` Test.matrix n) $ \x -> runST $+        x `readOnlyMatrix` \mx -> do+            e <- M.read mx i+            return $ e === M.at x i++prop_write t (Index2 n i) e =+    forAll (Test.matrix n) $ \x -> runST $+        x `mutatesToMatrix` (x `M.update` [(i,e)]) $ \mx -> do+            M.write mx i e+  where+    _ = e == t++prop_modify t (Index2 n i) (Blind f) =+    forAll (Test.matrix n) $ \x -> runST $+        x `mutatesToMatrix`+            (typed t $ x `M.update` [(i, f $ M.at x i)]) $ \mx ->+                M.modify mx i f++prop_getElems t x =+    forAll arbitrary $ \(Blind f) -> runST $+        x `mutatesToMatrix` (M.map f x) $ \mx -> do+            es <- M.getElems mx+            M.mapTo mx f mx+            return $ es === M.elems (M.map f x)+  where+    _ = typed t x++prop_getElems' t x =+    forAll arbitrary $ \(Blind f) -> runST $+        x `mutatesToMatrix` (M.map f x) $ \mx -> do+            es <- M.getElems' mx+            M.mapTo mx f mx+            return $ es === M.elems x+  where+    _ = typed t x++prop_getAssocs t x =+    forAll arbitrary $ \(Blind f) -> runST $+        x `mutatesToMatrix` (M.map f x) $ \mx -> do+            ies <- M.getAssocs mx+            M.mapTo mx f mx+            return $ ies === M.assocs (M.map f x)+  where+    _ = typed t x++prop_getAssocs' t x =+    forAll arbitrary $ \(Blind f) -> runST $+        x `mutatesToMatrix` (M.map f x) $ \mx -> do+            ies <- M.getAssocs' mx+            M.mapTo mx f mx+            return $ ies === M.assocs x+  where+    _ = typed t x++prop_setElems t x =+    forAll (QC.vector $ m*n) $ \es -> runST $+        x `mutatesToMatrix` (M.fromList (m,n) es) $ \mx ->+            M.setElems mx es+  where+    (m,n) = M.dim x+    _ = typed t x++prop_setAssocs t (Assocs2 mn ies) =+    forAll (Test.matrix mn) $ \x -> runST $+        x `mutatesToMatrix` (typed t $ M.update x ies) $ \mx ->+            M.setAssocs mx ies++prop_mapTo t (Blind f) = binaryProp t+    (\x -> M.map f x)+    (\dst mx -> M.mapTo dst f mx)++prop_zipWithTo t (Blind f) = ternaryProp t+    (\x y -> M.zipWith f x y)+    (\dst mx my -> M.zipWithTo dst f mx my)++prop_shiftDiagM_ t a =+    forAll (Test.vector (min m n)) $ \s -> runST $+        s `readOnlyVector` \ms ->+        a `mutatesToMatrix` (M.shiftDiag s a) $ \ma ->+            M.shiftDiagM_ ms ma+  where+    (m,n) = M.dim a+    _ = typed t a++prop_shiftDiagWithScaleM_ t e a =+    forAll (Test.vector (min m n)) $ \s -> runST $+        s `readOnlyVector` \ms ->+        a `mutatesToMatrix` (M.shiftDiagWithScale e s a) $ \ma ->+            M.shiftDiagWithScaleM_ e ms ma+  where+    (m,n) = M.dim a+    _ = typed t a++prop_addTo t = ternaryProp t M.add M.addTo++prop_subTo t = ternaryProp t M.sub M.subTo++prop_scaleM_ t e a = runST $+    a `mutatesToMatrix` (M.scale e a) $ \ma ->+        M.scaleM_ e ma+  where+    _ = typed t a++prop_addWithScaleM_ t alpha (MatrixPair x y) = runST $+    x `readOnlyMatrix` \mx ->+    y `mutatesToMatrix` (M.addWithScale alpha x y) $ \my ->+        M.addWithScaleM_ alpha mx my+  where+    _ = typed t x++prop_scaleRowsM_ t a =+    forAll (Test.vector m) $ \s -> runST $+        s `readOnlyVector` \ms ->+        a `mutatesToMatrix` (M.scaleRows s a) $ \ma ->+            M.scaleRowsM_ ms ma+  where+    (m,n) = M.dim a+    _ = typed t a++prop_scaleColsM_ t a =+    forAll (Test.vector n) $ \s -> runST $+        s `readOnlyVector` \ms ->+        a `mutatesToMatrix` (M.scaleCols s a) $ \ma ->+            M.scaleColsM_ ms ma+  where+    (m,n) = M.dim a+    _ = typed t a++prop_negateTo t = binaryProp t M.negate M.negateTo++prop_conjugateTo t = binaryProp t M.conjugate M.conjugateTo++prop_swapRows t =+    forAll arbitrary $ \(Index2 (m,n) (i1,_)) ->+    forAll (choose (0,m-1)) $ \i2 ->+    forAll (typed t `fmap` Test.matrix (m,n)) $ \a ->+        let a' = M.update a $ [ ((i2,j),e) | (j,e) <- V.assocs (M.row a i1)+                              ] +++                              [ ((i1,j),e) | (j,e) <- V.assocs (M.row a i2)+                              ]+        in runST $+            a `mutatesToMatrix` a' $ \ma ->+            M.swapRows ma i1 i2++prop_swapCols t =+    forAll arbitrary $ \(Index2 (m,n) (_,j1)) ->+    forAll (choose (0,n-1)) $ \j2 ->+    forAll (typed t `fmap` Test.matrix (m,n)) $ \a ->+        let a' = M.update a $ [ ((i,j2),e) | (i,e) <- V.assocs (M.col a j1)+                              ] +++                              [ ((i,j1),e) | (i,e) <- V.assocs (M.col a j2)+                              ]+        in runST $+            a `mutatesToMatrix` a' $ \ma ->+            M.swapCols ma j1 j2+++binaryProp :: (AEq e, Arbitrary e, Show e, Storable e, Testable a)+            => e+            -> (Matrix e -> Matrix e)+            -> (forall s . STMatrix s e -> STMatrix s e -> ST s a)+            -> Property+binaryProp t imm_f f = let+    prop1 t x = runST $+        x `mutatesToMatrix` (imm_f x) $ \mx -> f mx mx+      where _ = typed t x+    prop2 t (MatrixPair x y) = runST $ let _ = typed t x in+        x `readOnlyMatrix` \mx ->+        y `mutatesToMatrix` (imm_f x) $ \my -> f my mx+      where _ = typed t x+    in (    label "1" prop1+        .&. label "2" prop2+       )+    +ternaryProp :: (AEq e, Arbitrary e, Show e, Storable e, Testable a)+            => e+            -> (Matrix e -> Matrix e -> Matrix e)+            -> (forall s . STMatrix s e -> STMatrix s e -> STMatrix s e -> ST s a)+            -> Property+ternaryProp t imm_f f = let+    prop1 t x = runST $+        x `mutatesToMatrix` (imm_f x x) $ \mx -> f mx mx mx+      where _ = typed t x+    prop2a t (MatrixPair x y) = runST $+        x `readOnlyMatrix` \mx ->+        y `mutatesToMatrix` (imm_f x y) $ \my -> f my mx my+      where _ = typed t x+    prop2b t (MatrixPair x y) = runST $+        x `mutatesToMatrix` (imm_f x y) $ \mx ->+        y `readOnlyMatrix` \my -> f mx mx my+      where _ = typed t x        +    prop3 t (MatrixTriple x y z) = runST $+        x `readOnlyMatrix` \mx ->+        y `readOnlyMatrix` \my ->+        z `mutatesToMatrix` (imm_f x y) $ \mz -> f mz mx my+      where _ = typed t x+    in (    label "1" prop1+        .&. label "2a" prop2a+        .&. label "2b" prop2b+        .&. label "3" prop3+       )+++readOnlyMatrix :: (Storable e, AEq e, Testable prop, Show e)+               => Matrix e+               -> (STMatrix s e ->  ST s prop)+               -> ST s Property+readOnlyMatrix x = mutatesToMatrix x x++mutatesToMatrix :: (Storable e, AEq e, Testable prop, Show e)+                => Matrix e+                -> Matrix e+                -> (STMatrix s e -> ST s prop)+                -> ST s Property+mutatesToMatrix x x_new f = do+    mx <- M.newCopy x+    prop <- f mx+    x' <- M.freeze mx+    return $ prop .&. (x' === x_new)
+ tests/STVector.hs view
@@ -0,0 +1,312 @@+{-# LANGUAGE NoMonomorphismRestriction, Rank2Types #-}+module STVector (+    tests_STVector,+    mutatesToVector,+    readOnlyVector,+    ) where++import Control.Monad+import Control.Monad.ST+import Data.AEq+import Data.Complex( magnitude )+import Debug.Trace+import Foreign( Storable )+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck hiding ( vector )+import qualified Test.QuickCheck as QC++import Numeric.LinearAlgebra.Vector( Vector, STVector )+import qualified Numeric.LinearAlgebra.Vector as V++import Test.QuickCheck.LinearAlgebra( TestElem(..), Dim(..), Index(..),+    Assocs(..), VectorPair(..), VectorTriple(..) )+import qualified Test.QuickCheck.LinearAlgebra as Test+import Test.QuickCheck.Property(rejected)++import Typed+++--- this could be a bad idea ..+instance Testable () where+  property _ = property rejected+++tests_STVector = testGroup "STVector"+    [ testPropertyI "new_" prop_new_+    , testPropertyI "new" prop_new+    , testPropertyI "newCopy" prop_newCopy+    , testPropertyI "copyTo" prop_copyTo+    , testPropertyDZ "swap" prop_swap prop_swap+    , testPropertyI "read" prop_read+    , testPropertyI "write" prop_write+    , testPropertyI "modify" prop_modify+    , testPropertyI "getElems" prop_getElems+    , testPropertyI "getElems'" prop_getElems'+    , testPropertyI "getAssocs" prop_getAssocs+    , testPropertyI "getAssocs'" prop_getAssocs'+    , testPropertyI "setElems" prop_setElems+    , testPropertyI "setAssocs" prop_setAssocs+    , testPropertyI "mapTo" prop_mapTo+    , testPropertyI "zipWithTo" prop_zipWithTo+    , testPropertyDZ "getSumAbs" prop_getSumAbs prop_getSumAbs+    , testPropertyDZ "getNorm2" prop_getNorm2 prop_getNorm2+    , testPropertyDZ "getDot" prop_getDot prop_getDot+    , testPropertyDZ "kroneckerTo" prop_kroneckerTo prop_kroneckerTo+    , testPropertyDZ "addTo" prop_addTo prop_addTo+    , testPropertyDZ "subTo" prop_subTo prop_subTo+    , testPropertyDZ "mulTo" prop_mulTo prop_mulTo+    , testPropertyDZ "negateTo" prop_negateTo prop_negateTo+    , testPropertyDZ "conjugateTo" prop_conjugateTo prop_conjugateTo+    , testPropertyDZ "absTo" prop_absTo prop_absTo+    , testPropertyDZ "signumTo" prop_signumTo prop_signumTo+    , testPropertyDZ "divTo" prop_divTo prop_divTo+    , testPropertyDZ "recipTo" prop_recipTo prop_recipTo+    , testPropertyDZ "sqrtTo" prop_sqrtTo prop_sqrtTo+    , testPropertyDZ "expTo" prop_expTo prop_expTo+    , testPropertyDZ "logTo" prop_logTo prop_logTo+    , testPropertyDZ "powTo" prop_powTo prop_powTo+    , testPropertyDZ "sinTo" prop_sinTo prop_sinTo+    , testPropertyDZ "cosTo" prop_cosTo prop_cosTo+    , testPropertyDZ "tanTo" prop_tanTo prop_tanTo+    , testPropertyDZ "asinTo" prop_asinTo prop_asinTo+    , testPropertyDZ "acosTo" prop_acosTo prop_acosTo+    , testPropertyDZ "atanTo" prop_atanTo prop_atanTo+    , testPropertyDZ "sinhTo" prop_sinhTo prop_sinhTo+    , testPropertyDZ "coshTo" prop_coshTo prop_coshTo+    , testPropertyDZ "tanhTo" prop_tanhTo prop_tanhTo+    , testPropertyDZ "asinhTo" prop_asinhTo prop_asinhTo+    , testPropertyDZ "acoshTo" prop_acoshTo prop_acoshTo+    , testPropertyDZ "atanhTo" prop_atanhTo prop_atanhTo+    ]+    ++{-+  getSumAbs:++    Double: [Failed]+*** Failed! Falsifiable (after 34 tests and 1 shrink): +fromList [48.00809219086489,-28.969358622663314,63.04503159639685,5.714612973491514,-5.312024428882535,60.56484370204321,20.339282130713237,-25.609691263383986,11.776052643355653,-72.22738635520177]+LHS+(used seed -5655945031033394469)++    Complex Double: [Failed]+*** Failed! Falsifiable (after 46 tests): +fromList [(-126.63684010249744) :+ (-25.732604105949363),48.30271669448071 :+ (-39.257907001851365),(-742.581416038894) :+ (-40.94772884905545),(-21.033310146590043) :+ 11.040319311574454,(-32.47272728995846) :+ (-75.38889146104881),34.61215019691849 :+ 63.02796474654257,25.495435934718248 :+ 14.86496960897311,285.1569736733574 :+ 20.592531068434027,(-75.03887610996705) :+ 62.568157533798285,13.719037128011735 :+ 49.186886152517744,(-23.33031638959207) :+ (-41.802953657765805),46.325514491999364 :+ (-40.3054052139413),(-97.8445174356864) :+ 62.27686352261467,(-210.08994152230045) :+ 23.4837419831381,(-47.12015960420664) :+ 9.502863461401958]+LHS++    Double: [Failed]+*** Failed! Falsifiable (after 61 tests): +VectorPair (fromList [24.074823693680273,166.2322847046224,-2.8103216076602617,6.544349669641704,157.92295537758915,-52.792112116283036,-56.334929255514766,12.079209274206134,-51.61912866052746,163.39401573569245,-49.34434955256682,-17.020978906318945,116.41247221011058]) (fromList [91.62365332716433,-46.23902424675873,151.71325376854423,34.663441501788725,-2.5921683575991397,-48.720845208466315,51.34009695413845,41.16706632522662,-52.1781413047511,18.0562293933656,-198.82058422020668,-4.213635327473868,40.59717128981193])+LHS+LHS+(used seed -6941761855370166739)++    Complex Double: [OK, passed 100 tests]++-}    +    +prop_new_ t (Dim n) = +    (V.dim $ typed t $ V.create $ V.new_ n) === n++prop_new t (Dim n) e = +    (V.create $ V.new n e) === (typed t $ V.constant n e)+    +prop_newCopy t x = +    (V.create $ V.newCopy x) === x+  where+    _ = typed t x+        +prop_copyTo t (VectorPair x y) = runST $+    x `readOnlyVector` \mx ->+    y `mutatesToVector` x $ \my ->+        V.copyTo my mx+  where+    _ = typed t x++prop_swap t (VectorPair x y) = runST $+    x `mutatesToVector` y $ \mx ->+    y `mutatesToVector` x $ \my ->+        V.swap mx my+  where+    _ = typed t x+    +prop_read t (Index n i) =+    forAll (typed t `fmap` Test.vector n) $ \x -> runST $+        x `readOnlyVector` \mx -> do+            e <- V.read mx i+            return $ e === V.at x i++prop_write t (Index n i) e =+    forAll (Test.vector n) $ \x -> runST $+        x `mutatesToVector` (x `V.update` [(i,e)]) $ \mx -> do+            V.write mx i e+  where+    _ = e == t++prop_modify t (Index n i) (Blind f) =+    forAll (Test.vector n) $ \x -> runST $+        x `mutatesToVector`+            (typed t $ x `V.update` [(i, f $ V.at x i)]) $ \mx ->+                V.modify mx i f++prop_getElems t x =+    forAll arbitrary $ \(Blind f) -> runST $+        x `mutatesToVector` (V.map f x) $ \mx -> do+            es <- V.getElems mx+            V.mapTo mx f mx+            return $ es === V.elems (V.map f x)+  where+    _ = typed t x++prop_getElems' t x =+    forAll arbitrary $ \(Blind f) -> runST $+        x `mutatesToVector` (V.map f x) $ \mx -> do+            es <- V.getElems' mx+            V.mapTo mx f mx+            return $ es === V.elems x+  where+    _ = typed t x++prop_getAssocs t x =+    forAll arbitrary $ \(Blind f) -> runST $+        x `mutatesToVector` (V.map f x) $ \mx -> do+            ies <- V.getAssocs mx+            V.mapTo mx f mx+            return $ ies === V.assocs (V.map f x)+  where+    _ = typed t x++prop_getAssocs' t x =+    forAll arbitrary $ \(Blind f) -> runST $+        x `mutatesToVector` (V.map f x) $ \mx -> do+            ies <- V.getAssocs' mx+            V.mapTo mx f mx+            return $ ies === V.assocs x+  where+    _ = typed t x++prop_setElems t x =+    forAll (QC.vector n) $ \es -> runST $+        x `mutatesToVector` (V.fromList n es) $ \mx ->+            V.setElems mx es+  where+    n = V.dim x+    _ = typed t x++prop_setAssocs t (Assocs n ies) =+    forAll (Test.vector n) $ \x -> runST $+        x `mutatesToVector` (typed t $ V.update x ies) $ \mx ->+            V.setAssocs mx ies++prop_mapTo t (Blind f) = binaryProp t+    (\x -> V.map f x)+    (\dst mx -> V.mapTo dst f mx)++prop_zipWithTo t (Blind f) = ternaryProp t+    (\x y -> V.zipWith f x y)+    (\dst mx my -> V.zipWithTo dst f mx my)++prop_getSumAbs t x = runST $+    x `readOnlyVector` \mx -> do+        s <- V.getSumAbs mx+        return $ s === V.sumAbs x+  where+    _ = typed t x++prop_getNorm2 t x = runST $+    x `readOnlyVector` \mx -> do+        n <- V.getNorm2 mx+        return $ n === V.norm2 x+  where+    _ = typed t x++prop_getDot t (VectorPair x y) = runST $+    x `readOnlyVector` \mx ->+    y `readOnlyVector` \my -> do+        d <- V.getDot mx my+        return $ d === V.dot x y+  where+    _ = typed t x++prop_kroneckerTo t = sized $ \s -> resize (s `div` 2) $+    forAll arbitrary $ \x ->+    forAll arbitrary $ \y ->+    forAll (Test.vector $ V.dim x * V.dim y) $ \z -> runST $+        x `readOnlyVector` \mx ->+        y `readOnlyVector` \my ->+        z `mutatesToVector` (typed t $ V.kronecker x y) $ \mz ->+            V.kroneckerTo mz mx my++prop_addTo t = ternaryProp t V.add V.addTo+prop_subTo t = ternaryProp t V.sub V.subTo+prop_mulTo t = ternaryProp t V.mul V.mulTo+prop_negateTo t = binaryProp t V.negate V.negateTo+prop_conjugateTo t = binaryProp t V.conjugate V.conjugateTo+prop_absTo t = binaryProp t V.abs V.absTo+prop_signumTo t = binaryProp t V.signum V.signumTo++prop_divTo t = ternaryProp t V.div V.divTo+prop_recipTo t = binaryProp t V.recip V.recipTo++prop_sqrtTo t = binaryProp t V.sqrt V.sqrtTo+prop_expTo t = binaryProp t V.exp V.expTo+prop_logTo t = binaryProp t V.log V.logTo+prop_powTo t = ternaryProp t V.pow V.powTo+prop_sinTo t = binaryProp t V.sin V.sinTo+prop_cosTo t = binaryProp t V.cos V.cosTo+prop_tanTo t = binaryProp t V.tan V.tanTo+prop_asinTo t = binaryProp t V.asin V.asinTo+prop_acosTo t = binaryProp t V.acos V.acosTo+prop_atanTo t = binaryProp t V.atan V.atanTo+prop_sinhTo t = binaryProp t V.sinh V.sinhTo+prop_coshTo t = binaryProp t V.cosh V.coshTo+prop_tanhTo t = binaryProp t V.tanh V.tanhTo+prop_asinhTo t = binaryProp t V.asinh V.asinhTo+prop_acoshTo t = binaryProp t V.acosh V.acoshTo+prop_atanhTo t = binaryProp t V.atanh V.atanhTo+++binaryProp :: (AEq e, Arbitrary e, Show e, Storable e, Testable a)+            => e+            -> (Vector e -> Vector e)+            -> (forall s . STVector s e -> STVector s e -> ST s a)+            -> Property+binaryProp t imm_f f = let+    prop2 t (VectorPair x y) = runST $ let _ = typed t x in+        x `readOnlyVector` \mx ->+        y `mutatesToVector` (imm_f x) $ \my -> f my mx+      where _ = typed t x+    in label "" prop2+    +ternaryProp :: (AEq e, Arbitrary e, Show e, Storable e, Testable a)+            => e+            -> (Vector e -> Vector e -> Vector e)+            -> (forall s . STVector s e -> STVector s e -> STVector s e -> ST s a)+            -> Property+ternaryProp t imm_f f = let+    prop3 t (VectorTriple x y z) = runST $+        x `readOnlyVector` \mx ->+        y `readOnlyVector` \my ->+        z `mutatesToVector` (imm_f x y) $ \mz -> f mz mx my+      where _ = typed t x+    in label "" prop3+       +++readOnlyVector :: (Storable e, AEq e, Testable prop, Show e)+               => Vector e+               -> (STVector s e -> ST s prop)+               -> ST s Property+readOnlyVector x = mutatesToVector x x++mutatesToVector :: (Storable e, AEq e, Testable prop, Show e)+          => Vector e+          -> Vector e+          -> (STVector s e -> ST s prop)+          -> ST s Property+mutatesToVector x x_new f = do+    mx <- V.newCopy x+    prop <- f mx+    x' <- V.freeze mx+    return $ prop .&. (x' === x_new)
+ tests/Statistics.hs view
@@ -0,0 +1,209 @@+module Statistics (+    tests_Statistics+    ) where++import Control.Monad( replicateM )+import Data.AEq+import Data.List( foldl' )+import Debug.Trace+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck hiding ( vector )+import qualified Test.QuickCheck as QC++import Numeric.LinearAlgebra+import qualified Numeric.LinearAlgebra.Packed as P+import qualified Numeric.LinearAlgebra.Matrix as M+import qualified Numeric.LinearAlgebra.Vector as V++import Test.QuickCheck.LinearAlgebra( VectorList(..), WeightedVectorList(..) )+import qualified Test.QuickCheck.LinearAlgebra as Test++import Typed++testAEq actual expected =+    if actual ~== expected+        then True+        else trace ("expected: " ++ show expected ++ "\nactual: " ++ show actual)+                   False++++tests_Statistics = testGroup "Statistics"+    [ testPropertyD "sum" prop_sum+    , testPropertyD "weightedSum" prop_weightedSum+    , testPropertyD "mean" prop_mean+    , testPropertyD "weightedMean" prop_weightedMean+    , testPropertyD "weightedMean (equal weights)" prop_weightedMean_eqw+    , testPropertyD "Matrix cov" prop_Matrix_cov+    , testPropertyD "Matrix covWithMean" prop_Matrix_covWithMean+    , testPropertyD "Matrix weightedCov (equal weights)" prop_Matrix_weightedCov_eqw+    , testPropertyD "Matrix weightedCov" prop_Matrix_weightedCov+    , testPropertyD "Matrix weightedCovWithMean" prop_Matrix_weightedCovWithMean+    , testPropertyD "Packed cov" prop_Packed_cov+    , testPropertyD "Packed covWithMean" prop_Packed_covWithMean+    , testPropertyD "Packed weightedCov (equal weights)" prop_Packed_weightedCov_eqw+    , testPropertyD "Packed weightedCov" prop_Packed_weightedCov+    , testPropertyD "Packed weightedCovWithMean" prop_Packed_weightedCovWithMean+    ]+++prop_sum t (VectorList p xs) =+    V.sum p xs ~== foldl' V.add (V.constant p 0) xs+  where+    _ = typed t (head xs)++prop_weightedSum t (WeightedVectorList p wxs) =+    V.weightedSum p wxs+            ~== V.sum p (map (uncurry V.scale) wxs)+  where+    n = length wxs+    _ = typed t (snd $ head wxs)++prop_mean t (VectorList p xs) =+    V.mean p xs ~== V.scale (1/n) (V.sum p xs)+  where+    n = fromIntegral $ max (length xs) 1+    _ = typed t (head xs)++prop_weightedMean_eqw t (VectorList p xs) = let+    wxs = zip (repeat 1) xs+    in V.weightedMean p wxs ~== V.mean p xs+  where+    _ = typed t (head xs)+    +prop_weightedMean t (WeightedVectorList p wxs) = let+        w_sum = (sum . fst . unzip) wxs+        in V.weightedMean p wxs+            ~== if w_sum == 0 then V.constant p 0+                              else V.scale (1/w_sum) (V.weightedSum p wxs)+  where+    n = length wxs+    _ = typed t (snd $ head wxs)++prop_Matrix_cov t (VectorList p xs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        xbar = V.mean p xs+        ys = [ V.sub x xbar | x <- xs ]+        scale = case method of { UnbiasedCov -> 1/(n-1) ; MLCov -> 1/n }+        cov' = foldl' (flip $ \y -> M.rank1Update scale y y)+                      (M.constant (p,p) 0)+                      ys+        cov = M.cov p method xs++        in M.hermMulVector cov z ~== M.mulVector NoTrans cov' z+  where+    n = fromIntegral $ length xs+    _ = typed t $ head xs++prop_Matrix_covWithMean t (VectorList p xs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        xbar = V.mean p xs+        cov' = M.covWithMean xbar method xs+        cov = M.cov p method xs+        in M.hermMulVector cov z ~== M.hermMulVector cov' z+  where+    n = fromIntegral $ length xs+    _ = typed t $ head xs++prop_Matrix_weightedCov_eqw t (VectorList p xs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        wxs = zip (repeat 1) xs+        cov = M.weightedCov p method wxs+        cov' = M.cov p method xs+        in M.hermMulVector cov z ~== M.hermMulVector cov' z+  where+    n = fromIntegral $ length xs+    _ = typed t $ head xs++prop_Matrix_weightedCov t (WeightedVectorList p wxs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        (ws,xs) = unzip wxs+        +        w_sum = sum ws+        ws' = [ w / w_sum | w <- ws ]+        w2_sum = sum [ w*w | w <- ws' ]+        scale = case method of { UnbiasedCov -> 1/(1-w2_sum) ; MLCov -> 1 }++        xbar = V.weightedMean p wxs+        wys = [ (w, V.sub x xbar) | (w,x) <- zip ws' xs ]+        cov' = if w_sum == 0+                    then M.constant (p,p) 0+                    else foldl' (flip $ \(w,y) -> M.rank1Update (scale*w) y y)+                                (M.constant (p,p) 0)+                                wys++        cov = M.weightedCov p method wxs++        in M.hermMulVector cov z ~== M.mulVector NoTrans cov' z+  where+    n = fromIntegral $ length wxs+    _ = typed t $ snd $ head wxs++prop_Matrix_weightedCovWithMean t (WeightedVectorList p wxs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        xbar = V.weightedMean p wxs+        cov' = M.weightedCov p method wxs+        cov = M.weightedCovWithMean xbar method wxs+        in M.hermMulVector cov z ~== M.hermMulVector cov' z+  where+    n = fromIntegral $ length wxs+    _ = typed t $ snd $ head wxs++prop_Packed_cov t (VectorList p xs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        cov' = M.cov p method xs+        cov = P.cov p method xs+        in P.hermMulVector cov z ~== M.hermMulVector cov' z+  where+    n = fromIntegral $ length xs+    _ = typed t $ head xs++prop_Packed_covWithMean t (VectorList p xs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        xbar = V.mean p xs+        cov = P.covWithMean xbar method xs+        cov' = P.cov p method xs+        in P.hermMulVector cov z ~== P.hermMulVector cov' z+  where+    n = fromIntegral $ length xs+    _ = typed t $ head xs++prop_Packed_weightedCov_eqw t (VectorList p xs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        wxs = zip (repeat 1) xs+        cov = P.weightedCov p method wxs+        cov' = P.cov p method xs+        in P.hermMulVector cov z ~== P.hermMulVector cov' z+  where+    n = fromIntegral $ length xs+    _ = typed t $ head xs++prop_Packed_weightedCov t (WeightedVectorList p wxs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        cov' = M.weightedCov p method wxs+        cov = P.weightedCov p method wxs+        in P.hermMulVector cov z ~== M.hermMulVector cov' z+  where+    n = fromIntegral $ length wxs+    _ = typed t $ snd $ head wxs++prop_Packed_weightedCovWithMean t (WeightedVectorList p wxs) =+    forAll (Test.vector p) $ \z ->+    forAll (elements [ UnbiasedCov, MLCov ]) $ \method -> let+        xbar = V.weightedMean p wxs+        cov' = P.weightedCov p method wxs+        cov = P.weightedCovWithMean xbar method wxs+        in P.hermMulVector cov z ~== P.hermMulVector cov' z+  where+    n = fromIntegral $ length wxs+    _ = typed t $ snd $ head wxs
+ tests/Typed.hs view
@@ -0,0 +1,63 @@+module Typed(+    typed,+    +    testPropertyI,+    testPropertyD,+    testPropertyZ,+    testPropertyDZ,+    +    immutableVector,+    immutableMatrix,+    ) where+++import Data.Complex( Complex )+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck++import Numeric.LinearAlgebra.Vector( Vector )+import Numeric.LinearAlgebra.Matrix( Matrix )+        ++typed :: e -> a e -> a e+typed _ = id++immutableVector :: Vector e -> Vector e+immutableVector = id++immutableMatrix :: Matrix e -> Matrix e+immutableMatrix = id++testPropertyI :: (Testable a)+              => TestName+              -> (Int -> a)+              -> Test+testPropertyI str prop =+    testProperty str $ prop undefined++testPropertyDZ :: (Testable a, Testable b)+               => TestName+               -> (Double -> a)+               -> (Complex Double -> b)+               -> Test+testPropertyDZ str propd propz =+    testGroup str+        [ testProperty "Double" $ propd undefined+        , testProperty "Complex Double" $ propz undefined+        ]++testPropertyD :: (Testable a)+              => TestName+              -> (Double -> a)+              -> Test+testPropertyD str prop =+    testProperty str $ prop undefined++testPropertyZ :: (Testable a)+              => TestName+              -> (Complex Double -> a)+              -> Test+testPropertyZ str prop =+    testProperty str $ prop undefined+        
+ tests/Vector.hs view
@@ -0,0 +1,389 @@+module Vector (+    tests_Vector+    ) where++import Data.AEq+import Debug.Trace+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck hiding ( vector )+import qualified Test.QuickCheck as QC++import Numeric.LinearAlgebra.Vector( Vector )+import qualified Numeric.LinearAlgebra.Vector as V++import Test.QuickCheck.LinearAlgebra( TestElem(..), Dim(..), Assocs(..),+    VectorPair(..) )+import qualified Test.QuickCheck.LinearAlgebra as Test++import Typed+++tests_Vector = testGroup "Vector"+    [ testPropertyI "dim/fromList" prop_dim_fromList+    , testPropertyI "at/fromList" prop_at_fromList+    , testPropertyI "zero" prop_zero+    , testPropertyI "constant" prop_constant+    , testPropertyI "indices" prop_indices+    , testPropertyI "elems" prop_elems+    , testPropertyI "assocs" prop_assocs+    , testPropertyI "update" prop_update+    , testPropertyI "accum" prop_accum+    , testPropertyI "map" prop_map+    , testPropertyI "zipWith" prop_zipWith+    , testPropertyI "concat" prop_concat+    , testPropertyI "slice" prop_slice+    , testPropertyI "splitAt" prop_splitAt+    , testPropertyDZ "sumAbs" prop_sumAbs prop_sumAbs    +    , testPropertyDZ "norm2" prop_norm2 prop_norm2+    , testPropertyDZ "whichMaxAbs1" prop_whichMaxAbs1 prop_whichMaxAbs1+    , testPropertyDZ "whichMaxAbs2" prop_whichMaxAbs1 prop_whichMaxAbs2+    , testPropertyDZ "dot" prop_dot prop_dot+    , testPropertyDZ "kronecker" prop_kronecker prop_kronecker+    , testPropertyDZ "add" prop_add prop_add+    , testPropertyDZ "addWithScale" prop_addWithScale prop_addWithScale+    , testPropertyDZ "sub" prop_sub prop_sub+    , testPropertyDZ "scale" prop_scale prop_scale+    , testPropertyDZ "mul" prop_mul prop_mul+    , testPropertyDZ "negate" prop_negate prop_negate+    , testPropertyDZ "conjugate" prop_conjugate prop_conjugate+    , testPropertyDZ "abs" prop_abs prop_abs+    , testPropertyDZ "signum" prop_signum prop_signum+    , testPropertyDZ "div" prop_div prop_div+    , testPropertyDZ "recip" prop_recip prop_recip+    , testPropertyDZ "sqrt" prop_sqrt prop_sqrt+    , testPropertyDZ "exp" prop_exp prop_exp+    , testPropertyDZ "log" prop_log prop_log+    , testPropertyDZ "pow" prop_pow prop_pow+    , testPropertyDZ "sin" prop_sin prop_sin+    , testPropertyDZ "cos" prop_cos prop_cos+    , testPropertyDZ "tan" prop_tan prop_tan+    , testPropertyDZ "asin" prop_asin prop_asin    +    , testPropertyDZ "acos" prop_acos prop_acos    +    , testPropertyDZ "atan" prop_atan prop_atan    +    , testPropertyDZ "sinh" prop_sinh prop_sinh+    , testPropertyDZ "cosh" prop_cosh prop_cosh+    , testPropertyDZ "tanh" prop_tanh prop_tanh+    , testPropertyDZ "asinh" prop_asinh prop_asinh+    , testPropertyDZ "acosh" prop_acosh prop_acosh+    , testPropertyDZ "atanh" prop_atanh prop_atanh+    ]+++{-+abs and signum fail for complex doubles (NB, their ST Vector analogues dont!)++  abs:++    Double: [OK, passed 100 tests]++    Complex Double: [Failed]+*** Failed! Falsifiable (after 18 tests and 1 shrink): +fromList [(-6.7066276741258) :+ 6.89825617623592,(-11.603500174324518) :+ 62.02307490865834]+(used seed -7536870184029858963)++  signum:++    Double: [OK, passed 100 tests]++    Complex Double: [Failed]+*** Failed! Falsifiable (after 2 tests): +fromList [6.727193397617394 :+ 2.38960475296862]+(used seed -6373326149733724790)++-}++------------------------- Vector Construction ------------------------------++prop_dim_fromList t (Dim n) =+    forAll (QC.vector n) $ \es -> let+        x = typed t $ V.fromList n es+        in V.dim x == n+        +prop_at_fromList t (Dim n) =+    forAll (QC.vector n) $ \es -> let+        x = typed t $ V.fromList n es+        in and [ V.at x i === e | (i,e) <- zip [ 0..n-1 ] es ]++prop_zero t (Dim n) = let+    x = typed t $ V.zero n+    in x === V.fromList n (replicate n 0)++prop_constant t (Dim n) e =+    V.constant n e === V.fromList n (replicate n e)+  where+    _ = typed t [e]+++-------------------------- Accessing Vectors ------------------------------++prop_indices t x =+    V.indices x === [ 0..((V.dim x) - 1) ]+  where+    _ = immutableVector x+    _ = typed t x++prop_elems t x =+    V.elems x === [ V.at x i | i <- V.indices x ]+  where+    _ = typed t x+    +prop_assocs t x =+    V.assocs x === zip (V.indices x) (V.elems x)+  where+    _ = typed t x+++------------------------- Incremental Updates ------------------------------+    +prop_update t (Assocs n ies) =+    forAll (typed t `fmap` Test.vector n) $ \x -> let+        x' = V.update x ies+        is = V.indices x+        is1 = (fst . unzip) ies+        is0 = [ i | i <- is, i `notElem` is1 ]+        in and $+            [ V.at x' i `elem` [ e | (i',e) <- ies, i' == i ]+            | i <- is1+            ] +++            [ V.at x' i === V.at x i+            | i <- is0+            ]++prop_accum t (Blind f) (Assocs n ies) =+    forAll (typed t `fmap` Test.vector n) $ \x -> let+        x' = V.accum f x ies+        in x' === V.fromList n [ foldl f e [ e' | (i',e') <- ies, i' == i]+                               | (i,e) <- V.assocs x ]+  where+      _ = typed t $ (snd . unzip) ies+     +     +-------------------------- Derived Vectors ------------------------------+     +prop_map t (Blind f) x =+    V.map f x === V.fromList (V.dim x) (map f $ V.elems x)+  where+    _ = typed t x+    _ = typed t $ V.map f x++prop_zipWith t (Blind f) (VectorPair x y) =+    V.zipWith f x y === (V.fromList (V.dim x) $+                                zipWith f (V.elems x) (V.elems y))+  where+    _ = typed t x+    _ = typed t y    +    _ = typed t $ V.zipWith f x y++prop_concat t xs =+    V.elems (V.concat xs) === concatMap V.elems xs+  where+    _ = typed t $ head xs++------------------------------ Vector Views-- --------------------------------++prop_slice t x = +    forAll (choose (0,n)) $ \n' ->+    forAll (choose (0,n-n')) $ \o ->+        V.slice o n' x === V.fromList n' (take n' $ drop o $ es)+  where+    n  = V.dim x+    es = V.elems x+    _  = typed t x++prop_splitAt t x =+    forAll (choose (0,n)) $ \k ->+        V.splitAt k x === (V.fromList k $ take k es,+                           V.fromList (n-k) $ drop k es)+  where+    n  = V.dim x+    es = V.elems x+    _  = typed t x+    +++-------------------------- Num Vector Operations --------------------------++prop_add t (VectorPair x y) =+    x `V.add` y === V.zipWith (+) x y+  where+    _ = typed t x++prop_addWithScale t alpha (VectorPair x y) =+    V.addWithScale alpha x y ~== V.add (V.scale alpha x) y+  where+    _ = typed t x++prop_sub t (VectorPair x y) =+    x `V.sub` y === V.zipWith (-) x y+  where+    _ = typed t x++prop_scale t k x =+    V.scale k x ~== V.map (k*) x+  where+    _ = typed t x++prop_mul t (VectorPair x y) =+    x `V.mul` y === V.zipWith (*) x y+  where+    _ = typed t x++prop_negate t x =+    V.negate x === V.map negate x+  where+    _ = typed t x++prop_conjugate t x =+    V.conjugate x === V.map conjugate x+  where+    _ = typed t x++prop_abs t x =+    V.abs x === V.map abs x+  where+    _ = typed t x++prop_signum t x =+    V.signum x === V.map signum x+  where+    _ = typed t x+++---------------------- Fractional Vector Operations ------------------------++prop_div t (VectorPair x y) =+    x `V.div` y ~== V.zipWith (/) x y+  where+    _ = typed t x+    +prop_recip t x =+    V.recip x ~== V.map (1/) x+  where+    _ = typed t x+    ++---------------------- Floating Vector Operations ------------------------++prop_exp t x =+    V.exp x ~== V.map exp x+  where+    _ = typed t x++prop_sqrt t x =+    V.sqrt x ~== V.map sqrt x+  where+    _ = typed t x++prop_log t x =+    V.log x ~== V.map log x+  where+    _ = typed t x++prop_pow t (VectorPair x y) =+    x `V.pow` y ~== V.zipWith (**) x y+  where+    _ = typed t x++prop_sin t x =+    V.sin x ~== V.map sin x+  where+    _ = typed t x++prop_cos t x =+    V.cos x ~== V.map cos x+  where+    _ = typed t x++prop_tan t x =+    V.tan x ~== V.map tan x+  where+    _ = typed t x++prop_asin t x =+    -- trace (show (V.asin x) ++ "\n" ++ (show $ V.map asin x)) $    +    V.asin x ~== V.map asin x+  where+    _ = typed t x++prop_acos t x =+    V.acos x ~== V.map acos x+  where+    _ = typed t x++prop_atan t x =+    V.atan x ~== V.map atan x+  where+    _ = typed t x++prop_sinh t x =+    V.sinh x ~== V.map sinh x+  where+    _ = typed t x++prop_cosh t x =+    V.cosh x ~== V.map cosh x+  where+    _ = typed t x++prop_tanh t x =+    V.tanh x ~== V.map tanh x+  where+    _ = typed t x++prop_asinh t x =+    -- trace (show (V.asinh x) ++ "\n" ++ (show $ V.map asinh x)) $+    V.asinh x ~== V.map asinh x+  where+    _ = typed t x++prop_acosh t x =+    V.acosh x ~== V.map acosh x+  where+    _ = typed t x++prop_atanh t x =+    V.atanh x ~== V.map atanh x+  where+    _ = typed t x+++-------------------------- Vector Properties ---------------------------------++prop_sumAbs t x =+    V.sumAbs x ~== (sum $ map norm1 $ V.elems x)+  where+    _ = typed t x++prop_norm2 t x =+    V.norm2 x ~== (sqrt $ sum $ map (^^2) $ map norm $ V.elems x)+  where+    _ = typed t x++prop_whichMaxAbs1 t x =+    (V.dim x > 0) && all (not . isNaN) (map norm1 $ V.elems x) ==>+        V.at x i === e+  where+    (i,e) = V.whichMaxAbs x      +    _     = typed t x++prop_whichMaxAbs2 t x =+    (V.dim x > 0) && all (not . isNaN) (map norm1 $ V.elems x) ==>+        all (<= norm1 e) $ map norm1 (V.elems x)+  where+    (_,e) = V.whichMaxAbs x+    _     = typed t x++prop_dot t (VectorPair x y) =+    V.dot x y ~== sum (V.elems (x * conj y))+  where+    conj = V.conjugate+    (*)  = V.mul+    _    = typed t x++prop_kronecker t x y =+    x `V.kronecker` y ~==+        V.fromList (V.dim x * V.dim y)+                   [ e*f | e <- V.elems x, f <- V.elems y ]+  where+    _ = typed t x