packages feed

blas 0.6 → 0.7

raw patch · 166 files changed

+18828/−9680 lines, 166 filesdep +QuickCheckdep −permutationsetup-changed

Dependencies added: QuickCheck

Dependencies removed: permutation

Files

− BLAS/C.hs 
@@ -1,20 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : BLAS.C--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.C (-    module BLAS.C.Types,-    module BLAS.C.Level1,-    module BLAS.C.Level2,-    module BLAS.C.Level3,-    ) where-        -import BLAS.C.Types-import BLAS.C.Level1-import BLAS.C.Level2-import BLAS.C.Level3
− BLAS/C/Double.hs 
@@ -1,112 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.C.Double--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.C.Double -    where-        -import Foreign.Ptr ( Ptr )-import BLAS.C.Types------------------------------- Level 1 Routines ---------------------------------foreign import ccall unsafe "cblas.h cblas_ddot"-    ddot   :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO Double--foreign import ccall unsafe "cblas.h cblas_dnrm2"-    dnrm2  :: Int -> Ptr Double -> Int -> IO Double--foreign import ccall unsafe "cblas.h cblas_dasum"-    dasum  :: Int -> Ptr Double -> Int -> IO Double--foreign import ccall unsafe "cblas.h cblas_idamax"-    idamax :: Int -> Ptr Double -> Int -> IO Int--foreign import ccall unsafe "cblas.h cblas_dscal"-    dscal  :: Int -> Double -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dswap"-    dswap  :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dcopy"-    dcopy  :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_daxpy"-    daxpy  :: Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_drotg"-    drotg  :: Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()--foreign import ccall unsafe "cblas.h cblas_drot"-    drot :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Double -> IO ()--foreign import ccall unsafe "cblas.h cblas_drotmg"-    drotmg :: Ptr Double -> Ptr Double -> Ptr Double -> Double -> Ptr Double -> IO ()--foreign import ccall unsafe "cblas.h cblas_drotm"-    drotm :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> Ptr Double -> IO ()------------------------------- Level 2 Routines ---------------------------------foreign import ccall unsafe "cblas.h cblas_dgemv"-    dgemv :: CBLASOrder -> CBLASTrans -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dgbmv"-    dgbmv :: CBLASOrder -> CBLASTrans -> Int -> Int -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dtrmv"-    dtrmv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dtbmv"-    dtbmv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()-                 -foreign import ccall unsafe "cblas.h cblas_dtrsv"-    dtrsv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dtbsv"-    dtbsv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()-    -foreign import ccall unsafe "cblas.h cblas_dsymv"-    dsymv :: CBLASOrder -> CBLASUpLo -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()-    -foreign import ccall unsafe "cblas.h cblas_dsbmv"-    dsbmv :: CBLASOrder -> CBLASUpLo -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()-    -foreign import ccall unsafe "cblas.h cblas_dger"-    dger  :: CBLASOrder -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()-        -foreign import ccall unsafe "cblas.h cblas_dsyr"-    dsyr  :: CBLASOrder -> CBLASUpLo -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dsyr2"-    dsyr2 :: CBLASOrder -> CBLASUpLo -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()------------------------------- Level 3 Routines ---------------------------------foreign import ccall unsafe "cblas.h cblas_dgemm"-    dgemm  :: CBLASOrder -> CBLASTrans -> CBLASTrans -> Int -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dsymm"-    dsymm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dtrmm"-    dtrmm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dtrsm"-    dtrsm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_dsyrk"-    dsyrk  :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> Double -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()-           -foreign import ccall unsafe "cblas.h cblas_dsyr2k"           -    dsyr2k :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()-
− BLAS/C/Level1.hs 
@@ -1,151 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -fno-excess-precision #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.C.Level1--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.C.Level1-    where-     -import Prelude hiding ( div )--import Foreign ( Ptr, Storable, advancePtr, castPtr, peek, poke, with )-import Foreign.Storable.Complex ()-import Data.Complex--import BLAS.Elem.Base-import BLAS.C.Types-import BLAS.C.Double  -import BLAS.C.Zomplex-        -class (Elem a) => BLAS1 a where-    dotu  :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO a-    dotc  :: 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 () --    swap  :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    copy  :: Int -> Ptr a -> Int -> 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 ()--    -- | conjugate all elements of a vector-    conj  :: Int -> Ptr a -> Int -> IO ()--    -- | Replaces @y@ with @alpha (conj x) + y@-    acxpy :: Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()--    -- | Replaces @y@ with @x*y@.-    mul :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()--    -- | Replaces @y@ with @conj(x)*y@.-    cmul :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()--    -- | Replaces @y@ with @y/x@.-    div :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()--    -- | Replaces @y@ with @y/conj(x)@.-    cdiv :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()----instance BLAS1 Double where-    dotu  = ddot-    dotc  = ddot-    nrm2  = dnrm2-    asum  = dasum-    iamax = idamax-    swap  = dswap-    copy  = dcopy-    axpy  = daxpy-    scal  = dscal-    rotg  = drotg-    rot   = drot-    conj _ _ _ = return ()-    acxpy = daxpy-    mul n = dtbmv colMajor upper noTrans nonUnit n 0-    cmul  = mul-    div n = dtbsv colMajor upper noTrans nonUnit n 0-    cdiv = div--instance BLAS1 (Complex Double) where-    dotu n pX incX pY incY =-        with 0 $ \pDotu -> do-            zdotu_sub n pX incX pY incY pDotu-            peek pDotu--    dotc n pX incX pY incY =-        with 0 $ \pDotc -> do-            zdotc_sub n pX incX pY incY pDotc-            peek pDotc--    nrm2  = znrm2-    asum  = zasum-    iamax = izamax-    swap  = zswap-    copy  = zcopy-    -    axpy n alpha pX incX pY incY = -        with alpha $ \pAlpha ->-            zaxpy n pAlpha pX incX pY incY-    -    scal n alpha pX incX =-        with alpha $ \pAlpha ->-            zscal n pAlpha pX incX-            -    rotg  = zrotg--    rot = zdrot--    conj n pX incX =-        let pXI   = (castPtr pX) `advancePtr` 1-            alpha = -1-            incXI = 2 * incX-        in dscal n alpha pXI incXI-    -    acxpy n a pX incX pY incY =-        let pXR   = castPtr pX-            pYR   = castPtr pY-            pXI   = pXR `advancePtr` 1-            pYI   = pYR `advancePtr` 1-            incX' = 2 * incX-            incY' = 2 * incY-        in case a of-            (ra :+  0) -> do-                daxpy n ( ra) pXR incX' pYR incY'-                daxpy n (-ra) pXI incX' pYI incY'-            (0  :+ ia) -> do-                daxpy n ( ia) pXR incX' pYI incY'-                daxpy n ( ia) pXI incX' pYR incY'-            _ -> go n pX pY-        where-            go n' pX' pY'-                | n' `seq` pX' `seq` pY' `seq` False = undefined-                | n' <= 0 =-                    return ()-                | otherwise = do-                    x <- peek pX'-                    y <- peek pY'-                    poke pY' (a * (conjugate x) + y)-                    -                    let n''  = n' - 1-                        pX'' = pX' `advancePtr` incX-                        pY'' = pY' `advancePtr` incY-                        -                    go n'' pX'' pY''-        -    mul n  = ztbmv colMajor upper noTrans   nonUnit n 0-    cmul n = ztbmv colMajor upper conjTrans nonUnit n 0--    div n  = ztbsv colMajor upper noTrans   nonUnit n 0-    cdiv n = ztbsv colMajor upper conjTrans nonUnit n 0
− BLAS/C/Level2.hs 
@@ -1,82 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.C.Level2--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.C.Level2-    where-     -import Data.Complex -import Foreign ( Ptr, with )   --import BLAS.C.Types-import BLAS.C.Level1-import BLAS.C.Double -import BLAS.C.Zomplex-        -class (BLAS1 a) => BLAS2 a where-    gemv :: CBLASOrder -> CBLASTrans -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    gbmv :: CBLASOrder -> CBLASTrans -> Int -> Int -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    trmv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    tbmv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    trsv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    tbsv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    hemv :: CBLASOrder -> CBLASUpLo -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    hbmv :: CBLASOrder -> CBLASUpLo -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    geru :: CBLASOrder -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    gerc :: CBLASOrder -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    her  :: CBLASOrder -> CBLASUpLo -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    her2 :: CBLASOrder -> CBLASUpLo -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()--instance BLAS2 Double where-    gemv = dgemv-    gbmv = dgbmv-    trmv = dtrmv-    tbmv = dtbmv-    trsv = dtrsv-    tbsv = dtbsv-    hemv = dsymv-    hbmv = dsbmv-    geru = dger-    gerc = dger-    her  = dsyr-    her2 = dsyr2-    -instance BLAS2 (Complex Double) where-    gemv order transA m n alpha pA ldA pX incX beta pY incY =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zgemv order transA m n pAlpha pA ldA pX incX pBeta pY incY-    -    gbmv order transA m n kl ku alpha pA ldA pX incX beta pY incY =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zgbmv order transA m n kl ku pAlpha pA ldA pX incX pBeta pY incY--    trmv = ztrmv-    tbmv = ztbmv-    trsv = ztrsv-    tbsv = ztbsv -    -    hemv order uplo n alpha pA ldA pX incX beta pY incY =-        with alpha $ \pAlpha -> with beta $ \pBeta -> -            zhemv order uplo n pAlpha pA ldA pX incX pBeta pY incY-    -    hbmv order uplo n k alpha pA ldA pX incX beta pY incY =-        with alpha $ \pAlpha -> with beta $ \pBeta -> -            zhbmv order uplo n k pAlpha pA ldA pX incX pBeta pY incY--    geru order m n alpha pX incX pY incY pA ldA = -        with alpha $ \pAlpha -> zgeru order m n pAlpha pX incX pY incY pA ldA--    gerc order m n alpha pX incX pY incY pA ldA = -        with alpha $ \pAlpha -> zgerc order m n pAlpha pX incX pY incY pA ldA--    her order uplo n alpha pX incX pA ldA = -        with alpha $ \pAlpha -> zher order uplo n pAlpha pX incX pA ldA-    -    her2 order uplo n alpha pX incX pY incY pA ldA = -        with alpha $ \pAlpha -> zher2 order uplo n pAlpha pX incX pY incY pA ldA
− BLAS/C/Level3.hs 
@@ -1,82 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.C.Level3--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.C.Level3-    where-     -import Data.Complex -import Foreign ( Ptr, with )   --import BLAS.C.Types-import BLAS.C.Level2-import BLAS.C.Double  -import BLAS.C.Zomplex -        -        -class (BLAS2 a) => BLAS3 a where-    gemm  :: CBLASOrder -> CBLASTrans -> CBLASTrans -> Int -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    symm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    hemm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    trmm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    trsm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()-    syrk  :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> a -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    syr2k :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    herk  :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> a -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    her2k :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()-    -    -instance BLAS3 Double where-    gemm  = dgemm-    symm  = dsymm-    hemm  = dsymm-    trmm  = dtrmm-    trsm  = dtrsm-    syrk  = dsyrk-    syr2k = dsyr2k-    herk  = dsyrk-    her2k = dsyr2k-    -    -instance BLAS3 (Complex Double) where-    gemm order transA transB m n k alpha pA ldA pB ldB beta pC ldC =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zgemm order transA transB m n k pAlpha pA ldA pB ldB pBeta pC ldC-    -    symm order side uplo m n alpha pA ldA pB ldB beta pC ldC =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zsymm order side uplo m n pAlpha pA ldA pB ldB pBeta pC ldC--    hemm order side uplo m n alpha pA ldA pB ldB beta pC ldC =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zhemm order side uplo m n pAlpha pA ldA pB ldB pBeta pC ldC-    -    trmm order side uplo transA diag m n alpha pA ldA pB ldB =-        with alpha $ \pAlpha -> -            ztrmm order side uplo transA diag m n pAlpha pA ldA pB ldB-            -    trsm order side uplo transA diag m n alpha pA ldA pB ldB =-        with alpha $ \pAlpha -> -            ztrsm order side uplo transA diag m n pAlpha pA ldA pB ldB-            -    syrk order uplo transA n k alpha pA ldA beta pC ldC =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zsyrk order uplo transA n k pAlpha pA ldA pBeta pC ldC-            -    syr2k order uplo transA n k alpha pA ldA pB ldB beta pC ldC =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zsyr2k order uplo transA n k pAlpha pA ldA pB ldB pBeta pC ldC--    herk order uplo transA n k alpha pA ldA beta pC ldC =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zherk order uplo transA n k pAlpha pA ldA pBeta pC ldC-            -    her2k order uplo transA n k alpha pA ldA pB ldB beta pC ldC =-        with alpha $ \pAlpha -> with beta $ \pBeta ->-            zher2k order uplo transA n k pAlpha pA ldA pB ldB pBeta pC ldC
− BLAS/C/Types.hs 
@@ -1,87 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : BLAS.C.Types--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.C.Types (-    CBLASOrder,-    CBLASTrans,-    CBLASUpLo,-    CBLASDiag,-    CBLASSide,--    rowMajor,-    colMajor,-    -    noTrans,-    trans,-    conjTrans,-    -    upper,-    lower,-    -    nonUnit,-    unit,-    -    leftSide,-    rightSide,--    cblasOrder,-    cblasTrans,-    cblasUpLo,-    cblasDiag,-    cblasSide,-    ) where-        -import BLAS.Types-        -newtype CBLASOrder = CBLASOrder Int deriving (Eq, Show)-newtype CBLASTrans = CBLASTrans Int deriving (Eq, Show)-newtype CBLASUpLo  = CBLASUpLo  Int deriving (Eq, Show)-newtype CBLASDiag  = CBLASDiag  Int deriving (Eq, Show)-newtype CBLASSide  = CBLASSide  Int deriving (Eq, Show)--rowMajor, colMajor :: CBLASOrder-rowMajor = CBLASOrder 101-colMajor = CBLASOrder 102--cblasOrder :: Order -> CBLASOrder-cblasOrder RowMajor = CBLASOrder 101-cblasOrder ColMajor = CBLASOrder 102--noTrans, trans, conjTrans :: CBLASTrans-noTrans   = CBLASTrans 111-trans     = CBLASTrans 112-conjTrans = CBLASTrans 113--cblasTrans :: Trans -> CBLASTrans-cblasTrans NoTrans   = CBLASTrans 111-cblasTrans ConjTrans = CBLASTrans 113--upper, lower :: CBLASUpLo-upper = CBLASUpLo 121-lower = CBLASUpLo 122--cblasUpLo :: UpLo -> CBLASUpLo-cblasUpLo Upper = CBLASUpLo 121-cblasUpLo Lower = CBLASUpLo 122--nonUnit, unit :: CBLASDiag-nonUnit = CBLASDiag 131-unit    = CBLASDiag 132--cblasDiag :: Diag -> CBLASDiag-cblasDiag NonUnit = CBLASDiag 131-cblasDiag Unit    = CBLASDiag 132--leftSide, rightSide :: CBLASSide-leftSide  = CBLASSide 141-rightSide = CBLASSide 142--cblasSide :: Side -> CBLASSide-cblasSide LeftSide  = CBLASSide 141-cblasSide RightSide = CBLASSide 142
− BLAS/C/Zomplex.hs 
@@ -1,122 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.C.Zomplex--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.C.Zomplex-    where-        -import Data.Complex ( Complex )-import Foreign.Ptr  ( Ptr )-import BLAS.C.Types------------------------------ Level 1 Routines ---------------------------------foreign import ccall unsafe "cblas.h cblas_zdotu_sub"-    zdotu_sub   :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> IO ()--foreign import ccall unsafe "cblas.h cblas_zdotc_sub"-    zdotc_sub   :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> IO ()---foreign import ccall unsafe "cblas.h cblas_dznrm2"-    znrm2  :: Int -> Ptr (Complex Double) -> Int -> IO Double--foreign import ccall unsafe "cblas.h cblas_dzasum"-    zasum  :: Int -> Ptr (Complex Double) -> Int -> IO Double--foreign import ccall unsafe "cblas.h cblas_izamax"-    izamax :: Int -> Ptr (Complex Double) -> Int -> IO Int--foreign import ccall unsafe "cblas.h cblas_zscal"-    zscal  :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zswap"-    zswap  :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zcopy"-    zcopy  :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zaxpy"-    zaxpy  :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zrotg"-    zrotg  :: Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()--foreign import ccall unsafe "cblas.h cblas_zdrot"-    zdrot :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Double -> Double -> IO ()------------------------------- Level 2 Routines ---------------------------------foreign import ccall unsafe "cblas.h cblas_zgemv"-    zgemv :: CBLASOrder -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zgbmv"-    zgbmv :: CBLASOrder -> CBLASTrans -> Int -> Int -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_ztrmv"-    ztrmv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_ztbmv"-    ztbmv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()-                 -foreign import ccall unsafe "cblas.h cblas_ztrsv"-    ztrsv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_ztbsv"-    ztbsv :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()-    -foreign import ccall unsafe "cblas.h cblas_zhemv"-    zhemv :: CBLASOrder -> CBLASUpLo -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zhbmv"-    zhbmv :: CBLASOrder -> CBLASUpLo -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()-    -foreign import ccall unsafe "cblas.h cblas_zgeru"-    zgeru  :: CBLASOrder -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zgerc"-    zgerc  :: CBLASOrder -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()-        -foreign import ccall unsafe "cblas.h cblas_zher"-    zher  :: CBLASOrder -> CBLASUpLo -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zher2"-    zher2 :: CBLASOrder -> CBLASUpLo -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()------------------------------- Level 3 Routines ---------------------------------foreign import ccall unsafe "cblas.h cblas_zgemm"-    zgemm  :: CBLASOrder -> CBLASTrans -> CBLASTrans -> Int -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zsymm"-    zsymm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zhemm"-    zhemm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_ztrmm"-    ztrmm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_ztrsm"-    ztrsm  :: CBLASOrder -> CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zsyrk"-    zsyrk  :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()-           -foreign import ccall unsafe "cblas.h cblas_zsyr2k"           -    zsyr2k :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()--foreign import ccall unsafe "cblas.h cblas_zherk"-    zherk  :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()-           -foreign import ccall unsafe "cblas.h cblas_zher2k"           -    zher2k :: CBLASOrder -> CBLASUpLo -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()-
− BLAS/Conj.hs 
@@ -1,33 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Conj--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Conj (-    Conj(..)-    ) where--import Data.Complex-import Data.Vector.Dense.Class.Internal.Base( BaseVector, conjVector )--class Conj e where-    -- | Take the complex conjugate of a value.  For real values-    -- this is equal to @id@.-    conj :: e -> e--instance Conj (Complex Double) where-    conj = conjugate-    {-# INLINE conj #-}-    -instance Conj Double where-    conj = id-    {-# INLINE conj #-}--instance (BaseVector x) => Conj (x n e) where-    conj = conjVector-    {-# INLINE conj #-}
− BLAS/Elem.hs 
@@ -1,20 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : BLAS.Elem--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Elem (-    module BLAS.Elem.Base,-    module BLAS.C.Level1,-    module BLAS.C.Level2,-    module BLAS.C.Level3-    ) where--import BLAS.Elem.Base-import BLAS.C.Level1 ( BLAS1 )-import BLAS.C.Level2 ( BLAS2 )-import BLAS.C.Level3 ( BLAS3 )
− BLAS/Elem/Base.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Elem.Base--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Elem.Base (-    Elem(..),-    module BLAS.Conj,-    ) where--import BLAS.Conj-import Data.Complex             ( Complex(..), magnitude )-import Foreign                  ( Storable )-import Foreign.Storable.Complex ()---- | The base class for elements.-class (Storable e, Fractional e, Conj e) => Elem e where-    -- | Get the magnitude of a value.-    norm :: e -> Double-    -    -- | Get the l1 norm of a value.-    norm1 :: e -> Double-    -    -- | Convert a double to an element-    fromReal :: Double -> e--    -- | Coerce an element to a double-    toReal :: e -> Double-    -instance Elem Double where-    norm     = abs-    norm1    = abs-    fromReal = id-    toReal   = id-    -instance Elem (Complex Double) where-    norm             = magnitude-    norm1 (x :+ y)   = abs x + abs y-    fromReal x       = x :+ 0-    toReal  (x :+ _) = x-
− BLAS/Internal.hs 
@@ -1,318 +0,0 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}-{-# OPTIONS_GHC -fglasgow-exts #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Internal--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental------module BLAS.Internal (-    clearArray,-    bzero,-    inlinePerformIO,-    checkedSubvector,-    checkedSubvectorWithStride,-    checkVecVecOp,-    checkedRow,-    checkedCol,-    checkedDiag,-    checkedSubmatrix,-    checkMatMatOp,-    checkMatVecMult,-    checkMatMatMult,-    checkMatVecMultAdd,-    checkMatMatMultAdd,-    checkMatVecSolv,-    checkMatMatSolv,-    checkMatVecSolvTo,-    checkMatMatSolvTo,-    checkSquare,-    checkFat,-    checkTall,-    checkBinaryOp,-    checkTernaryOp,-    diagStart,-    diagLen,    -    ) where---import Data.Ix     ( inRange )-import Foreign                  ( Ptr, Storable, castPtr, sizeOf )-import Foreign.C.Types          ( CSize )-import Text.Printf ( printf )---#if defined(__GLASGOW_HASKELL__)-import GHC.Base                 ( realWorld# )-import GHC.IOBase               ( IO(IO) )-#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 = (fromInteger . toInteger) (n * sizeOf e)-        in do-            bzero ptr nbytes-{-# INLINE clearArray #-}---bzero :: Ptr a -> Int -> IO ()-bzero ptr n =-    let ptr' = castPtr ptr-        n'   = (fromInteger . toInteger) n-    in bzero_ ptr' n'-        -foreign import ccall "strings.h bzero"-    bzero_ :: Ptr () -> CSize -> IO ()-    --inlinePerformIO :: IO a -> a-#if defined(__GLASGOW_HASKELL__)-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r-#else-inlinePerformIO = unsafePerformIO-#endif-{-# INLINE inlinePerformIO #-}--checkedSubvector :: Int -> (Int -> Int -> v) -> Int -> Int -> v-checkedSubvector n sub o n'-    | (o < 0) && (n' /= 0) = -        error $ printf -            "tried to create a subvector starting at a negative offset: `%d'" o-    | n' < 0 = -        error $ printf -            "tried to create a subvector with a negative length `%d'" n'-    | n' + o > n = -        error $ printf-            ("tried to create a subvector of length `%d' and offset `%d' "-             ++ " from a vector of length `%d'") n' o n-    | otherwise =-        sub o n'-        -checkedSubvectorWithStride :: Int -> Int -> (Int -> Int -> v)-    -> Int -> Int -> v-checkedSubvectorWithStride s n sub o n'-    | (o < 0) && (n' /= 0) =-        error $ printf-            "Tried to create a subvector starting at a negative offset: `%d'" o-    | n' < 0 =-        error $ printf-            "Tried to create a subvector with a negative length `%d'" n'-    | s <= 0 =-        error $ printf-            "Tried to create a subvector with non-positive stride `%d'" s-    | not $ inRange (-1,n) (o + s * n') =-        error $ printf-            ("tried to create a subvector of length `%d',  offset `%d',"-             ++ " and stride '%d' from a vector of length `%d'") n' o s n-    | otherwise =-        sub o n'--checkVecVecOp :: String -> Int -> Int -> a -> a-checkVecVecOp name n1 n2-    | n1 /= n2 =-        error $ printf-            ("%s: x and y have different dimensions.  x has dimension `%d',"-             ++ " and y has dimension `%d'") name n1 n2-    | otherwise = id-{-# INLINE checkVecVecOp #-}--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 `%d' 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 :: (Int,Int) -> a -> a-checkSquare (m,n)-    | m /= n =-        error $ printf-            ("Expected a square matrix but got one with shape `%s'")-            (show (m,n))-    | otherwise = id--checkFat :: (Int,Int) -> a -> a-checkFat (m,n)-    | m > n =-        error $ printf-            ("Expected a fat matrix but got one with shape `%s'")-            (show (m,n))-    | otherwise = id--checkTall :: (Int,Int) -> a -> a-checkTall (m,n)-    | m < n =-        error $ printf-            ("Expected a tall matrix but got one with shape `%s'")-            (show (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 #-}
− BLAS/Matrix.hs 
@@ -1,20 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : BLAS.Matrix--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Matrix (-    module BLAS.Matrix.Base,-    module BLAS.Matrix.Immutable,-    module BLAS.Matrix.Mutable,-    module BLAS.Matrix.Solve,-    ) where--import BLAS.Matrix.Base-import BLAS.Matrix.Immutable-import BLAS.Matrix.Mutable-import BLAS.Matrix.Solve
− BLAS/Matrix/Base.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Matrix.Base--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Matrix.Base (-    BaseMatrix(..),-    numRows,-    numCols,-    isSquare,-    isFat,-    isTall,-    ) where--import BLAS.Tensor---- | A base class for matrices.-class (BaseTensor a (Int,Int)) => BaseMatrix a where-    -- | Creates a new matrix view that conjugates and transposes the -    -- given matrix.-    herm :: a (m,n) e -> a (n,m) e---- | Get the number of rows in the matrix.-numRows :: (BaseMatrix a) => a mn e -> Int-numRows = fst . shape-{-# INLINE numRows #-}---- | Get the number of rows in the matrix.-numCols :: (BaseMatrix a) => a mn e -> Int-numCols = snd . shape-{-# INLINE numCols #-}--isSquare :: (BaseMatrix a) => a mn e -> Bool-isSquare a = numRows a == numCols a--isFat :: (BaseMatrix a) => a mn e -> Bool-isFat a = numRows a <= numCols a--isTall :: (BaseMatrix a) => a mn e -> Bool-isTall a = numRows a >= numCols a-
− BLAS/Matrix/Immutable.hs 
@@ -1,108 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-{-# OPTIONS_GHC -fglasgow-exts #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Matrix.Apply.Immutable--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Matrix.Immutable (-    -- * Rows and columns-    row,-    col,-    rows,-    cols,--    -- * Multiplication-    (<*>),-    (<**>),-    sapply,-    sapplyMat,-    -    IMatrix(..),-    unsafeApply,-    unsafeApplyMat,-    ) where--import BLAS.Elem( BLAS1, BLAS3 )-import BLAS.Internal ( checkedRow, checkedCol, checkMatVecMult, -    checkMatMatMult )--import BLAS.Matrix.Base-import BLAS.Matrix.Mutable( unsafeGetSApply, unsafeGetSApplyMat )--import Data.Vector.Dense-import Data.Vector.Dense.ST( runSTVector )-import Data.Matrix.Dense.Internal-import Data.Matrix.Dense.Class( unsafeRowView, unsafeColView )-import Data.Matrix.Dense.ST( runSTMatrix )--infixr 7 <*>, <**>--class (BLAS1 e, BaseMatrix a) => IMatrix a e where-    unsafeSApply :: e -> a (m,n) e -> Vector n e -> Vector m e-    unsafeSApplyMat :: e -> a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e--    -- | Same as 'row' but index is not range-checked.-    unsafeRow :: a (m,n) e -> Int -> Vector n e-    unsafeRow a i = let-        e = basisVector (numRows a) i-        in conj $ unsafeApply (herm a) e-    -    -- | Same as 'col' but index is not range-checked.    -    unsafeCol :: a (m,n) e -> Int -> Vector m e-    unsafeCol a j = let-        e = basisVector (numCols a) j-        in unsafeApply a e----- | Get the given row in a matrix.-row :: (IMatrix a e) => a (m,n) e -> Int -> Vector n e-row a = checkedRow (shape a) (unsafeRow a)---- | Get the given column in a matrix.-col :: (IMatrix a e) => a (m,n) e -> Int -> Vector m e-col a = checkedCol (shape a) (unsafeCol a)---- | Get a list the row vectors in the matrix.-rows :: (IMatrix a e) => a (m,n) e -> [Vector n e]-rows a = [ unsafeRow a i | i <- [0..numRows a - 1] ]---- | Get a list the column vectors in the matrix.-cols :: (IMatrix a e) => a (m,n) e -> [Vector m e]-cols a = [ unsafeCol a j | j <- [0..numCols a - 1] ]----- | Apply to a vector-(<*>) :: (IMatrix a e) => a (m,n) e -> Vector n e -> Vector m e-(<*>) a x = checkMatVecMult (shape a) (dim x) $ unsafeApply a x-    --- | Apply to a matrix-(<**>) :: (IMatrix a e) => a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e-(<**>) a b = checkMatMatMult (shape a) (shape b) $ unsafeApplyMat a b--sapply :: (IMatrix a e) => e -> a (m,n) e -> Vector n e -> Vector m e-sapply k a x = checkMatVecMult (shape a) (dim x) $ unsafeSApply k a x-    -sapplyMat :: (IMatrix a e) => e -> a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e    -sapplyMat k a b = checkMatMatMult (shape a) (shape b) $ unsafeSApplyMat k a b--unsafeApply :: (IMatrix a e) => a (m,n) e -> Vector n e -> Vector m e-unsafeApply = unsafeSApply 1--unsafeApplyMat :: (IMatrix a e) => a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e-unsafeApplyMat = unsafeSApplyMat 1--instance (BLAS3 e) => IMatrix Matrix e where-    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x-    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b-    unsafeRow                 = unsafeRowView-    unsafeCol                 = unsafeColView--{-# RULES-"scale.apply/sapply"       forall k a x. (<*>) (k *> a) x = sapply k a x-"scale.applyMat/sapplyMat" forall k a b. (<**>) (k *> a) b = sapplyMat k a b-  #-}
− BLAS/Matrix/Mutable.hs 
@@ -1,278 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Matrix.Apply.Read--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Matrix.Mutable (-    -- * Getting rows and columns-    getRow,-    getCol,-    getRows,-    getCols,-    getRows',-    getCols',-    -    -- * Matrix and vector multiplication-    getApply,-    getSApply,-    -    getApplyMat,-    getSApplyMat,--    -- * In-place multiplication-    doApply,-    doSApplyAdd,-    doApply_,-    doSApply_,-    -    doApplyMat,-    doSApplyAddMat,-    doApplyMat_,-    doSApplyMat_,--    -- * The MMatrix type class-    MMatrix(..),--    -- * Unsafe operations-    unsafeGetApply,-    unsafeDoApply,-    unsafeDoApply_,--    unsafeGetApplyMat,-    unsafeDoApplyMat,-    unsafeDoApplyMat_,--    ) where--import Control.Monad( liftM )-import Control.Monad.ST( ST )--import BLAS.Elem-import BLAS.Internal( checkSquare, checkMatVecMult, checkMatVecMultAdd,-    checkMatMatMult, checkMatMatMultAdd, checkedRow, checkedCol )-import BLAS.UnsafeIOToM--import BLAS.Matrix.Base--import Data.Vector.Dense.Class--import Data.Matrix.Dense.Internal( Matrix )-import Data.Matrix.Dense.Class.Internal hiding ( BaseMatrix )---- | Minimal complete definition: (unsafeDoSApplyAdd, unsafeDoSApplyAddMat)-class (BaseMatrix a, BLAS1 e, Monad m) => MMatrix a e m where-    unsafeGetSApply :: (ReadVector x m, WriteVector y m) =>-        e -> a (k,l) e -> x l e -> m (y k e)-    unsafeGetSApply alpha a x = do-        y <- newVector_ (numRows a)-        unsafeDoSApplyAdd alpha a x 0 y-        return y--    unsafeGetSApplyMat :: (ReadMatrix b x m, WriteMatrix c y m) =>-        e -> a (r,s) e -> b (s,t) e -> m (c (r,t) e)-    unsafeGetSApplyMat alpha a b = do-        c <- newMatrix_ (numRows a, numCols b)-        unsafeDoSApplyAddMat alpha a b 0 c-        return c--    unsafeDoSApplyAdd :: (ReadVector x m, WriteVector y m) =>-        e -> a (k,l) e -> x l e -> e -> y k e -> m ()-    unsafeDoSApplyAdd alpha a x beta y = do-        y' <- unsafeGetSApply alpha a x-        scaleBy beta y-        unsafeAxpyVector 1 y' y--    unsafeDoSApplyAddMat :: (ReadMatrix b x m, WriteMatrix c y m) =>-        e -> a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-    unsafeDoSApplyAddMat alpha a b beta c = do-        c' <- unsafeGetSApplyMat alpha a b-        scaleBy beta c-        unsafeAxpyMatrix 1 c' c--    unsafeDoSApply_ :: (WriteVector y m) =>-        e -> a (n,n) e -> y n e -> m ()-    unsafeDoSApply_ alpha a x = do-        y <- newVector_ (dim x)-        unsafeDoSApplyAdd alpha a x 0 y-        unsafeCopyVector x y--    unsafeDoSApplyMat_ :: (WriteMatrix b y m) =>-        e -> a (k,k) e -> b (k,l) e -> m ()-    unsafeDoSApplyMat_ alpha a b = do-        c <- newMatrix_ (shape b)-        unsafeDoSApplyAddMat alpha a b 0 c-        unsafeCopyMatrix b c--    unsafeGetRow :: (WriteVector x m) => a (k,l) e -> Int -> m (x l e)-    unsafeGetRow a i = do-        e <- newBasisVector (numRows a) i-        liftM conj $ unsafeGetApply (herm a) e-        -    unsafeGetCol :: (WriteVector x m) => a (k,l) e -> Int -> m (x k e)-    unsafeGetCol a j = do-        e <- newBasisVector (numCols a) j-        unsafeGetApply a e----- | Get the given row in a matrix.-getRow :: (MMatrix a e m, WriteVector x m) => a (k,l) e -> Int -> m (x l e)-getRow a = checkedRow (shape a) (unsafeGetRow a)---- | Get the given column in a matrix.-getCol :: (MMatrix a e m, WriteVector x m) => a (k,l) e -> Int -> m (x k e)-getCol a = checkedCol (shape a) (unsafeGetCol a)---- | Get a lazy list the row vectors in the matrix.  See also "getRows'".-getRows :: (MMatrix a e m, WriteVector x m) => -    a (k,l) e -> m [x l e]-getRows = unsafeInterleaveM . getRows'---- | Get a lazy list of the column vectors in the matrix.  See also "getCols'".-getCols :: (MMatrix a e m, WriteVector x m) => -    a (k,l) e -> m [x k e]-getCols = unsafeInterleaveM . getCols'---- | Get a strict list the row vectors in the matrix.  See also "getRows".-getRows' :: (MMatrix a e m, WriteVector x m) => a (k,l) e -> m [x l e]-getRows' a = mapM (unsafeGetRow a) [0..numRows a - 1]---- | Get a strict list of the column vectors in the matrix.  See also "getCols".-getCols' :: (MMatrix a e m, WriteVector x m) => a (k,l) e -> m [x k e]-getCols' a = mapM (unsafeGetCol a) [0..numCols a - 1]---- | Scale and apply to a vector-getSApply :: (MMatrix a e m, ReadVector x m, WriteVector y m) =>-    e -> a (k,l) e -> x l e -> m (y k e)-getSApply k a x =-    checkMatVecMult (shape a) (dim x) $ -        unsafeGetSApply k a x---- | Scale and apply to a matrix-getSApplyMat :: (MMatrix a e m, ReadMatrix b x m, WriteMatrix c y m) =>-    e -> a (r,s) e -> b (s,t) e -> m (c (r,t) e)-getSApplyMat k a b =-    checkMatMatMult (shape a) (shape b) $-        unsafeGetSApplyMat k a b-    --- | @y := alpha a x + beta y@    -doSApplyAdd :: (MMatrix a e m, ReadVector x m, WriteVector y m) =>-    e -> a (k,l) e -> x l e -> e -> y k e -> m ()-doSApplyAdd alpha a x beta y =-    checkMatVecMultAdd (shape a) (dim x) (dim y) $-        unsafeDoSApplyAdd alpha a x beta y---- | @c := alpha a b + beta c@-doSApplyAddMat :: (MMatrix a e m, ReadMatrix b x m, WriteMatrix c y m) =>-    e -> a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-doSApplyAddMat alpha a b beta c =-    checkMatMatMultAdd (shape a) (shape b) (shape c)-        unsafeDoSApplyAddMat alpha a b beta c---- | Apply to a vector-getApply :: (MMatrix a e m, ReadVector x m, WriteVector y m) =>-    a (k,l) e -> x l e -> m (y k e)-getApply a x =-    checkMatVecMult (shape a) (dim x) $ do-        unsafeGetApply a x---- | Apply to a matrix-getApplyMat :: (MMatrix a e m, ReadMatrix b x m, WriteMatrix c y m) =>-    a (r,s) e -> b (s,t) e -> m (c (r,t) e)-getApplyMat a b =-    checkMatMatMult (shape a) (shape b) $-        unsafeGetApplyMat a b---- | @ x := alpha a x@        -doSApply_ :: (MMatrix a e m, WriteVector y m) =>-    e -> a (n,n) e -> y n e -> m ()-doSApply_ alpha a x =-    checkSquare (shape a) $-        checkMatVecMult (shape a) (dim x) $-            unsafeDoSApply_ alpha a x---- | @ b := alpha a b@-doSApplyMat_ :: (MMatrix a e m, WriteMatrix b y m) =>-    e -> a (s,s) e -> b (s,t) e -> m ()-doSApplyMat_ alpha a b =-    checkSquare (shape a) $-        checkMatMatMult (shape a) (shape b) $-            unsafeDoSApplyMat_ alpha a b--unsafeGetApply :: (MMatrix a e m, ReadVector x m, WriteVector y m) =>-    a (k,l) e -> x l e -> m (y k e)-unsafeGetApply = unsafeGetSApply 1--unsafeGetApplyMat :: (MMatrix a e m, ReadMatrix b x m, WriteMatrix c y m) =>-    a (r,s) e -> b (s,t) e -> m (c (r,t) e)-unsafeGetApplyMat = unsafeGetSApplyMat 1---- | Apply to a vector and store the result in another vector-doApply :: (MMatrix a e m, ReadVector x m, WriteVector y m) =>-    a (k,l) e -> x l e -> y k e -> m ()-doApply a x y =-    checkMatVecMultAdd (numRows a, numCols a) (dim x) (dim y) $-        unsafeDoApply a x y---- | Apply to a matrix and store the result in another matrix-doApplyMat :: (MMatrix a e m, ReadMatrix b x m, WriteMatrix c y m) =>-    a (r,s) e -> b (s,t) e -> c (r,t) e -> m ()-doApplyMat a b c =-    checkMatMatMultAdd (shape a) (shape b) (shape c) $-        unsafeDoApplyMat a b c-        -unsafeDoApply :: (MMatrix a e m, ReadVector x m, WriteVector y m) =>-    a (k,l) e -> x l e -> y k e -> m ()-unsafeDoApply a x y = unsafeDoSApplyAdd 1 a x 0 y--unsafeDoApplyMat :: (MMatrix a e m, ReadMatrix b x m, WriteMatrix c y m) =>-    a (r,s) e -> b (s,t) e -> c (r,t) e -> m ()-unsafeDoApplyMat a b c = unsafeDoSApplyAddMat 1 a b 0 c---- | @x := a x@    -doApply_ :: (MMatrix a e m, WriteVector y m) =>-    a (n,n) e -> y n e -> m ()-doApply_ a x =-    checkSquare (shape a) $-        checkMatVecMult (shape a) (dim x) $-            unsafeDoApply_ a x---- | @ b := a b@-doApplyMat_ :: (MMatrix a e m, WriteMatrix b y m) =>-    a (s,s) e -> b (s,t) e -> m ()-doApplyMat_ a b =-    checkSquare (shape a) $-        checkMatMatMult (shape a) (shape b) $-            unsafeDoApplyMat_ a b-  -unsafeDoApply_ :: (MMatrix a e m, WriteVector y m) => -    a (n,n) e -> y n e -> m ()-unsafeDoApply_ a x =-    unsafeDoSApply_ 1 a x--unsafeDoApplyMat_ :: (MMatrix a e m, WriteMatrix b y m) =>-    a (s,s) e -> b (s,t) e -> m ()-unsafeDoApplyMat_ a b = -    unsafeDoSApplyMat_ 1 a b--instance (BLAS3 e) => MMatrix IOMatrix e IO where-    unsafeDoSApplyAdd    = gemv-    unsafeDoSApplyAddMat = gemm-    unsafeGetRow         = unsafeGetRowMatrix-    unsafeGetCol         = unsafeGetColMatrix--instance (BLAS3 e) => MMatrix (STMatrix s) e (ST s) where-    unsafeDoSApplyAdd    = gemv-    unsafeDoSApplyAddMat = gemm-    unsafeGetRow         = unsafeGetRowMatrix-    unsafeGetCol         = unsafeGetColMatrix--instance (BLAS3 e, UnsafeIOToM m) => MMatrix Matrix e m where-    unsafeDoSApplyAdd    = gemv-    unsafeDoSApplyAddMat = gemm-    unsafeGetRow         = unsafeGetRowMatrix-    unsafeGetCol         = unsafeGetColMatrix
− BLAS/Matrix/Solve.hs 
@@ -1,16 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : BLAS.Matrix.Solve--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Matrix.Solve (-    module BLAS.Matrix.Solve.Immutable,-    module BLAS.Matrix.Solve.Mutable,-    ) where--import BLAS.Matrix.Solve.Immutable-import BLAS.Matrix.Solve.Mutable
− BLAS/Matrix/Solve/Immutable.hs 
@@ -1,64 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Matrix.Solve.Immutable--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Matrix.Solve.Immutable (-    ISolve(..),-    (<\>),-    (<\\>),-    ssolve,-    ssolveMat,-    -    ) where--import BLAS.Elem-import BLAS.Internal ( checkMatVecSolv, checkMatMatSolv )-import BLAS.Matrix.Base--import Data.Vector.Dense ( Vector, dim )-import Data.Matrix.Dense ( Matrix, shape )--infixr 7 <\>, <\\>--class (BaseMatrix a, BLAS1 e) => ISolve a e where-    unsafeSolve :: a (m,n) e -> Vector m e -> Vector n e-    unsafeSolve = unsafeSSolve 1-    -    unsafeSolveMat :: a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e-    unsafeSolveMat = unsafeSSolveMat 1--    unsafeSSolve :: e -> a (m,n) e -> Vector m e -> Vector n e-    -    unsafeSSolveMat :: e -> a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e----- | Solve for a vector-(<\>) :: (ISolve a e) => a (m,n) e -> Vector m e -> Vector n e-(<\>) a y =-    checkMatVecSolv (shape a) (dim y) $-        unsafeSolve a y---- | Solve for a matrix-(<\\>) :: (ISolve a e) => a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e-(<\\>) a b =-    checkMatMatSolv (shape a) (shape b) $-        unsafeSolveMat a b---- | Solve for a vector and scale-ssolve :: (ISolve a e) => e -> a (m,n) e -> Vector m e -> Vector n e-ssolve alpha a y =-    checkMatVecSolv (shape a) (dim y) $-        unsafeSSolve alpha a y---- | Solve for a matrix and scale-ssolveMat :: (ISolve a e) => e -> a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e-ssolveMat alpha a b =-    checkMatMatSolv (shape a) (shape b) $-        unsafeSSolveMat alpha a b-
− BLAS/Matrix/Solve/Mutable.hs 
@@ -1,193 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Matrix.Solve.Mutable--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Matrix.Solve.Mutable (-    -    -- * Matrix and vector solving-    getSolve,-    getSolveMat,-    getSSolve,-    getSSolveMat,-    -    -- * In-place solving-    doSolve,-    doSolveMat,-    doSSolve,-    doSSolveMat,-    doSolve_,-    doSolveMat_,-    doSSolve_,-    doSSolveMat_,-    -    -- * The MSolve typeclass-    MSolve(..),--    -- * Unsafe operations-    unsafeGetSolve,-    unsafeGetSolveMat,-    unsafeGetSSolve,-    unsafeGetSSolveMat,--    ) where--import BLAS.Elem-import BLAS.Internal ( checkMatVecSolv, checkMatMatSolv, checkMatVecSolvTo,-    checkMatMatSolvTo, checkSquare )-import BLAS.Matrix.Base--import Data.Vector.Dense.Class-import Data.Matrix.Dense.Class hiding ( BaseMatrix )---class (BaseMatrix a, BLAS1 e, Monad m) => MSolve a e m where-    unsafeDoSolve :: (ReadVector y m, WriteVector x m) =>-        a (k,l) e -> y k e -> x l e -> m ()-    unsafeDoSolve = unsafeDoSSolve 1-    -    unsafeDoSolveMat :: (ReadMatrix c y m, WriteMatrix b x m) =>-        a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()-    unsafeDoSolveMat = unsafeDoSSolveMat 1-    -    unsafeDoSSolve :: (ReadVector y m, WriteVector x m) =>-        e -> a (k,l) e -> y k e -> x l e -> m ()-    unsafeDoSSolve alpha a y x = do-        unsafeDoSolve a y x-        scaleBy alpha x-    -    unsafeDoSSolveMat :: (ReadMatrix c y m, WriteMatrix b x m) =>-        e -> a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()-    unsafeDoSSolveMat alpha a c b = do-        unsafeDoSolveMat a c b-        scaleBy alpha b--    unsafeDoSolve_ :: (WriteVector x m) => a (k,k) e -> x k e -> m ()-    unsafeDoSolve_ = unsafeDoSSolve_ 1--    unsafeDoSSolve_ :: (WriteVector x m) => e -> a (k,k) e -> x k e -> m ()-    unsafeDoSSolve_ alpha a x = do-        scaleBy alpha x-        unsafeDoSolve_ a x-        -    unsafeDoSolveMat_ :: (WriteMatrix b x m) => a (k,k) e -> b (k,l) e -> m ()-    unsafeDoSolveMat_ = unsafeDoSSolveMat_ 1-        -    unsafeDoSSolveMat_ :: (WriteMatrix b x m) => e -> a (k,k) e -> b (k,l) e -> m ()         -    unsafeDoSSolveMat_ alpha a b = do-        scaleBy alpha b-        unsafeDoSolveMat_ a b---unsafeGetSolve :: (MSolve a e m, ReadVector y m, WriteVector x m) => -    a (k,l) e -> y k e -> m (x l e)-unsafeGetSolve a y = do-    x <- newVector_ (numCols a)-    unsafeDoSolve a y x-    return x-    -unsafeGetSSolve :: (MSolve a e m, ReadVector y m, WriteVector x m) => -    e -> a (k,l) e -> y k e -> m (x l e)-unsafeGetSSolve alpha a y = do-    x <- newVector_ (numCols a)-    unsafeDoSSolve alpha a y x-    return x-    -unsafeGetSolveMat :: (MSolve a e m, ReadMatrix c y m, WriteMatrix b x m) => -    a (r,s) e -> c (r,t) e -> m (b (s,t) e)-unsafeGetSolveMat a c = do-    b <- newMatrix_ (numCols a, numCols c)-    unsafeDoSolveMat a c b-    return b--unsafeGetSSolveMat :: (MSolve a e m, ReadMatrix c y m, WriteMatrix b x m) => -    e -> a (r,s) e -> c (r,t) e -> m (b (s,t) e)                         -unsafeGetSSolveMat alpha a c = do-    b <- newMatrix_ (numCols a, numCols c)-    unsafeDoSSolveMat alpha a c b-    return b---- | Solve for a vector-getSolve :: (MSolve a e m, ReadVector y m, WriteVector x m) =>-    a (k,l) e -> y k e -> m (x l e)-getSolve a y = -    checkMatVecSolv (shape a) (dim y) $-        unsafeGetSolve a y---- | Solve for a vector and scale-getSSolve :: (MSolve a e m, ReadVector y m, WriteVector x m) => -    e -> a (k,l) e -> y k e -> m (x l e)-getSSolve alpha a y = -    checkMatVecSolv (shape a) (dim y) $-        unsafeGetSSolve alpha a y---- | Solve for a matrix-getSolveMat :: (MSolve a e m, ReadMatrix c y m, WriteMatrix b x m) => -    a (r,s) e -> c (r,t) e -> m (b (s,t) e)                     -getSolveMat a c =-    checkMatMatSolv (shape a) (shape c) $-            unsafeGetSolveMat a c-            --- | Solve for a matrix and scale-getSSolveMat :: (MSolve a e m, ReadMatrix c y m, WriteMatrix b x m) => -    e -> a (r,s) e -> c (r,t) e -> m (b (s,t) e)                 -getSSolveMat alpha a b =-    checkMatMatSolv (shape a) (shape b) $-            unsafeGetSSolveMat alpha a b--doSolve :: (MSolve a e m, ReadVector y m, WriteVector x m) => -    a (r,s) e -> y r e -> x s e -> m ()                 -doSolve a y x =-    checkMatVecSolvTo (shape a) (dim y) (dim x) $-        unsafeDoSolve a y x-        -doSolveMat :: (MSolve a e m, ReadMatrix c y m, WriteMatrix b x m) => -    a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()                -doSolveMat a c b =-    checkMatMatSolvTo (shape a) (shape c) (shape b) $-        unsafeDoSolveMat a c b-    -doSSolve :: (MSolve a e m, ReadVector y m, WriteVector x m) => -    e -> a (k,l) e -> y k e -> x l e -> m ()-doSSolve alpha a y x =-    checkMatVecSolvTo (shape a) (dim y) (dim x) $-        unsafeDoSSolve alpha a y x--doSSolveMat :: (MSolve a e m, ReadMatrix c y m, WriteMatrix b x m) => -    e -> a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()                  -doSSolveMat alpha a c b =-    checkMatMatSolvTo (shape a) (shape c) (shape b) $-        unsafeDoSSolveMat alpha a c b--doSolve_ :: (MSolve a e m, ReadVector y m, WriteVector x m) => -    a (k,k) e -> x k e -> m ()-doSolve_ a x =-    checkSquare (shape a) $-        checkMatVecSolv (shape a) (dim x) $-            unsafeDoSolve_ a x--doSSolve_ :: (MSolve a e m, WriteVector x m) => -    e -> a (k,k) e -> x k e -> m ()-doSSolve_ alpha a x =-    checkSquare (shape a) $-        checkMatVecSolv (shape a) (dim x) $-            unsafeDoSSolve_ alpha a x--doSolveMat_ :: (MSolve a e m, WriteMatrix b x m) => -    a (k,k) e -> b (k,l) e -> m ()          -doSolveMat_ a b =-    checkSquare (shape a) $-        checkMatMatSolv (shape a) (shape b) $-            unsafeDoSolveMat_ a b--doSSolveMat_ :: (MSolve a e m, WriteMatrix b x m) =>-    e -> a (k,k) e -> b (k,l) e -> m ()          -doSSolveMat_ alpha a b =-    checkSquare (shape a) $-        checkMatMatSolv (shape a) (shape b) $-            unsafeDoSSolveMat_ alpha a b
− BLAS/Tensor.hs 
@@ -1,20 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : BLAS.Tensor--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Tensor (-    module BLAS.Tensor.Base,-    module BLAS.Tensor.Immutable,-    module BLAS.Tensor.Read,-    module BLAS.Tensor.Write,-    ) where--import BLAS.Tensor.Base-import BLAS.Tensor.Immutable -import BLAS.Tensor.Read-import BLAS.Tensor.Write
− BLAS/Tensor/Base.hs 
@@ -1,25 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Tensor.Base--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Tensor.Base (-    BaseTensor(..),-    ) where--import Data.Ix---- | The base class for tensors (i.e. Vector, Matrix, etc.).-class (Ix i, Eq i, Show i) => BaseTensor x i | x -> i where-    -- | Get the shape of the tensor.  For vectors this is the dimension.-    -- For matrices, this will be a pair @(m,n)@ of the number of rows-    -- and columns.-    shape :: x n e -> i-    -    -- | Get the range of valid indices in the tensor.-    bounds :: x n e -> (i,i)
− BLAS/Tensor/Immutable.hs 
@@ -1,77 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Tensor.Immutable--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Tensor.Immutable (-    ITensor(..),-    (!),-    ) where--import BLAS.Tensor.Base-import BLAS.Elem-import Data.Ix---infixl 9 !-infixl 7 *>-infixl 5 `shift`----- | A class for immutable tensors.-class (BaseTensor x i) => ITensor x i where-    -- | Get the numer of elements stored in the tensor.-    size :: x n e -> Int-    -    -- | Get a new tensor by replacing the elements at the given indices.-    (//) :: (BLAS1 e) => x n e -> [(i,e)] -> x n e--    -- | Get the value at the given index, without doing any bounds-checking.-    unsafeAt :: (Elem e) => x n e -> i -> e-    -    -- | Same as '(//)' but doesn't do any bounds-checking.-    unsafeReplace :: (BLAS1 e) => x n e -> [(i,e)] -> x n e-    -    -- | Get the indices of the elements stored in the tensor.-    indices :: x n e -> [i]-    -    -- | Get the elements stored in the tensor.-    elems :: (Elem e) => x n e -> [e]-    elems = snd . unzip . assocs--    -- | Get the list of @(@index@,@ element@)@ pairs stored in the tensor.-    assocs :: (Elem e) => x n e -> [(i,e)]--    -- accum :: (e -> e' -> e) -> x e -> [(i,e')] -> x e-    -    -- | Apply a function elementwise to a tensor.-    tmap :: (BLAS1 e) => (e -> e) -> x n e -> x n e-    -    -- ixmap :: i -> (i -> i) -> x e -> x e-    -- unsafeIxMap-    -    -- | Scale every element by the given value.-    (*>) :: (BLAS1 e) => e -> x n e -> x n e-    (*>) k = tmap (k*)-    -    -- | Add a constant to every element.-    shift :: (BLAS1 e) => e -> x n e -> x n e-    shift k = tmap (k+)    -    --- | Get the value at the given index.  Range-checks the argument.-(!) :: (ITensor x i, Elem e) => x n e -> i -> e-(!) x i =-    case (inRange b i) of-        False -> -            error $ "tried to get element at a index `" ++ show i ++ "'"-                    ++ " in an object with shape `" ++ show s ++ "'"-        True -> -            unsafeAt x i-  where-    b = bounds x-    s = shape x
− BLAS/Tensor/Read.hs 
@@ -1,79 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Tensor.Read--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Tensor.Read (-    ReadTensor(..),-    readElem,-    ) where--import Data.Ix-import BLAS.Elem-import BLAS.Tensor.Base---- | Class for mutable read-only tensors.-class (BaseTensor x i, Monad m) => ReadTensor x i m | x -> i where-    -- | Get the number of elements stored in the tensor.-    getSize :: x n e -> m Int-    -    -- | Get the value at the specified index, without doing any -    -- range-checking.-    unsafeReadElem :: (Elem e) => x n e -> i -> m e--    -- | Returns a lazy list of the indices in the tensor.  -    -- Because of the laziness, this function should be used with care.-    -- See also "getIndices'".-    getIndices :: x n e -> m [i]--    -- | Returns a list of the indices in the tensor.  See also-    -- 'getIndices'.-    getIndices' :: x n e -> m [i]--    -- | Returns a lazy list of the elements in the tensor.  -    -- Because of the laziness, this function should be used with care.-    -- See also "getElems'".    -    getElems :: (Elem e) => x n e -> m [e]-    getElems x = getAssocs x >>= return . snd . unzip--    -- | Returns a list of the elements in the tensor.  See also-    -- 'getElems'.-    getElems' :: (Elem e) => x n e -> m [e]-    getElems' x = getAssocs' x >>= return . snd . unzip-    -    -- | Returns a lazy list of the elements-index pairs in the tensor.  -    -- Because of the laziness, this function should be used with care.-    -- See also "getAssocs'".        -    getAssocs :: (Elem e) => x n e -> m [(i,e)]-    getAssocs x = do-        is <- getIndices x-        es <- getElems x-        return $ zip is es--    -- | Returns a list of the index-elements pairs in the tensor.  See also-    -- 'getAssocs'.-    getAssocs' :: (Elem e) => x n e -> m [(i,e)]-    getAssocs' x = do-        is <- getIndices' x-        es <- getElems' x-        return $ zip is es----- | Gets the value at the specified index after checking that the argument--- is in bounds.-readElem :: (ReadTensor x i m, Elem e) => x n e -> i -> m e-readElem x i =-    case (inRange b i) of-        False -> -            fail $ "tried to get element at a index `" ++ show i ++ "'"-                   ++ " in an object with shape `" ++ show s ++ "'"-        True -> -            unsafeReadElem x i-  where-      b = bounds x-      s = shape x
− BLAS/Tensor/Write.hs 
@@ -1,112 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module     : BLAS.Tensor.Write--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Tensor.Write (-    WriteTensor(..),-    writeElem,-    modifyElem,-    swapElems,-    ) where--import Data.Ix( inRange )-import BLAS.Tensor.Base-import BLAS.Tensor.Read-import BLAS.Elem( Elem, BLAS1, conj )---- | Class for modifiable mutable tensors.-class (ReadTensor x i m) => WriteTensor x i m | x -> m where-    -- | Get the maximum number of elements that can be stored in the tensor.-    getMaxSize :: x n e -> m Int-    getMaxSize = getSize-    -    -- | Sets all stored elements to zero.-    setZero :: (Elem e) => x n e -> m ()-    setZero = setConstant 0-    -    -- | Sets all stored elements to the given value.-    setConstant :: (Elem e) => e -> x n e -> m ()--    -- | True if the value at a given index can be changed-    canModifyElem :: x n e -> i -> m Bool-    -    -- | Set the value of the element at the given index, without doing any-    -- range checking.-    unsafeWriteElem :: (Elem e) => x n e -> i -> e -> m ()-    -    -- | Modify the value of the element at the given index, without doing-    -- any range checking.-    unsafeModifyElem :: (Elem e) => x n e -> i -> (e -> e) -> m ()-    unsafeModifyElem x i f = do-        e <- unsafeReadElem x i-        unsafeWriteElem x i (f e)-    -    -- | Replace each element by a function applied to it-    modifyWith :: (Elem e) => (e -> e) -> x n e -> m ()--    -- | Same as 'swapElem' but arguments are not range-checked.-    unsafeSwapElems :: (Elem e) => x n e -> i -> i -> m ()-    unsafeSwapElems x i j = do-        e <- unsafeReadElem x i-        f <- unsafeReadElem x j-        unsafeWriteElem x j e-        unsafeWriteElem x i f-    -    -- | Replace every element with its complex conjugate.-    doConj :: (BLAS1 e) => x n e -> m ()-    doConj = modifyWith conj--    -- | Scale every element in the vector by the given value.-    scaleBy :: (BLAS1 e) => e -> x n e -> m ()-    scaleBy 1 = const $ return ()-    scaleBy k = modifyWith (k*)--    -- | Add a value to every element in a vector.-    shiftBy :: (BLAS1 e) => e -> x n e -> m ()-    shiftBy 0 = const $ return ()-    shiftBy k = modifyWith (k+)----- | Set the value of the element at the given index.-writeElem :: (WriteTensor x i m, Elem e) => x n e -> i -> e -> m ()-writeElem x i e = do-    ok <- canModifyElem x i-    case ok && inRange (bounds x) i of-        False -> -            fail $ "tried to set element at index `" ++ show i ++ "'"-                   ++ " in an object with shape `" ++ show s ++ "'"-                   ++ " but that element cannot be modified"-        True ->-            unsafeWriteElem x i e-  where-    s = shape x---- | Update the value of the element at the given index.-modifyElem :: (WriteTensor x i m, Elem e) => x n e -> i -> (e -> e) -> m ()-modifyElem x i f = do-    ok <- canModifyElem x i-    case ok of-        False -> -            fail $ "tried to modify element at index `" ++ show i ++ "'"-                   ++ " in an object with shape `" ++ show s ++ "'"-                   ++ " but that element cannot be modified"-        True ->-            unsafeModifyElem x i f-  where-    s = shape x---- | Swap the values stored at two positions in the tensor.-swapElems :: (WriteTensor x i m, Elem e) => x n e -> i -> i -> m ()-swapElems x i j-    | not ((inRange (bounds x) i) && (inRange (bounds x) j)) = -        fail $ "Tried to swap elements `" ++ show i ++ "' and `"-               ++ show j ++ "' in a tensor of shape `" ++ show (shape x) -               ++ "'."-    | otherwise =-        unsafeSwapElems x i j
− BLAS/Types.hs 
@@ -1,53 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : BLAS.Types--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.Types (-    Order(..),-    Trans(..),-    UpLo(..),-    Diag(..),-    Side(..),-    -    flipOrder,-    flipTrans,-    flipUpLo,-    flipSide,-    ) where---- | Matrix element storage order-data Order = RowMajor | ColMajor deriving (Eq, Show)---- | Transpose type-data Trans = NoTrans | ConjTrans deriving (Eq,Show)---- | Lower or upper triangular storage-data UpLo = Upper | Lower deriving (Eq,Show)---- | Diagonal storage-data Diag = Unit | NonUnit deriving (Eq,Show)---- | Multiplication side-data Side = LeftSide | RightSide deriving (Eq,Show)---flipOrder :: Order -> Order-flipOrder RowMajor = ColMajor-flipOrder ColMajor = RowMajor--flipTrans :: Trans -> Trans-flipTrans NoTrans = ConjTrans-flipTrans ConjTrans = NoTrans--flipUpLo :: UpLo -> UpLo-flipUpLo Upper = Lower-flipUpLo Lower = Upper-        -flipSide :: Side -> Side-flipSide LeftSide  = RightSide-flipSide RightSide = LeftSide
− BLAS/UnsafeIOToM.hs 
@@ -1,34 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : BLAS.UnsafeIOToM--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module BLAS.UnsafeIOToM (-    UnsafeIOToM(..),-    ) where--import Control.Monad.ST ( ST, unsafeIOToST, unsafeInterleaveST )-import System.IO.Unsafe( unsafeInterleaveIO )---class (Monad m) => UnsafeIOToM m where-    unsafeIOToM :: IO a -> m a-    unsafeInterleaveM :: m a -> m a-    -instance UnsafeIOToM IO where-    unsafeIOToM = id-    {-# INLINE unsafeIOToM #-}-    -    unsafeInterleaveM = unsafeInterleaveIO-    {-# INLINE unsafeInterleaveM #-}--instance UnsafeIOToM (ST s) where-    unsafeIOToM = unsafeIOToST-    {-# INLINE unsafeIOToM #-}--    unsafeInterleaveM = unsafeInterleaveST-    {-# INLINE unsafeInterleaveM #-}
+ COPYING view
@@ -0,0 +1,30 @@+Copyright (c) Patrick Perry <patperry@stanford.edu> 2008++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.
− Data/Matrix/Banded.hs 
@@ -1,49 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded (-    module Data.Matrix.Banded.Internal,-    -    -- * Converting between mutable and immutable banded matrices-    UnsafeFreezeBanded(..),-    UnsafeThawBanded(..),-    freezeBanded,-    thawBanded,-    ) where--import BLAS.Elem-import Data.Matrix.Banded.Internal hiding ( B )-import qualified Data.Matrix.Banded.Internal as I-import Data.Matrix.Banded.ST-import Data.Matrix.Banded.IO--class UnsafeFreezeBanded a where-    unsafeFreezeBanded :: a mn e -> Banded mn e-instance UnsafeFreezeBanded IOBanded where-    unsafeFreezeBanded = I.B-instance UnsafeFreezeBanded (STBanded s) where-    unsafeFreezeBanded = unsafeFreezeBanded . unsafeSTBandedToIOBanded    -    -class UnsafeThawBanded a where-    unsafeThawBanded :: Banded mn e -> a mn e-instance UnsafeThawBanded IOBanded where-    unsafeThawBanded (I.B a) = a-instance UnsafeThawBanded (STBanded s) where-    unsafeThawBanded = unsafeIOBandedToSTBanded . unsafeThawBanded-    -freezeBanded :: (ReadBanded a x m, WriteBanded b y m, UnsafeFreezeBanded b, BLAS1 e) =>-    a mn e -> m (Banded mn e)-freezeBanded x = do-    x' <- newCopyBanded x-    return (unsafeFreezeBanded x')--thawBanded :: (WriteBanded a y m, BLAS1 e) =>-    Banded mn e -> m (a mn e)-thawBanded = newCopyBanded
− Data/Matrix/Banded/Class.hs 
@@ -1,49 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.Class--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.Class (-    -- * The banded matrix type classes-    BaseBanded(..),-    ReadBanded,-    WriteBanded,-        -    -- * Banded matrix shape-    module BLAS.Tensor.Base,-    module BLAS.Matrix.Base,-    coerceBanded,-    -    -- * Bandwidth-    numLower,-    numUpper,-    bandwidth,--    module Data.Matrix.Banded.Class.Creating,-    module Data.Matrix.Banded.Class.Elements,-    module Data.Matrix.Banded.Class.Special,-    module Data.Matrix.Banded.Class.Views,-    module Data.Matrix.Banded.Class.Copying,-    -    -- * Low-level functions-    ldaOfBanded,-    isHermBanded,-    withBandedPtr,-    withBandedElemPtr,-    -    ) where--import Data.Matrix.Banded.Class.Internal( BaseBanded(..), ReadBanded, -    WriteBanded, numLower, numUpper, bandwidth, ldaOfBanded, isHermBanded,-    coerceBanded, withBandedPtr, withBandedElemPtr )-import BLAS.Tensor.Base-import BLAS.Matrix.Base hiding ( BaseMatrix )-import Data.Matrix.Banded.Class.Creating-import Data.Matrix.Banded.Class.Elements-import Data.Matrix.Banded.Class.Special-import Data.Matrix.Banded.Class.Views-import Data.Matrix.Banded.Class.Copying
− Data/Matrix/Banded/Class/Copying.hs 
@@ -1,86 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.Class.Copying--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.Class.Copying (-    -- * Copying Banded matrices-    newCopyBanded,-    copyBanded,-    unsafeCopyBanded,-    ) where--import BLAS.C.Level1( BLAS1 )-import qualified BLAS.C.Level1 as BLAS-import BLAS.Matrix-import BLAS.UnsafeIOToM--import Control.Monad( zipWithM_ )-import Data.Ix( range )-import Foreign( advancePtr )--import Data.Matrix.Banded.Class.Internal-import Data.Matrix.Banded.Class.Views-import Data.Vector.Dense.Class( unsafeCopyVector )--newCopyBanded :: (BLAS1 e, ReadBanded a x m, WriteBanded b y m) => -    a mn e -> m (b mn e)-newCopyBanded a -    | isHermBanded a =-        newCopyBanded ((herm . coerceBanded) a) >>= -            return . coerceBanded . herm-    | otherwise = do-        a' <- newBanded_ (shapeBanded a) (numLower a, numUpper a)-        unsafeCopyBanded a' a-        return a'--copyBanded :: (BLAS1 e, WriteBanded b y m, ReadBanded a x m) =>-    b mn e -> a mn e -> m ()-copyBanded dst src-    | shapeBanded dst /= shapeBanded src =-        error "Shape mismatch in copyBanded."-    | bandwidth dst /= bandwidth src =-        error "Bandwidth mismatch in copyBanded."-    | otherwise =-        unsafeCopyBanded dst src--unsafeCopyBanded :: (BLAS1 e, WriteBanded b y m, ReadBanded a x m) =>-    b mn e -> a mn e -> m ()-unsafeCopyBanded dst src-    | isHermBanded dst = -        unsafeCopyBanded ((herm . coerceBanded) dst) -                         ((herm . coerceBanded) src)-                         -    | (not . isHermBanded) src =-        unsafeIOToM $-        withBandedPtr dst $ \pDst ->-        withBandedPtr src $ \pSrc ->-            if ldDst == m && ldSrc == m-                then copyBlock pDst pSrc-                else copyCols  pDst pSrc n-                -    | otherwise =-        zipWithM_ unsafeCopyVector (diagViews dst) (diagViews src)-        -  where-    m     = numLower dst + numUpper dst + 1 -- we can be sure dst is not herm-    n     = numCols dst-    ldDst = ldaOfBanded dst-    ldSrc = ldaOfBanded src--    copyBlock pDst pSrc =-        BLAS.copy (m*n) pSrc 1 pDst 1--    copyCols pDst pSrc nleft-        | nleft == 0 = return ()-        | otherwise = do-            BLAS.copy m pSrc 1 pDst 1-            copyCols (pDst `advancePtr` ldDst) (pSrc `advancePtr` ldSrc) -                     (nleft-1)--    diagViews a = map (unsafeDiagViewBanded a) $ (range . bandwidth) a-
− Data/Matrix/Banded/Class/Creating.hs 
@@ -1,60 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.Class.Creating--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.Class.Creating (-    -- * Creating banded matrices-    newBanded,-    newListsBanded,-    unsafeNewBanded,-    ) where--import Control.Monad-import Foreign--import BLAS.Elem( Elem )-import BLAS.Internal( clearArray )-import BLAS.Tensor( writeElem, unsafeWriteElem )-import BLAS.UnsafeIOToM--import Data.Vector.Dense.Class( dim )--import Data.Matrix.Banded.Class.Internal-import Data.Matrix.Banded.Class.Views---newBanded :: (WriteBanded a x m, Elem e) => -    (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> m (a mn e)-newBanded = newBandedHelp writeElem--unsafeNewBanded :: (WriteBanded a x m, Elem e) => -    (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> m (a mn e)-unsafeNewBanded = newBandedHelp unsafeWriteElem--newBandedHelp :: (WriteBanded a x m, Elem e) => -       (a mn e -> (Int,Int) -> e -> m ()) -    -> (Int,Int) -> (Int,Int) -> [((Int,Int),e)] -> m (a mn e)-newBandedHelp set (m,n) (kl,ku) ijes = do-    x <- newBanded_ (m,n) (kl,ku)-    unsafeIOToM $ withBandedPtr x $ flip clearArray ((kl+1+ku)*n)-    mapM_ (uncurry $ set x) ijes-    return x--newListsBanded :: (WriteBanded a x m, Elem e) => -    (Int,Int) -> (Int,Int) -> [[e]] -> m (a mn e)-newListsBanded (m,n) (kl,ku) xs = do-    a <- newBanded_ (m,n) (kl,ku)-    zipWithM_ (writeDiagElems a) [(negate kl)..ku] xs-    return a-  where-    writeDiagElems a i es =-        let d   = diagViewBanded a i-            nb  = max 0 (negate i)-            es' = drop nb es-        in zipWithM_ (unsafeWriteElem d) [0..(dim d - 1)] es'-
− Data/Matrix/Banded/Class/Elements.hs 
@@ -1,17 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.Class.Elements--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.Class.Elements (-    -- * Reading and writing matrix elements-    module BLAS.Tensor.Read,-    module BLAS.Tensor.Write,-    ) where--import BLAS.Tensor.Read-import BLAS.Tensor.Write
− Data/Matrix/Banded/Class/Internal.hs 
@@ -1,558 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.Class.Internal--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.Class.Internal (-    -- * Banded matrix types-    IOBanded,-    STBanded,-    unsafeIOBandedToSTBanded,-    unsafeSTBandedToIOBanded,--    -- * Banded type classes-    BaseBanded(..),-    ReadBanded,-    WriteBanded,--    -- * Low-level Banded properties-    bandedViewMatrix,-    matrixFromBanded,-    ldaOfBanded,-    isHermBanded,-    hermBanded,--    -- * Bandwidth properties-    bandwidth,-    numLower,-    numUpper,--    -- * Coercing the Banded shape-    coerceBanded,--    -- * WriteTensor functions-    newBanded_,-    newZeroBanded,-    setZeroBanded,-    newConstantBanded,-    setConstantBanded,-    modifyWithBanded,-    canModifyElemBanded,-    unsafeWriteElemBanded,--    -- * Vector views-    unsafeRowViewBanded,-    unsafeColViewBanded,-    unsafeGetRowBanded,-    unsafeGetColBanded,-    -    -- * Utility functions-    shapeBanded,-    boundsBanded,-    withBandedPtr,-    withBandedElemPtr,-    indexOfBanded,-    indicesBanded,-    gbmv,-    gbmm,-    -    ) where--import Control.Monad-import Control.Monad.ST-import Data.Ix-import Data.List( foldl' )-import Foreign-import Unsafe.Coerce--import BLAS.Elem-import BLAS.C.Types-import qualified BLAS.C.Level2 as BLAS-import BLAS.Internal( diagLen )-import BLAS.UnsafeIOToM--import BLAS.Matrix.Base hiding ( BaseMatrix )-import qualified BLAS.Matrix.Base as BLAS-import BLAS.Matrix.Mutable--import BLAS.Tensor--import Data.Vector.Dense.Class.Internal( IOVector, STVector,-    BaseVector(..), ReadVector, WriteVector, doConjVector,-    withVectorPtr, stride, isConj )-import Data.Vector.Dense.Class.Creating( newListVector )-import Data.Vector.Dense.Class.Operations( getConjVector )--import Data.Matrix.Dense.Class( BaseMatrix, ReadMatrix, WriteMatrix,-    isHermMatrix, arrayFromMatrix, matrixViewArray, colViews )---class (BLAS.BaseMatrix a, BaseVector x) => -    BaseBanded a x | a -> x where-        bandedViewArray :: ForeignPtr e -> Ptr e -> Int -> Int -> Int -> Int -> Int -> Bool -> a mn e-        arrayFromBanded :: a mn e -> (ForeignPtr e, Ptr e, Int, Int, Int, Int, Int, Bool)--class (UnsafeIOToM m, ReadTensor a (Int,Int) m, -           BaseBanded a x, ReadVector x m) => -    ReadBanded a x m | a -> x where--class (WriteTensor a (Int,Int) m,-           WriteVector x m, ReadBanded a x m) => -    WriteBanded a x m | a -> m, m -> a, a -> x where---------------------------- Basic Banded Properties -----------------------------withBandedPtr :: (BaseBanded a x, Storable e) => -    a mn e -> (Ptr e -> IO b) -> IO b-withBandedPtr a f =-    let (fp,p,_,_,_,_,_,_) = arrayFromBanded a-    in do-        b <- f p-        touchForeignPtr fp-        return b--size1 :: (BaseBanded a x) => a mn e -> Int-size1 a = let (_,_,m,_,_,_,_,_) = arrayFromBanded a in m-{-# INLINE size1  #-}--size2 :: (BaseBanded a x) => a mn e -> Int-size2 a = let (_,_,_,n,_,_,_,_) = arrayFromBanded a in n-{-# INLINE size2 #-}--lowBW :: (BaseBanded a x) => a mn e -> Int-lowBW a = let (_,_,_,_,kl,_,_,_) = arrayFromBanded a in kl-{-# INLINE lowBW  #-}--upBW :: (BaseBanded a x) => a mn e -> Int-upBW a = let (_,_,_,_,_,ku,_,_) = arrayFromBanded a in ku-{-# INLINE upBW #-}--ldaOfBanded :: (BaseBanded a x) => a mn e -> Int-ldaOfBanded a = let (_,_,_,_,_,_,l,_) = arrayFromBanded a in l-{-# INLINE ldaOfBanded #-}--isHermBanded :: (BaseBanded a x) => a mn e -> Bool-isHermBanded a = let (_,_,_,_,_,_,_,h) = arrayFromBanded a in h-{-# INLINE isHermBanded #-}--matrixFromBanded :: (BaseBanded b x, BaseMatrix a x) => -    b mn e -> ((Int,Int), (Int,Int), a mn' e, Bool)-matrixFromBanded b =-    let (f,p,m,n,kl,ku,ld,h) = arrayFromBanded b-        a = matrixViewArray f p (kl+1+ku) n ld False-    in ((m,n), (kl,ku), a, h)--bandedViewMatrix :: (BaseMatrix a x, BaseBanded b x) => -    (Int,Int) -> (Int,Int) -> a mn e -> Bool -> Maybe (b mn' e)-bandedViewMatrix (m,n) (kl,ku) a h = -    if isHermMatrix a -        then Nothing-        else let (f,p,m',n',ld,_) = arrayFromMatrix a-             in case undefined of-                 _ | m' /= kl+1+ku -> -                     error $ "bandedViewMatrix:"-                        ++ " number of rows must be equal to number of diagonals"-                 _ | n' /= n ->-                     error $ "bandedViewMatrix:"-                        ++ " numbers of columns must be equal"-                 _ ->-                     Just $ bandedViewArray f p m n kl ku ld h--bandwidth :: (BaseBanded a x) => a mn e -> (Int,Int)-bandwidth a =-    let (kl,ku) = (numLower a, numUpper a)-    in (negate kl, ku)-{-# INLINE bandwidth #-}--numLower :: (BaseBanded a x) =>  a mn e -> Int-numLower a | isHermBanded a = upBW a-           | otherwise      = lowBW a-{-# INLINE numLower #-}--numUpper :: (BaseBanded a x) =>  a mn e -> Int-numUpper a | isHermBanded a = lowBW a-           | otherwise      = upBW a-{-# INLINE numUpper #-}----- | Cast the shape type of the matrix.-coerceBanded :: (BaseBanded a x) => a mn e -> a mn' e-coerceBanded = unsafeCoerce-{-# INLINE coerceBanded #-}----------------------------- BaseTensor functions -------------------------------shapeBanded :: (BaseBanded a x) => a mn e -> (Int,Int)-shapeBanded a | isHermBanded a = (size2 a, size1 a)-              | otherwise      = (size1 a, size2 a)-{-# INLINE shapeBanded #-}--boundsBanded :: (BaseBanded a x) => a mn e -> ((Int,Int), (Int,Int))-boundsBanded a = ((0,0), (m-1,n-1)) where (m,n) = shapeBanded a-{-# INLINE boundsBanded #-}----------------------------- BaseMatrix functions -------------------------------hermBanded :: (BaseBanded a x) => a (m,n) e -> a (n,m) e-hermBanded a = let (f,p,m,n,kl,ku,l,h) = arrayFromBanded a-               in bandedViewArray f p m n kl ku l (not h)-{-# INLINE hermBanded #-}----------------------------- ReadTensor functions -------------------------------getSizeBanded :: (ReadBanded a x m) => a mn e -> m Int-getSizeBanded = return . sizeBanded-{-# INLINE getSizeBanded #-}--getIndicesBanded :: (ReadBanded a x m) => a mn e -> m [(Int,Int)]-getIndicesBanded = return . indicesBanded-{-# INLINE getIndicesBanded #-}--getElemsBanded :: (ReadBanded a x m, Elem e) => a mn e -> m [e]-getElemsBanded a = getAssocsBanded a >>= return . (map snd)--getAssocsBanded :: (ReadBanded a x m, Elem e) => a mn e -> m [((Int,Int),e)]-getAssocsBanded a = do-    is <- getIndicesBanded a-    unsafeInterleaveM $ mapM (\i -> unsafeReadElem a i >>= \e -> return (i,e)) is-    -getIndicesBanded' :: (ReadBanded a x m) => a mn e -> m [(Int,Int)]-getIndicesBanded' = getIndicesBanded-{-# INLINE getIndicesBanded' #-}--getElemsBanded' :: (ReadBanded a x m, Elem e) => a mn e -> m [e]-getElemsBanded' a = getAssocsBanded' a >>= return . (map snd)--getAssocsBanded' :: (ReadBanded a x m, Elem e) => a mn e -> m [((Int,Int),e)]-getAssocsBanded' a = do-    is <- getIndicesBanded a-    mapM (\i -> unsafeReadElem a i >>= \e -> return (i,e)) is--unsafeReadElemBanded :: (ReadBanded a x m, Elem e) => a mn e -> (Int,Int) -> m e-unsafeReadElemBanded a (i,j)-    | isHermBanded a = -        unsafeReadElemBanded (hermBanded $ coerceBanded a) (j,i) -        >>= return . conj-    | hasStorageBanded a (i,j) =-        unsafeIOToM $-            withBandedElemPtr a (i,j) peek-    | otherwise =-        return 0-{-# INLINE unsafeReadElemBanded #-}---------------------------- WriteTensor functions --------------------------------- | Create a new banded matrix of given shape and (lower,upper), bandwidths,--- but do not initialize the elements.-newBanded_ :: (WriteBanded a x m, Elem e) => (Int,Int) -> (Int,Int) -> m (a mn e)-newBanded_ (m,n) (kl,ku)-    | m < 0 || n < 0 =-        err "dimensions must be non-negative."-    | kl < 0 =-        err "lower bandwdth must be non-negative."-    | m /= 0 && kl >= m =-        err "lower bandwidth must be less than m."-    | ku < 0 =-        err "upper bandwidth must be non-negative."-    | n /= 0 && ku >= n =-        err "upper bandwidth must be less than n."-    | otherwise =-        let m'  = kl + 1 + ku-            l   = m'-            h   = False-        in unsafeIOToM $ do    -            fp <- mallocForeignPtrArray (m' * n)-            let p = unsafeForeignPtrToPtr fp-            return $ bandedViewArray fp p m n kl ku l h-    where-      err s = fail $ "newBanded_ " ++ show (m,n) ++ " " ++ show (kl,ku) ++ ": " ++ s-                  --- | Create a zero banded matrix of the specified shape and bandwidths.-newZeroBanded :: (WriteBanded a x m, Elem e) => (Int,Int) -> (Int,Int) -> m (a mn e)-newZeroBanded mn bw = do-    a <- newBanded_ mn bw-    setZeroBanded a-    return a---- | Create a constant banded matrix of the specified shape and bandwidths.-newConstantBanded :: (WriteBanded a x m, Elem e) => (Int,Int) -> (Int,Int) -> e -> m (a mn e)-newConstantBanded mn bw e = do-    a <- newBanded_ mn bw-    setConstantBanded e a-    return a--setZeroBanded :: (WriteBanded a x m, Elem e) => a mn e -> m ()    -setZeroBanded = setConstantBanded 0--setConstantBanded :: (WriteBanded a x m, Elem e) => e -> a mn e -> m ()-setConstantBanded e a-    | isHermBanded a = setConstantBanded (conj e) a'-    | otherwise = do-        is <- getIndicesBanded a-        mapM_ (\i -> unsafeWriteElemBanded a i e) is-  where-    a' = (hermBanded . coerceBanded) a--unsafeWriteElemBanded :: (WriteBanded a x m, Elem e) => -    a mn e -> (Int,Int) -> e -> m ()-unsafeWriteElemBanded a (i,j) e-    | isHermBanded a  = unsafeWriteElemBanded a' (j,i) $ conj e-    | otherwise = unsafeIOToM $-                      withBandedElemPtr a (i,j) (`poke` e)-  where-    a' = (hermBanded . coerceBanded) a--modifyWithBanded :: (WriteBanded a x m, Elem e) => (e -> e) -> a mn e -> m ()-modifyWithBanded f a = do-    ies <- getAssocsBanded a-    mapM_ (\(ij,e) -> unsafeWriteElemBanded a ij (f e)) ies--canModifyElemBanded :: (WriteBanded a x m) => a mn e -> (Int,Int) -> m Bool-canModifyElemBanded a ij = return $ hasStorageBanded a ij-{-# INLINE canModifyElemBanded #-}--------------------------------- Vector views -----------------------------------unsafeRowViewBanded :: (BaseBanded a x, Storable e) => -    a mn e -> Int -> (Int, x k e, Int)-unsafeRowViewBanded a i =-    if h then-        case unsafeColViewBanded a' i of (nb, v, na) -> (nb, conj v, na)        -    else-        let nb  = max (i - kl)         0-            na  = max (n - 1 - i - ku) 0-            r   = min (ku + i)         (kl + ku)-            c   = max (i - kl)         0 -            p'  = p `advancePtr` (r + c * ld)-            inc = ld - 1-            len = n - (nb + na)-        in if len >= 0 -            then (nb, vectorViewArray f p' len inc False, na)-            else (n , vectorViewArray f p' 0   inc False,  0)-  where-    (f,p,_,n,kl,ku,ld,h) = arrayFromBanded a-    a' = (hermBanded . coerceBanded) a--unsafeColViewBanded :: (BaseBanded a x, Storable e) => -    a mn e -> Int -> (Int, x k e, Int)-unsafeColViewBanded a j =-    if h then-        case unsafeRowViewBanded a' j of (nb, v, na) -> (nb, conj v, na)-    else-        let nb  = max (j - ku)         0-            na  = max (m - 1 - j - kl) 0-            r   = max (ku - j) 0 -            c   = j -            p'  = p `advancePtr` (r + c * ld)-            inc = 1-            len = m - (nb + na)-        in if len >= 0-            then (nb, vectorViewArray f p' len inc False, na)-            else (m , vectorViewArray f p' 0   inc False,  0)-  where-    (f,p,m,_,kl,ku,ld,h) = arrayFromBanded a-    a' = (hermBanded . coerceBanded) a--unsafeGetRowBanded :: (ReadBanded a x m, WriteVector y m, Elem e) => -    a (k,l) e -> Int -> m (y l e)-unsafeGetRowBanded a i = -    let (nb,x,na) = unsafeRowViewBanded a i-        n = numCols a-    in do-        es <- getElems x-        newListVector n $ (replicate nb 0) ++ es ++ (replicate na 0)--unsafeGetColBanded :: (ReadBanded a x m, WriteVector y m, Elem e) => -    a (k,l) e -> Int -> m (y k e)-unsafeGetColBanded a j = unsafeGetRowBanded (hermBanded a) j >>= return . conj----------------------------- Matrix multiplication -------------------------------- | @gbmv alpha a x beta y@ replaces @y := alpha a * x + beta y@-gbmv :: (ReadBanded a z m, ReadVector x m, WriteVector y m, BLAS2 e) => -    e -> a (k,l) e -> x l e -> e -> y k e -> m ()-gbmv alpha a x beta y-    | numRows a == 0 || numCols a == 0 =-        scaleBy beta y-    | isConj x = do-        x' <- getConjVector (conj x)-        gbmv alpha a x' beta y-    | isConj y = do-        doConjVector y-        gbmv alpha a x beta (conj y)-        doConjVector y-    | otherwise =-        let order  = colMajor-            transA = blasTransOf a-            (m,n)  = case (isHermBanded a) of-                         False -> shape a-                         True  -> (flipShape . shape) a-            (kl,ku) = case (isHermBanded a) of-                          False -> (numLower a, numUpper a)-                          True  -> (numUpper a, numLower a)-            ldA    = ldaOfBanded a-            incX   = stride x-            incY   = stride y-        in unsafeIOToM $-               withBandedPtr a $ \pA ->-               withVectorPtr x $ \pX ->-               withVectorPtr y $ \pY -> do-                   BLAS.gbmv order transA m n kl ku alpha pA ldA pX incX beta pY incY---- | @gbmm alpha a b beta c@ replaces @c := alpha a * b + beta c@.-gbmm :: (ReadBanded a x m, ReadMatrix b y m, WriteMatrix c z m, BLAS2 e) => -    e -> a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-gbmm alpha a b beta c =-    sequence_ $-        zipWith (\x y -> gbmv alpha a x beta y) (colViews b) (colViews c)----------------------------- Utility functions ---------------------------------withBandedElemPtr :: (BaseBanded a x, Storable e) => -    a mn e -> (Int,Int) -> (Ptr e -> IO b) -> IO b-withBandedElemPtr a (i,j) f-    | isHermBanded a  = withBandedElemPtr (hermBanded $ coerceBanded a) (j,i) f-    | otherwise = withBandedPtr a $ \ptr ->-                      f $ ptr `advancePtr` (indexOfBanded a (i,j))--indexOfBanded :: (BaseBanded a x) => a mn e -> (Int,Int) -> Int-indexOfBanded a (i,j) =-    let (_,_,_,_,_,ku,ld,h) = arrayFromBanded a-        (i',j')           = if h then (j,i) else (i,j)-    in ku + (i' - j') + j' * ld--hasStorageBanded :: (BaseBanded a x) => a mn e -> (Int,Int) -> Bool-hasStorageBanded a (i,j) =-    let (_,_,m,_,kl,ku,_,h) = arrayFromBanded a-        (i',j')             = if h then (j,i) else (i,j)-    in inRange (max 0 (j'-ku), min (m-1) (j'+kl)) i'--sizeBanded :: (BaseBanded a x) => a mn e -> Int-sizeBanded a =-    let (_,_,m,n,kl,ku,_,_) = arrayFromBanded a-    in foldl' (+) 0 $ map (diagLen (m,n)) [(-kl)..ku]--indicesBanded :: (BaseBanded a x) => a mn e -> [(Int,Int)]-indicesBanded a =-    let is = if isHermBanded a -                 then [ (i,j) | i <- range (0,m-1), j <- range (0,n-1) ]-                 else [ (i,j) | j <- range (0,n-1), i <- range (0,m-1) ]-    in filter (hasStorageBanded a) is-  where (m,n) = shapeBanded a--blasTransOf :: (BaseBanded a x) => a mn e -> CBLASTrans-blasTransOf a = -    case (isHermBanded a) of-          False -> noTrans-          True  -> conjTrans--flipShape :: (Int,Int) -> (Int,Int)-flipShape (m,n) = (n,m)--------------------------------------- Instances ---------------------------------- | The Banded matrix data type.-data IOBanded mn e =-    BM {-# UNPACK #-} !(ForeignPtr e) -- storage-       {-# UNPACK #-} !(Ptr e)        -- base pointer-       {-# UNPACK #-} !Int            -- numer of rows-       {-# UNPACK #-} !Int            -- number of columns-       {-# UNPACK #-} !Int            -- lower bandwidth-       {-# UNPACK #-} !Int            -- upper bandwidth-       {-# UNPACK #-} !Int            -- lda of storage-       {-# UNPACK #-} !Bool           -- isHerm flag--newtype STBanded s mn e = ST (IOBanded mn e)--unsafeIOBandedToSTBanded :: IOBanded mn e -> STBanded s mn e-unsafeIOBandedToSTBanded = ST--unsafeSTBandedToIOBanded :: STBanded s mn e -> IOBanded mn e-unsafeSTBandedToIOBanded (ST x) = x--instance BaseBanded IOBanded IOVector where-    bandedViewArray f p m n kl ku ld h      = BM f p m n kl ku ld h-    arrayFromBanded (BM f p m n kl ku ld h) = (f,p,m,n,kl,ku,ld,h)--instance BaseBanded (STBanded s) (STVector s) where-    bandedViewArray f p m n kl ku ld h           = ST (BM f p m n kl ku ld h)-    arrayFromBanded (ST (BM f p m n kl ku ld h)) = (f,p,m,n,kl,ku,ld,h)--instance BaseTensor IOBanded (Int,Int) where-    shape  = shapeBanded-    bounds = boundsBanded-    -instance BaseTensor (STBanded s) (Int,Int) where-    shape  = shapeBanded-    bounds = boundsBanded--instance BLAS.BaseMatrix IOBanded where-    herm = hermBanded-    -instance BLAS.BaseMatrix (STBanded s) where-    herm = hermBanded--instance ReadBanded IOBanded     IOVector     IO-instance ReadBanded (STBanded s) (STVector s) (ST s)--instance ReadTensor IOBanded (Int,Int) IO where-    getSize        = getSizeBanded-    getAssocs      = getAssocsBanded-    getIndices     = getIndicesBanded-    getElems       = getElemsBanded-    getAssocs'     = getAssocsBanded'-    getIndices'    = getIndicesBanded'-    getElems'      = getElemsBanded'-    unsafeReadElem = unsafeReadElemBanded-    -instance ReadTensor (STBanded s) (Int,Int) (ST s) where-    getSize        = getSizeBanded-    getAssocs      = getAssocsBanded-    getIndices     = getIndicesBanded-    getElems       = getElemsBanded-    getAssocs'     = getAssocsBanded'-    getIndices'    = getIndicesBanded'-    getElems'      = getElemsBanded'-    unsafeReadElem = unsafeReadElemBanded--instance WriteBanded IOBanded IOVector IO where-instance WriteBanded (STBanded s) (STVector s) (ST s) where--instance WriteTensor IOBanded (Int,Int) IO where-    setConstant     = setConstantBanded-    setZero         = setZeroBanded-    modifyWith      = modifyWithBanded-    unsafeWriteElem = unsafeWriteElemBanded-    canModifyElem   = canModifyElemBanded--instance WriteTensor (STBanded s) (Int,Int) (ST s) where-    setConstant     = setConstantBanded-    setZero         = setZeroBanded-    modifyWith      = modifyWithBanded-    unsafeWriteElem = unsafeWriteElemBanded-    canModifyElem   = canModifyElemBanded--instance (BLAS2 e) => MMatrix IOBanded e IO where-    unsafeDoSApplyAdd    = gbmv-    unsafeDoSApplyAddMat = gbmm-    unsafeGetRow         = unsafeGetRowBanded-    unsafeGetCol         = unsafeGetColBanded--instance (BLAS2 e) => MMatrix (STBanded s) e (ST s) where-    unsafeDoSApplyAdd    = gbmv-    unsafeDoSApplyAddMat = gbmm-    unsafeGetRow         = unsafeGetRowBanded-    unsafeGetCol         = unsafeGetColBanded
− Data/Matrix/Banded/Class/Special.hs 
@@ -1,19 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.Class.Special--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.Class.Special (-    -- * Special banded matrices-    newZeroBanded,-    setZeroBanded,-    newConstantBanded,-    setConstantBanded,-    ) where--import Data.Matrix.Banded.Class.Internal-
− Data/Matrix/Banded/Class/Views.hs 
@@ -1,53 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.Class.Views--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.Class.Views (-    -- * Row and column views-    diagViewBanded,-    rowViewBanded,-    colViewBanded,-    -    unsafeDiagViewBanded,-    unsafeRowViewBanded,-    unsafeColViewBanded,-    -    ) where--import BLAS.Internal( checkedRow, checkedCol, checkedDiag, diagStart, diagLen )--import Data.Matrix.Banded.Class.Internal-import Data.Vector.Dense.Class-import Foreign--diagViewBanded :: (BaseBanded a x, Storable e) => -    a mn e -> Int -> x k e-diagViewBanded a = checkedDiag (shape a) (unsafeDiagViewBanded a) --rowViewBanded :: (BaseBanded a x, Storable e) => -    a mn e -> Int -> (Int, x k e, Int)-rowViewBanded a = checkedRow (shape a) (unsafeRowViewBanded a) --colViewBanded :: (BaseBanded a x, Storable e) => -    a mn e -> Int -> (Int, x k e, Int)-colViewBanded a = checkedCol (shape a) (unsafeColViewBanded a)--unsafeDiagViewBanded :: (BaseBanded a x, Storable e) => -    a mn e -> Int -> x k e-unsafeDiagViewBanded a d-    | isHermBanded a = conj $ unsafeDiagViewBanded a' (negate d)-    | otherwise =-        let (fp,p,m,n,_,_,ld,_) = arrayFromBanded a-            off = indexOfBanded a (diagStart d)-            p'  = p `advancePtr` off-            len = diagLen (m,n) d-            inc = ld-            c   = False-        in vectorViewArray fp p' len inc c-  where-    a' = (hermBanded . coerceBanded) a
− Data/Matrix/Banded/IO.hs 
@@ -1,18 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.IO--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.IO (-    -- * The IOBanded data type-    IOBanded,-    -    module Data.Matrix.Banded.Class,-    ) where--import Data.Matrix.Banded.Class.Internal( IOBanded )-import Data.Matrix.Banded.Class
− Data/Matrix/Banded/Internal.hs 
@@ -1,266 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC -fglasgow-exts #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.Internal--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.Internal (-    -- * Banded matrix type-    Banded(..),--    -- * Banded shape-    module BLAS.Tensor.Base,-    module BLAS.Matrix.Base,-    bandwidth,-    numLower,-    numUpper,-    coerceBanded,--    -- * Creating banded matrices-    banded,-    listsBanded,-    unsafeBanded,--    -- * Reading banded matrix elements-    module BLAS.Tensor.Immutable,-    -    -- * Special banded matrices-    zeroBanded,-    constantBanded,--    -- * Vector views-    diagBanded,-    unsafeDiagBanded,--    -- * Converting to lists-    listsFromBanded,--    -- * Low-level properties-    ldaOfBanded,-    isHermBanded,-    -    -- * Matrix and vector multiplication-    module BLAS.Matrix.Immutable,--    ) where--import Data.AEq-import System.IO.Unsafe---import BLAS.Internal ( diagLen, checkedDiag, inlinePerformIO )-import BLAS.Elem( BLAS1, BLAS2 )-import BLAS.Tensor.Base-import BLAS.Tensor.Immutable-import BLAS.Tensor.Read-import BLAS.UnsafeIOToM--import BLAS.Matrix.Base hiding ( BaseMatrix )-import BLAS.Matrix.Immutable-import BLAS.Matrix.Mutable-import qualified BLAS.Matrix.Base as BLAS--import Data.Ix( inRange, range )-import Data.Matrix.Banded.Class.Internal( BaseBanded(..), ReadBanded,-    IOBanded, coerceBanded, numLower, numUpper, bandwidth, isHermBanded,-    shapeBanded, boundsBanded, ldaOfBanded, gbmv, gbmm, unsafeGetRowBanded,-    unsafeGetColBanded )-import Data.Matrix.Banded.Class.Creating( newListsBanded, unsafeNewBanded, -    newBanded )-import Data.Matrix.Banded.Class.Elements( writeElem, unsafeWriteElem )-import Data.Matrix.Banded.Class.Special( newZeroBanded, newConstantBanded )-import Data.Matrix.Banded.Class.Views( unsafeDiagViewBanded )-import Data.Matrix.Banded.Class.Copying( newCopyBanded )--import Data.Vector.Dense( Vector, zeroVector )-import Data.Vector.Dense.ST( runSTVector )-import Data.Matrix.Dense.ST( runSTMatrix )--newtype Banded mn e = B (IOBanded mn e)--unsafeFreezeIOBanded :: IOBanded mn e -> Banded mn e-unsafeFreezeIOBanded = B--unsafeThawIOBanded :: Banded mn e -> IOBanded mn e-unsafeThawIOBanded (B a) = a---liftBanded :: (IOBanded mn e -> a) -> Banded mn e -> a-liftBanded f (B x) = f x-{-# INLINE liftBanded #-}----- liftBanded2 :: ---     (IOBanded mn e -> IOBanded mn e -> a) -> ---         Banded mn e -> Banded mn e -> a--- liftBanded2 f x = liftBanded (liftBanded f x)--- {-# INLINE liftBanded2 #-}--- --- unsafeLiftBanded :: (IOBanded mn e -> IO a) -> Banded mn e -> a--- unsafeLiftBanded f = unsafePerformIO . liftBanded f--- {-# NOINLINE unsafeLiftBanded #-}--- --- unsafeLiftBanded2 :: ---     (IOBanded mn e -> IOBanded mn e -> IO a) -> ---         Banded mn e -> Banded mn e -> a--- unsafeLiftBanded2 f x y = unsafePerformIO $ liftBanded2 f x y--- {-# NOINLINE unsafeLiftBanded2 #-}---inlineLiftBanded :: (IOBanded n e -> IO a) -> Banded n e -> a-inlineLiftBanded f = inlinePerformIO . liftBanded f-{-# INLINE inlineLiftBanded #-}---banded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> Banded (m,n) e-banded mn kl ijes = -    unsafeFreezeIOBanded $ unsafePerformIO $ newBanded mn kl ijes-{-# NOINLINE banded #-}--unsafeBanded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> Banded (m,n) e-unsafeBanded mn kl ijes = -    unsafeFreezeIOBanded $ unsafePerformIO $ unsafeNewBanded mn kl ijes-{-# NOINLINE unsafeBanded #-}--listsBanded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> [[e]] -> Banded (m,n) e-listsBanded mn kl xs = -    unsafeFreezeIOBanded $ unsafePerformIO $ newListsBanded mn kl xs-{-# NOINLINE listsBanded #-}--zeroBanded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> Banded (m,n) e-zeroBanded mn kl =-    unsafeFreezeIOBanded $ unsafePerformIO $ newZeroBanded mn kl-{-# NOINLINE zeroBanded #-}--constantBanded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> e -> Banded (m,n) e-constantBanded mn kl e =-    unsafeFreezeIOBanded $ unsafePerformIO $ newConstantBanded mn kl e-{-# NOINLINE constantBanded #-}---- | Get a the given diagonal in a banded matrix.  Negative indices correspond --- to sub-diagonals.-diagBanded :: (BLAS1 e) => Banded mn e -> Int -> Vector k e-diagBanded a = checkedDiag (shape a) (unsafeDiagBanded a)---- | Same as 'diagBanded' but index is not range-checked.-unsafeDiagBanded :: (BLAS1 e) => Banded mn e -> Int -> Vector k e-unsafeDiagBanded a i -    | inRange (bandwidth a) i = unsafeDiagViewBanded a i-    | otherwise               = zeroVector $ diagLen (shape a) i---instance BaseTensor Banded (Int,Int) where-    shape  = shapeBanded . unsafeThawIOBanded-    bounds = boundsBanded . unsafeThawIOBanded--instance ITensor Banded (Int,Int) where-    (//)          = replaceHelp writeElem-    unsafeReplace = replaceHelp unsafeWriteElem-    -    unsafeAt x i  = inlineLiftBanded (flip unsafeReadElem i) x-    {-# INLINE unsafeAt #-}-    -    size          = inlineLiftBanded getSize-    elems         = inlineLiftBanded getElems-    indices       = inlineLiftBanded getIndices-    assocs        = inlineLiftBanded getAssocs--    tmap f a      = coerceBanded $ listsBanded mn bw (map (map f) es)-      where (mn,bw,es) = listsFromBanded a--listsFromBanded :: (BLAS1 e) => Banded mn e -> ((Int,Int), (Int,Int),[[e]])-listsFromBanded a = ( (m,n)-            , (kl,ku)-            , map paddedDiag [(-kl)..ku]-            )-  where-    (m,n)   = shape a-    (kl,ku) = (numLower a, numUpper a)-    -    padBegin i   = replicate (max (-i) 0)    0-    padEnd   i   = replicate (max (m-n+i) 0) 0-    paddedDiag i = (  padBegin i-                   ++ elems (unsafeDiagViewBanded a i) -                   ++ padEnd i -                   )--replaceHelp :: (BLAS1 e) => -       (IOBanded mn e -> (Int,Int) -> e -> IO ())-    -> Banded mn e -> [((Int,Int), e)] -> Banded mn e-replaceHelp set x ies =-    unsafeFreezeIOBanded $ unsafePerformIO $ do-        y  <- newCopyBanded (unsafeThawIOBanded x)-        mapM_ (uncurry $ set y) ies-        return y-{-# NOINLINE replaceHelp #-}---instance (Monad m) => ReadTensor Banded (Int,Int) m where-    getSize        = return . size-    getAssocs      = return . assocs-    getIndices     = return . indices-    getElems       = return . elems-    getAssocs'     = getAssocs-    getIndices'    = getIndices-    getElems'      = getElems-    unsafeReadElem x i = return (unsafeAt x i)--instance BLAS.BaseMatrix Banded where-    herm (B a) = B (herm a)-    -instance BaseBanded Banded Vector where-    bandedViewArray f p m n kl ku l h = B $ bandedViewArray f p m n kl ku l h-    arrayFromBanded (B a )            = arrayFromBanded a--instance (UnsafeIOToM m) => ReadBanded Banded Vector m where--instance (BLAS2 e) => IMatrix Banded e where-    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x-    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    -    unsafeRow a i             = runSTVector $ unsafeGetRow a i-    unsafeCol a j             = runSTVector $ unsafeGetCol a j--instance (BLAS2 e, UnsafeIOToM m) => MMatrix Banded e m where-    unsafeDoSApplyAdd    = gbmv-    unsafeDoSApplyAddMat = gbmm-    unsafeGetRow         = unsafeGetRowBanded-    unsafeGetCol         = unsafeGetColBanded---instance (BLAS1 e) => Show (Banded mn e) where-    show a -        | isHermBanded a = -           "herm (" ++ show (herm $ coerceBanded a) ++ ")"-        | otherwise = -             let (mn,kl,es) = listsFromBanded a -             in "listsBanded " ++ show mn ++ " " ++ show kl ++ " " ++ show es--compareHelp :: (BLAS1 e) => -    (e -> e -> Bool) -> Banded mn e -> Banded mn e -> Bool-compareHelp cmp a b-    | shape a /= shape b =-        False-    | isHermBanded a == isHermBanded b && bandwidth a == bandwidth b =-        let elems' = if isHermBanded a then elems . herm .coerceBanded-                                       else elems-        in-            and $ zipWith cmp (elems' a) (elems' b)-    | otherwise =-        let l = max (numLower a) (numLower b)-            u = max (numUpper a) (numUpper b)-        in-            and $ zipWith cmp (diagElems (-l,u) a) (diagElems (-l,u) b)-  where-    diagElems bw c = concatMap elems [ diagBanded c i | i <- range bw ]--instance (BLAS1 e, Eq e) => Eq (Banded mn e) where-    (==) = compareHelp (==)--instance (BLAS1 e, AEq e) => AEq (Banded mn e) where-    (===) = compareHelp (===)-    (~==) = compareHelp (~==)
− Data/Matrix/Banded/ST.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances,-        Rank2Types #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Banded.ST--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Banded.ST (-    -- * The @STBanded@ data type-    STBanded,-    runSTBanded,--    unsafeIOBandedToSTBanded,-    unsafeSTBandedToIOBanded,--    module Data.Matrix.Banded.Class,-    ) where--import Control.Monad.ST--import Data.Matrix.Banded.Internal( Banded(..) )-import Data.Matrix.Banded.Class-import Data.Matrix.Banded.Class.Internal( STBanded, unsafeIOBandedToSTBanded,-    unsafeSTBandedToIOBanded )--runSTBanded :: (forall s . ST s (STBanded s mn e)) -> Banded mn e-runSTBanded x = runST $ x >>= return . B . unsafeSTBandedToIOBanded
− Data/Matrix/Dense.hs 
@@ -1,52 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense (-    module Data.Matrix.Dense.Internal,-    -    -- * Matrix and vector multiplication-    module BLAS.Matrix.Immutable,-    -    -- * Converting between mutable and immutable matrices-    UnsafeFreezeMatrix(..),-    UnsafeThawMatrix(..),-    freezeMatrix,-    thawMatrix,-    ) where--import BLAS.Elem-import Data.Matrix.Dense.Internal hiding ( M )-import qualified Data.Matrix.Dense.Internal as I-import Data.Matrix.Dense.ST-import Data.Matrix.Dense.IO-import BLAS.Matrix.Immutable--class UnsafeFreezeMatrix a where-    unsafeFreezeMatrix :: a mn e -> Matrix mn e-instance UnsafeFreezeMatrix IOMatrix where-    unsafeFreezeMatrix = I.M-instance UnsafeFreezeMatrix (STMatrix s) where-    unsafeFreezeMatrix = unsafeFreezeMatrix . unsafeSTMatrixToIOMatrix    -    -class UnsafeThawMatrix a where-    unsafeThawMatrix :: Matrix mn e -> a mn e-instance UnsafeThawMatrix IOMatrix where-    unsafeThawMatrix (I.M a) = a-instance UnsafeThawMatrix (STMatrix s) where-    unsafeThawMatrix = unsafeIOMatrixToSTMatrix . unsafeThawMatrix-    -freezeMatrix :: (ReadMatrix a x m, WriteMatrix b y m, UnsafeFreezeMatrix b, BLAS1 e) =>-    a mn e -> m (Matrix mn e)-freezeMatrix x = do-    x' <- newCopyMatrix x-    return (unsafeFreezeMatrix x')--thawMatrix :: (WriteMatrix a y m, BLAS1 e) =>-    Matrix mn e -> m (a mn e)-thawMatrix = newCopyMatrix
− Data/Matrix/Dense/Class.hs 
@@ -1,46 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Class--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Class (-    -- * The dense matrix type classes-    BaseMatrix(..),-    ReadMatrix,-    WriteMatrix,-    -    -- * Matrix shape-    module BLAS.Tensor.Base,-    module BLAS.Matrix.Base,-    coerceMatrix,--    module Data.Matrix.Dense.Class.Creating,-    module Data.Matrix.Dense.Class.Elements,-    module Data.Matrix.Dense.Class.Special,-    module Data.Matrix.Dense.Class.Views,-    module Data.Matrix.Dense.Class.Copying,-    module Data.Matrix.Dense.Class.Operations,-    module BLAS.Matrix.Mutable,-    -    -- * Low-level functions-    ldaOfMatrix,-    isHermMatrix,-    withMatrixPtr,-    -    ) where--import Data.Matrix.Dense.Class.Internal( BaseMatrix(..), ldaOfMatrix, -    isHermMatrix, ReadMatrix, WriteMatrix, coerceMatrix, withMatrixPtr )-import BLAS.Tensor.Base-import BLAS.Matrix.Base hiding ( BaseMatrix )-import BLAS.Matrix.Mutable-import Data.Matrix.Dense.Class.Creating-import Data.Matrix.Dense.Class.Elements-import Data.Matrix.Dense.Class.Special-import Data.Matrix.Dense.Class.Views-import Data.Matrix.Dense.Class.Copying-import Data.Matrix.Dense.Class.Operations
− Data/Matrix/Dense/Class/Copying.hs 
@@ -1,63 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Class.Copying--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Class.Copying (-    -- * Copying matrices-    newCopyMatrix,-    copyMatrix,-    swapMatrix,-    unsafeCopyMatrix,-    unsafeSwapMatrix,-    -    -- * Swapping rows and columns-    swapRows,-    swapCols,-    unsafeSwapRows,-    unsafeSwapCols,-    -    ) where--import BLAS.Elem-import BLAS.Internal( checkBinaryOp )--import Control.Monad( when )--import Data.Matrix.Dense.Class.Internal-import Data.Matrix.Dense.Class.Views-import Data.Vector.Dense.Class----- | @copyMatrix dst src@ replaces the values in @dst@ with those in--- source.  The operands must be the same shape.-copyMatrix :: (WriteMatrix b y m,  ReadMatrix a x m, BLAS1 e) => -    b mn e -> a mn e -> m ()-copyMatrix b a = checkBinaryOp (shape b) (shape a) $ unsafeCopyMatrix b a-{-# INLINE copyMatrix #-}---- | @swapMatrix x y@ swaps the values stored in two matrices.-swapMatrix :: (WriteMatrix a x m, BLAS1 e) => -    a mn e -> a mn e -> m ()-swapMatrix a b = checkBinaryOp (shape b) (shape a) $ unsafeSwapMatrix a b-{-# INLINE swapMatrix #-}--swapRows :: (WriteMatrix a x m, BLAS1 e) => a (r,s) e -> Int -> Int -> m ()-swapRows a i j = -    when (i /= j) $ unsafeSwapVector (rowView a i) (rowView a j)--swapCols :: (WriteMatrix a x m, BLAS1 e) => a (r,s) e -> Int -> Int -> m ()-swapCols a i j = -    when (i /= j) $ unsafeSwapVector (colView a i) (colView a j)--unsafeSwapRows :: (WriteMatrix a x m, BLAS1 e) => a (r,s) e -> Int -> Int -> m ()-unsafeSwapRows a i j = -    when (i /= j) $ unsafeSwapVector (unsafeRowView a i) (unsafeRowView a j)--unsafeSwapCols :: (WriteMatrix a x m, BLAS1 e) => a (r,s) e -> Int -> Int -> m ()-unsafeSwapCols a i j = -    when (i /= j) $ unsafeSwapVector (unsafeColView a i) (unsafeColView a j)
− Data/Matrix/Dense/Class/Creating.hs 
@@ -1,84 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Class.Creating--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Class.Creating (-    -- * Creating matrices-    newMatrix_,-    newMatrix,-    newListMatrix,-    newRowsMatrix,-    newColsMatrix,-    newRowMatrix,-    newColMatrix,-    unsafeNewMatrix,-    ) where--import Control.Monad( forM_ )-import Foreign( pokeArray )--import BLAS.Elem-import BLAS.UnsafeIOToM--import Data.Vector.Dense.Class-import Data.Matrix.Dense.Class.Internal----- | Creates a new matrix with the given association list.  Unspecified--- indices will get initialized to zero.-newMatrix :: (WriteMatrix a x m, Elem e) => -    (Int,Int) -> [((Int,Int), e)] -> m (a mn e)-newMatrix = newMatrixHelp writeElem---- | Same as 'newMatrix' but indices are not range-checked.-unsafeNewMatrix :: (WriteMatrix a x m, Elem e) => -    (Int,Int) -> [((Int,Int), e)] -> m (a mn e)-unsafeNewMatrix = newMatrixHelp unsafeWriteElem--newMatrixHelp :: (WriteMatrix a x m, Elem e) => -    (a mn e -> (Int,Int) -> e -> m ()) -> (Int,Int) -> [((Int,Int),e)] -> m (a mn e)-newMatrixHelp set n ies = do-    a <- newZeroMatrix n-    mapM_ (uncurry $ set a) ies-    return a---- | Create a new matrix with the given elements in column-major order.-newListMatrix :: (WriteMatrix a x m, Elem e) => (Int,Int) -> [e] -> m (a mn e)-newListMatrix (m,n) es = do-    a <- newZeroMatrix (m,n)-    unsafeIOToM $ withMatrixPtr a $ flip pokeArray (take (m*n) es)-    return a---- | Form a matrix from a list of column vectors.-newColsMatrix :: (ReadVector x m, WriteMatrix a y m, BLAS1 e) => -    (Int,Int) -> [x k e] -> m (a (k,l) e)-newColsMatrix (m,n) cs = do-    a <- newZeroMatrix (m,n)-    forM_ (zip [0..(n-1)] cs) $ \(j,c) ->-        copyVector (unsafeColView a j) c-    return a---- | Form a matrix from a list of row vectors.-newRowsMatrix :: (ReadVector x m, WriteMatrix a y m, BLAS1 e) => -    (Int,Int) -> [x l e] -> m (a (k,l) e)-newRowsMatrix (m,n) rs = do-    a <- newZeroMatrix (m,n)-    forM_ (zip [0..(m-1)] rs) $ \(i,r) ->-        copyVector (unsafeRowView a i) r-    return a---- | Create a new matrix from a column vector.-newColMatrix :: (ReadVector x m, WriteMatrix a y m, BLAS1 e) => -    x k e -> m (a (k,one) e)-newColMatrix x = newColsMatrix (dim x,1) [x]---- | Create a new matrix from a row vector.-newRowMatrix :: (ReadVector x m, WriteMatrix a y m, BLAS1 e) => -    x l e -> m (a (one,l) e)-newRowMatrix x = newRowsMatrix (1,dim x) [x]-
− Data/Matrix/Dense/Class/Elements.hs 
@@ -1,17 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Class.Elements--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Class.Elements (-    -- * Reading and writing matrixelements-    module BLAS.Tensor.Read,-    module BLAS.Tensor.Write,-    ) where--import BLAS.Tensor.Read-import BLAS.Tensor.Write
− Data/Matrix/Dense/Class/Internal.hs 
@@ -1,719 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Class.Internal--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Class.Internal (--    -- * Matrix types-    IOMatrix,-    STMatrix,-    unsafeIOMatrixToSTMatrix,-    unsafeSTMatrixToIOMatrix,--    -- * Matrix type classes-    BaseMatrix(..),-    ReadMatrix,-    WriteMatrix,-    -    -- * Basic matrix properties-    ldaOfMatrix,-    isHermMatrix,--    -- * Coercing the matrix shape-    coerceMatrix,--    -- * Converting to and from vectors-    maybeFromRow,-    maybeFromCol,-    maybeToVector,-    -    -- * Lifting vector operations-    liftMatrix,-    liftMatrix2,--    -- * BaseTensor functions-    shapeMatrix,-    boundsMatrix,-    -    -- * BaseMatrix functions-    hermMatrix,--    -- * ReadTensor functions-    getSizeMatrix,-    getAssocsMatrix,-    getIndicesMatrix,-    getElemsMatrix,-    getAssocsMatrix',-    getIndicesMatrix',-    getElemsMatrix',-    unsafeReadElemMatrix,--    -- * WriteTensor functions-    newMatrix_,-    newZeroMatrix,-    setZeroMatrix,-    newConstantMatrix,-    setConstantMatrix,-    modifyWithMatrix,-    canModifyElemMatrix,-    unsafeWriteElemMatrix,-    -    -- * CopyTensor functions-    newCopyMatrix,-    unsafeCopyMatrix,-    -    -- * SwapTensor functions-    unsafeSwapMatrix,--    -- * Vector views-    rowViews,-    colViews,-    unsafeRowView,-    unsafeColView,-    unsafeDiagView,-    unsafeGetRowMatrix,-    unsafeGetColMatrix,-    -    -- * Numeric functions-    doConjMatrix,-    scaleByMatrix,-    shiftByMatrix,-    -    -- * Numeric2 functions-    unsafeAxpyMatrix,-    unsafeMulMatrix,-    unsafeDivMatrix,-    -    -- * Numeric3 functions-    unsafeDoAddMatrix,-    unsafeDoSubMatrix,-    unsafeDoMulMatrix,-    unsafeDoDivMatrix,-    -    -- * ReadApply functions-    gemv,-    gemm,-    -    -- * Utility functions-    withMatrixPtr,-    indexOfMatrix,-    indicesMatrix,-    unsafeDoMatrixOp2,-    -    ) where--import Control.Monad-import Control.Monad.ST-import Data.Ix-import Foreign-import Unsafe.Coerce--import BLAS.Elem-import BLAS.C.Types-import qualified BLAS.C.Level2 as BLAS-import qualified BLAS.C.Level3 as BLAS-import BLAS.Internal( diagStart, diagLen )-import BLAS.UnsafeIOToM--import BLAS.Tensor--import Data.Vector.Dense.Class.Internal( IOVector, STVector,-    BaseVector(..), ReadVector, WriteVector, -    newCopyVector, unsafeCopyVector, unsafeSwapVector, -    doConjVector, scaleByVector, shiftByVector, unsafeAxpyVector, -    unsafeMulVector, unsafeDivVector, withVectorPtr, dim, stride, isConj )--import BLAS.Matrix.Base hiding ( BaseMatrix )-import qualified BLAS.Matrix.Base as BLAS---class (BLAS.BaseMatrix a, BaseVector x) => -    BaseMatrix a x | a -> x where-        matrixViewArray :: ForeignPtr e -> Ptr e -> Int -> Int -> Int -> Bool -> a mn e-        arrayFromMatrix :: a mn e -> (ForeignPtr e, Ptr e, Int, Int, Int, Bool)--class (UnsafeIOToM m, ReadTensor a (Int,Int) m, -           BaseMatrix a x, -           ReadVector x m) => -    ReadMatrix a x m | a -> x where--class (WriteTensor a (Int,Int) m,-           WriteVector x m, ReadMatrix a x m) => -    WriteMatrix a x m | a -> m, m -> a, a -> x where---------------------------- Basic Matrix Properties -----------------------------size1 :: (BaseMatrix a x) => a mn e -> Int-size1 a = let (_,_,m,_,_,_) = arrayFromMatrix a in m-{-# INLINE size1  #-}--size2 :: (BaseMatrix a x) => a mn e -> Int-size2 a = let (_,_,_,n,_,_) = arrayFromMatrix a in n-{-# INLINE size2 #-}--ldaOfMatrix :: (BaseMatrix a x) => a mn e -> Int-ldaOfMatrix a = let (_,_,_,_,l,_) = arrayFromMatrix a in l-{-# INLINE ldaOfMatrix #-}--isHermMatrix :: (BaseMatrix a x) => a mn e -> Bool-isHermMatrix a = let (_,_,_,_,_,h) = arrayFromMatrix a in h-{-# INLINE isHermMatrix #-}---- | Cast the shape type of the matrix.-coerceMatrix :: (BaseMatrix a x) => a mn e -> a mn' e-coerceMatrix = unsafeCoerce-{-# INLINE coerceMatrix #-}------------------------- Converting to/from Vectors ------------------------------ | Create a matrix view of a row vector.  This will fail if the--- vector is conjugated and the stride is not @1@.-maybeFromRow :: (BaseMatrix a x, BaseVector x) => -    x m e -> Maybe (a (one,m) e)-maybeFromRow x-    | c && s == 1 =-        Just $ matrixViewArray f p n 1 (max 1 n) True-    | not c =-        Just $ matrixViewArray f p 1 n s         False-    | otherwise =-        Nothing-  where-    (f,p,n,s,c) = arrayFromVector x---- | Possibly create a matrix view of a column vector.  This will fail--- if the stride of the vector is not @1@ and the vector is not conjugated.-maybeFromCol :: (BaseMatrix a x, BaseVector x) => -    x n e -> Maybe (a (n,one) e)-maybeFromCol x-    | c = maybeFromRow (conj x) >>= return . herm-    | s == 1 =-        Just $ matrixViewArray f p n 1 (max 1 n) False-    | otherwise =-        Nothing-  where-    (f,p,n,s,c) = arrayFromVector x--maybeToVector :: (BaseMatrix a x) => -    a mn e -> Maybe (x k e)-maybeToVector a-    | h = -        maybeToVector a' >>= return . conj-    | ld == m =-        Just $ vectorViewArray f p (m*n) 1  False-    | m == 1 =-        Just $ vectorViewArray f p n     ld False-    | otherwise =-        Nothing-  where-    a' = (coerceMatrix . herm . coerceMatrix) a-    (f,p,m,n,ld,h) = arrayFromMatrix a-------------------------- Lifting vector operations ------------------------------- | Take a unary elementwise vector operation and apply it to the elements--- of a matrix.-liftMatrix :: (Monad m, BaseMatrix a x, Storable e) =>-    (x k e -> m ()) -> a mn e -> m ()-liftMatrix f a =-    case maybeToVector a of-        Just x -> f x-        _ -> -            let xs  = case isHermMatrix a of-                          True  -> rowViews (coerceMatrix a)-                          False -> colViews (coerceMatrix a)-            in mapM_ f xs---- | Take a binary elementwise vector operation and apply it to the elements--- of a pair of matrices.-liftMatrix2 :: (Monad m, BaseMatrix a x, BaseMatrix b y, Storable e) =>-    (x k e -> y k e -> m ()) ->-        a mn e -> b mn e -> m ()-liftMatrix2 f a b =-    if isHermMatrix a == isHermMatrix b-        then case (maybeToVector a, maybeToVector b) of-                 ((Just x), (Just y)) -> f x y-                 _                    -> elementwise-        else elementwise-  where-    elementwise =             -        let vecsA = if isHermMatrix a then rowViews . coerceMatrix-                                      else colViews . coerceMatrix-            vecsB = if isHermMatrix a then rowViews . coerceMatrix-                                      else colViews . coerceMatrix-            xs = vecsA a-            ys = vecsB b-        in zipWithM_ f xs ys----------------------------- BaseTensor functions -------------------------------shapeMatrix :: (BaseMatrix a x) => a mn e -> (Int,Int)-shapeMatrix a | isHermMatrix a  = (size2 a, size1 a)-              | otherwise       = (size1 a, size2 a)-{-# INLINE shapeMatrix #-}--boundsMatrix :: (BaseMatrix a x) => a mn e -> ((Int,Int), (Int,Int))-boundsMatrix a = ((0,0), (m-1,n-1)) where (m,n) = shapeMatrix a-{-# INLINE boundsMatrix #-}----------------------------- BaseMatrix functions -------------------------------hermMatrix :: (BaseMatrix a x) => a (m,n) e -> a (n,m) e-hermMatrix a = let (f,p,m,n,l,h) = arrayFromMatrix a-               in matrixViewArray f p m n l (not h)-{-# INLINE hermMatrix #-}----------------------------- ReadTensor functions -------------------------------getSizeMatrix :: (ReadMatrix a x m) => a mn e -> m Int-getSizeMatrix a = return (m*n) where (m,n) = shape a--getIndicesMatrix :: (ReadMatrix a x m) => a mn e -> m [(Int,Int)]-getIndicesMatrix = return . indicesMatrix-{-# INLINE getIndicesMatrix #-}--getElemsMatrix :: (ReadMatrix a x m, Elem e) => a mn e -> m [e]-getElemsMatrix a-    | isHermMatrix a = getElemsMatrix (herm $ coerceMatrix a) >>= -                           return . map conj-    | otherwise = -        liftM concat $-            unsafeInterleaveM $ -                mapM getElems (colViews $ coerceMatrix a)--getAssocsMatrix :: (ReadMatrix a x m, Elem e) => a mn e -> m [((Int,Int),e)]-getAssocsMatrix a = do-    is <- getIndicesMatrix a-    es <- getElemsMatrix a-    return $ zip is es-    -getIndicesMatrix' :: (ReadMatrix a x m) => a mn e -> m [(Int,Int)]-getIndicesMatrix' = getIndicesMatrix-{-# INLINE getIndicesMatrix' #-}--getElemsMatrix' :: (ReadMatrix a x m, Elem e) => a mn e -> m [e]-getElemsMatrix' a-    | isHermMatrix a = getElemsMatrix' (herm $ coerceMatrix a) >>= -                           return . map conj-    | otherwise = -        liftM concat $-            mapM getElems' (colViews $ coerceMatrix a)--getAssocsMatrix' :: (ReadMatrix a x m, Elem e) => a mn e -> m [((Int,Int),e)]-getAssocsMatrix' a = do-    is <- getIndicesMatrix' a-    es <- getElemsMatrix' a-    return $ zip is es--unsafeReadElemMatrix :: (ReadMatrix a x m, Elem e) => a mn e -> (Int,Int) -> m e-unsafeReadElemMatrix a (i,j)-    | isHermMatrix a = unsafeReadElem (herm $ coerceMatrix a) (j,i) >>= -                           return . conj-    | otherwise = unsafeIOToM $-                      withMatrixPtr a $ \ptr ->-                          peekElemOff ptr (indexOfMatrix a (i,j))-{-# INLINE unsafeReadElemMatrix #-}---------------------------- WriteTensor functions --------------------------------- | Create a new matrix of given shape, but do not initialize the elements.-newMatrix_ :: (WriteMatrix a x m, Elem e) => (Int,Int) -> m (a mn e)-newMatrix_ (m,n) -    | m < 0 || n < 0 =-        fail $ -            "Tried to create a matrix with shape `" ++ show (m,n) ++ "'"-    | otherwise = unsafeIOToM $ do-        f <- mallocForeignPtrArray (m*n)-        return $ matrixViewArray f (unsafeForeignPtrToPtr f) m n (max 1 m) False---- | Create a zero matrix of the specified shape.-newZeroMatrix :: (WriteMatrix a x m, Elem e) => (Int,Int) -> m (a mn e)-newZeroMatrix mn = do-    a <- newMatrix_ mn-    setZero a-    return a---- | Create a constant matrix of the specified shape.-newConstantMatrix :: (WriteMatrix a x m, Elem e) => (Int,Int) -> e -> m (a mn e)-newConstantMatrix mn e = do-    a <- newMatrix_ mn-    setConstant e a-    return a--setZeroMatrix :: (WriteMatrix a x m, Elem e) => a mn e -> m ()    -setZeroMatrix = liftMatrix setZero--setConstantMatrix :: (WriteMatrix a x m, Elem e) => e -> a mn e -> m ()-setConstantMatrix e = liftMatrix (setConstant e)--unsafeWriteElemMatrix :: (WriteMatrix a x m, Elem e) => -    a mn e -> (Int,Int) -> e -> m ()-unsafeWriteElemMatrix a (i,j) e-    | isHermMatrix a  = unsafeWriteElem a' (j,i) $ conj e-    | otherwise       = unsafeIOToM $-                            withMatrixPtr a $ \ptr ->-                                pokeElemOff ptr (indexOfMatrix a (i,j)) e-  where-    a' = (herm . coerceMatrix) a--modifyWithMatrix :: (WriteMatrix a x m, Elem e) => (e -> e) -> a mn e -> m ()-modifyWithMatrix f = liftMatrix (modifyWith f)--canModifyElemMatrix :: (WriteMatrix a x m) => a mn e -> (Int,Int) -> m Bool-canModifyElemMatrix _ _ = return True-{-# INLINE canModifyElemMatrix #-}---------------------------- CopyTensor functions --------------------------------newCopyMatrix :: (BLAS1 e, ReadMatrix a x m, WriteMatrix b y m) => -    a mn e -> m (b mn e)-newCopyMatrix a -    | isHermMatrix a =-        newCopyMatrix ((herm . coerceMatrix) a) >>= -            return . coerceMatrix . herm-    | otherwise = do-        a' <- newMatrix_ (shape a)-        unsafeCopyMatrix a' a-        return a'--unsafeCopyMatrix :: (BLAS1 e, WriteMatrix b y m,  ReadMatrix a x m) => -    b mn e -> a mn e -> m ()-unsafeCopyMatrix = liftMatrix2 unsafeCopyVector---------------------------- SwapTensor functions --------------------------------unsafeSwapMatrix :: (WriteMatrix a x m, BLAS1 e) => a mn e -> a mn e -> m ()-unsafeSwapMatrix = liftMatrix2 unsafeSwapVector--------------------------------- Vector views -----------------------------------unsafeRowView :: (BaseMatrix a x, Storable e) => -    a (k,l) e -> Int -> x l e-unsafeRowView a i-    | isHermMatrix a =-        conj $ unsafeColView (herm a) i-    | otherwise =-        let (fp,p,_,n,ld,_) = arrayFromMatrix a-            o  = indexOfMatrix a (i,0)-            p' = p `advancePtr` o-            s  = ld-            c  = False-        in vectorViewArray fp p' n s c--unsafeColView :: (BaseMatrix a x, Storable e) => -    a (k,l) e -> Int -> x k e-unsafeColView a j -    | isHermMatrix a =-        conj $ unsafeRowView (herm a) j-    | otherwise =-        let (fp,p,m,_,_,_) = arrayFromMatrix a-            o  = indexOfMatrix a (0,j)-            p' = p `advancePtr` o-            s  = 1-            c  = False-        in vectorViewArray fp p' m s c--unsafeDiagView :: (BaseMatrix a x, Storable e) => a mn e -> Int -> x k e-unsafeDiagView a i -    | isHermMatrix a = -        conj $ unsafeDiagView (herm $ coerceMatrix a) (negate i)-    | otherwise =            -        let (fp,p,m,n,ld,_) = arrayFromMatrix a-            o  = indexOfMatrix a (diagStart i)-            p' = p `advancePtr` o-            n' = diagLen (m,n) i-            s  = ld + 1-            c  = False-        in vectorViewArray fp p' n' s c---- | Get a list of vector views of the rows of the matrix.-rowViews :: (BaseMatrix a x, Storable e) => a (m,n) e -> [x n e]-rowViews a = [ unsafeRowView a i | i <- [0..numRows a - 1] ]---- | Get a list of vector views of the columns of the matrix.-colViews :: (BaseMatrix a x, Storable e) => a (m,n) e -> [x m e]-colViews a = [ unsafeColView a j | j <- [0..numCols a - 1] ]---- | Same as 'getRow' but not range-checked.-unsafeGetRowMatrix :: (ReadMatrix a x m, WriteVector y m, BLAS1 e) => -    a (k,l) e -> Int -> m (y l e)    -unsafeGetRowMatrix a i = newCopyVector (unsafeRowView a i)---- | Same as 'getCol' but not range-checked.-unsafeGetColMatrix :: (ReadMatrix a x m, WriteVector y m, BLAS1 e) => -    a (k,l) e -> Int -> m (y k e)-unsafeGetColMatrix a j = newCopyVector (unsafeColView a j)------------------------------ Numeric functions ---------------------------------doConjMatrix :: (WriteMatrix a x m, BLAS1 e) => a mn e -> m ()-doConjMatrix = liftMatrix doConjVector--scaleByMatrix :: (WriteMatrix a x m, BLAS1 e) => e -> a mn e -> m ()-scaleByMatrix k = liftMatrix (scaleByVector k)--shiftByMatrix :: (WriteMatrix a x m, BLAS1 e) => e -> a mn e -> m ()-shiftByMatrix k = liftMatrix (shiftByVector k)----------------------------- Numeric2 functions ---------------------------------unsafeAxpyMatrix :: (ReadMatrix a x m, WriteMatrix b y m, BLAS1 e) =>-    e -> a mn e -> b mn e -> m ()-unsafeAxpyMatrix = unsafeAxpyMatrixHelp---- for some reason GHC 6.8.3 doesn't infer the type correctly unless we --- split unsafeAxpyMatrix into two functions-unsafeAxpyMatrixHelp :: (BaseMatrix a x, BaseMatrix b y,-    ReadVector x m, WriteVector y m, BLAS1 e) =>-    e -> a mn e -> b mn e -> m ()-unsafeAxpyMatrixHelp alpha = liftMatrix2 (unsafeAxpyVector alpha)---unsafeMulMatrix :: (WriteMatrix b y m, ReadMatrix a x m, BLAS1 e) =>-    b mn e -> a mn e -> m ()-unsafeMulMatrix = liftMatrix2 unsafeMulVector--unsafeDivMatrix :: (WriteMatrix b y m, ReadMatrix a x m, BLAS1 e) =>-    b mn e -> a mn e -> m ()-unsafeDivMatrix = liftMatrix2 unsafeDivVector----------------------------- Numeric3 functions ---------------------------------unsafeDoAddMatrix :: (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) =>-    a mn e -> b mn e -> c mn e -> m ()-unsafeDoAddMatrix = unsafeDoMatrixOp2 $ flip $ unsafeAxpyMatrix 1--unsafeDoSubMatrix :: (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) =>-    a mn e -> b mn e -> c mn e -> m ()-unsafeDoSubMatrix = unsafeDoMatrixOp2 $ flip $ unsafeAxpyMatrix (-1)--unsafeDoMulMatrix :: (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) =>-    a mn e -> b mn e -> c mn e -> m ()-unsafeDoMulMatrix = unsafeDoMatrixOp2 $ unsafeMulMatrix--unsafeDoDivMatrix :: (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) =>-    a mn e -> b mn e -> c mn e -> m ()-unsafeDoDivMatrix = unsafeDoMatrixOp2 $ unsafeDivMatrix----------------------------- ReadApply functions ----------------------------------- | @gemv alpha a x beta y@ replaces @y := alpha a * x + beta y@.-gemv :: (ReadMatrix a z m, ReadVector x m, WriteVector y m, BLAS3 e) => -    e -> a (k,l) e -> x l e -> e -> y k e -> m ()-gemv alpha a x beta y-    | numRows a == 0 || numCols a == 0 =-        scaleBy beta y-        -    | isConj y && (isConj x || stride x == 1) =-        let order  = colMajor-            transA = if isConj x then noTrans else conjTrans-            transB = blasTransOf (herm a)-            m      = 1-            n      = dim y-            k      = dim x-            ldA    = stride x-            ldB    = ldaOfMatrix a-            ldC    = stride y-            alpha' = conj alpha-            beta'  = conj beta-        in unsafeIOToM $-               withVectorPtr x $ \pA ->-               withMatrixPtr a $ \pB ->-               withVectorPtr y $ \pC ->-                   BLAS.gemm order transA transB m n k alpha' pA ldA pB ldB beta' pC ldC-    -    | (isConj y && otherwise) || isConj x = do-        doConj y-        gemv alpha a x beta (conj y)-        doConj y-        -    | otherwise =-        let order  = colMajor-            transA = blasTransOf a-            (m,n)  = case (isHermMatrix a) of-                         False -> shape a-                         True  -> (flipShape . shape) a-            ldA    = ldaOfMatrix a-            incX   = stride x-            incY   = stride y-        in unsafeIOToM $-               withMatrixPtr a $ \pA ->-               withVectorPtr x $ \pX ->-               withVectorPtr y $ \pY -> do-                   BLAS.gemv order transA m n alpha pA ldA pX incX beta pY incY---- | @gemm alpha a b beta c@ replaces @c := alpha a * b + beta c@.-gemm :: (BLAS3 e, ReadMatrix a x m, ReadMatrix b y m, WriteMatrix c z m) => -    e -> a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-gemm alpha a b beta c-    | numRows a == 0 || numCols a == 0 || numCols b == 0 = -        scaleBy beta c-    | isHermMatrix c = gemm (conj alpha) (herm b) (herm a) (conj beta) (herm c)-    | otherwise =-        let order  = colMajor-            transA = blasTransOf a-            transB = blasTransOf b-            (m,n)  = shape c-            k      = numCols a-            ldA    = ldaOfMatrix a-            ldB    = ldaOfMatrix b-            ldC    = ldaOfMatrix c-        in unsafeIOToM $-               withMatrixPtr a $ \pA ->-               withMatrixPtr b $ \pB ->-               withMatrixPtr c $ \pC ->-                   BLAS.gemm order transA transB m n k alpha pA ldA pB ldB beta pC ldC------------------------------ Utility functions ---------------------------------blasTransOf :: (BaseMatrix a x) => a mn e -> CBLASTrans-blasTransOf a = -    case (isHermMatrix a) of-          False -> noTrans-          True  -> conjTrans--flipShape :: (Int,Int) -> (Int,Int)-flipShape (m,n) = (n,m)--withMatrixPtr :: (BaseMatrix a x) =>-    a mn e -> (Ptr e -> IO b) -> IO b-withMatrixPtr a f =-    let (fp,p,_,_,_,_) = arrayFromMatrix a-    in do-        b <- f p-        touchForeignPtr fp-        return b--indexOfMatrix :: (BaseMatrix a x) => a mn e -> (Int,Int) -> Int-indexOfMatrix a (i,j) = -    let (i',j') = case isHermMatrix a of-                        True  -> (j,i)-                        False -> (i,j)-        l = ldaOfMatrix a-    in i' + j'*l-{-# INLINE indexOfMatrix #-}--indicesMatrix :: (BaseMatrix a x) => a mn e -> [(Int,Int)]-indicesMatrix a -    | isHermMatrix a = [ (i,j) | i <- range (0,m-1), j <- range (0,n-1) ]-    | otherwise      = [ (i,j) | j <- range (0,n-1), i <- range (0,m-1) ]-  where (m,n) = shape a--unsafeDoMatrixOp2 :: (BLAS1 e, ReadMatrix a x m, ReadMatrix b y m, WriteMatrix c z m) =>-    (c n e -> b n e -> m ()) -> a n e -> b n e -> c n e -> m ()-unsafeDoMatrixOp2 f a b c = do-    unsafeCopyMatrix c a-    f c b--------------------------------------- Instances ---------------------------------- | The mutable dense matrix data type.  It can either store elements in --- column-major order, or provide a view into another matrix.  The view --- transposes and conjugates the underlying matrix.-data IOMatrix mn e =-      DM {-# UNPACK #-} !(ForeignPtr e) -- a pointer to the storage region-         {-# UNPACK #-} !(Ptr e)        -- a pointer to the first element-         {-# UNPACK #-} !Int            -- the number of rows in the matrix-         {-# UNPACK #-} !Int            -- the number of columns in the matrix-         {-# UNPACK #-} !Int            -- the leading dimension size of the matrix-         {-# UNPACK #-} !Bool           -- indicates whether or not the matrix is transposed and conjugated--newtype STMatrix s n e = ST (IOMatrix n e)--unsafeIOMatrixToSTMatrix :: IOMatrix n e -> STMatrix s n e-unsafeIOMatrixToSTMatrix = ST-{-# INLINE unsafeIOMatrixToSTMatrix #-}--unsafeSTMatrixToIOMatrix :: STMatrix s n e -> IOMatrix n e-unsafeSTMatrixToIOMatrix (ST x) = x-{-# INLINE unsafeSTMatrixToIOMatrix #-}---instance BaseMatrix IOMatrix IOVector where-    matrixViewArray f p m n = DM f p m n-    arrayFromMatrix (DM f p m n l h) = (f,p,m,n,l,h)--instance BaseMatrix (STMatrix s) (STVector s) where-    matrixViewArray f p m n l h = ST $ DM f p m n l h-    arrayFromMatrix (ST (DM f p m n l h)) = (f,p,m,n,l,h)--instance BaseTensor IOMatrix (Int,Int) where-    shape  = shapeMatrix-    bounds = boundsMatrix--instance BaseTensor (STMatrix s) (Int,Int) where-    shape  = shapeMatrix-    bounds = boundsMatrix--instance ReadTensor IOMatrix (Int,Int) IO where-    getSize        = getSizeMatrix-    getAssocs      = getAssocsMatrix-    getIndices     = getIndicesMatrix-    getElems       = getElemsMatrix-    getAssocs'     = getAssocsMatrix'-    getIndices'    = getIndicesMatrix'-    getElems'      = getElemsMatrix'-    unsafeReadElem = unsafeReadElemMatrix--instance ReadTensor (STMatrix s) (Int,Int) (ST s) where-    getSize        = getSizeMatrix-    getAssocs      = getAssocsMatrix-    getIndices     = getIndicesMatrix-    getElems       = getElemsMatrix-    getAssocs'     = getAssocsMatrix'-    getIndices'    = getIndicesMatrix'-    getElems'      = getElemsMatrix'-    unsafeReadElem = unsafeReadElemMatrix--instance WriteTensor IOMatrix (Int,Int) IO where-    setConstant     = setConstantMatrix-    setZero         = setZeroMatrix-    modifyWith      = modifyWithMatrix-    unsafeWriteElem = unsafeWriteElemMatrix-    canModifyElem   = canModifyElemMatrix-    doConj          = doConjMatrix-    scaleBy         = scaleByMatrix-    shiftBy         = shiftByMatrix---instance WriteTensor (STMatrix s) (Int,Int) (ST s) where-    setConstant     = setConstantMatrix-    setZero         = setZeroMatrix-    modifyWith      = modifyWithMatrix-    unsafeWriteElem = unsafeWriteElemMatrix-    canModifyElem   = canModifyElemMatrix-    doConj          = doConjMatrix-    scaleBy         = scaleByMatrix-    shiftBy         = shiftByMatrix--instance BLAS.BaseMatrix IOMatrix where-    herm = hermMatrix--instance BLAS.BaseMatrix (STMatrix s) where-    herm = hermMatrix-    -instance ReadMatrix IOMatrix IOVector IO where-instance ReadMatrix (STMatrix s) (STVector s) (ST s) where    -    -instance WriteMatrix IOMatrix IOVector IO where-instance WriteMatrix (STMatrix s) (STVector s) (ST s) where
− Data/Matrix/Dense/Class/Operations.hs 
@@ -1,193 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Class.Operations--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Class.Operations (-    -- * Matrix operations-    -- ** Unsary-    getConjMatrix,-    getScaledMatrix,-    getShiftedMatrix,-    -    -- ** Binary-    getAddMatrix,-    getSubMatrix,-    getMulMatrix,-    getDivMatrix,-    addMatrix,-    subMatrix,-    axpyMatrix,-    mulMatrix,-    divMatrix,--    -- ** Unsafe-    unsafeGetAddMatrix,-    unsafeGetSubMatrix,-    unsafeGetMulMatrix,-    unsafeGetDivMatrix,-    unsafeAddMatrix,-    unsafeSubMatrix,-    unsafeAxpyMatrix,-    unsafeMulMatrix,-    unsafeDivMatrix,-    -    ) where--import BLAS.Elem( BLAS1 )-import BLAS.Internal( checkBinaryOp )-import BLAS.Tensor( BaseTensor(..) )--import Data.Matrix.Dense.Class.Internal------------------------------- Unary Operations --------------------------------- | Get a new matrix with elements with the conjugates of the elements--- of the given matrix.-getConjMatrix :: (ReadMatrix a x m, WriteMatrix b y m, BLAS1 e) =>-    a mn e -> m (b mn e)-getConjMatrix = getUnaryOp doConjMatrix-{-# INLINE getConjMatrix #-}---- | Get a new matrix by scaling the elements of another matrix--- by a given value.-getScaledMatrix :: (ReadMatrix a x m, WriteMatrix b y m, BLAS1 e) =>-    e -> a mn e -> m (b mn e)-getScaledMatrix e = getUnaryOp (scaleByMatrix e)-{-# INLINE getScaledMatrix #-}---- | Get a new matrix by shifting the elements of another matrix--- by a given value.-getShiftedMatrix :: (ReadMatrix a x m, WriteMatrix b y m, BLAS1 e) =>-    e -> a mn e -> m (b mn e)-getShiftedMatrix e = getUnaryOp (shiftByMatrix e)-{-# INLINE getShiftedMatrix #-}------------------------------- Binary Operations ---------------------------------- | @getAddMatrix a b@ creates a new matrix equal to the sum @a+b@.  The --- operands must have the same shape.-getAddMatrix :: -    (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) => -    a mn e -> b mn e -> m (c mn e)-getAddMatrix = checkTensorOp2 unsafeGetAddMatrix-{-# INLINE getAddMatrix #-}--unsafeGetAddMatrix :: -    (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) => -    a mn e -> b mn e -> m (c mn e)-unsafeGetAddMatrix = unsafeGetBinaryOp unsafeAddMatrix-{-# INLINE unsafeGetAddMatrix #-}---- | @getSubMatrix a b@ creates a new matrix equal to the difference @a-b@.  The --- operands must have the same shape.-getSubMatrix :: -    (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) => -    a mn e -> b mn e -> m (c mn e)-getSubMatrix = checkTensorOp2 unsafeGetSubMatrix-{-# INLINE getSubMatrix #-}--unsafeGetSubMatrix :: -    (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) => -    a mn e -> b mn e -> m (c mn e)-unsafeGetSubMatrix = unsafeGetBinaryOp unsafeSubMatrix-{-# INLINE unsafeGetSubMatrix #-}---- | @getMulMatrix a b@ creates a new matrix equal to the elementwise product --- @a*b@.  The operands must have the same shape.-getMulMatrix :: -    (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) => -    a mn e -> b mn e -> m (c mn e)-getMulMatrix = checkTensorOp2 unsafeGetMulMatrix-{-# INLINE getMulMatrix #-}--unsafeGetMulMatrix :: -    (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) => -    a mn e -> b mn e -> m (c mn e)-unsafeGetMulMatrix = unsafeGetBinaryOp unsafeMulMatrix-{-# INLINE unsafeGetMulMatrix #-}---- | @getDivMatrix a b@ creates a new matrix equal to the elementwise ratio--- @a/b@.  The operands must have the same shape.-getDivMatrix :: -    (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) => -    a mn e -> b mn e -> m (c mn e)-getDivMatrix = checkTensorOp2 unsafeGetDivMatrix-{-# INLINE getDivMatrix #-}--unsafeGetDivMatrix :: -    (ReadMatrix a x m, ReadMatrix b x m, WriteMatrix c z m, BLAS1 e) => -    a mn e -> b mn e -> m (c mn e)-unsafeGetDivMatrix = unsafeGetBinaryOp unsafeDivMatrix-{-# INLINE unsafeGetDivMatrix #-}---axpyMatrix :: (ReadMatrix a x m, WriteMatrix b y m, BLAS1 e) =>-    e -> a n e -> b n e -> m ()-axpyMatrix alpha x y = -    checkBinaryOp (shape x) (shape y) $ unsafeAxpyMatrix alpha x y-{-# INLINE axpyMatrix #-}--addMatrix :: (WriteMatrix b y m, ReadMatrix a x m, BLAS1 e) =>-    b n e -> a n e -> m ()-addMatrix b a = -    checkBinaryOp (shape b) (shape a) $ unsafeAddMatrix b a-{-# INLINE addMatrix #-}--unsafeAddMatrix :: (WriteMatrix b y m, ReadMatrix a x m, BLAS1 e) =>-    b n e -> a n e -> m ()-unsafeAddMatrix b a = unsafeAxpyMatrix 1 a b--subMatrix :: (WriteMatrix b y m, ReadMatrix a x m, BLAS1 e) =>-    b n e -> a n e -> m ()-subMatrix b a = -    checkBinaryOp (shape b) (shape a) $ unsafeSubMatrix b a-{-# INLINE subMatrix #-}--unsafeSubMatrix :: (WriteMatrix b y m, ReadMatrix a x m, BLAS1 e) =>-    b n e -> a n e -> m ()-unsafeSubMatrix b a = unsafeAxpyMatrix (-1) a b--mulMatrix :: (WriteMatrix b y m, ReadMatrix a x m, BLAS1 e) =>-    b n e -> a n e -> m ()-mulMatrix b a = -    checkBinaryOp (shape b) (shape a) $ unsafeMulMatrix b a-{-# INLINE mulMatrix #-}--divMatrix :: (WriteMatrix b y m, ReadMatrix a x m, BLAS1 e) =>-    b n e -> a n e -> m ()-divMatrix b a = -    checkBinaryOp (shape b) (shape a) $ unsafeDivMatrix b a-{-# INLINE divMatrix #-}---checkTensorOp2 :: (BaseTensor x i, BaseTensor y i) => -    (x n e -> y n e -> a) ->-        x n e -> y n e -> a-checkTensorOp2 f x y = -    checkBinaryOp (shape x) (shape y) $ f x y-{-# INLINE checkTensorOp2 #-}--getUnaryOp :: (ReadMatrix a x m, WriteMatrix b y m, BLAS1 e) =>-    (b mn e -> m ()) -> a mn e -> m (b mn e)-getUnaryOp f a = do-    b <- newCopyMatrix a-    f b-    return b-{-# INLINE getUnaryOp #-}--unsafeGetBinaryOp :: -    (WriteMatrix c z m, ReadMatrix a x m, ReadMatrix b x m, BLAS1 e) => -    (c n e -> b n e -> m ()) ->-        a n e -> b n e -> m (c n e)-unsafeGetBinaryOp f a b = do-    c <- newCopyMatrix a-    f c b-    return c
− Data/Matrix/Dense/Class/Special.hs 
@@ -1,41 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Class.Special--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Class.Special (-    -- * Special matrices-    newZeroMatrix,-    setZeroMatrix,-    newConstantMatrix,-    setConstantMatrix,-    newIdentityMatrix,-    setIdentityMatrix,-    ) where--import BLAS.Elem( Elem )-import BLAS.Tensor( unsafeWriteElem )-import BLAS.Matrix.Base( numRows, numCols )--import Data.Matrix.Dense.Class.Internal----- | Create a new matrix of the given shape with ones along the diagonal, --- and zeros everywhere else.-newIdentityMatrix :: (WriteMatrix a x m, Elem e) => (Int,Int) -> m (a mn e)-newIdentityMatrix mn = do-    a <- newMatrix_ mn-    setIdentityMatrix a-    return a---- | Set diagonal elements to one and all other elements to zero.-setIdentityMatrix :: (WriteMatrix a x m, Elem e) => a mn e -> m ()-setIdentityMatrix a = do-    setZeroMatrix a-    mapM_ (\i -> unsafeWriteElem a (i,i) 1) [0..(mn-1)]-  where-    mn = min (numRows a) (numCols a)
− Data/Matrix/Dense/Class/Views.hs 
@@ -1,123 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Class.Views--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Class.Views (-    -- * Matrix views-    submatrixView,-    splitRowsAt,-    splitColsAt,-    unsafeSubmatrixView,-    unsafeSplitRowsAt,-    unsafeSplitColsAt,--    -- * Row and Column views-    rowViews,-    colViews,-    rowView,-    colView,-    diagView,-    unsafeRowView,-    unsafeColView,-    unsafeDiagView,-    -    -- * Getting rows and columns-    getDiag,-    unsafeGetDiag,-    -    ) where--import BLAS.Elem( BLAS1 )-import BLAS.Internal( checkedSubmatrix, checkedRow, checkedCol, checkedDiag )-import BLAS.Tensor( shape )-import BLAS.Matrix.Base( herm )--import Data.Matrix.Dense.Class.Internal-import Data.Vector.Dense.Class.Internal( WriteVector, newCopyVector )--import Foreign----- | @submatrixView a ij mn@ returns a view of the submatrix of @a@ with element @(0,0)@--- being element @ij@ in @a@, and having shape @mn@.-submatrixView :: (BaseMatrix a x, Storable e) => a mn e -> (Int,Int) -> (Int,Int) -> a mn' e-submatrixView a = checkedSubmatrix (shape a) (unsafeSubmatrixView a)-{-# INLINE submatrixView #-}---- | Same as 'submatrixView' but indices are not range-checked.-unsafeSubmatrixView :: (BaseMatrix a x, Storable e) => -    a mn e -> (Int,Int) -> (Int,Int) -> a mn' e-unsafeSubmatrixView a (i,j) (m,n)-    | isHermMatrix a  = -        coerceMatrix $ herm $ -            unsafeSubmatrixView (herm $ coerceMatrix a) (j,i) (n,m)-    | otherwise =-        let (fp,p,_,_,ld,_) = arrayFromMatrix a-            o  = indexOfMatrix a (i,j)-            p' = p `advancePtr` o-        in matrixViewArray fp p' m n ld False--splitRowsAt :: (BaseMatrix a x, Storable e) =>-    Int -> a (m,n) e -> (a (m1,n) e, a (m2,n) e)-splitRowsAt m1 a = ( submatrixView a (0,0)  (m1,n)-                   , submatrixView a (m1,0) (m2,n)-                   )-  where -    (m,n) = shape a-    m2    = m - m1--unsafeSplitRowsAt :: (BaseMatrix a x, Storable e) =>-    Int -> a (m,n) e -> (a (m1,n) e, a (m2,n) e)-unsafeSplitRowsAt m1 a = ( unsafeSubmatrixView a (0,0)  (m1,n)-                         , unsafeSubmatrixView a (m1,0) (m2,n)-                         )-  where -    (m,n) = shape a-    m2    = m - m1--splitColsAt :: (BaseMatrix a x, Storable e) =>-    Int -> a (m,n) e -> (a (m,n1) e, a (m,n2) e)-splitColsAt n1 a = ( submatrixView a (0,0)  (m,n1)-                   , submatrixView a (0,n1) (m,n2)-                   )-  where-    (m,n) = shape a-    n2    = n - n1--unsafeSplitColsAt :: (BaseMatrix a x, Storable e) =>-    Int -> a (m,n) e -> (a (m,n1) e, a (m,n2) e)-unsafeSplitColsAt n1 a = ( unsafeSubmatrixView a (0,0)  (m,n1)-                         , unsafeSubmatrixView a (0,n1) (m,n2)-                         )-  where-    (m,n) = shape a-    n2    = n - n1----- | Get a vector view of the given diagonal in a matrix.-diagView :: (BaseMatrix a x, Storable e) => a mn e -> Int -> x k e-diagView a = checkedDiag (shape a) (unsafeDiagView a)---- | Get a vector view of the given row in a matrix.-rowView :: (BaseMatrix a x, Storable e) => a (m,n) e -> Int -> x n e-rowView a = checkedRow (shape a) (unsafeRowView a)---- | Get a vector view of the given column in a matrix.-colView :: (BaseMatrix a x, Storable e) => a (m,n) e -> Int -> x m e-colView a = checkedCol (shape a) (unsafeColView a)---- | Get the given diagonal in a matrix.  Negative indices correspond--- to sub-diagonals.-getDiag :: (ReadMatrix a x m, WriteVector y m, BLAS1 e) => -    a mn e -> Int -> m (y k e)-getDiag a = checkedDiag (shape a) (unsafeGetDiag a)---- | Same as 'getDiag' but not range-checked.-unsafeGetDiag :: (ReadMatrix a x m, WriteVector y m, BLAS1 e) => -    a mn e -> Int -> m (y k e)-unsafeGetDiag a i = newCopyVector (unsafeDiagView a i)
− Data/Matrix/Dense/IO.hs 
@@ -1,18 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.IO--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.IO (-    -- * The IOMatrix data type-    IOMatrix,-    -    module Data.Matrix.Dense.Class,-    ) where--import Data.Matrix.Dense.Class.Internal( IOMatrix )-import Data.Matrix.Dense.Class
− Data/Matrix/Dense/Internal.hs 
@@ -1,332 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.Internal--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.Internal (-    -- * Dense matrix type-    Matrix(..),--    -- * Matrix shape-    module BLAS.Tensor.Base,-    module BLAS.Matrix.Base,-    coerceMatrix,--    -- * Creating matrices-    matrix, -    listMatrix,-    rowsMatrix,-    colsMatrix,-    rowMatrix,-    colMatrix,-    unsafeMatrix,-    -    -- * Reading matrix elements-    module BLAS.Tensor.Immutable,-    -    -- * Special matrices-    zeroMatrix,-    constantMatrix,-    identityMatrix,--    -- * Matrix views-    submatrix,-    splitRowsAt,-    splitColsAt,-    unsafeSubmatrix,-    unsafeSplitRowsAt,-    unsafeSplitColsAt,-    -    -- * Vector views-    diag,-    unsafeDiag,--    -- * Low-level properties-    ldaOfMatrix,-    isHermMatrix,-    ) where--import Data.AEq-import System.IO.Unsafe--import BLAS.Elem ( Elem, BLAS1 )-import BLAS.Internal ( inlinePerformIO )-import BLAS.UnsafeIOToM--import BLAS.Tensor.Base-import BLAS.Tensor.Immutable-import BLAS.Tensor--import BLAS.Matrix.Base hiding ( BaseMatrix )-import qualified BLAS.Matrix.Base as BLAS--import Data.Matrix.Dense.Class.Creating-import Data.Matrix.Dense.Class.Special-import Data.Matrix.Dense.Class.Views( submatrixView, unsafeSubmatrixView,-    splitRowsAt, splitColsAt, unsafeSplitRowsAt, unsafeSplitColsAt,-    diagView, unsafeDiagView )-import Data.Matrix.Dense.Class.Internal( coerceMatrix, isHermMatrix, -    ldaOfMatrix, colViews, BaseMatrix(..), IOMatrix, maybeFromRow, -    maybeFromCol, newCopyMatrix, ReadMatrix )-import Data.Matrix.Dense.Class.Operations-import Data.Vector.Dense.Class.Internal-import Data.Vector.Dense--newtype Matrix mn e = M (IOMatrix mn e)--unsafeFreezeIOMatrix :: IOMatrix mn e -> Matrix mn e-unsafeFreezeIOMatrix = M--unsafeThawIOMatrix :: Matrix mn e -> IOMatrix mn e-unsafeThawIOMatrix (M a) = a---liftMatrix :: (IOMatrix n e -> a) -> Matrix n e -> a-liftMatrix f (M x) = f x-{-# INLINE liftMatrix #-}--liftMatrix2 :: -    (IOMatrix n e -> IOMatrix n e -> a) -> -        Matrix n e -> Matrix n e -> a-liftMatrix2 f x = liftMatrix (liftMatrix f x)-{-# INLINE liftMatrix2 #-}--unsafeLiftMatrix :: (IOMatrix n e -> IO a) -> Matrix n e -> a-unsafeLiftMatrix f = unsafePerformIO . liftMatrix f-{-# NOINLINE unsafeLiftMatrix #-}--unsafeLiftMatrix2 :: -    (IOMatrix n e -> IOMatrix n e -> IO a) -> -        Matrix n e -> Matrix n e -> a-unsafeLiftMatrix2 f x y = unsafePerformIO $ liftMatrix2 f x y-{-# NOINLINE unsafeLiftMatrix2 #-}--inlineLiftMatrix :: (IOMatrix n e -> IO a) -> Matrix n e -> a-inlineLiftMatrix f = inlinePerformIO . liftMatrix f-{-# INLINE inlineLiftMatrix #-}----- | Create a new matrix of the given size and initialize the given elements to--- the given values.  All other elements get set to zero.-matrix :: (BLAS1 e) => (Int,Int) -> [((Int,Int), e)] -> Matrix (m,n) e-matrix mn ies = unsafeFreezeIOMatrix $ unsafePerformIO $ newMatrix mn ies-{-# NOINLINE matrix #-}---- | Create a new matrix with the given elements in row-major order.-listMatrix :: (BLAS1 e) => (Int,Int) -> [e] -> Matrix (m,n) e-listMatrix mn es = unsafeFreezeIOMatrix $ unsafePerformIO $ newListMatrix mn es-{-# NOINLINE listMatrix #-}---- | Same as 'matrix' but does not do any bounds checking.-unsafeMatrix :: (BLAS1 e) => (Int,Int) -> [((Int,Int), e)] -> Matrix (m,n) e-unsafeMatrix mn ies = unsafeFreezeIOMatrix $ unsafePerformIO $ unsafeNewMatrix mn ies-{-# NOINLINE unsafeMatrix #-}---- | Create a matrix of the given shape from a list of rows-rowsMatrix :: (BLAS1 e) => (Int,Int) -> [Vector n e] -> Matrix (m,n) e-rowsMatrix mn rs = unsafeFreezeIOMatrix $ unsafePerformIO $ newRowsMatrix mn rs-{-# NOINLINE rowsMatrix #-}---- | Create a matrix of the given shape from a list of columns-colsMatrix :: (BLAS1 e) => (Int,Int) -> [Vector m e] -> Matrix (m,n) e-colsMatrix mn cs = unsafeFreezeIOMatrix $ unsafePerformIO $ newColsMatrix mn cs-{-# NOINLINE colsMatrix #-}---- | Get a matrix from a row vector.-rowMatrix :: (BLAS1 e) => Vector n e -> Matrix (one,n) e-rowMatrix x = -    case maybeFromRow $ unsafeThawIOVector x of-        Just x' -> unsafeFreezeIOMatrix x'-        Nothing -> unsafeFreezeIOMatrix $ unsafePerformIO $ newRowMatrix x-  where-    unsafeThawIOVector :: Vector n e -> IOVector n e-    unsafeThawIOVector = unsafeThawVector-{-# NOINLINE rowMatrix #-}---- | Get a matrix from a column vector.-colMatrix :: (BLAS1 e) => Vector m e -> Matrix (m,one) e-colMatrix x = -    case maybeFromCol $ unsafeThawIOVector x of-        Just x' -> unsafeFreezeIOMatrix x'-        Nothing -> unsafeFreezeIOMatrix $ unsafePerformIO $ newColMatrix x-  where-    unsafeThawIOVector :: Vector n e -> IOVector n e-    unsafeThawIOVector = unsafeThawVector-{-# NOINLINE colMatrix #-}---- | Get a new zero of the given shape.-zeroMatrix :: (BLAS1 e) => (Int,Int) -> Matrix (m,n) e-zeroMatrix mn = unsafeFreezeIOMatrix $ unsafePerformIO $ newZeroMatrix mn-{-# NOINLINE zeroMatrix #-}---- | Get a new constant of the given shape.-constantMatrix :: (BLAS1 e) => (Int,Int) -> e -> Matrix (m,n) e-constantMatrix mn e = unsafeFreezeIOMatrix $ unsafePerformIO $ newConstantMatrix mn e-{-# NOINLINE constantMatrix #-}---- | Get a new matrix of the given shape with ones along the diagonal and--- zeroes everywhere else.-identityMatrix :: (BLAS1 e) => (Int,Int) -> Matrix (m,n) e-identityMatrix mn = unsafeFreezeIOMatrix $ unsafePerformIO $ newIdentityMatrix mn-{-# NOINLINE identityMatrix #-}----- | @submatrix a ij mn@ returns the submatrix of @a@ with element @(0,0)@--- being element @ij@ in @a@, and having shape @mn@.-submatrix :: (Elem e) => Matrix mn e -> (Int,Int) -> (Int,Int) -> Matrix mn' e-submatrix = submatrixView---- | Same as 'submatrix' but indices are not range-checked.-unsafeSubmatrix :: (Elem e) => Matrix mn e -> (Int,Int) -> (Int,Int) -> Matrix mn' e-unsafeSubmatrix = unsafeSubmatrixView---- | Get a the given diagonal in a matrix.  Negative indices correspond to--- sub-diagonals.-diag :: (Elem e) => Matrix mn e -> Int -> Vector k e-diag = diagView---- | Same as 'diag' but index is not range-checked.-unsafeDiag :: (Elem e) => Matrix mn e -> Int -> Vector k e-unsafeDiag = unsafeDiagView---instance BaseTensor Matrix (Int,Int) where-    shape  = liftMatrix shape-    bounds = liftMatrix bounds--instance ITensor Matrix (Int,Int) where-    (//)          = replaceHelp writeElem-    unsafeReplace = replaceHelp unsafeWriteElem-    -    unsafeAt a i  = inlineLiftMatrix (flip unsafeReadElem i) a-    {-# INLINE unsafeAt #-}-    -    size          = inlineLiftMatrix getSize-    elems         = inlineLiftMatrix getElems-    indices       = inlineLiftMatrix getIndices-    assocs        = inlineLiftMatrix getAssocs--    tmap f a -        | isHermMatrix a = coerceMatrix $ herm $ -                               listMatrix (n,m) $ map (conj . f) (elems a)-        | otherwise      = coerceMatrix $-                               listMatrix (m,n) $ map f (elems a)-      where-        (m,n) = shape a--    (*>) k x = unsafeFreezeIOMatrix $ unsafeLiftMatrix (getScaledMatrix k) x-    {-# NOINLINE (*>) #-}--    shift k x = unsafeFreezeIOMatrix $ unsafeLiftMatrix (getShiftedMatrix k) x-    {-# NOINLINE shift #-}----replaceHelp :: (BLAS1 e) => -    (IOMatrix mn e -> (Int,Int) -> e -> IO ()) ->-        Matrix mn e -> [((Int,Int), e)] -> Matrix mn e-replaceHelp set x ies =-    unsafePerformIO $ do-        y  <- newCopyMatrix (unsafeThawIOMatrix x)-        mapM_ (uncurry $ set y) ies-        return (unsafeFreezeIOMatrix y)-{-# NOINLINE replaceHelp #-}--instance (Monad m) => ReadTensor Matrix (Int,Int) m where-    getSize        = return . size-    getAssocs      = return . assocs-    getIndices     = return . indices-    getElems       = return . elems-    getAssocs'     = getAssocs-    getIndices'    = getIndices-    getElems'      = getElems-    unsafeReadElem x i = return (unsafeAt x i)--instance BLAS.BaseMatrix Matrix where-    herm (M a) = M (herm a)-    -instance BaseMatrix Matrix Vector where-    matrixViewArray f p m n l h  = M $ matrixViewArray f p m n l h-    arrayFromMatrix (M a )       = arrayFromMatrix a--instance (UnsafeIOToM m) => ReadMatrix Matrix Vector m where--instance (BLAS1 e) => Num (Matrix mn e) where-    (+) x y     = unsafeFreezeIOMatrix $ unsafeLiftMatrix2 getAddMatrix x y-    (-) x y     = unsafeFreezeIOMatrix $ unsafeLiftMatrix2 getSubMatrix x y-    (*) x y     = unsafeFreezeIOMatrix $ unsafeLiftMatrix2 getMulMatrix x y-    negate      = ((-1) *>)-    abs         = tmap abs-    signum      = tmap signum-    fromInteger = coerceMatrix . (constantMatrix (1,1)) . fromInteger-    -instance (BLAS1 e) => Fractional (Matrix mn e) where-    (/) x y      = unsafeFreezeIOMatrix $ unsafeLiftMatrix2 getDivMatrix x y-    recip        = tmap recip-    fromRational = coerceMatrix . (constantMatrix (1,1)) . fromRational --instance (BLAS1 e, Floating e) => Floating (Matrix (m,n) e) where-    pi    = constantMatrix (1,1) pi-    exp   = tmap exp-    sqrt  = tmap sqrt-    log   = tmap log-    (**)  = tzipWith (**)-    sin   = tmap sin-    cos   = tmap cos-    tan   = tmap tan-    asin  = tmap asin-    acos  = tmap acos-    atan  = tmap atan-    sinh  = tmap sinh-    cosh  = tmap cosh-    tanh  = tmap tanh-    asinh = tmap asinh-    acosh = tmap acosh-    atanh = tmap atanh--tzipWith :: (BLAS1 e) =>-    (e -> e -> e) -> Matrix mn e -> Matrix mn e -> Matrix mn e-tzipWith f a b-    | shape b /= mn =-        error ("tzipWith: matrix shapes differ; first has shape `" ++-                show mn ++ "' and second has shape `" ++-                show (shape b) ++ "'")-    | otherwise =-        coerceMatrix $-            listMatrix mn $ zipWith f (colElems a) (colElems b)-  where-    mn = shape a-    colElems = (concatMap elems) . colViews . coerceMatrix--instance (BLAS1 e, Show e) => Show (Matrix mn e) where-    show a | isHermMatrix a = -                "herm (" ++ show (herm $ coerceMatrix a) ++ ")"-           | otherwise =-                "listMatrix " ++ show (shape a) ++ " " ++ show (elems a)-        -compareHelp :: (BLAS1 e) => -    (e -> e -> Bool) -> Matrix mn e -> Matrix mn e -> Bool-compareHelp cmp a b-    | shape a /= shape b =-        False-    | isHermMatrix a == isHermMatrix b =-        let elems' = if isHermMatrix a then elems . herm .coerceMatrix-                                       else elems-        in-            and $ zipWith cmp (elems' a) (elems' b)-    | otherwise =-        and $ zipWith cmp (colElems a) (colElems b)-  where-    colElems c = concatMap elems (colViews $ coerceMatrix c)--instance (BLAS1 e, Eq e) => Eq (Matrix mn e) where-    (==) = compareHelp (==)--instance (BLAS1 e, AEq e) => AEq (Matrix mn e) where-    (===) = compareHelp (===)-    (~==) = compareHelp (~==)
− Data/Matrix/Dense/ST.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances,-        Rank2Types #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Dense.ST--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Dense.ST (-    -- * The @STMatrix@ data type-    STMatrix,-    runSTMatrix,--    unsafeIOMatrixToSTMatrix,-    unsafeSTMatrixToIOMatrix,--    module Data.Matrix.Dense.Class,-    ) where--import Control.Monad.ST--import Data.Matrix.Dense.Internal( Matrix(..) )-import Data.Matrix.Dense.Class-import Data.Matrix.Dense.Class.Internal( STMatrix, unsafeIOMatrixToSTMatrix,-    unsafeSTMatrixToIOMatrix )--runSTMatrix :: (forall s . ST s (STMatrix s n e)) -> Matrix n e-runSTMatrix x = runST $ x >>= return . M . unsafeSTMatrixToIOMatrix
− Data/Matrix/Diag.hs 
@@ -1,238 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ExistentialQuantification #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Diag--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Diag (-    -- * The diagonal matrix types-    Diag,-    -    -- * Converting to and from @Vector@s-    diagFromVector,-    vectorFromDiag,-    -    -- * Coercing shapes-    coerceDiag,-    -    module BLAS.Matrix,-    -    ) where--import Control.Monad( zipWithM_ )-import Control.Monad.ST( ST )--import BLAS.Elem( BLAS1 )-import BLAS.Matrix hiding ( BaseMatrix )-import qualified BLAS.Matrix as BLAS-import BLAS.Tensor-import BLAS.UnsafeIOToM-import Unsafe.Coerce--import Data.AEq--import Data.Matrix.Dense.Class( ReadMatrix, WriteMatrix, unsafeCopyMatrix, -    rowViews, coerceMatrix )-import Data.Matrix.Dense.ST( runSTMatrix )-import Data.Vector.Dense( Vector )-import Data.Vector.Dense.IO( IOVector )-import Data.Vector.Dense.ST( STVector, runSTVector )-import Data.Vector.Dense.Class( BaseVector, ReadVector, WriteVector,-    conj, dim, coerceVector, scaleBy, unsafeCopyVector, unsafeAxpyVector,-    unsafeMulVector, unsafeDivVector, newCopyVector )--data Diag x nn e = forall n. Diag (x n e)--coerceDiag :: Diag x mn e -> Diag x mn' e-coerceDiag = unsafeCoerce--diagFromVector :: (BaseVector x) => x n e -> Diag x (n,n) e-diagFromVector = Diag . coerceVector--vectorFromDiag :: (BaseVector x) => Diag x (n,n) e -> x n e-vectorFromDiag (Diag x) = coerceVector x--instance (BaseVector x) => BaseTensor (Diag x) (Int,Int) where-    shape  (Diag x) = (n,n) where n = dim x-    bounds (Diag x) = ((0,0),(n-1,n-1)) where n = dim x--instance (BaseVector x) => BLAS.BaseMatrix (Diag x) where-    herm (Diag x) = Diag (conj x)-    -        -instance (BLAS1 e) => IMatrix (Diag Vector) e where-    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x-    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b--instance (BLAS1 e) => MMatrix (Diag IOVector) e IO where-    unsafeDoSApplyAdd    = unsafeDoSApplyAddDiagVector-    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatDiagVector-    unsafeDoSApply_      = unsafeDoSApplyDiagVector_-    unsafeDoSApplyMat_   = unsafeDoSApplyMatDiagVector_--instance (BLAS1 e) => MMatrix (Diag (STVector s)) e (ST s) where-    unsafeDoSApplyAdd    = unsafeDoSApplyAddDiagVector-    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatDiagVector-    unsafeDoSApply_      = unsafeDoSApplyDiagVector_-    unsafeDoSApplyMat_   = unsafeDoSApplyMatDiagVector_--instance (BLAS1 e, UnsafeIOToM m) => MMatrix (Diag Vector) e m where-    unsafeDoSApplyAdd    = unsafeDoSApplyAddDiagVector-    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatDiagVector-    unsafeDoSApply_      = unsafeDoSApplyDiagVector_-    unsafeDoSApplyMat_   = unsafeDoSApplyMatDiagVector_---unsafeDoSApplyAddDiagVector :: (ReadVector z m, ReadVector x m, WriteVector y m, BLAS1 e) =>-    e -> Diag z (r,s) e -> x s e -> e -> y r e -> m ()-unsafeDoSApplyAddDiagVector alpha a x beta y = do-    x' <- newCopyVector x-    unsafeDoSApplyDiagVector_ 1 (coerceDiag a) x'-    scaleBy beta y-    unsafeAxpyVector alpha x' (coerceVector y)--unsafeDoSApplyAddMatDiagVector :: (ReadVector x m, ReadMatrix b y m, WriteMatrix c z m, BLAS1 e) =>-    e -> Diag x (r,s) e -> b (s,t) e ->  e -> c (r,t) e -> m ()-unsafeDoSApplyAddMatDiagVector alpha a b beta c = do-    scaleBy beta c-    ks <- getElems (vectorFromDiag $ coerceDiag a)-    let (kxs) = zip ks (rowViews b)-        ys    = rowViews c-    zipWithM_ (\(k,x) y -> unsafeAxpyVector (alpha*k) x y) kxs ys--unsafeDoSApplyDiagVector_ :: (ReadVector x m, WriteVector y m, BLAS1 e) =>-    e -> Diag x (s,s) e -> y s e -> m ()-unsafeDoSApplyDiagVector_ alpha a x = do-    unsafeMulVector x (vectorFromDiag a)-    scaleBy alpha x--unsafeDoSApplyMatDiagVector_ :: (ReadVector x m, WriteMatrix b y m, BLAS1 e) =>-    e -> Diag x (s,s) e -> b (s,t) e ->  m ()-unsafeDoSApplyMatDiagVector_ alpha a b = do-    ks <- getElems (vectorFromDiag a)-    zipWithM_ (\k r -> scaleBy (alpha*k) r) ks (rowViews b)---instance (BLAS1 e) => ISolve (Diag Vector) e where-    unsafeSSolve alpha a y    = runSTVector $ unsafeGetSSolve    alpha a y-    unsafeSSolveMat alpha a c = runSTMatrix $ unsafeGetSSolveMat alpha a c--instance (BLAS1 e) => MSolve (Diag IOVector) e IO where-    unsafeDoSSolve     = unsafeDoSSolveDiagVector-    unsafeDoSSolveMat  = unsafeDoSSolveMatDiagVector-    unsafeDoSSolve_    = unsafeDoSSolveDiagVector_-    unsafeDoSSolveMat_ = unsafeDoSSolveMatDiagVector_--instance (BLAS1 e) => MSolve (Diag (STVector s)) e (ST s) where-    unsafeDoSSolve     = unsafeDoSSolveDiagVector-    unsafeDoSSolveMat  = unsafeDoSSolveMatDiagVector-    unsafeDoSSolve_    = unsafeDoSSolveDiagVector_-    unsafeDoSSolveMat_ = unsafeDoSSolveMatDiagVector_--instance (BLAS1 e, UnsafeIOToM m) => MSolve (Diag Vector) e m where-    unsafeDoSSolve     = unsafeDoSSolveDiagVector-    unsafeDoSSolveMat  = unsafeDoSSolveMatDiagVector-    unsafeDoSSolve_    = unsafeDoSSolveDiagVector_-    unsafeDoSSolveMat_ = unsafeDoSSolveMatDiagVector_----unsafeDoSSolveDiagVector :: (ReadVector z m, ReadVector y m, WriteVector x m, BLAS1 e) =>-    e -> Diag z (r,s) e -> y r e -> x s e -> m ()-unsafeDoSSolveDiagVector alpha a y x = do-    unsafeCopyVector x (coerceVector y)-    unsafeDoSSolveDiagVector_ alpha (coerceDiag a) x--unsafeDoSSolveMatDiagVector :: (ReadVector x m, ReadMatrix c z m, WriteMatrix b y m, BLAS1 e) =>-    e -> Diag x (r,s) e -> c (r,t) e -> b (s,t) e -> m ()-unsafeDoSSolveMatDiagVector alpha a c b = do-    unsafeCopyMatrix b (coerceMatrix c)-    unsafeDoSSolveMatDiagVector_ alpha (coerceDiag a) b--unsafeDoSSolveDiagVector_ :: (ReadVector x m, WriteVector y m, BLAS1 e) =>-    e -> Diag x (k,k) e -> y k e -> m ()-unsafeDoSSolveDiagVector_ alpha a x = do-    scaleBy alpha x-    unsafeDivVector x (vectorFromDiag a)--unsafeDoSSolveMatDiagVector_ :: (ReadVector x m, WriteMatrix a y m, BLAS1 e) =>-    e -> Diag x (k,k) e -> a (k,l) e -> m ()-unsafeDoSSolveMatDiagVector_ alpha a b = do-    scaleBy alpha b-    ks <- unsafeInterleaveM $ getElems (vectorFromDiag a)-    zipWithM_ (\k r -> scaleBy (1/k) r) ks (rowViews b)---instance (Show e, BLAS1 e) => Show (Diag Vector (n,n) e) where-    show x = "diagFromVector (" ++ show (vectorFromDiag x) ++ ")"--instance (Eq e, BLAS1 e) => Eq (Diag Vector (n,n) e) where-    (==) x y = (==) (vectorFromDiag x) (vectorFromDiag y)--instance (AEq e, BLAS1 e) => AEq (Diag Vector (n,n) e) where-    (===) x y = (===) (vectorFromDiag x) (vectorFromDiag y)-    (~==) x y = (~==) (vectorFromDiag x) (vectorFromDiag y)--{--instance (BLAS1 e) => ITensor (Diag Vector) (Int,Int) e where-    zero (m,n) | m /= n = error "tried to make a non-square diagonal matrix"-               | otherwise = coerceDiag $ diagFromVector $ zero n--    constant (m,n) e | m /= n = error "tried to make a non-square diagonal matrix"-                     | otherwise = coerceDiag $ diagFromVector $ constant n e-               -    size = size . vectorFromDiag . coerceDiag-    -    assocs a =-        let ies = assocs $ vectorFromDiag $ coerceDiag a-        in map (\(i,e) -> ((i,i),e)) ies-    -    (//) = replaceHelp (//)-    -    tmap f a = (coerceDiag . diagFromVector) -                   (tmap f $ vectorFromDiag $ coerceDiag a)-    -    unsafeAt a (i,j) | i /= j = 0-                     | otherwise = unsafeAt (vectorFromDiag $ coerceDiag a) i-                     -    unsafeReplace = replaceHelp unsafeReplace-    -replaceHelp :: (BLAS1 e) => -       (Vector n e -> [(Int,e)] -> Vector n e) -    -> Diag Vector nn e -> [((Int,Int),e)] -> Diag Vector nn e-replaceHelp f a ijes =-    let iies = filter (\((i,j),_) -> i == j) ijes-        ies  = map (\((i,_),e) -> (i,e)) iies-        x'   = f (vectorFromDiag $ coerceDiag a) ies-    in coerceDiag $ diagFromVector x'-    -    -instance (BLAS1 e) => ReadTensor (Diag Vector) (Int,Int) e IO where-    getSize = getSize . toVector-    -    newCopy a = do-        x' <- newCopy $ toVector a-        return $ fromVector x'-    -    unsafeReadElem a (i,j)-        | i /= j    = return 0-        | otherwise = unsafeReadElem (toVector a) i-        --        -instance (BLAS1 e) => MTensor (DiagMatrix Mut (n,n)) (Int,Int) e IO where-    setZero = setZero . toVector-    -    setConstant k = setConstant k . toVector-    -    canModifyElem a (i,j) = return (i == j && i >= 0 && i < numRows a)-    -    unsafeWriteElem a (i,_) = unsafeWriteElem (toVector a) i-    -    modifyWith f a = modifyWith f (toVector a)-    --}
− Data/Matrix/Herm.hs 
@@ -1,236 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Herm--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Herm (-    Herm(..),-    UpLo(..),--    fromBase,-    toBase,-    mapHerm,--    hermL,-    hermU,--    coerceHerm,--    ) where--import Control.Monad( zipWithM_ )-import Control.Monad.ST( ST )-import Unsafe.Coerce--import BLAS.C( BLAS2, BLAS3, colMajor, rightSide, leftSide, cblasUpLo )-import qualified BLAS.C as BLAS-import BLAS.UnsafeIOToM--import BLAS.Matrix-import BLAS.Types ( UpLo(..), flipUpLo )--import Data.Matrix.Banded( Banded )-import Data.Matrix.Banded.Class -import Data.Matrix.Banded.IO( IOBanded )-import Data.Matrix.Banded.ST( STBanded )-import Data.Matrix.Dense( Matrix )-import Data.Matrix.Dense.Class hiding ( BaseMatrix )-import Data.Matrix.Dense.IO( IOMatrix )-import Data.Matrix.Dense.ST( STMatrix, runSTMatrix )-import Data.Vector.Dense.Class-import Data.Vector.Dense.ST( runSTVector )---data Herm a nn e = Herm UpLo (a nn e)--coerceHerm :: Herm a mn e -> Herm a mn' e-coerceHerm = unsafeCoerce--mapHerm :: (a (n,n) e -> b (n,n) e) -> Herm a (n,n) e -> Herm b (n,n) e-mapHerm f (Herm u a) = Herm u $ f a--fromBase :: UpLo -> a (n,n) e -> Herm a (n,n) e-fromBase = Herm-        -toBase :: Herm a (n,n) e -> (UpLo, a (n,n) e)-toBase (Herm u a) = (u,a)--hermL :: a (n,n) e -> Herm a (n,n) e-hermL = Herm Lower--hermU :: a (n,n) e -> Herm a (n,n) e-hermU = Herm Upper-      -instance BaseMatrix a => BaseTensor (Herm a) (Int,Int) where-    shape  (Herm _ a) = (n,n)             where n = min (numRows a) (numCols a)-    bounds (Herm _ a) = ((0,0),(n-1,n-1)) where n = min (numRows a) (numCols a)-      -instance BaseMatrix a => BaseMatrix (Herm a) where-    herm = coerceHerm-    -instance Show (a mn e) => Show (Herm a mn e) where-    show (Herm u a) = constructor ++ " (" ++ show a ++ ")"-      where-        constructor = case u of-            Lower -> "hermL"-            Upper -> "hermU"---------------------------- Dense Matrix instances ------------------------------hemv :: (ReadMatrix a z m, ReadVector x m, WriteVector y m, BLAS2 e) => -    e -> Herm a (k,k) e -> x k e -> e -> y k e -> m ()-hemv alpha h x beta y-    | numRows h == 0 =-        return ()-    | isConj y = do-        doConj y-        hemv alpha h x beta (conj y)-        doConj y-    | isConj x = do-        x' <- newCopyVector x-        doConj x'-        hemv alpha h (conj x') beta y-    | otherwise =-        let order = colMajor-            (u,a) = toBase h-            n     = numCols a-            u'    = case isHermMatrix a of-                        True  -> flipUpLo u-                        False -> u-            uploA = cblasUpLo u'-            ldA   = ldaOfMatrix a-            incX  = stride x-            incY  = stride y-        in unsafeIOToM $-               withMatrixPtr a $ \pA ->-               withVectorPtr x $ \pX ->-               withVectorPtr y $ \pY ->-                   BLAS.hemv order uploA n alpha pA ldA pX incX beta pY incY--hemm :: (ReadMatrix a x m, ReadMatrix b y m, WriteMatrix c z m, BLAS3 e) => -    e -> Herm a (k,k) e -> b (k,l) e -> e -> c (k,l) e -> m ()-hemm alpha h b beta c-    | numRows b == 0 || numCols b == 0 || numCols c == 0 = return ()-    | (isHermMatrix a) /= (isHermMatrix c) || (isHermMatrix a) /= (isHermMatrix b) =-        zipWithM_ (\x y -> hemv alpha h x beta y) (colViews b) (colViews c)-    | otherwise =-        let order   = colMajor-            (m,n)   = shape c-            (side,u',m',n')-                    = if isHermMatrix a-                          then (rightSide, flipUpLo u, n, m)-                          else (leftSide,  u,          m, n)-            uploA   = cblasUpLo u'-            ldA     = ldaOfMatrix a-            ldB     = ldaOfMatrix b-            ldC     = ldaOfMatrix c-        in unsafeIOToM $-               withMatrixPtr a $ \pA ->-               withMatrixPtr b $ \pB ->-               withMatrixPtr c $ \pC ->-                   BLAS.hemm order side uploA m' n' alpha pA ldA pB ldB beta pC ldC-    where-      (u,a) = toBase h--hemv' :: (ReadMatrix a z m, ReadVector x m, WriteVector y m, BLAS2 e) => -    e -> Herm a (r,s) e -> x s e -> e -> y r e -> m ()-hemv' alpha a x beta y = -    hemv alpha (coerceHerm a) x beta (coerceVector y)--hemm' :: (ReadMatrix a x m, ReadMatrix b y m, WriteMatrix c z m, BLAS3 e) => -    e -> Herm a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-hemm' alpha a b beta c = -    hemm alpha (coerceHerm a) b beta (coerceMatrix c)--instance (BLAS3 e) => IMatrix (Herm Matrix) e where-    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x-    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    --instance (BLAS3 e) => MMatrix (Herm (STMatrix s)) e (ST s) where-    unsafeDoSApplyAdd    = hemv'-    unsafeDoSApplyAddMat = hemm'--instance (BLAS3 e) => MMatrix (Herm IOMatrix) e IO where-    unsafeDoSApplyAdd    = hemv'-    unsafeDoSApplyAddMat = hemm'--instance (BLAS3 e, UnsafeIOToM m) => MMatrix (Herm Matrix) e m where-    unsafeDoSApplyAdd    = hemv'-    unsafeDoSApplyAddMat = hemm'---------------------------- Banded Matrix instances ------------------------------hbmv :: (ReadBanded a z m, ReadVector x m, WriteVector y m, BLAS2 e) => -    e -> Herm a (k,k) e -> x k e -> e -> y k e -> m ()-hbmv alpha h x beta y-    | numRows h == 0 =-        return ()-    | isConj y = do-        doConj y-        hbmv alpha h x beta (conj y)-        doConj y-    | isConj x = do-        x' <- newCopyVector x-        doConj x'-        hbmv alpha h (conj x') beta y-    | otherwise =-        let order = colMajor-            (u,a) = toBase h-            n     = numCols a-            k     = case u of -                        Upper -> numUpper a-                        Lower -> numLower a      -            u'    = case (isHermBanded a) of-                        True  -> flipUpLo u-                        False -> u-            uploA = cblasUpLo u'-            ldA   = ldaOfBanded a-            incX  = stride x-            incY  = stride y-            withPtrA -                  = case u' of Upper -> withBandedPtr a-                               Lower -> withBandedElemPtr a (0,0)-        in unsafeIOToM $-               withPtrA $ \pA ->-               withVectorPtr x $ \pX ->-               withVectorPtr y $ \pY -> do-                   BLAS.hbmv order uploA n k alpha pA ldA pX incX beta pY incY--hbmm :: (ReadBanded a x m, ReadMatrix b y m, WriteMatrix c z m, BLAS2 e) => -    e -> Herm a (k,k) e -> b (k,l) e -> e -> c (k,l) e -> m ()-hbmm alpha h b beta c =-    zipWithM_ (\x y -> hbmv alpha h x beta y) (colViews b) (colViews c)--hbmv' :: (ReadBanded a z m, ReadVector x m, WriteVector y m, BLAS2 e) => -    e -> Herm a (r,s) e -> x s e -> e -> y r e -> m ()-hbmv' alpha a x beta y = -    hbmv alpha (coerceHerm a) x beta (coerceVector y)--hbmm' :: (ReadBanded a x m, ReadMatrix b y m, WriteMatrix c z m, BLAS3 e) => -    e -> Herm a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-hbmm' alpha a b beta c = -    hbmm alpha (coerceHerm a) b beta (coerceMatrix c)--instance (BLAS3 e) => IMatrix (Herm Banded) e where-    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x-    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    --instance (BLAS3 e) => MMatrix (Herm (STBanded s)) e (ST s) where-    unsafeDoSApplyAdd    = hbmv'-    unsafeDoSApplyAddMat = hbmm'--instance (BLAS3 e) => MMatrix (Herm IOBanded) e IO where-    unsafeDoSApplyAdd    = hbmv'-    unsafeDoSApplyAddMat = hbmm'--instance (BLAS3 e, UnsafeIOToM m) => MMatrix (Herm Banded) e m where-    unsafeDoSApplyAdd    = hbmv'-    unsafeDoSApplyAddMat = hbmm'-
− Data/Matrix/Perm.hs 
@@ -1,206 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Perm--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Perm (-    module BLAS.Matrix,--    Perm(..),-    -    -- * The identity permutation-    identity,-    -    -- * Converting to/from @Permutation@s-    fromPermutation,-    toPermutation,-    -    -- * Coercing-    coercePerm--    ) where--import Control.Monad ( forM_ )-import Data.AEq--import BLAS.Elem-import BLAS.Matrix-import BLAS.Tensor-import BLAS.UnsafeIOToM--import Data.Matrix.Dense.Class( ReadMatrix, WriteMatrix, unsafeRowView,-    unsafeAxpyMatrix, coerceMatrix )-import Data.Vector.Dense.Class( ReadVector, WriteVector, dim, isConj, -    scaleBy, unsafeAxpyVector, unsafeSwapVector, coerceVector )-import Data.Vector.Dense.ST( runSTVector )-import Data.Matrix.Dense.ST( runSTMatrix )--{----import Data.Vector.Dense.IO ( dim, isConj, conj, unsafeSwapVectors, -    unsafeCopyVector, unsafeWithElemPtr, unsafeReadElem, unsafeWriteElem, -    coerceVector )-import qualified Data.Vector.Dense.IO as V-    -import Data.Matrix.Dense.IO ( unsafeRow, unsafeCopyMatrix, coerceMatrix )-import qualified Data.Matrix.Dense.IO as M--}--import Data.Permutation ( Permutation )-import qualified Data.Permutation as P--import Unsafe.Coerce---data Perm mn e = -      P { baseOf :: !Permutation-        , isHerm :: !Bool-        }-    | I !Int--identity :: Int -> Perm (n,n) e-identity = I--fromPermutation :: Permutation -> Perm (n,n) e-fromPermutation = flip P False--toPermutation :: Perm (n,n) e -> Permutation-toPermutation (I n)       = P.identity n-toPermutation (P sigma h) = if h then P.inverse sigma else sigma--coercePerm :: Perm mn e -> Perm mn' e-coercePerm = unsafeCoerce--instance BaseTensor Perm (Int,Int) where-    shape (P sigma _) = (n,n) where n = P.size sigma-    shape (I n)       = (n,n)-    -    bounds p = ((0,0), (m-1,n-1)) where (m,n) = shape p-    -instance BaseMatrix Perm where-    herm a@(P _ _) = a{ isHerm=(not . isHerm) a }-    herm a@(I _)   = coercePerm a---{-          -instance (BLAS1 e) => IMatrix Perm e where-instance (BLAS1 e) => RMatrix Perm e where---}--instance (BLAS1 e) => IMatrix Perm e where-    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x-    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b--instance (BLAS1 e, UnsafeIOToM m) => MMatrix Perm e m where-    unsafeDoSApplyAdd    = unsafeDoSApplyAddPerm-    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatPerm-    unsafeDoSApply_      = unsafeDoSApplyPerm_-    unsafeDoSApplyMat_   = unsafeDoSApplyMatPerm_---unsafeDoSApplyPerm_ :: (WriteVector y m, BLAS1 e) => -    e -> Perm (k,k) e -> y k e -> m ()-unsafeDoSApplyPerm_ alpha   (I _)   x = scaleBy alpha x-unsafeDoSApplyPerm_ alpha p@(P _ _) x-    | isHerm p  = P.invertWith swap sigma >> scaleBy alpha x-    | otherwise = P.applyWith swap sigma  >> scaleBy alpha x-  where-    sigma = baseOf p-    swap  = unsafeSwapElems x--unsafeDoSApplyMatPerm_ :: (WriteMatrix c z m, BLAS1 e) => -    e -> Perm (k,k) e -> c (k,l) e -> m ()-unsafeDoSApplyMatPerm_ alpha   (I _)   a = scaleBy alpha a-unsafeDoSApplyMatPerm_ alpha p@(P _ _) a-    | isHerm p  = P.invertWith swap sigma >> scaleBy alpha a-    | otherwise = P.applyWith  swap sigma >> scaleBy alpha a-  where-    sigma    = baseOf p-    swap i j = unsafeSwapVector (unsafeRowView a i) (unsafeRowView a j)---unsafeDoSApplyAddPerm :: (ReadVector x m, WriteVector y m, BLAS1 e) =>-    e -> Perm (k,l) e -> x l e -> e -> y k e -> m ()-unsafeDoSApplyAddPerm alpha (I _) x beta y = do-    scaleBy beta y-    unsafeAxpyVector alpha (coerceVector x) y-unsafeDoSApplyAddPerm alpha p x beta y-    | isConj x =-        unsafeDoSApplyAddPerm (conj alpha) p (conj x) (conj beta) (conj y)-    | otherwise =-        let n     = dim x-            sigma = baseOf p-        in do-            scaleBy beta y-            forM_ [0..(n-1)] $ \i ->-                let i' = P.unsafeApply sigma i-                in case (isHerm p) of-                       False -> do-                           e <- unsafeReadElem x i  -                           f <- unsafeReadElem y i'-                           unsafeWriteElem y i' (alpha*e + f)-                           -                       True  -> do-                           e <- unsafeReadElem x i'-                           f <- unsafeReadElem y i-                           unsafeWriteElem y i (alpha*e + f)--unsafeDoSApplyAddMatPerm :: (ReadMatrix b x m, WriteMatrix c y m, BLAS1 e) =>-    e -> Perm (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-unsafeDoSApplyAddMatPerm alpha (I _) b beta c = do-    scaleBy beta c-    unsafeAxpyMatrix alpha b (coerceMatrix c)-unsafeDoSApplyAddMatPerm alpha p b beta c =-    let m     = numCols p-        sigma = baseOf p-    in do-        scaleBy beta c-        forM_ [0..(m-1)] $ \i ->-            let i' = P.unsafeApply sigma i-            in case (isHerm p) of-                   False -> unsafeAxpyVector alpha (unsafeRowView b i)-                                (unsafeRowView c i') -                   True  -> unsafeAxpyVector alpha (unsafeRowView b i') -                                (unsafeRowView c i)--instance (BLAS1 e) => ISolve Perm e where-    unsafeSSolve alpha a y    = runSTVector $ unsafeGetSSolve    alpha a y-    unsafeSSolveMat alpha a c = runSTMatrix $ unsafeGetSSolveMat alpha a c-    -instance (BLAS1 e, UnsafeIOToM m) => MSolve Perm e m where    -    unsafeDoSSolve_ alpha p       = unsafeDoSApplyPerm_ alpha (herm p)-    unsafeDoSSolveMat_ alpha p    = unsafeDoSApplyMatPerm_ alpha (herm p)-    unsafeDoSSolve alpha p x y    = unsafeDoSApplyAddPerm alpha (coercePerm $ herm p) x 0 y-    unsafeDoSSolveMat alpha p a b = unsafeDoSApplyAddMatPerm alpha (coercePerm $ herm p) a 0 b---instance (Elem e) => Show (Perm (n,n) e) where-    show (I n)         = "identity " ++ show n-    show p | isHerm p  = "herm (" ++ show (herm p) ++ ")"-           | otherwise = "fromPermutation (" ++ show (baseOf p) ++ ")"-    -    -instance Eq (Perm (n,n) e) where-    (==) (I n) (I n') = n == n'-    (==) (I n) p-        | isHerm p   = (==) (I n) (herm p)-        | otherwise  = (==) (fromPermutation $ P.identity n) p-    (==) p     (I n) = (==) (I n) p--    (==) (P sigma h) (P sigma' h') -        | h == h'   = sigma == sigma'-        | otherwise = P.size sigma == P.size sigma'-                      && sigma == (P.inverse sigma')---instance AEq (Perm (n,n) e) where-    (===) = (==)-    (~==) = (==)-
− Data/Matrix/Tri.hs 
@@ -1,653 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : Data.Matrix.Tri--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Matrix.Tri (-    Tri(..),-    UpLo(..), Diag(..),--    fromBase,-    toBase,-    mapTri,--    lower,-    lowerFat,-    lowerTall,-    -    lowerU,-    lowerUFat,-    lowerUTall,-    -    upper,-    upperFat,-    upperTall,-    -    upperU,-    upperUFat,-    upperUTall,--    coerceTri,-    -    module BLAS.Matrix,-    ) where--import BLAS.Matrix--import Control.Monad( when )-import Control.Monad.ST( ST )-import Unsafe.Coerce--import BLAS.C( BLAS2, BLAS3 )-import BLAS.Internal ( checkSquare, checkFat, checkTall )-import BLAS.UnsafeIOToM-import BLAS.Matrix-import BLAS.Types ( UpLo(..), Diag(..), Trans(..), flipTrans, flipUpLo )-import BLAS.C.Types ( cblasDiag, cblasUpLo, cblasTrans, colMajor, -    noTrans, conjTrans, leftSide, rightSide )-import qualified BLAS.C as BLAS-import qualified BLAS.C.Types as BLAS--import Data.Matrix.Banded.Class-import Data.Matrix.Banded( Banded )-import Data.Matrix.Banded.IO( IOBanded )-import Data.Matrix.Banded.ST( STBanded )-import Data.Matrix.Dense.Class hiding ( BaseMatrix )-import Data.Matrix.Dense( Matrix )-import Data.Matrix.Dense.IO( IOMatrix )-import Data.Matrix.Dense.ST( STMatrix, runSTMatrix )-import qualified Data.Matrix.Dense.Class as Dense-import Data.Vector.Dense.Class-import Data.Vector.Dense.ST( runSTVector )-import Foreign( Storable )--data Tri a mn e = Tri UpLo Diag (a mn e)---- | Coerce the shape type.-coerceTri :: Tri a mn e -> Tri a mn' e-coerceTri = unsafeCoerce--mapTri :: (a (m,n) e -> b (m,n) e) -> Tri a (m,n) e -> Tri b (m,n) e-mapTri f (Tri u d a) = Tri u d $ f a--fromBase :: UpLo -> Diag -> a (m,n) e -> Tri a (m,n) e-fromBase = Tri-        -toBase :: Tri a (m,n) e -> (UpLo, Diag, a (m,n) e)-toBase (Tri u d a) = (u,d,a)---lower :: (BaseMatrix a) => a (n,n) e -> Tri a (n,n) e-lower a = checkSquare (shape a) $ Tri Lower NonUnit a--lowerFat :: (BaseMatrix a) => a (m,n) e -> Tri a (m,m) e-lowerFat a = checkFat (shape a) $ Tri Lower NonUnit (unsafeCoerce a)--lowerTall :: (BaseMatrix a) => a (m,n) e -> Tri a (m,n) e-lowerTall a = checkTall (shape a) $ Tri Lower NonUnit a---lowerU :: (BaseMatrix a) => a (n,n) e -> Tri a (n,n) e-lowerU a = checkSquare (shape a) $ Tri Lower Unit a--lowerUFat :: (BaseMatrix a) => a (m,n) e -> Tri a (m,m) e-lowerUFat a = checkFat (shape a) $ Tri Lower Unit (unsafeCoerce a)--lowerUTall :: (BaseMatrix a) => a (m,n) e -> Tri a (m,n) e-lowerUTall a = checkTall (shape a) $ Tri Lower Unit a---upper :: (BaseMatrix a) => a (n,n) e -> Tri a (n,n) e-upper a = checkSquare (shape a) $ Tri Upper NonUnit a--upperFat :: (BaseMatrix a) => a (m,n) e -> Tri a (m,n) e-upperFat a = checkFat (shape a) $ Tri Upper NonUnit a--upperTall :: (BaseMatrix a) => a (m,n) e -> Tri a (n,n) e-upperTall a = checkTall (shape a) $ Tri Upper NonUnit (unsafeCoerce a)---upperU :: (BaseMatrix a) => a (n,n) e -> Tri a (n,n) e-upperU a = checkSquare (shape a) $ Tri Upper Unit a--upperUFat :: (BaseMatrix a) => a (m,n) e -> Tri a (m,n) e-upperUFat a = checkFat (shape a) $ Tri Upper Unit a--upperUTall :: (BaseMatrix a) => a (m,n) e -> Tri a (n,n) e-upperUTall a = checkTall (shape a) $ Tri Upper Unit (unsafeCoerce a)--      -instance BaseMatrix a => BaseTensor (Tri a) (Int,Int) where-    shape (Tri Lower _ a) = (numRows a, min (numRows a) (numCols a))-    shape (Tri Upper _ a) = (min (numRows a) (numCols a), numCols a)-    -    bounds a = ((0,0),(m-1,n-1)) where (m,n) = shape a-    -instance BaseMatrix a => BaseMatrix (Tri a) where-    herm (Tri u d a) = Tri (flipUpLo u) d (herm a)---instance (Show (a (m,n) e), BaseMatrix a) => Show (Tri a (m,n) e) where-    show (Tri u d a) =-        constructor ++ suffix ++ " (" ++ show a ++ ")"-        where-          constructor = case (u,d) of-              (Lower, NonUnit) -> "lower"-              (Lower, Unit   ) -> "lowerU"-              (Upper, NonUnit) -> "upper"-              (Upper, Unit   ) -> "upperU"--          suffix = case undefined of-                       _ | isSquare a -> ""-                       _ | isFat a    -> "Fat"-                       _              -> "Tall"-------------------------- Tri Matrix Apply Functions ---------------------------instance (BLAS3 e) => IMatrix (Tri Matrix) e where-    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x-    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    --instance (BLAS3 e) => MMatrix (Tri IOMatrix) e IO where-    unsafeDoSApplyAdd    = unsafeDoSApplyAddTriMatrix-    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatTriMatrix-    unsafeDoSApply_      = trmv-    unsafeDoSApplyMat_   = trmm--instance (BLAS3 e) => MMatrix (Tri (STMatrix s)) e (ST s) where-    unsafeDoSApplyAdd    = unsafeDoSApplyAddTriMatrix-    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatTriMatrix-    unsafeDoSApply_      = trmv-    unsafeDoSApplyMat_   = trmm--instance (BLAS3 e, UnsafeIOToM m) => MMatrix (Tri Matrix) e m where-    unsafeDoSApplyAdd    = unsafeDoSApplyAddTriMatrix-    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatTriMatrix-    unsafeDoSApply_      = trmv-    unsafeDoSApplyMat_   = trmm----unsafeDoSApplyAddTriMatrix :: (BLAS3 e, ReadMatrix a z m, MMatrix a e m, -    ReadVector x m, WriteVector y m) =>-        e -> Tri a (k,l) e -> x l e -> e -> y k e -> m ()-unsafeDoSApplyAddTriMatrix alpha t x beta y =-    if beta == 0-        then unsafeDoSApplyTriMatrix alpha t x y-        else do-            y' <- newCopyVector y-            unsafeDoSApplyTriMatrix alpha t x y'-            scaleBy beta y-            unsafeAxpyVector 1 y' y--unsafeDoSApplyAddMatTriMatrix :: (BLAS3 e, ReadMatrix a z m, MMatrix a e m, -    ReadMatrix b x m, WriteMatrix c y m) =>-        e -> Tri a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-unsafeDoSApplyAddMatTriMatrix alpha t b beta c =-    if beta == 0-        then unsafeDoSApplyMatTriMatrix alpha t b c-        else do-            c' <- newCopyMatrix c-            unsafeDoSApplyMatTriMatrix alpha t b c'-            scaleBy beta c-            unsafeAxpyMatrix 1 c' c--unsafeDoSApplyTriMatrix :: (BLAS3 e, ReadMatrix a z m, MMatrix a e m, -    ReadVector x m, WriteVector y m) =>-        e -> Tri a (k,l) e -> x l e -> y k e -> m ()-unsafeDoSApplyTriMatrix alpha t x y =-    case (u, toLower d a, toUpper d a) of-        (Lower,Left t',_) -> do-            unsafeCopyVector y (coerceVector x)-            trmv alpha t' y-            -        (Lower,Right (t',r),_) -> do-            let y1 = unsafeSubvector y 0            (numRows t')-                y2 = unsafeSubvector y (numRows t') (numRows r)-            unsafeCopyVector y1 x-            trmv alpha t' y1-            unsafeDoSApplyAdd alpha r x 0 y2-            -        (Upper,_,Left t') -> do-            unsafeCopyVector (coerceVector y) x-            trmv alpha t' (coerceVector y)--        (Upper,_,Right (t',r)) ->-            let x1 = unsafeSubvector x 0            (numCols t')-                x2 = unsafeSubvector x (numCols t') (numCols r)-            in do-                unsafeCopyVector y x1-                trmv alpha t' y-                unsafeDoSApplyAdd alpha r x2 1 y-  where-    (u,d,a) = toBase t--unsafeDoSApplyMatTriMatrix :: (BLAS3 e, ReadMatrix a z m, MMatrix a e m, -    ReadMatrix b x m, WriteMatrix c y m) =>-        e -> Tri a (r,s) e -> b (s,t) e -> c (r,t) e -> m ()-unsafeDoSApplyMatTriMatrix alpha t b c =-    case (u, toLower d a, toUpper d a) of-        (Lower,Left t',_) -> do-            unsafeCopyMatrix c (coerceMatrix b)-            trmm alpha t' c-            -        (Lower,Right (t',r),_) -> do-            let c1 = unsafeSubmatrixView c (0,0)          (numRows t',numCols c)-                c2 = unsafeSubmatrixView c (numRows t',0) (numRows r ,numCols c)-            unsafeCopyMatrix c1 b-            trmm alpha t' c1-            unsafeDoSApplyAddMat alpha r b 0 c2-            -        (Upper,_,Left t') -> do-            unsafeCopyMatrix (coerceMatrix c) b-            trmm alpha t' (coerceMatrix c)--        (Upper,_,Right (t',r)) ->-            let b1 = unsafeSubmatrixView b (0,0)          (numCols t',numCols b)-                b2 = unsafeSubmatrixView b (numCols t',0) (numCols r ,numCols b)-            in do-                unsafeCopyMatrix c b1-                trmm alpha t' c-                unsafeDoSApplyAddMat alpha r b2 1 c-  where-    (u,d,a) = toBase t---toLower :: (Dense.BaseMatrix a x, Storable e) => Diag -> a (m,n) e -        -> Either (Tri a (m,m) e) -                  (Tri a (n,n) e, a (d,n) e)-toLower diag a =-    if m <= n-        then Left $  fromBase Lower diag (unsafeSubmatrixView a (0,0) (m,m))-        else let t = fromBase Lower diag (unsafeSubmatrixView a (0,0) (n,n))-                 r = unsafeSubmatrixView a (n,0) (d,n)-             in Right (t,r)-  where-    (m,n) = shape a-    d     = m - n-    -toUpper :: (Dense.BaseMatrix a x, Storable e) => Diag -> a (m,n) e-        -> Either (Tri a (n,n) e)-                  (Tri a (m,m) e, a (m,d) e)-toUpper diag a =-    if n <= m-        then Left $  fromBase Upper diag (unsafeSubmatrixView a (0,0) (n,n))-        else let t = fromBase Upper diag (unsafeSubmatrixView a (0,0) (m,m))-                 r = unsafeSubmatrixView a (0,m) (m,d)-             in Right (t,r)-  where-    (m,n) = shape a-    d     = n - m--trmv :: (ReadMatrix a x m, WriteVector y m, BLAS3 e) => -    e -> Tri a (k,k) e -> y n e -> m ()-trmv alpha t x -    | dim x == 0 = -        return ()-        -    | isConj x =-        let (u,d,a) = toBase t-            order   = colMajor-            side    = rightSide-            (h,u')  = if isHermMatrix a then (NoTrans, flipUpLo u) else (ConjTrans, u)-            uploA   = cblasUpLo u'-            transA  = cblasTrans h-            diagA   = cblasDiag d-            m       = 1-            n       = dim x-            alpha'  = conj alpha-            ldA     = ldaOfMatrix a-            ldB     = stride x-        in unsafeIOToM $-               withMatrixPtr a $ \pA ->-               withVectorPtr x $ \pB ->-                   BLAS.trmm order side uploA transA diagA m n alpha' pA ldA pB ldB--    | otherwise =-        let (u,d,a)   = toBase t-            order     = colMajor-            (transA,u') = if isHermMatrix a then (conjTrans, flipUpLo u) else (noTrans, u)-            uploA     = cblasUpLo u'-            diagA     = cblasDiag d-            n         = dim x-            ldA       = ldaOfMatrix a-            incX      = stride x-        in do-            when (alpha /= 1) $ scaleBy alpha x-            unsafeIOToM $-                withMatrixPtr a $ \pA ->-                withVectorPtr x $ \pX -> do-                   BLAS.trmv order uploA transA diagA n pA ldA pX incX---trmm :: (ReadMatrix a x m, WriteMatrix b y m, BLAS3 e) => -    e -> Tri a (k,k) e -> b (k,l) e -> m ()-trmm _ _ b-    | numRows b == 0 || numCols b == 0 = return ()-trmm alpha t b =-    let (u,d,a)   = toBase t-        order     = colMajor-        (h,u')    = if isHermMatrix a then (ConjTrans, flipUpLo u) else (NoTrans, u)-        (m,n)     = shape b-        (side,h',m',n',alpha')-                  = if isHermMatrix b-                        then (rightSide, flipTrans h, n, m, conj alpha)-                        else (leftSide , h          , m, n, alpha       )-        uploA     = cblasUpLo u'-        transA    = cblasTrans h'-        diagA     = cblasDiag d-        ldA       = ldaOfMatrix a-        ldB       = ldaOfMatrix b-    in unsafeIOToM $-           withMatrixPtr a $ \pA ->-           withMatrixPtr b $ \pB ->-               BLAS.trmm order side uploA transA diagA m' n' alpha' pA ldA pB ldB--------------------------- Tri Matrix Solve Functions ---------------------------instance (BLAS3 e) => ISolve (Tri Matrix) e where-    unsafeSSolve    alpha a y = runSTVector $ unsafeGetSSolve    alpha a y-    unsafeSSolveMat alpha a c = runSTMatrix $ unsafeGetSSolveMat alpha a c--instance (BLAS3 e) => MSolve (Tri IOMatrix) e IO where-    unsafeDoSSolve     = unsafeDoSSolveTriMatrix-    unsafeDoSSolveMat  = unsafeDoSSolveMatTriMatrix-    unsafeDoSSolve_    = trsv-    unsafeDoSSolveMat_ = trsm--instance (BLAS3 e) => MSolve (Tri (STMatrix s)) e (ST s) where-    unsafeDoSSolve     = unsafeDoSSolveTriMatrix-    unsafeDoSSolveMat  = unsafeDoSSolveMatTriMatrix-    unsafeDoSSolve_    = trsv-    unsafeDoSSolveMat_ = trsm--instance (BLAS3 e, UnsafeIOToM m) => MSolve (Tri Matrix) e m where-    unsafeDoSSolve     = unsafeDoSSolveTriMatrix-    unsafeDoSSolveMat  = unsafeDoSSolveMatTriMatrix-    unsafeDoSSolve_    = trsv-    unsafeDoSSolveMat_ = trsm----unsafeDoSSolveTriMatrix :: (ReadMatrix a z m,-    ReadVector y m, WriteVector x m, BLAS3 e) =>-        e -> Tri a (k,l) e -> y k e -> x l e -> m ()-unsafeDoSSolveTriMatrix alpha t y x =-    case (u, toLower d a, toUpper d a) of-        (Lower,Left t',_) -> do-            unsafeCopyVector x (coerceVector y)-            trsv alpha t' (coerceVector x)-            -        (Lower,Right (t',_),_) -> do-            let y1 = unsafeSubvector y 0            (numRows t')-            unsafeCopyVector x y1-            trsv alpha t' x-            -        (Upper,_,Left t') -> do-            unsafeCopyVector x (coerceVector y)-            trsv alpha t' x--        (Upper,_,Right (t',r)) ->-            let x1 = unsafeSubvector x 0            (numCols t')-                x2 = unsafeSubvector x (numCols t') (numCols r)-            in do-                unsafeCopyVector x1 y-                trsv alpha t' x1-                setZero x2-  where-    (u,d,a) = toBase t---unsafeDoSSolveMatTriMatrix :: (ReadMatrix a z m,-    ReadMatrix c y m, WriteMatrix b x m, BLAS3 e) =>-        e -> Tri a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()-unsafeDoSSolveMatTriMatrix alpha t c b =-    case (u, toLower d a, toUpper d a) of-        (Lower,Left t',_) -> do-            unsafeCopyMatrix b (coerceMatrix c)-            trsm alpha t' (coerceMatrix b)-            -        (Lower,Right (t',_),_) -> do-            let c1 = unsafeSubmatrixView c (0,0)          (numRows t',numCols c)-            unsafeCopyMatrix b c1-            trsm alpha t' b-            -        (Upper,_,Left t') -> do-            unsafeCopyMatrix (coerceMatrix b) c-            trsm alpha t' (coerceMatrix b)--        (Upper,_,Right (t',r)) ->-            let b1 = unsafeSubmatrixView b (0,0)          (numCols t',numCols b)-                b2 = unsafeSubmatrixView b (numCols t',0) (numCols r ,numCols b)-            in do-                unsafeCopyMatrix b1 c-                trsm alpha t' b1-                setZero b2-  where-    (u,d,a) = toBase t---trsv :: (ReadMatrix a x m, WriteVector y m, BLAS3 e) => -    e -> Tri a (k,k) e -> y n e -> m ()-trsv alpha t x-    | dim x == 0 = return ()--    | isConj x =-        let (u,d,a) = toBase t-            order   = colMajor-            side    = rightSide-            (h,u')  = if isHermMatrix a then (NoTrans, flipUpLo u) else (ConjTrans, u)-            uploA   = cblasUpLo u'-            transA  = cblasTrans h-            diagA   = cblasDiag d-            m       = 1-            n       = dim x-            alpha'  = conj alpha-            ldA     = ldaOfMatrix a-            ldB     = stride x-        in unsafeIOToM $-               withMatrixPtr a $ \pA ->-               withVectorPtr x $ \pB ->-                   BLAS.trsm order side uploA transA diagA m n alpha' pA ldA pB ldB--    | otherwise =-        let (u,d,a) = toBase t-            order     = colMajor-            (transA,u') = if isHermMatrix a then (conjTrans, flipUpLo u) else (noTrans, u)-            uploA     = cblasUpLo u'-            diagA     = cblasDiag d-            n         = dim x-            ldA       = ldaOfMatrix a-            incX      = stride x-        in do-            when (alpha /= 1) $ scaleBy alpha x-            unsafeIOToM $-                withMatrixPtr a $ \pA ->-                withVectorPtr x $ \pX ->-                    BLAS.trsv order uploA transA diagA n pA ldA pX incX--trsm :: (ReadMatrix a x m, WriteMatrix b y m, BLAS3 e) => -    e -> Tri a (k,k) e -> b (k,l) e -> m ()-trsm _ _ b-    | numRows b == 0 || numCols b == 0 = return ()-trsm alpha t b =-    let (u,d,a)   = toBase t-        order     = colMajor-        (h,u')    = if isHermMatrix a then (ConjTrans, flipUpLo u) else (NoTrans, u)-        (m,n)     = shape b-        (side,h',m',n',alpha')-                  = if isHermMatrix b-                        then (rightSide, flipTrans h, n, m, conj alpha)-                        else (leftSide , h          , m, n, alpha     )-        uploA     = cblasUpLo u'-        transA    = cblasTrans h'-        diagA     = cblasDiag d-        ldA       = ldaOfMatrix a-        ldB       = ldaOfMatrix b-    in unsafeIOToM $     -           withMatrixPtr a $ \pA ->-           withMatrixPtr b $ \pB -> do-               BLAS.trsm order side uploA transA diagA m' n' alpha' pA ldA pB ldB--------------------------- Tri Banded Apply Functions ---------------------------tbmv :: (ReadBanded a x m, WriteVector y m, BLAS2 e) => -    e -> Tri a (k,k) e -> y n e -> m ()-tbmv alpha t x | isConj x = do-    doConj x-    tbmv alpha t (conj x)-    doConj x--tbmv alpha t x =-    let (u,d,a) = toBase t-        order     = colMajor-        (transA,u') -                  = if isHermBanded a -                        then (conjTrans, flipUpLo u) else (noTrans, u)-        uploA     = cblasUpLo u'-        diagA     = cblasDiag d-        n         = numCols a-        k         = case u of Upper -> numUpper a -                              Lower -> numLower a-        ldA       = ldaOfBanded a-        incX      = stride x-        withPtrA  = case u' of -                        Upper -> withBandedPtr a-                        Lower -> withBandedElemPtr a (0,0)-    in do-        scaleBy alpha x-        unsafeIOToM $-            withPtrA $ \pA ->-            withVectorPtr x $ \pX -> do-                BLAS.tbmv order uploA transA diagA n k pA ldA pX incX--tbmm :: (ReadBanded a x m, WriteMatrix b y m, BLAS2 e) =>-    e -> Tri a (k,k) e -> b (k,l) e -> m ()-tbmm 1     t b = mapM_ (\x -> tbmv 1 t x) (colViews b)-tbmm alpha t b = scaleBy alpha b >> tbmm 1 t b--tbmv' :: (ReadBanded a z m, ReadVector x m, WriteVector y m, BLAS2 e) => -    e -> Tri a (r,s) e -> x s e -> e -> y r e -> m ()-tbmv' alpha a x beta y -    | beta /= 0 = do-        x' <- newCopyVector x-        tbmv alpha (coerceTri a) x'-        scaleBy beta y-        axpyVector 1 x' (coerceVector y)-    | otherwise = do-        unsafeCopyVector (coerceVector y) x-        tbmv alpha (coerceTri a) (coerceVector y)--tbmm' :: (ReadBanded a x m, ReadMatrix b y m, WriteMatrix c z m, BLAS2 e) => -    e -> Tri a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()-tbmm' alpha a b beta c-    | beta /= 0 = do-        b' <- newCopyMatrix b-        tbmm alpha (coerceTri a) b'-        scaleBy beta c-        axpyMatrix 1 b' (coerceMatrix c)-    | otherwise = do-        unsafeCopyMatrix (coerceMatrix c) b-        tbmm alpha (coerceTri a) (coerceMatrix c)--instance (BLAS2 e) => IMatrix (Tri Banded) e where-    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x-    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    --instance (BLAS2 e) => MMatrix (Tri (STBanded s)) e (ST s) where-    unsafeDoSApply_      = tbmv-    unsafeDoSApplyMat_   = tbmm-    unsafeDoSApplyAdd    = tbmv'-    unsafeDoSApplyAddMat = tbmm'--instance (BLAS2 e) => MMatrix (Tri IOBanded) e IO where-    unsafeDoSApply_      = tbmv-    unsafeDoSApplyMat_   = tbmm-    unsafeDoSApplyAdd    = tbmv'-    unsafeDoSApplyAddMat = tbmm'--instance (BLAS2 e, UnsafeIOToM m) => MMatrix (Tri Banded) e m where-    unsafeDoSApply_      = tbmv-    unsafeDoSApplyMat_   = tbmm-    unsafeDoSApplyAdd    = tbmv'-    unsafeDoSApplyAddMat = tbmm'--------------------------- Tri Banded Solve Functions ---------------------------tbsv :: (ReadBanded a x m, WriteVector y m, BLAS2 e) => -    e -> Tri a (k,k) e -> y n e -> m ()-tbsv alpha t x | isConj x = do-    doConj x-    tbsv alpha t (conj x)-    doConj x-    -tbsv alpha t x = -    let (u,d,a) = toBase t-        order     = colMajor-        (transA,u') = if isHermBanded a then (conjTrans, flipUpLo u) else (noTrans, u)-        uploA     = cblasUpLo u'-        diagA     = cblasDiag d-        n         = numCols a-        k         = case u of Upper -> numUpper a -                              Lower -> numLower a        -        ldA       = ldaOfBanded a-        incX      = stride x-        withPtrA  = case u' of -                        Upper -> withBandedPtr a-                        Lower -> withBandedElemPtr a (0,0)-    in do-        scaleBy alpha x-        unsafeIOToM $-            withPtrA $ \pA ->-            withVectorPtr x $ \pX -> do-                BLAS.tbsv order uploA transA diagA n k pA ldA pX incX--tbsm :: (ReadBanded a x m, WriteMatrix b y m, BLAS2 e) => -    e -> Tri a (k,k) e -> b (k,l) e -> m ()-tbsm 1     t b = mapM_ (\x -> tbsv 1 t x) (colViews b)-tbsm alpha t b = scaleBy alpha b >> tbsm 1 t b--unsafeDoSSolveTriBanded :: (ReadBanded a z m,-    ReadVector y m, WriteVector x m, BLAS2 e) =>-        e -> Tri a (k,l) e -> y k e -> x l e -> m ()-unsafeDoSSolveTriBanded alpha a y x = do-    unsafeCopyVector (coerceVector x) y-    tbsv alpha (coerceTri a) (coerceVector x)--unsafeDoSSolveMatTriBanded :: (ReadBanded a z m,-    ReadMatrix c y m, WriteMatrix b x m, BLAS2 e) =>-        e -> Tri a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()-unsafeDoSSolveMatTriBanded alpha a c b = do-    unsafeCopyMatrix (coerceMatrix b) c-    tbsm alpha (coerceTri a) b---instance (BLAS2 e) => ISolve (Tri Banded) e where-    unsafeSSolve    alpha a y = runSTVector $ unsafeGetSSolve    alpha a y-    unsafeSSolveMat alpha a c = runSTMatrix $ unsafeGetSSolveMat alpha a c--instance (BLAS2 e) => MSolve (Tri IOBanded) e IO where-    unsafeDoSSolve     = unsafeDoSSolveTriBanded-    unsafeDoSSolveMat  = unsafeDoSSolveMatTriBanded-    unsafeDoSSolve_    = tbsv-    unsafeDoSSolveMat_ = tbsm--instance (BLAS2 e) => MSolve (Tri (STBanded s)) e (ST s) where-    unsafeDoSSolve     = unsafeDoSSolveTriBanded-    unsafeDoSSolveMat  = unsafeDoSSolveMatTriBanded-    unsafeDoSSolve_    = tbsv-    unsafeDoSSolveMat_ = tbsm--instance (BLAS2 e, UnsafeIOToM m) => MSolve (Tri Banded) e m where-    unsafeDoSSolve     = unsafeDoSSolveTriBanded-    unsafeDoSSolveMat  = unsafeDoSSolveMatTriBanded-    unsafeDoSSolve_    = tbsv-    unsafeDoSSolveMat_ = tbsm
− Data/Vector/Dense.hs 
@@ -1,50 +0,0 @@-{-# OPTIONS_HADDOCK prune #-}--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense (-    module Data.Vector.Dense.Internal,--    -- * Converting between mutable and immutable vectors-    UnsafeFreezeVector(..),-    UnsafeThawVector(..),-    freezeVector,-    thawVector,-    -    ) where--import BLAS.Elem-import Data.Vector.Dense.Internal hiding ( V )-import qualified Data.Vector.Dense.Internal as I-import Data.Vector.Dense.IO-import Data.Vector.Dense.ST--class UnsafeFreezeVector x where-    unsafeFreezeVector :: x n e -> Vector n e-instance UnsafeFreezeVector IOVector where-    unsafeFreezeVector = I.V-instance UnsafeFreezeVector (STVector s) where-    unsafeFreezeVector = unsafeFreezeVector . unsafeSTVectorToIOVector--class UnsafeThawVector x where-    unsafeThawVector :: Vector n e -> x n e-instance UnsafeThawVector IOVector where-    unsafeThawVector (I.V x) = x-instance UnsafeThawVector (STVector s) where-    unsafeThawVector = unsafeIOVectorToSTVector . unsafeThawVector-    -freezeVector :: (ReadVector x m, WriteVector y m, UnsafeFreezeVector y, BLAS1 e) =>-    x n e -> m (Vector n e)-freezeVector x = do-    x' <- newCopyVector x-    return (unsafeFreezeVector x')--thawVector :: (WriteVector y m, BLAS1 e) =>-    Vector n e -> m (y n e)-thawVector = newCopyVector
− Data/Vector/Dense/Class.hs 
@@ -1,49 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class (-    -- * The dense vector type classes-    BaseVector(..),-    ReadVector,-    WriteVector,-    -    -- * Vector shape-    dim,-    coerceVector,-    module BLAS.Tensor.Base,--    -- * Conjugating vectors-    module BLAS.Conj,-    -    module Data.Vector.Dense.Class.Creating,-    module Data.Vector.Dense.Class.Elements,-    module Data.Vector.Dense.Class.Special,-    module Data.Vector.Dense.Class.Views,-    module Data.Vector.Dense.Class.Copying,-    module Data.Vector.Dense.Class.Properties,-    module Data.Vector.Dense.Class.Operations,-    -    -- * Low-level functions-    stride,-    isConj,-    withVectorPtr,-    -    ) where--import Data.Vector.Dense.Class.Internal( BaseVector(..), dim, stride, isConj,-    ReadVector, WriteVector, coerceVector, withVectorPtr )-import BLAS.Tensor.Base-import BLAS.Conj-import Data.Vector.Dense.Class.Creating-import Data.Vector.Dense.Class.Elements-import Data.Vector.Dense.Class.Special-import Data.Vector.Dense.Class.Views-import Data.Vector.Dense.Class.Copying-import Data.Vector.Dense.Class.Properties-import Data.Vector.Dense.Class.Operations
− Data/Vector/Dense/Class/Copying.hs 
@@ -1,43 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Copying--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Copying (-    -- * Copying vectors-    newCopyVector,-    copyVector,-    swapVector,-    unsafeCopyVector,-    unsafeSwapVector,-    --    ) where--import BLAS.C( BLAS1 )-import qualified BLAS.C as BLAS-import BLAS.Internal( checkBinaryOp )--import BLAS.Tensor--import Data.Vector.Dense.Class.Internal----- | @copyVector dst src@ replaces the values in @dst@ with those in--- source.  The operands must be the same shape.-copyVector :: (BLAS1 e, WriteVector y m, ReadVector x m) =>-    y n e -> x n e -> m ()-copyVector y x = checkBinaryOp (shape x) (shape y) $ unsafeCopyVector y x-{-# INLINE copyVector #-}----- | Swap the values stored in two vectors.-swapVector :: (BLAS1 e, WriteVector y m) => -    y n e -> y n e -> m ()-swapVector x y = checkBinaryOp (shape x) (shape y) $ unsafeSwapVector x y-{-# INLINE swapVector #-}-
− Data/Vector/Dense/Class/Creating.hs 
@@ -1,53 +0,0 @@-{-# OPTIONS_HADDOCK hide, prune #-}--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Creating--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Creating (-    -- * Creating new vectors-    newVector_,-    newVector,-    newListVector,-    unsafeNewVector,--    ) where--import Foreign--import BLAS.Elem-import BLAS.Tensor-import BLAS.UnsafeIOToM--import Data.Vector.Dense.Class.Internal------ | Creates a new vector with the given association list.  Unspecified--- indices will get initialized to zero.-newVector :: (WriteVector x m, Elem e) => Int -> [(Int,e)] -> m (x n e)-newVector = newVectorHelp writeElem---- | Same as 'newVector' but indices are not range-checked.-unsafeNewVector :: (WriteVector x m, Elem e) => Int -> [(Int,e)] -> m (x n e)-unsafeNewVector = newVectorHelp unsafeWriteElem--newVectorHelp :: (WriteVector x m, Elem e) => -    (x n e -> Int -> e -> m ()) -> Int -> [(Int,e)] -> m (x n e)-newVectorHelp set n ies = do-    x <- newZeroVector n-    mapM_ (uncurry $ set x) ies-    return x---- | Creates a new vector of the given dimension with the given elements.--- If the list has length less than the passed-in dimenson, the tail of--- the vector will be uninitialized.-newListVector :: (WriteVector x m, Elem e) => Int -> [e] -> m (x n e)-newListVector n es = do-    x <- newVector_ n-    unsafeIOToM $ withVectorPtr x $ flip pokeArray $ take n $ es ++ (repeat 0)-    return x
− Data/Vector/Dense/Class/Elements.hs 
@@ -1,17 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Elements--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Elements (-    -- * Reading and writing vector elements-    module BLAS.Tensor.Read,-    module BLAS.Tensor.Write,-    ) where--import BLAS.Tensor.Read-import BLAS.Tensor.Write
− Data/Vector/Dense/Class/Internal.hs 
@@ -1,475 +0,0 @@-{-# LANGUAGE BangPatterns, MultiParamTypeClasses, FunctionalDependencies,-        FlexibleContexts, FlexibleInstances #-}-{-# OPTIONS_HADDOCK hide, prune #-}--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Internal--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Internal (-    -- * Vector types-    IOVector,-    STVector,-    unsafeIOVectorToSTVector,-    unsafeSTVectorToIOVector,--    -- * Vector type classes-    BaseVector(..),-    ReadVector,-    WriteVector,--    -- * Basic vector propreties-    dim,-    stride,-    isConj,--    -- * Coercing the vector shape-    coerceVector,--    -- * BaseTensor functions-    shapeVector,-    boundsVector,--    -- * ReadTensor functions-    getSizeVector,-    getAssocsVector,-    getIndicesVector,-    getElemsVector,-    getAssocsVector',-    getIndicesVector',-    getElemsVector',-    unsafeReadElemVector,--    -- * WriteTensor functions-    newVector_,-    newZeroVector,-    setZeroVector,-    newConstantVector,-    setConstantVector,-    canModifyElemVector,-    unsafeWriteElemVector,-    modifyWithVector,--    -- * Numeric functions-    doConjVector,-    scaleByVector,-    shiftByVector,-    -    -- * CopyTensor functions-    newCopyVector,-    unsafeCopyVector,-    -    -- * SwapTensor functions-    unsafeSwapVector,-    -    -- * Numeric2 functions-    unsafeAxpyVector,-    unsafeMulVector,-    unsafeDivVector,-     -    -- * Utility functions-    withVectorPtr,-    indexOfVector,-    indicesVector,-    vectorCall,-    vectorCall2,--    ) where--import Control.Monad( forM_ )-import Control.Monad.ST-import Foreign-import Unsafe.Coerce--import BLAS.Internal ( clearArray, inlinePerformIO )-import BLAS.Elem-import qualified BLAS.C as BLAS-import BLAS.Tensor-import BLAS.UnsafeIOToM--import Data.Vector.Dense.Class.Internal.Base--class (BaseVector x, UnsafeIOToM m, ReadTensor x Int m) => ReadVector x m-class (ReadVector x m, WriteTensor x Int m) => WriteVector x m | x -> m, m -> x----- | Cast the shape type of the vector.-coerceVector :: (BaseVector x) => x n e -> x n' e-coerceVector = unsafeCoerce-{-# INLINE coerceVector #-}---------------------------- BaseTensor functions -------------------------------shapeVector :: (BaseVector x) => x n e -> Int-shapeVector = dim-{-# INLINE shapeVector #-}--boundsVector :: (BaseVector x) => x n e -> (Int,Int)-boundsVector x = (0, dim x - 1)-{-# INLINE boundsVector #-}---------------------------- ReadTensor functions ------------------------------    -getSizeVector :: (ReadVector x m) => x n e -> m Int-getSizeVector = return . dim-{-# INLINE getSizeVector #-}--getIndicesVector :: (ReadVector x m) => x n e -> m [Int]-getIndicesVector = return . indicesVector-{-# INLINE getIndicesVector #-}--getIndicesVector' :: (ReadVector x m) => x n e -> m [Int]-getIndicesVector' = getIndicesVector-{-# INLINE getIndicesVector' #-}--getElemsVector :: (ReadVector x m, Elem e) => x n e -> m [e]-getElemsVector x = do-    ies <- getAssocsVector x-    return $ (snd . unzip) ies--getElemsVector' :: (ReadVector x m, Elem e) => x n e -> m [e]-getElemsVector' x = do-    ies <- getAssocsVector' x-    return $ (snd . unzip) ies--getAssocsVector :: (ReadVector x m, Elem e) => x n e -> m [(Int,e)]-getAssocsVector x-    | isConj x =-        getAssocsVector (conj x) -            >>= return . map (\(i,e) -> (i,conj e))-    | otherwise =-        let (f,p,n,incX,_) = arrayFromVector x-        in return $ go n f incX p 0-  where-        go !n !f !incX !ptr !i -            | i >= n = -                 -- This is very important since we are doing unsafe IO.-                 -- Otherwise, the DVector might get discared and the-                 -- memory freed before all of the elements are read-                 inlinePerformIO $ do-                     touchForeignPtr f-                     return []-            | otherwise =-                let e    = inlinePerformIO $ peek ptr-                    ptr' = ptr `advancePtr` incX-                    i'   = i + 1-                    ies  = go n f incX ptr' i'-                in e `seq` ((i,e):ies)-{-# INLINE getAssocsVector #-}--getAssocsVector' :: (ReadVector x m, Elem e) => x n e -> m [(Int,e)]-getAssocsVector' x-    | isConj x =-        getAssocsVector' (conj x) -            >>= return . map (\(i,e) -> (i,conj e))-    | otherwise =-        unsafeIOToM $-            withVectorPtr x $ \ptr ->-                go (dim x) (stride x) ptr 0-  where-        go !n !incX !ptr !i -            | i >= n = -                return []-            | otherwise = do-                e <- peek ptr-                let ptr' = ptr `advancePtr` incX-                    i'   = i + 1-                ies <- go n incX ptr' i'-                return $ (i,e):ies--unsafeReadElemVector :: (ReadVector x m, Elem e) => x n e -> Int -> m e-unsafeReadElemVector x i-    | isConj x = -        unsafeReadElemVector (conj x) i >>= return . conj-    | otherwise =-        unsafeIOToM $-            withVectorPtr x $ \ptr ->-                peekElemOff ptr (indexOfVector x i) ---------------------------- WriteTensor functions --------------------------------- | Creates a new vector of the given length.  The elements will be --- uninitialized.-newVector_ :: (WriteVector x m, Elem e) => Int -> m (x n e)-newVector_ n-    | n < 0 = -        fail $ "Tried to create a vector with `" ++ show n ++ "' elements."-    | otherwise = unsafeIOToM $ do-        arr <- mallocForeignPtrArray n-        return $ vectorViewArray arr (unsafeForeignPtrToPtr arr) n 1 False---- | Create a zero vector of the specified length.-newZeroVector :: (WriteVector y m, Elem e) => Int -> m (y n e)-newZeroVector n = do-    x <- newVector_ n-    setZeroVector x-    return x---- | Set every element in the vector to zero.-setZeroVector :: (WriteVector y m, Elem e) => y n e -> m ()-setZeroVector x -    | stride x == 1 = unsafeIOToM $-                          withVectorPtr x $ -                              flip clearArray (dim x)-    | otherwise     = setConstantVector 0 x---- | Create a constant vector of the specified length.-newConstantVector :: (WriteVector y m, Elem e) => Int -> e -> m (y n e)-newConstantVector n e = do-    x <- newVector_ n-    setConstantVector e x-    return x-        --- | Set every element in the vector to a constant.-setConstantVector :: (WriteVector y m, Elem e) => e -> y n e -> m ()-setConstantVector e x -    | isConj x  = setConstantVector (conj e) (conj x)-    | otherwise = unsafeIOToM $ withVectorPtr x $ go (dim x)-  where-    go !n !ptr | n <= 0 = return ()-               | otherwise = let ptr' = ptr `advancePtr` (stride x)-                                 n'   = n - 1-                             in poke ptr e >> -                                go n' ptr'--canModifyElemVector :: (WriteVector y m) => y n e -> Int -> m Bool-canModifyElemVector _ _ = return True-{-# INLINE canModifyElemVector #-}--unsafeWriteElemVector :: (WriteVector y m, Elem e) => y n e -> Int -> e -> m ()-unsafeWriteElemVector x i e =-    let e' = if isConj x then conj e else e-    in unsafeIOToM $ withVectorPtr x $ \ptr -> -           pokeElemOff ptr (indexOfVector x i) e'-                    -modifyWithVector :: (WriteVector y m, Elem e) => (e -> e) -> y n e -> m ()-modifyWithVector f x-    | isConj x = modifyWithVector (conj . f . conj) (conj x)-    | otherwise = unsafeIOToM $-                      withVectorPtr x $ \ptr ->-                          go (dim x) ptr-  where-    go !n !ptr | n <= 0 = return ()-               | otherwise = do-                   peek ptr >>= poke ptr . f-                   go (n-1) (ptr `advancePtr` incX)--    incX = stride x---------------------------- CopyTensor functions ---------------------------------- | Creats a new vector by copying another one.-newCopyVector :: (BLAS1 e, ReadVector x m, WriteVector y m) => -    x n e -> m (y n e)    -newCopyVector x-    | isConj x = -        newCopyVector (conj x) >>= return . conj-    | otherwise = do-        y <- newVector_ (dim x)-        unsafeCopyVector y x-        return y---- | Same as 'copyVector' but the sizes of the arguments are not checked.-unsafeCopyVector :: (BLAS1 e, WriteVector y m, ReadVector x m) =>-    y n e -> x n e -> m ()-unsafeCopyVector y x-    | isConj x && isConj y =-        unsafeCopyVector (conj y) (conj x)-    | isConj x || isConj y =-        forM_ [0..(dim x - 1)] $ \i -> do-            unsafeReadElem x i >>= unsafeWriteElem y i-    | otherwise =-        vectorCall2 BLAS.copy x y---------------------------- SwapTensor functions ---------------------------------- | Same as 'swapVector' but the sizes of the arguments are not checked.-unsafeSwapVector :: (BLAS1 e, WriteVector y m) => -    y n e -> y n e -> m ()-unsafeSwapVector x y-    | isConj x && isConj y =-        unsafeSwapVector (conj x) (conj y)-    | isConj x || isConj y =-        forM_ [0..(dim x - 1)] $ \i -> do-            tmp <- unsafeReadElem x i-            unsafeReadElem y i >>= unsafeWriteElem x i-            unsafeWriteElem y i tmp-    | otherwise =-        vectorCall2 BLAS.swap x y------------------------------ Numeric functions ---------------------------------doConjVector :: (WriteVector y m, BLAS1 e) => y n e -> m ()-doConjVector = vectorCall BLAS.conj--scaleByVector :: (WriteVector y m, BLAS1 e) => e -> y n e -> m ()-scaleByVector 1 _ = return ()-scaleByVector k x | isConj x    = scaleByVector (conj k) (conj x)-                    | otherwise = vectorCall (flip BLAS.scal k) x-                    -shiftByVector :: (WriteVector y m, Elem e) => e -> y n e -> m ()-shiftByVector k x | isConj x  = shiftByVector (conj k) (conj x)-                  | otherwise = modifyWithVector (k+) x----------------------------- Numeric2 functions ---------------------------------unsafeAxpyVector :: (ReadVector x m, WriteVector y m, BLAS1 e) => -    e -> x n e -> y n e -> m ()-unsafeAxpyVector alpha x y-    | isConj y =-        unsafeAxpyVector (conj alpha) (conj x) (conj y)-    | isConj x =-        vectorCall2 (flip BLAS.acxpy alpha) x y-    | otherwise =-        vectorCall2 (flip BLAS.axpy alpha) x y--unsafeMulVector :: (WriteVector y m, ReadVector x m, BLAS1 e) => -    y n e -> x n e -> m ()-unsafeMulVector y x-    | isConj y =-        unsafeMulVector (conj y) (conj x)-    | isConj x =-        vectorCall2 BLAS.cmul x y-    | otherwise =-        vectorCall2 BLAS.mul x y--unsafeDivVector :: (WriteVector y m, ReadVector x m, BLAS1 e) => -    y n e -> x n e -> m ()-unsafeDivVector y x-    | isConj y =-        unsafeDivVector (conj y) (conj x)-    | isConj x =-        vectorCall2 BLAS.cdiv x y-    | otherwise =-        vectorCall2 BLAS.div x y------------------------------ Utility functions ---------------------------------indexOfVector :: (BaseVector x) => x n e -> Int -> Int-indexOfVector x i = i * stride x-{-# INLINE indexOfVector #-}--indicesVector :: (BaseVector x) => x n e -> [Int]-indicesVector x = [0..(n-1)] where n = dim x-{-# INLINE indicesVector #-}--vectorCall :: (ReadVector x m) => -    (Int -> Ptr e -> Int -> IO a) -        ->  x n e -> m a-vectorCall f x =-    let n    = dim x-        incX = stride x-    in unsafeIOToM $-           withVectorPtr x $ \pX -> -               f n pX incX-{-# INLINE vectorCall #-}--vectorCall2 :: (ReadVector x m, ReadVector y m) => -       (Int -> Ptr e -> Int -> Ptr f -> Int -> IO a) -    -> x n e -> y n' f -> m a-vectorCall2 f x y =-    let n    = dim x-        incX = stride x-        incY = stride y-    in unsafeIOToM $-           withVectorPtr x $ \pX ->-               withVectorPtr y $ \pY ->-                   f n pX incX pY incY-{-# INLINE vectorCall2 #-}    --------------------------------------- Instances --------------------------------data IOVector n e = -      DV {-# UNPACK #-} !(ForeignPtr e) -- memory owner-         {-# UNPACK #-} !(Ptr e)        -- pointer to the first element-         {-# UNPACK #-} !Int            -- the length of the vector-         {-# UNPACK #-} !Int            -- the stride (in elements, not bytes) between elements.-         {-# UNPACK #-} !Bool           -- indicates whether or not the vector is conjugated--newtype STVector s n e = ST (IOVector n e)--unsafeIOVectorToSTVector :: IOVector n e -> STVector s n e-unsafeIOVectorToSTVector = ST--unsafeSTVectorToIOVector :: STVector s n e -> IOVector n e-unsafeSTVectorToIOVector (ST x) = x---instance BaseVector IOVector where-    vectorViewArray                = DV-    {-# INLINE vectorViewArray #-}-    -    arrayFromVector (DV f p n s c) = (f,p,n,s,c)-    {-# INLINE arrayFromVector #-}--instance BaseVector (STVector s) where-    vectorViewArray f p n s c = ST $ DV f p n s c-    {-# INLINE vectorViewArray #-}    -    -    arrayFromVector (ST x)    = arrayFromVector x-    {-# INLINE arrayFromVector #-}--instance BaseTensor IOVector Int where-    bounds = boundsVector-    shape  = shapeVector--instance BaseTensor (STVector s) Int where-    bounds = boundsVector-    shape  = shapeVector-        -instance ReadTensor IOVector Int IO where-    getSize        = getSizeVector-    getAssocs      = getAssocsVector-    getIndices     = getIndicesVector-    getElems       = getElemsVector-    getAssocs'     = getAssocsVector'-    getIndices'    = getIndicesVector'-    getElems'      = getElemsVector'-    unsafeReadElem = unsafeReadElemVector--instance ReadTensor (STVector s) Int (ST s) where-    getSize        = getSizeVector-    getAssocs      = getAssocsVector-    getIndices     = getIndicesVector-    getElems       = getElemsVector-    getAssocs'     = getAssocsVector'-    getIndices'    = getIndicesVector'-    getElems'      = getElemsVector'-    unsafeReadElem = unsafeReadElemVector--instance ReadVector IOVector IO where-instance ReadVector (STVector s) (ST s) where    --instance WriteTensor IOVector Int IO where-    setConstant     = setConstantVector-    setZero         = setZeroVector-    canModifyElem   = canModifyElemVector-    unsafeWriteElem = unsafeWriteElemVector-    modifyWith      = modifyWithVector-    doConj          = doConjVector-    scaleBy         = scaleByVector-    shiftBy         = shiftByVector-    -instance WriteTensor (STVector s) Int (ST s) where-    setConstant     = setConstantVector-    setZero         = setZeroVector-    canModifyElem   = canModifyElemVector-    unsafeWriteElem = unsafeWriteElemVector-    modifyWith      = modifyWithVector-    doConj          = doConjVector-    scaleBy         = scaleByVector-    shiftBy         = shiftByVector--instance WriteVector IOVector IO where-instance WriteVector (STVector s) (ST s) where
− Data/Vector/Dense/Class/Internal/Base.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Internal.Base--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Internal.Base (-    BaseVector(..),-    withVectorPtr,-    dim,-    stride,-    isConj,-    conjVector-    ) where--import Foreign-import BLAS.Tensor.Base--class (BaseTensor x Int) => BaseVector x where-    -    -- | Give a storage region, a base pointer, a length, a stride, and a conjugacy-    -- flag, create a vector view of the underlying memory.-    vectorViewArray :: ForeignPtr e -> Ptr e -> Int -> Int -> Bool -> x n e--    arrayFromVector :: x n e -> (ForeignPtr e, Ptr e, Int, Int, Bool)--conjVector :: (BaseVector x) => x n e -> x n e-conjVector x = let (f,o,n,s,c) = arrayFromVector x-               in vectorViewArray f o n s (not c)-{-# INLINE conjVector #-} --withVectorPtr :: (BaseVector x) => -    x n e -> (Ptr e -> IO a) -> IO a-withVectorPtr x f = -    let (fp,p,_,_,_) = arrayFromVector x-    in do-        a <- f p-        touchForeignPtr fp-        return a-{-# INLINE withVectorPtr #-}--dim :: (BaseVector x) => x n e -> Int-dim x = let (_,_,n,_,_) = arrayFromVector x in n-{-# INLINE dim #-}--stride :: (BaseVector x) => x n e -> Int-stride x = let (_,_,_,s,_) = arrayFromVector x in s-{-# INLINE stride #-}--isConj :: (BaseVector x) => x n e -> Bool-isConj x = let (_,_,_,_,c) = arrayFromVector x in c-{-# INLINE isConj #-}
− Data/Vector/Dense/Class/Operations.hs 
@@ -1,191 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Operations--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Operations (-    -- * Vector operations-    -- ** Unary-    getConjVector,-    getScaledVector,-    getShiftedVector,-    -    -- ** Binary-    getAddVector,-    getSubVector,-    getMulVector,-    getDivVector,-    addVector,-    subVector,-    axpyVector,-    mulVector,-    divVector,--    -- ** Unsafe-    unsafeGetAddVector,-    unsafeGetSubVector,-    unsafeGetMulVector,-    unsafeGetDivVector,-    unsafeAddVector,-    unsafeSubVector,-    unsafeAxpyVector,-    unsafeMulVector,-    unsafeDivVector,-    ) where--import BLAS.Elem( BLAS1 )-import BLAS.Internal( checkBinaryOp )-import BLAS.Tensor( BaseTensor(..) )-import Data.Vector.Dense.Class.Internal------------------------------ Unary Operations --------------------------------- | Get a new vector with elements with the conjugates of the elements--- of the given vector-getConjVector :: (ReadVector x m, WriteVector y m, BLAS1 e) =>-    x n e -> m (y n e)-getConjVector = getUnaryOp doConjVector-{-# INLINE getConjVector #-}---- | Get a new vector by scaling the elements of another vector--- by a given value.-getScaledVector :: (ReadVector x m, WriteVector y m, BLAS1 e) =>-    e -> x n e -> m (y n e)-getScaledVector e = getUnaryOp (scaleByVector e)-{-# INLINE getScaledVector #-}---- | Get a new vector by shifting the elements of another vector--- by a given value.-getShiftedVector :: (ReadVector x m, WriteVector y m, BLAS1 e) =>-    e -> x n e -> m (y n e)-getShiftedVector e = getUnaryOp (shiftByVector e)-{-# INLINE getShiftedVector #-}------------------------------- Binary Operations --------------------------------- | @getAddVector x y@ creates a new vector equal to the sum @x+y@.  The --- operands must have the same dimension.-getAddVector :: -    (ReadVector x m, ReadVector y m, WriteVector z m, BLAS1 e) => -    x n e -> y n e -> m (z n e)-getAddVector = checkTensorOp2 unsafeGetAddVector-{-# INLINE getAddVector #-}--unsafeGetAddVector :: -    (ReadVector x m, ReadVector y m, WriteVector z m, BLAS1 e) => -    x n e -> y n e -> m (z n e)-unsafeGetAddVector = unsafeGetBinaryOp unsafeAddVector-{-# INLINE unsafeGetAddVector #-}---- | @getSubVector x y@ creates a new tensor equal to the difference @x-y@.  --- The operands must have the same dimension.-getSubVector :: -    (ReadVector x m, ReadVector y m, WriteVector z m, BLAS1 e) => -    x n e -> y n e -> m (z n e)-getSubVector = checkTensorOp2 unsafeGetSubVector-{-# INLINE getSubVector #-}--unsafeGetSubVector :: -    (ReadVector x m, ReadVector y m, WriteVector z m, BLAS1 e) => -    x n e -> y n e -> m (z n e)-unsafeGetSubVector = unsafeGetBinaryOp unsafeSubVector-{-# INLINE unsafeGetSubVector #-}---- | @getMulVector x y@ creates a new vector equal to the elementwise product --- @x*y@.  The operands must have the same dimensino-getMulVector :: -    (ReadVector x m, ReadVector y m, WriteVector z m, BLAS1 e) => -    x n e -> y n e -> m (z n e)-getMulVector = checkTensorOp2 unsafeGetMulVector-{-# INLINE getMulVector #-}--unsafeGetMulVector :: -    (ReadVector x m, ReadVector y m, WriteVector z m, BLAS1 e) => -    x n e -> y n e -> m (z n e)-unsafeGetMulVector = unsafeGetBinaryOp unsafeMulVector-{-# INLINE unsafeGetMulVector #-}---- | @getDivVector x y@ creates a new vector equal to the elementwise --- ratio @x/y@.  The operands must have the same shape.-getDivVector :: -    (ReadVector x m, ReadVector y m, WriteVector z m, BLAS1 e) => -    x n e -> y n e -> m (z n e)-getDivVector = checkTensorOp2 unsafeGetDivVector-{-# INLINE getDivVector #-}--unsafeGetDivVector :: -    (ReadVector x m, ReadVector y m, WriteVector z m, BLAS1 e) => -    x n e -> y n e -> m (z n e)-unsafeGetDivVector = unsafeGetBinaryOp unsafeDivVector-{-# INLINE unsafeGetDivVector #-}---- | @axpyVector alpha x y@ replaces @y@ with @alpha * x + y@.-axpyVector :: (ReadVector x m, WriteVector y m, BLAS1 e) =>-    e -> x n e -> y n e -> m ()-axpyVector alpha x y = -    checkBinaryOp (shape x) (shape y) $ unsafeAxpyVector alpha x y-{-# INLINE axpyVector #-}---- | @addVector y x@ replaces @y@ with @y+x@.-addVector :: (WriteVector y m, ReadVector x m, BLAS1 e) => -    y n e -> x n e -> m ()-addVector y x = checkBinaryOp (dim y) (dim x) $ unsafeAddVector y x-{-# INLINE addVector #-}--unsafeAddVector :: (WriteVector y m, ReadVector x m, BLAS1 e) => -    y n e -> x n e -> m ()-unsafeAddVector y x = unsafeAxpyVector 1 x y---- | @subVector y x@ replaces @y@ with @y-x@.-subVector :: (WriteVector y m, ReadVector x m, BLAS1 e) => -    y n e -> x n e -> m ()-subVector y x = checkBinaryOp (dim y) (dim x) $ unsafeSubVector y x-{-# INLINE subVector #-}--unsafeSubVector :: (WriteVector y m, ReadVector x m, BLAS1 e) => -    y n e -> x n e -> m ()-unsafeSubVector y x = unsafeAxpyVector (-1) x y---- | @mulVector y x@ replaces @y@ with @y*x@.-mulVector :: (WriteVector y m, ReadVector x m, BLAS1 e) => -    y n e -> x n e -> m ()-mulVector y x =-    checkBinaryOp (shape y) (shape x) $ unsafeMulVector y x-{-# INLINE mulVector #-}---- | @divVector y x@ replaces @y@ with @y/x@.-divVector :: (WriteVector y m, ReadVector x m, BLAS1 e) => -    y n e -> x n e -> m ()-divVector y x =-    checkBinaryOp (shape y) (shape x) $ unsafeDivVector y x-{-# INLINE divVector #-}---checkTensorOp2 :: (BaseTensor x i, BaseTensor y i) => -    (x n e -> y n e -> a) ->-        x n e -> y n e -> a-checkTensorOp2 f x y = -    checkBinaryOp (shape x) (shape y) $ f x y-{-# INLINE checkTensorOp2 #-}--getUnaryOp :: (ReadVector x m, WriteVector y m, BLAS1 e) =>-    (y n e -> m ()) -> x n e -> m (y n e)-getUnaryOp f x = do-    y <- newCopyVector x-    f y-    return y-{-# INLINE getUnaryOp #-}--unsafeGetBinaryOp :: -    (WriteVector z m, ReadVector x m, ReadVector y m, BLAS1 e) => -    (z n e -> y n e -> m ()) ->-        x n e -> y n e -> m (z n e)-unsafeGetBinaryOp f x y = do-    z <- newCopyVector x-    f z y-    return z
− Data/Vector/Dense/Class/Properties.hs 
@@ -1,65 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Properties--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Properties (-    -- * Vector Properties-    getSumAbs,-    getNorm2,-    getWhichMaxAbs,-    getDot,-    unsafeGetDot,--    ) where--import BLAS.C( BLAS1 )-import BLAS.Conj-import BLAS.Internal (  checkVecVecOp )-import qualified BLAS.C as BLAS--import BLAS.Tensor--import Data.Vector.Dense.Class.Internal----- | Gets the sum of the absolute values of the vector entries.-getSumAbs :: (ReadVector x m, BLAS1 e) => x n e -> m Double-getSumAbs = vectorCall BLAS.asum-    --- | Gets the 2-norm of a vector.-getNorm2 :: (ReadVector x m, BLAS1 e) => x n e -> m Double-getNorm2 = vectorCall BLAS.nrm2---- | 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 :: (ReadVector x m, BLAS1 e) => x n e -> m (Int, e)-getWhichMaxAbs x =-    case (dim x) of-        0 -> fail $ "getWhichMaxAbs of an empty vector"-        _ -> do-            i <- vectorCall BLAS.iamax x-            e <- unsafeReadElem x i-            return (i,e)----- | Computes the dot product of two vectors.-getDot :: (ReadVector x m, ReadVector y m, BLAS1 e) => -    x n e -> y n e -> m e-getDot x y = checkVecVecOp "getDot" (dim x) (dim y) $ unsafeGetDot x y-{-# INLINE getDot #-}--unsafeGetDot :: (ReadVector x m, ReadVector y m, BLAS1 e) => -    x n e -> y n e -> m e-unsafeGetDot x y =-    case (isConj x, isConj y) of-        (False, False) -> vectorCall2 BLAS.dotc x y-        (True , False) -> vectorCall2 BLAS.dotu x y-        (False, True ) -> vectorCall2 BLAS.dotu x y >>= return . conj-        (True , True)  -> vectorCall2 BLAS.dotc x y >>= return . conj-{-# INLINE unsafeGetDot #-}
− Data/Vector/Dense/Class/Special.hs 
@@ -1,49 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Special--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Special (-    -- * Special vectors-    newZeroVector,-    newConstantVector,-    newBasisVector,-    setZeroVector,-    setConstantVector,-    setBasisVector,-        -    ) where--import Foreign--import BLAS.Elem-import BLAS.Tensor--import Data.Vector.Dense.Class.Internal-import Data.Vector.Dense.Class.Creating----- | @newBasisVector n i@ creates a vector of length @n@ that is all zero --- except for at position @i@, where it equal to one.-newBasisVector :: (WriteVector x m, Elem e) => Int -> Int -> m (x n e)-newBasisVector n i = do-    x <- newVector_ n-    setBasisVector i x-    return x----- | @setBasis x i@ sets the @i@th coordinate of @x@ to @1@, and all other--- coordinates to @0@.  If the vector has been scaled, it is possible that--- @readVector x i@ will not return exactly @1@.  See 'setElem'.-setBasisVector :: (WriteVector x m, Elem e) => Int -> x n e -> m ()-setBasisVector i x-    | i < 0 || i >= dim x =-        fail $ "tried to set a vector of dimension `" ++ show (dim x) ++ "'"-               ++ " to basis vector `" ++ show i ++ "'"-    | otherwise = do-        setZeroVector x-        unsafeWriteElem x i 1
− Data/Vector/Dense/Class/Views.hs 
@@ -1,48 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Class.Views--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.Class.Views (-    -- * Vector views-    subvector,-    subvectorWithStride,-    unsafeSubvector,-    unsafeSubvectorWithStride,--    ) where--import BLAS.Internal ( checkedSubvector, checkedSubvectorWithStride )-import Data.Vector.Dense.Class.Internal-import Foreign----- | @subvector x o n@ creates a subvector view of @x@ starting at index @o@ --- and having length @n@.-subvector :: (BaseVector x, Storable e) => -    x n e -> Int -> Int -> x n' e-subvector x = checkedSubvector (dim x) (unsafeSubvector x)-{-# INLINE subvector #-}--unsafeSubvector :: (BaseVector x, Storable e) => -    x n e -> Int -> Int -> x n' e-unsafeSubvector = unsafeSubvectorWithStride 1-{-# INLINE unsafeSubvector #-}---- | @subvectorWithStride s x o n@ creates a subvector view of @x@ starting --- at index @o@, having length @n@ and stride @s@.-subvectorWithStride :: (BaseVector x, Storable e) => -    Int -> x n e -> Int -> Int -> x n' e-subvectorWithStride s x = -    checkedSubvectorWithStride s (dim x) (unsafeSubvectorWithStride s x)-{-# INLINE subvectorWithStride #-}--unsafeSubvectorWithStride :: (BaseVector x, Storable e) => -    Int -> x n e -> Int -> Int -> x n' e-unsafeSubvectorWithStride s' x o' n' =-    let (f,p,_,s,c) = arrayFromVector x-    in vectorViewArray f (p `advancePtr` (s*o')) n' (s*s') c
− Data/Vector/Dense/IO.hs 
@@ -1,18 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.IO--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.IO (-    -- * The IOVector data type-    IOVector,-    -    module Data.Vector.Dense.Class,-    ) where--import Data.Vector.Dense.Class.Internal( IOVector )-import Data.Vector.Dense.Class
− Data/Vector/Dense/Internal.hs 
@@ -1,284 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module     : Data.Vector.Dense.Internal--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental----module Data.Vector.Dense.Internal (-    -- * The Vector type-    Vector(..),--    -- * Vector shape-    dim,-    coerceVector,-    module BLAS.Tensor.Base,--    -- * Conjugating vectors-    module BLAS.Conj,--    -- * Creating new vectors-    vector, -    listVector,-    unsafeVector,--    -- * Reading vector elements-    module BLAS.Tensor.Immutable,--    -- * Special vectors-    zeroVector,-    constantVector,-    basisVector,--    -- * Vector views-    subvector,-    subvectorWithStride,-    unsafeSubvector,-    unsafeSubvectorWithStride,--    -- * Vector properties-    sumAbs,-    norm2,-    whichMaxAbs,-    (<.>),--    -- * Low-level vector properties-    stride,-    isConj,-    ) where--import Data.AEq-import System.IO.Unsafe--import BLAS.Conj-import BLAS.Tensor.Base-import BLAS.Tensor.Immutable--import BLAS.Elem ( BLAS1 )-import BLAS.Internal ( inlinePerformIO )-import BLAS.UnsafeIOToM--import Data.Vector.Dense.IO-import Data.Vector.Dense.Class---infixl 7 <.>---newtype Vector n e = V (IOVector n e)---unsafeFreezeIOVector :: IOVector n e -> Vector n e-unsafeFreezeIOVector = V-unsafeThawIOVector :: Vector n e -> IOVector n e-unsafeThawIOVector (V x) = x---liftVector :: (IOVector n e -> a) -> Vector n e -> a-liftVector f (V x) = f x-{-# INLINE liftVector #-}--liftVector2 :: -    (IOVector n e -> IOVector n e -> a) -> -        Vector n e -> Vector n e -> a-liftVector2 f x = liftVector (liftVector f x)-{-# INLINE liftVector2 #-}--unsafeLiftVector :: (IOVector n e -> IO a) -> Vector n e -> a-unsafeLiftVector f = unsafePerformIO . liftVector f-{-# NOINLINE unsafeLiftVector #-}--unsafeLiftVector2 :: -    (IOVector n e -> IOVector n e -> IO a) -> -        Vector n e -> Vector n e -> a-unsafeLiftVector2 f x y = unsafePerformIO $ liftVector2 f x y-{-# NOINLINE unsafeLiftVector2 #-}--inlineLiftVector :: (IOVector n e -> IO a) -> Vector n e -> a-inlineLiftVector f = inlinePerformIO . liftVector f-{-# INLINE inlineLiftVector #-}---- | Create a vector with the given dimension and elements.  The elements--- given in the association list must all have unique indices, otherwise--- the result is undefined.-vector :: (BLAS1 e) => Int -> [(Int, e)] -> Vector n e-vector n ies = unsafeFreezeIOVector $ unsafePerformIO $ newVector n ies-{-# NOINLINE vector #-}---- | Same as 'vector', but does not range-check the indices.-unsafeVector :: (BLAS1 e) => Int -> [(Int, e)] -> Vector n e-unsafeVector n ies = unsafeFreezeIOVector $ unsafePerformIO $ unsafeNewVector n ies-{-# NOINLINE unsafeVector #-}---- | Create a vector of the given dimension with elements initialized--- to the values from the list.  @listVector n es@ is equivalent to --- @vector n (zip [0..(n-1)] es)@, except that the result is undefined --- if @length es@ is less than @n@.-listVector :: (BLAS1 e) => Int -> [e] -> Vector n e-listVector n es = unsafeFreezeIOVector $ unsafePerformIO $ newListVector n es-{-# NOINLINE listVector #-}---- | @zeroVector n@ creates a vector of dimension @n@ with all values--- set to zero.-zeroVector :: (BLAS1 e) => Int -> Vector n e-zeroVector n = unsafeFreezeIOVector $ unsafePerformIO $ newZeroVector n-{-# NOINLINE zeroVector #-}---- | @constantVector n e@ creates a vector of dimension @n@ with all values--- set to @e@.-constantVector :: (BLAS1 e) => Int -> e -> Vector n e-constantVector n e = unsafeFreezeIOVector $ unsafePerformIO $ newConstantVector n e-{-# NOINLINE constantVector #-}---- | @basisVector n i@ creates a vector of dimension @n@ with zeros --- everywhere but position @i@, where there is a one.-basisVector :: (BLAS1 e) => Int -> Int -> Vector n e-basisVector n i = unsafeFreezeIOVector $ unsafePerformIO $ newBasisVector n i-{-# NOINLINE basisVector #-}---- | Compute the sum of absolute values of entries in the vector.-sumAbs :: (BLAS1 e) => Vector n e -> Double-sumAbs = unsafeLiftVector getSumAbs-{-# NOINLINE sumAbs #-}---- | Compute the 2-norm of a vector.-norm2 :: (BLAS1 e) => Vector n e -> Double-norm2 = unsafeLiftVector getNorm2-{-# NOINLINE 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 n e -> (Int, e)-whichMaxAbs = unsafeLiftVector getWhichMaxAbs-{-# NOINLINE whichMaxAbs #-}---- | Compute the dot product of two vectors.-(<.>) :: (BLAS1 e) => Vector n e -> Vector n e -> e-(<.>) = unsafeLiftVector2 getDot-{-# NOINLINE (<.>) #-}---instance BaseTensor Vector Int where-    shape  = liftVector shape-    bounds = liftVector bounds--instance ITensor Vector Int where-    (//)          = replaceHelp writeElem-    unsafeReplace = replaceHelp unsafeWriteElem-    -    unsafeAt x i  = inlineLiftVector (flip unsafeReadElem i) x-    {-# INLINE unsafeAt #-}-    -    size          = inlineLiftVector getSize-    elems         = inlineLiftVector getElems-    indices       = inlineLiftVector getIndices-    assocs        = inlineLiftVector getAssocs--    tmap f x      = listVector (dim x) (map f $ elems x)--    (*>) k x = unsafeFreezeIOVector $ unsafeLiftVector (getScaledVector k) x-    {-# NOINLINE (*>) #-}--    shift k x = unsafeFreezeIOVector $ unsafeLiftVector (getShiftedVector k) x-    {-# NOINLINE shift #-}---replaceHelp :: (BLAS1 e) => -    (IOVector n e -> Int -> e -> IO ()) ->-        Vector n e -> [(Int, e)] -> Vector n e-replaceHelp set x ies =-    unsafePerformIO $ do-        y  <- newCopyVector (unsafeThawIOVector x)-        mapM_ (uncurry $ set y) ies-        return (unsafeFreezeIOVector y)-{-# NOINLINE replaceHelp #-}--instance (Monad m) => ReadTensor Vector Int m where-    getSize        = return . size-    getAssocs      = return . assocs-    getIndices     = return . indices-    getElems       = return . elems-    getAssocs'     = return . assocs-    getIndices'    = return . indices-    getElems'      = return . elems-    unsafeReadElem x i = return $ unsafeAt x i-    ---instance BaseVector Vector where-    vectorViewArray f o n s c = V $ vectorViewArray f o n s c-    arrayFromVector           = liftVector arrayFromVector--instance (UnsafeIOToM m) => ReadVector Vector m where-    -instance (BLAS1 e) => Num (Vector n e) where-    (+) x y     = unsafeFreezeIOVector $ unsafeLiftVector2 getAddVector x y-    (-) x y     = unsafeFreezeIOVector $ unsafeLiftVector2 getSubVector x y-    (*) x y     = unsafeFreezeIOVector $ unsafeLiftVector2 getMulVector x y-    negate      = ((-1) *>)-    abs         = tmap abs-    signum      = tmap signum-    fromInteger = (constantVector 1) . fromInteger-    -instance (BLAS1 e) => Fractional (Vector n e) where-    (/) x y      = unsafeFreezeIOVector $ unsafeLiftVector2 getDivVector x y-    recip        = tmap recip-    fromRational = (constantVector 1) . fromRational -    -instance (BLAS1 e, Floating e) => Floating (Vector n e) where-    pi    = constantVector 1 pi-    exp   = tmap exp-    sqrt  = tmap sqrt-    log   = tmap log-    (**)  = tzipWith (**)-    sin   = tmap sin-    cos   = tmap cos-    tan   = tmap tan-    asin  = tmap asin-    acos  = tmap acos-    atan  = tmap atan-    sinh  = tmap sinh-    cosh  = tmap cosh-    tanh  = tmap tanh-    asinh = tmap asinh-    acosh = tmap acosh-    atanh = tmap atanh--tzipWith :: (BLAS1 e) =>-    (e -> e -> e) -> Vector n e -> Vector n e -> Vector n e-tzipWith f x y-    | dim y /= n =-        error ("tzipWith: vector lengths differ; first has length `" ++-                show n ++ "' and second has length `" ++-                show (dim y) ++ "'")-    | otherwise =-        listVector n (zipWith f (elems x) (elems y))-  where-    n = dim x---instance (BLAS1 e, Show e) => Show (Vector n e) where-    show x-        | isConj x  = "conj (" ++ show (conj x) ++ ")"-        | otherwise = "listVector " ++ show (dim x) ++ " " ++ show (elems x)--instance (BLAS1 e, Eq e) => Eq (Vector n e) where-    (==) = compareHelp (==)--instance (BLAS1 e, AEq e) => AEq (Vector n e) where-    (===) = compareHelp (===)-    (~==) = compareHelp (~==)--compareHelp :: (BLAS1 e) => -    (e -> e -> Bool) -> -        Vector n e -> Vector n e -> Bool-compareHelp cmp x y-    | isConj x && isConj y =-        compareHelp cmp (conj x) (conj y)-    | otherwise =-        (dim x == dim y) && (and $ zipWith cmp (elems x) (elems y))--
− Data/Vector/Dense/ST.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE Rank2Types, FlexibleInstances, MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module     : Vector.Dense.ST--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Data.Vector.Dense.ST (-    -- * The @STVector@ data type-    STVector,-    runSTVector,--    unsafeIOVectorToSTVector,-    unsafeSTVectorToIOVector,-    -    module Data.Vector.Dense.Class-    ) where--import Control.Monad.ST-import Data.Vector.Dense.Class.Internal( STVector, unsafeIOVectorToSTVector,-    unsafeSTVectorToIOVector )-import Data.Vector.Dense.Class-import Data.Vector.Dense.Internal ( Vector(..) )--runSTVector :: (forall s . ST s (STVector s n e)) -> Vector n e-runSTVector x = -    runST $ x >>= return . V . unsafeSTVectorToIOVector
− INSTALL 
@@ -1,106 +0,0 @@--                   INSTALLING THE blas LIBRARY--This document tells you how to build and install the blas library, and how-to build and run the tests for the library.  --TABLE OF CONTENTS-I.   Prerequisites-II.  Configuring-III. Building and Installing-IV.  Verifying the Installation-V.   Building and Running the Tests-VI.  Custom CBLAS Configurations---I. PREREQUISITES--Installing blas requires a working CBLAS to be installed on your system.  If you-do not have a CBLAS installed and you are not too concerned about performance,-probably the easiest to install is the one that comes with the GNU Scientific-Library (GSL), available at http://www.gnu.org/software/gsl/.  If you care about-performance, a better option is to use ATLAS, available at -http://math-atlas.sourceforge.net/.  Other options include the Goto BLAS and-Intel's MKL library.  If you are running Mac OS X, you can use vecLib, which-is part of the Accelerate framework and is installed by default.---II. CONFIGURING--To configure blas, first decide which CBLAS you want to link to and figure out-the appropriate flag.  The default flags are as follows:--    CBLAS Vendor                                 Flag-    -------------------------------------------------------    ATLAS                                        -fatlas-    GSL                                          -fgsl-    Intel MKL                                    -fmkl-    vecLib                                       -fveclib-    Other vendor or non-standard installation    -fcustom-    -Now, run the command "runhaskell Setup.lhs configure" with the appropriate -flag.  For example, to link with ATLAS, you would run the command:--# runhaskell Setup.lhs configure -fatlas--You can also pass additional arguments to the configure script.  To see a full-list, do "runhaskell Setup.lhs configure --help".  If you do not pass a flag-to the configure script, ATLAS is used by default.  Do not try passing more than-one CBLAS flag to the script.---III. BUILDING AND INSTALLING--To build the library, execute the command--# runhaskell Setup.lhs build--To build the haddock documentation, run--# runhaskell Setup.lhs haddock--Lastly, to install the library, do--# runhaskell Setup.lhs install---IV. VERIFYING THE INSTALLATION--Once you have installed blas, try running the command "ghci -package blas".  You-should not get any "unknown symbol" errors.---V. BUILDING AND RUNNING THE TESTS--If you have verified that blas is installed correctly, you can try building and-running the tests.  These are in the "tests" directory, and are in the form of-QuickCheck properties.  To build and run them, just run "make" in the tests-directory.  --NOTE: there is a bug in the version of QuickCheck that comes with GHC 6.8 and-older that will either cause some of the tests to fail or cause the test suite-to hang. You need version 1.2.0.0 or later (the version that comes with GHC-6.10). For older GHC versions, you can get a patched QuickCheck from the darcs-repository at http://darcs.haskell.org/packages/QuickCheck/ .---VI. CUSTOM CBLAS CONFIGURATIONS--If your CBLAS is not one of the defaults listed above or it is not installed in-a standard location, you need to edit the blas.cabal file to tell the -installation script where it lives.  At the end of the file, you will see the-following lines:--    if flag(custom)-        -- CUSTOM CBLAS LIBS GO HERE-        extra-libraries:    -        -        -- PATH TO CUSTOM LIB DIR GOES HERE -        extra-lib-dirs:     -    -You need to fill in the names and locations of your CBLAS libraries.  If your-CBLAS is in a library with dependencies, make sure you list the dependencies-*after* the libraries that depend on them.    --Once you have edited blas.cabal, build and install as normal, using the -"-fcustom" flag when you configure the library.
− LICENSE 
@@ -1,30 +0,0 @@-Copyright (c) Patrick Perry <patperry@stanford.edu> 2008--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
@@ -1,6 +1,38 @@ -Changes in 0.6:+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.@@ -14,7 +46,8 @@   now provide access to rows and columns.    -Changes in 0.5:+Changes in 0.5+--------------  * Add Banded matrix data type, as well as Tri Banded and Herm Banded.
+ 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 library to link with.  To link+with a custom BLAS, add the "--with-blas=<lib>" argument to --configure-option,+e.g++    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
@@ -1,3 +1,3 @@ #!/usr/bin/env runhaskell > import Distribution.Simple-> main = defaultMain+> main = defaultMainWithHooks autoconfUserHooks
TODO view
@@ -1,7 +1,41 @@ +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 [on my blog][] is a good starting point.+  [on my blog]:http://quantile95.com/2008/10/31/ann-blas-bindings-for-haskell-version-06++* 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. ++* Put better checks in swapElem for WriteTensor.++* Better error reporting.  Change the "check" functions in BLAS.Internal+  to be like "checkIsSquare".++* The ReadTensor/WriteTensor functions for Banded matrices are+  really terrible.  Re-write these to be more efficient.+ * Add getSum/sum.  Put in re-write rules from scale and add to axpy.  Here- is the old code and re-write rules:+  is the old code and re-write rules (from version 0.4):  +   <pre><code>     unsafeGetSum :: (BLAS1 e) =>          e -> DVector s n e -> e -> DVector t n e -> IO (DVector r n e)     unsafeGetSum 1 x beta y@@ -17,58 +51,85 @@             return (unsafeCoerce s)      {-# RULES-    "scale/plus"   forall k l x y. plus (scale k x) (scale l y) = add k x l y-    "scale1/plus"  forall k x y.   plus (scale k x) y = add k x 1 y-    "scale2/plus"  forall k x y.   plus x (scale k y) = add 1 x k y--    "scale/minus"  forall k l x y. minus (scale k x) (scale l y) = -                                       add k x (-l) y-    "scale1/minus" forall k x y.   minus (scale k x) y = add k x (-1) y-    "scale2/minus" forall k x y.   minus x (scale k y) = add 1 x (-k) y+      "scale/plus"   forall k l x y. plus (scale k x) (scale l y) = add k x l y+      "scale1/plus"  forall k x y.   plus (scale k x) y = add k x 1 y+      "scale2/plus"  forall k x y.   plus x (scale k y) = add 1 x k y+      +      "scale/minus"  forall k l x y. minus (scale k x) (scale l y) = +                                         add k x (-l) y+      "scale1/minus" forall k x y.   minus (scale k x) y = add k x (-1) y+      "scale2/minus" forall k x y.   minus x (scale k y) = add 1 x (-k) y       #-}+  </pre></code> -* Matrix creation functions are inconsistent in phantom types.  Some have-  pairs, some do not.+Medium projects+--------------- -* Add getSubmatrix function to MMatrix.+* Looking at the HPC output, there are a few important code paths that +  aren't getting covered by the tests.  Specifically in the following +  functions: gemm, hemv, hemm, hbmm, trmv, trmm, etc.  These functions+  are in Data.Matrix.Banded.IOBase and Data.Matrix.Dense.Base.+  It is impossible to test these code paths using pure code.  You need to+  use STMatrix and STVector.  I suggest stealing "Mondaic.hs" from+  QuickCheck2 for this purpose.   -* Add getDense/toDense to MMatrix/IMatrix+* There do not yet exist bindings for `ger`, `syr`, etc.  Add them.  The+  bindings should only be for mutable types, and should have names like+  `rank1UpdateMatrix`, `rankKUpdateHermMatrix`, etc. -* Add addVector, subVector, addMatrix, subMatrix, etc.+* 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. -* Put better checks in swapElem for WriteTensor+* Provide custum `unsafeGetRow`/`unsafeGetCol` functions for Herm Matrix,+  Tri Matrix, etc. rather than using matrix multiplication, which is what+  the default instance does. -* STDiag and IODiag instead of current type?+* Provide Read/Write Tensor instances for Herm Matrix, Tri Matrix, +  Herm Banded, etc. -* Merge UnsafeIOToM and UnsafeInterleaveM+* Write tests for STBanded.  The easiest way to do this is to mimic what is+  done in the STMatrix tests. -* Add "Mult" class and get rid of <**> ?+* Add getDenseMatrix/toDenseMatrix to MMatrix/IMatrix.  Ideally put in+  customized versions for all 6 matrix types. -* Add "Solv" class and get rid of <\\> ?+* Optimization: Add `isRealType :: e -> Bool` and specilize hemm. -* lazy getRows/getCols needs to be re-implemented+* Add functions for arithmetic on banded matrices, and provide a `Num`+  instance for Banded. -* Optimization: Put 'isReal' in Elem class and specialize swap, copy, axpy, dot.+* Right now BLAS.h, double.c, zomplex.c, Double.hs, Zomplex.hs, and+  BLAS.Level{1,2,3}.hs are all (somewhat tediously) generated by hand.+  It would be nice to have a script that automatically generates them+  from a standard "cblas.h" header file.  Ideally, the script would also+  work for "clapack.h".  This would be *really* useful for the upcoming+  LAPACK bindings.  It's a chance to play around with Language.C for+  anyone who is interested. -* Optimization: better "swapElem" for vector and matrix -* Optimization: Put vector/matrix fields in the typeclass and inline them.  -Implementation for IOVector:+Big Projects+------------ -    fptrOfVector (DV f _ _ _ _) = f-    {-# INLINE fptrOfVector #-}+* 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. -    offsetOfVector (DV _ o _ _ _) = o-    {-# INLINE offsetOfVector #-}-    -    dim (DV _ _ n _ _) = n-    {-# INLINE dim #-}-    -    stride (DV _ _ _ s _) = s-    {-# INLINE stride #-}-    -    isConj (DV _ _ _ _ c) = c-    {-# INLINE isConj #-}+* Data.Matrix.Dense.Base is really, really ugly.  Unfortunately, I didn't+  figure out the best way to write these functions until after I had +  written all of the dense matrix ones.  The cleaner approach is the one+  followed in Data.Matrix.Banded.{IOBase,Base}, where all of the functions+  are determined in terms of IO types (instead of using the general type+  classes).  Reorganize Data.Matrix.Dense.{Base,IOBase,STBase} to mimic+  the style of Data.Matrix.Banded. -* Optimization: The ReadTensor/WriteTensor functions for Banded matrices are-really terrible.  Re-write these to be more efficient.+Notes+-----++* There is one remaining functional dependency in `Shaped x i | x -> i`.  We+  cannot get rid of it since GHC 6.10.1 has not yet implemented equality+  constraints in superclass contexts, which are required for MatrixShaped.+  When GHC implements this feature, get rid of this last remaining+  dependency.
+ aclocal.m4 view
@@ -0,0 +1,14 @@+# generated automatically by aclocal 1.10 -*- Autoconf -*-++# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,+# 2005, 2006  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_include([m4/ax_blas.m4])
+ blas.buildinfo.in view
@@ -0,0 +1,3 @@++buildable: @BUILD_PACKAGE_BOOL@+ld-options: @LDFLAGS@ @BLAS_LIBS@ @LIBS@
blas.cabal view
@@ -1,6 +1,6 @@ name:            blas-version:         0.6-homepage:        http://stat.stanford.edu/~patperry/code/blas+version:         0.7+homepage:        http://github.com/patperry/blas synopsis:        Bindings to the BLAS library description:     The BLAS (Basic Linear Algebra Subprograms) are routines that provide@@ -16,190 +16,121 @@     . category:        Math license:         BSD3-license-file:    LICENSE+license-file:    COPYING copyright:       (c) 2008. Patrick Perry <patperry@stanford.edu> author:          Patrick Perry maintainer:      Patrick Perry <patperry@stanford.edu>-cabal-version:   >= 1.2.0-build-type:      Simple-tested-with:     GHC == 6.8.3+cabal-version:   >= 1.2.3+build-type:      Configure+tested-with:     GHC == 6.10.1 -extra-source-files:     INSTALL-                        NEWS-                        TODO+extra-source-files:     NEWS README TODO configure.ac configure+                        aclocal.m4 m4/ax_blas.m4+                        blas.buildinfo.in cbits/config.h.in cbits/BLAS.h+                        tests/Makefile.in                                                  examples/LU.hs                         -                        tests/Makefile+                        tests/Test/Vector/Dense.hs+                        tests/Test/Matrix/Banded.hs+                        tests/Test/Matrix/Dense.hs+                        tests/Test/Matrix/Herm/Banded.hs+                        tests/Test/Matrix/Herm/Dense.hs+                        tests/Test/Matrix/Tri/Banded.hs+                        tests/Test/Matrix/Tri/Dense.hs                         tests/Main.hs                         tests/Driver.hs-                        -                        tests/Generators/Vector/Dense.hs-                        tests/Generators/Matrix.hs-                        tests/Generators/Matrix/Banded.hs-                        tests/Generators/Matrix/Dense.hs-                        tests/Generators/Matrix/Diag.hs-                        tests/Generators/Matrix/Perm.hs-                        tests/Generators/Matrix/Herm/Banded.hs-                        tests/Generators/Matrix/Herm/Dense.hs-                        tests/Generators/Matrix/Tri/Banded.hs-                        tests/Generators/Matrix/Tri/Dense.hs-                        tests/Generators/Permutation.hs-                                                 tests/Vector.hs                         tests/STVector.hs                         tests/Matrix.hs                         tests/STMatrix.hs                         tests/Banded.hs-                        tests/Diag.hs-                        tests/Perm.hs                         tests/HermMatrix.hs                         tests/HermBanded.hs                         tests/TriBanded.hs                         tests/TriMatrix.hs----- Below are the flags for specifying which CBLAS to link with.  If no flag--- is specified, the default is to use ATLAS.  To use the "custom" flag, you--- must edit the section at the end of the file with the name and location--- of the CBLAS library you want to use.--flag atlas-    description:    Link with ATLAS.-    default:        False--flag gsl-    description:    Link with GSL unoptimized CBLAS.-    default:        False--flag mkl-    description:    Link with Intel MKL.-    default:        False--flag veclib-    description:    Link with Mac OS X vecLib.-    default:        False-    -flag custom-    description:    Link with a custom CBLAS.  -    default:        False-    -- You must edit this file below to use this option.  +                                            +extra-tmp-files:        config.log config.status autom4te.cache+                        blas.buildinfo cbits/config.h tests/Makefile  library-    exposed-modules:    -                        BLAS.C-                            BLAS.C.Level1-                            BLAS.C.Level2-                            BLAS.C.Level3-                            BLAS.C.Types--                        BLAS.Conj--                        BLAS.Elem-                            BLAS.Elem.Base--                        BLAS.Internal--                        BLAS.Matrix-                            BLAS.Matrix.Base-                            BLAS.Matrix.Immutable-                            BLAS.Matrix.Mutable-                            BLAS.Matrix.Solve-                                BLAS.Matrix.Solve.Immutable-                                BLAS.Matrix.Solve.Mutable+    hs-source-dirs:     lib+    exposed-modules:    BLAS.Internal+                        BLAS.CTypes -                        BLAS.Tensor-                            BLAS.Tensor.Base-                            BLAS.Tensor.Immutable-                            BLAS.Tensor.Read-                            BLAS.Tensor.Write+                        Data.Elem.BLAS+                        Data.Elem.BLAS.Level1+                        Data.Elem.BLAS.Level2+                        Data.Elem.BLAS.Level3 -                        BLAS.Types+                        Data.Tensor.Class+                            Data.Tensor.Class.ITensor+                            Data.Tensor.Class.MTensor -                        BLAS.UnsafeIOToM+                        Data.Matrix.Class+                            Data.Matrix.Class.IMatrix+                            Data.Matrix.Class.IMatrixBase+                            Data.Matrix.Class.MMatrix+                            Data.Matrix.Class.MMatrixBase+                            Data.Matrix.Class.ISolve+                            Data.Matrix.Class.ISolveBase+                            Data.Matrix.Class.MSolve+                            Data.Matrix.Class.MSolveBase                          Data.Matrix.Banded+                            Data.Matrix.Banded.Base+                            Data.Matrix.Banded.Class                             Data.Matrix.Banded.IO+                            Data.Matrix.Banded.IOBase                             Data.Matrix.Banded.ST-                            Data.Matrix.Banded.Class+                            Data.Matrix.Banded.STBase                                                  Data.Matrix.Dense+                            Data.Matrix.Dense.Base+                            Data.Matrix.Dense.Class                             Data.Matrix.Dense.IO+                            Data.Matrix.Dense.IOBase                             Data.Matrix.Dense.ST-                            Data.Matrix.Dense.Class+                            Data.Matrix.Dense.STBase -                        Data.Matrix.Diag -                        Data.Matrix.Perm                         Data.Matrix.Herm+                        Data.Matrix.HermBase                         Data.Matrix.Tri+                        Data.Matrix.TriBase                          Data.Vector.Dense+                            Data.Vector.Dense.Base+                            Data.Vector.Dense.Class                             Data.Vector.Dense.IO+                            Data.Vector.Dense.IOBase                             Data.Vector.Dense.ST-                            Data.Vector.Dense.Class+                            Data.Vector.Dense.STBase +                        Test.QuickCheck.BLAS+                        Test.QuickCheck.BLASBase -    other-modules:      BLAS.C.Double-                        BLAS.C.Zomplex-                        -                        Data.Vector.Dense.Internal-                        Data.Vector.Dense.Class.Internal-                        Data.Vector.Dense.Class.Internal.Base-                        Data.Vector.Dense.Class.Creating-                        Data.Vector.Dense.Class.Elements-                        Data.Vector.Dense.Class.Special-                        Data.Vector.Dense.Class.Views-                        Data.Vector.Dense.Class.Copying-                        Data.Vector.Dense.Class.Properties-                        Data.Vector.Dense.Class.Operations-                        -                        Data.Matrix.Banded.Internal-                        Data.Matrix.Banded.Class.Internal-                        Data.Matrix.Banded.Class.Creating-                        Data.Matrix.Banded.Class.Elements-                        Data.Matrix.Banded.Class.Special-                        Data.Matrix.Banded.Class.Views-                        Data.Matrix.Banded.Class.Copying-                        -                        Data.Matrix.Dense.Internal-                        Data.Matrix.Dense.Class.Internal-                        Data.Matrix.Dense.Class.Creating-                        Data.Matrix.Dense.Class.Elements-                        Data.Matrix.Dense.Class.Special-                        Data.Matrix.Dense.Class.Views-                        Data.Matrix.Dense.Class.Copying-                        Data.Matrix.Dense.Class.Operations+    other-modules:      +                        BLAS.Types+                        Data.Elem.BLAS.Base+                        Data.Elem.BLAS.Double+                        Data.Elem.BLAS.Zomplex+    +    includes:           cbits/config.h+                        cbits/BLAS.h+    include-dirs:       cbits+    c-sources:          cbits/double.c+                        cbits/zomplex.c                              ghc-options:        -Wall-    extensions:         BangPatterns, FlexibleContexts, -                        FlexibleInstances, ForeignFunctionInterface, -                        FunctionalDependencies, MultiParamTypeClasses-    build-depends:      base, ieee, permutation, storable-complex-     -    if flag(atlas)-        extra-libraries:    cblas atlas-      -    if flag(gsl)-        extra-libraries:    gslcblas--    if flag(mkl)-      if arch(x86_64)-        extra-libraries:    mkl_lapack mkl_intel_lp64 mkl_sequential mkl_core-      else-        extra-libraries:    mkl_lapack mkl_intel mkl_sequential mkl_core--    if flag(veclib)-        extra-libraries:    cblas--    if flag(custom)-        -- CUSTOM CBLAS LIBS GO HERE-        extra-libraries:    -        -        -- PATH TO CUSTOM LIB DIR GOES HERE -        extra-lib-dirs:     -    -    -- fall back to ATLAS if no flag is specified-    if !flag(atlas) && !flag(gsl) && !flag(mkl) && !flag(veclib) && !flag(custom)-        extra-libraries:    cblas atlas-    +    extensions:         BangPatterns, +                        FlexibleContexts, +                        FlexibleInstances, +                        ForeignFunctionInterface, +                        FunctionalDependencies, +                        MultiParamTypeClasses,+                        Rank2Types,+                        ScopedTypeVariables,+                        TypeFamilies+                         +    build-depends:      base, ieee, storable-complex, QuickCheck >= 1.2
+ cbits/BLAS.h view
@@ -0,0 +1,579 @@+#ifndef BLAS_H+#define BLAS_H++#ifdef __cplusplus+extern "C" {+#endif++#ifndef BLAS_ENUM_DEFINED_H+   #define BLAS_ENUM_DEFINED_H+   enum BLAS_TRANSPOSE {BlasNoTrans=111, BlasTrans=112, BlasConjTrans=113};+   enum BLAS_UPLO  {BlasUpper=121, BlasLower=122};+   enum BLAS_DIAG  {BlasNonUnit=131, BlasUnit=132};+   enum BLAS_SIDE  {BlasLeft=141, BlasRight=142};+#endif++#define BLAS_INDEX int++/*+ * ===========================================================================+ * Prototypes for level 1 BLAS functions (complex are recast as routines)+ * ===========================================================================+ */+float  blas_sdsdot(const int N, const float alpha, const float *X,+                    const int incX, const float *Y, const int incY);+double blas_dsdot(const int N, const float *X, const int incX, const float *Y,+                   const int incY);+float  blas_sdot(const int N, const float  *X, const int incX,+                  const float  *Y, const int incY);+double blas_ddot(const int N, const double *X, const int incX,+                  const double *Y, const int incY);+/*+ * Functions having prefixes Z and C only+ */+void   blas_cdotu_sub(const int N, const void *X, const int incX,+                       const void *Y, const int incY, void *dotu);+void   blas_cdotc_sub(const int N, const void *X, const int incX,+                       const void *Y, const int incY, void *dotc);++void   blas_zdotu_sub(const int N, const void *X, const int incX,+                       const void *Y, const int incY, void *dotu);+void   blas_zdotc_sub(const int N, const void *X, const int incX,+                       const void *Y, const int incY, void *dotc);+++/*+ * Functions having prefixes S D SC DZ+ */+float  blas_snrm2(const int N, const float *X, const int incX);+float  blas_sasum(const int N, const float *X, const int incX);++double blas_dnrm2(const int N, const double *X, const int incX);+double blas_dasum(const int N, const double *X, const int incX);++float  blas_scnrm2(const int N, const void *X, const int incX);+float  blas_scasum(const int N, const void *X, const int incX);++double blas_dznrm2(const int N, const void *X, const int incX);+double blas_dzasum(const int N, const void *X, const int incX);+++/*+ * Functions having standard 4 prefixes (S D C Z)+ */+BLAS_INDEX blas_isamax(const int N, const float  *X, const int incX);+BLAS_INDEX blas_idamax(const int N, const double *X, const int incX);+BLAS_INDEX blas_icamax(const int N, const void   *X, const int incX);+BLAS_INDEX blas_izamax(const int N, const void   *X, const int incX);++/*+ * ===========================================================================+ * Prototypes for level 1 BLAS routines+ * ===========================================================================+ */++/*+ * Routines with standard 4 prefixes (s, d, c, z)+ */+void blas_sswap(const int N, float *X, const int incX,+                 float *Y, const int incY);+void blas_scopy(const int N, const float *X, const int incX,+                 float *Y, const int incY);+void blas_saxpy(const int N, const float alpha, const float *X,+                 const int incX, float *Y, const int incY);++void blas_dswap(const int N, double *X, const int incX,+                 double *Y, const int incY);+void blas_dcopy(const int N, const double *X, const int incX,+                 double *Y, const int incY);+void blas_daxpy(const int N, const double alpha, const double *X,+                 const int incX, double *Y, const int incY);+                       +void blas_cswap(const int N, void *X, const int incX,+                 void *Y, const int incY);+void blas_ccopy(const int N, const void *X, const int incX,+                 void *Y, const int incY);+void blas_caxpy(const int N, const void *alpha, const void *X,+                 const int incX, void *Y, const int incY);++void blas_zswap(const int N, void *X, const int incX,+                 void *Y, const int incY);+void blas_zcopy(const int N, const void *X, const int incX,+                 void *Y, const int incY);+void blas_zaxpy(const int N, const void *alpha, const void *X,+                 const int incX, void *Y, const int incY);++/*+ * Routines with S and D prefix only+ */+void blas_srotg(float *a, float *b, float *c, float *s);+void blas_srotmg(float *d1, float *d2, float *b1, const float b2, float *P);+void blas_srot(const int N, float *X, const int incX,+                float *Y, const int incY, const float c, const float s);+void blas_srotm(const int N, float *X, const int incX,+                float *Y, const int incY, const float *P);++void blas_drotg(double *a, double *b, double *c, double *s);+void blas_drotmg(double *d1, double *d2, double *b1, const double b2, double *P);+void blas_drot(const int N, double *X, const int incX,+                double *Y, const int incY, const double c, const double s);+void blas_drotm(const int N, double *X, const int incX,+                double *Y, const int incY, const double *P);+++/*+ * Routines with S D C Z CS and ZD prefixes+ */+void blas_sscal(const int N, const float alpha, float *X, const int incX);+void blas_dscal(const int N, const double alpha, double *X, const int incX);+void blas_cscal(const int N, const void *alpha, void *X, const int incX);+void blas_zscal(const int N, const void *alpha, void *X, const int incX);+void blas_csscal(const int N, const float alpha, void *X, const int incX);+void blas_zdscal(const int N, const double alpha, void *X, const int incX);++/*+ * Extra reference routines provided by ATLAS, but not mandated by the standard+ */+void blas_crotg(void *a, void *b, void *c, void *s);+void blas_zrotg(void *a, void *b, void *c, void *s);+void blas_csrot(const int N, void *X, const int incX, void *Y, const int incY,+                 const float c, const float s);+void blas_zdrot(const int N, void *X, const int incX, void *Y, const int incY,+                 const double c, const double s);++/*+ * ===========================================================================+ * Prototypes for level 2 BLAS+ * ===========================================================================+ */++/*+ * Routines with standard 4 prefixes (S, D, C, Z)+ */+void blas_sgemv(+                 const enum BLAS_TRANSPOSE TransA, const int M, const int N,+                 const float alpha, const float *A, const int lda,+                 const float *X, const int incX, const float beta,+                 float *Y, const int incY);+void blas_sgbmv(+                 const enum BLAS_TRANSPOSE TransA, const int M, const int N,+                 const int KL, const int KU, const float alpha,+                 const float *A, const int lda, const float *X,+                 const int incX, const float beta, float *Y, const int incY);+void blas_strmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const float *A, const int lda,+                 float *X, const int incX);+void blas_stbmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const int K, const float *A, const int lda,+                 float *X, const int incX);+void blas_stpmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const float *Ap, float *X, const int incX);+void blas_strsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const float *A, const int lda, float *X,+                 const int incX);+void blas_stbsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const int K, const float *A, const int lda,+                 float *X, const int incX);+void blas_stpsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const float *Ap, float *X, const int incX);++void blas_dgemv(+                 const enum BLAS_TRANSPOSE TransA, const int M, const int N,+                 const double alpha, const double *A, const int lda,+                 const double *X, const int incX, const double beta,+                 double *Y, const int incY);+void blas_dgbmv(+                 const enum BLAS_TRANSPOSE TransA, const int M, const int N,+                 const int KL, const int KU, const double alpha,+                 const double *A, const int lda, const double *X,+                 const int incX, const double beta, double *Y, const int incY);+void blas_dtrmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const double *A, const int lda,+                 double *X, const int incX);+void blas_dtbmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const int K, const double *A, const int lda,+                 double *X, const int incX);+void blas_dtpmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const double *Ap, double *X, const int incX);+void blas_dtrsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const double *A, const int lda, double *X,+                 const int incX);+void blas_dtbsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const int K, const double *A, const int lda,+                 double *X, const int incX);+void blas_dtpsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const double *Ap, double *X, const int incX);++void blas_cgemv(+                 const enum BLAS_TRANSPOSE TransA, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 const void *X, const int incX, const void *beta,+                 void *Y, const int incY);+void blas_cgbmv(+                 const enum BLAS_TRANSPOSE TransA, const int M, const int N,+                 const int KL, const int KU, const void *alpha,+                 const void *A, const int lda, const void *X,+                 const int incX, const void *beta, void *Y, const int incY);+void blas_ctrmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const void *A, const int lda,+                 void *X, const int incX);+void blas_ctbmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const int K, const void *A, const int lda,+                 void *X, const int incX);+void blas_ctpmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const void *Ap, void *X, const int incX);+void blas_ctrsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const void *A, const int lda, void *X,+                 const int incX);+void blas_ctbsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const int K, const void *A, const int lda,+                 void *X, const int incX);+void blas_ctpsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const void *Ap, void *X, const int incX);++void blas_zgemv(+                 const enum BLAS_TRANSPOSE TransA, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 const void *X, const int incX, const void *beta,+                 void *Y, const int incY);+void blas_zgbmv(+                 const enum BLAS_TRANSPOSE TransA, const int M, const int N,+                 const int KL, const int KU, const void *alpha,+                 const void *A, const int lda, const void *X,+                 const int incX, const void *beta, void *Y, const int incY);+void blas_ztrmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const void *A, const int lda,+                 void *X, const int incX);+void blas_ztbmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const int K, const void *A, const int lda,+                 void *X, const int incX);+void blas_ztpmv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const void *Ap, void *X, const int incX);+void blas_ztrsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const void *A, const int lda, void *X,+                 const int incX);+void blas_ztbsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const int K, const void *A, const int lda,+                 void *X, const int incX);+void blas_ztpsv(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+                 const int N, const void *Ap, void *X, const int incX);+++/*+ * Routines with S and D prefixes only+ */+void blas_ssymv(const enum BLAS_UPLO Uplo,+                 const int N, const float alpha, const float *A,+                 const int lda, const float *X, const int incX,+                 const float beta, float *Y, const int incY);+void blas_ssbmv(const enum BLAS_UPLO Uplo,+                 const int N, const int K, const float alpha, const float *A,+                 const int lda, const float *X, const int incX,+                 const float beta, float *Y, const int incY);+void blas_sspmv(const enum BLAS_UPLO Uplo,+                 const int N, const float alpha, const float *Ap,+                 const float *X, const int incX,+                 const float beta, float *Y, const int incY);+void blas_sger(const int M, const int N,+                const float alpha, const float *X, const int incX,+                const float *Y, const int incY, float *A, const int lda);+void blas_ssyr(const enum BLAS_UPLO Uplo,+                const int N, const float alpha, const float *X,+                const int incX, float *A, const int lda);+void blas_sspr(const enum BLAS_UPLO Uplo,+                const int N, const float alpha, const float *X,+                const int incX, float *Ap);+void blas_ssyr2(const enum BLAS_UPLO Uplo,+                const int N, const float alpha, const float *X,+                const int incX, const float *Y, const int incY, float *A,+                const int lda);+void blas_sspr2(const enum BLAS_UPLO Uplo,+                const int N, const float alpha, const float *X,+                const int incX, const float *Y, const int incY, float *A);++void blas_dsymv(const enum BLAS_UPLO Uplo,+                 const int N, const double alpha, const double *A,+                 const int lda, const double *X, const int incX,+                 const double beta, double *Y, const int incY);+void blas_dsbmv(const enum BLAS_UPLO Uplo,+                 const int N, const int K, const double alpha, const double *A,+                 const int lda, const double *X, const int incX,+                 const double beta, double *Y, const int incY);+void blas_dspmv(const enum BLAS_UPLO Uplo,+                 const int N, const double alpha, const double *Ap,+                 const double *X, const int incX,+                 const double beta, double *Y, const int incY);+void blas_dger(const int M, const int N,+                const double alpha, const double *X, const int incX,+                const double *Y, const int incY, double *A, const int lda);+void blas_dsyr(const enum BLAS_UPLO Uplo,+                const int N, const double alpha, const double *X,+                const int incX, double *A, const int lda);+void blas_dspr(const enum BLAS_UPLO Uplo,+                const int N, const double alpha, const double *X,+                const int incX, double *Ap);+void blas_dsyr2(const enum BLAS_UPLO Uplo,+                const int N, const double alpha, const double *X,+                const int incX, const double *Y, const int incY, double *A,+                const int lda);+void blas_dspr2(const enum BLAS_UPLO Uplo,+                const int N, const double alpha, const double *X,+                const int incX, const double *Y, const int incY, double *A);+++/*+ * Routines with C and Z prefixes only+ */+void blas_chemv(const enum BLAS_UPLO Uplo,+                 const int N, const void *alpha, const void *A,+                 const int lda, const void *X, const int incX,+                 const void *beta, void *Y, const int incY);+void blas_chbmv(const enum BLAS_UPLO Uplo,+                 const int N, const int K, const void *alpha, const void *A,+                 const int lda, const void *X, const int incX,+                 const void *beta, void *Y, const int incY);+void blas_chpmv(const enum BLAS_UPLO Uplo,+                 const int N, const void *alpha, const void *Ap,+                 const void *X, const int incX,+                 const void *beta, void *Y, const int incY);+void blas_cgeru(const int M, const int N,+                 const void *alpha, const void *X, const int incX,+                 const void *Y, const int incY, void *A, const int lda);+void blas_cgerc(const int M, const int N,+                 const void *alpha, const void *X, const int incX,+                 const void *Y, const int incY, void *A, const int lda);+void blas_cher(const enum BLAS_UPLO Uplo,+                const int N, const float alpha, const void *X, const int incX,+                void *A, const int lda);+void blas_chpr(const enum BLAS_UPLO Uplo,+                const int N, const float alpha, const void *X,+                const int incX, void *A);+void blas_cher2(const enum BLAS_UPLO Uplo, const int N,+                const void *alpha, const void *X, const int incX,+                const void *Y, const int incY, void *A, const int lda);+void blas_chpr2(const enum BLAS_UPLO Uplo, const int N,+                const void *alpha, const void *X, const int incX,+                const void *Y, const int incY, void *Ap);++void blas_zhemv(const enum BLAS_UPLO Uplo,+                 const int N, const void *alpha, const void *A,+                 const int lda, const void *X, const int incX,+                 const void *beta, void *Y, const int incY);+void blas_zhbmv(const enum BLAS_UPLO Uplo,+                 const int N, const int K, const void *alpha, const void *A,+                 const int lda, const void *X, const int incX,+                 const void *beta, void *Y, const int incY);+void blas_zhpmv(const enum BLAS_UPLO Uplo,+                 const int N, const void *alpha, const void *Ap,+                 const void *X, const int incX,+                 const void *beta, void *Y, const int incY);+void blas_zgeru(const int M, const int N,+                 const void *alpha, const void *X, const int incX,+                 const void *Y, const int incY, void *A, const int lda);+void blas_zgerc(const int M, const int N,+                 const void *alpha, const void *X, const int incX,+                 const void *Y, const int incY, void *A, const int lda);+void blas_zher(const enum BLAS_UPLO Uplo,+                const int N, const double alpha, const void *X, const int incX,+                void *A, const int lda);+void blas_zhpr(const enum BLAS_UPLO Uplo,+                const int N, const double alpha, const void *X,+                const int incX, void *A);+void blas_zher2(const enum BLAS_UPLO Uplo, const int N,+                const void *alpha, const void *X, const int incX,+                const void *Y, const int incY, void *A, const int lda);+void blas_zhpr2(const enum BLAS_UPLO Uplo, const int N,+                const void *alpha, const void *X, const int incX,+                const void *Y, const int incY, void *Ap);++/*+ * ===========================================================================+ * Prototypes for level 3 BLAS+ * ===========================================================================+ */++/*+ * Routines with standard 4 prefixes (S, D, C, Z)+ */+void blas_sgemm(const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_TRANSPOSE TransB, const int M, const int N,+                 const int K, const float alpha, const float *A,+                 const int lda, const float *B, const int ldb,+                 const float beta, float *C, const int ldc);+void blas_ssymm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const int M, const int N,+                 const float alpha, const float *A, const int lda,+                 const float *B, const int ldb, const float beta,+                 float *C, const int ldc);+void blas_ssyrk(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                 const float alpha, const float *A, const int lda,+                 const float beta, float *C, const int ldc);+void blas_ssyr2k(const enum BLAS_UPLO Uplo,+                  const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                  const float alpha, const float *A, const int lda,+                  const float *B, const int ldb, const float beta,+                  float *C, const int ldc);+void blas_strmm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_DIAG Diag, const int M, const int N,+                 const float alpha, const float *A, const int lda,+                 float *B, const int ldb);+void blas_strsm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_DIAG Diag, const int M, const int N,+                 const float alpha, const float *A, const int lda,+                 float *B, const int ldb);++void blas_dgemm(const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_TRANSPOSE TransB, const int M, const int N,+                 const int K, const double alpha, const double *A,+                 const int lda, const double *B, const int ldb,+                 const double beta, double *C, const int ldc);+void blas_dsymm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const int M, const int N,+                 const double alpha, const double *A, const int lda,+                 const double *B, const int ldb, const double beta,+                 double *C, const int ldc);+void blas_dsyrk(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                 const double alpha, const double *A, const int lda,+                 const double beta, double *C, const int ldc);+void blas_dsyr2k(const enum BLAS_UPLO Uplo,+                  const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                  const double alpha, const double *A, const int lda,+                  const double *B, const int ldb, const double beta,+                  double *C, const int ldc);+void blas_dtrmm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_DIAG Diag, const int M, const int N,+                 const double alpha, const double *A, const int lda,+                 double *B, const int ldb);+void blas_dtrsm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_DIAG Diag, const int M, const int N,+                 const double alpha, const double *A, const int lda,+                 double *B, const int ldb);++void blas_cgemm(const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_TRANSPOSE TransB, const int M, const int N,+                 const int K, const void *alpha, const void *A,+                 const int lda, const void *B, const int ldb,+                 const void *beta, void *C, const int ldc);+void blas_csymm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 const void *B, const int ldb, const void *beta,+                 void *C, const int ldc);+void blas_csyrk(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                 const void *alpha, const void *A, const int lda,+                 const void *beta, void *C, const int ldc);+void blas_csyr2k(const enum BLAS_UPLO Uplo,+                  const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                  const void *alpha, const void *A, const int lda,+                  const void *B, const int ldb, const void *beta,+                  void *C, const int ldc);+void blas_ctrmm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_DIAG Diag, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 void *B, const int ldb);+void blas_ctrsm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_DIAG Diag, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 void *B, const int ldb);++void blas_zgemm(const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_TRANSPOSE TransB, const int M, const int N,+                 const int K, const void *alpha, const void *A,+                 const int lda, const void *B, const int ldb,+                 const void *beta, void *C, const int ldc);+void blas_zsymm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 const void *B, const int ldb, const void *beta,+                 void *C, const int ldc);+void blas_zsyrk(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                 const void *alpha, const void *A, const int lda,+                 const void *beta, void *C, const int ldc);+void blas_zsyr2k(const enum BLAS_UPLO Uplo,+                  const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                  const void *alpha, const void *A, const int lda,+                  const void *B, const int ldb, const void *beta,+                  void *C, const int ldc);+void blas_ztrmm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_DIAG Diag, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 void *B, const int ldb);+void blas_ztrsm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+                 const enum BLAS_DIAG Diag, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 void *B, const int ldb);+++/*+ * Routines with prefixes C and Z only+ */+void blas_chemm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 const void *B, const int ldb, const void *beta,+                 void *C, const int ldc);+void blas_cherk(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                 const float alpha, const void *A, const int lda,+                 const float beta, void *C, const int ldc);+void blas_cher2k(const enum BLAS_UPLO Uplo,+                  const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                  const void *alpha, const void *A, const int lda,+                  const void *B, const int ldb, const float beta,+                  void *C, const int ldc);+void blas_zhemm(const enum BLAS_SIDE Side,+                 const enum BLAS_UPLO Uplo, const int M, const int N,+                 const void *alpha, const void *A, const int lda,+                 const void *B, const int ldb, const void *beta,+                 void *C, const int ldc);+void blas_zherk(const enum BLAS_UPLO Uplo,+                 const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                 const double alpha, const void *A, const int lda,+                 const double beta, void *C, const int ldc);+void blas_zher2k(const enum BLAS_UPLO Uplo,+                  const enum BLAS_TRANSPOSE Trans, const int N, const int K,+                  const void *alpha, const void *A, const int lda,+                  const void *B, const int ldb, const double beta,+                  void *C, const int ldc);++#ifdef __cplusplus+}+#endif++#endif
+ cbits/config.h.in view
@@ -0,0 +1,22 @@+/* 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 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 version of this package. */+#undef PACKAGE_VERSION
+ cbits/double.c view
@@ -0,0 +1,457 @@++#include "BLAS.h"+#include "config.h"++static char *BLAS_TRANS_CODES[] = { "N", "T", "C" };+#define TRANS(x) BLAS_TRANS_CODES[(int) (x) - (int) BlasNoTrans]++static char *BLAS_UPLO_CODES[] = { "U", "L" };+#define UPLO(x) BLAS_UPLO_CODES[(int) (x) - (int) BlasUpper]++static char *BLAS_DIAG_CODES[] = { "N", "U" };+#define DIAG(x) BLAS_DIAG_CODES[(int) (x) - (int) BlasNonUnit]++static char *BLAS_SIDE_CODES[] = { "L", "R" };+#define SIDE(x) BLAS_SIDE_CODES[(int) (x) - (int) BlasLeft]+++extern double+F77_FUNC(ddot) (const int *N, const double *X, const int *incX,+	            const double *Y, const int *incY);+extern double+F77_FUNC(dnrm2) (const int *N, const double *X, const int *incX);+extern double+F77_FUNC(dasum) (const int *N, const double *X, const int *incX);++extern BLAS_INDEX +F77_FUNC(idamax) (const int *N, const double *X, const int *incX);+extern void +F77_FUNC(dswap) (const int *N, double *X, const int *incX,+                 double *Y, const int *incY);+extern void +F77_FUNC(dcopy) (const int *N, const double *X, const int *incX,+                 double *Y, const int *incY);+extern void +F77_FUNC(daxpy) (const int *N, const double *alpha, const double *X,+                 const int *incX, double *Y, const int *incY);++extern void+F77_FUNC(drotg) (double *a, double *b, double *c, double *s);+extern void+F77_FUNC(drotmg) (double *d1, double *d2, double *b1, const double *b2, double *P);+extern void+F77_FUNC(drot) (const int *N, double *X, const int *incX,+                double *Y, const int *incY, const double *c, const double *s);+extern void +F77_FUNC(drotm) (const int *N, double *X, const int *incX,+                 double *Y, const int *incY, const double *P);+extern void +F77_FUNC(dscal) (const int *N, const double *alpha, double *X, const int *incX);+++extern void +F77_FUNC(dgemv) (const char *TransA, const int *M, const int *N,+                 const double *alpha, const double *A, const int *lda,+                 const double *X, const int *incX, const double *beta,+                 double *Y, const int *incY);++extern void+F77_FUNC(dgbmv)(const char *trans, const int *m, const int *n,+		const int *kl,const int *ku,+		const double *alpha, const double *a, const int *lda,+		const double *x, const int *incx,+		const double *beta, double *y, const int *incy);++extern void+F77_FUNC(dsbmv)(const char *uplo, const int *n, const int *k,+		const double *alpha, const double *a, const int *lda,+		const double *x, const int *incx,+		const double *beta, double *y, const int *incy);+extern void+F77_FUNC(dspmv)(const char *uplo, const int *n,+		const double *alpha, const double *ap,+		const double *x, const int *incx,+		const double *beta, double *y, const int *incy);+extern void+F77_FUNC(dsymv)(const char *uplo, const int *n, const double *alpha,+		const double *a, const int *lda,+		const double *x, const int *incx,+		const double *beta, double *y, const int *incy);+extern void+F77_FUNC(dtbmv)(const char *uplo, const char *trans,+		const char *diag, const int *n, const int *k,+		const double *a, const int *lda,+		double *x, const int *incx);+extern void+F77_FUNC(dtpmv)(const char *uplo, const char *trans, const char *diag,+		const int *n, const double *ap,+		double *x, const int *incx);+extern void+F77_FUNC(dtrmv)(const char *uplo, const char *trans, const char *diag,+		const int *n, const double *a, const int *lda,+		double *x, const int *incx);+extern void+F77_FUNC(dtbsv)(const char *uplo, const char *trans,+		const char *diag, const int *n, const int *k,+		const double *a, const int *lda,+		double *x, const int *incx);+extern void+F77_FUNC(dtpsv)(const char *uplo, const char *trans,+		const char *diag, const int *n,+		const double *ap, double *x, const int *incx);+extern void+F77_FUNC(dtrsv)(const char *uplo, const char *trans,+		const char *diag, const int *n,+		const double *a, const int *lda,+		double *x, const int *incx);+extern void+F77_FUNC(dger)(const int *m, const int *n, const double *alpha,+	       const double *x, const int *incx,+	       const double *y, const int *incy,+	       double *a, const int *lda);+extern void+F77_FUNC(dsyr)(const char *uplo, const int *n, const double *alpha,+	       const double *x, const int *incx,+	       double *a, const int *lda);+extern void+F77_FUNC(dspr)(const char *uplo, const int *n, const double *alpha,+	       const double *x, const int *incx, double *ap);+extern void+F77_FUNC(dsyr2)(const char *uplo, const int *n, const double *alpha,+		const double *x, const int *incx,+		const double *y, const int *incy,+		double *a, const int *lda);+extern void+F77_FUNC(dspr2)(const char *uplo, const int *n, const double *alpha,+		const double *x, const int *incx,+		const double *y, const int *incy, double *ap);+extern void+F77_FUNC(dgemm)(const char *transa, const char *transb, const int *m,+		const int *n, const int *k, const double *alpha,+		const double *a, const int *lda,+		const double *b, const int *ldb,+		const double *beta, double *c, const int *ldc);+extern void+F77_FUNC(dtrsm)(const char *side, const char *uplo,+		const char *transa, const char *diag,+		const int *m, const int *n, const double *alpha,+		const double *a, const int *lda,+		double *b, const int *ldb);+extern void+F77_FUNC(dtrmm)(const char *side, const char *uplo, const char *transa,+		const char *diag, const int *m, const int *n,+		const double *alpha, const double *a, const int *lda,+		double *b, const int *ldb);+extern void+F77_FUNC(dsymm)(const char *side, const char *uplo, const int *m,+		const int *n, const double *alpha,+		const double *a, const int *lda,+		const double *b, const int *ldb,+		const double *beta, double *c, const int *ldc);+extern void+F77_FUNC(dsyrk)(const char *uplo, const char *trans,+		const int *n, const int *k,+		const double *alpha, const double *a, const int *lda,+		const double *beta, double *c, const int *ldc);+extern void+F77_FUNC(dsyr2k)(const char *uplo, const char *trans,+		 const int *n, const int *k,+		 const double *alpha, const double *a, const int *lda,+		 const double *b, const int *ldb,+		 const double *beta, double *c, const int *ldc);+++double +blas_ddot (const int N, const double *X, const int incX,+           const double *Y, const int incY)+{+    return F77_FUNC(ddot) (&N, X, &incX, Y, &incY);+}+++double +blas_dnrm2 (const int N, const double *X, const int incX)+{+    return F77_FUNC(dnrm2) (&N, X, &incX);+}++double +blas_dasum (const int N, const double *X, const int incX)+{+    return F77_FUNC(dasum) (&N, X, &incX);    +}++BLAS_INDEX +blas_idamax (const int N, const double *X, const int incX)+{+    return (F77_FUNC(idamax) (&N, X, &incX) - 1);+}++void +blas_dswap (const int N, double *X, const int incX,+            double *Y, const int incY)+{+    F77_FUNC(dswap) (&N, X, &incX, Y, &incY);+}++void +blas_dcopy (const int N, const double *X, const int incX,+            double *Y, const int incY)+{+    F77_FUNC(dcopy) (&N, X, &incX, Y, &incY);+}++void +blas_daxpy (const int N, const double alpha, const double *X,+            const int incX, double *Y, const int incY)+{+    F77_FUNC(daxpy) (&N, &alpha, X, &incX, Y, &incY);+}++void +blas_drotg (double *a, double *b, double *c, double *s)+{+    F77_FUNC(drotg) (a, b, c, s);+}++void +blas_drotmg (double *d1, double *d2, double *b1, const double b2, double *P)+{+    F77_FUNC(drotmg) (d1, d2, b1, &b2, P);+}++void +blas_drot (const int N, double *X, const int incX,+           double *Y, const int incY, const double c, const double s)+{+    F77_FUNC(drot) (&N, X, &incX, Y, &incY, &c, &s);+}++void +blas_drotm (const int N, double *X, const int incX,+            double *Y, const int incY, const double *P)+{+    F77_FUNC(drotm) (&N, X, &incX, Y, &incY, P);+}++void +blas_dscal (const int N, const double alpha, double *X, const int incX)+{+    F77_FUNC(dscal) (&N, &alpha, X, &incX);+}++void +blas_dgemv (const enum BLAS_TRANSPOSE TransA, const int M, const int N,+            const double alpha, const double *A, const int lda,+            const double *X, const int incX, const double beta,+            double *Y, const int incY)+{+    F77_FUNC(dgemv) (TRANS(TransA), &M, &N, &alpha, A, &lda, X, &incX,+                     &beta, Y, &incY);+}++void +blas_dgbmv (const enum BLAS_TRANSPOSE TransA, const int M, const int N,+            const int KL, const int KU, const double alpha,+            const double *A, const int lda, const double *X,+            const int incX, const double beta, double *Y, const int incY)+{+    F77_FUNC(dgbmv) (TRANS(TransA), &M, &N, &KL, &KU, &alpha, A, &lda,+                     X, &incX, &beta, Y, &incY);+}+ +void +blas_dtrmv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const double *A, const int lda,+            double *X, const int incX)+{+    F77_FUNC(dtrmv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, A, &lda,+                     X, &incX);+}++void +blas_dtbmv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const int K, const double *A, const int lda,+            double *X, const int incX)+{+    F77_FUNC(dtbmv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, &K, A, &lda,+                     X, &incX);+}++void +blas_dtpmv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const double *Ap, double *X, const int incX)+{+    F77_FUNC(dtpmv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, Ap,+                     X, &incX);+}++void +blas_dtrsv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const double *A, const int lda, double *X,+            const int incX)+{+    F77_FUNC(dtrsv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, A, &lda,+                     X, &incX);+}++void +blas_dtbsv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const int K, const double *A, const int lda,+            double *X, const int incX)++{+    F77_FUNC(dtbsv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, &K, A, &lda,+                     X, &incX);+}++void +blas_dtpsv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const double *Ap, double *X, const int incX)+{+    F77_FUNC(dtpsv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, Ap,+                     X, &incX);+}+++void +blas_dsymv (const enum BLAS_UPLO Uplo,+            const int N, const double alpha, const double *A,+            const int lda, const double *X, const int incX,+            const double beta, double *Y, const int incY)+{+    F77_FUNC(dsymv) (UPLO(Uplo), &N, &alpha, A, &lda, X, &incX,+                     &beta, Y, &incY);    +}++void +blas_dsbmv (const enum BLAS_UPLO Uplo,+            const int N, const int K, const double alpha, const double *A,+            const int lda, const double *X, const int incX,+            const double beta, double *Y, const int incY)+{+    F77_FUNC(dsbmv) (UPLO(Uplo), &N, &K, &alpha, A, &lda, X, &incX,+                     &beta, Y, &incY);    +}++void+blas_dspmv (const enum BLAS_UPLO Uplo,+            const int N, const double alpha, const double *Ap,+            const double *X, const int incX,+            const double beta, double *Y, const int incY)+{+    F77_FUNC(dspmv) (UPLO(Uplo), &N, &alpha, Ap, X, &incX, &beta, Y, &incY);+}++void+blas_dger (const int M, const int N,+           const double alpha, const double *X, const int incX,+           const double *Y, const int incY, double *A, const int lda)+{+    F77_FUNC(dger) (&M, &N, &alpha, X, &incX, Y, &incY, A, &lda);        +}++void+blas_dsyr (const enum BLAS_UPLO Uplo,+           const int N, const double alpha, const double *X,+           const int incX, double *A, const int lda)+{+    F77_FUNC(dsyr) (UPLO(Uplo), &N, &alpha, X, &incX, A, &lda);    +}++void+blas_dspr (const enum BLAS_UPLO Uplo,+           const int N, const double alpha, const double *X,+           const int incX, double *Ap)+{+    F77_FUNC(dspr) (UPLO(Uplo), &N, &alpha, X, &incX, Ap);    +}++void +blas_dsyr2 (const enum BLAS_UPLO Uplo,+            const int N, const double alpha, const double *X,+            const int incX, const double *Y, const int incY, double *A,+            const int lda)+{+    F77_FUNC(dsyr2) (UPLO(Uplo), &N, &alpha, X, &incX, Y, &incY, A, &lda);    +}++void+blas_dspr2 (const enum BLAS_UPLO Uplo,+            const int N, const double alpha, const double *X,+            const int incX, const double *Y, const int incY, double *A)+{+    F77_FUNC(dspr2) (UPLO(Uplo), &N, &alpha, X, &incX, Y, &incY, A);+}++void +blas_dgemm (const enum BLAS_TRANSPOSE TransA,+            const enum BLAS_TRANSPOSE TransB, const int M, const int N,+            const int K, const double alpha, const double *A,+            const int lda, const double *B, const int ldb,+            const double beta, double *C, const int ldc)+{+    F77_FUNC(dgemm) (TRANS(TransA), TRANS(TransB), &M, &N, &K,+                     &alpha, A, &lda, B, &ldb, &beta, C, &ldc);+}++void +blas_dsymm (const enum BLAS_SIDE Side,+            const enum BLAS_UPLO Uplo, const int M, const int N,+            const double alpha, const double *A, const int lda,+            const double *B, const int ldb, const double beta,+            double *C, const int ldc)+{+    F77_FUNC(dsymm) (SIDE(Side), UPLO(Uplo), &M, &N,+                     &alpha, A, &lda, B, &ldb, &beta, C, &ldc);+}++void +blas_dsyrk (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE Trans, const int N, const int K,+            const double alpha, const double *A, const int lda,+            const double beta, double *C, const int ldc)+{+    F77_FUNC(dsyrk) (UPLO(Uplo), TRANS(Trans), &N, &K,+                     &alpha, A, &lda, &beta, C, &ldc);+    +}++void+blas_dsyr2k (const enum BLAS_UPLO Uplo,+             const enum BLAS_TRANSPOSE Trans, const int N, const int K,+             const double alpha, const double *A, const int lda,+             const double *B, const int ldb, const double beta,+             double *C, const int ldc)+{+    F77_FUNC(dsyr2k) (UPLO(Uplo), TRANS(Trans), &N, &K,+                      &alpha, A, &lda, B, &ldb, &beta, C, &ldc);+}++void+blas_dtrmm (const enum BLAS_SIDE Side,+            const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+            const enum BLAS_DIAG Diag, const int M, const int N,+            const double alpha, const double *A, const int lda,+            double *B, const int ldb)+{+    F77_FUNC(dtrmm) (SIDE(Side), UPLO(Uplo), TRANS(TransA), DIAG(Diag), &M, &N,+                     &alpha, A, &lda, B, &ldb);+}++void+blas_dtrsm (const enum BLAS_SIDE Side,+            const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+            const enum BLAS_DIAG Diag, const int M, const int N,+            const double alpha, const double *A, const int lda,+            double *B, const int ldb)+{+    F77_FUNC(dtrsm) (SIDE(Side), UPLO(Uplo), TRANS(TransA), DIAG(Diag), &M, &N,+                     &alpha, A, &lda, B, &ldb);+}
+ cbits/zomplex.c view
@@ -0,0 +1,480 @@++#include "BLAS.h"+#include "config.h"+#include <stdio.h>++static char *BLAS_TRANS_CODES[] = { "N", "T", "C" };+#define TRANS(x) BLAS_TRANS_CODES[(int) (x) - (int) BlasNoTrans]++static char *BLAS_UPLO_CODES[] = { "U", "L" };+#define UPLO(x) BLAS_UPLO_CODES[(int) (x) - (int) BlasUpper]++static char *BLAS_DIAG_CODES[] = { "N", "U" };+#define DIAG(x) BLAS_DIAG_CODES[(int) (x) - (int) BlasNonUnit]++static char *BLAS_SIDE_CODES[] = { "L", "R" };+#define SIDE(x) BLAS_SIDE_CODES[(int) (x) - (int) BlasLeft]+++extern double+F77_FUNC(dzasum)(const int *n, const void *zx, const int *incx);+extern double+F77_FUNC(dznrm2)(const int *n, const void *x, const int *incx);+extern int+F77_FUNC(izamax)(const int *n, const void *zx, const int *incx);+extern void+F77_FUNC(zaxpy)(const int *n, const void *za, const void *zx,+	    const int *incx, void *zy, const int *incy);+extern void +F77_FUNC(zcopy)(const int *n, const void *zx, const int *incx,+	    void *zy, const int *incy);+extern const void +F77_FUNC(zdotc)(const void * ret_val, const int *n,+	    const void *zx, const int *incx, const void *zy, const int *incy);+extern const void +F77_FUNC(zdotu)(const void * ret_val, const int *n,+	    const void *zx, const int *incx, const void *zy, const int *incy);+extern void +F77_FUNC(zdrot)(const int *n, void *zx, const int *incx, void *zy,+	const int *incy, const double *c, const double *s);+extern void +F77_FUNC(zdscal)(const int *n, const double *da, void *zx, const int *incx);+extern void +F77_FUNC(zgbmv)(const char *trans, const int *m, const int *n, const int *kl,+	    const int *ku, const void *alpha, const void *a, const int *lda,+	    const void *x, const int *incx, const void *beta, void *y,+	    const int *incy);+extern void+F77_FUNC(zgemm)(const char *transa, const char *transb, const int *m,+	    const int *n, const int *k, const const void *alpha,+	    const const void *a, const int *lda,+	    const const void *b, const int *ldb,+	    const const void *beta, const void *c, const int *ldc);+extern void +F77_FUNC(zgemv)(const char *trans, const int *m, const int *n, const void *alpha,+	    const void *a, const int *lda, const void *x, const int *incx,+	    const void *beta, void *y, const int *incy);+extern void +F77_FUNC(zgerc)(const int *m, const int *n, const void *alpha, const void *x,+	    const int *incx, const void *y, const int *incy, void *a, const int *lda);+extern void +F77_FUNC(zgeru)(const int *m, const int *n, const void *alpha, const void *x,+	    const int *incx, const void *y, const int *incy, void *a, const int *lda);+extern void +F77_FUNC(zhbmv)(const char *uplo, const int *n, const int *k, const void *alpha,+	    const void *a, const int *lda, const void *x, const int *incx,+	    const void *beta, const void *y, const int *incy);+extern void +F77_FUNC(zhemm)(const char *side, const char *uplo, const int *m, const int *n,+	    const void *alpha, const void *a, const int *lda, const void *b,+	    const int *ldb, const void *beta, const void *c, const int *ldc);+extern void +F77_FUNC(zhemv)(const char *uplo, const int *n, const void *alpha, const void *a,+	    const int *lda, const void *x, const int *incx, const void *beta,+	    const void *y, const int *incy);+extern void +F77_FUNC(zher)(const char *uplo, const int *n, const double *alpha, const void *x,+	   const int *incx, void *a, const int *lda);+extern void +F77_FUNC(zher2)(const char *uplo, const int *n, const void *alpha, const void *x,+	    const int *incx, const void *y, const int *incy, void *a, const int *lda);+extern void +F77_FUNC(zher2k)(const char *uplo, const char *trans, const int *n, const int *k,+	     const void *alpha, const void *a, const int *lda, const void *b,+	     const int *ldb, const double *beta, void *c, const int *ldc);+extern void +F77_FUNC(zherk)(const char *uplo, const char *trans, const int *n, const int *k,+	    const double *alpha, const void *a, const int *lda, const double *beta,+	    void *c, const int *ldc);+extern void +F77_FUNC(zhpmv)(const char *uplo, const int *n, const void *alpha, const void *ap,+	    const void *x, const int *incx, const void * beta, void *y,+	    const int *incy);+extern void +F77_FUNC(zhpr)(const char *uplo, const int *n, const double *alpha,+	   const void *x, const int *incx, void *ap);+extern void +F77_FUNC(zhpr2)(const char *uplo, const int *n, const void *alpha, const void *x,+	    const int *incx, const void *y, const int *incy, void *ap);+extern void +F77_FUNC(zrotg)(const void *ca, const void *cb, void *c, const void *s);+extern void +F77_FUNC(zscal)(const int *n, const void *za, const void *zx, const int *incx);+extern void +F77_FUNC(zswap)(const int *n, const void *zx, const int *incx, const void *zy, const int *incy);+extern void +F77_FUNC(zsymm)(const char *side, const char *uplo, const int *m, const int *n,+	    const void *alpha, const void *a, const int *lda, const void *b,+	    const int *ldb, const void *beta, const void *c, const int *ldc);+extern void +F77_FUNC(zsyr2k)(const char *uplo, const char *trans, const int *n, const int *k,+	     const void *alpha, const void *a, const int *lda, const void *b,+	     const int *ldb, const void *beta, void *c, const int *ldc);+extern void +F77_FUNC(zsyrk)(const char *uplo, const char *trans, const int *n, const int *k,+	    const void *alpha, const void *a, const int *lda,+	    const void *beta, void *c, const int *ldc);+extern void +F77_FUNC(ztbmv)(const char *uplo, const char *trans, const char *diag, const int *n, const int *k,+	    const void *a, const int *lda, void *x, const int *incx);+extern void +F77_FUNC(ztbsv)(const char *uplo, const char *trans, const char *diag, const int *n, const int *k,+	    const void *a, const int *lda, void *x, const int *incx);+extern void +F77_FUNC(ztpmv)(const char *uplo, const char *trans, const char *diag, const int *n,+	    const void *ap, void *x, const int *incx);+extern void +F77_FUNC(ztpsv)(const char *uplo, const char *trans, const char *diag, const int *n,+	    const void *ap, void *x, const int *incx);+extern void +F77_FUNC(ztrmm)(const char *side, const char *uplo, const char *transa, const char *diag,+	    const int *m, const int *n, const void *alpha, const void *a,+	    const int *lda, void *b, const int *ldb);+extern void +F77_FUNC(ztrmv)(const char *uplo, const char *trans, const char *diag, const int *n,+	    const void *a, const int *lda, void *x, const int *incx);+extern void +F77_FUNC(ztrsm)(const char *side, const char *uplo, const char *transa, const char *diag,+	    const int *m, const int *n, const void *alpha, const void *a,+	    const int *lda, void *b, const int *ldb);+extern void +F77_FUNC(ztrsv)(const char *uplo, const char *trans, const char *diag, const int *n,+	    const void *a, const int *lda, void *x, const int *incx);+++void +blas_zdotu_sub (const int N, const void *X, const int incX,+                const void *Y, const int incY, void *dotu)+{+    return F77_FUNC(zdotu) (dotu, &N, X, &incX, Y, &incY);+}++void +blas_zdotc_sub (const int N, const void *X, const int incX,+                const void *Y, const int incY, void *dotc)+{+    return F77_FUNC(zdotc) (dotc, &N, X, &incX, Y, &incY);+}+++double +blas_dznrm2 (const int N, const void *X, const int incX)+{+    return F77_FUNC(dznrm2) (&N, X, &incX);+}++double +blas_dzasum (const int N, const void *X, const int incX)+{+    return F77_FUNC(dzasum) (&N, X, &incX);    +}++BLAS_INDEX +blas_izamax (const int N, const void *X, const int incX)+{+    return (F77_FUNC(izamax) (&N, X, &incX) - 1);+}++void +blas_zswap (const int N, void *X, const int incX,+            void *Y, const int incY)+{+    F77_FUNC(zswap) (&N, X, &incX, Y, &incY);+}++void +blas_zcopy (const int N, const void *X, const int incX,+            void *Y, const int incY)+{+    F77_FUNC(zcopy) (&N, X, &incX, Y, &incY);+}++void +blas_zaxpy (const int N, const void *alpha, const void *X,+            const int incX, void *Y, const int incY)+{+    F77_FUNC(zaxpy) (&N, alpha, X, &incX, Y, &incY);+}++void +blas_zdscal (const int N, const double alpha, void *X, const int incX)+{+    F77_FUNC(zdscal) (&N, &alpha, X, &incX);+}++void +blas_zscal (const int N, const void *alpha, void *X, const int incX)+{+    F77_FUNC(zscal) (&N, alpha, X, &incX);+}++void +blas_zrotg (void *a, void *b, void *c, void *s)+{+    F77_FUNC(zrotg) (a, b, c, s);+}++void +blas_zdrot (const int N, void *X, const int incX,+           void *Y, const int incY, const double c, const double s)+{+    F77_FUNC(zdrot) (&N, X, &incX, Y, &incY, &c, &s);+}+++void +blas_zgemv (const enum BLAS_TRANSPOSE TransA, const int M, const int N,+            const void *alpha, const void *A, const int lda,+            const void *X, const int incX, const void *beta,+            void *Y, const int incY)+{+    F77_FUNC(zgemv) (TRANS(TransA), &M, &N, alpha, A, &lda, X, &incX,+                     beta, Y, &incY);+}++void +blas_zgbmv (const enum BLAS_TRANSPOSE TransA, const int M, const int N,+            const int KL, const int KU, const void *alpha,+            const void *A, const int lda, const void *X,+            const int incX, const void *beta, void *Y, const int incY)+{+    F77_FUNC(zgbmv) (TRANS(TransA), &M, &N, &KL, &KU, alpha, A, &lda,+                     X, &incX, beta, Y, &incY);+}+ +void +blas_ztrmv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const void *A, const int lda,+            void *X, const int incX)+{+    F77_FUNC(ztrmv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, A, &lda,+                     X, &incX);+}++void +blas_ztbmv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const int K, const void *A, const int lda,+            void *X, const int incX)+{+    F77_FUNC(ztbmv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, &K, A, &lda,+                     X, &incX);+}++void +blas_ztpmv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const void *Ap, void *X, const int incX)+{+    F77_FUNC(ztpmv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, Ap,+                     X, &incX);+}++void +blas_ztrsv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const void *A, const int lda, void *X,+            const int incX)+{+    F77_FUNC(ztrsv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, A, &lda,+                     X, &incX);+}++void +blas_ztbsv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const int K, const void *A, const int lda,+            void *X, const int incX)++{+    F77_FUNC(ztbsv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, &K, A, &lda,+                     X, &incX);+}++void +blas_ztpsv (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE TransA, const enum BLAS_DIAG Diag,+            const int N, const void *Ap, void *X, const int incX)+{+    F77_FUNC(ztpsv) (UPLO(Uplo), TRANS(TransA), DIAG(Diag), &N, Ap,+                     X, &incX);+}+++void +blas_zhemv (const enum BLAS_UPLO Uplo,+            const int N, const void *alpha, const void *A,+            const int lda, const void *X, const int incX,+            const void *beta, void *Y, const int incY)+{+    F77_FUNC(zhemv) (UPLO(Uplo), &N, alpha, A, &lda, X, &incX,+                     beta, Y, &incY);    +}++void +blas_zhbmv (const enum BLAS_UPLO Uplo,+            const int N, const int K, const void *alpha, const void *A,+            const int lda, const void *X, const int incX,+            const void *beta, void *Y, const int incY)+{+    F77_FUNC(zhbmv) (UPLO(Uplo), &N, &K, alpha, A, &lda, X, &incX,+                     beta, Y, &incY);    +}++void+blas_zhpmv (const enum BLAS_UPLO Uplo,+            const int N, const void *alpha, const void *Ap,+            const void *X, const int incX,+            const void *beta, void *Y, const int incY)+{+    F77_FUNC(zhpmv) (UPLO(Uplo), &N, alpha, Ap, X, &incX, beta, Y, &incY);+}++void+blas_zgeru (const int M, const int N,+           const void *alpha, const void *X, const int incX,+           const void *Y, const int incY, void *A, const int lda)+{+    F77_FUNC(zgeru) (&M, &N, alpha, X, &incX, Y, &incY, A, &lda);        +}++void+blas_zgerc (const int M, const int N,+           const void *alpha, const void *X, const int incX,+           const void *Y, const int incY, void *A, const int lda)+{+    F77_FUNC(zgerc) (&M, &N, alpha, X, &incX, Y, &incY, A, &lda);        +}++void+blas_zher (const enum BLAS_UPLO Uplo,+           const int N, const double alpha, const void *X,+           const int incX, void *A, const int lda)+{+    F77_FUNC(zher) (UPLO(Uplo), &N, &alpha, X, &incX, A, &lda);    +}++void+blas_zhpr (const enum BLAS_UPLO Uplo,+           const int N, const double alpha, const void *X,+           const int incX, void *Ap)+{+    F77_FUNC(zhpr) (UPLO(Uplo), &N, &alpha, X, &incX, Ap);    +}++void +blas_zher2 (const enum BLAS_UPLO Uplo,+            const int N, const void * alpha, const void *X,+            const int incX, const void *Y, const int incY, void *A,+            const int lda)+{+    F77_FUNC(zher2) (UPLO(Uplo), &N, alpha, X, &incX, Y, &incY, A, &lda);    +}++void+blas_zhpr2 (const enum BLAS_UPLO Uplo,+            const int N, const void * alpha, const void *X,+            const int incX, const void *Y, const int incY, void *A)+{+    F77_FUNC(zhpr2) (UPLO(Uplo), &N, alpha, X, &incX, Y, &incY, A);+}++void +blas_zgemm (const enum BLAS_TRANSPOSE TransA,+            const enum BLAS_TRANSPOSE TransB, const int M, const int N,+            const int K, const void * alpha, const void *A,+            const int lda, const void *B, const int ldb,+            const void * beta, void *C, const int ldc)+{+    F77_FUNC(zgemm) (TRANS(TransA), TRANS(TransB), &M, &N, &K,+                     alpha, A, &lda, B, &ldb, beta, C, &ldc);+}++void +blas_zsymm (const enum BLAS_SIDE Side,+            const enum BLAS_UPLO Uplo, const int M, const int N,+            const void * alpha, const void *A, const int lda,+            const void *B, const int ldb, const void * beta,+            void *C, const int ldc)+{+    F77_FUNC(zsymm) (SIDE(Side), UPLO(Uplo), &M, &N,+                     alpha, A, &lda, B, &ldb, beta, C, &ldc);+}++void +blas_zsyrk (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE Trans, const int N, const int K,+            const void * alpha, const void *A, const int lda,+            const void * beta, void *C, const int ldc)+{+    F77_FUNC(zsyrk) (UPLO(Uplo), TRANS(Trans), &N, &K,+                     alpha, A, &lda, beta, C, &ldc);+    +}++void+blas_zsyr2k (const enum BLAS_UPLO Uplo,+             const enum BLAS_TRANSPOSE Trans, const int N, const int K,+             const void * alpha, const void *A, const int lda,+             const void *B, const int ldb, const void * beta,+             void *C, const int ldc)+{+    F77_FUNC(zsyr2k) (UPLO(Uplo), TRANS(Trans), &N, &K,+                      alpha, A, &lda, B, &ldb, beta, C, &ldc);+}++void +blas_zhemm (const enum BLAS_SIDE Side,+            const enum BLAS_UPLO Uplo, const int M, const int N,+            const void * alpha, const void *A, const int lda,+            const void *B, const int ldb, const void * beta,+            void *C, const int ldc)+{+    F77_FUNC(zhemm) (SIDE(Side), UPLO(Uplo), &M, &N,+                     alpha, A, &lda, B, &ldb, beta, C, &ldc);+}++void +blas_zherk (const enum BLAS_UPLO Uplo,+            const enum BLAS_TRANSPOSE Trans, const int N, const int K,+            const double alpha, const void *A, const int lda,+            const double beta, void *C, const int ldc)+{+    F77_FUNC(zherk) (UPLO(Uplo), TRANS(Trans), &N, &K,+                     &alpha, A, &lda, &beta, C, &ldc);+    +}++void+blas_zher2k (const enum BLAS_UPLO Uplo,+             const enum BLAS_TRANSPOSE Trans, const int N, const int K,+             const void * alpha, const void *A, const int lda,+             const void *B, const int ldb, const double beta,+             void *C, const int ldc)+{+    F77_FUNC(zher2k) (UPLO(Uplo), TRANS(Trans), &N, &K,+                      alpha, A, &lda, B, &ldb, &beta, C, &ldc);+}++void+blas_ztrmm (const enum BLAS_SIDE Side,+            const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+            const enum BLAS_DIAG Diag, const int M, const int N,+            const void * alpha, const void *A, const int lda,+            void *B, const int ldb)+{+    F77_FUNC(ztrmm) (SIDE(Side), UPLO(Uplo), TRANS(TransA), DIAG(Diag), &M, &N,+                     alpha, A, &lda, B, &ldb);+}++void+blas_ztrsm (const enum BLAS_SIDE Side,+            const enum BLAS_UPLO Uplo, const enum BLAS_TRANSPOSE TransA,+            const enum BLAS_DIAG Diag, const int M, const int N,+            const void * alpha, const void *A, const int lda,+            void *B, const int ldb)+{+    F77_FUNC(ztrsm) (SIDE(Side), UPLO(Uplo), TRANS(TransA), DIAG(Diag), &M, &N,+                     alpha, A, &lda, B, &ldb);+}
+ configure view
@@ -0,0 +1,6933 @@+#! /bin/sh+# Guess values for system-dependent variables and create Makefiles.+# Generated by GNU Autoconf 2.62 for Haskell blas 0.7.+#+# Report bugs to <patperry@stanford.edu>.+#+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,+# 2002, 2003, 2004, 2005, 2006, 2007, 2008 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+++++# PATH needs CR+# 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_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+if (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++# Support unset when possible.+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then+  as_unset=unset+else+  as_unset=false+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.+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); exit 1; }+fi++# Work around bugs in pre-3.0 UWIN ksh.+for as_var in ENV MAIL MAILPATH+do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# Required to use basename.+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+++# Name of the executable.+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'`++# CDPATH.+$as_unset CDPATH+++if test "x$CONFIG_SHELL" = x; then+  if (eval ":") 2>/dev/null; then+  as_have_required=yes+else+  as_have_required=no+fi++  if test $as_have_required = yes &&	 (eval ":+(as_func_return () {+  (exit \$1)+}+as_func_success () {+  as_func_return 0+}+as_func_failure () {+  as_func_return 1+}+as_func_ret_success () {+  return 0+}+as_func_ret_failure () {+  return 1+}++exitcode=0+if as_func_success; then+  :+else+  exitcode=1+  echo as_func_success failed.+fi++if as_func_failure; then+  exitcode=1+  echo as_func_failure succeeded.+fi++if as_func_ret_success; then+  :+else+  exitcode=1+  echo as_func_ret_success failed.+fi++if as_func_ret_failure; then+  exitcode=1+  echo as_func_ret_failure succeeded.+fi++if ( set x; as_func_ret_success y && test x = \"\$1\" ); then+  :+else+  exitcode=1+  echo positional parameters were not saved.+fi++test \$exitcode = 0) || { (exit 1); exit 1; }++(+  as_lineno_1=\$LINENO+  as_lineno_2=\$LINENO+  test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" &&+  test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; }+") 2> /dev/null; then+  :+else+  as_candidate_shells=+    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  case $as_dir in+	 /*)+	   for as_base in sh bash ksh sh5; do+	     as_candidate_shells="$as_candidate_shells $as_dir/$as_base"+	   done;;+       esac+done+IFS=$as_save_IFS+++      for as_shell in $as_candidate_shells $SHELL; do+	 # Try only shells that exist, to save several forks.+	 if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&+		{ ("$as_shell") 2> /dev/null <<\_ASEOF+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+++:+_ASEOF+}; then+  CONFIG_SHELL=$as_shell+	       as_have_required=yes+	       if { "$as_shell" 2> /dev/null <<\_ASEOF+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_func_return () {+  (exit $1)+}+as_func_success () {+  as_func_return 0+}+as_func_failure () {+  as_func_return 1+}+as_func_ret_success () {+  return 0+}+as_func_ret_failure () {+  return 1+}++exitcode=0+if as_func_success; then+  :+else+  exitcode=1+  echo as_func_success failed.+fi++if as_func_failure; then+  exitcode=1+  echo as_func_failure succeeded.+fi++if as_func_ret_success; then+  :+else+  exitcode=1+  echo as_func_ret_success failed.+fi++if as_func_ret_failure; then+  exitcode=1+  echo as_func_ret_failure succeeded.+fi++if ( set x; as_func_ret_success y && test x = "$1" ); then+  :+else+  exitcode=1+  echo positional parameters were not saved.+fi++test $exitcode = 0) || { (exit 1); exit 1; }++(+  as_lineno_1=$LINENO+  as_lineno_2=$LINENO+  test "x$as_lineno_1" != "x$as_lineno_2" &&+  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; }++_ASEOF+}; then+  break+fi++fi++      done++      if test "x$CONFIG_SHELL" != x; then+  for as_var in BASH_ENV ENV+	do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var+	done+	export CONFIG_SHELL+	exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}+fi+++    if test $as_have_required = no; then+  echo This script requires a shell more modern than all the+      echo shells that I found on your system.  Please install a+      echo modern shell, or manually run the script under such a+      echo shell if you do have one.+      { (exit 1); exit 1; }+fi+++fi++fi++++(eval "as_func_return () {+  (exit \$1)+}+as_func_success () {+  as_func_return 0+}+as_func_failure () {+  as_func_return 1+}+as_func_ret_success () {+  return 0+}+as_func_ret_failure () {+  return 1+}++exitcode=0+if as_func_success; then+  :+else+  exitcode=1+  echo as_func_success failed.+fi++if as_func_failure; then+  exitcode=1+  echo as_func_failure succeeded.+fi++if as_func_ret_success; then+  :+else+  exitcode=1+  echo as_func_ret_success failed.+fi++if as_func_ret_failure; then+  exitcode=1+  echo as_func_ret_failure succeeded.+fi++if ( set x; as_func_ret_success y && test x = \"\$1\" ); then+  :+else+  exitcode=1+  echo positional parameters were not saved.+fi++test \$exitcode = 0") || {+  echo No shell found that supports shell functions.+  echo Please tell bug-autoconf@gnu.org about your system,+  echo including any error possibly output before this message.+  echo This can help us improve future autoconf versions.+  echo Configuration will now proceed without shell functions.+}++++  as_lineno_1=$LINENO+  as_lineno_2=$LINENO+  test "x$as_lineno_1" != "x$as_lineno_2" &&+  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {++  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO+  # uniformly replaced by the line number.  The first 'sed' inserts a+  # line-number line after each line using $LINENO; the second 'sed'+  # does the real work.  The second script uses 'N' to pair each+  # line-number line with the line containing $LINENO, and appends+  # trailing '-' during substitution so that $LINENO is not a special+  # case at line end.+  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the+  # scripts with optimization help from Paolo Bonzini.  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+   { (exit 1); exit 1; }; }++  # 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+}+++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in+-n*)+  case `echo 'x\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  *)   ECHO_C='\c';;+  esac;;+*)+  ECHO_N='-n';;+esac+if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++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 -p'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -p'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -p'+  fi+else+  as_ln_s='cp -p'+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=:+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++if test -x / >/dev/null 2>&1; then+  as_test_x='test -x'+else+  if ls -dL / >/dev/null 2>&1; then+    as_ls_L_option=L+  else+    as_ls_L_option=+  fi+  as_test_x='+    eval sh -c '\''+      if test -d "$1"; then+	test -d "$1/.";+      else+	case $1 in+	-*)set "./$1";;+	esac;+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in+	???[sx]*):;;*)false;;esac;fi+    '\'' sh+  '+fi+as_executable_p=$as_test_x++# 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 7<&0 </dev/null 6>&1++# Name of the host.+# hostname on some systems (SVR3.2, 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=+SHELL=${CONFIG_SHELL-/bin/sh}++# Identity of this package.+PACKAGE_NAME='Haskell blas'+PACKAGE_TARNAME='haskell-blas'+PACKAGE_VERSION='0.7'+PACKAGE_STRING='Haskell blas 0.7'+PACKAGE_BUGREPORT='patperry@stanford.edu'++ac_unique_file="blas.cabal"+ac_subst_vars='SHELL+PATH_SEPARATOR+PACKAGE_NAME+PACKAGE_TARNAME+PACKAGE_VERSION+PACKAGE_STRING+PACKAGE_BUGREPORT+exec_prefix+prefix+program_transform_name+bindir+sbindir+libexecdir+datarootdir+datadir+sysconfdir+sharedstatedir+localstatedir+includedir+oldincludedir+docdir+infodir+htmldir+dvidir+pdfdir+psdir+libdir+localedir+mandir+DEFS+ECHO_C+ECHO_N+ECHO_T+LIBS+build_alias+host_alias+target_alias+CC+CFLAGS+LDFLAGS+CPPFLAGS+ac_ct_CC+EXEEXT+OBJEXT+BLAS_LIBS+BUILD_PACKAGE_BOOL+LIBOBJS+LTLIBOBJS'+ac_subst_files=''+ac_user_opts='+enable_option_checking+with_compiler+with_blas+'+      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=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_echo "$as_me: error: invalid feature name: $ac_useropt" >&2+   { (exit 1); exit 1; }; }+    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_echo "$as_me: error: invalid feature name: $ac_useropt" >&2+   { (exit 1); exit 1; }; }+    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_echo "$as_me: error: invalid package name: $ac_useropt" >&2+   { (exit 1); exit 1; }; }+    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_echo "$as_me: error: invalid package name: $ac_useropt" >&2+   { (exit 1); exit 1; }; }+    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_echo "$as_me: error: unrecognized option: $ac_option+Try \`$0 --help' for more information." >&2+   { (exit 1); exit 1; }; }+    ;;++  *=*)+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`+    # Reject names that are not valid shell variable names.+    expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&+      { $as_echo "$as_me: error: invalid variable name: $ac_envvar" >&2+   { (exit 1); exit 1; }; }+    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_echo "$as_me: error: missing argument to $ac_option" >&2+   { (exit 1); exit 1; }; }+fi++if test -n "$ac_unrecognized_opts"; then+  case $enable_option_checking in+    no) ;;+    fatal) { $as_echo "$as_me: error: Unrecognized options: $ac_unrecognized_opts" >&2+   { (exit 1); exit 1; }; } ;;+    *)     $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_echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2+   { (exit 1); exit 1; }; }+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+    $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.+    If a cross compiler is detected then cross compile mode will be used." >&2+  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_echo "$as_me: error: Working directory cannot be determined" >&2+   { (exit 1); exit 1; }; }+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||+  { $as_echo "$as_me: error: pwd does not report name of working directory" >&2+   { (exit 1); exit 1; }; }+++# 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_echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2+   { (exit 1); exit 1; }; }+fi+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"+ac_abs_confdir=`(+	cd "$srcdir" && test -r "./$ac_unique_file" || { $as_echo "$as_me: error: $ac_msg" >&2+   { (exit 1); exit 1; }; }+	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 blas 0.7 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-blas]+  --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 blas 0.7:";;+   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>++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    C/C++/Objective 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@stanford.edu>.+_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 blas configure 0.7+generated by GNU Autoconf 2.62++Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,+2002, 2003, 2004, 2005, 2006, 2007, 2008 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+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 blas $as_me 0.7, which was+generated by GNU Autoconf 2.62.  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) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;+    2)+      ac_configure_args1="$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+      ac_configure_args="$ac_configure_args '$ac_arg'"+      ;;+    esac+  done+done+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export 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++    cat <<\_ASBOX+## ---------------- ##+## Cache variables. ##+## ---------------- ##+_ASBOX+    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:$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= ;; #(+      *) $as_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++    cat <<\_ASBOX+## ----------------- ##+## Output variables. ##+## ----------------- ##+_ASBOX+    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+      cat <<\_ASBOX+## ------------------- ##+## File substitutions. ##+## ------------------- ##+_ASBOX+      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+      cat <<\_ASBOX+## ----------- ##+## confdefs.h. ##+## ----------- ##+_ASBOX+      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'; { (exit 1); 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++# 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+++# 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+  ac_site_file1=$CONFIG_SITE+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 -r "$ac_site_file"; then+    { $as_echo "$as_me:$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"+  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.+  if test -f "$cache_file"; then+    { $as_echo "$as_me:$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:$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:$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:$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:$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:$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:$LINENO:   former value:  \`$ac_old_val'" >&5+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}+	{ $as_echo "$as_me:$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.+      *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;+    esac+  fi+done+if $ac_cache_corrupted; then+  { $as_echo "$as_me:$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_echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5+$as_echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}+   { (exit 1); exit 1; }; }+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+++++ac_config_headers="$ac_config_headers cbits/config.h"+++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:$LINENO: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_prog_CC+set}" = set; 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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_CC="${ac_tool_prefix}gcc"+    $as_echo "$as_me:$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:$LINENO: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:$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:$LINENO: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_prog_ac_ct_CC+set}" = set; 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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_ac_ct_CC="gcc"+    $as_echo "$as_me:$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:$LINENO: result: $ac_ct_CC" >&5+$as_echo "$ac_ct_CC" >&6; }+else+  { $as_echo "$as_me:$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:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools+whose name does not start with the host triplet.  If you think this+configuration is useful to you, please write to autoconf@gnu.org." >&5+$as_echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools+whose name does not start with the host triplet.  If you think this+configuration is useful to you, please write to autoconf@gnu.org." >&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:$LINENO: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_prog_CC+set}" = set; 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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_CC="${ac_tool_prefix}cc"+    $as_echo "$as_me:$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:$LINENO: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:$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:$LINENO: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_prog_CC+set}" = set; 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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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:$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:$LINENO: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:$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:$LINENO: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_prog_CC+set}" = set; 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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"+    $as_echo "$as_me:$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:$LINENO: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:$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:$LINENO: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if test "${ac_cv_prog_ac_ct_CC+set}" = set; 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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_ac_ct_CC="$ac_prog"+    $as_echo "$as_me:$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:$LINENO: result: $ac_ct_CC" >&5+$as_echo "$ac_ct_CC" >&6; }+else+  { $as_echo "$as_me:$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:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools+whose name does not start with the host triplet.  If you think this+configuration is useful to you, please write to autoconf@gnu.org." >&5+$as_echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools+whose name does not start with the host triplet.  If you think this+configuration is useful to you, please write to autoconf@gnu.org." >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+fi++fi+++test -z "$CC" && { { $as_echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH+See \`config.log' for more details." >&5+$as_echo "$as_me: error: no acceptable C compiler found in \$PATH+See \`config.log' for more details." >&2;}+   { (exit 1); exit 1; }; }++# Provide some information about the compiler.+$as_echo "$as_me:$LINENO: checking for C compiler version" >&5+set X $ac_compile+ac_compiler=$2+{ (ac_try="$ac_compiler --version >&5"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compiler --version >&5") 2>&5+  ac_status=$?+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }+{ (ac_try="$ac_compiler -v >&5"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compiler -v >&5") 2>&5+  ac_status=$?+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }+{ (ac_try="$ac_compiler -V >&5"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compiler -V >&5") 2>&5+  ac_status=$?+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }++cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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:$LINENO: checking for C compiler default output file name" >&5+$as_echo_n "checking for C compiler default output file name... " >&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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link_default") 2>&5+  ac_status=$?+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; 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++{ $as_echo "$as_me:$LINENO: result: $ac_file" >&5+$as_echo "$ac_file" >&6; }+if test -z "$ac_file"; then+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { $as_echo "$as_me:$LINENO: error: C compiler cannot create executables+See \`config.log' for more details." >&5+$as_echo "$as_me: error: C compiler cannot create executables+See \`config.log' for more details." >&2;}+   { (exit 77); exit 77; }; }+fi++ac_exeext=$ac_cv_exeext++# Check that the compiler produces executables we can run.  If not, either+# the compiler is broken, or we cross compile.+{ $as_echo "$as_me:$LINENO: checking whether the C compiler works" >&5+$as_echo_n "checking whether the C compiler works... " >&6; }+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0+# If not cross compiling, check that we can run a simple program.+if test "$cross_compiling" != yes; then+  if { ac_try='./$ac_file'+  { (case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_try") 2>&5+  ac_status=$?+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+    cross_compiling=no+  else+    if test "$cross_compiling" = maybe; then+	cross_compiling=yes+    else+	{ { $as_echo "$as_me:$LINENO: error: cannot run C compiled programs.+If you meant to cross compile, use \`--host'.+See \`config.log' for more details." >&5+$as_echo "$as_me: error: cannot run C compiled programs.+If you meant to cross compile, use \`--host'.+See \`config.log' for more details." >&2;}+   { (exit 1); exit 1; }; }+    fi+  fi+fi+{ $as_echo "$as_me:$LINENO: result: yes" >&5+$as_echo "yes" >&6; }++rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out+ac_clean_files=$ac_clean_files_save+# Check that the compiler produces executables we can run.  If not, either+# the compiler is broken, or we cross compile.+{ $as_echo "$as_me:$LINENO: checking whether we are cross compiling" >&5+$as_echo_n "checking whether we are cross compiling... " >&6; }+{ $as_echo "$as_me:$LINENO: result: $cross_compiling" >&5+$as_echo "$cross_compiling" >&6; }++{ $as_echo "$as_me:$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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; 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:$LINENO: error: cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details." >&5+$as_echo "$as_me: error: cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details." >&2;}+   { (exit 1); exit 1; }; }+fi++rm -f conftest$ac_cv_exeext+{ $as_echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5+$as_echo "$ac_cv_exeext" >&6; }++rm -f conftest.$ac_ext+EXEEXT=$ac_cv_exeext+ac_exeext=$EXEEXT+{ $as_echo "$as_me:$LINENO: checking for suffix of object files" >&5+$as_echo_n "checking for suffix of object files... " >&6; }+if test "${ac_cv_objext+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compile") 2>&5+  ac_status=$?+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; 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:$LINENO: error: cannot compute suffix of object files: cannot compile+See \`config.log' for more details." >&5+$as_echo "$as_me: error: cannot compute suffix of object files: cannot compile+See \`config.log' for more details." >&2;}+   { (exit 1); exit 1; }; }+fi++rm -f conftest.$ac_cv_objext conftest.$ac_ext+fi+{ $as_echo "$as_me:$LINENO: result: $ac_cv_objext" >&5+$as_echo "$ac_cv_objext" >&6; }+OBJEXT=$ac_cv_objext+ac_objext=$OBJEXT+{ $as_echo "$as_me:$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 test "${ac_cv_c_compiler_gnu+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */++int+main ()+{+#ifndef __GNUC__+       choke me+#endif++  ;+  return 0;+}+_ACEOF+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compile") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext; then+  ac_compiler_gnu=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	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:$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:$LINENO: checking whether $CC accepts -g" >&5+$as_echo_n "checking whether $CC accepts -g... " >&6; }+if test "${ac_cv_prog_cc_g+set}" = set; 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 >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compile") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext; then+  ac_cv_prog_cc_g=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	CFLAGS=""+      cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compile") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext; then+  :+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_c_werror_flag=$ac_save_c_werror_flag+	 CFLAGS="-g"+	 cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compile") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext; then+  ac_cv_prog_cc_g=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5+++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:$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:$LINENO: checking for $CC option to accept ISO C89" >&5+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }+if test "${ac_cv_prog_cc_c89+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  ac_cv_prog_cc_c89=no+ac_save_CC=$CC+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+#include <stdarg.h>+#include <stdio.h>+#include <sys/types.h>+#include <sys/stat.h>+/* 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"+  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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_compile") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext; then+  ac_cv_prog_cc_c89=$ac_arg+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5+++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:$LINENO: result: none needed" >&5+$as_echo "none needed" >&6; } ;;+  xno)+    { $as_echo "$as_me:$LINENO: result: unsupported" >&5+$as_echo "unsupported" >&6; } ;;+  *)+    CC="$CC $ac_cv_prog_cc_c89"+    { $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;+esac+++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++++++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) acx_blas_ok=disable ;;+	-* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$with_blas" ;;+	*) BLAS_LIBS="-l$with_blas" ;;+esac++++ax_blas_ok=no++# Get fortran linker names of BLAS functions to check for.+sgemm=sgemm_+dgemm=dgemm_++ax_blas_save_LIBS="$LIBS"+LIBS="$LIBS $FLIBS"++# First, check BLAS_LIBS environment variable+if test $ax_blas_ok = no; then+if test "x$BLAS_LIBS" != x; then+	save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"+	{ $as_echo "$as_me:$LINENO: checking for $sgemm in $BLAS_LIBS" >&5+$as_echo_n "checking for $sgemm in $BLAS_LIBS... " >&6; }+	cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  ax_blas_ok=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	BLAS_LIBS=""+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+	{ $as_echo "$as_me:$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 $ax_blas_ok = no; then+	save_LIBS="$LIBS"; LIBS="$LIBS"+	as_ac_var=`$as_echo "ac_cv_func_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm" >&5+$as_echo_n "checking for $sgemm... " >&6; }+if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+/* Define $sgemm to an innocuous variant, in case <limits.h> declares $sgemm.+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */+#define $sgemm innocuous_$sgemm++/* System header to define __stub macros and hopefully few prototypes,+    which can conflict with char $sgemm (); 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 $sgemm++/* 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 ();+/* 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_$sgemm || defined __stub___$sgemm+choke me+#endif++int+main ()+{+return $sgemm ();+  ;+  return 0;+}+_ACEOF+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_var=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_var=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+fi+ac_res=`eval 'as_val=${'$as_ac_var'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_var'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes+fi++	LIBS="$save_LIBS"+fi++# BLAS in ATLAS library? (http://math-atlas.sourceforge.net/)+if test $ax_blas_ok = no; then+	{ $as_echo "$as_me:$LINENO: checking for ATL_xerbla in -latlas" >&5+$as_echo_n "checking for ATL_xerbla in -latlas... " >&6; }+if test "${ac_cv_lib_atlas_ATL_xerbla+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-latlas  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  ac_cv_lib_atlas_ATL_xerbla=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_cv_lib_atlas_ATL_xerbla=no+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_atlas_ATL_xerbla" >&5+$as_echo "$ac_cv_lib_atlas_ATL_xerbla" >&6; }+if test $ac_cv_lib_atlas_ATL_xerbla = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_f77blas_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lf77blas" >&5+$as_echo_n "checking for $sgemm in -lf77blas... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lf77blas -latlas $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  { $as_echo "$as_me:$LINENO: checking for cblas_dgemm in -lcblas" >&5+$as_echo_n "checking for cblas_dgemm in -lcblas... " >&6; }+if test "${ac_cv_lib_cblas_cblas_dgemm+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcblas -lf77blas -latlas $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  ac_cv_lib_cblas_cblas_dgemm=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_cv_lib_cblas_cblas_dgemm=no+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_cblas_cblas_dgemm" >&5+$as_echo "$ac_cv_lib_cblas_cblas_dgemm" >&6; }+if test $ac_cv_lib_cblas_cblas_dgemm = yes; then+  ax_blas_ok=yes+			 BLAS_LIBS="-lcblas -lf77blas -latlas"+fi++fi++fi++fi++# BLAS in PhiPACK libraries? (requires generic BLAS lib, too)+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lblas" >&5+$as_echo_n "checking for $sgemm in -lblas... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_dgemm_$dgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $dgemm in -ldgemm" >&5+$as_echo_n "checking for $dgemm in -ldgemm... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-ldgemm -lblas $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_sgemm_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lsgemm" >&5+$as_echo_n "checking for $sgemm in -lsgemm... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsgemm -lblas $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lsgemm -ldgemm -lblas"+fi++fi++fi++fi++# BLAS in Intel MKL library?+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_mkl_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lmkl" >&5+$as_echo_n "checking for $sgemm in -lmkl... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lmkl  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes;BLAS_LIBS="-lmkl"+fi++fi++# BLAS in Apple vecLib library?+if test $ax_blas_ok = no; then+	save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"+	as_ac_var=`$as_echo "ac_cv_func_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm" >&5+$as_echo_n "checking for $sgemm... " >&6; }+if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+/* Define $sgemm to an innocuous variant, in case <limits.h> declares $sgemm.+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */+#define $sgemm innocuous_$sgemm++/* System header to define __stub macros and hopefully few prototypes,+    which can conflict with char $sgemm (); 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 $sgemm++/* 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 ();+/* 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_$sgemm || defined __stub___$sgemm+choke me+#endif++int+main ()+{+return $sgemm ();+  ;+  return 0;+}+_ACEOF+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_var=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_var=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+fi+ac_res=`eval 'as_val=${'$as_ac_var'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_var'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes;BLAS_LIBS="-framework vecLib"+fi++	LIBS="$save_LIBS"+fi++# BLAS in Alpha CXML library?+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_cxml_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lcxml" >&5+$as_echo_n "checking for $sgemm in -lcxml... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcxml  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes;BLAS_LIBS="-lcxml"+fi++fi++# BLAS in Alpha DXML library? (now called CXML, see above)+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_dxml_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -ldxml" >&5+$as_echo_n "checking for $sgemm in -ldxml... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-ldxml  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes;BLAS_LIBS="-ldxml"+fi++fi++# BLAS in Sun Performance library?+if test $ax_blas_ok = no; then+	if test "x$GCC" != xyes; then # only works with Sun CC+		{ $as_echo "$as_me:$LINENO: checking for acosp in -lsunmath" >&5+$as_echo_n "checking for acosp in -lsunmath... " >&6; }+if test "${ac_cv_lib_sunmath_acosp+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsunmath  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  ac_cv_lib_sunmath_acosp=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_cv_lib_sunmath_acosp=no+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_sunmath_acosp" >&5+$as_echo "$ac_cv_lib_sunmath_acosp" >&6; }+if test $ac_cv_lib_sunmath_acosp = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_sunperf_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lsunperf" >&5+$as_echo_n "checking for $sgemm in -lsunperf... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsunperf -lsunmath $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; 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 $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_scs_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lscs" >&5+$as_echo_n "checking for $sgemm in -lscs... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lscs  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lscs"+fi++fi++# BLAS in SGIMATH library?+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_complib.sgimath_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lcomplib.sgimath" >&5+$as_echo_n "checking for $sgemm in -lcomplib.sgimath... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcomplib.sgimath  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"+fi++fi++# BLAS in IBM ESSL library? (requires generic BLAS lib, too)+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lblas" >&5+$as_echo_n "checking for $sgemm in -lblas... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_essl_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lessl" >&5+$as_echo_n "checking for $sgemm in -lessl... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lessl -lblas $FLIBS $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lessl -lblas"+fi++fi++fi++# Generic BLAS library?+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lblas" >&5+$as_echo_n "checking for $sgemm in -lblas... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lblas"+fi++fi++LIBS="$ax_blas_save_LIBS"++# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:+if test x"$ax_blas_ok" = xyes; then+    ax_blas_ok=yes; ax_blas_underscore=yes+    :+else+    ax_blas_ok=no+++ax_blas_ok=no++# Get fortran linker names of BLAS functions to check for.+sgemm=sgemm+dgemm=dgemm++ax_blas_save_LIBS="$LIBS"+LIBS="$LIBS $FLIBS"++# First, check BLAS_LIBS environment variable+if test $ax_blas_ok = no; then+if test "x$BLAS_LIBS" != x; then+	save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"+	{ $as_echo "$as_me:$LINENO: checking for $sgemm in $BLAS_LIBS" >&5+$as_echo_n "checking for $sgemm in $BLAS_LIBS... " >&6; }+	cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  ax_blas_ok=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	BLAS_LIBS=""+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+	{ $as_echo "$as_me:$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 $ax_blas_ok = no; then+	save_LIBS="$LIBS"; LIBS="$LIBS"+	as_ac_var=`$as_echo "ac_cv_func_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm" >&5+$as_echo_n "checking for $sgemm... " >&6; }+if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+/* Define $sgemm to an innocuous variant, in case <limits.h> declares $sgemm.+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */+#define $sgemm innocuous_$sgemm++/* System header to define __stub macros and hopefully few prototypes,+    which can conflict with char $sgemm (); 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 $sgemm++/* 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 ();+/* 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_$sgemm || defined __stub___$sgemm+choke me+#endif++int+main ()+{+return $sgemm ();+  ;+  return 0;+}+_ACEOF+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_var=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_var=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+fi+ac_res=`eval 'as_val=${'$as_ac_var'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_var'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes+fi++	LIBS="$save_LIBS"+fi++# BLAS in ATLAS library? (http://math-atlas.sourceforge.net/)+if test $ax_blas_ok = no; then+	{ $as_echo "$as_me:$LINENO: checking for ATL_xerbla in -latlas" >&5+$as_echo_n "checking for ATL_xerbla in -latlas... " >&6; }+if test "${ac_cv_lib_atlas_ATL_xerbla+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-latlas  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  ac_cv_lib_atlas_ATL_xerbla=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_cv_lib_atlas_ATL_xerbla=no+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_atlas_ATL_xerbla" >&5+$as_echo "$ac_cv_lib_atlas_ATL_xerbla" >&6; }+if test $ac_cv_lib_atlas_ATL_xerbla = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_f77blas_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lf77blas" >&5+$as_echo_n "checking for $sgemm in -lf77blas... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lf77blas -latlas $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  { $as_echo "$as_me:$LINENO: checking for cblas_dgemm in -lcblas" >&5+$as_echo_n "checking for cblas_dgemm in -lcblas... " >&6; }+if test "${ac_cv_lib_cblas_cblas_dgemm+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcblas -lf77blas -latlas $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  ac_cv_lib_cblas_cblas_dgemm=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_cv_lib_cblas_cblas_dgemm=no+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_cblas_cblas_dgemm" >&5+$as_echo "$ac_cv_lib_cblas_cblas_dgemm" >&6; }+if test $ac_cv_lib_cblas_cblas_dgemm = yes; then+  ax_blas_ok=yes+			 BLAS_LIBS="-lcblas -lf77blas -latlas"+fi++fi++fi++fi++# BLAS in PhiPACK libraries? (requires generic BLAS lib, too)+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lblas" >&5+$as_echo_n "checking for $sgemm in -lblas... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_dgemm_$dgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $dgemm in -ldgemm" >&5+$as_echo_n "checking for $dgemm in -ldgemm... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-ldgemm -lblas $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_sgemm_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lsgemm" >&5+$as_echo_n "checking for $sgemm in -lsgemm... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsgemm -lblas $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lsgemm -ldgemm -lblas"+fi++fi++fi++fi++# BLAS in Intel MKL library?+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_mkl_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lmkl" >&5+$as_echo_n "checking for $sgemm in -lmkl... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lmkl  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes;BLAS_LIBS="-lmkl"+fi++fi++# BLAS in Apple vecLib library?+if test $ax_blas_ok = no; then+	save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"+	as_ac_var=`$as_echo "ac_cv_func_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm" >&5+$as_echo_n "checking for $sgemm... " >&6; }+if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+/* Define $sgemm to an innocuous variant, in case <limits.h> declares $sgemm.+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */+#define $sgemm innocuous_$sgemm++/* System header to define __stub macros and hopefully few prototypes,+    which can conflict with char $sgemm (); 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 $sgemm++/* 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 ();+/* 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_$sgemm || defined __stub___$sgemm+choke me+#endif++int+main ()+{+return $sgemm ();+  ;+  return 0;+}+_ACEOF+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_var=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_var=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+fi+ac_res=`eval 'as_val=${'$as_ac_var'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_var'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes;BLAS_LIBS="-framework vecLib"+fi++	LIBS="$save_LIBS"+fi++# BLAS in Alpha CXML library?+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_cxml_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lcxml" >&5+$as_echo_n "checking for $sgemm in -lcxml... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcxml  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes;BLAS_LIBS="-lcxml"+fi++fi++# BLAS in Alpha DXML library? (now called CXML, see above)+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_dxml_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -ldxml" >&5+$as_echo_n "checking for $sgemm in -ldxml... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-ldxml  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes;BLAS_LIBS="-ldxml"+fi++fi++# BLAS in Sun Performance library?+if test $ax_blas_ok = no; then+	if test "x$GCC" != xyes; then # only works with Sun CC+		{ $as_echo "$as_me:$LINENO: checking for acosp in -lsunmath" >&5+$as_echo_n "checking for acosp in -lsunmath... " >&6; }+if test "${ac_cv_lib_sunmath_acosp+set}" = set; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsunmath  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  ac_cv_lib_sunmath_acosp=yes+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_cv_lib_sunmath_acosp=no+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_sunmath_acosp" >&5+$as_echo "$ac_cv_lib_sunmath_acosp" >&6; }+if test $ac_cv_lib_sunmath_acosp = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_sunperf_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lsunperf" >&5+$as_echo_n "checking for $sgemm in -lsunperf... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lsunperf -lsunmath $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; 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 $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_scs_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lscs" >&5+$as_echo_n "checking for $sgemm in -lscs... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lscs  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lscs"+fi++fi++# BLAS in SGIMATH library?+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_complib.sgimath_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lcomplib.sgimath" >&5+$as_echo_n "checking for $sgemm in -lcomplib.sgimath... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcomplib.sgimath  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"+fi++fi++# BLAS in IBM ESSL library? (requires generic BLAS lib, too)+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lblas" >&5+$as_echo_n "checking for $sgemm in -lblas... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  as_ac_Lib=`$as_echo "ac_cv_lib_essl_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lessl" >&5+$as_echo_n "checking for $sgemm in -lessl... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lessl -lblas $FLIBS $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lessl -lblas"+fi++fi++fi++# Generic BLAS library?+if test $ax_blas_ok = no; then+	as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`+{ $as_echo "$as_me:$LINENO: checking for $sgemm in -lblas" >&5+$as_echo_n "checking for $sgemm in -lblas... " >&6; }+if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lblas  $LIBS"+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* 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+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:$LINENO: $ac_try_echo\""+$as_echo "$ac_try_echo") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then+  eval "$as_ac_Lib=yes"+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_Lib=no"+fi++rm -rf conftest.dSYM+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+ac_res=`eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'`+	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+if test `eval 'as_val=${'$as_ac_Lib'}+		 $as_echo "$as_val"'` = yes; then+  ax_blas_ok=yes; BLAS_LIBS="-lblas"+fi++fi++LIBS="$ax_blas_save_LIBS"++# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:+if test x"$ax_blas_ok" = xyes; then+    ax_blas_ok=yes; ax_blas_underscore=no+    :+else+    ax_blas_ok=no++fi++fi+++++if test x"$ax_blas_ok" = xyes; then+++cat >>confdefs.h <<\_ACEOF+#define HAVE_BLAS 1+_ACEOF++++        if test x"$ax_blas_underscore" = xyes; then+            cat >>confdefs.h <<\_ACEOF+#define F77_FUNC(name) name ## _+_ACEOF++        else+            cat >>confdefs.h <<\_ACEOF+#define F77_FUNC(name) name+_ACEOF++        fi++    :+else+    ax_blas_ok=no++fi+++if test "$ax_blas_ok" = yes; then+  BUILD_PACKAGE_BOOL=True+else+  BUILD_PACKAGE_BOOL=False+fi+++ac_config_files="$ac_config_files blas.buildinfo tests/Makefile"++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:$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= ;; #(+      *) $as_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+    test "x$cache_file" != "x/dev/null" &&+      { $as_echo "$as_me:$LINENO: updating cache $cache_file" >&5+$as_echo "$as_me: updating cache $cache_file" >&6;}+    cat confcache >$cache_file+  else+    { $as_echo "$as_me:$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=+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.+  ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"+  ac_ltlibobjs="$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:$LINENO: creating $CONFIG_STATUS" >&5+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}+cat >$CONFIG_STATUS <<_ACEOF || ac_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}+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_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+++++# PATH needs CR+# 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_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+if (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++# Support unset when possible.+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then+  as_unset=unset+else+  as_unset=false+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.+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); exit 1; }+fi++# Work around bugs in pre-3.0 UWIN ksh.+for as_var in ENV MAIL MAILPATH+do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# Required to use basename.+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+++# Name of the executable.+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'`++# CDPATH.+$as_unset CDPATH++++  as_lineno_1=$LINENO+  as_lineno_2=$LINENO+  test "x$as_lineno_1" != "x$as_lineno_2" &&+  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {++  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO+  # uniformly replaced by the line number.  The first 'sed' inserts a+  # line-number line after each line using $LINENO; the second 'sed'+  # does the real work.  The second script uses 'N' to pair each+  # line-number line with the line containing $LINENO, and appends+  # trailing '-' during substitution so that $LINENO is not a special+  # case at line end.+  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the+  # scripts with optimization help from Paolo Bonzini.  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+   { (exit 1); exit 1; }; }++  # 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+}+++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in+-n*)+  case `echo 'x\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  *)   ECHO_C='\c';;+  esac;;+*)+  ECHO_N='-n';;+esac+if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++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 -p'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -p'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -p'+  fi+else+  as_ln_s='cp -p'+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=:+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++if test -x / >/dev/null 2>&1; then+  as_test_x='test -x'+else+  if ls -dL / >/dev/null 2>&1; then+    as_ls_L_option=L+  else+    as_ls_L_option=+  fi+  as_test_x='+    eval sh -c '\''+      if test -d "$1"; then+	test -d "$1/.";+      else+	case $1 in+	-*)set "./$1";;+	esac;+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in+	???[sx]*):;;*)false;;esac;fi+    '\'' sh+  '+fi+as_executable_p=$as_test_x++# 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++# 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 blas $as_me 0.7, which was+generated by GNU Autoconf 2.62.  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++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 from templates according to the+current configuration.++Usage: $0 [OPTIONS] [FILE]...++  -h, --help       print this help, then exit+  -V, --version    print version number and configuration settings, then exit+  -q, --quiet      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 <bug-autoconf@gnu.org>."++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_cs_version="\\+Haskell blas config.status 0.7+configured by $0, generated by GNU Autoconf 2.62,+  with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"++Copyright (C) 2008 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=$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 ;;+  --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"` ;;+    esac+    CONFIG_FILES="$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+    CONFIG_HEADERS="$CONFIG_HEADERS '$ac_optarg'"+    ac_need_defaults=false;;+  --he | --h)+    # Conflict between --help and --header+    { $as_echo "$as_me: error: ambiguous option: $1+Try \`$0 --help' for more information." >&2+   { (exit 1); exit 1; }; };;+  --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_echo "$as_me: error: unrecognized option: $1+Try \`$0 --help' for more information." >&2+   { (exit 1); exit 1; }; } ;;++  *) ac_config_targets="$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" ;;+    "blas.buildinfo") CONFIG_FILES="$CONFIG_FILES blas.buildinfo" ;;+    "tests/Makefile") CONFIG_FILES="$CONFIG_FILES tests/Makefile" ;;++  *) { { $as_echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5+$as_echo "$as_me: error: invalid argument: $ac_config_target" >&2;}+   { (exit 1); exit 1; }; };;+  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=+  trap 'exit_status=$?+  { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status+' 0+  trap '{ (exit 1); exit 1; }' 1 2 13 15+}+# Create a (secure) tmp directory for tmp files.++{+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&+  test -n "$tmp" && test -d "$tmp"+}  ||+{+  tmp=./conf$$-$RANDOM+  (umask 077 && mkdir "$tmp")+} ||+{+   $as_echo "$as_me: cannot create a temporary directory in ." >&2+   { (exit 1); exit 1; }+}++# 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='
'+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 {' >"$tmp/subs1.awk" &&+_ACEOF+++{+  echo "cat >conf$$subs.awk <<_ACEOF" &&+  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&+  echo "_ACEOF"+} >conf$$subs.sh ||+  { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5+$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}+   { (exit 1); exit 1; }; }+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_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5+$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}+   { (exit 1); exit 1; }; }++  if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` = $ac_delim_num; then+    break+  elif $ac_last_try; then+    { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5+$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}+   { (exit 1); exit 1; }; }+  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 >>"\$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 >>"\$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 < "$tmp/subs1.awk" > "$tmp/subs.awk" \+  || { { $as_echo "$as_me:$LINENO: error: could not setup config files machinery" >&5+$as_echo "$as_me: error: could not setup config files machinery" >&2;}+   { (exit 1); exit 1; }; }+_ACEOF++# VPATH may cause trouble with some makes, so we remove $(srcdir),+# ${srcdir} and @srcdir@ 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[	 ]*=/{+s/:*\$(srcdir):*/:/+s/:*\${srcdir}:*/:/+s/:*@srcdir@:*/:/+s/^\([^=]*=[	 ]*\):*/\1/+s/:*$//+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 >"$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_t=`sed -n "/$ac_delim/p" confdefs.h`+  if test -z "$ac_t"; then+    break+  elif $ac_last_try; then+    { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_HEADERS" >&5+$as_echo "$as_me: error: could not make $CONFIG_HEADERS" >&2;}+   { (exit 1); exit 1; }; }+  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]+  if (D_is_set[macro]) {+    # Preserve the white space surrounding the "#".+    prefix = substr(line, 1, index(line, defundef) - 1)+    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 "/*", line, "*/"+      next+    }+  }+}+{ print }+_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+  { { $as_echo "$as_me:$LINENO: error: could not setup config headers machinery" >&5+$as_echo "$as_me: error: could not setup config headers machinery" >&2;}+   { (exit 1); exit 1; }; }+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_echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5+$as_echo "$as_me: error: Invalid tag $ac_tag." >&2;}+   { (exit 1); exit 1; }; };;+  :[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="$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_echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5+$as_echo "$as_me: error: cannot find input file: $ac_f" >&2;}+   { (exit 1); exit 1; }; };;+      esac+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac+      ac_file_inputs="$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:$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 >"$tmp/stdin" \+      || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5+$as_echo "$as_me: error: could not create $ac_file" >&2;}+   { (exit 1); exit 1; }; } ;;+    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"+  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || {+    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_echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5+$as_echo "$as_me: error: cannot create directory $as_dir" >&2;}+   { (exit 1); exit 1; }; }; }+  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:$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 "$tmp/subs.awk" >$tmp/out \+  || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5+$as_echo "$as_me: error: could not create $ac_file" >&2;}+   { (exit 1); exit 1; }; }++test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&+  { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&+  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&+  { $as_echo "$as_me:$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 "$tmp/stdin"+  case $ac_file in+  -) cat "$tmp/out" && rm -f "$tmp/out";;+  *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";;+  esac \+  || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5+$as_echo "$as_me: error: could not create $ac_file" >&2;}+   { (exit 1); exit 1; }; }+ ;;+  :H)+  #+  # CONFIG_HEADER+  #+  if test x"$ac_file" != x-; then+    {+      $as_echo "/* $configure_input  */" \+      && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs"+    } >"$tmp/config.h" \+      || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5+$as_echo "$as_me: error: could not create $ac_file" >&2;}+   { (exit 1); exit 1; }; }+    if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then+      { $as_echo "$as_me:$LINENO: $ac_file is unchanged" >&5+$as_echo "$as_me: $ac_file is unchanged" >&6;}+    else+      rm -f "$ac_file"+      mv "$tmp/config.h" "$ac_file" \+	|| { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5+$as_echo "$as_me: error: could not create $ac_file" >&2;}+   { (exit 1); exit 1; }; }+    fi+  else+    $as_echo "/* $configure_input  */" \+      && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \+      || { { $as_echo "$as_me:$LINENO: error: could not create -" >&5+$as_echo "$as_me: error: could not create -" >&2;}+   { (exit 1); exit 1; }; }+  fi+ ;;+++  esac++done # for ac_tag+++{ (exit 0); exit 0; }+_ACEOF+chmod +x $CONFIG_STATUS+ac_clean_files=$ac_clean_files_save++test $ac_write_fail = 0 ||+  { { $as_echo "$as_me:$LINENO: error: write failure creating $CONFIG_STATUS" >&5+$as_echo "$as_me: error: write failure creating $CONFIG_STATUS" >&2;}+   { (exit 1); exit 1; }; }+++# 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 || { (exit 1); exit 1; }+fi+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then+  { $as_echo "$as_me:$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,23 @@++AC_PREREQ(2.61)+AC_INIT([Haskell blas], [0.7], [patperry@stanford.edu])+AC_CONFIG_SRCDIR([blas.cabal])++AC_CONFIG_HEADERS([cbits/config.h])++AC_PROG_CC+AC_CONFIG_MACRO_DIR([m4])++AC_ARG_WITH(compiler, +    [AC_HELP_STRING([--with-compiler=<cmd>], [use Haskell compiler <cmd>])])++AX_BLAS+if test "$ax_blas_ok" = yes; then+  BUILD_PACKAGE_BOOL=True+else +  BUILD_PACKAGE_BOOL=False+fi+AC_SUBST([BUILD_PACKAGE_BOOL])++AC_CONFIG_FILES([blas.buildinfo tests/Makefile])+AC_OUTPUT
examples/LU.hs view
@@ -1,7 +1,7 @@-+{-# LANGUAGE ScopedTypeVariables #-} module LU ( luFactorize ) where -import BLAS.Elem( BLAS3 )+import Data.Elem.BLAS( BLAS3 )  import Control.Monad import Control.Monad.ST@@ -12,12 +12,13 @@ import Data.Vector.Dense.ST  -lu :: (BLAS3 e) => Matrix (m,n) e -> Either Int (Matrix (m,n) e, [Int])-lu a = runST $ do-    a' <- thawMatrix a-    luFactorize a' >>=-        return . either Left (\pivots ->-            Right (unsafeFreezeMatrix a', pivots)+lu :: (BLAS3 e) => Matrix (n,p) e -> Either Int (Matrix (n,p) e, [Int])+lu (a :: Matrix (n,p) e) = runST $ do+    ma <- thawMatrix a :: ST s (STMatrix s (n,p) e)+    luFactorize ma >>=+        either (return . Left) (\pivots -> do+            a' <- unsafeFreezeMatrix ma+            return $ Right (a',pivots)             )  @@ -29,7 +30,7 @@  - 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.  -}      -luFactorize :: (BLAS3 e) => STMatrix s (m,n) e -> ST s (Either Int [Int])+luFactorize :: (WriteMatrix a e m) => a (n,p) e -> m (Either Int [Int]) luFactorize a     | mn > 1 =         let nleft = mn `div` 2@@ -44,7 +45,7 @@                    luFactorize a22 >>=                        either (return . Left . (nleft+)) (\pivots' -> do                            zipWithM_ (swapRows a21) [0..] pivots'-                           return (Right $ pivots ++ map (nleft+) pivots')+                           return $ Right (pivots ++ map (nleft+) pivots')                        )                )     | mn == 1 = @@ -59,7 +60,7 @@                 else                     return $ Left 0     | otherwise =-        return (Right [])+        return $ Right []   where     (m,n) = shape a     mn    = min m n
+ lib/BLAS/CTypes.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : BLAS.CTypes+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module BLAS.CTypes (+    CBLASOrder,+    CBLASTrans,+    CBLASUpLo,+    CBLASDiag,+    CBLASSide,++    rowMajor,+    colMajor,+    +    noTrans,+    trans,+    conjTrans,+    +    upper,+    lower,+    +    nonUnit,+    unit,+    +    leftSide,+    rightSide,++    cblasOrder,+    cblasTrans,+    cblasUpLo,+    cblasDiag,+    cblasSide,+    ) where+        +import BLAS.Types+        +newtype CBLASOrder = CBLASOrder Int deriving (Eq, Show)+newtype CBLASTrans = CBLASTrans Int deriving (Eq, Show)+newtype CBLASUpLo  = CBLASUpLo  Int deriving (Eq, Show)+newtype CBLASDiag  = CBLASDiag  Int deriving (Eq, Show)+newtype CBLASSide  = CBLASSide  Int deriving (Eq, Show)++rowMajor, colMajor :: CBLASOrder+rowMajor = CBLASOrder 101+colMajor = CBLASOrder 102++cblasOrder :: OrderEnum -> CBLASOrder+cblasOrder RowMajor = CBLASOrder 101+cblasOrder ColMajor = CBLASOrder 102++noTrans, trans, conjTrans :: CBLASTrans+noTrans   = CBLASTrans 111+trans     = CBLASTrans 112+conjTrans = CBLASTrans 113++cblasTrans :: TransEnum -> CBLASTrans+cblasTrans NoTrans   = CBLASTrans 111+cblasTrans ConjTrans = CBLASTrans 113++upper, lower :: CBLASUpLo+upper = CBLASUpLo 121+lower = CBLASUpLo 122++cblasUpLo :: UpLoEnum -> CBLASUpLo+cblasUpLo Upper = CBLASUpLo 121+cblasUpLo Lower = CBLASUpLo 122++nonUnit, unit :: CBLASDiag+nonUnit = CBLASDiag 131+unit    = CBLASDiag 132++cblasDiag :: DiagEnum -> CBLASDiag+cblasDiag NonUnit = CBLASDiag 131+cblasDiag Unit    = CBLASDiag 132++leftSide, rightSide :: CBLASSide+leftSide  = CBLASSide 141+rightSide = CBLASSide 142++cblasSide :: SideEnum -> CBLASSide+cblasSide LeftSide  = CBLASSide 141+cblasSide RightSide = CBLASSide 142
+ lib/BLAS/Internal.hs view
@@ -0,0 +1,318 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+{-# OPTIONS_GHC -fglasgow-exts #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : BLAS.Internal+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+++module BLAS.Internal (+    clearArray,+    bzero,+    inlinePerformIO,+    checkedSubvector,+    checkedSubvectorWithStride,+    checkVecVecOp,+    checkedRow,+    checkedCol,+    checkedDiag,+    checkedSubmatrix,+    checkMatMatOp,+    checkMatVecMult,+    checkMatMatMult,+    checkMatVecMultAdd,+    checkMatMatMultAdd,+    checkMatVecSolv,+    checkMatMatSolv,+    checkMatVecSolvTo,+    checkMatMatSolvTo,+    checkSquare,+    checkFat,+    checkTall,+    checkBinaryOp,+    checkTernaryOp,+    diagStart,+    diagLen,    +    ) where++import Data.Ix     ( inRange )+import Foreign                  ( Ptr, Storable, castPtr, sizeOf )+import Foreign.C.Types          ( CSize )+import Text.Printf ( printf )+++#if defined(__GLASGOW_HASKELL__)+import GHC.Base                 ( realWorld# )+import GHC.IOBase               ( IO(IO) )+#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 = (fromInteger . toInteger) (n * sizeOf e)+        in do+            bzero ptr nbytes+{-# INLINE clearArray #-}+++bzero :: Ptr a -> Int -> IO ()+bzero ptr n =+    let ptr' = castPtr ptr+        n'   = (fromInteger . toInteger) n+    in bzero_ ptr' n'+        +foreign import ccall "strings.h bzero"+    bzero_ :: Ptr () -> CSize -> IO ()+    ++inlinePerformIO :: IO a -> a+#if defined(__GLASGOW_HASKELL__)+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+#else+inlinePerformIO = unsafePerformIO+#endif+{-# INLINE inlinePerformIO #-}++checkedSubvector :: Int -> (Int -> Int -> v) -> Int -> Int -> v+checkedSubvector n sub o n'+    | (o < 0) && (n' /= 0) = +        error $ printf +            "tried to create a subvector starting at a negative offset: `%d'" o+    | n' < 0 = +        error $ printf +            "tried to create a subvector with a negative length `%d'" n'+    | n' + o > n = +        error $ printf+            ("tried to create a subvector of length `%d' and offset `%d' "+             ++ " from a vector of length `%d'") n' o n+    | otherwise =+        sub o n'+        +checkedSubvectorWithStride :: Int -> Int -> (Int -> Int -> v)+    -> Int -> Int -> v+checkedSubvectorWithStride s n sub o n'+    | (o < 0) && (n' /= 0) =+        error $ printf+            "Tried to create a subvector starting at a negative offset: `%d'" o+    | n' < 0 =+        error $ printf+            "Tried to create a subvector with a negative length `%d'" n'+    | s <= 0 =+        error $ printf+            "Tried to create a subvector with non-positive stride `%d'" s+    | not $ inRange (-1,n) (o + s * n') =+        error $ printf+            ("tried to create a subvector of length `%d',  offset `%d',"+             ++ " and stride '%d' from a vector of length `%d'") n' o s n+    | otherwise =+        sub o n'++checkVecVecOp :: String -> Int -> Int -> a -> a+checkVecVecOp name n1 n2+    | n1 /= n2 =+        error $ printf+            ("%s: x and y have different dimensions.  x has dimension `%d',"+             ++ " and y has dimension `%d'") name n1 n2+    | otherwise = id+{-# INLINE checkVecVecOp #-}++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 `%d' 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/BLAS/Types.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module     : BLAS.Types+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module BLAS.Types (+    OrderEnum(..),+    TransEnum(..),+    UpLoEnum(..),+    DiagEnum(..),+    SideEnum(..),+    +    flipOrder,+    flipTrans,+    flipUpLo,+    flipSide,+    ) where++-- | Matrix element storage order.+data OrderEnum = RowMajor | ColMajor deriving (Eq, Show, Enum)++-- | Transpose type.+data TransEnum = NoTrans | ConjTrans deriving (Eq, Show, Enum)++-- | Lower or upper triangular storage.+data UpLoEnum = Upper | Lower deriving (Eq, Show, Enum)++-- | Diagonal storage.+data DiagEnum = Unit | NonUnit deriving (Eq, Show, Enum)++-- | Multiplication side.+data SideEnum = LeftSide | RightSide deriving (Eq, Show, Enum)++-- | Exchange @RowMajor@ and @ColMajor@.+flipOrder :: OrderEnum -> OrderEnum+flipOrder RowMajor = ColMajor+flipOrder ColMajor = RowMajor++-- | Exchange @NoTrans@ and @ConjTrans@.+flipTrans :: TransEnum -> TransEnum+flipTrans NoTrans = ConjTrans+flipTrans ConjTrans = NoTrans++-- | Exchange @Upper@ and @Lower@.+flipUpLo :: UpLoEnum -> UpLoEnum+flipUpLo Upper = Lower+flipUpLo Lower = Upper+        +-- | Exchange @LeftSide@ and @RigthSide@.+flipSide :: SideEnum -> SideEnum+flipSide LeftSide  = RightSide+flipSide RightSide = LeftSide
+ lib/Data/Elem/BLAS.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Elem.BLAS+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Type classes for elements with BLAS support.+--++module Data.Elem.BLAS (+    -- * Base element type class+    module Data.Elem.BLAS.Base,+    -- * BLAS element types+    BLAS1,+    BLAS2,+    BLAS3,+    -- * Re-export of Complex from Data.Complex+    module Data.Complex+    ) where++import Data.Elem.BLAS.Base+import Data.Elem.BLAS.Level1( BLAS1 )+import Data.Elem.BLAS.Level2( BLAS2 )+import Data.Elem.BLAS.Level3( BLAS3 )+import Data.Complex( Complex(..) )
+ lib/Data/Elem/BLAS/Base.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Elem.BLAS.Base+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Elem.BLAS.Base (+    Elem(..),+    ) where++import Data.AEq+import Data.Complex             ( Complex(..), magnitude )+import qualified Data.Complex as Complex+import Foreign                  ( Storable )+import Foreign.Storable.Complex ()++-- | The base class for elements.+class (AEq e, Storable e, Fractional e) => Elem e where+    -- | Get the complex conjugate of a value.+    conjugate :: e -> e+    +    -- | Get the magnitude of a value.+    norm :: e -> Double+    +    -- | Get the l1 norm of a value.+    norm1 :: e -> Double+    +    -- | Convert a double to an element.+    fromReal :: Double -> e++    -- | Try to coerce a value to a double.  This will fail unless the+    -- complex part is zero (according to a comparison by @(~==)@).+    maybeToReal :: e -> Maybe Double+    +instance Elem Double where+    conjugate   = id+    {-# INLINE conjugate #-}+    norm        = abs+    {-# INLINE norm #-}+    norm1       = abs+    {-# INLINE norm1 #-}+    fromReal    = id+    {-# INLINE fromReal #-}+    maybeToReal = Just+    {-# INLINE maybeToReal #-}+    +instance Elem (Complex Double) where+    conjugate      = Complex.conjugate+    {-# INLINE conjugate #-}+    norm           = magnitude+    {-# INLINE norm #-}    +    norm1 (x :+ y) = abs x + abs y+    {-# INLINE norm1 #-}    +    fromReal x     = x :+ 0+    {-# INLINE fromReal #-}    +    maybeToReal (x :+ y) | y ~== 0   = Just x+                         | otherwise = Nothing+    {-# INLINE maybeToReal #-}
+ lib/Data/Elem/BLAS/Double.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# CFILES cbits/double.c #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Elem.BLAS.Double+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Elem.BLAS.Double +    where+        +import Foreign.Ptr ( Ptr )+import BLAS.CTypes++---------------------------- Level 1 Routines -------------------------------++foreign import ccall unsafe "BLAS.h blas_ddot"+    ddot :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO Double++foreign import ccall unsafe "BLAS.h blas_dnrm2"+    dnrm2  :: Int -> Ptr Double -> Int -> IO Double++foreign import ccall unsafe "BLAS.h blas_dasum"+    dasum  :: Int -> Ptr Double -> Int -> IO Double++foreign import ccall unsafe "BLAS.h blas_idamax"+    idamax :: Int -> Ptr Double -> Int -> IO Int++foreign import ccall unsafe "BLAS.h blas_dscal"+    dscal  :: Int -> Double -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dswap"+    dswap  :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dcopy"+    dcopy  :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_daxpy"+    daxpy  :: Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_drotg"+    drotg  :: Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> IO ()++foreign import ccall unsafe "BLAS.h blas_drot"+    drot :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Double -> IO ()++foreign import ccall unsafe "BLAS.h blas_drotmg"+    drotmg :: Ptr Double -> Ptr Double -> Ptr Double -> Double -> Ptr Double -> IO ()++foreign import ccall unsafe "BLAS.h blas_drotm"+    drotm :: Int -> Ptr Double -> Int -> Ptr Double -> Int -> Ptr Double -> IO ()+++---------------------------- Level 2 Routines -------------------------------++foreign import ccall unsafe "BLAS.h blas_dgemv"+    dgemv :: CBLASTrans -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dgbmv"+    dgbmv ::  CBLASTrans -> Int -> Int -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dtrmv"+    dtrmv ::  CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dtbmv"+    dtbmv ::  CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()+                 +foreign import ccall unsafe "BLAS.h blas_dtrsv"+    dtrsv ::  CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dtbsv"+    dtbsv ::  CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()+    +foreign import ccall unsafe "BLAS.h blas_dsymv"+    dsymv ::  CBLASUpLo -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()+    +foreign import ccall unsafe "BLAS.h blas_dsbmv"+    dsbmv ::  CBLASUpLo -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()+    +foreign import ccall unsafe "BLAS.h blas_dger"+    dger  ::  Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()+        +foreign import ccall unsafe "BLAS.h blas_dsyr"+    dsyr  ::  CBLASUpLo -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dsyr2"+    dsyr2 ::  CBLASUpLo -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()+++---------------------------- Level 3 Routines -------------------------------++foreign import ccall unsafe "BLAS.h blas_dgemm"+    dgemm  ::  CBLASTrans -> CBLASTrans -> Int -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dsymm"+    dsymm  ::  CBLASSide -> CBLASUpLo -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dtrmm"+    dtrmm  ::  CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dtrsm"+    dtrsm  ::  CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_dsyrk"+    dsyrk  ::  CBLASUpLo -> CBLASTrans -> Int -> Int -> Double -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()+           +foreign import ccall unsafe "BLAS.h blas_dsyr2k"           +    dsyr2k ::  CBLASUpLo -> CBLASTrans -> Int -> Int -> Double -> Ptr Double -> Int -> Ptr Double -> Int -> Double -> Ptr Double -> Int -> IO ()+
+ lib/Data/Elem/BLAS/Level1.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-excess-precision #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Elem.BLAS.Level1+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Elem.BLAS.Level1+    where+     +import Prelude hiding ( div )++import Foreign ( Ptr, Storable, advancePtr, castPtr, peek, poke, with )+import Foreign.Storable.Complex ()+import Data.Complex ( Complex(..) )++import Data.Elem.BLAS.Base+import BLAS.CTypes+import Data.Elem.BLAS.Double  +import Data.Elem.BLAS.Zomplex+        +-- | Types with vector-vector operations.+class (Elem a) => BLAS1 a where+    dotu  :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO a+    dotc  :: 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 () ++    swap  :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    copy  :: Int -> Ptr a -> Int -> 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 ()++    -- Replaces @y@ with @conj y@.+    vconj  :: Int -> Ptr a -> Int -> IO ()++    -- Replaces @y@ with @alpha (conj x) + y@+    acxpy :: Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()++    -- Replaces @y@ with @x*y@.+    vmul :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()++    -- Replaces @y@ with @conj(x)*y@.+    vcmul :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()++    -- Replaces @y@ with @y/x@.+    vdiv :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()++    -- Replaces @y@ with @y/conj(x)@.+    vcdiv :: Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()++++instance BLAS1 Double where+    dotu  = ddot+    dotc  = ddot+    nrm2  = dnrm2+    asum  = dasum+    iamax = idamax+    swap  = dswap+    copy  = dcopy+    axpy  = daxpy+    scal  = dscal+    rotg  = drotg+    rot   = drot+    vconj _ _ _ = return ()+    acxpy = daxpy+    vmul n = dtbmv upper noTrans nonUnit n 0+    vcmul  = vmul+    vdiv n = dtbsv upper noTrans nonUnit n 0+    vcdiv  = vdiv++instance BLAS1 (Complex Double) where+    dotu n pX incX pY incY =+        with 0 $ \pDotu -> do+            zdotu_sub n pX incX pY incY pDotu+            peek pDotu++    dotc n pX incX pY incY =+        with 0 $ \pDotc -> do+            zdotc_sub n pX incX pY incY pDotc+            peek pDotc++    nrm2  = znrm2+    asum  = zasum+    iamax = izamax+    swap  = zswap+    copy  = zcopy+    +    axpy n alpha pX incX pY incY = +        with alpha $ \pAlpha ->+            zaxpy n pAlpha pX incX pY incY+    +    scal n alpha pX incX =+        with alpha $ \pAlpha ->+            zscal n pAlpha pX incX+            +    rotg  = zrotg++    rot = zdrot++    vconj n pX incX =+        let pXI   = (castPtr pX) `advancePtr` 1+            alpha = -1+            incXI = 2 * incX+        in dscal n alpha pXI incXI+    +    acxpy n a pX incX pY incY =+        let pXR   = castPtr pX+            pYR   = castPtr pY+            pXI   = pXR `advancePtr` 1+            pYI   = pYR `advancePtr` 1+            incX' = 2 * incX+            incY' = 2 * incY+        in case a of+            (ra :+  0) -> do+                daxpy n ( ra) pXR incX' pYR incY'+                daxpy n (-ra) pXI incX' pYI incY'+            (0  :+ ia) -> do+                daxpy n ( ia) pXR incX' pYI incY'+                daxpy n ( ia) pXI incX' pYR incY'+            _ -> go n pX pY+        where+            go n' pX' pY'+                | n' `seq` pX' `seq` pY' `seq` False = undefined+                | n' <= 0 =+                    return ()+                | otherwise = do+                    x <- peek pX'+                    y <- peek pY'+                    poke pY' (a * (conjugate x) + y)+                    +                    let n''  = n' - 1+                        pX'' = pX' `advancePtr` incX+                        pY'' = pY' `advancePtr` incY+                        +                    go n'' pX'' pY''+        +    vmul n  = ztbmv upper noTrans   nonUnit n 0+    vcmul n = ztbmv upper conjTrans nonUnit n 0++    vdiv n  = ztbsv upper noTrans   nonUnit n 0+    vcdiv n = ztbsv upper conjTrans nonUnit n 0
+ lib/Data/Elem/BLAS/Level2.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Elem.BLAS.Level2+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Elem.BLAS.Level2+    where+     +import Data.Complex +import Foreign ( Ptr, with )   ++import BLAS.Types+import BLAS.CTypes+import Data.Elem.BLAS.Level1+import Data.Elem.BLAS.Double +import Data.Elem.BLAS.Zomplex+   +-- | Types with matrix-vector operations.+class (BLAS1 a) => BLAS2 a where+    gemv :: TransEnum -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    gbmv :: TransEnum -> Int -> Int -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    trmv :: UpLoEnum -> TransEnum -> DiagEnum -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    tbmv :: UpLoEnum -> TransEnum -> DiagEnum -> Int -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    trsv :: UpLoEnum -> TransEnum -> DiagEnum -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    tbsv :: UpLoEnum -> TransEnum -> DiagEnum -> Int -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    hemv :: UpLoEnum -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    hbmv :: UpLoEnum -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    geru :: Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    gerc :: Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    her  :: UpLoEnum -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    her2 :: UpLoEnum -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> Ptr a -> Int -> IO ()++instance BLAS2 Double where+    gemv t = dgemv (cblasTrans t)+    gbmv t = dgbmv (cblasTrans t)+    trmv u t d = dtrmv (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    tbmv u t d = dtbmv (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    trsv u t d = dtrsv (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    tbsv u t d = dtbsv (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    hemv u = dsymv (cblasUpLo u)+    hbmv u = dsbmv (cblasUpLo u)+    geru = dger+    gerc = dger+    her  u = dsyr  (cblasUpLo u)+    her2 u = dsyr2 (cblasUpLo u)+    +instance BLAS2 (Complex Double) where+    gemv transA m n alpha pA ldA pX incX beta pY incY =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zgemv (cblasTrans transA) m n pAlpha pA ldA pX incX pBeta pY incY+    +    gbmv transA m n kl ku alpha pA ldA pX incX beta pY incY =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zgbmv (cblasTrans transA) m n kl ku pAlpha pA ldA pX incX pBeta pY incY++    trmv u t d = ztrmv (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    tbmv u t d = ztbmv (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    trsv u t d = ztrsv (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    tbsv u t d = ztbsv (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    +    hemv uplo n alpha pA ldA pX incX beta pY incY =+        with alpha $ \pAlpha -> with beta $ \pBeta -> +            zhemv (cblasUpLo uplo) n pAlpha pA ldA pX incX pBeta pY incY+    +    hbmv uplo n k alpha pA ldA pX incX beta pY incY =+        with alpha $ \pAlpha -> with beta $ \pBeta -> +            zhbmv (cblasUpLo uplo) n k pAlpha pA ldA pX incX pBeta pY incY++    geru m n alpha pX incX pY incY pA ldA = +        with alpha $ \pAlpha -> +            zgeru m n pAlpha pX incX pY incY pA ldA++    gerc m n alpha pX incX pY incY pA ldA = +        with alpha $ \pAlpha -> +            zgerc m n pAlpha pX incX pY incY pA ldA++    her uplo n alpha pX incX pA ldA = +        with alpha $ \pAlpha -> +            zher (cblasUpLo uplo) n pAlpha pX incX pA ldA+    +    her2 uplo n alpha pX incX pY incY pA ldA = +        with alpha $ \pAlpha ->+            zher2 (cblasUpLo uplo) n pAlpha pX incX pY incY pA ldA
+ lib/Data/Elem/BLAS/Level3.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Elem.BLAS.Level3+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Elem.BLAS.Level3+    where+     +import Data.Complex +import Foreign ( Ptr, with )   ++import BLAS.Types+import BLAS.CTypes+import Data.Elem.BLAS.Level2+import Data.Elem.BLAS.Double  +import Data.Elem.BLAS.Zomplex +        +-- | Types with matrix-matrix operations.        +class (BLAS2 a) => BLAS3 a where+    gemm  :: TransEnum -> TransEnum -> Int -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    symm  :: SideEnum -> UpLoEnum -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    hemm  :: SideEnum -> UpLoEnum -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    trmm  :: SideEnum -> UpLoEnum -> TransEnum -> DiagEnum -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    trsm  :: SideEnum -> UpLoEnum -> TransEnum -> DiagEnum -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> IO ()+    syrk  :: UpLoEnum -> TransEnum -> Int -> Int -> a -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    syr2k :: UpLoEnum -> TransEnum -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    herk  :: UpLoEnum -> TransEnum -> Int -> Int -> a -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    her2k :: UpLoEnum -> TransEnum -> Int -> Int -> a -> Ptr a -> Int -> Ptr a -> Int -> a -> Ptr a -> Int -> IO ()+    +    +instance BLAS3 Double where+    gemm ta tb = dgemm (cblasTrans ta) (cblasTrans tb)+    symm  s u = dsymm (cblasSide s) (cblasUpLo u) +    hemm  s u = dsymm (cblasSide s) (cblasUpLo u) +    trmm  s u t d = dtrmm (cblasSide s) (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    trsm  s u t d = dtrsm (cblasSide s) (cblasUpLo u) (cblasTrans t) (cblasDiag d)+    syrk  u t = dsyrk  (cblasUpLo u) (cblasTrans t)+    syr2k u t = dsyr2k (cblasUpLo u) (cblasTrans t)+    herk  u t = dsyrk  (cblasUpLo u) (cblasTrans t)+    her2k u t = dsyr2k (cblasUpLo u) (cblasTrans t)+    +    +instance BLAS3 (Complex Double) where+    gemm transA transB m n k alpha pA ldA pB ldB beta pC ldC =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zgemm (cblasTrans transA) (cblasTrans transB) m n k pAlpha pA ldA pB ldB pBeta pC ldC+    +    symm side uplo m n alpha pA ldA pB ldB beta pC ldC =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zsymm (cblasSide side) (cblasUpLo uplo) m n pAlpha pA ldA pB ldB pBeta pC ldC++    hemm side uplo m n alpha pA ldA pB ldB beta pC ldC =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zhemm (cblasSide side) (cblasUpLo uplo) m n pAlpha pA ldA pB ldB pBeta pC ldC+    +    trmm side uplo transA diag m n alpha pA ldA pB ldB =+        with alpha $ \pAlpha -> +            ztrmm (cblasSide side) (cblasUpLo uplo) (cblasTrans transA) (cblasDiag diag) m n pAlpha pA ldA pB ldB+            +    trsm side uplo transA diag m n alpha pA ldA pB ldB =+        with alpha $ \pAlpha -> +            ztrsm (cblasSide side) (cblasUpLo uplo) (cblasTrans transA) (cblasDiag diag) m n pAlpha pA ldA pB ldB+            +    syrk uplo transA n k alpha pA ldA beta pC ldC =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zsyrk (cblasUpLo uplo) (cblasTrans transA) n k pAlpha pA ldA pBeta pC ldC+            +    syr2k uplo transA n k alpha pA ldA pB ldB beta pC ldC =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zsyr2k (cblasUpLo uplo) (cblasTrans transA) n k pAlpha pA ldA pB ldB pBeta pC ldC++    herk uplo transA n k alpha pA ldA beta pC ldC =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zherk (cblasUpLo uplo) (cblasTrans transA) n k pAlpha pA ldA pBeta pC ldC+            +    her2k uplo transA n k alpha pA ldA pB ldB beta pC ldC =+        with alpha $ \pAlpha -> with beta $ \pBeta ->+            zher2k (cblasUpLo uplo) (cblasTrans transA) n k pAlpha pA ldA pB ldB pBeta pC ldC
+ lib/Data/Elem/BLAS/Zomplex.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# CFILES cbits/zomplex.c #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Elem.BLAS.Zomplex+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Elem.BLAS.Zomplex+    where+        +import Data.Complex ( Complex )+import Foreign.Ptr  ( Ptr )+import BLAS.CTypes++---------------------------- Level 1 Routines -------------------------------++foreign import ccall unsafe "BLAS.h blas_zdotu_sub"+    zdotu_sub   :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "BLAS.h blas_zdotc_sub"+    zdotc_sub   :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> IO ()+++foreign import ccall unsafe "BLAS.h blas_dznrm2"+    znrm2  :: Int -> Ptr (Complex Double) -> Int -> IO Double++foreign import ccall unsafe "BLAS.h blas_dzasum"+    zasum  :: Int -> Ptr (Complex Double) -> Int -> IO Double++foreign import ccall unsafe "BLAS.h blas_izamax"+    izamax :: Int -> Ptr (Complex Double) -> Int -> IO Int++foreign import ccall unsafe "BLAS.h blas_zscal"+    zscal  :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zswap"+    zswap  :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zcopy"+    zcopy  :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zaxpy"+    zaxpy  :: Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zrotg"+    zrotg  :: Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> Ptr (Complex Double) -> IO ()++foreign import ccall unsafe "BLAS.h blas_zdrot"+    zdrot :: Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Double -> Double -> IO ()+++---------------------------- Level 2 Routines -------------------------------++foreign import ccall unsafe "BLAS.h blas_zgemv"+    zgemv :: CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zgbmv"+    zgbmv ::  CBLASTrans -> Int -> Int -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_ztrmv"+    ztrmv ::  CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_ztbmv"+    ztbmv ::  CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()+                 +foreign import ccall unsafe "BLAS.h blas_ztrsv"+    ztrsv ::  CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_ztbsv"+    ztbsv ::  CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()+    +foreign import ccall unsafe "BLAS.h blas_zhemv"+    zhemv ::  CBLASUpLo -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zhbmv"+    zhbmv ::  CBLASUpLo -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()+    +foreign import ccall unsafe "BLAS.h blas_zgeru"+    zgeru  ::  Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zgerc"+    zgerc  ::  Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()+        +foreign import ccall unsafe "BLAS.h blas_zher"+    zher  ::  CBLASUpLo -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zher2"+    zher2 ::  CBLASUpLo -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()+++---------------------------- Level 3 Routines -------------------------------++foreign import ccall unsafe "BLAS.h blas_zgemm"+    zgemm  ::  CBLASTrans -> CBLASTrans -> Int -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zsymm"+    zsymm  ::  CBLASSide -> CBLASUpLo -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zhemm"+    zhemm  ::  CBLASSide -> CBLASUpLo -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_ztrmm"+    ztrmm  ::  CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_ztrsm"+    ztrsm  ::  CBLASSide -> CBLASUpLo -> CBLASTrans -> CBLASDiag -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zsyrk"+    zsyrk  ::  CBLASUpLo -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()+           +foreign import ccall unsafe "BLAS.h blas_zsyr2k"           +    zsyr2k ::  CBLASUpLo -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()++foreign import ccall unsafe "BLAS.h blas_zherk"+    zherk  ::  CBLASUpLo -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()+           +foreign import ccall unsafe "BLAS.h blas_zher2k"           +    zher2k ::  CBLASUpLo -> CBLASTrans -> Int -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Int -> Ptr (Complex Double) -> Ptr (Complex Double) -> Int -> IO ()+
+ lib/Data/Matrix/Banded.hs view
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Banded+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Immutable banded matrices.+--++module Data.Matrix.Banded (+    -- * Banded matrix type+    Banded,++    -- * Overloaded interface for banded matrices+    BaseBanded( numLower, numUpper, bandwidths+              , maybeMatrixStorageFromBanded, maybeBandedFromMatrixStorage, coerceBanded ),++    -- * Overloaded interface for matrices+    module Data.Matrix.Class,+    module Data.Matrix.Class.IMatrix,    +    +    -- * Creating banded matrices+    banded,+    listsBanded,++    -- * Special banded matrices+    zeroBanded,+    constantBanded,++    -- * Conversions between vectors and banded matrices+    bandedFromVector,+    diagBandedFromVector,+    maybeVectorFromBanded,++    -- * Vector views+    diagBanded,++    -- * Overloaded interface for reading banded matrix elements+    module Data.Tensor.Class,+    module Data.Tensor.Class.ITensor,+    ) where++import Data.Matrix.Banded.Base++import Data.Matrix.Class+import Data.Matrix.Class.IMatrix++import Data.Tensor.Class+import Data.Tensor.Class.ITensor
+ lib/Data/Matrix/Banded/Base.hs view
@@ -0,0 +1,809 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances,+        TypeFamilies, Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Banded.Base+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Matrix.Banded.Base+    where++import Control.Monad+import Control.Monad.ST+import Data.AEq+import Data.Ix+import System.IO.Unsafe+import Unsafe.Coerce++import BLAS.Internal( clearArray, checkedRow, checkedCol, checkedDiag,+    diagLen, inlinePerformIO )++import Data.Elem.BLAS( Elem, BLAS1, BLAS2, BLAS3 )++import Data.Tensor.Class+import Data.Tensor.Class.ITensor+import Data.Tensor.Class.MTensor++import Data.Matrix.Class+import Data.Matrix.Class.IMatrixBase+import Data.Matrix.Class.MMatrixBase+import Data.Matrix.Class.ISolveBase+import Data.Matrix.Class.MSolveBase++import Data.Matrix.Herm+import Data.Matrix.Tri++import Data.Vector.Dense.ST( runSTVector )+import Data.Vector.Dense.Base( BaseVector, ReadVector, WriteVector, Vector(..), +    dim, unsafeVectorToIOVector, unsafePerformIOWithVector,+    unsafeConvertIOVector, newZeroVector, newCopyVector )+import Data.Matrix.Dense.ST( runSTMatrix )+import Data.Matrix.Dense.Base( BaseMatrix, ReadMatrix, WriteMatrix, Matrix(..),+    unsafeMatrixToIOMatrix, unsafePerformIOWithMatrix )++import Data.Matrix.Banded.IOBase( IOBanded )+import qualified Data.Matrix.Banded.IOBase as IO+++-- | Immutable banded matrices.  The type arguments are as follows:+--+--     * @np@: a phantom type for the shape of the matrix.  Most functions+--       will demand that this be specified as a pair.  When writing a function+--       signature, you should always prefer @Banded (n,p) e@ to+--       @Banded np e@.+--+--     * @e@: the element type of the matrix.  Only certain element types+--       are supported.+--+newtype Banded np e = Banded (IOBanded np e)++freezeIOBanded :: (BLAS1 e) => IOBanded np e -> IO (Banded np e)+freezeIOBanded x = do+    y <- IO.newCopyIOBanded x+    return (Banded y)++thawIOBanded :: (BLAS1 e) => Banded np e -> IO (IOBanded np e)+thawIOBanded (Banded x) =+    IO.newCopyIOBanded x++unsafeFreezeIOBanded :: IOBanded np e -> IO (Banded np e)+unsafeFreezeIOBanded = return . Banded++unsafeThawIOBanded :: Banded np e -> IO (IOBanded np e)+unsafeThawIOBanded (Banded x) = return x++-- | Common functionality for all banded matrix types.+class ( MatrixShaped a, HasVectorView a, HasMatrixStorage a, Elem e+      , BaseVector (VectorView a) e, BaseMatrix (MatrixStorage a) e+      ) => BaseBanded a e where+    +    -- | Get the number of lower diagonals in the banded matrix.+    numLower :: a (n,p) e -> Int+    +    -- | Get the number of upper diagonals in the banded matrix+    numUpper :: a (n,p) e -> Int+        +    -- | Get the range of valid diagonals in the banded matrix.+    -- @bandwidthds a@ is equal to @(numLower a, numUpper a)@.+    bandwidths :: a (n,p) e -> (Int,Int)+          +    -- | Get the leading dimension of the underlying storage of the+    -- banded matrix.+    ldaBanded :: a (n,p) e -> Int+    +    -- | Indicate whether or not the banded matrix is transposed and+    -- conjugated.+    isHermBanded :: a (n,p) e -> Bool++    -- | Cast the shape type of the banded matrix.+    coerceBanded :: a np e -> a np' e+    coerceBanded = unsafeCoerce+    {-# INLINE coerceBanded #-}++    -- | Get a matrix with the underlying storage of the banded matrix.+    -- This will fail if the banded matrix is hermed.+    maybeMatrixStorageFromBanded :: a (n,p) e -> Maybe (MatrixStorage a (k,p) e)++    -- | Given a shape and bandwidths, possibly view the elements stored+    -- in a dense matrix as a banded matrix.  This will if the matrix+    -- storage is hermed.  An error will be called if the number of rows+    -- in the matrix does not equal the desired number of diagonals or+    -- if the number of columns in the matrix does not equal the desired+    -- number of columns.+    maybeBandedFromMatrixStorage :: (Int,Int)+                                 -> (Int,Int)+                                 -> MatrixStorage a (k,p) e+                                 -> Maybe (a (n,p) e)++    -- | View a vector as a banded matrix of the given shape.  The vector+    -- must have length equal to one of the specified dimensions.+    viewVectorAsBanded :: (Int,Int) -> VectorView a k e -> a (n,p) e+    +    -- | View a vector as a diagonal banded matrix.+    viewVectorAsDiagBanded :: VectorView a n e -> a (n,n) e+    viewVectorAsDiagBanded x = let+        n = dim x+        in viewVectorAsBanded (n,n) x+    {-# INLINE viewVectorAsBanded #-}+    +    -- | If the banded matrix has only a single diagonal, return a view+    -- into that diagonal.  Otherwise, return @Nothing@.+    maybeViewBandedAsVector :: a (n,p) e -> Maybe (VectorView a k e)++    unsafeDiagViewBanded :: a (n,p) e -> Int -> VectorView a k e+    unsafeRowViewBanded :: a (n,p) e -> Int -> (Int, VectorView a k e, Int)+    unsafeColViewBanded :: a (n,p) e -> Int -> (Int, VectorView a k e, Int)+    +    -- | Unsafe cast from a matrix to an 'IOBanded'.+    unsafeBandedToIOBanded :: a (n,p) e -> IOBanded (n,p) e+    unsafeIOBandedToBanded :: IOBanded (n,p) e -> a (n,p) e+++-- | Banded matrices that can be read in a monad.+class ( BaseBanded a e, BLAS2 e, ReadTensor a (Int,Int) e m+      , MMatrix a e m, MMatrix (Herm a) e m, MMatrix (Tri a) e m+      , MSolve (Tri a) e m+      , ReadVector (VectorView a) e m, ReadMatrix (MatrixStorage a) e m+      ) => ReadBanded a e m where++    -- | Cast the banded matrix to an 'IOBanded', perform an @IO@ action, and+    -- convert the @IO@ action to an action in the monad @m@.  This+    -- operation is /very/ unsafe.+    unsafePerformIOWithBanded :: a (n,p) e -> (IOBanded (n,p) e -> IO r) -> m r++    -- | Convert a mutable banded matrix to an immutable one by taking a +    -- complete copy of it.+    freezeBanded :: a (n,p) e -> m (Banded (n,p) e)+    unsafeFreezeBanded :: a (n,p) e -> m (Banded (n,p) e)++-- | Banded matrices that can be created or modified in a monad.+class ( ReadBanded a e m, WriteTensor a (Int,Int) e m+      , WriteVector (VectorView a) e m+      , WriteMatrix (MatrixStorage a) e m+      ) => WriteBanded a e m where++    -- | Creates a new banded matrix of the given shape and bandwidths.  +    -- The elements will be uninitialized.+    newBanded_ :: (Int,Int) -> (Int,Int) -> m (a (n,p) e)++    -- | Unsafely convert an 'IO' action that creates an 'IOBanded' into+    -- an action in @m@ that creates a matrix.+    unsafeConvertIOBanded :: IO (IOBanded (n,p) e) -> m (a (n,p) e)++    -- | Convert an immutable banded matrix to a mutable one by taking a +    -- complete copy of it.+    thawBanded :: Banded (n,p) e -> m (a (n,p) e)+    unsafeThawBanded :: Banded (n,p) e -> m (a (n,p) e)++-- | Create a banded matrix with the given shape, bandwidths, and +-- associations.  The indices in the associations list must all fall+-- in the bandwidth of the matrix.  Unspecified elements will be set+-- to zero.+newBanded :: (WriteBanded a e m) => +    (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> m (a (n,p) e)+newBanded = newBandedHelp writeElem+{-# INLINE newBanded #-}++unsafeNewBanded :: (WriteBanded a e m) => +    (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> m (a (n,p) e)+unsafeNewBanded = newBandedHelp unsafeWriteElem+{-# INLINE unsafeNewBanded #-}++newBandedHelp :: (WriteBanded a e m) => +       (IOBanded (n,p) e -> (Int,Int) -> e -> IO ())+    -> (Int,Int) -> (Int,Int) -> [((Int,Int),e)] -> m (a (n,p) e)+newBandedHelp set (m,n) (kl,ku) ijes = +    unsafeConvertIOBanded $ do+        x <- newBanded_ (m,n) (kl,ku)+        IO.withIOBanded x $ flip clearArray ((kl+1+ku)*n)+        mapM_ (uncurry $ set x) ijes+        return x+{-# INLINE newBandedHelp #-}++-- | Create a banded matrix of the given shape and bandwidths by specifying+-- its diagonal elements.  The lists must all have the same length, equal+-- to the number of elements in the main diagonal of the matrix.  The +-- sub-diagonals are specified first, then the super-diagonals.  In +-- subdiagonal @i@, the first @i@ elements of the list are ignored.+newListsBanded :: (WriteBanded a e m) => +    (Int,Int) -> (Int,Int) -> [[e]] -> m (a (n,p) e)+newListsBanded (m,n) (kl,ku) xs = do+    a <- newBanded_ (m,n) (kl,ku)+    zipWithM_ (writeDiagElems a) [(negate kl)..ku] xs+    return a+  where+    writeDiagElems :: (WriteBanded a e m) => a (n,p) e -> Int -> [e] -> m ()+    writeDiagElems a i es =+        let d   = unsafeDiagViewBanded a i+            nb  = max 0 (negate i)+            es' = drop nb es+        in zipWithM_ (unsafeWriteElem d) [0..(dim d - 1)] es'+{-# INLINE newListsBanded #-}++-- | Create a zero banded matrix with the specified shape and bandwidths.+newZeroBanded :: (WriteBanded a e m) => (Int,Int) -> (Int,Int) -> m (a (n,p) e)+newZeroBanded mn bw = unsafeConvertIOBanded $+    IO.newZeroIOBanded mn bw+{-# INLINE newZeroBanded #-}+ +-- | Create a constant banded matrix of the specified shape and bandwidths.+newConstantBanded :: (WriteBanded a e m) +                  => (Int,Int) -> (Int,Int) -> e -> m (a (n,p) e)+newConstantBanded mn bw e = unsafeConvertIOBanded $+    IO.newConstantIOBanded mn bw e+{-# INLINE newConstantBanded #-}+ +-- | Set every element of a banded matrix to zero.+setZeroBanded :: (WriteBanded a e m) => a (n,p) e -> m ()+setZeroBanded a =+    unsafePerformIOWithBanded a $ IO.setZeroIOBanded+{-# INLINE setZeroBanded #-}+ +-- | Set every element of a banded matrix to a constant.+setConstantBanded :: (WriteBanded a e m) => e -> a (n,p) e -> m ()+setConstantBanded e a =+    unsafePerformIOWithBanded a $ IO.setConstantIOBanded e+{-# INLINE setConstantBanded #-}++-- | Create a new banded matrix by taking a copy of another one.+newCopyBanded :: (ReadBanded a e m, WriteBanded b e m)+              => a (n,p) e -> m (b (n,p) e)+newCopyBanded a = unsafeConvertIOBanded $+    IO.newCopyIOBanded (unsafeBandedToIOBanded a)+{-# INLINE newCopyBanded #-}++-- | Copy the elements of one banded matrix into another.  The two matrices+-- must have the same shape and badwidths.+copyBanded :: (WriteBanded b e m, ReadBanded a e m) =>+    b (n,p) e -> a (n,p) e -> m ()+copyBanded dst src+    | shape dst /= shape src =+        error "Shape mismatch in copyBanded."+    | bandwidths dst /= bandwidths src =+        error "Bandwidth mismatch in copyBanded."+    | otherwise =+        unsafeCopyBanded dst src+{-# INLINE copyBanded #-}++unsafeCopyBanded :: (WriteBanded b e m, ReadBanded a e m)+                 => b (n,p) e -> a (n,p) e -> m ()+unsafeCopyBanded dst src =+    unsafePerformIOWithBanded dst $ \dst' ->+        IO.unsafeCopyIOBanded dst' (unsafeBandedToIOBanded src)+{-# INLINE unsafeCopyBanded #-}++-- | Get a view of a diagonal of the banded matrix.  This will fail if+-- the index is outside of the bandwidth.+diagViewBanded :: (BaseBanded a e)+               => a (n,p) e -> Int -> VectorView a k e+diagViewBanded a i+    | i < -(numLower a) || i > numUpper a =+        error $ "Tried to get a diagonal view outside of the bandwidth."+    | otherwise =+        unsafeDiagViewBanded a i+{-# INLINE diagViewBanded #-}++-- | Get a view into the partial row of the banded matrix, along with the+-- number of zeros to pad before and after the view.+rowViewBanded :: (BaseBanded a e) => +    a (n,p) e -> Int -> (Int, VectorView a k e, Int)+rowViewBanded a = checkedRow (shape a) (unsafeRowViewBanded a) +{-# INLINE rowViewBanded #-}++-- | Get a view into the partial column of the banded matrix, along with the+-- number of zeros to pad before and after the view.+colViewBanded :: (BaseBanded a e) => +    a (n,p) e -> Int -> (Int, VectorView a k e, Int)+colViewBanded a = checkedCol (shape a) (unsafeColViewBanded a)+{-# INLINE colViewBanded #-}++-- | Get a copy of the given diagonal of a banded matrix.+getDiagBanded :: (ReadBanded a e m, WriteVector y e m) =>+    a (n,p) e -> Int -> m (y k e)+getDiagBanded a i | i >= -kl && i <= ku =+                       newCopyVector $ diagViewBanded a i+                  | otherwise =+                       newZeroVector $ diagLen (m,n) i+  where+    (m,n)   = shape a+    (kl,ku) = bandwidths a+{-# INLINE getDiagBanded #-}+ +unsafeGetDiagBanded :: (ReadBanded a e m, WriteVector y e m) =>+    a (n,p) e -> Int -> m (y k e)+unsafeGetDiagBanded a i = +    newCopyVector $ unsafeDiagViewBanded a i+{-# INLINE unsafeGetDiagBanded #-}+ +unsafeGetRowBanded :: (ReadBanded a e m, WriteVector y e m) =>+    a (n,p) e -> Int -> m (y p e)+unsafeGetRowBanded a i = unsafeConvertIOVector $+    IO.unsafeGetRowIOBanded (unsafeBandedToIOBanded a) i+{-# INLINE unsafeGetRowBanded #-}+ +unsafeGetColBanded :: (ReadBanded a e m, WriteVector y e m) =>+    a (n,p) e -> Int -> m (y n e)+unsafeGetColBanded a i = unsafeConvertIOVector $+    IO.unsafeGetColIOBanded (unsafeBandedToIOBanded a) i+{-# INLINE unsafeGetColBanded #-}++gbmv :: (ReadBanded a e m, ReadVector x e m, WriteVector y e m) =>+    e -> a (k,l) e -> x l e -> e -> y k e -> m ()+gbmv alpha a x beta y =+    unsafePerformIOWithVector y $+        IO.gbmv alpha (unsafeBandedToIOBanded a) (unsafeVectorToIOVector x) beta+{-# INLINE gbmv #-}++gbmm :: (ReadBanded a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    e -> a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()+gbmm alpha a b beta c =+    unsafePerformIOWithMatrix c $+        IO.gbmm alpha (unsafeBandedToIOBanded a) (unsafeMatrixToIOMatrix b) beta+{-# INLINE gbmm #-}++hbmv :: (ReadBanded a e m, ReadVector x e m, WriteVector y e m) =>+    e -> Herm a (k,l) e -> x l e -> e -> y k e -> m ()+hbmv alpha a x beta y =+    unsafePerformIOWithVector y $+        IO.hbmv alpha (mapHerm unsafeBandedToIOBanded a) (unsafeVectorToIOVector x) beta+{-# INLINE hbmv #-}++hbmm :: (ReadBanded a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    e -> Herm a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()+hbmm alpha a b beta c =+    unsafePerformIOWithMatrix c $+        IO.hbmm alpha (mapHerm unsafeBandedToIOBanded a) (unsafeMatrixToIOMatrix b) beta+{-# INLINE hbmm #-}++tbmv :: (ReadBanded a e m, WriteVector y e m) =>+    e -> Tri a (k,k) e -> y k e -> m ()+tbmv alpha a x =+    unsafePerformIOWithVector x $+        IO.tbmv alpha (mapTri unsafeBandedToIOBanded a)+{-# INLINE tbmv #-}++tbmm :: (ReadBanded a e m, WriteMatrix b e m) =>+    e -> Tri a (k,k) e -> b (k,l) e -> m ()+tbmm alpha a b =+    unsafePerformIOWithMatrix b $+        IO.tbmm alpha (mapTri unsafeBandedToIOBanded a)+{-# INLINE tbmm #-}++tbmv' :: (ReadBanded a e m, ReadVector x e m, WriteVector y e m) =>+    e -> Tri a (k,l) e -> x l e -> e -> y k e -> m ()+tbmv' alpha a x beta y =+    unsafePerformIOWithVector y $+        IO.tbmv' alpha (mapTri unsafeBandedToIOBanded a) (unsafeVectorToIOVector x) beta+{-# INLINE tbmv' #-}++tbmm' :: (ReadBanded a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    e -> Tri a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()+tbmm' alpha a b beta c =+    unsafePerformIOWithMatrix c $+        IO.tbmm' alpha (mapTri unsafeBandedToIOBanded a) (unsafeMatrixToIOMatrix b) beta+{-# INLINE tbmm' #-}++tbsv :: (ReadBanded a e m, WriteVector y e m) =>+    e -> Tri a (k,k) e -> y k e -> m ()+tbsv alpha a x =+    unsafePerformIOWithVector x $+        IO.tbmv alpha (mapTri unsafeBandedToIOBanded a)+{-# INLINE tbsv #-}++tbsm :: (ReadBanded a e m, WriteMatrix b e m) =>+    e -> Tri a (k,k) e -> b (k,l) e -> m ()+tbsm alpha a b =+    unsafePerformIOWithMatrix b $+        IO.tbsm alpha (mapTri unsafeBandedToIOBanded a)+{-# INLINE tbsm #-}++tbsv' :: (ReadBanded a e m, ReadVector y e m, WriteVector x e m)+      => e -> Tri a (k,l) e -> y k e -> x l e -> m ()+tbsv' alpha a y x = +    unsafePerformIOWithVector x $+        IO.tbsv' alpha (mapTri unsafeBandedToIOBanded a) (unsafeVectorToIOVector y)+{-# INLINE tbsv' #-}++tbsm' :: (ReadBanded a e m, ReadMatrix c e m, WriteMatrix b e m) +      => e -> Tri a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()+tbsm' alpha a c b =+    unsafePerformIOWithMatrix b $+        IO.tbsm' alpha (mapTri unsafeBandedToIOBanded a) (unsafeMatrixToIOMatrix c)+{-# INLINE tbsm' #-}++instance (Elem e) => BaseBanded IOBanded e where+    numLower = IO.numLowerIOBanded+    {-# INLINE numLower #-}+    numUpper = IO.numUpperIOBanded+    {-# INLINE numUpper #-}+    bandwidths = IO.bandwidthsIOBanded+    {-# INLINE bandwidths #-}+    ldaBanded = IO.ldaIOBanded+    {-# INLINE ldaBanded #-}+    isHermBanded = IO.isHermIOBanded+    {-# INLINE isHermBanded #-}+    maybeMatrixStorageFromBanded = IO.maybeMatrixStorageFromIOBanded+    {-# INLINE maybeMatrixStorageFromBanded #-}+    maybeBandedFromMatrixStorage = IO.maybeIOBandedFromMatrixStorage+    {-# INLINE maybeBandedFromMatrixStorage #-}+    viewVectorAsBanded = IO.viewVectorAsIOBanded+    {-# INLINE viewVectorAsBanded #-}+    maybeViewBandedAsVector = IO.maybeViewIOBandedAsVector+    {-# INLINE maybeViewBandedAsVector #-}+    unsafeDiagViewBanded = IO.unsafeDiagViewIOBanded+    {-# INLINE unsafeDiagViewBanded #-}+    unsafeRowViewBanded = IO.unsafeRowViewIOBanded+    {-# INLINE unsafeRowViewBanded #-}+    unsafeColViewBanded = IO.unsafeColViewIOBanded+    {-# INLINE unsafeColViewBanded #-}+    unsafeIOBandedToBanded = id+    {-# INLINE unsafeIOBandedToBanded #-}+    unsafeBandedToIOBanded = id+    {-# INLINE unsafeBandedToIOBanded #-}++instance (BLAS3 e) => ReadBanded IOBanded e IO where+    unsafePerformIOWithBanded a f = f a+    {-# INLINE unsafePerformIOWithBanded #-}+    freezeBanded = freezeIOBanded+    {-# INLINE freezeBanded #-}+    unsafeFreezeBanded = unsafeFreezeIOBanded+    {-# INLINE unsafeFreezeBanded #-}+    +instance (BLAS3 e) => WriteBanded IOBanded e IO where+    newBanded_ = IO.newIOBanded_+    {-# INLINE newBanded_ #-}+    unsafeConvertIOBanded = id+    {-# INLINE unsafeConvertIOBanded #-}+    thawBanded = thawIOBanded+    {-# INLINE thawBanded #-}+    unsafeThawBanded = unsafeThawIOBanded+    {-# INLINE unsafeThawBanded #-}++-- | Create a banded matrix with the given shape, bandwidths, and +-- associations.  The indices in the associations list must all fall+-- in the bandwidth of the matrix.  Unspecified elements will be set+-- to zero.+banded :: (BLAS3 e) => (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> Banded (n,p) e+banded mn kl ies = unsafePerformIO $+    unsafeFreezeIOBanded =<< newBanded mn kl ies+{-# NOINLINE banded #-}++unsafeBanded :: (BLAS3 e) => (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> Banded (n,p) e+unsafeBanded mn kl ies = unsafePerformIO $+    unsafeFreezeIOBanded =<< unsafeNewBanded mn kl ies+{-# NOINLINE unsafeBanded #-}++-- | Create a banded matrix of the given shape and bandwidths by specifying+-- its diagonal elements.  The lists must all have the same length, equal+-- to the number of elements in the main diagonal of the matrix.  The +-- sub-diagonals are specified first, then the super-diagonals.  In +-- subdiagonal @i@, the first @i@ elements of the list are ignored.+listsBanded :: (BLAS3 e) => (Int,Int) -> (Int,Int) -> [[e]] -> Banded (n,p) e+listsBanded mn kl xs = unsafePerformIO $+    unsafeFreezeIOBanded =<< newListsBanded mn kl xs+{-# NOINLINE listsBanded #-}++-- | Create a zero banded matrix with the specified shape and bandwidths.+zeroBanded :: (BLAS3 e) => (Int,Int) -> (Int,Int) -> Banded (n,p) e+zeroBanded mn kl = unsafePerformIO $+    unsafeFreezeIOBanded =<< newZeroBanded mn kl+{-# NOINLINE zeroBanded #-}++-- | Create a constant banded matrix of the specified shape and bandwidths.+constantBanded :: (BLAS3 e) => (Int,Int) -> (Int,Int) -> e -> Banded (n,p) e+constantBanded mn kl e = unsafePerformIO $+    unsafeFreezeIOBanded =<< newConstantBanded mn kl e+{-# INLINE constantBanded #-}++-- | Create a banded matrix from a vector.  The vector must have length+-- equal to one of the specified dimension sizes.+bandedFromVector :: (Elem e) => (Int,Int) -> Vector k e -> Banded (n,p) e+bandedFromVector = viewVectorAsBanded+{-# INLINE bandedFromVector #-}++-- | Create a diagonal banded matrix from a vector.+diagBandedFromVector :: (Elem e) => Vector n e -> Banded (n,n) e+diagBandedFromVector = viewVectorAsDiagBanded+{-# INLINE diagBandedFromVector #-}++-- | Convert a diagonal banded matrix to a vector.  Fail if the banded+-- matrix has more than one diagonal+maybeVectorFromBanded :: (Elem e) => Banded (n,p) e -> Maybe (Vector k e)+maybeVectorFromBanded = maybeViewBandedAsVector+{-# INLINE maybeVectorFromBanded #-}++-- | Get a the given diagonal in a banded matrix.  Negative indices correspond +-- to sub-diagonals.+diagBanded :: (BLAS1 e) => Banded (n,p) e -> Int -> Vector k e+diagBanded a = checkedDiag (shape a) (unsafeDiagBanded a)+{-# INLINE diagBanded #-}++unsafeDiagBanded :: (BLAS1 e) => Banded (n,p) e -> Int -> Vector k e+unsafeDiagBanded a i | i >= -kl && i <= ku = unsafeDiagViewBanded a i+               | otherwise = runSTVector $ +    newZeroVector $ diagLen (shape a) i+  where+    (kl,ku) = bandwidths a+{-# INLINE unsafeDiagBanded #-}++listsFromBanded :: (BLAS1 e) => Banded np e -> ((Int,Int), (Int,Int),[[e]])+listsFromBanded a = ( (m,n)+            , (kl,ku)+            , map paddedDiag [(-kl)..ku]+            )+  where+    (m,n)   = shape a+    (kl,ku) = bandwidths (coerceBanded a)+    +    padBegin i   = replicate (max (-i) 0)    0+    padEnd   i   = replicate (max (m-n+i) 0) 0+    paddedDiag i = (  padBegin i+                   ++ elems (unsafeDiagViewBanded (coerceBanded a) i) +                   ++ padEnd i +                   )++instance (BLAS3 e) => Show (Banded (n,p) e) where+    show a +        | isHermBanded a = +           "herm (" ++ show (herm a) ++ ")"+        | otherwise = +             let (mn,kl,es) = listsFromBanded a +             in "listsBanded " ++ show mn ++ " " ++ show kl ++ " " ++ show es++compareBandedHelp :: (BLAS3 e) => +    (e -> e -> Bool) -> Banded (n,p) e -> Banded (n,p) e -> Bool+compareBandedHelp cmp a b+    | shape a /= shape b =+        False+    | isHermBanded a == isHermBanded b && bandwidths a == bandwidths b =+        let elems' = if isHermBanded a then elems . herm+                                       else elems+        in+            and $ zipWith cmp (elems' a) (elems' b)+    | otherwise =+        let l = max (numLower a) (numLower b)+            u = max (numUpper a) (numUpper b)+        in+            and $ zipWith cmp (diagElems (-l,u) a) (diagElems (-l,u) b)+  where+    diagElems bw c = concatMap elems [ diagBanded c i | i <- range bw ]++instance (BLAS3 e, Eq e) => Eq (Banded (n,p) e) where+    (==) = compareBandedHelp (==)++instance (BLAS3 e, AEq e) => AEq (Banded (n,p) e) where+    (===) = compareBandedHelp (===)+    (~==) = compareBandedHelp (~==)+++replaceBandedHelp :: (BLAS3 e) => +       (forall n. IOBanded n e -> (Int,Int) -> e -> IO ())+    -> Banded mn e -> [((Int,Int), e)] -> Banded mn e+replaceBandedHelp set x ies = unsafePerformIO $ do+    y  <- newCopyBanded =<< unsafeThawIOBanded (coerceBanded x)+    mapM_ (uncurry $ set y) ies+    unsafeFreezeIOBanded (coerceBanded y)+{-# NOINLINE replaceBandedHelp #-}++instance (BLAS3 e) => ITensor Banded (Int,Int) e where+    (//)          = replaceBandedHelp writeElem+    {-# INLINE (//) #-}+    unsafeReplace = replaceBandedHelp unsafeWriteElem+    {-# INLINE unsafeReplace #-}+    unsafeAt (Banded a) i  = inlinePerformIO (unsafeReadElem a i)+    {-# INLINE unsafeAt #-}+    size (Banded a) = IO.sizeIOBanded a+    {-# INLINE size #-}+    elems (Banded a) = inlinePerformIO $ getElems a+    {-# INLINE elems #-}+    indices (Banded a) = IO.indicesIOBanded a+    {-# INLINE indices #-}+    assocs (Banded a) = inlinePerformIO $ getAssocs a+    {-# INLINE assocs #-}+    tmap f a      = coerceBanded $ listsBanded mn bw (map (map f) es)+      where (mn,bw,es) = listsFromBanded a++instance (BLAS3 e, Monad m) => ReadTensor Banded (Int,Int) e m where+    getSize = return . size+    {-# INLINE getSize #-}+    getAssocs = return . assocs+    {-# INLINE getAssocs #-}+    getIndices = return . indices+    {-# INLINE getIndices #-}+    getElems = return . elems+    {-# INLINE getElems #-}+    getAssocs' = return . assocs+    {-# INLINE getAssocs' #-}+    getIndices' = return . indices+    {-# INLINE getIndices' #-}+    getElems' = return . elems+    {-# INLINE getElems' #-}+    unsafeReadElem x i = return (unsafeAt x i)+    {-# INLINE unsafeReadElem #-}+++instance HasVectorView Banded where+    type VectorView Banded = Vector++instance HasMatrixStorage Banded where+    type MatrixStorage Banded = Matrix++instance Shaped Banded (Int,Int) where+    shape (Banded a) = IO.shapeIOBanded a+    {-# INLINE shape #-}+    bounds (Banded a) = IO.boundsIOBanded a+    {-# INLINE bounds #-}++instance MatrixShaped Banded where+    herm (Banded a) = Banded $ IO.hermIOBanded a+    {-# INLINE herm #-}+    +instance (Elem e) => BaseBanded Banded e where+    numLower (Banded a) = IO.numLowerIOBanded a+    {-# INLINE numLower #-}+    numUpper (Banded a) = IO.numUpperIOBanded a+    {-# INLINE numUpper #-}+    bandwidths (Banded a) = IO.bandwidthsIOBanded a+    {-# INLINE bandwidths #-}+    ldaBanded (Banded a) = IO.ldaIOBanded a+    {-# INLINE ldaBanded #-}+    isHermBanded (Banded a) = IO.isHermIOBanded a+    {-# INLINE isHermBanded #-}+    maybeMatrixStorageFromBanded (Banded a) = liftM Matrix $ IO.maybeMatrixStorageFromIOBanded a+    {-# INLINE maybeMatrixStorageFromBanded #-}+    maybeBandedFromMatrixStorage mn kl (Matrix a) = +        liftM Banded $ IO.maybeIOBandedFromMatrixStorage mn kl a+    {-# INLINE maybeBandedFromMatrixStorage #-}+    viewVectorAsBanded mn (Vector x) = Banded $ IO.viewVectorAsIOBanded mn x+    {-# INLINE viewVectorAsBanded #-}+    maybeViewBandedAsVector (Banded a) = +        liftM Vector $ IO.maybeViewIOBandedAsVector a+    {-# INLINE maybeViewBandedAsVector #-}    +    unsafeDiagViewBanded (Banded a) i = Vector $ IO.unsafeDiagViewIOBanded a i+    {-# INLINE unsafeDiagViewBanded #-}+    unsafeRowViewBanded (Banded a) i = +        case IO.unsafeRowViewIOBanded a i of (nb,x,na) -> (nb, Vector x, na)+    {-# INLINE unsafeRowViewBanded #-}+    unsafeColViewBanded (Banded a) j = +        case IO.unsafeColViewIOBanded a j of (nb,x,na) -> (nb, Vector x, na)+    {-# INLINE unsafeColViewBanded #-}+    unsafeIOBandedToBanded = Banded+    {-# INLINE unsafeIOBandedToBanded #-}+    unsafeBandedToIOBanded (Banded a) = a+    {-# INLINE unsafeBandedToIOBanded #-}++instance (BLAS3 e) => ReadBanded Banded e IO where+    unsafePerformIOWithBanded (Banded a) f = f a+    {-# INLINE unsafePerformIOWithBanded #-}+    freezeBanded (Banded a) = freezeIOBanded a+    {-# INLINE freezeBanded #-}+    unsafeFreezeBanded (Banded a) = unsafeFreezeIOBanded a+    {-# INLINE unsafeFreezeBanded #-}++instance (BLAS3 e) => MMatrix Banded e IO where+    unsafeDoSApplyAdd    = gbmv+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = gbmm+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeGetRow         = unsafeGetRowBanded+    {-# INLINE unsafeGetRow #-}+    unsafeGetCol         = unsafeGetColBanded+    {-# INLINE unsafeGetCol #-}+    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Herm Banded) e IO where+    unsafeDoSApplyAdd    = hbmv+    {-# INLINE unsafeDoSApplyAdd #-}    +    unsafeDoSApplyAddMat = hbmm+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Tri Banded) e IO where+    unsafeDoSApply_      = tbmv+    {-# INLINE unsafeDoSApply_ #-}        +    unsafeDoSApplyMat_   = tbmm+    {-# INLINE unsafeDoSApplyMat_ #-}    +    unsafeDoSApplyAdd    = tbmv'+    {-# INLINE unsafeDoSApplyAdd #-}    +    unsafeDoSApplyAddMat = tbmm'+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MSolve (Tri Banded) e IO where+    unsafeDoSSolve_    = tbsv+    {-# INLINE unsafeDoSSolve_ #-}    +    unsafeDoSSolveMat_ = tbsm+    {-# INLINE unsafeDoSSolveMat_ #-}    +    unsafeDoSSolve     = tbsv'+    {-# INLINE unsafeDoSSolve #-}+    unsafeDoSSolveMat  = tbsm'+    {-# INLINE unsafeDoSSolveMat #-}    ++instance (BLAS3 e) => ReadBanded Banded e (ST s) where+    unsafePerformIOWithBanded (Banded a) f = unsafeIOToST $ f a+    {-# INLINE unsafePerformIOWithBanded #-}+    freezeBanded (Banded a) = unsafeIOToST $ freezeIOBanded a+    {-# INLINE freezeBanded #-}+    unsafeFreezeBanded (Banded a) = unsafeIOToST $ unsafeFreezeIOBanded a+    {-# INLINE unsafeFreezeBanded #-}++instance (BLAS3 e) => MMatrix Banded e (ST s) where+    unsafeDoSApplyAdd    = gbmv+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = gbmm+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeGetRow         = unsafeGetRowBanded+    {-# INLINE unsafeGetRow #-}+    unsafeGetCol         = unsafeGetColBanded+    {-# INLINE unsafeGetCol #-}+    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Herm Banded) e (ST s) where+    unsafeDoSApplyAdd    = hbmv+    {-# INLINE unsafeDoSApplyAdd #-}    +    unsafeDoSApplyAddMat = hbmm+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Tri Banded) e (ST s) where+    unsafeDoSApply_      = tbmv+    {-# INLINE unsafeDoSApply_ #-}        +    unsafeDoSApplyMat_   = tbmm+    {-# INLINE unsafeDoSApplyMat_ #-}    +    unsafeDoSApplyAdd    = tbmv'+    {-# INLINE unsafeDoSApplyAdd #-}    +    unsafeDoSApplyAddMat = tbmm'+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MSolve (Tri Banded) e (ST s) where+    unsafeDoSSolve_    = tbsv+    {-# INLINE unsafeDoSSolve_ #-}    +    unsafeDoSSolveMat_ = tbsm+    {-# INLINE unsafeDoSSolveMat_ #-}    +    unsafeDoSSolve     = tbsv'+    {-# INLINE unsafeDoSSolve #-}+    unsafeDoSSolveMat  = tbsm'+    {-# INLINE unsafeDoSSolveMat #-}    ++instance (BLAS3 e) => IMatrix Banded e where+    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x+    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    +    unsafeRow a i             = runSTVector $ unsafeGetRow a i+    unsafeCol a j             = runSTVector $ unsafeGetCol a j++instance (BLAS3 e) => IMatrix (Herm Banded) e where+    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x+    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    ++instance (BLAS3 e) => IMatrix (Tri Banded) e where+    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x+    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    ++instance (BLAS3 e) => ISolve (Tri Banded) e where+    unsafeSSolve    alpha a y = runSTVector $ unsafeGetSSolve    alpha a y+    unsafeSSolveMat alpha a c = runSTMatrix $ unsafeGetSSolveMat alpha a c+
+ lib/Data/Matrix/Banded/Class.hs view
@@ -0,0 +1,77 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Banded.Class+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface to mutable banded matrices.  For matrix types+-- than can be used with this interface, see "Data.Matrix.Banded.IO" and+-- "Data.Matrix.Banded.ST".  Many of these functions can also be used with+-- the immutable type defined in "Data.Matrix.Banded".+--++module Data.Matrix.Banded.Class (+    -- * Banded matrix type classes+    BaseBanded( numLower, numUpper, bandwidths, ldaBanded, isHermBanded+              , maybeMatrixStorageFromBanded, maybeBandedFromMatrixStorage, coerceBanded ),+    ReadBanded,+    WriteBanded,++    -- * Overloaded interface for matrices+    module Data.Matrix.Class,+    module Data.Matrix.Class.MMatrix,++    -- * Creating banded matrices+    newBanded_,+    newBanded,+    newListsBanded,++    -- * Special banded matrices+    newZeroBanded,+    setZeroBanded,+    newConstantBanded,+    setConstantBanded,++    -- * Copying banded matrices+    newCopyBanded,+    copyBanded,++    -- * Conversions between banded matrices and vectors+    viewVectorAsBanded,+    viewVectorAsDiagBanded,+    maybeViewBandedAsVector,++    -- * Row and column views+    rowViewBanded,+    colViewBanded,+    diagViewBanded,+    +    -- * Getting diagonals+    getDiagBanded,++    -- * Overloaded interface for reading and writing banded matrix elements+    module Data.Tensor.Class,+    module Data.Tensor.Class.MTensor,++    -- * Conversions between mutable and immutable banded matrices+    freezeBanded,+    thawBanded,+    unsafeFreezeBanded,+    unsafeThawBanded,++    -- * Conversions from @IOBanded@s+    unsafeBandedToIOBanded,+    unsafeConvertIOBanded,+    unsafePerformIOWithBanded,+    +    ) where++import Data.Matrix.Banded.Base++import Data.Matrix.Class+import Data.Matrix.Class.MMatrix++import Data.Tensor.Class+import Data.Tensor.Class.MTensor
+ lib/Data/Matrix/Banded/IO.hs view
@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Banded.IO+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Mutable banded matrices in the IO monad.+--++module Data.Matrix.Banded.IO (+    -- * The IOBanded data type+    IOBanded,+    withIOBanded,++    -- * Overloaded mutable banded matrix interface    +    module Data.Matrix.Banded.Class,+    ) where++import Data.Matrix.Banded.IOBase+import Data.Matrix.Banded.Class
+ lib/Data/Matrix/Banded/IOBase.hs view
@@ -0,0 +1,693 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances,+        TypeFamilies, ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Banded.IOBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Matrix.Banded.IOBase+    where++import Data.Ix+import Data.List+import Control.Monad+import Foreign+import System.IO.Unsafe+import Unsafe.Coerce++import BLAS.Internal( diagLen, diagStart )+import Data.Elem.BLAS( Elem, BLAS1, BLAS2, BLAS3, conjugate )+import qualified Data.Elem.BLAS.Level1 as BLAS+import qualified Data.Elem.BLAS.Level2 as BLAS++import Data.Matrix.Class+import Data.Matrix.Class.MMatrixBase+import Data.Matrix.Class.MSolveBase++import Data.Matrix.Herm+import Data.Matrix.Tri++import Data.Tensor.Class+import Data.Tensor.Class.MTensor++import Data.Matrix.Dense.IOBase( IOMatrix(..) )+import Data.Matrix.Dense.Base( ReadMatrix, WriteMatrix, coerceMatrix,+    newCopyMatrix, colViews, scaleByMatrix, unsafeCopyMatrix, +    unsafeAxpyMatrix )+import Data.Vector.Dense.IOBase( IOVector(..), withIOVector )+import Data.Vector.Dense.Base( ReadVector, WriteVector, coerceVector,+    stride, conj, isConj, unsafeVectorToIOVector, newListVector,+    newCopyVector, newCopyVector', scaleByVector, doConjVector,+    unsafeCopyVector, unsafeAxpyVector )++-- | Banded matrix in the 'IO' monad.  The type arguments are as follows:+--+--     * @np@: a phantom type for the shape of the matrix.  Most functions+--       will demand that this be specified as a pair.  When writing a function+--       signature, you should always prefer @IOBanded (n,p) e@ to+--       @IOBanded np e@.+--+--     * @e@: the element type of the matrix.  Only certain element types+--       are supported.+--+data IOBanded np e =+    IOBanded { fptrIOBanded     :: {-# UNPACK #-} !(ForeignPtr e)+             , ptrIOBanded      :: {-# UNPACK #-} !(Ptr e)+             , numRowsIOBanded  :: {-# UNPACK #-} !Int+             , numColsIOBanded  :: {-# UNPACK #-} !Int+             , numLowerIOBanded :: {-# UNPACK #-} !Int+             , numUpperIOBanded :: {-# UNPACK #-} !Int+             , ldaIOBanded      :: {-# UNPACK #-} !Int+             , isHermIOBanded   :: {-# UNPACK #-} !Bool+             }++hermIOBanded :: IOBanded np e -> IOBanded pn e+hermIOBanded a = a{ numRowsIOBanded  = numColsIOBanded a+                  , numColsIOBanded  = numRowsIOBanded a+                  , numLowerIOBanded = numUpperIOBanded a+                  , numUpperIOBanded = numLowerIOBanded a+                  , isHermIOBanded   = not (isHermIOBanded a)+                  }+{-# INLINE hermIOBanded #-}++indexIOBanded :: IOBanded np e -> (Int,Int) -> Int+indexIOBanded (IOBanded _ _ _ _ kl ku ld h) (i,j) =+    let (ku',i',j') = if h then (kl,j,i) else (ku,i,j)+    in ku' + (i' - j') + j' * ld+{-# INLINE indexIOBanded #-}++hasStorageIOBanded :: IOBanded np e -> (Int,Int) -> Bool+hasStorageIOBanded (IOBanded _ _ m n kl ku _ h) (i,j) =+    let (m',kl',ku',i',j') = if h then (n,ku,kl,j,i) else (m,kl,ku,i,j)+    in inRange (max 0 (j'-ku'), min (m'-1) (j'+kl')) i'+{-# INLINE hasStorageIOBanded #-}++-- | Execute an 'IO' action with a pointer to the first element in the+-- banded matrix.+withIOBanded :: IOBanded (n,p) e -> (Ptr e -> IO a) -> IO a+withIOBanded b f = do+    a <- f (ptrIOBanded b)+    touchForeignPtr (fptrIOBanded b)+    return a+{-# INLINE withIOBanded #-}++withIOBandedElem :: (Elem e)+                 => IOBanded np e -> (Int,Int) -> (Ptr e -> IO a) -> IO a+withIOBandedElem a (i,j) f =+    withIOBanded (coerceIOBanded a) $ \p ->+        f $ p `advancePtr` (indexIOBanded a (i,j))+{-# INLINE withIOBandedElem #-}++maybeMatrixStorageFromIOBanded :: IOBanded (n,p) e -> Maybe (IOMatrix (k,p) e)+maybeMatrixStorageFromIOBanded (IOBanded f p _ n kl ku l h)+    | h         = Nothing+    | otherwise = Just $ IOMatrix f p (kl+1+ku) n l False+{-# INLINE maybeMatrixStorageFromIOBanded #-}++maybeIOBandedFromMatrixStorage :: (Int,Int)+                   -> (Int,Int)+                   -> IOMatrix np e+                   -> Maybe (IOBanded np' e)+maybeIOBandedFromMatrixStorage (m,n) (kl,ku) (IOMatrix f p m' n' l h)+    | m < 0 || n < 0 =+        err "dimensions must be non-negative."+    | kl < 0 =+        err "lower bandwdth must be non-negative."+    | m /= 0 && kl >= m =+        err "lower bandwidth must be less than m."+    | ku < 0 =+        err "upper bandwidth must be non-negative."+    | n /= 0 && ku >= n =+        err "upper bandwidth must be less than n."+    | m' /= kl+1+ku =+        err $ "number of rows in the underlying matrix"+              ++ " must be equal to number of diagonals."+    | n' /= n =+        err $ "numbers of columns must be equal"+            ++ " to the number of columns in the underlying matrix."+    | h =+        Nothing    +    | otherwise =+        Just $ IOBanded f p m n kl ku l False+  where+    err s = +      error $ "maybeBandedFromMatrixStorage " ++ show (m,n) ++ " " ++ show (kl,ku) +            ++ " <matrix of shape " ++ show (m',n') ++ ">: " ++ show s++viewVectorAsIOBanded :: (Int,Int) -> IOVector k e -> IOBanded (n,p) e+viewVectorAsIOBanded (m,n) (IOVector f p k l c)+    | k /= m && k /= n =+        error $ "viewVectorAsBanded " ++ show (m,n) ++ " "+              ++ " <vector of dim " ++ show k ++ ">: "+              ++ "vector must have length equal to one of the specified"+              ++ " diemsion sizes"+    | otherwise =+        IOBanded f p m n 0 0 l c+{-# INLINE viewVectorAsIOBanded #-}++maybeViewIOBandedAsVector :: IOBanded (n,p) e -> Maybe (IOVector k e)+maybeViewIOBandedAsVector (IOBanded f p m n kl ku l h)+    | kl == 0 && ku == 0 =+        Just $ IOVector f p (min m n) l h+    | otherwise =+        Nothing+{-# INLINE maybeViewIOBandedAsVector #-}++bandwidthsIOBanded :: IOBanded np e -> (Int,Int)+bandwidthsIOBanded a =+    (numLowerIOBanded a, numUpperIOBanded a)+{-# INLINE bandwidthsIOBanded #-}++coerceIOBanded :: IOBanded np e -> IOBanded np' e+coerceIOBanded = unsafeCoerce+{-# INLINE coerceIOBanded #-}++shapeIOBanded :: IOBanded np e -> (Int,Int)+shapeIOBanded a = (numRowsIOBanded a, numColsIOBanded a)+{-# INLINE shapeIOBanded #-}++boundsIOBanded :: IOBanded np e -> ((Int,Int), (Int,Int))+boundsIOBanded a = ((0,0), (m-1,n-1)) where (m,n) = shapeIOBanded a+{-# INLINE boundsIOBanded #-}++sizeIOBanded :: IOBanded np e -> Int+sizeIOBanded (IOBanded _ _ m n kl ku _ _) =+    foldl' (+) 0 $ map (diagLen (m,n)) [(-kl)..ku]++indicesIOBanded :: IOBanded np e -> [(Int,Int)]+indicesIOBanded a =+    let is = if isHermIOBanded a+                 then [ (i,j) | i <- range (0,m-1), j <- range (0,n-1) ]+                 else [ (i,j) | j <- range (0,n-1), i <- range (0,m-1) ]+    in filter (hasStorageIOBanded a) is+  where (m,n) = shapeIOBanded a++getSizeIOBanded :: IOBanded np e -> IO Int+getSizeIOBanded = return . sizeIOBanded+{-# INLINE getSizeIOBanded #-}++getIndicesIOBanded :: IOBanded np e -> IO [(Int,Int)]+getIndicesIOBanded = return . indicesIOBanded+{-# INLINE getIndicesIOBanded #-}++getIndicesIOBanded' :: IOBanded np e -> IO [(Int,Int)]+getIndicesIOBanded' = getIndicesIOBanded+{-# INLINE getIndicesIOBanded' #-}++getAssocsIOBanded :: (Elem e) => IOBanded np e -> IO [((Int,Int),e)]+getAssocsIOBanded a =+    let go []     = return []+        go (i:is) = unsafeInterleaveIO $ do+                        e   <- unsafeReadElemIOBanded a i+                        ies <- go is+                        return $ (i,e):ies+    in go (indicesIOBanded a)+{-# INLINE getAssocsIOBanded #-}++getAssocsIOBanded' :: (Elem e) => IOBanded np e -> IO [((Int,Int),e)]+getAssocsIOBanded' a =+    sequence [ liftM ((,) i) (unsafeReadElemIOBanded a i)+             | i <- indicesIOBanded a ]+{-# INLINE getAssocsIOBanded' #-}++getElemsIOBanded :: (Elem e) => IOBanded np e -> IO [e]+getElemsIOBanded a = liftM (snd . unzip) $ getAssocsIOBanded a+{-# INLINE getElemsIOBanded #-}++getElemsIOBanded' :: (Elem e) => IOBanded np e -> IO [e]+getElemsIOBanded' a = liftM (snd . unzip) $ getAssocsIOBanded a+{-# INLINE getElemsIOBanded' #-}++unsafeReadElemIOBanded :: (Elem e) => IOBanded np e -> (Int,Int) -> IO e+unsafeReadElemIOBanded a (i,j)+    | hasStorageIOBanded a (i,j) =+        let f = if isHermIOBanded a then conjugate else id+        in liftM f $ withIOBandedElem a (i,j) peek+    | otherwise =+        return 0+{-# INLINE unsafeReadElemIOBanded #-}++unsafeWriteElemIOBanded :: (Elem e)+                      => IOBanded np e -> (Int,Int) -> e -> IO ()+unsafeWriteElemIOBanded a ij e =+    let e' = if isHermIOBanded a then conjugate e else e+    in withIOBandedElem a ij (`poke` e')+{-# INLINE unsafeWriteElemIOBanded #-}++modifyWithIOBanded :: (Elem e)+                   => (e -> e) -> IOBanded np e -> IO ()+modifyWithIOBanded f a = do+    ies <- getAssocsIOBanded a+    mapM_ (\(i,e) -> unsafeWriteElemIOBanded a i (f e)) ies++canModifyElemIOBanded :: IOBanded np e -> (Int,Int) -> IO Bool+canModifyElemIOBanded a ij = return $ hasStorageIOBanded a ij+{-# INLINE canModifyElemIOBanded #-}++-- | Create a new banded matrix of given shape and (lower,upper), bandwidths,+-- but do not initialize the elements.+newIOBanded_ :: (Elem e) => (Int,Int) -> (Int,Int) -> IO (IOBanded np e)+newIOBanded_ (m,n) (kl,ku)+    | m < 0 || n < 0 =+        err "dimensions must be non-negative."+    | kl < 0 =+        err "lower bandwdth must be non-negative."+    | m /= 0 && kl >= m =+        err "lower bandwidth must be less than m."+    | ku < 0 =+        err "upper bandwidth must be non-negative."+    | n /= 0 && ku >= n =+        err "upper bandwidth must be less than n."+    | otherwise =+        let m'  = kl + 1 + ku+            l   = m'+            h   = False+        in do+            fp <- mallocForeignPtrArray (m' * n)+            let p = unsafeForeignPtrToPtr fp+            return $ IOBanded fp p m n kl ku l h+    where+      err s = fail $ "newBanded_ " ++ show (m,n) ++ " " ++ show (kl,ku) ++ ": " ++ s+++-- | Create a zero banded matrix of the specified shape and bandwidths.+newZeroIOBanded :: (Elem e) => (Int,Int) -> (Int,Int) -> IO (IOBanded np e)+newZeroIOBanded mn bw = do+    a <- newIOBanded_ mn bw+    setZeroIOBanded a+    return a++setZeroIOBanded :: (Elem e) => IOBanded np e -> IO ()+setZeroIOBanded = setConstantIOBanded 0+{-# INLINE setZeroIOBanded #-}++-- | Create a constant banded matrix of the specified shape and bandwidths.+newConstantIOBanded :: (Elem e)+                    => (Int,Int) -> (Int,Int) -> e -> IO (IOBanded np e)+newConstantIOBanded mn bw e = do+    a <- newIOBanded_ mn bw+    setConstantIOBanded e a+    return a++setConstantIOBanded :: (Elem e) => e -> IOBanded np e -> IO ()+setConstantIOBanded e a+    | isHermIOBanded a = setConstantIOBanded (conjugate e) (hermIOBanded a)+    | otherwise = do+        is <- getIndicesIOBanded a+        mapM_ (\i -> unsafeWriteElemIOBanded a i e) is+{-# INLINE setConstantIOBanded #-}++newCopyIOBanded :: (BLAS1 e) => IOBanded np e -> IO (IOBanded np e)+newCopyIOBanded a +    | isHermIOBanded a =+        liftM hermIOBanded $ newCopyIOBanded (hermIOBanded a)+    | otherwise = do+        a' <- newIOBanded_ (shapeIOBanded a) (numLowerIOBanded a, numUpperIOBanded a)+        unsafeCopyIOBanded a' a+        return a'++unsafeCopyIOBanded :: (BLAS1 e)+                   => IOBanded mn e -> IOBanded mn e -> IO ()+unsafeCopyIOBanded dst src+    | isHermIOBanded dst = +        unsafeCopyIOBanded (hermIOBanded dst) +                           (hermIOBanded src)+                         +    | (not . isHermIOBanded) src =+        withIOBanded (coerceIOBanded dst) $ \pDst ->+        withIOBanded (coerceIOBanded src) $ \pSrc ->+            if ldDst == m && ldSrc == m+                then copyBlock pDst pSrc+                else copyCols  pDst pSrc n+                +    | otherwise =+        zipWithM_ unsafeCopyVector (diagViews dst) (diagViews src)+        +  where+    m     = numLowerIOBanded dst + numUpperIOBanded dst + 1 -- we can be sure dst is not herm+    n     = numColsIOBanded dst+    ldDst = ldaIOBanded dst+    ldSrc = ldaIOBanded src++    copyBlock pDst pSrc =+        BLAS.copy (m*n) pSrc 1 pDst 1++    copyCols pDst pSrc nleft+        | nleft == 0 = return ()+        | otherwise = do+            BLAS.copy m pSrc 1 pDst 1+            copyCols (pDst `advancePtr` ldDst) (pSrc `advancePtr` ldSrc) +                     (nleft-1)++    diagViews a = +        case bandwidthsIOBanded a of+            (kl,ku) -> map (unsafeDiagViewIOBanded a) $ range (-kl,ku)+++unsafeRowViewIOBanded :: (Elem e)+                      => IOBanded np e+                      -> Int+                      -> (Int, IOVector k e, Int)+unsafeRowViewIOBanded a@(IOBanded f p _ n kl ku ld h) i =+    if h then+        case unsafeColViewIOBanded (hermIOBanded a) i of+            (nb, v, na) -> (nb, conj v, na)+    else+        let nb  = min n $ max (i - kl)         0+            na  = min n $ max (n - 1 - i - ku) 0+            r   = min (ku + i)         (kl + ku)+            c   = max (i - kl)         0+            p'  = p `advancePtr` (r + c * ld)+            inc = max (ld - 1) 1+            len = n - (nb + na)+        in (nb, IOVector f p' len inc False, na)++unsafeColViewIOBanded :: (Elem e)+                      => IOBanded np e+                      -> Int+                      -> (Int, IOVector k e, Int)+unsafeColViewIOBanded a@(IOBanded f p m _ kl ku ld h) j =+    if h then+        case unsafeRowViewIOBanded (hermIOBanded a) j of+            (nb, v, na) -> (nb, conj v, na)+    else+        let nb  = min m $ max (j - ku)         0+            na  = min m $ max (m - 1 - j - kl) 0+            r   = max (ku - j) 0+            c   = j+            p'  = p `advancePtr` (r + c * ld)+            inc = 1+            len = m - (nb + na)+        in (nb, IOVector f p' len inc False, na)++unsafeDiagViewIOBanded :: (Elem e) => +    IOBanded np e -> Int -> IOVector k e+unsafeDiagViewIOBanded a@(IOBanded fp p m n _ _ ld h) d+    | h         = conj $ unsafeDiagViewIOBanded (hermIOBanded a) (negate d)+    | otherwise =+        let off = indexIOBanded a (diagStart d)+            p'  = p `advancePtr` off+            len = diagLen (m,n) d+            inc = ld+            c   = False+        in (IOVector fp p' len inc c)+++unsafeGetRowIOBanded :: (WriteVector y e IO, BLAS1 e) +                     => IOBanded np e -> Int -> IO (y p e)+unsafeGetRowIOBanded a i =+    let (nb,x,na) = unsafeRowViewIOBanded a i+        n = numCols a+    in do+        es <- getElems x+        newListVector n $ (replicate nb 0) ++ es ++ (replicate na 0)++unsafeGetColIOBanded :: (WriteVector y e IO, BLAS1 e) +                     => IOBanded np e -> Int -> IO (y n e)+unsafeGetColIOBanded a j =+    liftM conj $ unsafeGetRowIOBanded (hermIOBanded a) j++-- | @gbmv alpha a x beta y@ replaces @y := alpha a * x + beta y@+gbmv :: (ReadVector x e IO, WriteVector y e IO, BLAS2 e)+     => e -> IOBanded (n,p) e -> x p e -> e -> y n e -> IO ()+gbmv alpha a (x :: x p e) beta y+    | numRows a == 0 || numCols a == 0 =+        scaleByVector beta y+    | isConj x = do+        x' <- newCopyVector' x :: IO (IOVector p e) +        gbmv alpha a x' beta y+    | isConj y = do+        doConjVector y+        gbmv alpha a x beta (conj y)+        doConjVector y+    | otherwise =+        let transA = transIOBanded a+            (m,n)  = case (isHermIOBanded a) of+                         False -> shape a+                         True  -> (flipShape . shape) a+            (kl,ku) = case (isHermIOBanded a) of+                          False -> (numLowerIOBanded a, numUpperIOBanded a)+                          True  -> (numUpperIOBanded a, numLowerIOBanded a)+            ldA    = ldaIOBanded a+            incX   = stride x+            incY   = stride y+        in+            withIOBanded a   $ \pA ->+            withIOVector (unsafeVectorToIOVector x) $ \pX ->+            withIOVector (unsafeVectorToIOVector y) $ \pY -> do+                BLAS.gbmv transA m n kl ku alpha pA ldA pX incX beta pY incY++-- | @gbmm alpha a b beta c@ replaces @c := alpha a * b + beta c@.+gbmm :: (ReadMatrix b e IO, WriteMatrix c e IO, BLAS2 e)+     => e -> IOBanded (n,p) e -> b (p,q) e -> e -> c (n,q) e -> IO ()+gbmm alpha a b beta c =+    sequence_ $+        zipWith (\x y -> gbmv alpha a x beta y) (colViews b) (colViews c)++hbmv :: (ReadVector x e IO, WriteVector y e IO, BLAS2 e) => +    e -> Herm IOBanded (n,p) e -> x p e -> e -> y n e -> IO ()+hbmv alpha h (x :: x p e) beta (y :: y n e)+    | numRows h == 0 =+        return ()+    | isConj y = do+        doConjVector y+        hbmv alpha h x beta (conj y)+        doConjVector y+    | isConj x = do+        (x' :: IOVector p e) <- newCopyVector' x+        hbmv alpha h x' beta y+    | otherwise =+        let (u,a) = hermToBase (coerceHerm h)+            n     = numCols a+            k     = case u of +                        Upper -> numUpperIOBanded a+                        Lower -> numLowerIOBanded a      +            u'    = case (isHermIOBanded a) of+                        True  -> flipUpLo u+                        False -> u+            uploA = u'+            ldA   = ldaIOBanded a+            incX  = stride x+            incY  = stride y+            withPtrA +                  = case u' of Upper -> withIOBanded a+                               Lower -> withIOBandedElem a (0,0)+        in+            withPtrA $ \pA ->+            withIOVector (unsafeVectorToIOVector x) $ \pX ->+            withIOVector (unsafeVectorToIOVector y) $ \pY -> do+                BLAS.hbmv uploA n k alpha pA ldA pX incX beta pY incY++hbmm :: (ReadMatrix b e IO, WriteMatrix c e IO) => +    e -> Herm IOBanded (n,p) e -> b (p,q) e -> e -> c (n,q) e -> IO ()+hbmm alpha h b beta c =+    zipWithM_ (\x y -> hbmv alpha h x beta y) (colViews b) (colViews c)++tbmv :: (WriteVector y e IO, BLAS2 e) => +    e -> Tri IOBanded (n,n) e -> y n e -> IO ()+tbmv alpha t x | isConj x = do+    doConjVector x+    tbmv alpha t (conj x)+    doConjVector x++tbmv alpha t x =+    let (u,d,a) = triToBase t+        (transA,u') +                  = if isHermIOBanded a then (ConjTrans, flipUpLo u) +                                        else (NoTrans  , u)+        uploA     = u'+        diagA     = d+        n         = numCols a+        k         = case u of Upper -> numUpperIOBanded a +                              Lower -> numLowerIOBanded a+        ldA       = ldaIOBanded a+        incX      = stride x+        withPtrA  = case u' of +                        Upper -> withIOBanded a+                        Lower -> withIOBandedElem a (0,0)+    in do+        scaleByVector alpha x+        withPtrA $ \pA ->+            withVectorPtrIO x $ \pX -> do+                BLAS.tbmv uploA transA diagA n k pA ldA pX incX+  where withVectorPtrIO = withIOVector . unsafeVectorToIOVector++tbmm :: (WriteMatrix b e IO, BLAS2 e) =>+    e -> Tri IOBanded (n,n) e -> b (n,p) e -> IO ()+tbmm 1     t b = mapM_ (\x -> tbmv 1 t x) (colViews b)+tbmm alpha t b = scaleByMatrix alpha b >> tbmm 1 t b++tbmv' :: (ReadVector x e IO, WriteVector y e IO, BLAS2 e) => +    e -> Tri IOBanded (n,p) e -> x p e -> e -> y n e -> IO ()+tbmv' alpha a (x :: x p e) beta (y  :: y n e)+    | beta /= 0 = do+        (x' :: y p e) <- newCopyVector x+        tbmv alpha (coerceTri a) x'+        scaleByVector beta y+        unsafeAxpyVector 1 x' (coerceVector y)+    | otherwise = do+        unsafeCopyVector (coerceVector y) x+        tbmv alpha (coerceTri a) (coerceVector y)++tbmm' :: (ReadMatrix b e IO, WriteMatrix c e IO, BLAS2 e) => +    e -> Tri IOBanded (r,s) e -> b (s,t) e -> e -> c (r,t) e -> IO ()+tbmm' alpha a (b :: b (s,t) e) beta (c :: c (r,t) e)+    | beta /= 0 = do+        (b' :: c (s,t) e) <- newCopyMatrix b+        tbmm alpha (coerceTri a) b'+        scaleByMatrix beta c+        unsafeAxpyMatrix 1 b' (coerceMatrix c)+    | otherwise = do+        unsafeCopyMatrix (coerceMatrix c) b+        tbmm alpha (coerceTri a) (coerceMatrix c)++tbsv :: (WriteVector y e IO, BLAS2 e) => +    e -> Tri IOBanded (k,k) e -> y n e -> IO ()+tbsv alpha t x | isConj x = do+    doConjVector x+    tbsv alpha t (conj x)+    doConjVector x+tbsv alpha t x = +    let (u,d,a) = triToBase t+        (transA,u') = if isHermIOBanded a then (ConjTrans, flipUpLo u)+                                          else (NoTrans  , u)+        uploA     = u'+        diagA     = d+        n         = numCols a+        k         = case u of Upper -> numUpperIOBanded a +                              Lower -> numLowerIOBanded a        +        ldA       = ldaIOBanded a+        incX      = stride x+        withPtrA  = case u' of +                        Upper -> withIOBanded a+                        Lower -> withIOBandedElem a (0,0)+    in do+        scaleByVector alpha x+        withPtrA $ \pA ->+            withVectorPtrIO x $ \pX -> do+                BLAS.tbsv uploA transA diagA n k pA ldA pX incX+  where withVectorPtrIO = withIOVector . unsafeVectorToIOVector++tbsm :: (WriteMatrix b e IO, BLAS2 e) => +    e -> Tri IOBanded (k,k) e -> b (k,l) e -> IO ()+tbsm 1     t b = mapM_ (\x -> tbsv 1 t x) (colViews b)+tbsm alpha t b = scaleByMatrix alpha b >> tbsm 1 t b++tbsv' :: (ReadVector y e IO, WriteVector x e IO, BLAS2 e)+      => e -> Tri IOBanded (k,l) e -> y k e -> x l e -> IO ()+tbsv' alpha a y x = do+    unsafeCopyVector (coerceVector x) y+    tbsv alpha (coerceTri a) (coerceVector x)++tbsm' :: (ReadMatrix c e IO, WriteMatrix b e IO, BLAS2 e) +      => e -> Tri IOBanded (r,s) e -> c (r,t) e -> b (s,t) e -> IO ()+tbsm' alpha a c b = do+    unsafeCopyMatrix (coerceMatrix b) c+    tbsm alpha (coerceTri a) b++instance HasVectorView IOBanded where+    type VectorView IOBanded = IOVector++instance HasMatrixStorage IOBanded where+    type MatrixStorage IOBanded = IOMatrix++instance Shaped IOBanded (Int,Int) where+    shape  = shapeIOBanded+    {-# INLINE shape #-}+    bounds = boundsIOBanded+    {-# INLINE bounds #-}++instance MatrixShaped IOBanded where+    herm = hermIOBanded+    {-# INLINE herm #-}++instance (BLAS3 e) => ReadTensor IOBanded (Int,Int) e IO where+    getSize        = getSizeIOBanded+    {-# INLINE getSize #-}+    getAssocs      = getAssocsIOBanded+    {-# INLINE getAssocs #-}+    getIndices     = getIndicesIOBanded+    {-# INLINE getIndices #-}+    getElems       = getElemsIOBanded+    {-# INLINE getElems #-}+    getAssocs'     = getAssocsIOBanded'+    {-# INLINE getAssocs' #-}+    getIndices'    = getIndicesIOBanded'+    {-# INLINE getIndices' #-}+    getElems'      = getElemsIOBanded'+    {-# INLINE getElems' #-}+    unsafeReadElem = unsafeReadElemIOBanded+    {-# INLINE unsafeReadElem #-}++instance (BLAS3 e) => WriteTensor IOBanded (Int,Int) e IO where+    setConstant     = setConstantIOBanded+    {-# INLINE setConstant #-}+    setZero         = setZeroIOBanded+    {-# INLINE setZero #-}+    modifyWith      = modifyWithIOBanded+    {-# INLINE modifyWith #-}+    unsafeWriteElem = unsafeWriteElemIOBanded+    {-# INLINE unsafeWriteElem #-}+    canModifyElem   = canModifyElemIOBanded+    {-# INLINE canModifyElem #-}++instance (BLAS3 e) => MMatrix IOBanded e IO where+    unsafeDoSApplyAdd    = gbmv+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = gbmm+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeGetRow         = unsafeGetRowIOBanded+    {-# INLINE unsafeGetRow #-}+    unsafeGetCol         = unsafeGetColIOBanded+    {-# INLINE unsafeGetCol #-}+    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Herm IOBanded) e IO where+    unsafeDoSApplyAdd    = hbmv+    {-# INLINE unsafeDoSApplyAdd #-}    +    unsafeDoSApplyAddMat = hbmm+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Tri IOBanded) e IO where+    unsafeDoSApply_      = tbmv+    {-# INLINE unsafeDoSApply_ #-}        +    unsafeDoSApplyMat_   = tbmm+    {-# INLINE unsafeDoSApplyMat_ #-}    +    unsafeDoSApplyAdd    = tbmv'+    {-# INLINE unsafeDoSApplyAdd #-}    +    unsafeDoSApplyAddMat = tbmm'+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MSolve (Tri IOBanded) e IO where+    unsafeDoSSolve_    = tbsv+    {-# INLINE unsafeDoSSolve_ #-}    +    unsafeDoSSolveMat_ = tbsm+    {-# INLINE unsafeDoSSolveMat_ #-}    +    unsafeDoSSolve     = tbsv'+    {-# INLINE unsafeDoSSolve #-}+    unsafeDoSSolveMat  = tbsm'+    {-# INLINE unsafeDoSSolveMat #-}    ++transIOBanded :: IOBanded np e -> TransEnum+transIOBanded a =+    case (isHermIOBanded a) of+          False -> NoTrans+          True  -> ConjTrans+{-# INLINE transIOBanded #-}+
+ lib/Data/Matrix/Banded/ST.hs view
@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Banded.ST+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Mutable dense matrices in the ST monad.+--++module Data.Matrix.Banded.ST (+    -- * The @STBanded@ data type+    STBanded,+    runSTBanded,++    -- * Overloaded mutable banded matrix interface+    module Data.Matrix.Banded.Class,+    ) where++import Data.Matrix.Banded.STBase+import Data.Matrix.Banded.Class
+ lib/Data/Matrix/Banded/STBase.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Banded.STBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Matrix.Banded.STBase+    where++import Control.Monad+import Control.Monad.ST++import Data.Elem.BLAS( Elem, BLAS3 )++import Data.Matrix.Class+import Data.Matrix.Class.MMatrixBase+import Data.Matrix.Class.MSolveBase++import Data.Matrix.Herm+import Data.Matrix.Tri++import Data.Tensor.Class+import Data.Tensor.Class.MTensor++import Data.Matrix.Dense.STBase( STMatrix(..) )+import Data.Vector.Dense.STBase( STVector(..) )++import Data.Matrix.Banded.Base+import Data.Matrix.Banded.IOBase( IOBanded )+import qualified Data.Matrix.Banded.IOBase as IO++-- | Banded matrix in the 'ST' monad.  The type arguments are as follows:+--+--     * @s@: the state variable argument for the 'ST' type+--+--     * @np@: a phantom type for the shape of the matrix.  Most functions+--       will demand that this be specified as a pair.  When writing a function+--       signature, you should always prefer @STBanded s (n,p) e@ to+--       @STBanded s np e@.+--+--     * @e@: the element type of the matrix.  Only certain element types+--       are supported.+--+newtype STBanded s np e = STBanded (IOBanded np e)++-- | A safe way to create and work with a mutable banded matrix before returning +-- an immutable one for later perusal. This function avoids copying+-- the matrix before returning it - it uses unsafeFreezeBanded internally,+-- but this wrapper is a safe interface to that function. +runSTBanded :: (forall s . ST s (STBanded s n e)) -> Banded n e+runSTBanded mx = +    runST $ mx >>= \(STBanded x) -> return (Banded x)++instance HasVectorView (STBanded s) where+    type VectorView (STBanded s) = STVector s++instance HasMatrixStorage (STBanded s) where+    type MatrixStorage (STBanded s) = (STMatrix s)++instance Shaped (STBanded s) (Int,Int) where+    shape (STBanded a) = IO.shapeIOBanded a+    {-# INLINE shape #-}+    bounds (STBanded a) = IO.boundsIOBanded a+    {-# INLINE bounds #-}++instance MatrixShaped (STBanded s) where+    herm (STBanded a) = STBanded $ IO.hermIOBanded a+    {-# INLINE herm #-}++instance (BLAS3 e) => ReadTensor (STBanded s) (Int,Int) e (ST s) where+    getSize (STBanded a) = unsafeIOToST $ IO.getSizeIOBanded a+    {-# INLINE getSize #-}+    getAssocs (STBanded a) = unsafeIOToST $ IO.getAssocsIOBanded a+    {-# INLINE getAssocs #-}+    getIndices (STBanded a) = unsafeIOToST $ IO.getIndicesIOBanded a+    {-# INLINE getIndices #-}+    getElems (STBanded a) = unsafeIOToST $ IO.getElemsIOBanded a+    {-# INLINE getElems #-}+    getAssocs' (STBanded a) = unsafeIOToST $ IO.getAssocsIOBanded' a+    {-# INLINE getAssocs' #-}+    getIndices' (STBanded a) = unsafeIOToST $ IO.getIndicesIOBanded' a+    {-# INLINE getIndices' #-}+    getElems' (STBanded a) = unsafeIOToST $ IO.getElemsIOBanded' a+    {-# INLINE getElems' #-}+    unsafeReadElem (STBanded a) i = unsafeIOToST $ IO.unsafeReadElemIOBanded a i+    {-# INLINE unsafeReadElem #-}++instance (BLAS3 e) => WriteTensor (STBanded s) (Int,Int) e (ST s) where+    setConstant k (STBanded a) = unsafeIOToST $ IO.setConstantIOBanded k a+    {-# INLINE setConstant #-}+    setZero (STBanded a) = unsafeIOToST $ IO.setZeroIOBanded a+    {-# INLINE setZero #-}+    modifyWith f (STBanded a) = unsafeIOToST $ IO.modifyWithIOBanded f a+    {-# INLINE modifyWith #-}+    unsafeWriteElem (STBanded a) i e = unsafeIOToST $ IO.unsafeWriteElemIOBanded a i e+    {-# INLINE unsafeWriteElem #-}+    canModifyElem (STBanded a) i = unsafeIOToST $ IO.canModifyElemIOBanded a i+    {-# INLINE canModifyElem #-}++instance (Elem e) => BaseBanded (STBanded s) e where+    numLower (STBanded a) = IO.numLowerIOBanded a+    {-# INLINE numLower #-}+    numUpper (STBanded a) = IO.numUpperIOBanded a+    {-# INLINE numUpper #-}+    bandwidths (STBanded a) = IO.bandwidthsIOBanded a+    {-# INLINE bandwidths #-}+    ldaBanded (STBanded a) = IO.ldaIOBanded a+    {-# INLINE ldaBanded #-}+    isHermBanded (STBanded a) = IO.isHermIOBanded a+    {-# INLINE isHermBanded #-}+    maybeMatrixStorageFromBanded (STBanded a) = +        liftM STMatrix $ IO.maybeMatrixStorageFromIOBanded a+    {-# INLINE maybeMatrixStorageFromBanded #-}+    maybeBandedFromMatrixStorage mn kl (STMatrix a) = +        liftM STBanded $ IO.maybeIOBandedFromMatrixStorage mn kl a+    {-# INLINE maybeBandedFromMatrixStorage #-}+    viewVectorAsBanded mn (STVector x) = STBanded $ IO.viewVectorAsIOBanded mn x+    {-# INLINE viewVectorAsBanded #-}+    maybeViewBandedAsVector (STBanded a) = +        liftM STVector $ IO.maybeViewIOBandedAsVector a+    {-# INLINE maybeViewBandedAsVector #-}        +    unsafeDiagViewBanded (STBanded a) i = +        STVector $ IO.unsafeDiagViewIOBanded a i+    {-# INLINE unsafeDiagViewBanded #-}+    unsafeRowViewBanded (STBanded a) i = +        case IO.unsafeRowViewIOBanded a i of (nb,x,na) -> (nb, STVector x, na)+    {-# INLINE unsafeRowViewBanded #-}+    unsafeColViewBanded (STBanded a) j = +        case IO.unsafeColViewIOBanded a j of (nb,x,na) -> (nb, STVector x, na)+    {-# INLINE unsafeColViewBanded #-}+    unsafeIOBandedToBanded = STBanded+    {-# INLINE unsafeIOBandedToBanded #-}+    unsafeBandedToIOBanded (STBanded a) = a+    {-# INLINE unsafeBandedToIOBanded #-}+    +instance (BLAS3 e) => ReadBanded (STBanded s) e (ST s) where+    unsafePerformIOWithBanded (STBanded a) f = unsafeIOToST $ f a+    {-# INLINE unsafePerformIOWithBanded #-}+    freezeBanded (STBanded a) = unsafeIOToST $ freezeIOBanded a+    {-# INLINE freezeBanded #-}+    unsafeFreezeBanded (STBanded a) = unsafeIOToST $ unsafeFreezeIOBanded a+    {-# INLINE unsafeFreezeBanded #-}++instance (BLAS3 e) => MMatrix (STBanded s) e (ST s) where+    unsafeDoSApplyAdd    = gbmv+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = gbmm+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeGetRow         = unsafeGetRowBanded+    {-# INLINE unsafeGetRow #-}+    unsafeGetCol         = unsafeGetColBanded+    {-# INLINE unsafeGetCol #-}+    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Herm (STBanded s)) e (ST s) where+    unsafeDoSApplyAdd    = hbmv+    {-# INLINE unsafeDoSApplyAdd #-}    +    unsafeDoSApplyAddMat = hbmm+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Tri (STBanded s)) e (ST s) where+    unsafeDoSApply_      = tbmv+    {-# INLINE unsafeDoSApply_ #-}        +    unsafeDoSApplyMat_   = tbmm+    {-# INLINE unsafeDoSApplyMat_ #-}    +    unsafeDoSApplyAdd    = tbmv'+    {-# INLINE unsafeDoSApplyAdd #-}    +    unsafeDoSApplyAddMat = tbmm'+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MSolve (Tri (STBanded s)) e (ST s) where+    unsafeDoSSolve_    = tbsv+    {-# INLINE unsafeDoSSolve_ #-}    +    unsafeDoSSolveMat_ = tbsm+    {-# INLINE unsafeDoSSolveMat_ #-}    +    unsafeDoSSolve     = tbsv'+    {-# INLINE unsafeDoSSolve #-}+    unsafeDoSSolveMat  = tbsm'+    {-# INLINE unsafeDoSSolveMat #-}
+ lib/Data/Matrix/Class.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Common functionality for the types defined in+-- "Data.Matrix.Dense.Class" and "Data.Matrix.Banded.Class", and +-- a base class for the mutable and immutable matrix+-- classes defined in the submodules of this one.+--++module Data.Matrix.Class (+    -- * Matrix shape+    MatrixShaped(..),+    numRows,+    numCols,+    isSquare,+    isFat,+    isTall,+    flipShape,++    -- * Associated types for matrices+    HasVectorView(..),+    HasMatrixStorage(..),++    -- * Matrix storage types+    module BLAS.Types,++    ) where++import BLAS.Types+import Data.Tensor.Class++-- | A class for matrices with an associated type for row, column, and+-- diagonal vector views.+class HasVectorView (a :: * -> * -> *) where+    -- | An associated type for a vector view into a matrix type @a@.  +    -- Typically, the view will share the same storage as the matrix,+    -- so that modifying an element in the view will affect the+    -- corresponding element in the matrix, and vice versa.+    type VectorView a :: * -> * -> *++-- | A class for matrix types that use a matrix internally for storage,+-- "Data.Matrix.Banded.Class" for example.+class HasMatrixStorage (a :: * -> * -> *) where+    -- | An associated type for the underlying matrix storage.+    type MatrixStorage a :: * -> * -> *++-- | A base class for objects shaped like matrices.+class (Shaped a (Int,Int)) => MatrixShaped a where+    -- | Creates a new matrix view that conjugates and transposes the +    -- given matrix.+    herm :: a (m,n) e -> a (n,m) e++-- | Get the number of rows in the matrix.+numRows :: (MatrixShaped a) => a mn e -> Int+numRows = fst . shape+{-# INLINE numRows #-}++-- | Get the number of rows in the matrix.+numCols :: (MatrixShaped a) => a mn e -> Int+numCols = snd . shape+{-# INLINE numCols #-}++-- | Indicate whether or not a matrix has the same number of rows and columns.+isSquare :: (MatrixShaped a) => a mn e -> Bool+isSquare a = numRows a == numCols a+{-# INLINE isSquare #-}++-- | Indicate whether or not the number of rows is less than or equal to +-- the number of columns.+isFat :: (MatrixShaped a) => a mn e -> Bool+isFat a = numRows a <= numCols a+{-# INLINE isFat #-}++-- | Indicate whether or not the number of rows is greater than or equal to +-- the number of columns.+isTall :: (MatrixShaped a) => a mn e -> Bool+isTall a = numRows a >= numCols a+{-# INLINE isTall #-}++-- | Replaces @(m,n)@ with @(n,m)@+flipShape :: (Int,Int) -> (Int,Int)+flipShape (m,n) = (n,m)+{-# INLINE flipShape #-}+
+ lib/Data/Matrix/Class/IMatrix.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class.IMatrix+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface for immutable matrices.  The matrices provide+-- access to rows and columns, and can operate via multiplication on +-- immutable dense vectors and matrices.+--++module Data.Matrix.Class.IMatrix (+    -- * The IMatrix type class+    IMatrix,++    -- * Rows and columns+    row,+    col,+    rows,+    cols,++    -- * Multiplication+    (<*>),+    (<**>),+    sapply,+    sapplyMat,+    ) where++import Data.Matrix.Class.IMatrixBase
+ lib/Data/Matrix/Class/IMatrixBase.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS_GHC -fglasgow-exts #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class.IMatrixBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface for immutable matrices.  The matrices provide+-- access to rows and columns, and can operate via multiplication on +-- immutable dense vectors and matrices.+--++module Data.Matrix.Class.IMatrixBase (+    -- * The IMatrix type class+    IMatrix(..),++    -- * Rows and columns+    row,+    col,+    rows,+    cols,++    -- * Multiplication+    (<*>),+    (<**>),+    sapply,+    sapplyMat,+    +    -- * Unsafe operations+    unsafeApply,+    unsafeApplyMat,+    ) where++import Data.Elem.BLAS( BLAS3 )+import BLAS.Internal ( checkedRow, checkedCol, checkMatVecMult, +    checkMatMatMult )++import Data.Matrix.Class+import Data.Tensor.Class++import Data.Vector.Dense+import Data.Vector.Dense.ST( runSTVector )+import Data.Matrix.Herm+import Data.Matrix.TriBase+import Data.Matrix.Dense.Base+import Data.Matrix.Dense.ST( runSTMatrix )++infixr 7 <*>, <**>++-- | A type class for immutable matrices.  The member functions of the+-- type class do not perform any checks on the validity of shapes or+-- indices, so in general their safe counterparts should be preferred.+class (MatrixShaped a, BLAS3 e) => IMatrix a e where+    unsafeSApply :: e -> a (m,n) e -> Vector n e -> Vector m e+    unsafeSApplyMat :: e -> a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e++    unsafeRow :: a (m,n) e -> Int -> Vector n e+    unsafeRow a i = let+        e = basisVector (numRows a) i+        in conj $ unsafeApply (herm a) e+    {-# INLINE unsafeRow #-}+    +    unsafeCol :: a (m,n) e -> Int -> Vector m e+    unsafeCol a j = let+        e = basisVector (numCols a) j+        in unsafeApply a e+    {-# INLINE unsafeCol #-}++-- | Get the given row in a matrix.+row :: (IMatrix a e) => a (m,n) e -> Int -> Vector n e+row a = checkedRow (shape a) (unsafeRow a)+{-# INLINE row #-}++-- | Get the given column in a matrix.+col :: (IMatrix a e) => a (m,n) e -> Int -> Vector m e+col a = checkedCol (shape a) (unsafeCol a)+{-# INLINE col #-}++-- | Get a list the row vectors in the matrix.+rows :: (IMatrix a e) => a (m,n) e -> [Vector n e]+rows a = [ unsafeRow a i | i <- [0..numRows a - 1] ]+{-# INLINE rows #-}++-- | Get a list the column vectors in the matrix.+cols :: (IMatrix a e) => a (m,n) e -> [Vector m e]+cols a = [ unsafeCol a j | j <- [0..numCols a - 1] ]+{-# INLINE cols #-}++-- | Matrix multiplication by a vector.+(<*>) :: (IMatrix a e) => a (m,n) e -> Vector n e -> Vector m e+(<*>) a x = checkMatVecMult (shape a) (dim x) $ unsafeApply a x+{-# INLINE (<*>) #-}++-- | Matrix multiplication by a matrix.+(<**>) :: (IMatrix a e) => a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e+(<**>) a b = checkMatMatMult (shape a) (shape b) $ unsafeApplyMat a b+{-# INLINE (<**>) #-}++-- | Scale and multiply by a vector.  +-- @sapply k a x@ is equal to @a \<*> (k *> x)@, and often it is faster.+sapply :: (IMatrix a e) => e -> a (m,n) e -> Vector n e -> Vector m e+sapply k a x = checkMatVecMult (shape a) (dim x) $ unsafeSApply k a x+{-# INLINE sapply #-}+    +-- | Scale and multiply by a matrix.+-- @sapplyMat k a b@ is equal to @a \<**> (k *> b)@, and often it is faster.+sapplyMat :: (IMatrix a e) => e -> a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e    +sapplyMat k a b = checkMatMatMult (shape a) (shape b) $ unsafeSApplyMat k a b+{-# INLINE sapplyMat #-}++unsafeApply :: (IMatrix a e) => a (m,n) e -> Vector n e -> Vector m e+unsafeApply = unsafeSApply 1+{-# INLINE unsafeApply #-}++unsafeApplyMat :: (IMatrix a e) => a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e+unsafeApplyMat = unsafeSApplyMat 1+{-# INLINE unsafeApplyMat #-}++instance (BLAS3 e) => IMatrix Matrix e where+    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x+    {-# INLINE unsafeSApply #-}    +    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b+    {-# INLINE unsafeSApplyMat #-}   +    unsafeRow                 = unsafeRowView+    {-# INLINE unsafeRow #-}   +    unsafeCol                 = unsafeColView+    {-# INLINE unsafeCol #-}++instance (BLAS3 e) => IMatrix (Herm Matrix) e where+    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x+    {-# INLINE unsafeSApply #-}    +    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b    +    {-# INLINE unsafeSApplyMat #-}   +    unsafeRow a i = runSTVector $ unsafeGetRow a i+    {-# INLINE unsafeRow #-}+    unsafeCol a j = runSTVector $ unsafeGetCol a j+    {-# INLINE unsafeCol #-}++instance (BLAS3 e) => IMatrix (Tri Matrix) e where+    unsafeSApply alpha a x    = runSTVector $ unsafeGetSApply    alpha a x+    {-# INLINE unsafeSApply #-}+    unsafeSApplyMat alpha a b = runSTMatrix $ unsafeGetSApplyMat alpha a b+    {-# INLINE unsafeSApplyMat #-}   +    unsafeRow a i = runSTVector $ unsafeGetRow a i+    {-# INLINE unsafeRow #-}+    unsafeCol a j = runSTVector $ unsafeGetCol a j+    {-# INLINE unsafeCol #-}++{-# RULES+"scale.apply/sapply"       forall k a x. a <*>  (k *> x) = sapply k a x+"scale.applyMat/sapplyMat" forall k a b. a <**> (k *> b) = sapplyMat k a b+  #-}
+ lib/Data/Matrix/Class/ISolve.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class.ISolve+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface for solving immutable matrix systems.  The+-- matrices can operate via inverse multiplication on immutable dense+-- vectors and matrices.+--++module Data.Matrix.Class.ISolve (+    -- * The ISolve type class+    ISolve,+    +    -- * Solving linear systems+    (<\>),+    (<\\>),+    ssolve,+    ssolveMat,+    +    ) where++import Data.Matrix.Class.ISolveBase
+ lib/Data/Matrix/Class/ISolveBase.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class.ISolveBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface for solving immutable matrix systems.  The+-- matrices can operate via inverse multiplication on immutable dense+-- vectors and matrices.+--++module Data.Matrix.Class.ISolveBase (+    -- * The IMatrix type class+    ISolve(..),+    +    -- * Solving linear systems+    (<\>),+    (<\\>),+    ssolve,+    ssolveMat,+    +    ) where++import Data.Elem.BLAS+import BLAS.Internal ( checkMatVecSolv, checkMatMatSolv )+import Data.Matrix.Class+import Data.Matrix.Class.MSolveBase++import Data.Vector.Dense ( Vector, dim, (*>) )+import Data.Vector.Dense.ST ( runSTVector )+import Data.Matrix.Dense ( Matrix, shape )+import Data.Matrix.Dense.ST ( runSTMatrix )+import Data.Matrix.TriBase++infixr 7 <\>, <\\>++-- | A type class for immutable matrices with inverses.  The member+-- functions of the type class do not perform any checks on the validity+-- of shapes or indices, so in general their safe counterparts should be+-- preferred.+class (MatrixShaped a, BLAS3 e) => ISolve a e where+    unsafeSolve :: a (m,n) e -> Vector m e -> Vector n e+    unsafeSolve = unsafeSSolve 1+    {-# INLINE unsafeSolve #-}+    +    unsafeSolveMat :: a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e+    unsafeSolveMat = unsafeSSolveMat 1+    {-# INLINE unsafeSolveMat #-}++    unsafeSSolve :: e -> a (m,n) e -> Vector m e -> Vector n e+    +    unsafeSSolveMat :: e -> a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e++-- | Solve for a vector.+(<\>) :: (ISolve a e) => a (m,n) e -> Vector m e -> Vector n e+(<\>) a y =+    checkMatVecSolv (shape a) (dim y) $+        unsafeSolve a y+{-# INLINE (<\>) #-}++-- | Solve for a matrix.+(<\\>) :: (ISolve a e) => a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e+(<\\>) a b =+    checkMatMatSolv (shape a) (shape b) $+        unsafeSolveMat a b+{-# INLINE (<\\>) #-}++-- | Solve for a vector and scale.+-- @ssolve k a y@ is equal to @a \<\\> (k *> y)@ but is often faster.+ssolve :: (ISolve a e) => e -> a (m,n) e -> Vector m e -> Vector n e+ssolve alpha a y =+    checkMatVecSolv (shape a) (dim y) $+        unsafeSSolve alpha a y+{-# INLINE ssolve #-}++-- | Solve for a matrix and scale.+-- @ssolveMat k a c@ is equal to @a \<\\\\> (k *> c)@ but is often faster.+ssolveMat :: (ISolve a e) => e -> a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e+ssolveMat alpha a b =+    checkMatMatSolv (shape a) (shape b) $+        unsafeSSolveMat alpha a b+{-# INLINE ssolveMat #-}++instance (BLAS3 e) => ISolve (Tri Matrix) e where+    unsafeSSolve    alpha a y = runSTVector $ unsafeGetSSolve    alpha a y+    {-# INLINE unsafeSSolve #-}+    unsafeSSolveMat alpha a c = runSTMatrix $ unsafeGetSSolveMat alpha a c+    {-# INLINE unsafeSSolveMat #-}++{-# RULES+"scale.solve/ssolve"       forall k a y. a <\>  (k *> y) = ssolve k a y+"scale.solveMat/ssolveMat" forall k a c. a <\\> (k *> c) = ssolveMat k a c+  #-}
+ lib/Data/Matrix/Class/MMatrix.hs view
@@ -0,0 +1,47 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class.MMatrix+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface for mutable matrices. The type class associates a+-- matrix with a monad type in which operations can be perfomred.  The+-- matrices provide access to rows and columns, and can operate via+-- multiplication on dense vectors and matrices.  +--++module Data.Matrix.Class.MMatrix (+    -- * The MMatrix type class+    MMatrix,++    -- * Getting rows and columns+    getRow,+    getCol,+    getRows,+    getCols,+    getRows',+    getCols',+    +    -- * Matrix and vector multiplication+    getApply,+    getSApply,+    +    getApplyMat,+    getSApplyMat,++    -- * In-place multiplication+    doApply,+    doSApplyAdd,+    doApply_,+    doSApply_,+    +    doApplyMat,+    doSApplyAddMat,+    doApplyMat_,+    doSApplyMat_,+    ) where++import Data.Matrix.Class.MMatrixBase+
+ lib/Data/Matrix/Class/MMatrixBase.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class.MMatrixBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface for mutable matrices. The type class associates a+-- matrix with a monad type in which operations can be perfomred.  The+-- matrices provide access to rows and columns, and can operate via+-- multiplication on dense vectors and matrices.  +--++module Data.Matrix.Class.MMatrixBase (+    -- * The MMatrix type class+    MMatrix(..),++    -- * Getting rows and columns+    getRow,+    getCol,+    getRows',+    getCols',+    +    -- * Matrix and vector multiplication+    getApply,+    getSApply,+    +    getApplyMat,+    getSApplyMat,++    -- * In-place multiplication+    doApply,+    doSApplyAdd,+    doApply_,+    doSApply_,+    +    doApplyMat,+    doSApplyAddMat,+    doApplyMat_,+    doSApplyMat_,++    -- * Unsafe operations+    unsafeGetApply,+    unsafeDoApply,+    unsafeDoApply_,++    unsafeGetApplyMat,+    unsafeDoApplyMat,+    unsafeDoApplyMat_,++    -- * Utility functions+    getRowsM,+    getRowsIO,+    getRowsST,+    getColsM,+    getColsIO,+    getColsST,++    ) where++import BLAS.Internal( checkSquare, checkMatVecMult, checkMatVecMultAdd,+    checkMatMatMult, checkMatMatMultAdd, checkedRow, checkedCol )+import Data.Matrix.Class+import Data.Tensor.Class++import Data.Vector.Dense.Class+import Data.Matrix.Dense.Base+++-- | Get the given row in a matrix.+getRow :: (MMatrix a e m, WriteVector x e m) => a (k,l) e -> Int -> m (x l e)+getRow a = checkedRow (shape a) (unsafeGetRow a)+{-# INLINE getRow #-}++-- | Get the given column in a matrix.+getCol :: (MMatrix a e m, WriteVector x e m) => a (k,l) e -> Int -> m (x k e)+getCol a = checkedCol (shape a) (unsafeGetCol a)+{-# INLINE getCol #-}++-- | Get a strict list the row vectors in the matrix.+getRows' :: (MMatrix a e m, WriteVector x e m) => a (k,l) e -> m [x l e]+getRows' a = mapM (unsafeGetRow a) [0..numRows a - 1]+{-# INLINE getRows' #-}++-- | Get a strict list of the column vectors in the matrix.+getCols' :: (MMatrix a e m, WriteVector x e m) => a (k,l) e -> m [x k e]+getCols' a = mapM (unsafeGetCol a) [0..numCols a - 1]+{-# INLINE getCols' #-}++-- | Scale and apply to a vector+getSApply :: (MMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    e -> a (k,l) e -> x l e -> m (y k e)+getSApply k a x =+    checkMatVecMult (shape a) (dim x) $ +        unsafeGetSApply k a x+{-# INLINE getSApply #-}++-- | Scale and apply to a matrix+getSApplyMat :: (MMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    e -> a (r,s) e -> b (s,t) e -> m (c (r,t) e)+getSApplyMat k a b =+    checkMatMatMult (shape a) (shape b) $+        unsafeGetSApplyMat k a b+{-# INLINE getSApplyMat #-}++-- | @y := alpha a x + beta y@    +doSApplyAdd :: (MMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    e -> a (k,l) e -> x l e -> e -> y k e -> m ()+doSApplyAdd alpha a x beta y =+    checkMatVecMultAdd (shape a) (dim x) (dim y) $+        unsafeDoSApplyAdd alpha a x beta y+{-# INLINE doSApplyAdd #-}++-- | @c := alpha a b + beta c@+doSApplyAddMat :: (MMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    e -> a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()+doSApplyAddMat alpha a b beta c =+    checkMatMatMultAdd (shape a) (shape b) (shape c)+        unsafeDoSApplyAddMat alpha a b beta c+{-# INLINE doSApplyAddMat #-}++-- | Apply to a vector+getApply :: (MMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    a (k,l) e -> x l e -> m (y k e)+getApply a x =+    checkMatVecMult (shape a) (dim x) $ do+        unsafeGetApply a x+{-# INLINE getApply #-}++-- | Apply to a matrix+getApplyMat :: (MMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (r,s) e -> b (s,t) e -> m (c (r,t) e)+getApplyMat a b =+    checkMatMatMult (shape a) (shape b) $+        unsafeGetApplyMat a b+{-# INLINE getApplyMat #-}++-- | @ x := alpha a x@        +doSApply_ :: (MMatrix a e m, WriteVector y e m) =>+    e -> a (n,n) e -> y n e -> m ()+doSApply_ alpha a x =+    checkSquare ("doSApply_ " ++ show alpha) (shape a) $+        checkMatVecMult (shape a) (dim x) $+            unsafeDoSApply_ alpha a x+{-# INLINE doSApply_ #-}++-- | @ b := alpha a b@+doSApplyMat_ :: (MMatrix a e m, WriteMatrix b e m) =>+    e -> a (s,s) e -> b (s,t) e -> m ()+doSApplyMat_ alpha a b =+    checkSquare ("doSApplyMat_ " ++ show alpha) (shape a) $+        checkMatMatMult (shape a) (shape b) $+            unsafeDoSApplyMat_ alpha a b+{-# INLINE doSApplyMat_ #-}++unsafeGetApply :: (MMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    a (k,l) e -> x l e -> m (y k e)+unsafeGetApply = unsafeGetSApply 1+{-# INLINE unsafeGetApply #-}++unsafeGetApplyMat :: (MMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (r,s) e -> b (s,t) e -> m (c (r,t) e)+unsafeGetApplyMat = unsafeGetSApplyMat 1+{-# INLINE unsafeGetApplyMat #-}++-- | Apply to a vector and store the result in another vector+doApply :: (MMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    a (k,l) e -> x l e -> y k e -> m ()+doApply a x y =+    checkMatVecMultAdd (numRows a, numCols a) (dim x) (dim y) $+        unsafeDoApply a x y+{-# INLINE doApply #-}++-- | Apply to a matrix and store the result in another matrix+doApplyMat :: (MMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (r,s) e -> b (s,t) e -> c (r,t) e -> m ()+doApplyMat a b c =+    checkMatMatMultAdd (shape a) (shape b) (shape c) $+        unsafeDoApplyMat a b c+{-# INLINE doApplyMat #-}++unsafeDoApply :: (MMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    a (k,l) e -> x l e -> y k e -> m ()+unsafeDoApply a x y = unsafeDoSApplyAdd 1 a x 0 y+{-# INLINE unsafeDoApply #-}++unsafeDoApplyMat :: (MMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (r,s) e -> b (s,t) e -> c (r,t) e -> m ()+unsafeDoApplyMat a b c = unsafeDoSApplyAddMat 1 a b 0 c+{-# INLINE unsafeDoApplyMat #-}++-- | @x := a x@    +doApply_ :: (MMatrix a e m, WriteVector y e m) =>+    a (n,n) e -> y n e -> m ()+doApply_ a x =+    checkSquare "doApply_" (shape a) $+        checkMatVecMult (shape a) (dim x) $+            unsafeDoApply_ a x+{-# INLINE doApply_ #-}++-- | @ b := a b@+doApplyMat_ :: (MMatrix a e m, WriteMatrix b e m) =>+    a (s,s) e -> b (s,t) e -> m ()+doApplyMat_ a b =+    checkSquare "doApplyMat_" (shape a) $+        checkMatMatMult (shape a) (shape b) $+            unsafeDoApplyMat_ a b+{-# INLINE doApplyMat_ #-}+  +unsafeDoApply_ :: (MMatrix a e m, WriteVector y e m) => +    a (n,n) e -> y n e -> m ()+unsafeDoApply_ a x =+    unsafeDoSApply_ 1 a x+{-# INLINE unsafeDoApply_ #-}++unsafeDoApplyMat_ :: (MMatrix a e m, WriteMatrix b e m) =>+    a (s,s) e -> b (s,t) e -> m ()+unsafeDoApplyMat_ a b = +    unsafeDoSApplyMat_ 1 a b+{-# INLINE unsafeDoApplyMat_ #-}
+ lib/Data/Matrix/Class/MSolve.hs view
@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class.MSolve+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface for solving matrix systems in a monad.  The+-- matrices can operate via inverse multiplication on immutable dense+-- vectors and matrices.+--++module Data.Matrix.Class.MSolve (+    -- * The MSolve type class+    MSolve,++    -- * Solving linear systems+    getSolve,+    getSolveMat,+    getSSolve,+    getSSolveMat,+    +    -- * In-place operations+    doSolve,+    doSolveMat,+    doSSolve,+    doSSolveMat,+    doSolve_,+    doSolveMat_,+    doSSolve_,+    doSSolveMat_,++    ) where++import Data.Matrix.Class.MSolveBase
+ lib/Data/Matrix/Class/MSolveBase.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Class.MSolveBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface for solving matrix systems in a monad.  The+-- matrices can operate via inverse multiplication on immutable dense+-- vectors and matrices.+--++module Data.Matrix.Class.MSolveBase (+    -- * The MSolve type class+    MSolve(..),++    -- * Solving linear systems+    getSolve,+    getSolveMat,+    getSSolve,+    getSSolveMat,+    +    -- * In-place operations+    doSolve,+    doSolveMat,+    doSSolve,+    doSSolveMat,+    doSolve_,+    doSolveMat_,+    doSSolve_,+    doSSolveMat_,+    +    -- * Unsafe operations+    unsafeGetSolve,+    unsafeGetSolveMat,+    unsafeGetSSolve,+    unsafeGetSSolveMat,++    ) where++import Data.Matrix.Class+import Data.Tensor.Class+import BLAS.Internal ( checkMatVecSolv, checkMatMatSolv, checkMatVecSolvTo,+    checkMatMatSolvTo, checkSquare )++import Data.Vector.Dense.Class+import Data.Matrix.Dense.Base+++unsafeGetSolve :: (MSolve a e m, ReadVector y e m, WriteVector x e m) => +    a (k,l) e -> y k e -> m (x l e)+unsafeGetSolve a y = do+    x <- newVector_ (numCols a)+    unsafeDoSolve a y x+    return x+{-# INLINE unsafeGetSolve #-}+    +unsafeGetSSolve :: (MSolve a e m, ReadVector y e m, WriteVector x e m) => +    e -> a (k,l) e -> y k e -> m (x l e)+unsafeGetSSolve alpha a y = do+    x <- newVector_ (numCols a)+    unsafeDoSSolve alpha a y x+    return x+{-# INLINE unsafeGetSSolve #-}+    +unsafeGetSolveMat :: (MSolve a e m, ReadMatrix c e m, WriteMatrix b e m) => +    a (r,s) e -> c (r,t) e -> m (b (s,t) e)+unsafeGetSolveMat a c = do+    b <- newMatrix_ (numCols a, numCols c)+    unsafeDoSolveMat a c b+    return b+{-# INLINE unsafeGetSolveMat #-}++unsafeGetSSolveMat :: (MSolve a e m, ReadMatrix c e m, WriteMatrix b e m) => +    e -> a (r,s) e -> c (r,t) e -> m (b (s,t) e)                         +unsafeGetSSolveMat alpha a c = do+    b <- newMatrix_ (numCols a, numCols c)+    unsafeDoSSolveMat alpha a c b+    return b+{-# INLINE unsafeGetSSolveMat #-}++-- | Return @x@ such that @a x = y@.+getSolve :: (MSolve a e m, ReadVector y e m, WriteVector x e m) =>+    a (k,l) e -> y k e -> m (x l e)+getSolve a y = +    checkMatVecSolv (shape a) (dim y) $+        unsafeGetSolve a y+{-# INLINE getSolve #-}++-- | Return @x@ such that @a x = alpha y@.    +getSSolve :: (MSolve a e m, ReadVector y e m, WriteVector x e m) => +    e -> a (k,l) e -> y k e -> m (x l e)+getSSolve alpha a y = +    checkMatVecSolv (shape a) (dim y) $+        unsafeGetSSolve alpha a y+{-# INLINE getSSolve #-}++-- | Return @b@ such that @a b = c@.+getSolveMat :: (MSolve a e m, ReadMatrix c e m, WriteMatrix b e m) => +    a (r,s) e -> c (r,t) e -> m (b (s,t) e)                     +getSolveMat a c =+    checkMatMatSolv (shape a) (shape c) $+            unsafeGetSolveMat a c+{-# INLINE getSolveMat #-}+            +-- | Return @b@ such that @a b = alpha c@.+getSSolveMat :: (MSolve a e m, ReadMatrix c e m, WriteMatrix b e m) => +    e -> a (r,s) e -> c (r,t) e -> m (b (s,t) e)                 +getSSolveMat alpha a b =+    checkMatMatSolv (shape a) (shape b) $+            unsafeGetSSolveMat alpha a b+{-# INLINE getSSolveMat #-}++-- | Set @x := a^{-1} y@.+doSolve :: (MSolve a e m, ReadVector y e m, WriteVector x e m) => +    a (r,s) e -> y r e -> x s e -> m ()                 +doSolve a y x =+    checkMatVecSolvTo (shape a) (dim y) (dim x) $+        unsafeDoSolve a y x+{-# INLINE doSolve #-}+        +-- | Set @b := a^{-1} c@.+doSolveMat :: (MSolve a e m, ReadMatrix c e m, WriteMatrix b e m) => +    a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()                +doSolveMat a c b =+    checkMatMatSolvTo (shape a) (shape c) (shape b) $+        unsafeDoSolveMat a c b+{-# INLINE doSolveMat #-}+    +-- | Set @x := a^{-1} (alpha y)@.    +doSSolve :: (MSolve a e m, ReadVector y e m, WriteVector x e m) => +    e -> a (k,l) e -> y k e -> x l e -> m ()+doSSolve alpha a y x =+    checkMatVecSolvTo (shape a) (dim y) (dim x) $+        unsafeDoSSolve alpha a y x+{-# INLINE doSSolve #-}++-- | Set @b := a^{-1} (alpha c)@.+doSSolveMat :: (MSolve a e m, ReadMatrix c e m, WriteMatrix b e m) => +    e -> a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()                  +doSSolveMat alpha a c b =+    checkMatMatSolvTo (shape a) (shape c) (shape b) $+        unsafeDoSSolveMat alpha a c b+{-# INLINE doSSolveMat #-}++-- | Set @x := a^{-1} x@.+doSolve_ :: (MSolve a e m, ReadVector y e m, WriteVector x e m) => +    a (k,k) e -> x k e -> m ()+doSolve_ a x =+    checkSquare "doSolve_" (shape a) $+        checkMatVecSolv (shape a) (dim x) $+            unsafeDoSolve_ a x+{-# INLINE doSolve_ #-}++-- | Set @x := a^{-1} (alpha x)@.+doSSolve_ :: (MSolve a e m, WriteVector x e m) => +    e -> a (k,k) e -> x k e -> m ()+doSSolve_ alpha a x =+    checkSquare ("doSSolve_ " ++ show alpha) (shape a) $+        checkMatVecSolv (shape a) (dim x) $+            unsafeDoSSolve_ alpha a x+{-# INLINE doSSolve_ #-}++-- | Set @b := a^{-1} b@.+doSolveMat_ :: (MSolve a e m, WriteMatrix b e m) => +    a (k,k) e -> b (k,l) e -> m ()          +doSolveMat_ a b =+    checkSquare "doSolveMat_" (shape a) $+        checkMatMatSolv (shape a) (shape b) $+            unsafeDoSolveMat_ a b+{-# INLINE doSolveMat_ #-}++-- | Set @b := a^{-1} (alpha b)@.+doSSolveMat_ :: (MSolve a e m, WriteMatrix b e m) =>+    e -> a (k,k) e -> b (k,l) e -> m ()          +doSSolveMat_ alpha a b =+    checkSquare ("doSSolveMat_ " ++ show alpha) (shape a) $+        checkMatMatSolv (shape a) (shape b) $+            unsafeDoSSolveMat_ alpha a b+{-# INLINE doSSolveMat_ #-}
+ lib/Data/Matrix/Dense.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Dense+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Immutable dense matrices.+--++module Data.Matrix.Dense (+    -- * Dense matrix type+    Matrix,++    -- * Overloaded interface for dense matrices+    BaseMatrix( isHermMatrix, coerceMatrix ),++    -- * Overloaded interface for matrices+    module Data.Matrix.Class,+    module Data.Matrix.Class.IMatrix,    +    +    -- * Creating matrices+    matrix, +    listMatrix,+    rowsMatrix,+    colsMatrix,+    +    -- * Special matrices+    zeroMatrix,+    constantMatrix,+    identityMatrix,++    -- * Conversions between vectors and matrices+    matrixFromRow,+    matrixFromCol,+    matrixFromVector,+    vectorFromMatrix,++    -- * Matrix views+    submatrix,+    splitRowsAt,+    splitColsAt,+    +    -- * Vector views+    diag,++    -- * Overloaded interface for reading matrix elements+    module Data.Tensor.Class,+    module Data.Tensor.Class.ITensor,++    ) where++import Data.Matrix.Dense.Base++import Data.Matrix.Class+import Data.Matrix.Class.IMatrix+    +import Data.Tensor.Class+import Data.Tensor.Class.ITensor
+ lib/Data/Matrix/Dense/Base.hs view
@@ -0,0 +1,1799 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances,+        TypeFamilies, Rank2Types, ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Dense.Base+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Matrix.Dense.Base+    where++import Control.Monad+import Control.Monad.ST+import Data.AEq+import Foreign+import System.IO.Unsafe+import Unsafe.Coerce++import BLAS.Internal( checkBinaryOp, checkedSubmatrix, checkedDiag,+    checkedRow, checkedCol, inlinePerformIO )++import Data.Elem.BLAS( Elem, BLAS1, BLAS3, conjugate )+import qualified Data.Elem.BLAS.Level1 as BLAS+import qualified Data.Elem.BLAS.Level2 as BLAS+import qualified Data.Elem.BLAS.Level3 as BLAS++import Data.Tensor.Class+import Data.Tensor.Class.ITensor+import Data.Tensor.Class.MTensor++import Data.Matrix.Class+import Data.Matrix.Herm+import Data.Matrix.TriBase++import Data.Vector.Dense.IOBase+import Data.Vector.Dense.Base++import Data.Matrix.Dense.IOBase++-- | Immutable dense matrices.  The type arguments are as follows:+--+--     * @np@: a phantom type for the shape of the matrix.  Most functions+--       will demand that this be specified as a pair.  When writing a function+--       signature, you should always prefer @Matrix (n,p) e@ to+--       @Matrix np e@.+--+--     * @e@: the element type of the matrix.  Only certain element types+--       are supported.+--+newtype Matrix np e = Matrix (IOMatrix np e)++freezeIOMatrix :: (BLAS1 e) => IOMatrix np e -> IO (Matrix np e)+freezeIOMatrix x = do+    y <- newCopyIOMatrix x+    return (Matrix y)++thawIOMatrix :: (BLAS1 e) => Matrix np e -> IO (IOMatrix np e)+thawIOMatrix (Matrix x) =+    newCopyIOMatrix x++unsafeFreezeIOMatrix :: IOMatrix np e -> IO (Matrix np e)+unsafeFreezeIOMatrix = return . Matrix++unsafeThawIOMatrix :: Matrix np e -> IO (IOMatrix np e)+unsafeThawIOMatrix (Matrix x) = return x++-- | Common functionality for all dense matrix types.+class (HasVectorView a, Elem e, MatrixShaped a+      , BaseVector (VectorView a) e) => BaseMatrix a e where+          +    ldaMatrix :: a (n,p) e -> Int+    isHermMatrix :: a (n,p) e -> Bool++    -- | Cast the shape type of the matrix.+    coerceMatrix :: a np e -> a np' e+    coerceMatrix = unsafeCoerce+    {-# INLINE coerceMatrix #-}++    unsafeSubmatrixView :: a (n,p) e -> (Int,Int) -> (Int,Int) -> a (n',p') e+    unsafeDiagView :: a (n,p) e -> Int -> VectorView a k e+    unsafeRowView :: a (n,p) e -> Int -> VectorView a p e+    unsafeColView :: a (n,p) e -> Int -> VectorView a n e++    -- | Possibly create a vector view of a matrix.  This will fail if the+    -- matrix is hermed or if the lda of the matrix is not equal to the+    -- number of rows in the matrix.+    maybeViewMatrixAsVector :: a (n,p) e -> Maybe (VectorView a np e)+    +    -- | Possibly create a matrix view of a row vector.  This will fail if+    -- the stride of the vector is not @1@ or the vector is conjugated.+    maybeViewVectorAsRow  :: VectorView a p e -> Maybe (a (one,p) e)+    +    -- | Possibly create a matrix view of a column vector.  This will fail+    -- if the stride of the vector is not @1@ or the vector is not conjugated.+    maybeViewVectorAsCol  :: VectorView a n e -> Maybe (a (n,one) e)+    +    -- | Possible create a matrix view of the vector.  This will fail if+    -- the stride of the vector is not @1@ or the vector is conjugated.+    -- An error will be called if the vector does not have the same number+    -- of elements as the desired matrix.+    maybeViewVectorAsMatrix :: (Int,Int) +                            -> VectorView a np e +                            -> Maybe (a (n,p) e)+    +    -- | Unsafe cast from a matrix to an 'IOMatrix'.+    unsafeMatrixToIOMatrix :: a (n,p) e -> IOMatrix (n,p) e+    unsafeIOMatrixToMatrix :: IOMatrix (n,p) e -> a (n,p) e+++-- | Dense matrices that can be read in a monad.+class (BaseMatrix a e, BLAS3 e, ReadTensor a (Int,Int) e m+      , MMatrix a e m, MMatrix (Herm a) e m, MMatrix (Tri a) e m+      , MSolve (Tri a) e m+      , ReadVector (VectorView a) e m) => ReadMatrix a e m where++    -- | Cast the matrix to an 'IOMatrix', perform an @IO@ action, and+    -- convert the @IO@ action to an action in the monad @m@.  This+    -- operation is /very/ unsafe.+    unsafePerformIOWithMatrix :: a (n,p) e -> (IOMatrix (n,p) e -> IO r) -> m r++    -- | Convert a mutable matrix to an immutable one by taking a complete+    -- copy of it.+    freezeMatrix :: a (n,p) e -> m (Matrix (n,p) e)+    unsafeFreezeMatrix :: a (n,p) e -> m (Matrix (n,p) e)++-- | Dense matrices that can be created or modified in a monad.+class (ReadMatrix a e m, WriteTensor a (Int,Int) e m+      , WriteVector (VectorView a) e m) =>+    WriteMatrix a e m where++    -- | Creates a new matrix of the given shape.  The elements will be +    -- uninitialized.+    newMatrix_ :: (Int,Int) -> m (a (n,p) e)++    -- | Unsafely convert an 'IO' action that creates an 'IOMatrix' into+    -- an action in @m@ that creates a matrix.+    unsafeConvertIOMatrix :: IO (IOMatrix (n,p) e) -> m (a (n,p) e)++    -- | Convert an immutable matrix to a mutable one by taking a complete+    -- copy of it.+    thawMatrix :: Matrix (n,p) e -> m (a (n,p) e)+    unsafeThawMatrix :: Matrix (n,p) e -> m (a (n,p) e)++-- | Creates a new matrix with the given association list.  Unspecified+-- indices will get initialized to zero.+newMatrix :: (WriteMatrix a e m) =>+    (Int,Int) -> [((Int,Int), e)] -> m (a (n,p) e)+newMatrix (m,n) ies = unsafeConvertIOMatrix $ do+    a <- newZeroMatrix (m,n)+    withIOMatrix a $ \p ->+        forM_ ies $ \((i,j),e) -> do+            when (i < 0 || i >= m || j < 0 || j >= n) $ fail $+                "Index `" ++ show (i,j) ++ +                    "' is invalid for a matrix with shape `" ++ show (m,n) +++                    "'"+            pokeElemOff p (i+j*m) e+    return a+{-# INLINE newMatrix #-}+    +unsafeNewMatrix :: (WriteMatrix a e m) =>+    (Int,Int) -> [((Int,Int), e)] -> m (a (n,p) e)+unsafeNewMatrix (m,n) ies = unsafeConvertIOMatrix $ do+    a <- newZeroMatrix (m,n)+    withIOMatrix a $ \p ->+        forM_ ies $ \((i,j),e) -> do+            pokeElemOff p (i+j*m) e+    return a+{-# INLINE unsafeNewMatrix #-}++-- | Create a new matrix with the given elements in column-major order.+newListMatrix :: (WriteMatrix a e m) => (Int,Int) -> [e] -> m (a (n,p) e)+newListMatrix (m,n) es = do+    a <- newZeroMatrix (m,n)+    unsafePerformIOWithMatrix a $ \a' -> do+        withIOMatrix a' $ flip pokeArray (take (m*n) es)+        return a+{-# INLINE newListMatrix #-}++-- | Form a matrix from a list of column vectors.+newColsMatrix :: (ReadVector x e m, WriteMatrix a e m) =>+    (Int,Int) -> [x n e] -> m (a (n,p) e)+newColsMatrix (m,n) cs = do+    a <- newZeroMatrix (m,n)+    forM_ (zip [0..(n-1)] cs) $ \(j,c) ->+        unsafeCopyVector (unsafeColView a j) c+    return a+{-# INLINE newColsMatrix #-}++-- | Form a matrix from a list of row vectors.+newRowsMatrix :: (ReadVector x e m, WriteMatrix a e m) =>+    (Int,Int) -> [x p e] -> m (a (n,p) e)+newRowsMatrix (m,n) rs = do+    a <- newZeroMatrix (m,n)+    forM_ (zip [0..(m-1)] rs) $ \(i,r) ->+        unsafeCopyVector (unsafeRowView a i) r+    return a+{-# INLINE newRowsMatrix #-}++-- | Create a new matrix from a column vector.+newColMatrix :: (ReadVector x e m, WriteMatrix a e m) =>+    x n e -> m (a (n,one) e)+newColMatrix x = newColsMatrix (dim x,1) [x]+{-# INLINE newColMatrix #-}++-- | Create a new matrix from a row vector.+newRowMatrix :: (ReadVector x e m, WriteMatrix a e m) =>+    x p e -> m (a (one,p) e)+newRowMatrix x = newRowsMatrix (1,dim x) [x]+{-# INLINE newRowMatrix #-}++-- | Create a zero matrix of the specified shape.+newZeroMatrix :: (WriteMatrix a e m) => (Int,Int) -> m (a (n,p) e)+newZeroMatrix mn = do+    a <- newMatrix_ mn+    setZeroMatrix a+    return a+{-# INLINE newZeroMatrix #-}++-- | Set every element in the matrix to zero.+setZeroMatrix :: (WriteMatrix a e m) => a (n,p) e -> m ()+setZeroMatrix a =+    unsafePerformIOWithMatrix a $ setZeroIOMatrix+{-# INLINE setZeroMatrix #-}++-- | Create a constant matrix of the specified shape.+newConstantMatrix :: (WriteMatrix a e m) => (Int,Int) -> e -> m (a (n,p) e)+newConstantMatrix mn e = do+    a <- newMatrix_ mn+    setConstantMatrix e a+    return a+{-# INLINE newConstantMatrix #-}++-- | Set every element in the matrix to the given constant.+setConstantMatrix :: (WriteMatrix a e m) => e -> a (n,p) e -> m ()+setConstantMatrix e a =+    unsafePerformIOWithMatrix a $ setConstantIOMatrix e+{-# INLINE setConstantMatrix #-}++-- | Create a new matrix of the given shape with ones along the diagonal, +-- and zeros everywhere else.+newIdentityMatrix :: (WriteMatrix a e m) => (Int,Int) -> m (a (n,p) e)+newIdentityMatrix mn = do+    a <- newMatrix_ mn+    setIdentityMatrix a+    return a+{-# INLINE newIdentityMatrix #-}++-- | Set diagonal elements to one and all other elements to zero.+setIdentityMatrix :: (WriteMatrix a e m) => a (n,p) e -> m ()+setIdentityMatrix a = do+    setZeroMatrix a+    setConstantVector 1 (unsafeDiagView a 0)+{-# INLINE setIdentityMatrix #-}++-- | Get a copy of a matrix.+newCopyMatrix :: (ReadMatrix a e m, WriteMatrix b e m) =>+    a (n,p) e -> m (b (n,p) e)+newCopyMatrix a | isHermMatrix a = liftM herm $ newCopyMatrix (herm a)+                | otherwise      = do+    b <- newMatrix_ (shape a)+    unsafeCopyMatrix b a+    return b+{-# INLINE newCopyMatrix #-}++-- | Get a copy of a matrix and make sure the returned matrix is not+-- a view.  Specififially, the returned matrix will have @isHermMatrix@+-- equal to @False@.+newCopyMatrix' :: (ReadMatrix a e m, WriteMatrix b e m) =>+    a (n,p) e -> m (b (n,p) e)+newCopyMatrix' a = do+    b <- newMatrix_ (shape a)+    unsafeCopyMatrix b a+    return b+{-# INLINE newCopyMatrix' #-}++-- | @copyMatrix dst src@ replaces the values in @dst@ with those in+-- source.  The operands must be the same shape.+copyMatrix :: (WriteMatrix b e m, ReadMatrix a e m) => +    b (n,p) e -> a (n,p) e -> m ()+copyMatrix b a = checkBinaryOp (shape b) (shape a) $ unsafeCopyMatrix b a+{-# INLINE copyMatrix #-}++unsafeCopyMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()+unsafeCopyMatrix = liftMatrix2 unsafeCopyVector+{-# INLINE unsafeCopyMatrix #-}++-- | @swapMatrix x y@ swaps the values stored in two matrices.+swapMatrix :: (WriteMatrix a e m, WriteMatrix b e m) =>+    a (n,p) e -> b (n,p) e -> m ()+swapMatrix a b = checkBinaryOp (shape b) (shape a) $ unsafeSwapMatrix a b+{-# INLINE swapMatrix #-}++unsafeSwapMatrix :: (WriteMatrix a e m, WriteMatrix b e m) =>+    a (n,p) e -> b (n,p) e -> m ()+unsafeSwapMatrix = liftMatrix2 unsafeSwapVector+{-# INLINE unsafeSwapMatrix #-}++-- | Swap the elements in two rows of a matrix.+swapRows :: (WriteMatrix a e m) => a (n,p) e -> Int -> Int -> m ()+swapRows a i j = +    when (i /= j) $ unsafeSwapVector (rowView a i) (rowView a j)+{-# INLINE swapRows #-}++-- | Swap the elements in two columns of a matrix.+swapCols :: (WriteMatrix a e m) => a (n,p) e -> Int -> Int -> m ()+swapCols a i j = +    when (i /= j) $ unsafeSwapVector (colView a i) (colView a j)+{-# INLINE swapCols #-}++unsafeSwapRows :: (WriteMatrix a e m) => a (n,p) e -> Int -> Int -> m ()+unsafeSwapRows a i j = +    when (i /= j) $ unsafeSwapVector (unsafeRowView a i) (unsafeRowView a j)+{-# INLINE unsafeSwapRows #-}++unsafeSwapCols :: (WriteMatrix a e m) => a (n,p) e -> Int -> Int -> m ()+unsafeSwapCols a i j = +    when (i /= j) $ unsafeSwapVector (unsafeColView a i) (unsafeColView a j)+{-# INLINE unsafeSwapCols #-}++-- | @submatrixView a ij mn@ returns a view of the submatrix of @a@ with element @(0,0)@+-- being element @ij@ in @a@, and having shape @mn@.+submatrixView :: (BaseMatrix a e) => a (n,p) e -> (Int,Int) -> (Int,Int) -> a (n',p') e+submatrixView a = checkedSubmatrix (shape a) (unsafeSubmatrixView a)+{-# INLINE submatrixView #-}++-- | Divide the rows of a matrix into two blocks and return views into the+-- blocks.  The integer argument indicates how many rows should be in the+-- first block.+splitRowsAt :: (BaseMatrix a e) =>+    Int -> a (n,p) e -> (a (n1,p) e, a (n2,p) e)+splitRowsAt m1 a = ( submatrixView a (0,0)  (m1,n)+                   , submatrixView a (m1,0) (m2,n)+                   )+  where +    (m,n) = shape a+    m2    = m - m1+{-# INLINE splitRowsAt #-}++unsafeSplitRowsAt :: (BaseMatrix a e) =>+    Int -> a (n,p) e -> (a (n1,p) e, a (n2,p) e)+unsafeSplitRowsAt m1 a = ( unsafeSubmatrixView a (0,0)  (m1,n)+                         , unsafeSubmatrixView a (m1,0) (m2,n)+                         )+  where +    (m,n) = shape a+    m2    = m - m1+{-# INLINE unsafeSplitRowsAt #-}++-- | Divide the columns of a matrix into two blocks and return views into the+-- blocks.  The integer argument indicates how many columns should be in the+-- first block.+splitColsAt :: (BaseMatrix a e) =>+    Int -> a (n,p) e -> (a (n,p1) e, a (n,p2) e)+splitColsAt n1 a = ( submatrixView a (0,0)  (m,n1)+                   , submatrixView a (0,n1) (m,n2)+                   )+  where+    (m,n) = shape a+    n2    = n - n1+{-# INLINE splitColsAt #-}++unsafeSplitColsAt :: (BaseMatrix a e) =>+    Int -> a (n,p) e -> (a (n,p1) e, a (n,p2) e)+unsafeSplitColsAt n1 a = ( unsafeSubmatrixView a (0,0)  (m,n1)+                         , unsafeSubmatrixView a (0,n1) (m,n2)+                         )+  where+    (m,n) = shape a+    n2    = n - n1+{-# INLINE unsafeSplitColsAt #-}++-- | Get a list of vector views of the rows of the matrix.+rowViews :: (BaseMatrix a e) => a (n,p) e -> [VectorView a p e]+rowViews a = [ unsafeRowView a i | i <- [0..numRows a - 1] ]+{-# INLINE rowViews #-}++-- | Get a list of vector views of the columns of the matrix.+colViews :: (BaseMatrix a e) => a (n,p) e -> [VectorView a n e]+colViews a = [ unsafeColView a j | j <- [0..numCols a - 1] ]+{-# INLINE colViews #-}++-- | Get a vector view of the given row in a matrix.+rowView :: (BaseMatrix a e) => a (n,p) e -> Int -> VectorView a p e+rowView a = checkedRow (shape a) (unsafeRowView a)+{-# INLINE rowView #-}++unsafeGetRowMatrix :: (ReadMatrix a e m, WriteVector y e m) =>+    a (n,p) e -> Int -> m (y p e)+unsafeGetRowMatrix a i = newCopyVector (unsafeRowView a i)+{-# INLINE unsafeGetRowMatrix #-}++-- | Get a vector view of the given column in a matrix.+colView :: (BaseMatrix a e) => a (n,p) e -> Int -> VectorView a n e+colView a = checkedCol (shape a) (unsafeColView a)+{-# INLINE colView #-}++unsafeGetColMatrix :: (ReadMatrix a e m, WriteVector y e m) =>+    a (n,p) e -> Int -> m (y n e)+unsafeGetColMatrix a j = newCopyVector (unsafeColView a j)+{-# INLINE unsafeGetColMatrix #-}++-- | Get a vector view of the given diagonal in a matrix.+diagView :: (BaseMatrix a e) => a (n,p) e -> Int -> VectorView a k e+diagView a = checkedDiag (shape a) (unsafeDiagView a)+{-# INLINE diagView #-}++-- | Get the given diagonal in a matrix.  Negative indices correspond+-- to sub-diagonals.+getDiag :: (ReadMatrix a e m, WriteVector y e m) => +    a (n,p) e -> Int -> m (y k e)+getDiag a = checkedDiag (shape a) (unsafeGetDiag a)+{-# INLINE getDiag #-}++-- | Same as 'getDiag' but not range-checked.+unsafeGetDiag :: (ReadMatrix a e m, WriteVector y e m) => +    a (n,p) e -> Int -> m (y k e)+unsafeGetDiag a i = newCopyVector (unsafeDiagView a i)+{-# INLINE unsafeGetDiag #-}++-- | Conjugate every element of a matrix.+doConjMatrix :: (WriteMatrix a e m) => a (n,p) e -> m ()+doConjMatrix = liftMatrix doConjVector+{-# INLINE doConjMatrix #-}++-- | Get a new matrix with elements with the conjugates of the elements+-- of the given matrix.+getConjMatrix :: (ReadMatrix a e m, WriteMatrix b e m) =>+    a (n,p) e -> m (b (n,p) e)+getConjMatrix = getUnaryMatrixOp doConjMatrix+{-# INLINE getConjMatrix #-}++-- | Scale every element of a matrix by the given value.+scaleByMatrix :: (WriteMatrix a e m) => e -> a (n,p) e -> m ()+scaleByMatrix k = liftMatrix (scaleByVector k)+{-# INLINE scaleByMatrix #-}++-- | Get a new matrix by scaling the elements of another matrix+-- by a given value.+getScaledMatrix :: (ReadMatrix a e m, WriteMatrix b e m) =>+    e -> a (n,p) e -> m (b (n,p) e)+getScaledMatrix e = getUnaryMatrixOp (scaleByMatrix e)+{-# INLINE getScaledMatrix #-}++-- | Add a constant to every element in a matrix.+shiftByMatrix :: (WriteMatrix a e m) => e -> a (n,p) e -> m ()+shiftByMatrix k = liftMatrix (shiftByVector k)+{-# INLINE shiftByMatrix #-}++-- | Get a new matrix by shifting the elements of another matrix+-- by a given value.+getShiftedMatrix :: (ReadMatrix a e m, WriteMatrix b e m) =>+    e -> a (n,p) e -> m (b (n,p) e)+getShiftedMatrix e = getUnaryMatrixOp (shiftByMatrix e)+{-# INLINE getShiftedMatrix #-}++-- | Replace the first argument with the elementwise sum.+addMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()+addMatrix b a = +    checkBinaryOp (shape b) (shape a) $ unsafeAddMatrix b a+{-# INLINE addMatrix #-}++unsafeAddMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()+unsafeAddMatrix b a = unsafeAxpyMatrix 1 a b+{-# INLINE unsafeAddMatrix #-}++-- | @getAddMatrix a b@ creates a new matrix equal to the sum @a+b@.  The +-- operands must have the same shape.+getAddMatrix :: +    (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (n,p) e -> b (n,p) e -> m (c (n,p) e)+getAddMatrix = checkMatrixOp2 unsafeGetAddMatrix+{-# INLINE getAddMatrix #-}++unsafeGetAddMatrix :: +    (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (n,p) e -> b (n,p) e -> m (c (n,p) e)+unsafeGetAddMatrix = unsafeGetBinaryMatrixOp unsafeAddMatrix+{-# INLINE unsafeGetAddMatrix #-}++-- | Replace the first argument with the elementwise sum.+subMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()    +subMatrix b a = +    checkBinaryOp (shape b) (shape a) $ unsafeSubMatrix b a+{-# INLINE subMatrix #-}++unsafeSubMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()+unsafeSubMatrix b a = unsafeAxpyMatrix (-1) a b+{-# INLINE unsafeSubMatrix #-}++-- | @getSubMatrix a b@ creates a new matrix equal to the difference @a-b@.  The +-- operands must have the same shape.+getSubMatrix :: +    (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (n,p) e -> b (n,p) e -> m (c (n,p) e)+getSubMatrix = checkMatrixOp2 unsafeGetSubMatrix+{-# INLINE getSubMatrix #-}++unsafeGetSubMatrix :: +    (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (n,p) e -> b (n,p) e -> m (c (n,p) e)+unsafeGetSubMatrix = unsafeGetBinaryMatrixOp unsafeSubMatrix+{-# INLINE unsafeGetSubMatrix #-}++-- | @axpyMatrix a x y@ replaces @y := a x + y@.+axpyMatrix :: (ReadMatrix a e m, WriteMatrix b e m) =>+    e -> a (n,p) e -> b (n,p) e -> m ()+axpyMatrix alpha x y = +    checkBinaryOp (shape x) (shape y) $ unsafeAxpyMatrix alpha x y+{-# INLINE axpyMatrix #-}++unsafeAxpyMatrix :: (ReadMatrix a e m, WriteMatrix b e m) =>+    e -> a (n,p) e -> b (n,p) e -> m ()+unsafeAxpyMatrix alpha = liftMatrix2 (unsafeAxpyVector alpha)+{-# INLINE unsafeAxpyMatrix #-}++-- | Replace the first argument with the elementwise product.+mulMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()    +mulMatrix b a = +    checkBinaryOp (shape b) (shape a) $ unsafeMulMatrix b a+{-# INLINE mulMatrix #-}++unsafeMulMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()+unsafeMulMatrix = liftMatrix2 unsafeMulVector+{-# INLINE unsafeMulMatrix #-}++-- | @getMulMatrix a b@ creates a new matrix equal to the elementwise product +-- @a*b@.  The operands must have the same shape.+getMulMatrix :: +    (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (n,p) e -> b (n,p) e -> m (c (n,p) e)+getMulMatrix = checkMatrixOp2 unsafeGetMulMatrix+{-# INLINE getMulMatrix #-}++unsafeGetMulMatrix :: +    (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (n,p) e -> b (n,p) e -> m (c (n,p) e)+unsafeGetMulMatrix = unsafeGetBinaryMatrixOp unsafeMulMatrix+{-# INLINE unsafeGetMulMatrix #-}++-- | Replace the first argument with the elementwise quotient.+divMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()    +divMatrix b a = +    checkBinaryOp (shape b) (shape a) $ unsafeDivMatrix b a+{-# INLINE divMatrix #-}++unsafeDivMatrix :: (WriteMatrix b e m, ReadMatrix a e m) =>+    b (n,p) e -> a (n,p) e -> m ()+unsafeDivMatrix = liftMatrix2 unsafeDivVector+{-# INLINE unsafeDivMatrix #-}++-- | @getDivMatrix a b@ creates a new matrix equal to the elementwise ratio+-- @a/b@.  The operands must have the same shape.+getDivMatrix :: +    (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (n,p) e -> b (n,p) e -> m (c (n,p) e)+getDivMatrix = checkMatrixOp2 unsafeGetDivMatrix+{-# INLINE getDivMatrix #-}++unsafeGetDivMatrix :: +    (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    a (n,p) e -> b (n,p) e -> m (c (n,p) e)+unsafeGetDivMatrix = unsafeGetBinaryMatrixOp unsafeDivMatrix+{-# INLINE unsafeGetDivMatrix #-}++-------------------------------- MMatrix ----------------------------------++-- | A type class for mutable matrices associated with a monad.  The member+-- functions of the type class do not perform any checks on the validity of+-- shapes or indices, so in general their safe counterparts should be+-- preferred.+class (MatrixShaped a, BLAS3 e, Monad m) => MMatrix a e m where+    unsafeGetSApply :: (ReadVector x e m, WriteVector y e m) =>+        e -> a (k,l) e -> x l e -> m (y k e)+    unsafeGetSApply alpha a x = do+        y <- newVector_ (numRows a)+        unsafeDoSApplyAdd alpha a x 0 y+        return y+    {-# INLINE unsafeGetSApply #-}++    unsafeGetSApplyMat :: (ReadMatrix b e m, WriteMatrix c e m) =>+        e -> a (r,s) e -> b (s,t) e -> m (c (r,t) e)+    unsafeGetSApplyMat alpha a b = do+        c <- newMatrix_ (numRows a, numCols b)+        unsafeDoSApplyAddMat alpha a b 0 c+        return c+    {-# INLINE unsafeGetSApplyMat #-}++    unsafeDoSApplyAdd :: (ReadVector x e m, WriteVector y e m) =>+        e -> a (k,l) e -> x l e -> e -> y k e -> m ()+    unsafeDoSApplyAdd alpha a x beta (y :: y k e) = do+        (y' :: y k e) <- unsafeGetSApply alpha a x+        scaleByVector beta y+        unsafeAxpyVector 1 y' y+    {-# INLINE unsafeDoSApplyAdd #-}++    unsafeDoSApplyAddMat :: (ReadMatrix b e m, WriteMatrix c e m) =>+        e -> a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()+    unsafeDoSApplyAddMat alpha a b beta (c :: c (r,t) e) = do+        (c' :: c (r,t) e) <- unsafeGetSApplyMat alpha a b+        scaleByMatrix beta c+        unsafeAxpyMatrix 1 c' c+    {-# INLINE unsafeDoSApplyAddMat #-}++    unsafeDoSApply_ :: (WriteVector y e m) =>+        e -> a (n,n) e -> y n e -> m ()+    unsafeDoSApply_ alpha a (x :: y n e) = do+        (y :: y n e) <- newVector_ (dim x)+        unsafeDoSApplyAdd alpha a x 0 y+        unsafeCopyVector x y+    {-# INLINE unsafeDoSApply_ #-}++    unsafeDoSApplyMat_ :: (WriteMatrix b e m) =>+        e -> a (k,k) e -> b (k,l) e -> m ()+    unsafeDoSApplyMat_ alpha a (b :: b (k,l) e) = do+        (c :: b (k,l) e) <- newMatrix_ (shape b)+        unsafeDoSApplyAddMat alpha a b 0 c+        unsafeCopyMatrix b c+    {-# INLINE unsafeDoSApplyMat_ #-}++    unsafeGetRow :: (WriteVector x e m) => a (k,l) e -> Int -> m (x l e)+    unsafeGetRow (a :: a (k,l) e) i =+        let unsafeGetRowHelp :: (WriteVector x e m) => x l e -> m (x l e)+            unsafeGetRowHelp (_ :: x l e) = do+                (e :: x k e) <- newBasisVector (numRows a) i+                liftM conj $ unsafeGetSApply 1 (herm a) e+        in unsafeGetRowHelp undefined+    {-# INLINE unsafeGetRow #-}        +        +    unsafeGetCol :: (WriteVector x e m) => a (k,l) e -> Int -> m (x k e)+    unsafeGetCol (a :: a (k,l) e) j =+        let unsafeGetColHelp :: (WriteVector x e m) => x k e -> m (x k e)+            unsafeGetColHelp (_ :: x k e) = do+                (e :: x l e) <- newBasisVector (numCols a) j+                unsafeGetSApply 1 a e+        in unsafeGetColHelp undefined+    {-# INLINE unsafeGetCol #-}++    -- | Get a lazy list the row vectors in the matrix.+    getRows :: (WriteVector x e m) => +        a (k,l) e -> m [x l e]+    {-# INLINE getRows #-}++    -- | Get a lazy list of the column vectors in the matrix.+    getCols :: (WriteVector x e m) => +        a (k,l) e -> m [x k e]++getColsM :: (MMatrix a e m, WriteVector x e m)+          => (forall b. m b -> m b)+          -> a (k,l) e -> m [x k e]+getColsM unsafeInterleaveM a =+    let n    = numCols a+        go j | j == n    = return []+             | otherwise = unsafeInterleaveM $ do+                               c  <- unsafeGetCol a j+                               cs <- go (j+1)+                               return (c:cs)+    in go 0+{-# INLINE getColsM #-}++getColsIO :: (MMatrix a e IO, WriteVector x e IO)+          => a (k,l) e -> IO [x k e]+getColsIO = getColsM unsafeInterleaveIO++getColsST :: (MMatrix a e (ST s), WriteVector x e (ST s))+          => a (k,l) e -> ST s [x k e]+getColsST = getColsM unsafeInterleaveST++getRowsM :: (MMatrix a e m, WriteVector x e m)+         => (forall b. m b -> m b)+         -> a (k,l) e -> m [x l e]+getRowsM unsafeInterleaveM a =+    let m    = numRows a+        go i | i == m    = return []+             | otherwise = unsafeInterleaveM $ do+                                r  <- unsafeGetRow a i+                                rs <- go (i+1)+                                return (r:rs)+    in go 0+{-# INLINE getRowsM #-}++getRowsIO :: (MMatrix a e IO, WriteVector x e IO)+          => a (k,l) e -> IO [x l e]+getRowsIO = getRowsM unsafeInterleaveIO++getRowsST :: (MMatrix a e (ST s), WriteVector x e (ST s))+          => a (k,l) e -> ST s [x l e]+getRowsST = getRowsM unsafeInterleaveST+++-- | @gemv alpha a x beta y@ replaces @y := alpha a * x + beta y@.+gemv :: (ReadMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    e -> a (k,l) e -> x l e -> e -> y k e -> m ()+gemv alpha a x beta y+    | numRows a == 0 || numCols a == 0 =+        scaleByVector beta y+        +    | isConj y && (isConj x || stride x == 1) =+        let transA = if isConj x then NoTrans else ConjTrans+            transB = transMatrix (herm a)+            m      = 1+            n      = dim y+            k      = dim x+            ldA    = stride x+            ldB    = ldaMatrix a+            ldC    = stride y+            alpha' = conjugate alpha+            beta'  = conjugate beta+            x'     = unsafeVectorToIOVector x+            y'     = unsafeVectorToIOVector y+        in +            withMatrixPtr a $ \pB ->+            withIOVector x' $ \pA ->+            withIOVector y' $ \pC ->+                BLAS.gemm transA transB m n k alpha' pA ldA pB ldB beta' pC ldC+    +    | (isConj y && otherwise) || isConj x = do+        doConjVector y+        gemv alpha a x beta (conj y)+        doConjVector y+        +    | otherwise =+        let transA = transMatrix a+            (m,n)  = case (isHermMatrix a) of+                         False -> shape a+                         True  -> (flipShape . shape) a+            ldA    = ldaMatrix a+            incX   = stride x+            incY   = stride y+            x'     = unsafeVectorToIOVector x+            y'     = unsafeVectorToIOVector y+        in +            withMatrixPtr a   $ \pA ->+            withIOVector x' $ \pX ->+            withIOVector y' $ \pY -> do+                BLAS.gemv transA m n alpha pA ldA pX incX beta pY incY+  where +    withMatrixPtr d f = unsafePerformIOWithMatrix d $ flip withIOMatrix f+++-- | @gemm alpha a b beta c@ replaces @c := alpha a * b + beta c@.+gemm :: (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    e -> a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()+gemm alpha a b beta c+    | numRows a == 0 || numCols a == 0 || numCols b == 0 = +        scaleByMatrix beta c+    | isHermMatrix c = gemm (conjugate alpha) (herm b) (herm a) (conjugate beta) (herm c)+    | otherwise =+        let transA = transMatrix a+            transB = transMatrix b+            (m,n)  = shape c+            k      = numCols a+            ldA    = ldaMatrix a+            ldB    = ldaMatrix b+            ldC    = ldaMatrix c+        in +            withMatrixPtr   a $ \pA ->+            withIOMatrix (unsafeMatrixToIOMatrix b) $ \pB ->+            withIOMatrix (unsafeMatrixToIOMatrix c) $ \pC ->+                BLAS.gemm transA transB m n k alpha pA ldA pB ldB beta pC ldC+  where +    withMatrixPtr d f = unsafePerformIOWithMatrix d $ flip withIOMatrix f+++hemv :: (ReadMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    e -> Herm a (k,k) e -> x k e -> e -> y k e -> m ()+hemv alpha h (x :: x k e) beta (y :: y k e)+    | numRows h == 0 =+        return ()+    | isConj y = do+        doConjVector y+        hemv alpha h x beta (conj y)+        doConjVector y+    | isConj x = do+        (x' :: y k e) <- newCopyVector' x+        hemv alpha h x' beta y+    | otherwise =+        let (u,a) = hermToBase h+            n     = numCols a+            u'    = case isHermMatrix a of+                        True  -> flipUpLo u+                        False -> u+            uploA = u'+            ldA   = ldaMatrix a+            incX  = stride x+            incY  = stride y+            x'    = unsafeVectorToIOVector x+            y'    = unsafeVectorToIOVector y+        in +            withMatrixPtr a   $ \pA ->+            withIOVector x' $ \pX ->+            withIOVector y' $ \pY ->+                BLAS.hemv uploA n alpha pA ldA pX incX beta pY incY+  where +    withMatrixPtr d f = unsafePerformIOWithMatrix d $ flip withIOMatrix f++hemm :: (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    e -> Herm a (k,k) e -> b (k,l) e -> e -> c (k,l) e -> m ()+hemm alpha h b beta c+    | numRows b == 0 || numCols b == 0 || numCols c == 0 = return ()+    | (isHermMatrix a) /= (isHermMatrix c) || (isHermMatrix a) /= (isHermMatrix b) =+        zipWithM_ (\x y -> hemv alpha h x beta y) (colViews b) (colViews c)+    | otherwise =+        let (m,n)   = shape c+            (side,u',m',n')+                    = if isHermMatrix a+                          then (RightSide, flipUpLo u, n, m)+                          else (LeftSide,  u,          m, n)+            uploA   = u'+            ldA     = ldaMatrix a+            ldB     = ldaMatrix b+            ldC     = ldaMatrix c+        in +            withMatrixPtr   a $ \pA ->+            withIOMatrix (unsafeMatrixToIOMatrix b) $ \pB ->+            withIOMatrix (unsafeMatrixToIOMatrix c) $ \pC ->+                BLAS.hemm side uploA m' n' alpha pA ldA pB ldB beta pC ldC+    where+      withMatrixPtr d f = unsafePerformIOWithMatrix d $ flip withIOMatrix f+      (u,a) = hermToBase h++hemv' :: (ReadMatrix a e m, ReadVector x e m, WriteVector y e m) =>+    e -> Herm a (r,s) e -> x s e -> e -> y r e -> m ()+hemv' alpha a x beta y = +    hemv alpha (coerceHerm a) x beta (coerceVector y)++hemm' :: (ReadMatrix a e m, ReadMatrix b e m, WriteMatrix c e m) =>+    e -> Herm a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()+hemm' alpha a b beta c = +    hemm alpha (coerceHerm a) b beta (coerceMatrix c)++unsafeDoSApplyAddTriMatrix :: (ReadMatrix a e m, MMatrix a e m, +    ReadVector x e m, WriteVector y e m) =>+        e -> Tri a (k,l) e -> x l e -> e -> y k e -> m ()+unsafeDoSApplyAddTriMatrix alpha t x beta (y :: y k e) =+    if beta == 0+        then unsafeDoSApplyTriMatrix alpha t x y+        else do+            (y' :: y k e) <- newCopyVector y+            unsafeDoSApplyTriMatrix alpha t x y'+            scaleByVector beta y+            unsafeAxpyVector 1 y' y++unsafeDoSApplyAddMatTriMatrix :: (ReadMatrix a e m,+    ReadMatrix b e m, WriteMatrix c e m) =>+        e -> Tri a (r,s) e -> b (s,t) e -> e -> c (r,t) e -> m ()+unsafeDoSApplyAddMatTriMatrix alpha t b beta (c :: c (r,t) e) =+    if beta == 0+        then unsafeDoSApplyMatTriMatrix alpha t b c+        else do+            (c' :: c (r,t) e) <- newCopyMatrix c+            unsafeDoSApplyMatTriMatrix alpha t b c'+            scaleByMatrix beta c+            unsafeAxpyMatrix 1 c' c++unsafeDoSApplyTriMatrix :: (ReadMatrix a e m, MMatrix a e m, +    ReadVector x e m, WriteVector y e m) =>+        e -> Tri a (k,l) e -> x l e -> y k e -> m ()+unsafeDoSApplyTriMatrix alpha t x y =+    case (u, toLower d a, toUpper d a) of+        (Lower,Left t',_) -> do+            unsafeCopyVector y (coerceVector x)+            trmv alpha t' y+            +        (Lower,Right (t',r),_) -> do+            let y1 = unsafeSubvectorView y 0            (numRows t')+                y2 = unsafeSubvectorView y (numRows t') (numRows r)+            unsafeCopyVector y1 x+            trmv alpha t' y1+            unsafeDoSApplyAdd alpha r x 0 y2+            +        (Upper,_,Left t') -> do+            unsafeCopyVector (coerceVector y) x+            trmv alpha t' (coerceVector y)++        (Upper,_,Right (t',r)) ->+            let x1 = unsafeSubvectorView x 0            (numCols t')+                x2 = unsafeSubvectorView x (numCols t') (numCols r)+            in do+                unsafeCopyVector y x1+                trmv alpha t' y+                unsafeDoSApplyAdd alpha r x2 1 y+  where+    (u,d,a) = triToBase t++unsafeDoSApplyMatTriMatrix :: (ReadMatrix a e m,+    ReadMatrix b e m, WriteMatrix c e m) =>+        e -> Tri a (r,s) e -> b (s,t) e -> c (r,t) e -> m ()+unsafeDoSApplyMatTriMatrix alpha t b c =+    case (u, toLower d a, toUpper d a) of+        (Lower,Left t',_) -> do+            unsafeCopyMatrix c (coerceMatrix b)+            trmm alpha t' c+            +        (Lower,Right (t',r),_) -> do+            let c1 = unsafeSubmatrixView c (0,0)          (numRows t',numCols c)+                c2 = unsafeSubmatrixView c (numRows t',0) (numRows r ,numCols c)+            unsafeCopyMatrix c1 b+            trmm alpha t' c1+            unsafeDoSApplyAddMat alpha r b 0 c2+            +        (Upper,_,Left t') -> do+            unsafeCopyMatrix (coerceMatrix c) b+            trmm alpha t' (coerceMatrix c)++        (Upper,_,Right (t',r)) ->+            let b1 = unsafeSubmatrixView b (0,0)          (numCols t',numCols b)+                b2 = unsafeSubmatrixView b (numCols t',0) (numCols r ,numCols b)+            in do+                unsafeCopyMatrix c b1+                trmm alpha t' c+                unsafeDoSApplyAddMat alpha r b2 1 c+  where+    (u,d,a) = triToBase t+++toLower :: (BaseMatrix a e) => DiagEnum -> a (m,n) e +        -> Either (Tri a (m,m) e) +                  (Tri a (n,n) e, a (k,n) e)+toLower d a =+    if m <= n+        then Left $  triFromBase Lower d (unsafeSubmatrixView a (0,0) (m,m))+        else let t = triFromBase Lower d (unsafeSubmatrixView a (0,0) (n,n))+                 r = unsafeSubmatrixView a (n,0) (k,n)+             in Right (t,r)+  where+    (m,n) = shape a+    k     = m - n+    +toUpper :: (BaseMatrix a e) => DiagEnum -> a (m,n) e+        -> Either (Tri a (n,n) e)+                  (Tri a (m,m) e, a (m,k) e)+toUpper d a =+    if n <= m+        then Left $  triFromBase Upper d (unsafeSubmatrixView a (0,0) (n,n))+        else let t = triFromBase Upper d (unsafeSubmatrixView a (0,0) (m,m))+                 r = unsafeSubmatrixView a (0,m) (m,k)+             in Right (t,r)+  where+    (m,n) = shape a+    k     = n - m++trmv :: (ReadMatrix a e m, WriteVector y e m) =>+    e -> Tri a (k,k) e -> y n e -> m ()+trmv alpha t x +    | dim x == 0 = +        return ()+        +    | isConj x =+        let (u,d,a) = triToBase t+            side    = RightSide+            (h,u')  = if isHermMatrix a then (NoTrans  , flipUpLo u) +                                        else (ConjTrans, u)+            uploA   = u'+            transA  = h+            diagA   = d+            m       = 1+            n       = dim x+            alpha'  = conjugate alpha+            ldA     = ldaMatrix a+            ldB     = stride x+        in +            withMatrixPtr   a $ \pA ->+            withVectorPtrIO x $ \pB ->+                BLAS.trmm side uploA transA diagA m n alpha' pA ldA pB ldB++    | otherwise =+        let (u,d,a)   = triToBase t+            (transA,u') = if isHermMatrix a then (ConjTrans, flipUpLo u) +                                            else (NoTrans  , u)+            uploA     = u'+            diagA     = d+            n         = dim x+            ldA       = ldaMatrix a+            incX      = stride x+        in do+            when (alpha /= 1) $ scaleByVector alpha x+            withMatrixPtr a   $ \pA ->+                withVectorPtrIO x $ \pX -> do+                   BLAS.trmv uploA transA diagA n pA ldA pX incX+  where +    withMatrixPtr d f = unsafePerformIOWithMatrix d $ flip withIOMatrix f+    withVectorPtrIO = withIOVector . unsafeVectorToIOVector+++trmm :: (ReadMatrix a e m, WriteMatrix b e m) =>+    e -> Tri a (k,k) e -> b (k,l) e -> m ()+trmm _ _ b+    | numRows b == 0 || numCols b == 0 = return ()+trmm alpha t b =+    let (u,d,a)   = triToBase t+        (h,u')    = if isHermMatrix a then (ConjTrans, flipUpLo u) else (NoTrans, u)+        (m,n)     = shape b+        (side,h',m',n',alpha')+                  = if isHermMatrix b+                        then (RightSide, flipTrans h, n, m, conjugate alpha)+                        else (LeftSide , h          , m, n, alpha       )+        uploA     = u'+        transA    = h'+        diagA     = d+        ldA       = ldaMatrix a+        ldB       = ldaMatrix b+    in  +        withMatrixPtr   a $ \pA ->+        withIOMatrix (unsafeMatrixToIOMatrix b) $ \pB ->+            BLAS.trmm side uploA transA diagA m' n' alpha' pA ldA pB ldB+  where +    withMatrixPtr d f = unsafePerformIOWithMatrix d $ flip withIOMatrix f+  +unsafeDoSSolveTriMatrix :: (ReadMatrix a e m,+    ReadVector y e m, WriteVector x e m) =>+        e -> Tri a (k,l) e -> y k e -> x l e -> m ()+unsafeDoSSolveTriMatrix alpha t y x =+    case (u, toLower d a, toUpper d a) of+        (Lower,Left t',_) -> do+            unsafeCopyVector x (coerceVector y)+            trsv alpha t' (coerceVector x)+            +        (Lower,Right (t',_),_) -> do+            let y1 = unsafeSubvectorView y 0            (numRows t')+            unsafeCopyVector x y1+            trsv alpha t' x+            +        (Upper,_,Left t') -> do+            unsafeCopyVector x (coerceVector y)+            trsv alpha t' x++        (Upper,_,Right (t',r)) ->+            let x1 = unsafeSubvectorView x 0            (numCols t')+                x2 = unsafeSubvectorView x (numCols t') (numCols r)+            in do+                unsafeCopyVector x1 y+                trsv alpha t' x1+                setZeroVector x2+  where+    (u,d,a) = triToBase t+++unsafeDoSSolveMatTriMatrix :: (ReadMatrix a e m,+    ReadMatrix c e m, WriteMatrix b e m) =>+        e -> Tri a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()+unsafeDoSSolveMatTriMatrix alpha t c b =+    case (u, toLower d a, toUpper d a) of+        (Lower,Left t',_) -> do+            unsafeCopyMatrix b (coerceMatrix c)+            trsm alpha t' (coerceMatrix b)+            +        (Lower,Right (t',_),_) -> do+            let c1 = unsafeSubmatrixView c (0,0)          (numRows t',numCols c)+            unsafeCopyMatrix b c1+            trsm alpha t' b+            +        (Upper,_,Left t') -> do+            unsafeCopyMatrix (coerceMatrix b) c+            trsm alpha t' (coerceMatrix b)++        (Upper,_,Right (t',r)) ->+            let b1 = unsafeSubmatrixView b (0,0)          (numCols t',numCols b)+                b2 = unsafeSubmatrixView b (numCols t',0) (numCols r ,numCols b)+            in do+                unsafeCopyMatrix b1 c+                trsm alpha t' b1+                setZeroMatrix b2+  where+    (u,d,a) = triToBase t+++trsv :: (ReadMatrix a e m, WriteVector y e m) =>+    e -> Tri a (k,k) e -> y n e -> m ()+trsv alpha t x+    | dim x == 0 = return ()++    | isConj x =+        let (u,d,a) = triToBase t+            side    = RightSide+            (h,u')  = if isHermMatrix a then (NoTrans, flipUpLo u) else (ConjTrans, u)+            uploA   = u'+            transA  = h+            diagA   = d+            m       = 1+            n       = dim x+            alpha'  = conjugate alpha+            ldA     = ldaMatrix a+            ldB     = stride x+        in +            withMatrixPtr   a $ \pA ->+            withVectorPtrIO x $ \pB ->+                BLAS.trsm side uploA transA diagA m n alpha' pA ldA pB ldB++    | otherwise =+        let (u,d,a) = triToBase t+            (transA,u') = if isHermMatrix a then (ConjTrans, flipUpLo u) +                                            else (NoTrans  , u)+            uploA     = u'+            diagA     = d+            n         = dim x+            ldA       = ldaMatrix a+            incX      = stride x+        in do+            when (alpha /= 1) $ scaleByVector alpha x+            withMatrixPtr   a $ \pA ->+                withVectorPtrIO x $ \pX ->+                    BLAS.trsv uploA transA diagA n pA ldA pX incX+  where +    withVectorPtrIO = withIOVector . unsafeVectorToIOVector+    withMatrixPtr d f = unsafePerformIOWithMatrix d $ flip withIOMatrix f++trsm :: (ReadMatrix a e m, WriteMatrix b e m) =>+    e -> Tri a (k,k) e -> b (k,l) e -> m ()+trsm _ _ b+    | numRows b == 0 || numCols b == 0 = return ()+trsm alpha t b =+    let (u,d,a)   = triToBase t+        (h,u')    = if isHermMatrix a then (ConjTrans, flipUpLo u) else (NoTrans, u)+        (m,n)     = shape b+        (side,h',m',n',alpha')+                  = if isHermMatrix b+                        then (RightSide, flipTrans h, n, m, conjugate alpha)+                        else (LeftSide , h          , m, n, alpha     )+        uploA     = u'+        transA    = h'+        diagA     = d+        ldA       = ldaMatrix a+        ldB       = ldaMatrix b+    in +        withMatrixPtr   a $ \pA ->+        withIOMatrix (unsafeMatrixToIOMatrix b) $ \pB -> do+            BLAS.trsm side uploA transA diagA m' n' alpha' pA ldA pB ldB+  where +    withMatrixPtr d f = unsafePerformIOWithMatrix d $ flip withIOMatrix f++------------------------------------ MSolve ------------------------------++-- | A type class for mutable matrices with inverses.  The member+-- functions of the type class do not perform any checks on the validity+-- of shapes or indices, so in general their safe counterparts should be+-- preferred.+class (MatrixShaped a, BLAS3 e, Monad m) => MSolve a e m where+    unsafeDoSolve :: (ReadVector y e m, WriteVector x e m) =>+        a (k,l) e -> y k e -> x l e -> m ()+    unsafeDoSolve = unsafeDoSSolve 1+    {-# INLINE unsafeDoSolve #-}+    +    unsafeDoSolveMat :: (ReadMatrix c e m, WriteMatrix b e m) =>+        a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()+    unsafeDoSolveMat = unsafeDoSSolveMat 1+    {-# INLINE unsafeDoSolveMat #-}    +    +    unsafeDoSSolve :: (ReadVector y e m, WriteVector x e m) =>+        e -> a (k,l) e -> y k e -> x l e -> m ()+    unsafeDoSSolve alpha a y x = do+        unsafeDoSolve a y x+        scaleByVector alpha x+    {-# INLINE unsafeDoSSolve #-}        +    +    unsafeDoSSolveMat :: (ReadMatrix c e m, WriteMatrix b e m) =>+        e -> a (r,s) e -> c (r,t) e -> b (s,t) e -> m ()+    unsafeDoSSolveMat alpha a c b = do+        unsafeDoSolveMat a c b+        scaleByMatrix alpha b+    {-# INLINE unsafeDoSSolveMat #-}++    unsafeDoSolve_ :: (WriteVector x e m) => a (k,k) e -> x k e -> m ()+    unsafeDoSolve_ = unsafeDoSSolve_ 1+    {-# INLINE unsafeDoSolve_ #-}++    unsafeDoSSolve_ :: (WriteVector x e m) => e -> a (k,k) e -> x k e -> m ()+    unsafeDoSSolve_ alpha a x = do+        scaleByVector alpha x+        unsafeDoSolve_ a x+    {-# INLINE unsafeDoSSolve_ #-}        +        +    unsafeDoSolveMat_ :: (WriteMatrix b e m) => a (k,k) e -> b (k,l) e -> m ()+    unsafeDoSolveMat_ = unsafeDoSSolveMat_ 1+    {-# INLINE unsafeDoSolveMat_ #-}+        +    unsafeDoSSolveMat_ :: (WriteMatrix b e m) => e -> a (k,k) e -> b (k,l) e -> m ()+    unsafeDoSSolveMat_ alpha a b = do+        scaleByMatrix alpha b+        unsafeDoSolveMat_ a b+    {-# INLINE unsafeDoSSolveMat_ #-}++------------------------------------ Instances ------------------------------+++instance (Elem e) => BaseMatrix IOMatrix e where+    ldaMatrix = ldaMatrixIOMatrix+    {-# INLINE ldaMatrix #-}+    isHermMatrix = isHermIOMatrix+    {-# INLINE isHermMatrix #-}+    unsafeSubmatrixView = unsafeSubmatrixViewIOMatrix+    {-# INLINE unsafeSubmatrixView #-}+    unsafeDiagView = unsafeDiagViewIOMatrix+    {-# INLINE unsafeDiagView #-}+    unsafeRowView = unsafeRowViewIOMatrix+    {-# INLINE unsafeRowView #-}+    unsafeColView = unsafeColViewIOMatrix+    {-# INLINE unsafeColView #-}+    maybeViewMatrixAsVector = maybeViewIOMatrixAsVector+    {-# INLINE maybeViewMatrixAsVector #-}+    maybeViewVectorAsMatrix = maybeViewVectorAsIOMatrix+    {-# INLINE maybeViewVectorAsMatrix #-}+    maybeViewVectorAsRow = maybeViewVectorAsRowIOMatrix+    {-# INLINE maybeViewVectorAsRow #-}    +    maybeViewVectorAsCol = maybeViewVectorAsColIOMatrix+    {-# INLINE maybeViewVectorAsCol #-}+    unsafeIOMatrixToMatrix = id+    {-# INLINE unsafeIOMatrixToMatrix #-}+    unsafeMatrixToIOMatrix = id+    {-# INLINE unsafeMatrixToIOMatrix #-}++instance (BLAS3 e) => MMatrix IOMatrix e IO where+    unsafeDoSApplyAdd = gemv+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = gemm+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeGetRow = unsafeGetRowMatrix+    {-# INLINE unsafeGetRow #-}+    unsafeGetCol = unsafeGetColMatrix+    {-# INLINE unsafeGetCol #-}+    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Herm IOMatrix) e IO where+    unsafeDoSApplyAdd = hemv'+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = hemm'+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Tri IOMatrix) e IO where+    unsafeDoSApplyAdd = unsafeDoSApplyAddTriMatrix+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatTriMatrix+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeDoSApply_ = trmv+    {-# INLINE unsafeDoSApply_ #-}+    unsafeDoSApplyMat_ = trmm+    {-# INLINE unsafeDoSApplyMat_ #-}+    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MSolve  (Tri IOMatrix) e IO where+    unsafeDoSSolve = unsafeDoSSolveTriMatrix+    {-# INLINE unsafeDoSSolve #-}+    unsafeDoSSolveMat = unsafeDoSSolveMatTriMatrix+    {-# INLINE unsafeDoSSolveMat #-}    +    unsafeDoSSolve_ = trsv+    {-# INLINE unsafeDoSSolve_ #-}+    unsafeDoSSolveMat_ = trsm+    {-# INLINE unsafeDoSSolveMat_ #-}++instance (BLAS3 e) => ReadMatrix IOMatrix e IO where+    unsafePerformIOWithMatrix a f = f a+    {-# INLINE unsafePerformIOWithMatrix #-}+    freezeMatrix = freezeIOMatrix+    {-# INLINE freezeMatrix #-}+    unsafeFreezeMatrix = unsafeFreezeIOMatrix+    {-# INLINE unsafeFreezeMatrix #-}++instance (BLAS3 e) => WriteMatrix IOMatrix e IO where+    newMatrix_ = newIOMatrix_+    {-# INLINE newMatrix_ #-}+    unsafeConvertIOMatrix = id+    {-# INLINE unsafeConvertIOMatrix #-}+    thawMatrix = thawIOMatrix+    {-# INLINE thawMatrix #-}+    unsafeThawMatrix = unsafeThawIOMatrix+    {-# INLINE unsafeThawMatrix #-}++-- | Create a new matrix of the given size and initialize the given elements to+-- the given values.  All other elements get set to zero.+matrix :: (BLAS3 e) => (Int,Int) -> [((Int,Int), e)] -> Matrix (n,p) e+matrix mn ies = unsafePerformIO $+    unsafeFreezeIOMatrix =<< newMatrix mn ies+{-# NOINLINE matrix #-}++-- | Same as 'matrix' but does not do any bounds checking.+unsafeMatrix :: (BLAS3 e) => (Int,Int) -> [((Int,Int), e)] -> Matrix (n,p) e+unsafeMatrix mn ies =  unsafePerformIO $ +    unsafeFreezeIOMatrix =<< unsafeNewMatrix mn ies+{-# NOINLINE unsafeMatrix #-}++-- | Create a new matrix with the given elements in row-major order.+listMatrix :: (BLAS3 e) => (Int,Int) -> [e] -> Matrix (n,p) e+listMatrix mn es = unsafePerformIO $ +    unsafeFreezeIOMatrix =<< newListMatrix mn es+{-# NOINLINE listMatrix #-}++replaceMatrix :: (BLAS1 e) => Matrix np e -> [((Int,Int),e)] -> Matrix np e+replaceMatrix (Matrix a) ies =+    unsafePerformIO $ do+        b <- newCopyIOMatrix a+        mapM_ (uncurry $ writeElem b) ies+        return (Matrix b)+{-# NOINLINE replaceMatrix #-}++unsafeReplaceMatrix :: (BLAS1 e) => Matrix np e -> [((Int,Int),e)] -> Matrix np e+unsafeReplaceMatrix (Matrix a) ies =+    unsafePerformIO $ do+        b <- newCopyIOMatrix a+        mapM_ (uncurry $ unsafeWriteElem b) ies+        return (Matrix b)+{-# NOINLINE unsafeReplaceMatrix #-}++-- | Create a matrix of the given shape from a list of rows+rowsMatrix :: (BLAS3 e) => (Int,Int) -> [Vector p e] -> Matrix (n,p) e+rowsMatrix mn rs = unsafePerformIO $ +    unsafeFreezeIOMatrix =<< newRowsMatrix mn rs+{-# NOINLINE rowsMatrix #-}++-- | Create a matrix of the given shape from a list of columns+colsMatrix :: (BLAS3 e) => (Int,Int) -> [Vector n e] -> Matrix (n,p) e+colsMatrix mn cs = unsafePerformIO $ +    unsafeFreezeIOMatrix =<< newColsMatrix mn cs+{-# NOINLINE colsMatrix #-}++-- | Get a matrix from a row vector.+matrixFromRow :: (BLAS3 e) => Vector p e -> Matrix (one,p) e+matrixFromRow (Vector x) = +    case maybeViewVectorAsRow x of+        Just x' -> Matrix x'+        Nothing -> unsafePerformIO $ unsafeFreezeIOMatrix =<< newRowMatrix x+{-# NOINLINE matrixFromRow #-}++-- | Get a matrix from a column vector.+matrixFromCol :: (BLAS3 e) => Vector n e -> Matrix (n,one) e+matrixFromCol (Vector x) = +    case maybeViewVectorAsCol x of+        Just x' -> Matrix x'+        Nothing -> unsafePerformIO $ unsafeFreezeIOMatrix =<< newColMatrix x+{-# NOINLINE matrixFromCol #-}++-- | Get a matrix from the elements stored in columnwise order in the vector.+matrixFromVector :: (BLAS3 e) => (Int,Int) -> Vector np e -> Matrix (n,p) e+matrixFromVector (m,n) x+    | dim x /= m*n =+        error $ "matrixFromVector " ++ show (m,n) ++ "<vector of dim "+              ++ show (dim x) ++ ">: vector dimension must be equal to "+              ++ "the number of elements in the desired matrix"+    | otherwise =+        case maybeViewVectorAsMatrix (m,n) x of+            Just a  -> a+            Nothing -> listMatrix (m,n) (elems x)++-- | Get a vector by concatenating the columns of the matrix.+vectorFromMatrix :: (BLAS3 e) => Matrix (n,p) e -> Vector np e+vectorFromMatrix a =+    case maybeViewMatrixAsVector a of+        Just x  -> x+        Nothing -> listVector (size a) (concatMap elems (colViews a))++-- | Get a new zero of the given shape.+zeroMatrix :: (BLAS3 e) => (Int,Int) -> Matrix (n,p) e+zeroMatrix mn = unsafePerformIO $+    unsafeFreezeIOMatrix =<< newZeroMatrix mn+{-# NOINLINE zeroMatrix #-}++-- | Get a new constant of the given shape.+constantMatrix :: (BLAS3 e) => (Int,Int) -> e -> Matrix (n,p) e+constantMatrix mn e = unsafePerformIO $+    unsafeFreezeIOMatrix =<< newConstantMatrix mn e+{-# NOINLINE constantMatrix #-}++-- | Get a new matrix of the given shape with ones along the diagonal and+-- zeroes everywhere else.+identityMatrix :: (BLAS3 e) => (Int,Int) -> Matrix (n,p) e+identityMatrix mn = unsafePerformIO $+    unsafeFreezeIOMatrix =<< newIdentityMatrix mn+{-# NOINLINE identityMatrix #-}++-- | @submatrix a ij mn@ returns the submatrix of @a@ with element @(0,0)@+-- being element @ij@ in @a@, and having shape @mn@.+submatrix :: (Elem e) => Matrix (n,p) e -> (Int,Int) -> (Int,Int) -> Matrix (n',p') e+submatrix (Matrix a) ij mn = +    Matrix $ submatrixView a ij mn+{-# INLINE submatrix #-}++unsafeSubmatrix :: (Elem e) => Matrix (n,p) e -> (Int,Int) -> (Int,Int) -> Matrix (n',p') e+unsafeSubmatrix (Matrix a) ij mn = +    Matrix $ unsafeSubmatrixView a ij mn+{-# INLINE unsafeSubmatrix #-}++-- | Get a the given diagonal in a matrix.  Negative indices correspond to+-- sub-diagonals.+diag :: (Elem e) => Matrix (n,p) e -> Int -> Vector k e+diag (Matrix a) i = Vector (diagView a i)+{-# INLINE diag #-}++-- | Same as 'diag' but index is not range-checked.+unsafeDiag :: (Elem e) => Matrix (n,p) e -> Int -> Vector k e+unsafeDiag (Matrix a) i = Vector (diagView a i)+{-# INLINE unsafeDiag #-}++unsafeAtMatrix :: (Elem e) => Matrix np e -> (Int,Int) -> e+unsafeAtMatrix (Matrix (IOMatrix f p _ _ l h)) (i,j)+    | h = inlinePerformIO $ do+        e  <- liftM conjugate $ peekElemOff p (i*l+j)+        io <- touchForeignPtr f+        e `seq` io `seq` return e+    | otherwise = inlinePerformIO $ do+        e  <- peekElemOff p (i+j*l)+        io <- touchForeignPtr f+        e `seq` io `seq` return e+{-# INLINE unsafeAtMatrix #-}++indicesMatrix :: Matrix np e -> [(Int,Int)]+indicesMatrix (Matrix a) = indicesIOMatrix a+{-# INLINE indicesMatrix #-}++elemsMatrix :: (Elem e) => Matrix np e -> [e]+elemsMatrix (Matrix a) = +    case maybeViewIOMatrixAsVector a of+        (Just x) -> elemsVector (Vector x)+        Nothing  -> concatMap (elemsVector . Vector) (vecViews a)+  where+    vecViews = if isHermIOMatrix a+                   then rowViews . coerceMatrix+                   else colViews . coerceMatrix+{-# INLINE elemsMatrix #-}++assocsMatrix :: (Elem e) => Matrix np e -> [((Int,Int),e)]+assocsMatrix a = zip (indicesMatrix a) (elemsMatrix a)+{-# INLINE assocsMatrix #-}++tmapMatrix :: (BLAS3 e) => (e -> e) -> Matrix np e -> Matrix np e+tmapMatrix f a@(Matrix ma)+    | isHermIOMatrix ma = coerceMatrix $ herm $ +                              listMatrix (n,m) $ map (conjugate . f) (elems a)+    | otherwise         = coerceMatrix $+                              listMatrix (m,n) $ map f (elems a)+  where+    (m,n) = shape a++tzipWithMatrix :: (BLAS3 e) =>+    (e -> e -> e) -> Matrix np e -> Matrix np e -> Matrix np e+tzipWithMatrix f a b+    | shape b /= mn =+        error ("tzipWith: matrix shapes differ; first has shape `" +++                show mn ++ "' and second has shape `" +++                show (shape b) ++ "'")+    | otherwise =+        coerceMatrix $+            listMatrix mn $ zipWith f (colElems a) (colElems b)+  where+    mn = shape a+    colElems = (concatMap elems) . colViews . coerceMatrix++instance Shaped Matrix (Int,Int) where+    shape (Matrix a) = shapeIOMatrix a+    {-# INLINE shape #-}+    bounds (Matrix a) = boundsIOMatrix a+    {-# INLINE bounds #-}++instance MatrixShaped Matrix where+    herm (Matrix a) = Matrix (herm a)+    {-# INLINE herm #-}+    +instance HasVectorView Matrix where+    type VectorView Matrix = Vector+    +instance (Elem e) => BaseMatrix Matrix e where+    ldaMatrix (Matrix a) = ldaMatrixIOMatrix a+    {-# INLINE ldaMatrix #-}+    isHermMatrix (Matrix a) = isHermMatrix a+    {-# INLINE isHermMatrix #-}+    unsafeSubmatrixView (Matrix a) ij mn =+        Matrix (unsafeSubmatrixViewIOMatrix a ij mn)+    {-# INLINE unsafeSubmatrixView #-}+    unsafeDiagView (Matrix a) i = Vector (unsafeDiagViewIOMatrix a i)+    {-# INLINE unsafeDiagView #-}+    unsafeRowView (Matrix a) i = Vector (unsafeRowViewIOMatrix a i)+    {-# INLINE unsafeRowView #-}+    unsafeColView (Matrix a) i = Vector (unsafeColViewIOMatrix a i)+    {-# INLINE unsafeColView #-}+    maybeViewMatrixAsVector (Matrix a) = liftM Vector (maybeViewMatrixAsVector a)+    {-# INLINE maybeViewMatrixAsVector #-}+    maybeViewVectorAsMatrix mn (Vector x) = +        liftM Matrix $ maybeViewVectorAsIOMatrix mn x+    {-# INLINE maybeViewVectorAsMatrix #-}+    maybeViewVectorAsRow (Vector x) = liftM Matrix (maybeViewVectorAsRow x)+    {-# INLINE maybeViewVectorAsRow #-}+    maybeViewVectorAsCol (Vector x) = liftM Matrix (maybeViewVectorAsCol x)+    {-# INLINE maybeViewVectorAsCol #-}+    unsafeIOMatrixToMatrix = Matrix+    {-# INLINE unsafeIOMatrixToMatrix #-}+    unsafeMatrixToIOMatrix (Matrix a) = a+    {-# INLINE unsafeMatrixToIOMatrix #-}++instance (BLAS3 e) => ITensor Matrix (Int,Int) e where+    size (Matrix a) = sizeIOMatrix a+    {-# INLINE size #-}+    (//)          = replaceMatrix+    unsafeReplace = unsafeReplaceMatrix+    unsafeAt      = unsafeAtMatrix+    {-# INLINE unsafeAt #-}+    indices       = indicesMatrix+    {-# INLINE indices #-}+    elems         = elemsMatrix+    {-# INLINE elems #-}+    assocs        = assocsMatrix+    {-# INLINE assocs #-}+    tmap          = tmapMatrix+    {-# INLINE tmap #-}+    (*>) k (Matrix a) = unsafePerformIO $ liftM coerceMatrix $+        unsafeFreezeIOMatrix =<< getScaledMatrix k (coerceMatrix a)+    {-# NOINLINE (*>) #-}+    shift k (Matrix a) = unsafePerformIO $ liftM coerceMatrix $+        unsafeFreezeIOMatrix =<< getShiftedMatrix k (coerceMatrix a)+    {-# NOINLINE shift #-}++instance (BLAS3 e, Monad m) => ReadTensor Matrix (Int,Int) e m where+    getSize = return . size+    {-# INLINE getSize #-}+    getAssocs = return . assocs+    {-# INLINE getAssocs #-}+    getIndices = return . indices+    {-# INLINE getIndices #-}+    getElems = return . elems+    {-# INLINE getElems #-}+    getAssocs' = return . assocs+    {-# INLINE getAssocs' #-}+    getIndices' = return . indices+    {-# INLINE getIndices' #-}+    getElems' = return . elems+    {-# INLINE getElems' #-}+    unsafeReadElem x i = return $ unsafeAt x i+    {-# INLINE unsafeReadElem #-}++instance (BLAS3 e) => MMatrix Matrix e IO where+    unsafeDoSApplyAdd = gemv+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = gemm+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeGetRow = unsafeGetRowMatrix+    {-# INLINE unsafeGetRow #-}+    unsafeGetCol = unsafeGetColMatrix+    {-# INLINE unsafeGetCol #-}+    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Herm Matrix) e IO where+    unsafeDoSApplyAdd = hemv'+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = hemm'+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Tri Matrix) e IO where+    unsafeDoSApplyAdd = unsafeDoSApplyAddTriMatrix+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatTriMatrix+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeDoSApply_ = trmv+    {-# INLINE unsafeDoSApply_ #-}+    unsafeDoSApplyMat_ = trmm+    {-# INLINE unsafeDoSApplyMat_ #-}+    getRows = getRowsIO+    {-# INLINE getRows #-}+    getCols = getColsIO+    {-# INLINE getCols #-}++instance (BLAS3 e) => MSolve  (Tri Matrix) e IO where+    unsafeDoSSolve = unsafeDoSSolveTriMatrix+    {-# INLINE unsafeDoSSolve #-}+    unsafeDoSSolveMat = unsafeDoSSolveMatTriMatrix+    {-# INLINE unsafeDoSSolveMat #-}    +    unsafeDoSSolve_ = trsv+    {-# INLINE unsafeDoSSolve_ #-}+    unsafeDoSSolveMat_ = trsm+    {-# INLINE unsafeDoSSolveMat_ #-}++instance (BLAS3 e) => ReadMatrix Matrix e IO where+    unsafePerformIOWithMatrix (Matrix a) f = f a+    {-# INLINE unsafePerformIOWithMatrix #-}+    freezeMatrix (Matrix a) = freezeIOMatrix a+    {-# INLINE freezeMatrix #-}+    unsafeFreezeMatrix (Matrix a) = unsafeFreezeIOMatrix a+    {-# INLINE unsafeFreezeMatrix #-}++instance (BLAS3 e) => MMatrix Matrix e (ST s) where+    unsafeDoSApplyAdd = gemv+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = gemm+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeGetRow = unsafeGetRowMatrix+    {-# INLINE unsafeGetRow #-}+    unsafeGetCol = unsafeGetColMatrix+    {-# INLINE unsafeGetCol #-}+    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Herm Matrix) e (ST s) where+    unsafeDoSApplyAdd = hemv'+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = hemm'+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Tri Matrix) e (ST s) where+    unsafeDoSApplyAdd = unsafeDoSApplyAddTriMatrix+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatTriMatrix+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeDoSApply_ = trmv+    {-# INLINE unsafeDoSApply_ #-}+    unsafeDoSApplyMat_ = trmm+    {-# INLINE unsafeDoSApplyMat_ #-}+    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MSolve  (Tri Matrix) e (ST s) where+    unsafeDoSSolve = unsafeDoSSolveTriMatrix+    {-# INLINE unsafeDoSSolve #-}+    unsafeDoSSolveMat = unsafeDoSSolveMatTriMatrix+    {-# INLINE unsafeDoSSolveMat #-}    +    unsafeDoSSolve_ = trsv+    {-# INLINE unsafeDoSSolve_ #-}+    unsafeDoSSolveMat_ = trsm+    {-# INLINE unsafeDoSSolveMat_ #-}++instance (BLAS3 e) => ReadMatrix Matrix e (ST s) where+    unsafePerformIOWithMatrix (Matrix a) f = unsafeIOToST $ f a+    {-# INLINE unsafePerformIOWithMatrix #-}+    freezeMatrix (Matrix a) = unsafeIOToST $ freezeIOMatrix a+    {-# INLINE freezeMatrix #-}+    unsafeFreezeMatrix (Matrix a) = unsafeIOToST $ unsafeFreezeIOMatrix a+    {-# INLINE unsafeFreezeMatrix #-}++compareMatrixWith :: (BLAS3 e) => +    (e -> e -> Bool) -> Matrix (n,p) e -> Matrix (n,p) e -> Bool+compareMatrixWith cmp a b+    | shape a /= shape b =+        False+    | isHermMatrix a == isHermMatrix b =+        let elems' = if isHermMatrix a then elems . herm+                                       else elems+        in+            and $ zipWith cmp (elems' a) (elems' b)+    | otherwise =+        and $ zipWith cmp (colElems a) (colElems b)+  where+    colElems c = concatMap elems (colViews $ coerceMatrix c)++instance (BLAS3 e, Eq e) => Eq (Matrix (n,p) e) where+    (==) = compareMatrixWith (==)++instance (BLAS3 e, AEq e) => AEq (Matrix (n,p) e) where+    (===) = compareMatrixWith (===)+    (~==) = compareMatrixWith (~==)++instance (BLAS3 e, Show e) => Show (Matrix (n,p) e) where+    show a | isHermMatrix a = +                "herm (" ++ show (herm a) ++ ")"+           | otherwise =+                "listMatrix " ++ show (shape a) ++ " " ++ show (elems a)+        +instance (BLAS3 e) => Num (Matrix (n,p) e) where+    (+) x y     = unsafePerformIO $ unsafeFreezeIOMatrix =<< getAddMatrix x y+    {-# NOINLINE (+) #-}+    (-) x y     = unsafePerformIO $ unsafeFreezeIOMatrix =<< getSubMatrix x y+    {-# NOINLINE (-) #-}+    (*) x y     = unsafePerformIO $ unsafeFreezeIOMatrix =<< getMulMatrix x y+    {-# NOINLINE (*) #-}+    negate      = ((-1) *>)+    abs         = tmap abs+    signum      = tmap signum+    fromInteger = coerceMatrix . (constantMatrix (1,1)) . fromInteger+    +instance (BLAS3 e) => Fractional (Matrix (n,p) e) where+    (/) x y      = unsafePerformIO $ unsafeFreezeIOMatrix =<< getDivMatrix x y+    {-# NOINLINE (/) #-}+    recip        = tmap recip+    fromRational = coerceMatrix . (constantMatrix (1,1)) . fromRational ++instance (BLAS3 e, Floating e) => Floating (Matrix (m,n) e) where+    pi    = constantMatrix (1,1) pi+    exp   = tmap exp+    sqrt  = tmap sqrt+    log   = tmap log+    (**)  = tzipWithMatrix (**)+    sin   = tmap sin+    cos   = tmap cos+    tan   = tmap tan+    asin  = tmap asin+    acos  = tmap acos+    atan  = tmap atan+    sinh  = tmap sinh+    cosh  = tmap cosh+    tanh  = tmap tanh+    asinh = tmap asinh+    acosh = tmap acosh+    atanh = tmap atanh++-- | Take a unary elementwise vector operation and apply it to the elements+-- of a matrix.+liftMatrix :: (ReadMatrix a e m) =>+    (forall k. VectorView a k e -> m ()) -> a (n,p) e -> m ()+liftMatrix f a =+    case maybeViewMatrixAsVector a of+        Just x -> f x+        _ ->+            let xs = case isHermMatrix a of+                          True ->  rowViews (coerceMatrix a)+                          False -> colViews (coerceMatrix a)+            in mapM_ f xs+{-# INLINE liftMatrix #-}++-- | Take a binary elementwise vector operation and apply it to the elements+-- of a pair of matrices.+liftMatrix2 :: (ReadMatrix a e m, ReadMatrix b f m) =>+    (forall k. VectorView a k e -> VectorView b k f -> m ()) ->+        a (n,p) e -> b (n,p) f -> m ()+liftMatrix2 f a b =+    if isHermMatrix a == isHermMatrix b+        then case (maybeViewMatrixAsVector a, maybeViewMatrixAsVector b) of+                 ((Just x), (Just y)) -> f x y+                 _                    -> elementwise+        else elementwise+  where+    elementwise =+        let vecsA = if isHermMatrix a then rowViews . coerceMatrix+                                      else colViews . coerceMatrix+            vecsB = if isHermMatrix a then rowViews . coerceMatrix+                                      else colViews . coerceMatrix+            xs = vecsA a+            ys = vecsB b+        in zipWithM_ f xs ys+{-# INLINE liftMatrix2 #-}++checkMatrixOp2 :: (BaseMatrix x e, BaseMatrix y f) => +    (x n e -> y n f -> a) ->+        x n e -> y n f -> a+checkMatrixOp2 f x y = +    checkBinaryOp (shape x) (shape y) $ f x y+{-# INLINE checkMatrixOp2 #-}++getUnaryMatrixOp :: (ReadMatrix a e m, WriteMatrix b e m) =>+    (b (n,p) e -> m ()) -> a (n,p) e -> m (b (n,p) e)+getUnaryMatrixOp f a = do+    b <- newCopyMatrix a+    f b+    return b+{-# INLINE getUnaryMatrixOp #-}++unsafeGetBinaryMatrixOp :: +    (WriteMatrix c e m, ReadMatrix a e m, ReadMatrix b f m) =>+    (c (n,p) e -> b (n,p) f -> m ()) ->+        a (n,p) e -> b (n,p) f -> m (c (n,p) e)+unsafeGetBinaryMatrixOp f a b = do+    c <- newCopyMatrix a+    f c b+    return c++transMatrix :: (BaseMatrix a e) => a (n,p) e -> TransEnum+transMatrix a = +    case (isHermMatrix a) of+          False -> NoTrans+          True  -> ConjTrans+{-# INLINE transMatrix #-}++indexOfMatrix :: (BaseMatrix a e) => a (n,p) e -> (Int,Int) -> Int+indexOfMatrix a (i,j) = +    let (i',j') = case isHermMatrix a of+                        True  -> (j,i)+                        False -> (i,j)+        l = ldaMatrix a+    in i' + j'*l+{-# INLINE indexOfMatrix #-}
+ lib/Data/Matrix/Dense/Class.hs view
@@ -0,0 +1,117 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Dense.Class+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface to mutable dense matrices.  For matrix types+-- than can be used with this interface, see "Data.Matrix.Dense.IO" and+-- "Data.Matrix.Dense.ST".  Many of these functions can also be used with+-- the immutable type defined in "Data.Matrix.Dense".+--++module Data.Matrix.Dense.Class (+    -- * Dense matrix type classes+    BaseMatrix( ldaMatrix, isHermMatrix, coerceMatrix ),+    ReadMatrix,+    WriteMatrix,+    +    -- * Overloaded interface for matrices+    module Data.Matrix.Class,+    module Data.Matrix.Class.MMatrix,+    +    -- * Creating matrices+    newMatrix_,+    newMatrix,+    newListMatrix,+    newRowsMatrix,+    newColsMatrix,+    newRowMatrix,+    newColMatrix,++    -- * Special matrices+    newZeroMatrix,+    setZeroMatrix,+    newConstantMatrix,+    setConstantMatrix,+    newIdentityMatrix,+    setIdentityMatrix,+    +    -- * Copying matrices+    newCopyMatrix,+    newCopyMatrix',+    copyMatrix,+    swapMatrix,+    +    -- * Swapping rows and columns+    swapRows,+    swapCols,++    -- * Matrix views+    submatrixView,+    splitRowsAt,+    splitColsAt,++    -- * Row and column views+    rowViews,+    colViews,+    rowView,+    colView,+    diagView,++    -- * Conversions between matrices and vectors+    maybeViewMatrixAsVector,+    maybeViewVectorAsMatrix,+    maybeViewVectorAsRow,+    maybeViewVectorAsCol,  +    +    -- * Getting diagonals+    getDiag,+    +    -- * Overloaded interface for reading and writing matrix elements+    module Data.Tensor.Class,+    module Data.Tensor.Class.MTensor,++    -- * Matrix operations+    -- ** Unary+    getConjMatrix,+    getScaledMatrix,+    getShiftedMatrix,+    doConjMatrix,+    scaleByMatrix,+    shiftByMatrix,+    +    -- ** Binary+    getAddMatrix,+    getSubMatrix,+    getMulMatrix,+    getDivMatrix,+    addMatrix,+    subMatrix,+    axpyMatrix,+    mulMatrix,+    divMatrix,++    -- * Conversions between mutable and immutable matrices+    freezeMatrix,+    thawMatrix,+    unsafeFreezeMatrix,+    unsafeThawMatrix,++    -- * Conversions from @IOMatrix@s+    unsafeMatrixToIOMatrix,+    unsafeConvertIOMatrix,+    unsafePerformIOWithMatrix,+        +    ) where++import Data.Matrix.Dense.Base++import Data.Matrix.Class+import Data.Matrix.Class.MMatrix++import Data.Tensor.Class+import Data.Tensor.Class.MTensor+
+ lib/Data/Matrix/Dense/IO.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Dense.IO+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Mutable dense matrices in the IO monad.+--++module Data.Matrix.Dense.IO (+    -- * The IOMatrix data type+    IOMatrix,+    withIOMatrix,+    matrixViewArray,+    matrixViewArrayWithLda,+    +    -- * Overloaded mutable dense matrix interface+    module Data.Matrix.Dense.Class,+    ) where++import Data.Matrix.Dense.IOBase+import Data.Matrix.Dense.Class
+ lib/Data/Matrix/Dense/IOBase.hs view
@@ -0,0 +1,453 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, +        Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Dense.IOBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Matrix.Dense.IOBase+    where++import Control.Monad+import Foreign+import System.IO.Unsafe++import BLAS.Internal( diagLen )++import Data.Elem.BLAS( Complex, Elem, BLAS1, conjugate )+import qualified Data.Elem.BLAS.Level1 as BLAS++import Data.Matrix.Class++import Data.Tensor.Class+import Data.Tensor.Class.MTensor++import Data.Vector.Dense.IOBase+++-- | Dense matrix in the 'IO' monad.  The type arguments are as follows:+--+--     * @np@: a phantom type for the shape of the matrix.  Most functions+--       will demand that this be specified as a pair.  When writing a function+--       signature, you should always prefer @IOMatrix (n,p) e@ to+--       @IOMatrix np e@.+--+--     * @e@: the element type of the matrix.  Only certain element types+--       are supported.+--+data IOMatrix np e =+      IOMatrix {-# UNPACK #-} !(ForeignPtr e) -- a pointer to the storage region+               {-# UNPACK #-} !(Ptr e)        -- a pointer to the first element+               {-# UNPACK #-} !Int            -- the number of rows in the matrix+               {-# UNPACK #-} !Int            -- the number of colunps in the matrix+               {-# UNPACK #-} !Int            -- the leading dimension size of the matrix+               {-# UNPACK #-} !Bool           -- indicates whether or not the matrix is transposed and conjugated++-- | View an array in memory as a matrix.+matrixViewArray :: (Elem e)+                => ForeignPtr e+                -> Int          -- ^ offset+                -> (Int,Int)    -- ^ shape+                -> IOMatrix (n,p) e+matrixViewArray f o (m,n) = matrixViewArrayWithLda m f o (m,n)+{-# INLINE matrixViewArray #-}++-- | View an array in memory as a matrix, with the given leading dimension+-- size.+matrixViewArrayWithLda :: (Elem e)+                       => Int          -- ^ leading dimension size+                       -> ForeignPtr e+                       -> Int          -- ^ offset+                       -> (Int,Int)    -- ^ shape+                       -> IOMatrix (n,p) e+matrixViewArrayWithLda l f o (m,n) =+    let p = unsafeForeignPtrToPtr f `advancePtr` o+    in IOMatrix f p m n l False+{-# INLINE matrixViewArrayWithLda #-}+++numRowsIOMatrix :: IOMatrix np e -> Int+numRowsIOMatrix (IOMatrix _ _ m _ _ _) = m+{-# INLINE numRowsIOMatrix #-}++numColsIOMatrix :: IOMatrix np e -> Int+numColsIOMatrix (IOMatrix _ _ _ n _ _) = n+{-# INLINE numColsIOMatrix #-}++ldaMatrixIOMatrix :: IOMatrix np e -> Int+ldaMatrixIOMatrix (IOMatrix _ _ _ _ l _) = l+{-# INLINE ldaMatrixIOMatrix #-}++isHermIOMatrix :: IOMatrix np e -> Bool+isHermIOMatrix (IOMatrix _ _ _ _ _ h) = h+{-# INLINE isHermIOMatrix #-}++hermIOMatrix :: IOMatrix np e -> IOMatrix nm e+hermIOMatrix (IOMatrix f p m n l h) = (IOMatrix f p n m l (not h))+{-# INLINE hermIOMatrix #-}++unsafeSubmatrixViewIOMatrix :: (Elem e) =>+    IOMatrix np e -> (Int,Int) -> (Int,Int) -> IOMatrix np' e+unsafeSubmatrixViewIOMatrix (IOMatrix f p _ _ l h) (i,j) (m',n') =+    let o = if h then i*l+j else i+j*l+        p' = p `advancePtr` o+    in IOMatrix f p' m' n' l h+{-# INLINE unsafeSubmatrixViewIOMatrix #-}++unsafeRowViewIOMatrix :: (Elem e) => IOMatrix np e -> Int -> IOVector p e+unsafeRowViewIOMatrix (IOMatrix f p _ n l h) i =+    let (o,s) = if h then (i*l,1) else (i,l)+        p'    = p `advancePtr` o+    in IOVector f p' n s h+{-# INLINE unsafeRowViewIOMatrix #-}++unsafeColViewIOMatrix :: (Elem e) => IOMatrix np e -> Int -> IOVector n e+unsafeColViewIOMatrix (IOMatrix f p m _ l h) j =+    let (o,s) = if h then (j,l) else (j*l,1)+        p'    = p `advancePtr` o+    in IOVector f p' m s h+{-# INLINE unsafeColViewIOMatrix #-}++unsafeDiagViewIOMatrix :: (Elem e) => IOMatrix np e -> Int -> IOVector k e+unsafeDiagViewIOMatrix (IOMatrix f p m n l h) i =+    let o = if i >= 0 +                then if h then  i   else  i*l+                else if h then -i*l else -i+        p' = p `advancePtr` o+        k  = diagLen (m,n) i+        s  = l+1+    in IOVector f p' k s h+{-# INLINE unsafeDiagViewIOMatrix #-}++maybeViewVectorAsRowIOMatrix :: (Elem e) => IOVector p e -> Maybe (IOMatrix p1 e)+maybeViewVectorAsRowIOMatrix (IOVector f p n s c)+    | c && (s == 1) =+        Just $ IOMatrix f p 1 n (max 1 n) True+    | not c =+        Just $ IOMatrix f p 1 n s         False+    | otherwise =+        Nothing+{-# INLINE maybeViewVectorAsRowIOMatrix #-}++maybeViewVectorAsColIOMatrix :: (Elem e) => IOVector n e -> Maybe (IOMatrix n1 e)+maybeViewVectorAsColIOMatrix (IOVector f p n s c)+    | c =+        Just $ IOMatrix f p n 1 s         True+    | s == 1 =+        Just $ IOMatrix f p n 1 (max 1 n) False+    | otherwise =+        Nothing+{-# INLINE maybeViewVectorAsColIOMatrix #-}++maybeViewIOMatrixAsVector :: (Elem e) => IOMatrix np e -> Maybe (IOVector k e)+maybeViewIOMatrixAsVector (IOMatrix f p m n l h)+    | h         = Nothing+    | l /= m    = Nothing+    | otherwise = Just $ IOVector f p (m*n) 1 False+{-# INLINE maybeViewIOMatrixAsVector #-}++maybeViewVectorAsIOMatrix :: (Elem e) => (Int,Int) -> IOVector k e -> Maybe (IOMatrix np e)+maybeViewVectorAsIOMatrix (m,n) (IOVector f p k inc c)+    | m*n /= k =+        error $ "maybeViewVectorAsMatrix " ++ show (m,n)+              ++ " <vector of dim " ++ show k ++ ">: vector dimension"+              ++ " must equal product of specified dimensions"+    | c         = Nothing+    | inc /= 1  = Nothing+    | otherwise = Just $ IOMatrix f p m n m False+{-# INLINE maybeViewVectorAsIOMatrix #-}++liftIOMatrix :: (Elem e) => (forall n. IOVector n e -> IO ()) -> IOMatrix np e -> IO ()+liftIOMatrix g (IOMatrix f p m n l h)+    | h && (l == n) =+        g (IOVector f p (m*n) 1 True)+    | (not h) && (l == m) =+        g (IOVector f p (m*n) 1 False)+    | otherwise =+        let (m',n') = if h then (n,m) else (m,n)+            end     = p `advancePtr` (n'*l)+            go p' | p' == end = return ()+                  | otherwise = do+                      g (IOVector f p' m' 1 h)+                      go (p' `advancePtr` l)+        in go p++liftIOMatrix2 :: (Elem e, Elem f) =>+    (forall k. IOVector k e -> IOVector k f -> IO ()) ->+        IOMatrix np e -> IOMatrix np f -> IO ()+liftIOMatrix2 f a b =+    if isHermIOMatrix a == isHermIOMatrix b+        then case (maybeViewIOMatrixAsVector a, maybeViewIOMatrixAsVector b) of+                 ((Just x), (Just y)) -> f x y+                 _                    -> elementwise+        else elementwise+  where+    +    elementwise =+        let vecsA = if isHermIOMatrix a then rowViews+                                        else colViews+            vecsB = if isHermIOMatrix a then rowViews+                                        else colViews+            xs = vecsA a+            ys = vecsB b+        in zipWithM_ f xs ys+        +    rowViews c = [ unsafeRowViewIOMatrix c i | i <- [ 0..numRows c ] ]+    colViews c = [ unsafeColViewIOMatrix c j | j <- [ 0..numCols c ] ]++-- | Perform an 'IO' action with a pointer to the first element of the+-- matrix.+withIOMatrix :: IOMatrix (n,p) e -> (Ptr e -> IO a) -> IO a+withIOMatrix (IOMatrix f p _ _ _ _) g = do+    a <- g p+    touchForeignPtr f+    return a+{-# INLINE withIOMatrix #-}++-- | Create a new matrix of given shape, but do not initialize the elements.+newIOMatrix_ :: (Elem e) => (Int,Int) -> IO (IOMatrix np e)+newIOMatrix_ (m,n) +    | m < 0 || n < 0 =+        fail $ +            "Tried to create a matrix with shape `" ++ show (m,n) ++ "'"+    | otherwise =  do+        f <- mallocForeignPtrArray (m*n)+        return (IOMatrix f (unsafeForeignPtrToPtr f) m n (max 1 m) False)+{-# INLINE newIOMatrix_ #-}++newCopyIOMatrix :: (BLAS1 e) => IOMatrix np e -> IO (IOMatrix np e)+newCopyIOMatrix (IOMatrix f p m n l h) = +    let (m',n') = if h then (n,m) else (m,n)+        l'      = max 1 m'+    in do+        (IOMatrix f' p' _ _ _ _) <- newIOMatrix_ (m',n')+        if l == m'+            then do+                BLAS.copy (m*n) p 1 p' 1+            else +                let go src dst i | i == n'   = return ()+                                 | otherwise = do+                        BLAS.copy m' src 1 dst 1+                        go (src `advancePtr` l) (dst `advancePtr` l') (i+1)+                in go p p' 0+        touchForeignPtr f+        touchForeignPtr f'+        return (IOMatrix f' p' m n l' h)+{-# INLINE newCopyIOMatrix #-}++shapeIOMatrix :: IOMatrix np e -> (Int,Int)+shapeIOMatrix (IOMatrix _ _ m n _ _) = (m,n)+{-# INLINE shapeIOMatrix #-}++boundsIOMatrix :: IOMatrix np e -> ((Int,Int), (Int,Int))+boundsIOMatrix a = ((0,0), (m-1,n-1)) where (m,n) = shapeIOMatrix a+{-# INLINE boundsIOMatrix #-}++sizeIOMatrix :: IOMatrix np e -> Int+sizeIOMatrix (IOMatrix _ _ m n _ _) = m*n+{-# INLINE sizeIOMatrix #-}++getSizeIOMatrix :: IOMatrix np e -> IO Int+getSizeIOMatrix = return . sizeIOMatrix+{-# INLINE getSizeIOMatrix #-}++getMaxSizeIOMatrix :: IOMatrix np e -> IO Int+getMaxSizeIOMatrix = getSizeIOMatrix+{-# INLINE getMaxSizeIOMatrix #-}++indicesIOMatrix :: IOMatrix np e -> [(Int,Int)]+indicesIOMatrix (IOMatrix _ _ m n _ h)+    | h         = [ (i,j) | i <- [ 0..m-1 ], j <- [ 0..n-1 ] ]+    | otherwise = [ (i,j) | j <- [ 0..n-1 ], i <- [ 0..m-1 ] ]+{-# INLINE indicesIOMatrix #-}++getIndicesIOMatrix :: IOMatrix np e -> IO [(Int,Int)]+getIndicesIOMatrix = return . indicesIOMatrix+{-# INLINE getIndicesIOMatrix #-}++getIndicesIOMatrix' :: IOMatrix np e -> IO [(Int,Int)]+getIndicesIOMatrix' = getIndicesIOMatrix+{-# INLINE getIndicesIOMatrix' #-}++getElemsIOMatrix :: (Elem e) => IOMatrix np e -> IO [e]+getElemsIOMatrix (IOMatrix f p m n l h) +    | h         = liftM (map conjugate) $ +                      getElemsIOMatrix (IOMatrix f p n m l False)+    | l == m    = getElemsIOVector (IOVector f p (m*n) 1 False)+    | otherwise =+        let end   = p `advancePtr` (n*l)+            go p' | p' == end = return []+                  | otherwise = unsafeInterleaveIO $ do+                        c  <- getElemsIOVector (IOVector f p' m 1 False)+                        cs <- go (p' `advancePtr` l)+                        return (c ++ cs)+        in go p+{-# SPECIALIZE INLINE getElemsIOMatrix :: IOMatrix np Double -> IO [Double] #-}+{-# SPECIALIZE INLINE getElemsIOMatrix :: IOMatrix np (Complex Double) -> IO [Complex Double] #-}++getElemsIOMatrix' :: (Elem e) => IOMatrix np e -> IO [e]+getElemsIOMatrix' (IOMatrix f p m n l h) +    | h         = liftM (map conjugate) $ +                      getElemsIOMatrix' (IOMatrix f p n m l False)+    | l == m    = getElemsIOVector' (IOVector f p (m*n) 1 False)+    | otherwise =+        let end   = p `advancePtr` (n*l)+            go p' | p' == end = return []+                  | otherwise = do+                        c  <- getElemsIOVector' (IOVector f p' m 1 False)+                        cs <- go (p' `advancePtr` l)+                        return (c ++ cs)+        in go p+{-# SPECIALIZE INLINE getElemsIOMatrix' :: IOMatrix np Double -> IO [Double] #-}+{-# SPECIALIZE INLINE getElemsIOMatrix' :: IOMatrix np (Complex Double) -> IO [Complex Double] #-}++getAssocsIOMatrix :: (Elem e) => IOMatrix np e -> IO [((Int,Int),e)]+getAssocsIOMatrix a = do+    is <- getIndicesIOMatrix a+    es <- getElemsIOMatrix a+    return $ zip is es+{-# INLINE getAssocsIOMatrix #-}++getAssocsIOMatrix' :: (Elem e) => IOMatrix np e -> IO [((Int,Int),e)]+getAssocsIOMatrix' a = do+    is <- getIndicesIOMatrix' a+    es <- getElemsIOMatrix' a+    return $ zip is es+{-# INLINE getAssocsIOMatrix' #-}++unsafeReadElemIOMatrix :: (Elem e) => IOMatrix np e -> (Int,Int) -> IO e+unsafeReadElemIOMatrix (IOMatrix f p _ _ l h) (i,j)+    | h = do+        e <- liftM conjugate $ peekElemOff p (i*l+j)+        touchForeignPtr f+        return e+    | otherwise = do+        e <- peekElemOff p (i+j*l)+        touchForeignPtr f+        return e+{-# SPECIALIZE INLINE unsafeReadElemIOMatrix :: IOMatrix n Double -> (Int,Int) -> IO (Double) #-}+{-# SPECIALIZE INLINE unsafeReadElemIOMatrix :: IOMatrix n (Complex Double) -> (Int,Int) -> IO (Complex Double) #-}        ++canModifyElemIOMatrix :: IOMatrix np e -> (Int,Int) -> IO Bool+canModifyElemIOMatrix _ _ = return True+{-# INLINE canModifyElemIOMatrix #-}++unsafeWriteElemIOMatrix :: (Elem e) => +    IOMatrix np e -> (Int,Int) -> e -> IO ()+unsafeWriteElemIOMatrix (IOMatrix f p _ _ l h) (i,j) e+    | h = do+        pokeElemOff p (i*l+j) (conjugate e)+        touchForeignPtr f+    | otherwise = do+        pokeElemOff p (i+j*l) e+        touchForeignPtr f+{-# SPECIALIZE INLINE unsafeWriteElemIOMatrix :: IOMatrix n Double -> (Int,Int) -> Double -> IO () #-}+{-# SPECIALIZE INLINE unsafeWriteElemIOMatrix :: IOMatrix n (Complex Double) -> (Int,Int) -> Complex Double -> IO () #-}        ++unsafeModifyElemIOMatrix :: (Elem e) => +    IOMatrix n e -> (Int,Int) -> (e -> e) -> IO ()+unsafeModifyElemIOMatrix (IOMatrix f p _ _ l h) (i,j) g =+    let g' = if h then conjugate . g . conjugate else g+        p' = if h then p `advancePtr` (i*l+j) else p `advancePtr` (i+j*l)+    in do+        e <- peek p'+        poke p' (g' e)+        touchForeignPtr f+{-# SPECIALIZE INLINE unsafeModifyElemIOMatrix :: IOMatrix n Double -> (Int,Int) -> (Double -> Double) -> IO () #-}+{-# SPECIALIZE INLINE unsafeModifyElemIOMatrix :: IOMatrix n (Complex Double) -> (Int,Int) -> (Complex Double -> Complex Double) -> IO () #-}++unsafeSwapElemsIOMatrix :: (Elem e) => +    IOMatrix n e -> (Int,Int) -> (Int,Int) -> IO ()+unsafeSwapElemsIOMatrix (IOMatrix f p _ _ l h) (i1,j1) (i2,j2) =+    let (p1,p2) = if h then (p `advancePtr` (i1*l+j1), p `advancePtr` (i2*l+j2))+                       else (p `advancePtr` (i1+j1*l), p `advancePtr` (i2+j2*l))+    in do+        e1 <- peek p1+        e2 <- peek p2+        poke p2 e1+        poke p1 e2+        touchForeignPtr f+{-# SPECIALIZE INLINE unsafeSwapElemsIOMatrix :: IOMatrix n Double -> (Int,Int) -> (Int,Int) -> IO () #-}+{-# SPECIALIZE INLINE unsafeSwapElemsIOMatrix :: IOMatrix n (Complex Double) -> (Int,Int) -> (Int,Int) -> IO () #-}++modifyWithIOMatrix :: (Elem e) => (e -> e) -> IOMatrix np e -> IO ()+modifyWithIOMatrix g = liftIOMatrix (modifyWithIOVector g)+{-# INLINE modifyWithIOMatrix #-}++setZeroIOMatrix :: (Elem e) => IOMatrix np e -> IO ()+setZeroIOMatrix = liftIOMatrix setZeroIOVector+{-# INLINE setZeroIOMatrix #-}++setConstantIOMatrix :: (Elem e) => e -> IOMatrix np e -> IO ()+setConstantIOMatrix k = liftIOMatrix (setConstantIOVector k)+{-# INLINE setConstantIOMatrix #-}++doConjIOMatrix :: (BLAS1 e) => IOMatrix np e -> IO ()+doConjIOMatrix = liftIOMatrix doConjIOVector+{-# INLINE doConjIOMatrix #-}++scaleByIOMatrix :: (BLAS1 e) => e -> IOMatrix np e -> IO ()+scaleByIOMatrix k = liftIOMatrix (scaleByIOVector k)+{-# INLINE scaleByIOMatrix #-}+                    +shiftByIOMatrix :: (Elem e) => e -> IOMatrix np e -> IO ()                    +shiftByIOMatrix k = liftIOMatrix (shiftByIOVector k)+{-# INLINE shiftByIOMatrix #-}++instance Shaped IOMatrix (Int,Int) where+    shape = shapeIOMatrix+    {-# INLINE shape #-}+    bounds = boundsIOMatrix+    {-# INLINE bounds #-}++instance (Elem e) => ReadTensor IOMatrix (Int,Int) e IO where+    getSize = getSizeIOMatrix+    {-# INLINE getSize #-}+    unsafeReadElem = unsafeReadElemIOMatrix+    {-# INLINE unsafeReadElem #-}+    getIndices = getIndicesIOMatrix+    {-# INLINE getIndices #-}+    getIndices' = getIndicesIOMatrix'+    {-# INLINE getIndices' #-}+    getElems = getElemsIOMatrix+    {-# INLINE getElems #-}+    getElems' = getElemsIOMatrix'+    {-# INLINE getElems' #-}+    getAssocs = getAssocsIOMatrix+    {-# INLINE getAssocs #-}+    getAssocs' = getAssocsIOMatrix'+    {-# INLINE getAssocs' #-}++instance (BLAS1 e) => WriteTensor IOMatrix (Int,Int) e IO where+    getMaxSize = getMaxSizeIOMatrix+    {-# INLINE getMaxSize #-}+    setZero = setZeroIOMatrix+    {-# INLINE setZero #-}+    setConstant = setConstantIOMatrix+    {-# INLINE setConstant #-}+    canModifyElem = canModifyElemIOMatrix+    {-# INLINE canModifyElem #-}+    unsafeWriteElem = unsafeWriteElemIOMatrix+    {-# INLINE unsafeWriteElem #-}+    unsafeModifyElem = unsafeModifyElemIOMatrix+    {-# INLINE unsafeModifyElem #-}+    modifyWith = modifyWithIOMatrix+    {-# INLINE modifyWith #-}+    doConj = doConjIOMatrix+    {-# INLINE doConj #-}+    scaleBy = scaleByIOMatrix+    {-# INLINE scaleBy #-}+    shiftBy = shiftByIOMatrix+    {-# INLINE shiftBy #-}++instance HasVectorView IOMatrix where+    type VectorView IOMatrix = IOVector++instance MatrixShaped IOMatrix where+    herm = hermIOMatrix+    {-# INLINE herm #-}
+ lib/Data/Matrix/Dense/ST.hs view
@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Dense.ST+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Mutable dense matrices in the ST monad.+--++module Data.Matrix.Dense.ST (+    -- * The @STMatrix@ data type+    STMatrix,+    runSTMatrix,++    -- * Overloaded mutable dense matrix interface+    module Data.Matrix.Dense.Class,+    ) where++import Data.Matrix.Dense.Class+import Data.Matrix.Dense.STBase
+ lib/Data/Matrix/Dense/STBase.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies,+        Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Dense.STBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Matrix.Dense.STBase+    where++import Control.Monad+import Control.Monad.ST++import Data.Elem.BLAS( Elem, BLAS1, BLAS3 )++import Data.Tensor.Class+import Data.Tensor.Class.MTensor++import Data.Matrix.Class+import Data.Matrix.Dense.Base+import Data.Matrix.Dense.IOBase++import Data.Matrix.Herm+import Data.Matrix.TriBase++import Data.Vector.Dense.STBase++-- | Dense matrix in the 'ST' monad.  The type arguments are as follows:+--+--     * @s@: the state variable argument for the 'ST' type+--+--     * @np@: a phantom type for the shape of the matrix.  Most functions+--       will demand that this be specified as a pair.  When writing a function+--       signature, you should always prefer @STMatrix s (n,p) e@ to+--       @STMatrix s np e@.+--+--     * @e@: the element type of the matrix.  Only certain element types+--       are supported.+--+newtype STMatrix s np e = STMatrix (IOMatrix np e)++-- | 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 unsafeFreezeMatrix internally,+-- but this wrapper is a safe interface to that function. +runSTMatrix :: (forall s . ST s (STMatrix s n e)) -> Matrix n e+runSTMatrix mx = +    runST $ mx >>= \(STMatrix x) -> return (Matrix x)++instance HasVectorView (STMatrix s) where+    type VectorView (STMatrix s) = STVector s++instance Shaped (STMatrix s) (Int,Int) where+    shape (STMatrix a) = shapeIOMatrix a+    {-# INLINE shape #-}+    bounds (STMatrix a) = boundsIOMatrix a+    {-# INLINE bounds #-}++instance (Elem e) => ReadTensor (STMatrix s) (Int,Int) e (ST s) where+    getSize (STMatrix a) = unsafeIOToST $ getSizeIOMatrix a+    {-# INLINE getSize #-}+    unsafeReadElem (STMatrix a) i = unsafeIOToST $ unsafeReadElemIOMatrix a i+    {-# INLINE unsafeReadElem #-}+    getIndices (STMatrix a) = unsafeIOToST $ getIndicesIOMatrix a+    {-# INLINE getIndices #-}+    getIndices' (STMatrix a) = unsafeIOToST $ getIndicesIOMatrix' a+    {-# INLINE getIndices' #-}+    getElems (STMatrix a) = unsafeIOToST $ getElemsIOMatrix a+    {-# INLINE getElems #-}+    getElems' (STMatrix a) = unsafeIOToST $ getElemsIOMatrix' a+    {-# INLINE getElems' #-}+    getAssocs (STMatrix a) = unsafeIOToST $ getAssocsIOMatrix a+    {-# INLINE getAssocs #-}+    getAssocs' (STMatrix a) = unsafeIOToST $ getAssocsIOMatrix' a+    {-# INLINE getAssocs' #-}++instance (BLAS1 e) => WriteTensor (STMatrix s) (Int,Int) e (ST s) where+    getMaxSize (STMatrix a) =  unsafeIOToST $ getMaxSizeIOMatrix a+    {-# INLINE getMaxSize #-}+    setZero (STMatrix a) = unsafeIOToST $ setZeroIOMatrix a+    {-# INLINE setZero #-}+    setConstant e (STMatrix a) = unsafeIOToST $ setConstantIOMatrix e a+    {-# INLINE setConstant #-}+    canModifyElem (STMatrix a) i = unsafeIOToST $ canModifyElemIOMatrix a i+    {-# INLINE canModifyElem #-}+    unsafeWriteElem (STMatrix a) i e = unsafeIOToST $ unsafeWriteElemIOMatrix a i e+    {-# INLINE unsafeWriteElem #-}+    unsafeModifyElem (STMatrix a) i f = unsafeIOToST $ unsafeModifyElemIOMatrix a i f+    {-# INLINE unsafeModifyElem #-}+    modifyWith f (STMatrix a) = unsafeIOToST $ modifyWithIOMatrix f a+    {-# INLINE modifyWith #-}+    doConj (STMatrix a) = unsafeIOToST $ doConjIOMatrix a+    {-# INLINE doConj #-}+    scaleBy k (STMatrix a) = unsafeIOToST $ scaleByIOMatrix k a+    {-# INLINE scaleBy #-}+    shiftBy k (STMatrix a) = unsafeIOToST $ shiftByIOMatrix k a+    {-# INLINE shiftBy #-}++instance MatrixShaped (STMatrix s) where+    herm (STMatrix a) = STMatrix (herm a)+    {-# INLINE herm #-}+    +instance (BLAS3 e) => MMatrix (STMatrix s) e (ST s) where+    unsafeDoSApplyAdd = gemv+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = gemm+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeGetRow = unsafeGetRowMatrix+    {-# INLINE unsafeGetRow #-}+    unsafeGetCol = unsafeGetColMatrix+    {-# INLINE unsafeGetCol #-}+    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Herm (STMatrix s)) e (ST s) where+    unsafeDoSApplyAdd = hemv'+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = hemm'+    {-# INLINE unsafeDoSApplyAddMat #-}    +    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MMatrix (Tri (STMatrix s)) e (ST s) where+    unsafeDoSApplyAdd = unsafeDoSApplyAddTriMatrix+    {-# INLINE unsafeDoSApplyAdd #-}+    unsafeDoSApplyAddMat = unsafeDoSApplyAddMatTriMatrix+    {-# INLINE unsafeDoSApplyAddMat #-}+    unsafeDoSApply_ = trmv+    {-# INLINE unsafeDoSApply_ #-}+    unsafeDoSApplyMat_ = trmm+    {-# INLINE unsafeDoSApplyMat_ #-}+    getRows = getRowsST+    {-# INLINE getRows #-}+    getCols = getColsST+    {-# INLINE getCols #-}++instance (BLAS3 e) => MSolve  (Tri (STMatrix s)) e (ST s) where+    unsafeDoSSolve = unsafeDoSSolveTriMatrix+    {-# INLINE unsafeDoSSolve #-}+    unsafeDoSSolveMat = unsafeDoSSolveMatTriMatrix+    {-# INLINE unsafeDoSSolveMat #-}    +    unsafeDoSSolve_ = trsv+    {-# INLINE unsafeDoSSolve_ #-}+    unsafeDoSSolveMat_ = trsm+    {-# INLINE unsafeDoSSolveMat_ #-}++instance (Elem e) => BaseMatrix (STMatrix s) e where+    ldaMatrix (STMatrix a) = ldaMatrixIOMatrix a+    {-# INLINE ldaMatrix #-}+    isHermMatrix (STMatrix a) = isHermMatrix a+    {-# INLINE isHermMatrix #-}+    unsafeSubmatrixView (STMatrix a) ij mn =+        STMatrix (unsafeSubmatrixViewIOMatrix a ij mn)+    {-# INLINE unsafeSubmatrixView #-}+    unsafeDiagView (STMatrix a) i = STVector (unsafeDiagViewIOMatrix a i)+    {-# INLINE unsafeDiagView #-}+    unsafeRowView (STMatrix a) i = STVector (unsafeRowViewIOMatrix a i)+    {-# INLINE unsafeRowView #-}+    unsafeColView (STMatrix a) i = STVector (unsafeColViewIOMatrix a i)+    {-# INLINE unsafeColView #-}+    maybeViewMatrixAsVector (STMatrix a) = liftM STVector (maybeViewMatrixAsVector a)+    {-# INLINE maybeViewMatrixAsVector #-}+    maybeViewVectorAsMatrix mn (STVector x) = +        liftM STMatrix $ maybeViewVectorAsIOMatrix mn x+    {-# INLINE maybeViewVectorAsMatrix #-}    +    maybeViewVectorAsRow (STVector x) = liftM STMatrix (maybeViewVectorAsRow x)+    {-# INLINE maybeViewVectorAsRow #-}+    maybeViewVectorAsCol (STVector x) = liftM STMatrix (maybeViewVectorAsCol x)+    {-# INLINE maybeViewVectorAsCol #-}+    unsafeIOMatrixToMatrix = STMatrix+    {-# INLINE unsafeIOMatrixToMatrix #-}+    unsafeMatrixToIOMatrix (STMatrix a) = a+    {-# INLINE unsafeMatrixToIOMatrix #-}++instance (BLAS3 e) => ReadMatrix (STMatrix s) e (ST s) where+    unsafePerformIOWithMatrix (STMatrix a) f = unsafeIOToST $ f a+    {-# INLINE unsafePerformIOWithMatrix #-}+    freezeMatrix (STMatrix a) = unsafeIOToST $ freezeIOMatrix a+    {-# INLINE freezeMatrix #-}+    unsafeFreezeMatrix (STMatrix a) = unsafeIOToST $ unsafeFreezeIOMatrix a+    {-# INLINE unsafeFreezeMatrix #-}++instance (BLAS3 e) => WriteMatrix (STMatrix s) e (ST s) where+    newMatrix_ = unsafeIOToST . liftM STMatrix . newIOMatrix_+    {-# INLINE newMatrix_ #-}+    unsafeConvertIOMatrix = unsafeIOToST . liftM STMatrix+    {-# INLINE unsafeConvertIOMatrix #-}+    thawMatrix = unsafeIOToST . liftM STMatrix . thawIOMatrix+    {-# INLINE thawMatrix #-}+    unsafeThawMatrix = unsafeIOToST . liftM STMatrix . unsafeThawIOMatrix+    {-# INLINE unsafeThawMatrix #-}+
+ lib/Data/Matrix/Herm.hs view
@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Herm+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Hermitian views of matrices.+--++module Data.Matrix.Herm (+    Herm(..),+    hermFromBase,+    hermToBase,+    mapHerm,+    hermL,+    hermU,+    coerceHerm,+    ) where++import Data.Matrix.HermBase
+ lib/Data/Matrix/HermBase.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.HermBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Matrix.HermBase+    where++import Unsafe.Coerce++import BLAS.Internal( checkSquare )+import Data.Matrix.Class+import Data.Tensor.Class+import BLAS.Types ( UpLoEnum(..) )++-- | 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:+--+--     * @a@: the underlyting matrix type.+--+--     * @nn@: a phantom type for the shape of the matrix.+--+--     * @e@: the element type of the matrix.+--+data Herm a nn e = Herm UpLoEnum (a nn e)++-- | Cast the phantom shape type.+coerceHerm :: Herm a mn e -> Herm a mn' e+coerceHerm = unsafeCoerce++-- | Apply a function to the unerlying matrix.+mapHerm :: (a nn e -> b nn' e) -> Herm a nn e -> Herm b nn' e+mapHerm f (Herm u a) = Herm u $ f a++-- | Convert from a base matrix type to a Herm matrix type.+hermFromBase :: UpLoEnum -> a (n,n) e -> Herm a (n,n) e+hermFromBase = Herm+        +-- | Convert from a Herm matrix type to a base matrix type.        +hermToBase :: Herm a (n,n) e -> (UpLoEnum, a (n,n) e)+hermToBase (Herm u a) = (u,a)++-- | Construct a lower-triangular hermitian view into a matrix.  This also+-- checks to see if the base matrix is square.+hermL :: (MatrixShaped a) => a (n,n) e -> Herm a (n,n) e+hermL a = checkSquare "hermL" (shape a) (Herm Lower a)++-- | Construct an upper-triangular hermitian view into a matrix.  This also+-- checks to see if the base matrix is square.+hermU :: (MatrixShaped a) => a (n,n) e -> Herm a (n,n) e+hermU a = checkSquare "hermU" (shape a) (Herm Upper a)+      +instance (MatrixShaped a) => Shaped (Herm a) (Int,Int) where+    shape  (Herm _ a) = (n,n)             where n = min (numRows a) (numCols a)+    {-# INLINE shape #-}+    bounds (Herm _ a) = ((0,0),(n-1,n-1)) where n = min (numRows a) (numCols a)+    {-# INLINE bounds #-}+      +instance (MatrixShaped a) => MatrixShaped (Herm a) where+    herm = coerceHerm+    {-# INLINE herm #-}+    +instance Show (a (n,n) e) => Show (Herm a (n,n) e) where+    show (Herm u a) = constructor ++ " (" ++ show a ++ ")"+      where+        constructor = case u of+            Lower -> "hermL"+            Upper -> "hermU"
+ lib/Data/Matrix/Tri.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.Tri+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Triangular views of matrices.+--++module Data.Matrix.Tri (+    -- * Triangular matrix types+    Tri(..),++    triFromBase,+    triToBase,+    mapTri,++    lower,+    lowerU,+    upper,+    upperU,++    coerceTri,++    -- * Overloaded interface for solving linear systems+    module Data.Matrix.Class.ISolve,+    module Data.Matrix.Class.MSolve,+    ) where++import Data.Matrix.TriBase+import Data.Matrix.Class.ISolve+import Data.Matrix.Class.MSolve
+ lib/Data/Matrix/TriBase.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Matrix.TriBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Matrix.TriBase+    where++import Unsafe.Coerce++import Data.Matrix.Class+import Data.Tensor.Class+import BLAS.Types ( UpLoEnum(..), DiagEnum(..), flipUpLo )++-- | A triangular or trapezoidal view of an underlying matrix.  The view +-- can either be of the upper or lower triangular part of the matrix, and+-- can optionally include or exclude the diagonal.  If the diagonal enum +-- is @Unit@, the diagonal entries of the underlying matrix are not+-- referenced, but are assumed to be @1@.  The type arguments are as follows:+--+--     * @a@: the underlyting matrix type.+--+--     * @np@: a phantom type for the shape of the view.+--+--     * @e@: the element type of the matrix.+--+data Tri a np e = Tri UpLoEnum DiagEnum (a np e)++-- | Cast the phantom shape type.+coerceTri :: Tri a np e -> Tri a np' e+coerceTri = unsafeCoerce++-- | Apply a function to the base matrix.+mapTri :: (a np e -> b np' e) -> Tri a np e -> Tri b np' e+mapTri f (Tri u d a) = Tri u d $ f a++-- | Convert from a base matrix type to a triangular view.+triFromBase :: UpLoEnum -> DiagEnum -> a (n,p) e -> Tri a (n,p) e+triFromBase = Tri+        +-- | Convert from a triangular view to the base matrix.+triToBase :: Tri a (n,p) e -> (UpLoEnum, DiagEnum, a (n,p) e)+triToBase (Tri u d a) = (u,d,a)++-- | Get a lower triangular view of a matrix.+lower :: (MatrixShaped a) => a (n,p) e -> Tri a (n,p) e+lower = Tri Lower NonUnit++-- | Get a lower triangular view of a matrix, with unit diagonal.+lowerU :: (MatrixShaped a) => a (n,p) e -> Tri a (n,p) e+lowerU = Tri Lower Unit++-- | Get an upper triangular view of a matrix.+upper :: (MatrixShaped a) => a (n,p) e -> Tri a (n,p) e+upper = Tri Upper NonUnit++-- | Get an upper triangular view of a matrix, with unit diagonal.+upperU :: (MatrixShaped a) => a (n,p) e -> Tri a (n,p) e+upperU = Tri Upper Unit++      +instance (MatrixShaped a) => Shaped (Tri a) (Int,Int) where+    shape (Tri Lower _ a) = (numRows a, min (numRows a) (numCols a))+    shape (Tri Upper _ a) = (min (numRows a) (numCols a), numCols a)+    {-# INLINE shape #-}    +    bounds a = ((0,0),(m-1,n-1)) where (m,n) = shape a+    {-# INLINE bounds #-}+    +instance (MatrixShaped a) => MatrixShaped (Tri a) where+    herm (Tri u d a) = Tri (flipUpLo u) d (herm a)+    {-# INLINE herm #-}++instance (Show (a (n,p) e), MatrixShaped a) => Show (Tri a (n,p) e) where+    show (Tri u d a) =+        constructor ++ suffix ++ " (" ++ show a ++ ")"+        where+          constructor = case (u,d) of+              (Lower, NonUnit) -> "lower"+              (Lower, Unit   ) -> "lowerU"+              (Upper, NonUnit) -> "upper"+              (Upper, Unit   ) -> "upperU"++          suffix = case undefined of+                       _ | isSquare a -> ""+                       _ | isFat a    -> "Fat"+                       _              -> "Tall"
+ lib/Data/Tensor/Class.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Tensor.Class+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Overloaded interface for mutable and immutable tensors.  This module+-- contains the common functionality for the classes in +-- "Data.Tensor.Class.ITensor" and "Data.Tensor.Class.MTensor".+--++module Data.Tensor.Class (+    Shaped(..),+    ) where++import Data.Ix++-- | The base class for objects with shapes and indices +-- (i.e. Vector, Matrix, etc.).+class (Ix i, Show i) => Shaped x i | x -> i where+    -- | Get the shape of the tensor.  For vectors this is the dimension.+    -- For matrices, this will be a pair @(m,n)@ of the number of rows+    -- and columns.+    shape :: x n e -> i+    +    -- | Get the range of valid indices in the tensor.+    bounds :: x n e -> (i,i)
+ lib/Data/Tensor/Class/ITensor.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Tensor.Class.ITensor+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Overloaded interface for immutable tensors.++module Data.Tensor.Class.ITensor (+    ITensor(..),+    (!),+    ) where++import Data.Tensor.Class+import Data.Ix+++infixl 9 !+infixl 7 *>+infixl 5 `shift`+++-- | A class for immutable tensors.+class (Shaped x i) => ITensor x i e where+    -- | Get the numer of elements stored in the tensor.+    size :: x n e -> Int+    +    -- | Get a new tensor by replacing the elements at the given indices.+    (//) :: x n e -> [(i,e)] -> x n e++    -- | Get the value at the given index, without doing any bounds-checking.+    unsafeAt :: x n e -> i -> e+    +    -- | Same as '(//)' but doesn't do any bounds-checking.+    unsafeReplace :: x n e -> [(i,e)] -> x n e+    +    -- | Get the indices of the elements stored in the tensor.+    indices :: x n e -> [i]+    indices = fst . unzip . assocs+    {-# INLINE indices #-}+    +    -- | Get the elements stored in the tensor.+    elems :: x n e -> [e]+    elems = snd . unzip . assocs+    {-# INLINE elems #-}++    -- | Get the list of @(@index@,@ element@)@ pairs stored in the tensor.+    assocs :: x n e -> [(i,e)]++    -- accum :: (e -> e' -> e) -> x e -> [(i,e')] -> x e+    +    -- | Apply a function elementwise to a tensor.+    tmap :: (e -> e) -> x n e -> x n e+    +    -- ixmap :: i -> (i -> i) -> x e -> x e+    -- unsafeIxMap+    +    -- | Scale every element by the given value.+    (*>) :: (Num e) => e -> x n e -> x n e+    (*>) k = tmap (k*)+    {-# INLINE (*>) #-}+    +    -- | Add a constant to every element.+    shift :: (Num e) => e -> x n e -> x n e+    shift k = tmap (k+)+    {-# INLINE shift #-}+    +-- | Get the value at the given index.  Range-checks the argument.+(!) :: (ITensor x i e) => x n e -> i -> e+(!) x i =+    case (inRange b i) of+        False -> +            error $ "tried to get element at a index `" ++ show i ++ "'"+                    ++ " in an object with shape `" ++ show s ++ "'"+        True -> +            unsafeAt x i+  where+    b = bounds x+    s = shape x+{-# INLINE (!) #-}
+ lib/Data/Tensor/Class/MTensor.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Tensor.Class.MTensor+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Overloaded interface for mutable tensors.  This modules includes tensors+-- which can be /read/ in a monad, 'ReadTensor', as well as tensors which+-- can be /modified/ in a monad, 'WriteTensor'.+--++module Data.Tensor.Class.MTensor (+    -- * Read-only tensor type class+    ReadTensor(..),+    readElem,+    +    -- * Modifiable tensor type class+    WriteTensor(..),+    writeElem,+    modifyElem,+    swapElems,+    ) where++import Data.Elem.BLAS ( Elem, conjugate )+import Data.Ix+import Data.Tensor.Class++-- | Class for mutable read-only tensors.+class (Shaped x i, Monad m) => ReadTensor x i e m | x -> i where+    -- | Get the number of elements stored in the tensor.+    getSize :: x n e -> m Int+    +    -- | Get the value at the specified index, without doing any +    -- range-checking.+    unsafeReadElem :: x n e -> i -> m e++    -- | Returns a lazy list of the indices in the tensor.  +    -- Because of the laziness, this function should be used with care.+    -- See also "getIndices'".+    getIndices :: x n e -> m [i]++    -- | Returns a list of the indices in the tensor.  See also+    -- 'getIndices'.+    getIndices' :: x n e -> m [i]++    -- | Returns a lazy list of the elements in the tensor.  +    -- Because of the laziness, this function should be used with care.+    -- See also "getElems'".    +    getElems :: x n e -> m [e]+    getElems x = getAssocs x >>= return . snd . unzip+    {-# INLINE getElems #-}++    -- | Returns a list of the elements in the tensor.  See also+    -- 'getElems'.+    getElems' :: x n e -> m [e]+    getElems' x = getAssocs' x >>= return . snd . unzip+    {-# INLINE getElems' #-}+    +    -- | Returns a lazy list of the elements-index pairs in the tensor.  +    -- Because of the laziness, this function should be used with care.+    -- See also "getAssocs'".        +    getAssocs :: x n e -> m [(i,e)]+    getAssocs x = do+        is <- getIndices x+        es <- getElems x+        return $ zip is es+    {-# INLINE getAssocs #-}++    -- | Returns a list of the index-elements pairs in the tensor.  See also+    -- 'getAssocs'.+    getAssocs' :: x n e -> m [(i,e)]+    getAssocs' x = do+        is <- getIndices' x+        es <- getElems' x+        return $ zip is es+    {-# INLINE getAssocs' #-}++-- | Gets the value at the specified index after checking that the argument+-- is in bounds.+readElem :: (ReadTensor x i e m) => x n e -> i -> m e+readElem x i =+    case (inRange b i) of+        False -> +            fail $ "tried to get element at a index `" ++ show i ++ "'"+                   ++ " in an object with shape `" ++ show s ++ "'"+        True -> +            unsafeReadElem x i+  where+      b = bounds x+      s = shape x+{-# INLINE readElem #-}++-- | Class for modifiable mutable tensors.+class (ReadTensor x i e m) => WriteTensor x i e m | x -> m where+    -- | Get the maximum number of elements that can be stored in the tensor.+    getMaxSize :: x n e -> m Int+    getMaxSize = getSize+    {-# INLINE getMaxSize #-}+    +    -- | Sets all stored elements to zero.+    setZero :: (Num e) => x n e -> m ()+    setZero = setConstant 0+    {-# INLINE setZero #-}+    +    -- | Sets all stored elements to the given value.+    setConstant :: e -> x n e -> m ()++    -- | True if the value at a given index can be changed+    canModifyElem :: x n e -> i -> m Bool+    +    -- | Set the value of the element at the given index, without doing any+    -- range checking.+    unsafeWriteElem :: x n e -> i -> e -> m ()+    +    -- | Modify the value of the element at the given index, without doing+    -- any range checking.+    unsafeModifyElem :: x n e -> i -> (e -> e) -> m ()+    unsafeModifyElem x i f = do+        e <- unsafeReadElem x i+        unsafeWriteElem x i (f e)+    {-# INLINE unsafeModifyElem #-}+    +    -- | Replace each element by a function applied to it+    modifyWith :: (e -> e) -> x n e -> m ()++    -- | Same as 'swapElem' but arguments are not range-checked.+    unsafeSwapElems :: x n e -> i -> i -> m ()+    unsafeSwapElems x i j = do+        e <- unsafeReadElem x i+        f <- unsafeReadElem x j+        unsafeWriteElem x j e+        unsafeWriteElem x i f+    {-# INLINE unsafeSwapElems #-}+    +    -- | Replace every element with its complex conjugate.+    doConj :: (Elem e) => x n e -> m ()+    doConj = modifyWith conjugate+    {-# INLINE doConj #-}++    -- | Scale every element in the vector by the given value.+    scaleBy :: (Num e) => e -> x n e -> m ()+    scaleBy 1 = const $ return ()+    scaleBy k = modifyWith (k*)+    {-# INLINE scaleBy #-}++    -- | Add a value to every element in a vector.+    shiftBy :: (Num e) => e -> x n e -> m ()+    shiftBy 0 = const $ return ()+    shiftBy k = modifyWith (k+)+    {-# INLINE shiftBy #-}++-- | Set the value of the element at the given index.+writeElem :: (WriteTensor x i e m) => x n e -> i -> e -> m ()+writeElem x i e = do+    ok <- canModifyElem x i+    case ok && inRange (bounds x) i of+        False -> +            fail $ "tried to set element at index `" ++ show i ++ "'"+                   ++ " in an object with shape `" ++ show s ++ "'"+                   ++ " but that element cannot be modified"+        True ->+            unsafeWriteElem x i e+  where+    s = shape x+{-# INLINE writeElem #-}++-- | Update the value of the element at the given index.+modifyElem :: (WriteTensor x i e m) => x n e -> i -> (e -> e) -> m ()+modifyElem x i f = do+    ok <- canModifyElem x i+    case ok of+        False -> +            fail $ "tried to modify element at index `" ++ show i ++ "'"+                   ++ " in an object with shape `" ++ show s ++ "'"+                   ++ " but that element cannot be modified"+        True ->+            unsafeModifyElem x i f+  where+    s = shape x+{-# INLINE modifyElem #-}++-- | Swap the values stored at two positions in the tensor.+swapElems :: (WriteTensor x i e m) => x n e -> i -> i -> m ()+swapElems x i j+    | not ((inRange (bounds x) i) && (inRange (bounds x) j)) = +        fail $ "Tried to swap elements `" ++ show i ++ "' and `"+               ++ show j ++ "' in a tensor of shape `" ++ show (shape x) +               ++ "'."+    | otherwise =+        unsafeSwapElems x i j+{-# INLINE swapElems #-}
+ lib/Data/Vector/Dense.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Vector.Dense+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Immutable dense vectors.++module Data.Vector.Dense (+    -- * The Vector type+    Vector,++    -- * Overloaded interface for vectors+    BaseVector( dim, conj, isConj, coerceVector ),++    -- * Creating new vectors+    vector, +    listVector,++    -- * Special vectors+    zeroVector,+    constantVector,+    basisVector,++    -- * Overloaded interface for reading vector elements+    module Data.Tensor.Class.ITensor,++    -- * Vector views+    subvector,+    subvectorWithStride,++    -- * Vector properties+    sumAbs,+    norm2,+    whichMaxAbs,+    (<.>),++    ) where++import Data.Vector.Dense.Base+import Data.Tensor.Class.ITensor
+ lib/Data/Vector/Dense/Base.hs view
@@ -0,0 +1,887 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Vector.Dense.Base+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Vector.Dense.Base+    where++import Control.Monad+import Control.Monad.ST+import Data.AEq+import Foreign+import Unsafe.Coerce++import BLAS.Internal( checkBinaryOp, clearArray, inlinePerformIO,+    checkedSubvector, checkedSubvectorWithStride, checkVecVecOp )++import Data.Elem.BLAS ( Complex, Elem, BLAS1, conjugate )+import qualified Data.Elem.BLAS.Level1 as BLAS++import Data.Tensor.Class+import Data.Tensor.Class.ITensor+import Data.Tensor.Class.MTensor++import Data.Vector.Dense.IOBase++infixl 7 <.>++-- | Immutable dense vectors. The type arguments are as follows:+--+--     * @n@: a phantom type for the dimension of the vector+--+--     * @e@: the element type of the vector.  Only certain element types+--       are supported.+--+newtype Vector n e = Vector (IOVector n e)++freezeIOVector :: (BLAS1 e) => IOVector n e -> IO (Vector n e)+freezeIOVector x = do+    y <- newCopyIOVector x+    return (Vector y)++thawIOVector :: (BLAS1 e) => Vector n e -> IO (IOVector n e)+thawIOVector (Vector x) =+    newCopyIOVector x++unsafeFreezeIOVector :: IOVector n e -> IO (Vector n e)+unsafeFreezeIOVector = return . Vector++unsafeThawIOVector :: Vector n e -> IO (IOVector n e)+unsafeThawIOVector (Vector x) = return x++-- | Common functionality for all vector types.+class (Shaped x Int, Elem e) => BaseVector x e where+    -- | Get the dimension (length) of the vector.+    dim :: x n e -> Int+    +    -- | Get the memory stride (in elements) between consecutive elements.+    stride :: x n e -> Int++    -- | Indicate whether or not internally the vector stores the complex+    -- conjugates of its elements.+    isConj :: x n e -> Bool++    -- | Get a view into the complex conjugate of a vector.+    conj :: x n e -> x n e++    -- | Cast the shape type of the vector.+    coerceVector :: x n e -> x n' e+    coerceVector = unsafeCoerce+    {-# INLINE coerceVector #-}++    unsafeSubvectorViewWithStride :: Int -> x n e -> Int -> Int -> x n' e++    -- | Unsafe cast from a vector to an 'IOVector'.+    unsafeVectorToIOVector :: x n e -> IOVector n e+    unsafeIOVectorToVector :: IOVector n e -> x n e++-- | Vectors that can be read in a monad.+class (BaseVector x e, BLAS1 e, Monad m, ReadTensor x Int e m) => ReadVector x e m where+    -- | Cast the vector to an 'IOVector', perform an @IO@ action, and+    -- convert the @IO@ action to an action in the monad @m@.  This+    -- operation is /very/ unsafe.+    unsafePerformIOWithVector :: x n e -> (IOVector n e -> IO a) -> m a++    -- | Convert a mutable vector to an immutable one by taking a complete+    -- copy of it.+    freezeVector :: x n e -> m (Vector n e)+    unsafeFreezeVector :: x n e -> m (Vector n e)++-- | Vectors that can be created or modified in a monad.+class (ReadVector x e m, WriteTensor x Int e m) => WriteVector x e m where+    -- | Unsafely convert an 'IO' action that creates an 'IOVector' into+    -- an action in @m@ that creates a vector.+    unsafeConvertIOVector :: IO (IOVector n e) -> m (x n e)++    -- | Creates a new vector of the given length.  The elements will be+    -- uninitialized.+    newVector_ :: Int -> m (x n e)++    -- | Convert an immutable vector to a mutable one by taking a complete+    -- copy of it.+    thawVector :: Vector n e -> m (x n e)+    unsafeThawVector :: Vector n e -> m (x n e)++-- | Creates a new vector with the given association list.  Unspecified+-- indices will get initialized to zero.+newVector :: (WriteVector x e m) => Int -> [(Int,e)] -> m (x n e)+newVector n ies = do+    x <- newZeroVector n+    unsafePerformIOWithVector x $ \x' ->+        withIOVector x' $ \p -> do+            forM_ ies $ \(i,e) -> do+                when (i < 0 || i >= n) $ fail $+                    "Index `" ++ show i ++ +                        "' is invalid for a vector with dimension `" ++ +                        show n ++ "'"+                pokeElemOff p i e+            return x+{-# INLINE newVector #-}++unsafeNewVector :: (WriteVector x e m) => Int -> [(Int,e)] -> m (x n e)+unsafeNewVector n ies = do+    x <- newZeroVector n+    unsafePerformIOWithVector x $ \x' ->+        withIOVector x' $ \p -> do+            forM_ ies $ \(i,e) ->+                pokeElemOff p i e+            return x+{-# INLINE unsafeNewVector #-}++-- | Creates a new vector of the given dimension with the given elements.+-- If the list has length less than the passed-in dimenson, the tail of+-- the vector will be uninitialized.+newListVector :: (WriteVector x e m) => Int -> [e] -> m (x n e)+newListVector n es = do+    x <- newVector_ n+    unsafePerformIOWithVector x $ \x' ->+        withIOVector x' $ \p -> do+            pokeArray p $ take n $ es ++ (repeat 0)+            return x+{-# INLINE newListVector #-}++-- | Create a zero vector of the specified length.+newZeroVector :: (WriteVector x e m) => Int -> m (x n e)+newZeroVector n = do+    x <- newVector_ n+    unsafePerformIOWithVector x $ \x' ->+        withIOVector x' $ \p -> do+            clearArray p n+            return x+{-# INLINE newZeroVector #-}++-- | Set every element in the vector to zero.+setZeroVector :: (WriteVector x e m) => x n e -> m ()+setZeroVector x =+    unsafePerformIOWithVector x $ setZeroIOVector+{-# INLINE setZeroVector #-}++-- | Create a vector with every element initialized to the same value.+newConstantVector :: (WriteVector x e m) => Int -> e -> m (x n e)+newConstantVector n e = do+    x <- newVector_ n+    unsafePerformIOWithVector x $ \x' ->+        withIOVector x' $ \p -> do+            pokeArray p (replicate n e)+            return x+{-# INLINE newConstantVector #-}++-- | Set every element in the vector to a constant.+setConstantVector :: (WriteVector x e m) => e -> x n e -> m ()+setConstantVector e x =+    unsafePerformIOWithVector x $ setConstantIOVector e+{-# INLINE setConstantVector #-}++-- | @newBasisVector n i@ creates a vector of length @n@ that is all zero +-- except for at position @i@, where it equal to one.+newBasisVector :: (WriteVector x e m) => Int -> Int -> m (x n e)+newBasisVector n i = do+    x <- newZeroVector n+    unsafePerformIOWithVector x $ \x' ->+        withIOVector x' $ \p -> do+            pokeElemOff p i 1+            return x+{-# INLINE newBasisVector #-}++-- | @setBasis x i@ sets the @i@th coordinate of @x@ to @1@, and all other+-- coordinates to @0@.  If the vector has been scaled, it is possible that+-- @readVector x i@ will not return exactly @1@.  See 'setElem'.+setBasisVector :: (WriteVector x e m) => Int -> x n e -> m ()+setBasisVector i x+    | i < 0 || i >= dim x =+        fail $ "tried to set a vector of dimension `" ++ show (dim x) ++ "'"+               ++ " to basis vector `" ++ show i ++ "'"+    | otherwise = do+        setZeroVector x+        unsafeWriteElem x i 1 +{-# INLINE setBasisVector #-}++-- | Creates a new vector by copying another one.+newCopyVector :: (ReadVector x e m, WriteVector y e m) =>+    x n e -> m (y n e)+newCopyVector x+    | isConj x =+        newCopyVector (conj x) >>= return . conj+    | otherwise = do+        y <- newVector_ n+        unsafePerformIOWithVector y $ \y' ->+            withIOVector (unsafeVectorToIOVector x) $ \pX ->+                withIOVector y' $ \pY ->+                    BLAS.copy n pX incX pY 1+        return y+  where+    n    = dim x+    incX = stride x+{-# INLINE newCopyVector #-}++-- | Creates a new vector by copying another one.  The returned vector+-- is gauranteed not to be a view into another vector.  That is, the+-- returned vector will have @isConj@ to be @False@.+newCopyVector' :: (ReadVector x e m, WriteVector y e m) => x n e -> m (y n e)+newCopyVector' x | not (isConj x) = newCopyVector x+                 | otherwise = do+                     y <- newCopyVector (conj x)+                     unsafePerformIOWithVector y $ \y' ->+                        withIOVector y' $ \pY -> do+                            BLAS.vconj (dim x) pY 1+                            return y+{-# INLINE newCopyVector' #-}++-- | @copyVector dst src@ replaces the values in @dst@ with those in+-- source.  The operands must be the same shape.+copyVector :: (WriteVector y e m, ReadVector x e m) =>+    y n e -> x n e -> m ()+copyVector y x = checkBinaryOp (shape x) (shape y) $ unsafeCopyVector y x+{-# INLINE copyVector #-}++unsafeCopyVector :: (ReadVector y e m, ReadVector x e m) =>+    y n e -> x n e -> m ()+unsafeCopyVector y x+    | isConj x =+        unsafeCopyVector (conj y) (conj x)+    | isConj y = do+        vectorCall2 BLAS.copy x y+        vectorCall  BLAS.vconj y+    | otherwise =+        vectorCall2 BLAS.copy x y+{-# INLINE unsafeCopyVector #-}++-- | Swap the values stored in two vectors.+swapVector :: (WriteVector x e m, WriteVector y e m) => +    x n e -> y n e -> m ()+swapVector x y = checkBinaryOp (shape x) (shape y) $ unsafeSwapVector x y+{-# INLINE swapVector #-}++unsafeSwapVector :: (ReadVector x e m, ReadVector y e m) =>+    x n e -> y n e -> m ()+unsafeSwapVector x y+    | isConj x =+        unsafeSwapVector (conj x) (conj y)+    | isConj y = do+        vectorCall2 BLAS.swap x y+        vectorCall  BLAS.vconj x+        vectorCall  BLAS.vconj y+    | otherwise =+        vectorCall2 BLAS.swap x y+{-# INLINE unsafeSwapVector #-}++-- | @subvectorView x o n@ creates a subvector view of @x@ starting at index @o@ +-- and having length @n@.+subvectorView :: (BaseVector x e) => +    x n e -> Int -> Int -> x n' e+subvectorView x = checkedSubvector (dim x) (unsafeSubvectorView x)+{-# INLINE subvectorView #-}++unsafeSubvectorView :: (BaseVector x e) => +    x n e -> Int -> Int -> x n' e+unsafeSubvectorView = unsafeSubvectorViewWithStride 1+{-# INLINE unsafeSubvectorView #-}++-- | @subvectorViewWithStride s x o n@ creates a subvector view of @x@ starting +-- at index @o@, having length @n@ and stride @s@.+subvectorViewWithStride :: (BaseVector x e) => +    Int -> x n e -> Int -> Int -> x n' e+subvectorViewWithStride s x = +    checkedSubvectorWithStride s (dim x) (unsafeSubvectorViewWithStride s x)+{-# INLINE subvectorViewWithStride #-}++-- | Get a new vector with elements with the conjugates of the elements+-- of the given vector+getConjVector :: (ReadVector x e m, WriteVector y e m) =>+    x n e -> m (y n e)+getConjVector = getUnaryVectorOp doConjVector+{-# INLINE getConjVector #-}++-- | Conjugate every element of the vector.+doConjVector :: (WriteVector y e m) => y n e -> m ()+doConjVector x =+    unsafePerformIOWithVector x $ doConjIOVector+{-# INLINE doConjVector #-}++-- | Get a new vector by scaling the elements of another vector+-- by a given value.+getScaledVector :: (ReadVector x e m, WriteVector y e m) =>+    e -> x n e -> m (y n e)+getScaledVector e = getUnaryVectorOp (scaleByVector e)+{-# INLINE getScaledVector #-}++-- | Scale every element by the given value.+scaleByVector :: (WriteVector y e m) => e -> y n e -> m ()+scaleByVector k x =+    unsafePerformIOWithVector x $ scaleByIOVector k+{-# INLINE scaleByVector #-}++-- | Get a new vector by shifting the elements of another vector+-- by a given value.+getShiftedVector :: (ReadVector x e m, WriteVector y e m) =>+    e -> x n e -> m (y n e)+getShiftedVector e = getUnaryVectorOp (shiftByVector e)+{-# INLINE getShiftedVector #-}++-- | Add the given value to every element.+shiftByVector :: (WriteVector y e m) => e -> y n e -> m ()+shiftByVector k x =+    unsafePerformIOWithVector x $ shiftByIOVector k+{-# INLINE shiftByVector #-}++-- | @getAddVector x y@ creates a new vector equal to the sum @x+y@.  The +-- operands must have the same dimension.+getAddVector :: +    (ReadVector x e m, ReadVector y e m, WriteVector z e m) =>+    x n e -> y n e -> m (z n e)+getAddVector = checkVectorOp2 unsafeGetAddVector+{-# INLINE getAddVector #-}++unsafeGetAddVector :: +    (ReadVector x e m, ReadVector y e m, WriteVector z e m) =>+    x n e -> y n e -> m (z n e)+unsafeGetAddVector = unsafeGetBinaryVectorOp unsafeAddVector+{-# INLINE unsafeGetAddVector #-}++-- | @addVector y x@ replaces @y@ with @y+x@.+addVector :: (WriteVector y e m, ReadVector x e m) => +    y n e -> x n e -> m ()+addVector y x = checkBinaryOp (dim y) (dim x) $ unsafeAddVector y x+{-# INLINE addVector #-}++unsafeAddVector :: (WriteVector y e m, ReadVector x e m) =>+    y n e -> x n e -> m ()+unsafeAddVector y x = unsafeAxpyVector 1 x y+{-# INLINE unsafeAddVector #-}++-- | @getSubVector x y@ creates a new tensor equal to the difference @x-y@.  +-- The operands must have the same dimension.+getSubVector :: +    (ReadVector x e m, ReadVector y e m, WriteVector z e m) =>+    x n e -> y n e -> m (z n e)+getSubVector = checkVectorOp2 unsafeGetSubVector+{-# INLINE getSubVector #-}++unsafeGetSubVector :: +    (ReadVector x e m, ReadVector y e m, WriteVector z e m) =>+    x n e -> y n e -> m (z n e)+unsafeGetSubVector = unsafeGetBinaryVectorOp unsafeSubVector+{-# INLINE unsafeGetSubVector #-}++-- | @subVector y x@ replaces @y@ with @y-x@.+subVector :: (WriteVector y e m, ReadVector x e m) => +    y n e -> x n e -> m ()+subVector y x = checkBinaryOp (dim y) (dim x) $ unsafeSubVector y x+{-# INLINE subVector #-}++unsafeSubVector :: (WriteVector y e m, ReadVector x e m) =>+    y n e -> x n e -> m ()+unsafeSubVector y x = unsafeAxpyVector (-1) x y+{-# INLINE unsafeSubVector #-}++-- | @axpyVector alpha x y@ replaces @y@ with @alpha * x + y@.+axpyVector :: (ReadVector x e m, WriteVector y e m) =>+    e -> x n e -> y n e -> m ()+axpyVector alpha x y = +    checkBinaryOp (shape x) (shape y) $ unsafeAxpyVector alpha x y+{-# INLINE axpyVector #-}++unsafeAxpyVector :: (ReadVector x e m, ReadVector y e m) =>+    e -> x n e -> y n e -> m ()+unsafeAxpyVector alpha x y+    | isConj y =+        unsafeAxpyVector (conjugate alpha) (conj x) (conj y)+    | isConj x =+        vectorCall2 (flip BLAS.acxpy alpha) x y+    | otherwise =+        vectorCall2 (flip BLAS.axpy alpha) x y+{-# INLINE unsafeAxpyVector #-}++-- | @getMulVector x y@ creates a new vector equal to the elementwise product +-- @x*y@.  The operands must have the same dimensino+getMulVector :: +    (ReadVector x e m, ReadVector y e m, WriteVector z e m) =>+    x n e -> y n e -> m (z n e)+getMulVector = checkVectorOp2 unsafeGetMulVector+{-# INLINE getMulVector #-}++unsafeGetMulVector :: +    (ReadVector x e m, ReadVector y e m, WriteVector z e m) =>+    x n e -> y n e -> m (z n e)+unsafeGetMulVector = unsafeGetBinaryVectorOp unsafeMulVector+{-# INLINE unsafeGetMulVector #-}++-- | @mulVector y x@ replaces @y@ with @y*x@.+mulVector :: (WriteVector y e m, ReadVector x e m) => +    y n e -> x n e -> m ()+mulVector y x =+    checkBinaryOp (shape y) (shape x) $ unsafeMulVector y x+{-# INLINE mulVector #-}+ +unsafeMulVector :: (WriteVector y e m, ReadVector x e m) =>+    y n e -> x n e -> m ()+unsafeMulVector y x+    | isConj y =+        unsafeMulVector (conj y) (conj x)+    | isConj x =+        vectorCall2 BLAS.vcmul x y+    | otherwise =+        vectorCall2 BLAS.vmul x y+{-# INLINE unsafeMulVector #-}++-- | @getDivVector x y@ creates a new vector equal to the elementwise +-- ratio @x/y@.  The operands must have the same shape.+getDivVector :: +    (ReadVector x e m, ReadVector y e m, WriteVector z e m) =>+    x n e -> y n e -> m (z n e)+getDivVector = checkVectorOp2 unsafeGetDivVector+{-# INLINE getDivVector #-}++unsafeGetDivVector :: +    (ReadVector x e m, ReadVector y e m, WriteVector z e m) =>+    x n e -> y n e -> m (z n e)+unsafeGetDivVector = unsafeGetBinaryVectorOp unsafeDivVector+{-# INLINE unsafeGetDivVector #-}++-- | @divVector y x@ replaces @y@ with @y/x@.+divVector :: (WriteVector y e m, ReadVector x e m) => +    y n e -> x n e -> m ()+divVector y x =+    checkBinaryOp (shape y) (shape x) $ unsafeDivVector y x+{-# INLINE divVector #-}++unsafeDivVector :: (WriteVector y e m, ReadVector x e m) =>+    y n e -> x n e -> m ()+unsafeDivVector y x+    | isConj y =+        unsafeDivVector (conj y) (conj x)+    | isConj x =+        vectorCall2 BLAS.vcdiv x y+    | otherwise =+        vectorCall2 BLAS.vdiv x y+{-# INLINE unsafeDivVector #-}++-- | Gets the sum of the absolute values of the vector entries.+getSumAbs :: (ReadVector x e m) => x n e -> m Double+getSumAbs = vectorCall BLAS.asum+{-# INLINE getSumAbs #-}+    +-- | Gets the 2-norm of a vector.+getNorm2 :: (ReadVector x e m) => x n e -> m Double+getNorm2 = vectorCall 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 :: (ReadVector x e m) => x n e -> m (Int, e)+getWhichMaxAbs x =+    case (dim x) of+        0 -> fail $ "getWhichMaxAbs of an empty vector"+        _ -> do+            i <- vectorCall BLAS.iamax x+            e <- unsafeReadElem x i+            return (i,e)+{-# INLINE getWhichMaxAbs #-}++-- | Computes the dot product of two vectors.+getDot :: (ReadVector x e m, ReadVector y e m) => +    x n e -> y n e -> m e+getDot x y = checkVecVecOp "getDot" (dim x) (dim y) $ unsafeGetDot x y+{-# INLINE getDot #-}++unsafeGetDot :: (ReadVector x e m, ReadVector y e m) => +    x n e -> y n e -> m e+unsafeGetDot x y =+    case (isConj x, isConj y) of+        (False, False) -> vectorCall2 BLAS.dotc x y+        (True , False) -> vectorCall2 BLAS.dotu x y+        (False, True ) -> liftM conjugate $ vectorCall2 BLAS.dotu x y+        (True , True)  -> liftM conjugate $ vectorCall2 BLAS.dotc x y+{-# INLINE unsafeGetDot #-}++instance (Elem e) => BaseVector IOVector e where+    dim = dimIOVector+    {-# INLINE dim #-}+    stride = strideIOVector+    {-# INLINE stride #-}+    isConj = isConjIOVector+    {-# INLINE isConj #-}+    conj = conjIOVector+    {-# INLINE conj #-}+    unsafeSubvectorViewWithStride = unsafeSubvectorViewWithStrideIOVector+    {-# INLINE unsafeSubvectorViewWithStride #-}+    unsafeVectorToIOVector = id+    {-# INLINE unsafeVectorToIOVector #-}+    unsafeIOVectorToVector = id+    {-# INLINE unsafeIOVectorToVector #-}+    +instance (BLAS1 e) => ReadVector IOVector e IO where+    unsafePerformIOWithVector x f = f x+    {-# INLINE unsafePerformIOWithVector #-}+    freezeVector = freezeIOVector+    {-# INLINE freezeVector #-}+    unsafeFreezeVector = unsafeFreezeIOVector+    {-# INLINE unsafeFreezeVector #-}++instance (BLAS1 e) => WriteVector IOVector e IO where+    newVector_ = newIOVector_+    {-# INLINE newVector_ #-}+    unsafeConvertIOVector = id+    {-# NOINLINE unsafeConvertIOVector #-}+    thawVector = thawIOVector+    {-# INLINE thawVector #-}+    unsafeThawVector = unsafeThawIOVector+    {-# INLINE unsafeThawVector #-}+++-- | Create a vector with the given dimension and elements.  The elements+-- given in the association list must all have unique indices, otherwise+-- the result is undefined.+vector :: (BLAS1 e) => Int -> [(Int, e)] -> Vector n e+vector n ies = unsafePerformIO $+    unsafeFreezeIOVector =<< newVector n ies+{-# NOINLINE vector #-}++-- | Same as 'vector', but does not range-check the indices.+unsafeVector :: (BLAS1 e) => Int -> [(Int, e)] -> Vector n e+unsafeVector n ies = unsafePerformIO $+    unsafeFreezeIOVector =<< unsafeNewVector n ies+{-# NOINLINE unsafeVector #-}++-- | Create a vector of the given dimension with elements initialized+-- to the values from the list.  @listVector n es@ is equivalent to +-- @vector n (zip [0..(n-1)] es)@, except that the result is undefined +-- if @length es@ is less than @n@.+listVector :: (BLAS1 e) => Int -> [e] -> Vector n e+listVector n es = Vector $ unsafePerformIO $ newListVector n es+{-# NOINLINE listVector #-}++replaceVector :: (BLAS1 e) => Vector n e -> [(Int,e)] -> Vector n e+replaceVector (Vector x) ies =+    unsafePerformIO $ do+        y <- newCopyVector x+        mapM_ (uncurry $ writeElem y) ies+        return (Vector y)+{-# NOINLINE replaceVector #-}++unsafeReplaceVector :: (BLAS1 e) => Vector n e -> [(Int,e)] -> Vector n e+unsafeReplaceVector (Vector x) ies =+    unsafePerformIO $ do+        y <- newCopyVector x+        mapM_ (uncurry $ unsafeWriteElem y) ies+        return (Vector y)+{-# NOINLINE unsafeReplaceVector #-}++-- | @zeroVector n@ creates a vector of dimension @n@ with all values+-- set to zero.+zeroVector :: (BLAS1 e) => Int -> Vector n e+zeroVector n = unsafePerformIO $ +    unsafeFreezeIOVector =<< newZeroVector n+{-# NOINLINE zeroVector #-}++-- | @constantVector n e@ creates a vector of dimension @n@ with all values+-- set to @e@.+constantVector :: (BLAS1 e) => Int -> e -> Vector n e+constantVector n e = unsafePerformIO $+    unsafeFreezeIOVector =<< newConstantVector n e+{-# NOINLINE constantVector #-}++-- | @basisVector n i@ creates a vector of dimension @n@ with zeros +-- everywhere but position @i@, where there is a one.+basisVector :: (BLAS1 e) => Int -> Int -> Vector n e+basisVector n i = unsafePerformIO $+    unsafeFreezeIOVector =<< newBasisVector n i+{-# NOINLINE basisVector #-}++-- | @subvector x o n@ creates a subvector of @x@ starting at index @o@ +-- and having length @n@.+subvector :: (BLAS1 e) => Vector n e -> Int -> Int -> Vector n' e+subvector = subvectorView+{-# INLINE subvector #-}++unsafeSubvector :: (BLAS1 e) => Vector n e -> Int -> Int -> Vector n' e+unsafeSubvector = unsafeSubvectorView+{-# INLINE unsafeSubvector #-}++-- | @subvectorWithStride s x o n@ creates a subvector of @x@ starting +-- at index @o@, having length @n@ and stride @s@.+subvectorWithStride :: (BLAS1 e) =>+    Int -> Vector n e -> Int -> Int -> Vector n' e+subvectorWithStride = subvectorViewWithStride+{-# INLINE subvectorWithStride #-}+    +sizeVector :: Vector n e -> Int+sizeVector (Vector x) = sizeIOVector x+{-# INLINE sizeVector #-}++indicesVector :: Vector n e -> [Int]+indicesVector (Vector x) = indicesIOVector x+{-# INLINE indicesVector #-}++elemsVector :: (Elem e) => Vector n e -> [e]+elemsVector x | isConj x  = (map conjugate . elemsVector . conj) x+              | otherwise = case x of { (Vector (IOVector f p n incX _)) ->+    let end = p `advancePtr` (n*incX)+        go p' | p' == end = inlinePerformIO $ do+                                io <- touchForeignPtr f+                                io `seq` return []+              | otherwise = let e = inlinePerformIO (peek p')+                                es = go (p' `advancePtr` incX)+                            in e `seq` (e:es)+    in go p }+{-# SPECIALIZE INLINE elemsVector :: Vector n Double -> [Double] #-}+{-# SPECIALIZE INLINE elemsVector :: Vector n (Complex Double) -> [Complex Double] #-}++assocsVector :: (Elem e) => Vector n e -> [(Int,e)]+assocsVector x = zip (indicesVector x) (elemsVector x)+{-# INLINE assocsVector #-}++unsafeAtVector :: (Elem e) => Vector n e -> Int -> e+unsafeAtVector x i | isConj x  = conjugate $ unsafeAtVector (conj x) i+                   | otherwise = case x of { (Vector (IOVector f p _ inc _)) ->+    inlinePerformIO $ do+        e  <- peekElemOff p (i*inc)+        io <- touchForeignPtr f+        e `seq` io `seq` return e+    }+{-# INLINE unsafeAtVector #-}++tmapVector :: (BLAS1 e) => (e -> e) -> Vector n e -> Vector n e+tmapVector f x = listVector (dim x) (map f $ elemsVector x)+{-# INLINE tmapVector #-}++tzipWithVector :: (BLAS1 e) =>+    (e -> e -> e) -> Vector n e -> Vector n e -> Vector n e+tzipWithVector f x y+    | dim y /= n =+        error ("tzipWith: vector lengths differ; first has length `" +++                show n ++ "' and second has length `" +++                show (dim y) ++ "'")+    | otherwise =+        listVector n (zipWith f (elems x) (elems y))+  where+    n = dim x+{-# INLINE tzipWithVector #-}++scaleVector :: (BLAS1 e) => e -> Vector n e -> Vector n e+scaleVector e (Vector x) = +    unsafePerformIO $ unsafeFreezeIOVector =<< getScaledVector e x+{-# NOINLINE scaleVector #-}++shiftVector :: (BLAS1 e) => e -> Vector n e -> Vector n e+shiftVector e (Vector x) = +    unsafePerformIO $ unsafeFreezeIOVector =<< getShiftedVector e x+{-# NOINLINE shiftVector #-}++-- | Compute the sum of absolute values of entries in the vector.+sumAbs :: (BLAS1 e) => Vector n e -> Double+sumAbs (Vector x) = unsafePerformIO $ getSumAbs x+{-# NOINLINE sumAbs #-}++-- | Compute the 2-norm of a vector.+norm2 :: (BLAS1 e) => Vector n e -> Double+norm2 (Vector x) = unsafePerformIO $ getNorm2 x+{-# NOINLINE 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 n e -> (Int, e)+whichMaxAbs (Vector x) = unsafePerformIO $ getWhichMaxAbs x+{-# NOINLINE whichMaxAbs #-}++-- | Compute the dot product of two vectors.+(<.>) :: (BLAS1 e) => Vector n e -> Vector n e -> e+(<.>) x y = unsafePerformIO $ getDot x y+{-# NOINLINE (<.>) #-}++instance Shaped Vector Int where+    shape (Vector x) = shapeIOVector x+    {-# INLINE shape #-}+    bounds (Vector x) = boundsIOVector x+    {-# INLINE bounds #-}++instance (BLAS1 e) => ITensor Vector Int e where+    (//) = replaceVector+    {-# INLINE (//) #-}+    unsafeReplace = unsafeReplaceVector+    {-# INLINE unsafeReplace #-}+    unsafeAt = unsafeAtVector+    {-# INLINE unsafeAt #-}+    size = sizeVector+    {-# INLINE size #-}+    elems = elemsVector+    {-# INLINE elems #-}+    indices = indicesVector+    {-# INLINE indices #-}+    assocs = assocsVector+    {-# INLINE assocs #-}+    tmap = tmapVector+    {-# INLINE tmap #-}+    (*>) = scaleVector+    {-# INLINE (*>) #-}+    shift = shiftVector+    {-# INLINE shift #-}++instance (BLAS1 e, Monad m) => ReadTensor Vector Int e m where+    getSize = return . size+    {-# INLINE getSize #-}+    getAssocs = return . assocs+    {-# INLINE getAssocs #-}+    getIndices = return . indices+    {-# INLINE getIndices #-}+    getElems = return . elems+    {-# INLINE getElems #-}+    getAssocs' = return . assocs+    {-# INLINE getAssocs' #-}+    getIndices' = return . indices+    {-# INLINE getIndices' #-}+    getElems' = return . elems+    {-# INLINE getElems' #-}+    unsafeReadElem x i = return $ unsafeAt x i+    {-# INLINE unsafeReadElem #-}+    +instance (Elem e) => BaseVector Vector e where    +    dim (Vector x) = dimIOVector x+    {-# INLINE dim #-}+    stride (Vector x) = strideIOVector x+    {-# INLINE stride #-}+    isConj (Vector x) = isConjIOVector x+    {-# INLINE isConj #-}+    conj (Vector x) = (Vector (conjIOVector x))+    {-# INLINE conj #-}+    unsafeSubvectorViewWithStride s (Vector x) o n = +        Vector (unsafeSubvectorViewWithStrideIOVector s x o n)+    {-# INLINE unsafeSubvectorViewWithStride #-}+    unsafeVectorToIOVector (Vector x) = x+    {-# INLINE unsafeVectorToIOVector #-}+    unsafeIOVectorToVector = Vector+    {-# INLINE unsafeIOVectorToVector #-}++instance (BLAS1 e) => ReadVector Vector e IO where+    unsafePerformIOWithVector (Vector x) f = f x+    {-# INLINE unsafePerformIOWithVector #-}+    freezeVector (Vector x) = freezeIOVector x+    {-# INLINE freezeVector #-}+    unsafeFreezeVector = return+    {-# INLINE unsafeFreezeVector #-}++instance (BLAS1 e) => ReadVector Vector e (ST s) where+    unsafePerformIOWithVector (Vector x) f = unsafeIOToST $ f x+    {-# INLINE unsafePerformIOWithVector #-}    +    freezeVector (Vector x) = unsafeIOToST $ freezeIOVector x+    {-# INLINE freezeVector #-}+    unsafeFreezeVector = return+    {-# INLINE unsafeFreezeVector #-}++instance (Elem e, Show e) => Show (Vector n e) where+    show x+        | isConj x  = "conj (" ++ show (conj x) ++ ")"+        | otherwise = "listVector " ++ show (dim x) ++ " " ++ show (elemsVector x)++instance (BLAS1 e) => Eq (Vector n e) where+    (==) = compareVectorWith (==)++instance (BLAS1 e) => AEq (Vector n e) where+    (===) = compareVectorWith (===)+    (~==) = compareVectorWith (~==)++compareVectorWith :: (Elem e) => +    (e -> e -> Bool) -> +        Vector n e -> Vector n e -> Bool+compareVectorWith cmp x y+    | isConj x && isConj y =+        compareVectorWith cmp (conj x) (conj y)+    | otherwise =+        (dim x == dim y) && (and $ zipWith cmp (elemsVector x) (elemsVector y))++instance (BLAS1 e) => Num (Vector n e) where+    (+) x y = unsafePerformIO $ unsafeFreezeIOVector =<< getAddVector x y+    {-# NOINLINE (+) #-}+    (-) x y = unsafePerformIO $ unsafeFreezeIOVector =<< getSubVector x y+    {-# NOINLINE (-) #-}+    (*) x y = unsafePerformIO $ unsafeFreezeIOVector =<< getMulVector x y+    {-# NOINLINE (*) #-}+    negate = ((-1) *>)+    {-# INLINE negate #-}+    abs           = tmap abs+    signum        = tmap signum+    fromInteger n = listVector 1 [fromInteger n]+    +instance (BLAS1 e) => Fractional (Vector n e) where+    (/) x y      = unsafePerformIO $ unsafeFreezeIOVector =<< getDivVector x y+    {-# NOINLINE (/) #-}+    recip          = tmap recip+    fromRational q = listVector 1 [fromRational q]+    +instance (BLAS1 e, Floating e) => Floating (Vector n e) where+    pi    = listVector 1 [pi]+    exp   = tmap exp+    sqrt  = tmap sqrt+    log   = tmap log+    (**)  = tzipWithVector (**)+    sin   = tmap sin+    cos   = tmap cos+    tan   = tmap tan+    asin  = tmap asin+    acos  = tmap acos+    atan  = tmap atan+    sinh  = tmap sinh+    cosh  = tmap cosh+    tanh  = tmap tanh+    asinh = tmap asinh+    acosh = tmap acosh+    atanh = tmap atanh++vectorCall :: (ReadVector x e m)+           => (Int -> Ptr e -> Int -> IO a) +           ->  x n e -> m a+vectorCall f x = +    unsafePerformIOWithVector x $ \x' ->+        let n    = dimIOVector x'+            incX = strideIOVector x'+        in withIOVector x' $ \pX ->+               f n pX incX+{-# INLINE vectorCall #-}++vectorCall2 :: (ReadVector x e m, ReadVector y f m)+            => (Int -> Ptr e -> Int -> Ptr f -> Int -> IO a) +            -> x n e -> y n' f -> m a+vectorCall2 f x y =+    unsafePerformIOWithVector x $ \x' ->+        let y'   = unsafeVectorToIOVector y+            n    = dimIOVector x'+            incX = strideIOVector x'+            incY = strideIOVector y'+        in withIOVector x' $ \pX ->+           withIOVector y' $ \pY ->+               f n pX incX pY incY+{-# INLINE vectorCall2 #-}    ++checkVectorOp2 :: (BaseVector x e, BaseVector y f) => +    (x n e -> y n f -> a) ->+        x n e -> y n f -> a+checkVectorOp2 f x y = +    checkBinaryOp (dim x) (dim y) $ f x y+{-# INLINE checkVectorOp2 #-}++getUnaryVectorOp :: (ReadVector x e m, WriteVector y e m) =>+    (y n e -> m ()) -> x n e -> m (y n e)+getUnaryVectorOp f x = do+    y <- newCopyVector x+    f y+    return y+{-# INLINE getUnaryVectorOp #-}++unsafeGetBinaryVectorOp :: +    (WriteVector z e m, ReadVector x e m, ReadVector y e m) =>+    (z n e -> y n e -> m ()) ->+        x n e -> y n e -> m (z n e)+unsafeGetBinaryVectorOp f x y = do+    z <- newCopyVector x+    f z y+    return z+{-# INLINE unsafeGetBinaryVectorOp #-}
+ lib/Data/Vector/Dense/Class.hs view
@@ -0,0 +1,87 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Vector.Dense.Class+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- An overloaded interface to mutable dense vectors.  For vector types+-- than can be used with this interface, see "Data.Vector.Dense.IO" and+-- "Data.Vector.Dense.ST".  Many of these functions can also be used with+-- the immutable type defined in "Data.Vector.Dense".+--++module Data.Vector.Dense.Class (+    -- * Dense vector type classes+    BaseVector( dim, conj, stride, isConj, coerceVector ),+    ReadVector,+    WriteVector,+    +    -- * Creating new vectors+    newVector_,+    newVector,+    newListVector,+    +    -- * Special vectors+    newZeroVector,+    newConstantVector,+    newBasisVector,+    setZeroVector,+    setConstantVector,+    setBasisVector,++    -- * Copying vectors+    newCopyVector,+    newCopyVector',+    copyVector,+    swapVector,++    -- * Vector views+    subvectorView,+    subvectorViewWithStride,++    -- * Overloaded interface for reading and writing vector elements+    module Data.Tensor.Class.MTensor,++    -- * Vector operations+    -- ** Unary+    getConjVector,+    getScaledVector,+    getShiftedVector,+    doConjVector,+    scaleByVector,+    shiftByVector,+    +    -- ** Binary+    getAddVector,+    getSubVector,+    getMulVector,+    getDivVector,+    addVector,+    subVector,+    axpyVector,+    mulVector,+    divVector,++    -- * Vector Properties+    getSumAbs,+    getNorm2,+    getWhichMaxAbs,+    getDot,++    -- * Conversions between mutable and immutable vectors+    freezeVector,+    thawVector,+    unsafeFreezeVector,+    unsafeThawVector,++    -- * Conversions from @IOVector@s+    unsafeVectorToIOVector,+    unsafeConvertIOVector,+    unsafePerformIOWithVector,+    +    ) where++import Data.Vector.Dense.Base+import Data.Tensor.Class.MTensor
+ lib/Data/Vector/Dense/IO.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Vector.Dense.IO+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Mutable vectors in the IO monad.++module Data.Vector.Dense.IO (+    -- * The IOVector data type+    IOVector,+    vectorViewArray,+    vectorViewArrayWithStride,+    withIOVector,+    +    -- * Overloaded mutable dense vector interface+    module Data.Vector.Dense.Class,+    ) where++import Data.Vector.Dense.IOBase+import Data.Vector.Dense.Class
+ lib/Data/Vector/Dense/IOBase.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Vector.Dense.IOBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Vector.Dense.IOBase+    where++import Control.Monad+import Foreign+import System.IO.Unsafe++import BLAS.Internal ( clearArray )+import Data.Elem.BLAS ( Complex, Elem, BLAS1, conjugate )+import qualified Data.Elem.BLAS.Level1 as BLAS++import Data.Tensor.Class+import Data.Tensor.Class.MTensor++-- | Dense vectors in the 'IO' monad.  The type arguments are as follows:+--+--     * @n@: a phantom type for the dimension of the vector+--+--     * @e@: the element type of the vector.  Only certain element types+--       are supported.+--+data IOVector n e = +      IOVector {-# UNPACK #-} !(ForeignPtr e) -- memory owner+               {-# UNPACK #-} !(Ptr e)        -- pointer to the first element+               {-# UNPACK #-} !Int            -- the length of the vector+               {-# UNPACK #-} !Int            -- the stride (in elements, not bytes) between elements.+               {-# UNPACK #-} !Bool           -- indicates whether or not the vector is conjugated++-- | View an array in memory as a vector.+vectorViewArray :: (Elem e)+                => ForeignPtr e +                -> Int          -- ^ offset+                -> Int          -- ^ length+                -> IOVector n e+vectorViewArray = vectorViewArrayWithStride 1+{-# INLINE vectorViewArray #-}++-- | View an array in memory as a vector, with the given stride.+vectorViewArrayWithStride :: (Elem e)+                          => Int          -- ^ stride+                          -> ForeignPtr e+                          -> Int          -- ^ offset+                          -> Int          -- ^ length+                          -> IOVector n e+vectorViewArrayWithStride s f o n =+    let p = unsafeForeignPtrToPtr f `advancePtr` o+    in IOVector f p n s False+{-# INLINE vectorViewArrayWithStride #-}+                          +dimIOVector :: IOVector n e -> Int+dimIOVector (IOVector _ _ n _ _) = n+{-# INLINE dimIOVector #-}++strideIOVector :: IOVector n e -> Int+strideIOVector (IOVector _ _ _ incX _) = incX+{-# INLINE strideIOVector #-}++isConjIOVector :: IOVector n e -> Bool+isConjIOVector (IOVector _ _ _ _ c) = c+{-# INLINE isConjIOVector #-}++conjIOVector :: IOVector n e -> IOVector n e+conjIOVector (IOVector f p n incX c) = (IOVector f p n incX (not c))+{-# INLINE conjIOVector #-}++unsafeSubvectorViewWithStrideIOVector :: (Elem e) =>+    Int -> IOVector n e -> Int -> Int -> IOVector n' e+unsafeSubvectorViewWithStrideIOVector s' (IOVector f p _ inc c) o' n' =+    IOVector f (p `advancePtr` (inc*o')) n' (inc*s') c+{-# INLINE unsafeSubvectorViewWithStrideIOVector #-}++-- | Execute an 'IO' action with a pointer to the first element in the+-- vector.+withIOVector :: IOVector n e -> (Ptr e -> IO a) -> IO a+withIOVector (IOVector f p _ _ _) g = do+    a <- g p+    touchForeignPtr f+    return a+{-# INLINE withIOVector #-}++newIOVector_ :: (Elem e) => Int -> IO (IOVector n e)+newIOVector_ n+    | n < 0 = +        fail $ "Tried to create a vector with `" ++ show n ++ "' elements."+    | otherwise = do+        arr <- mallocForeignPtrArray n+        return $ IOVector arr (unsafeForeignPtrToPtr arr) n 1 False++newCopyIOVector :: (BLAS1 e) => IOVector n e -> IO (IOVector n e)+newCopyIOVector (IOVector f p n incX c) = do+    (IOVector f' p' _ _ _) <- newIOVector_ n+    BLAS.copy n p incX p' 1+    touchForeignPtr f+    touchForeignPtr f'+    return (IOVector f' p' n 1 c)++shapeIOVector :: IOVector n e -> Int+shapeIOVector = dimIOVector+{-# INLINE shapeIOVector #-}++boundsIOVector :: IOVector n e -> (Int,Int)+boundsIOVector x = (0, dimIOVector x - 1)+{-# INLINE boundsIOVector #-}++sizeIOVector :: IOVector n e -> Int+sizeIOVector = dimIOVector+{-# INLINE sizeIOVector #-}++getSizeIOVector :: IOVector n e -> IO Int+getSizeIOVector = return . sizeIOVector+{-# INLINE getSizeIOVector #-}++getMaxSizeIOVector :: IOVector n e -> IO Int+getMaxSizeIOVector = getSizeIOVector+{-# INLINE getMaxSizeIOVector #-}++indicesIOVector :: IOVector n e -> [Int]+indicesIOVector x = [ 0..n-1 ] where n = dimIOVector x+{-# INLINE indicesIOVector #-}++getIndicesIOVector :: IOVector n e -> IO [Int]+getIndicesIOVector = return . indicesIOVector+{-# INLINE getIndicesIOVector #-}++getIndicesIOVector' :: IOVector n e -> IO [Int]+getIndicesIOVector' = getIndicesIOVector+{-# INLINE getIndicesIOVector' #-}++getElemsIOVector :: (Elem e) => IOVector n e -> IO [e]+getElemsIOVector (IOVector f p n incX True) = do+    es <- getElemsIOVector (IOVector f p n incX False)+    return $ map conjugate es+getElemsIOVector (IOVector f p n incX False) =+    let end = p `advancePtr` (n*incX)+        go p' | p' == end = do+                   touchForeignPtr f+                   return []+              | otherwise = unsafeInterleaveIO $ do+                  e   <- peek p'+                  es  <- go (p' `advancePtr` incX)+                  return (e:es)+    in go p+{-# SPECIALIZE INLINE getElemsIOVector :: IOVector n Double -> IO [Double] #-}+{-# SPECIALIZE INLINE getElemsIOVector :: IOVector n (Complex Double) -> IO [Complex Double] #-}++getElemsIOVector' :: (Elem e) => IOVector n e -> IO [e]+getElemsIOVector' (IOVector f p n incX True) = do+    es <- getElemsIOVector' (IOVector f p n incX False)+    return $ map conjugate es    +getElemsIOVector' (IOVector f p n incX False) =+    let end = p `advancePtr` (-incX)+        go p' es | p' == end = do+                      touchForeignPtr f+                      return es+                 | otherwise = do+                      e <- peek p'+                      go (p' `advancePtr` (-incX)) (e:es)+    in go (p `advancePtr` ((n-1)*incX)) []+{-# SPECIALIZE INLINE getElemsIOVector' :: IOVector n Double -> IO [Double] #-}+{-# SPECIALIZE INLINE getElemsIOVector' :: IOVector n (Complex Double) -> IO [Complex Double] #-}++getAssocsIOVector :: (Elem e) => IOVector n e -> IO [(Int,e)]+getAssocsIOVector x = liftM2 zip (getIndicesIOVector x) (getElemsIOVector x)+{-# INLINE getAssocsIOVector #-}++getAssocsIOVector' :: (Elem e) => IOVector n e -> IO [(Int,e)]+getAssocsIOVector' x = liftM2 zip (getIndicesIOVector' x) (getElemsIOVector' x)+{-# INLINE getAssocsIOVector' #-}++unsafeReadElemIOVector :: (Elem e) => IOVector n e -> Int -> IO e+unsafeReadElemIOVector (IOVector f p n incX c) i+    | c = liftM conjugate $ unsafeReadElemIOVector (IOVector f p n incX False) i+    | otherwise = do+        e <- peekElemOff p (i*incX)+        touchForeignPtr f+        return e+{-# SPECIALIZE INLINE unsafeReadElemIOVector :: IOVector n Double -> Int -> IO (Double) #-}+{-# SPECIALIZE INLINE unsafeReadElemIOVector :: IOVector n (Complex Double) -> Int -> IO (Complex Double) #-}++canModifyElemIOVector :: IOVector n e -> Int -> IO Bool+canModifyElemIOVector _ _ = return True+{-# INLINE canModifyElemIOVector #-}++unsafeWriteElemIOVector :: (Elem e) => IOVector n e -> Int -> e -> IO ()+unsafeWriteElemIOVector (IOVector f p _ incX c) i e =+    let e' = if c then conjugate e else e+    in do+        pokeElemOff p (i*incX) e'+        touchForeignPtr f+{-# SPECIALIZE INLINE unsafeWriteElemIOVector :: IOVector n Double -> Int -> Double -> IO () #-}+{-# SPECIALIZE INLINE unsafeWriteElemIOVector :: IOVector n (Complex Double) -> Int -> Complex Double -> IO () #-}++unsafeModifyElemIOVector :: (Elem e) => IOVector n e -> Int -> (e -> e) -> IO ()+unsafeModifyElemIOVector (IOVector f p _ incX c) i g =+    let g' = if c then conjugate . g . conjugate else g+        p' = p `advancePtr` (i*incX)+    in do+        e <- peek p'+        poke p' (g' e)+        touchForeignPtr f+{-# SPECIALIZE INLINE unsafeModifyElemIOVector :: IOVector n Double -> Int -> (Double -> Double) -> IO () #-}+{-# SPECIALIZE INLINE unsafeModifyElemIOVector :: IOVector n (Complex Double) -> Int -> (Complex Double -> Complex Double) -> IO () #-}++unsafeSwapElemsIOVector :: (Elem e) => IOVector n e -> Int -> Int -> IO ()+unsafeSwapElemsIOVector (IOVector f p _ incX _) i1 i2 =+    let p1 = p `advancePtr` (i1*incX)+        p2 = p `advancePtr` (i2*incX)+    in do+        e1 <- peek p1+        e2 <- peek p2+        poke p2 e1+        poke p1 e2+        touchForeignPtr f+{-# SPECIALIZE INLINE unsafeSwapElemsIOVector :: IOVector n Double -> Int -> Int -> IO () #-}+{-# SPECIALIZE INLINE unsafeSwapElemsIOVector :: IOVector n (Complex Double) -> Int -> Int -> IO () #-}+                            +modifyWithIOVector :: (Elem e) => (e -> e) -> IOVector n e -> IO ()+modifyWithIOVector g (IOVector f p n incX c) =+    let g'  = if c then (conjugate . g . conjugate) else g+        end = p `advancePtr` (n*incX)+        go p' | p' == end = touchForeignPtr f+              | otherwise = do+                   e <- peek p'+                   poke p' (g' e)+                   go (p' `advancePtr` incX)+    in go p+{-# SPECIALIZE INLINE modifyWithIOVector :: (Double -> Double) -> IOVector n Double -> IO () #-}+{-# SPECIALIZE INLINE modifyWithIOVector :: (Complex Double -> Complex Double) -> IOVector n (Complex Double) -> IO () #-}++setZeroIOVector :: (Elem e) => IOVector n e -> IO ()+setZeroIOVector x@(IOVector f p n incX _)+    | incX == 1 = clearArray p n >> touchForeignPtr f+    | otherwise = setConstantIOVector 0 x+{-# INLINE setZeroIOVector #-}++setConstantIOVector :: (Elem e) => e -> IOVector n e -> IO ()+setConstantIOVector 0 x | strideIOVector x == 1 = setZeroIOVector x+setConstantIOVector e (IOVector f p n incX c) =+    let e'   = if c then conjugate e else e+        end = p `advancePtr` (n*incX)+        go p' | p' == end = touchForeignPtr f+              | otherwise = do+                   poke p' e'+                   go (p' `advancePtr` incX)+    in go p+{-# INLINE setConstantIOVector #-}++doConjIOVector :: (BLAS1 e) => IOVector n e -> IO ()+doConjIOVector (IOVector f p n incX _) =+    BLAS.vconj n p incX >> touchForeignPtr f+{-# INLINE doConjIOVector #-}++scaleByIOVector :: (BLAS1 e) => e -> IOVector n e -> IO ()+scaleByIOVector 1 _ = return ()+scaleByIOVector k (IOVector f p n incX c) =+    let k' = if c then conjugate k else k+    in BLAS.scal n k' p incX >> touchForeignPtr f+{-# INLINE scaleByIOVector #-}+                    +shiftByIOVector :: (Elem e) => e -> IOVector n e -> IO ()                    +shiftByIOVector k x | isConjIOVector x = +                        shiftByIOVector (conjugate k) (conjIOVector x)+                    | otherwise = +                        modifyWithIOVector (k+) x+{-# INLINE shiftByIOVector #-}++instance Shaped IOVector Int where+    shape = shapeIOVector+    {-# INLINE shape #-}+    bounds = boundsIOVector+    {-# INLINE bounds #-}++instance (Elem e) => ReadTensor IOVector Int e IO where+    getSize = getSizeIOVector+    {-# INLINE getSize #-}+    unsafeReadElem = unsafeReadElemIOVector+    {-# INLINE unsafeReadElem #-}+    getIndices = getIndicesIOVector+    {-# INLINE getIndices #-}+    getIndices' = getIndicesIOVector'+    {-# INLINE getIndices' #-}+    getElems = getElemsIOVector+    {-# INLINE getElems #-}+    getElems' = getElemsIOVector'+    {-# INLINE getElems' #-}+    getAssocs = getAssocsIOVector+    {-# INLINE getAssocs #-}+    getAssocs' = getAssocsIOVector'+    {-# INLINE getAssocs' #-}++instance (BLAS1 e) => WriteTensor IOVector Int e IO where+    getMaxSize = getMaxSizeIOVector+    {-# INLINE getMaxSize #-}+    setZero = setZeroIOVector+    {-# INLINE setZero #-}+    setConstant = setConstantIOVector+    {-# INLINE setConstant #-}+    canModifyElem = canModifyElemIOVector+    {-# INLINE canModifyElem #-}+    unsafeWriteElem = unsafeWriteElemIOVector+    {-# INLINE unsafeWriteElem #-}+    unsafeModifyElem = unsafeModifyElemIOVector+    {-# INLINE unsafeModifyElem #-}+    modifyWith = modifyWithIOVector+    {-# INLINE modifyWith #-}+    doConj = doConjIOVector+    {-# INLINE doConj #-}+    scaleBy = scaleByIOVector+    {-# INLINE scaleBy #-}+    shiftBy = shiftByIOVector+    {-# INLINE shiftBy #-}
+ lib/Data/Vector/Dense/ST.hs view
@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Data.Vector.Dense.ST+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Mutable vectors in the ST monad.++module Data.Vector.Dense.ST (+    -- * The @STVector@ data type+    runSTVector,+    STVector,+    +    -- * Overloaded mutable dense vector interface+    module Data.Vector.Dense.Class+    ) where++import Data.Vector.Dense.STBase( STVector, runSTVector )+import Data.Vector.Dense.Class
+ lib/Data/Vector/Dense/STBase.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE Rank2Types, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Vector.Dense.STBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Data.Vector.Dense.STBase+    where++import Control.Monad+import Control.Monad.ST++import Data.Elem.BLAS( Elem, BLAS1 )++import Data.Tensor.Class+import Data.Tensor.Class.MTensor++import Data.Vector.Dense.Base+import Data.Vector.Dense.IOBase++-- | Dense vectors in the 'ST' monad.  The type arguments are as follows:+--+--     * @s@: the state variable argument for the 'ST' type+--+--     * @n@: a phantom type for the dimension of the vector+--+--     * @e@: the element type of the vector.  Only certain element types+--       are supported.+--+newtype STVector s n e = STVector (IOVector n e)++-- | 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 unsafeFreezeVector internally,+-- but this wrapper is a safe interface to that function. +runSTVector :: (forall s . ST s (STVector s n e)) -> Vector n e+runSTVector mx = +    runST $ mx >>= \(STVector x) -> return (Vector x)++instance Shaped (STVector s) Int where+    shape (STVector x) = shapeIOVector x+    {-# INLINE shape #-}+    bounds (STVector x) = boundsIOVector x+    {-# INLINE bounds #-}++instance (Elem e) => ReadTensor (STVector s) Int e (ST s) where+    getSize (STVector x) = unsafeIOToST $ getSizeIOVector x+    {-# INLINE getSize #-}+    unsafeReadElem (STVector x) i = unsafeIOToST $ unsafeReadElemIOVector x i+    {-# INLINE unsafeReadElem #-}+    getIndices (STVector x) = unsafeIOToST $ getIndicesIOVector x+    {-# INLINE getIndices #-}+    getIndices' (STVector x) = unsafeIOToST $ getIndicesIOVector' x+    {-# INLINE getIndices' #-}+    getElems (STVector x) = unsafeIOToST $ getElemsIOVector x+    {-# INLINE getElems #-}+    getElems' (STVector x) = unsafeIOToST $ getElemsIOVector' x+    {-# INLINE getElems' #-}+    getAssocs (STVector x) = unsafeIOToST $ getAssocsIOVector x+    {-# INLINE getAssocs #-}+    getAssocs' (STVector x) = unsafeIOToST $ getAssocsIOVector' x+    {-# INLINE getAssocs' #-}++instance (BLAS1 e) => WriteTensor (STVector s) Int e (ST s) where+    getMaxSize (STVector x) = unsafeIOToST $ getMaxSizeIOVector x+    {-# INLINE getMaxSize #-}+    setZero (STVector x) = unsafeIOToST $ setZeroIOVector x+    {-# INLINE setZero #-}+    setConstant e (STVector x) = unsafeIOToST $ setConstantIOVector e x+    {-# INLINE setConstant #-}+    canModifyElem (STVector x) i = unsafeIOToST $ canModifyElemIOVector x i+    {-# INLINE canModifyElem #-}+    unsafeWriteElem (STVector x) i e= unsafeIOToST $ unsafeWriteElemIOVector x i e+    {-# INLINE unsafeWriteElem #-}+    unsafeModifyElem (STVector x) i f = unsafeIOToST $ unsafeModifyElemIOVector x i f+    {-# INLINE unsafeModifyElem #-}+    modifyWith f (STVector x) = unsafeIOToST $ modifyWithIOVector f x+    {-# INLINE modifyWith #-}+    doConj (STVector x) = unsafeIOToST $ doConjIOVector x+    {-# INLINE doConj #-}+    scaleBy k (STVector x) = unsafeIOToST $ scaleByIOVector k x+    {-# INLINE scaleBy #-}+    shiftBy k (STVector x) = unsafeIOToST $ shiftByIOVector k x+    {-# INLINE shiftBy #-}++instance (Elem e) => BaseVector (STVector s) e where+    dim (STVector x) = dimIOVector x+    {-# INLINE dim #-}+    stride (STVector x) = strideIOVector x+    {-# INLINE stride #-}+    isConj (STVector x) = isConjIOVector x+    {-# INLINE isConj #-}+    conj (STVector x) = STVector (conjIOVector x)+    {-# INLINE conj #-}+    unsafeSubvectorViewWithStride s (STVector x) o n = +        STVector (unsafeSubvectorViewWithStrideIOVector s x o n)+    {-# INLINE unsafeSubvectorViewWithStride #-}    +    unsafeVectorToIOVector (STVector x) = x+    {-# INLINE unsafeVectorToIOVector #-}+    unsafeIOVectorToVector = STVector+    {-# INLINE unsafeIOVectorToVector #-}++instance (BLAS1 e) => ReadVector (STVector s) e (ST s) where+    unsafePerformIOWithVector (STVector x) f = unsafeIOToST $ f x+    {-# INLINE unsafePerformIOWithVector #-}+    freezeVector (STVector x) = unsafeIOToST $ freezeIOVector x+    {-# INLINE freezeVector #-}+    unsafeFreezeVector (STVector x) = unsafeIOToST $ unsafeFreezeIOVector x+    {-# INLINE unsafeFreezeVector #-}++instance (BLAS1 e) => WriteVector (STVector s) e (ST s) where+    newVector_ = liftM STVector . unsafeIOToST . newIOVector_+    {-# INLINE newVector_ #-}+    unsafeConvertIOVector = unsafeIOToST . liftM STVector+    {-# NOINLINE unsafeConvertIOVector #-}+    thawVector = liftM STVector . unsafeIOToST . thawIOVector+    {-# INLINE thawVector #-}+    unsafeThawVector = liftM STVector . unsafeIOToST . unsafeThawIOVector+    {-# INLINE unsafeThawVector #-}
+ lib/Test/QuickCheck/BLAS.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Test.QuickCheck.BLAS+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--+-- Test generators for BLAS types.+--++module Test.QuickCheck.BLAS (+    -- * Testable element types+    TestElem(..),+    +    -- * Generating random objects+    -- ** Elements+    elements,+    realElements,+    +    -- ** Vectors+    dim,+    vector,+    +    -- ** Dense matrices+    shape,+    matrix,++    -- ** Banded matrices+    bandwidths,+    banded,+    ) where++import Test.QuickCheck.BLASBase
+ lib/Test/QuickCheck/BLASBase.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.QuickCheck.BLASBase+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Test.QuickCheck.BLASBase+    where+        +import Control.Monad+import Data.Maybe( fromJust )++import Test.QuickCheck hiding ( vector, elements )+import qualified Test.QuickCheck as QC++import Data.Vector.Dense( Vector, listVector, subvectorWithStride,+    conj )+import Data.Matrix.Dense( Matrix, listMatrix, herm, submatrix )+import Data.Matrix.Banded( Banded, maybeBandedFromMatrixStorage )+import Data.Elem.BLAS++-- | Element types that can be tested with QuickCheck properties.+class (BLAS3 e, Arbitrary e) => TestElem e where+    -- | Inicates whether or not the value should be used in tests.  For+    -- 'Double's, @isTestElemElem e@ is defined as +    -- @not (isNaN e || isInfinite e || isDenormalized e)@.+    isTestElemElem :: e -> Bool+    +instance TestElem Double where+    isTestElemElem e = not (isNaN e || isInfinite e || isDenormalized e)+    {-# INLINE isTestElemElem #-}++instance Arbitrary (Complex Double) where+    arbitrary = liftM2 (:+) arbitrary arbitrary+    {-# INLINE arbitrary #-}+    coarbitrary (x:+y) = coarbitrary (x,y)+    {-# INLINE coarbitrary #-}++instance TestElem (Complex Double) where+    isTestElemElem (x :+ y) = isTestElemElem x && isTestElemElem y+    {-# INLINE isTestElemElem #-}+    +-- | Generate a list of elements suitable for testing with.+elements :: (TestElem e) => Int -> Gen [e]+elements n = do+    es <- liftM (filter isTestElemElem) $ QC.vector n+    let n' = length es+    if n' < n+        then liftM (es ++) $ elements (n-n')+        else return es++-- | Generate a list of elements for testing that have no imaginary part.+realElements :: (TestElem e) => Int -> Gen [e]+realElements n = liftM (map fromReal) $ elements n++-- | Get an appropriate dimension for a random vector+dim :: Gen Int+dim = liftM abs arbitrary++-- | Generate a random vector of the given size.+vector :: (TestElem e) => Int -> Gen (Vector n e)+vector n =+    frequency [ (3, rawVector n)  +              , (2, conjVector n)+              , (1, subVector n    >>= \(SubVector s x o _) -> +                    return $ subvectorWithStride s x o n)+              ]    ++data SubVector n e = +    SubVector Int +              (Vector n e) +              Int +              Int +    deriving (Show)++instance (TestElem e) => Arbitrary (SubVector n e) where+    arbitrary = sized $ \m -> +        choose (0,m) >>= subVector+        +    coarbitrary = undefined++rawVector :: (TestElem e) => Int -> Gen (Vector n e)+rawVector n = do+    es <- elements n+    return $ listVector n es++conjVector :: (TestElem e) => Int -> Gen (Vector n e)+conjVector n = do+    x <- vector n+    return $ (conj x)++subVector :: (TestElem e) => Int -> Gen (SubVector n e)+subVector n = do+    o <- choose (0,5)+    s <- choose (1,5)+    e <- choose (0,5)+    x <- vector (o + s*n + e)+    return (SubVector s x o n)++data SubMatrix m n e = +    SubMatrix (Matrix (m,n) e) +              (Int,Int) +              (Int,Int) +    deriving (Show)++-- | Generate an appropriate shape for a random matrix.+shape :: Gen (Int,Int)+shape = sized $ \s ->+    let s' = (ceiling . sqrt) (fromIntegral s :: Double)+    in liftM2 (,) (choose (0,s')) (choose (0,1+s'))++-- | Generate a random matrix of the given shape.+matrix :: (TestElem e) => (Int,Int) -> Gen (Matrix (m,n) e)+matrix mn = frequency [ (3, rawMatrix mn)  +                      , (2, hermedMatrix mn)+                      , (1, subMatrix mn >>= \(SubMatrix a ij _) -> +                                 return $ submatrix a ij mn)+                      ]++rawMatrix :: (TestElem e) => (Int,Int) -> Gen (Matrix (m,n) e)+rawMatrix (m,n) = do+    es <- elements (m*n)+    return $ listMatrix (m,n) es++hermedMatrix :: (TestElem e) => (Int,Int) -> Gen (Matrix (m,n) e)+hermedMatrix (m,n) = do+    x <- matrix (n,m)+    return $ (herm x)++subMatrix :: (TestElem e) => (Int,Int) -> Gen (SubMatrix m n 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 m n 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 m n e) where+    arbitrary = do+        (m,n) <- shape+        (SubMatrix a ij mn) <- subMatrix (m,n)+        return $ SubMatrix a ij mn+        +    coarbitrary = undefined++-- | 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.+banded :: (TestElem e) => +    (Int,Int) -> (Int,Int) -> Gen (Banded (m,n) e)+banded mn lu = frequency [ (3, rawBanded mn lu)  +                         , (2, hermedBanded mn lu)+                         ]++rawBanded :: (TestElem e) => +    (Int,Int) -> (Int,Int) -> Gen (Banded (m,n) 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 (m,n) e)+hermedBanded (m,n) (kl,ku) = do+    x <- rawBanded (n,m) (ku,kl)+    return $ herm x+++
+ m4/ax_blas.m4 view
@@ -0,0 +1,231 @@+# SYNOPSIS+#+#   AX_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+#+#   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+#+#   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_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) acx_blas_ok=disable ;;+	-* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$with_blas" ;;+	*) BLAS_LIBS="-l$with_blas" ;;+esac++_AX_BLAS(gemm_, [ax_blas_ok=yes; ax_blas_underscore=yes],+    [_AX_BLAS(gemm, [ax_blas_ok=yes; ax_blas_underscore=no])])++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_BLAS+++# _AX_BLAS(GEMM, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])+# --------------------------------------------------------+# 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_BLAS], [+AC_PREREQ(2.50)+ax_blas_ok=no++# Get fortran linker names of BLAS functions to check for.+sgemm=s$1+dgemm=d$1++ax_blas_save_LIBS="$LIBS"+LIBS="$LIBS $FLIBS"++# First, check BLAS_LIBS environment variable+if test $ax_blas_ok = no; 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 $ax_blas_ok = no; 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 $ax_blas_ok = no; 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 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 Intel MKL library?+if test $ax_blas_ok = no; then+	AC_CHECK_LIB(mkl, $sgemm, [ax_blas_ok=yes;BLAS_LIBS="-lmkl"])+fi++# BLAS in Apple vecLib library?+if test $ax_blas_ok = no; then+	save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"+	AC_CHECK_FUNC($sgemm, [ax_blas_ok=yes;BLAS_LIBS="-framework vecLib"])+	LIBS="$save_LIBS"+fi++# BLAS in Alpha CXML library?+if test $ax_blas_ok = no; 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 $ax_blas_ok = no; then+	AC_CHECK_LIB(dxml, $sgemm, [ax_blas_ok=yes;BLAS_LIBS="-ldxml"])+fi++# BLAS in Sun Performance library?+if test $ax_blas_ok = no; 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 $ax_blas_ok = no; then+	AC_CHECK_LIB(scs, $sgemm, [ax_blas_ok=yes; BLAS_LIBS="-lscs"])+fi++# BLAS in SGIMATH library?+if test $ax_blas_ok = no; 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 $ax_blas_ok = no; 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 $ax_blas_ok = no; then+	AC_CHECK_LIB(blas, $sgemm, [ax_blas_ok=yes; BLAS_LIBS="-lblas"])+fi++LIBS="$ax_blas_save_LIBS"++# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:+if test x"$ax_blas_ok" = xyes; then+    $2+    :+else+    ax_blas_ok=no+    $3+fi+])dnl _AX_BLAS
tests/Banded.hs view
@@ -11,13 +11,13 @@  import Driver -import BLAS.Elem+import Data.Elem.BLAS import Data.Vector.Dense  import Data.Matrix.Dense ( Matrix, identityMatrix ) import Data.Matrix.Banded+import Data.Matrix.Banded.Base( listsFromBanded ) -import Generators.Matrix-import Generators.Matrix.Banded hiding ( banded )+import Test.Matrix.Banded hiding ( banded )          type V = Vector Int E type M = Matrix (Int,Int) E@@ -58,13 +58,14 @@ prop_shape (a :: B) =      shape a == (numRows a, numCols a) -prop_bandwidth (a :: B) =-    bandwidth a == ((negate . numLower) a, numUpper a)+prop_bandwidths (a :: B) =+    bandwidths a == (numLower a, numUpper a)  prop_size (a :: B) =-    size a == (sum $ map diagLen (range $ bandwidth a))+    size a == (sum $ map diagLen (range (-kl,ku)))   where     (m,n) = shape a+    (kl,ku) = bandwidths a     diagLen i | i <= 0    = min (m+i) n               | otherwise = min m     (n-i)  @@ -86,6 +87,10 @@     map dim (rows a) == replicate (numRows a) (numCols a) prop_cols_dims (a :: B) =     map dim (cols a) == replicate (numCols a) (numRows a)+prop_row_at (BandedAt (a :: B) (i,j)) =+    (row a i)!j === a!(i,j)+prop_col_at (BandedAt (a :: B) (i,j)) =+    (col a j)!i === a!(i,j)  prop_indices_length (a :: B) =     length (indices a) == size a@@ -105,9 +110,9 @@ prop_scale_elems (a :: B) k =     (assocs (k *> a)) `assocsEq` (map (second (*k)) (assocs a)) prop_herm_elem (BandedAt (a :: B) (i,j)) =-    (herm a) ! (j,i) === conj (a!(i,j))+    (herm a) ! (j,i) === conjugate (a!(i,j)) prop_herm_scale (a :: B) k =-    herm (k *> a) === (conj k) *> (herm a)+    herm (k *> a) === (conjugate k) *> (herm a)  prop_herm_shape (a :: B) =     shape (herm a) == (numCols a, numRows a)@@ -156,7 +161,7 @@     , ("elems of replace"      , mytest prop_replace_elems)          , ("numRows/numCols"       , mytest prop_shape)-    , ("numLower/numUpper"     , mytest prop_bandwidth)+    , ("numLower/numUpper"     , mytest prop_bandwidths)     , ("size"                  , mytest prop_size)     , ("bounds"                , mytest prop_bounds) @@ -167,6 +172,8 @@     , ("cols length"           , mytest prop_cols_len)     , ("rows dims"             , mytest prop_rows_dims)     , ("cols dims"             , mytest prop_cols_dims)+    , ("row at"                , mytest prop_row_at)+    , ("col at"                , mytest prop_col_at)      , ("indices length"        , mytest prop_indices_length)     , ("indices low bw"        , mytest prop_indices_lower)
− tests/Diag.hs 
@@ -1,56 +0,0 @@-module Diag( tests_Diag ) where-    -import Driver--import Generators.Matrix.Diag--import qualified BLAS.Elem as E-import Data.Vector.Dense-import Data.Matrix.Dense-import Data.Matrix.Diag--type V = Vector Int E-type M = Matrix (Int,Int) E-type D = Diag Vector (Int,Int) E---prop_diag_apply (DiagMV (d :: D) a x) =-    d <*> x ~== a <*> x--prop_diag_sapply k (DiagMV (d :: D) a x) =-    sapply k d x ~== sapply k a x--prop_diag_applyMat (DiagMM (d :: D) a b) =-    d <**> b ~== a <**> b--prop_diag_sapplyMat k (DiagMM (d :: D) a b) =-    sapplyMat k d b ~== sapplyMat k a b---prop_diag_solve (DiagSV (d :: D) y) =-    let x = d <\> y-    in d <*> x ~== y--prop_diag_ssolve k (DiagSV (d :: D) y) =-    ssolve k d y ~== d <\> (k *> y)--prop_diag_solveMat (DiagSM (d :: D) b) =-    let a = d <\\> b-    in d <**> a ~== b--prop_diag_ssolveMat k (DiagSM (d :: D) b) =-    ssolveMat k d b ~== d <\\> (k *> b)---tests_Diag =-    [ ("diag apply"             , mytest prop_diag_apply)-    , ("diag sapply"            , mytest prop_diag_sapply)-    , ("diag applyMat"          , mytest prop_diag_applyMat)-    , ("diag sapplyMat"         , mytest prop_diag_sapplyMat)--    , ("diag solve"             , mytest prop_diag_solve)-    , ("diag ssolve"            , mytest prop_diag_ssolve)-    , ("diag solveMat"          , mytest prop_diag_solveMat)-    , ("diag ssolveMat"         , mytest prop_diag_ssolveMat)-    -    ]
tests/Driver.hs view
@@ -51,13 +51,16 @@ import System.IO import System.Random +import Test.Vector.Dense()+import Test.Matrix.Dense()+import Test.Matrix.Banded()+ import Test.QuickCheck hiding ( vector )+import qualified Test.QuickCheck.BLAS as Test  import Text.Printf import Text.Show.Functions -import Generators.Matrix- #ifdef COMPLEX field = "Complex Double" type E = Complex Double @@ -66,10 +69,6 @@ type E = Double #endif -instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where-    arbitrary = liftM2 (:+) arbitrary arbitrary-    coarbitrary (x:+y) = coarbitrary (x,y)- newtype Natural = Nat Int deriving (Eq,Show) instance Arbitrary Natural where     arbitrary = do@@ -80,11 +79,7 @@  newtype Natural2 = Nat2 (Int,Int) deriving (Eq,Show) instance Arbitrary Natural2 where-    arbitrary = matrixSized $ \s -> do-        (Nat m) <- resize s arbitrary-        (Nat n) <- resize s arbitrary-        return $ Nat2 (m,n)-        +    arbitrary = liftM Nat2 Test.shape     coarbitrary = undefined  data Index = Index Int Int deriving (Eq,Show)@@ -98,10 +93,11 @@  data Index2 = Index2 (Int,Int) (Int,Int) deriving (Eq,Show) instance Arbitrary Index2 where-    arbitrary = matrixSized $ \s -> do-        (Index i m) <- resize s arbitrary-        (Index j n) <- resize s arbitrary-        return $ Index2 (i,j) (m,n)+    arbitrary = do+        (m',n') <- Test.shape+        i <- choose (0,m')+        j <- choose (0,n')+        return $ Index2 (i,j) (m'+1,n'+1)          coarbitrary = undefined
− tests/Generators/Matrix.hs 
@@ -1,20 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Generators.Matrix--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix-    where--import Test.QuickCheck-                -matrixSized :: (Int -> Gen a) -> Gen a-matrixSized f = -    sized $ \s ->-        let s' = ceiling (sqrt $ fromInteger $ toInteger s :: Double)-        in f s'-
− tests/Generators/Matrix/Banded.hs 
@@ -1,184 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : Test.QuickCheck.Matrix.Banded--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix.Banded (-    banded,-    -    BandedAt(..),-    ListsBanded(..),-    BandedMV(..),-    BandedMVPair(..),-    BandedMM(..),-    BandedMMPair(..),-    ) where--import Control.Monad( forM )--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC--import Generators.Vector.Dense ( vector )-import Generators.Matrix.Dense ( matrix )--import Data.Vector.Dense ( Vector, dim )-import Data.Matrix.Dense ( Matrix )-import Data.Matrix.Banded hiding ( banded )-import BLAS.Elem ( Elem, BLAS1 )---banded :: (BLAS1 e, Arbitrary e) => -    (Int,Int) -> (Int,Int) -> Gen (Banded (m,n) e)-banded mn kl = frequency [ (3, rawBanded mn kl)  -                         , (2, hermedBanded mn kl)-                         ]--rawBanded :: (BLAS1 e, Arbitrary e) => -    (Int,Int) -> (Int,Int) -> Gen (Banded (m,n) e)-rawBanded (m,n) (k,l) = do-    xs <- QC.vector ((k+1+l)*len)-    return $ listsBanded (m,n) (k,l) (splitDiags xs)-  where-    len = min m n-    -    splitDiags [] = [[]]-    splitDiags xs = let (d,xs') = splitAt len xs-                    in d:(splitDiags xs')--hermedBanded :: (BLAS1 e, Arbitrary e) => -    (Int,Int) -> (Int,Int) -> Gen (Banded (m,n) e)-hermedBanded (m,n) (l,u) = do-    x <- rawBanded (n,m) (u,l)-    return $ (herm x)--instance (Arbitrary e, BLAS1 e) => Arbitrary (Banded (m,n) e) where-    arbitrary = sized $ \k -> -        let k' = ceiling (sqrt $ fromInteger $ toInteger k :: Double)-        in do-            m <- choose (0,k')-            n <- choose (0,k')-            kl <- if m == 0 then return 0 else choose (0,m-1)-            ku <- if n == 0 then return 0 else choose (0,n-1)-            banded (m,n) (kl,ku)-        -    coarbitrary x =-        coarbitrary (assocs x)--data BandedAt m n e = BandedAt (Banded (m,n) e) (Int,Int) deriving (Eq, Show)-instance (Arbitrary e, BLAS1 e) => Arbitrary (BandedAt m n e) where-    arbitrary = sized $ \k ->-        let k' = ceiling (sqrt $ fromInteger $ toInteger k :: Double)-        in do-            m  <- choose (1,k'+1)-            n  <- choose (1,k'+1)-            kl <- choose (0,m-1)-            ku <- choose (0,n-1)-            i  <- choose (0,m-1)-            j  <- choose (0,n-1)-            a  <- banded (m,n) (kl,ku)-            -            return $ BandedAt a (i,j)--    coarbitrary = undefined---data ListsBanded e = ListsBanded (Int,Int) (Int,Int) [[e]] deriving (Eq,Show)-instance (Arbitrary e, Elem e) => Arbitrary (ListsBanded e) where-    arbitrary = sized $ \k ->-       let k' = ceiling (sqrt $ fromInteger $ toInteger k :: Double)-       in do-           m <- choose (1,k'+1)-           n <- choose (1,k'+1)-           kl <- choose (0,m-1)-           ku <- choose (0,n-1)-          -           ds <- forM [(-kl)..ku] $ \i ->-                     let beginPad = max (-i)    0-                         endPad   = max (m-n+i) 0-                         len      = m - (beginPad+endPad)-                     in do-                         xs <- QC.vector len-                         return $ replicate beginPad 0 ++ xs ++ replicate endPad 0-         -           return $ ListsBanded (m,n) (kl,ku) ds-          -    coarbitrary (ListsBanded mn lu ds) = coarbitrary (mn,lu,ds)-   -{--                    -data MatrixPair m n e = Pair (Matrix (m,n) e) (Matrix (m,n) e) deriving (Eq, Show)--instance (Arbitrary e, Elem e) => Arbitrary (MatrixPair m n e) where-    arbitrary = sized $ \k -> -        let k' = ceiling (sqrt $ fromInteger $ toInteger k :: Double)-        in do-            m <- choose (0,k')-            n <- choose (0,k')-            a <- matrix (m,n)-            b <- matrix (m,n)-            return $ Pair a b-        -    coarbitrary = undefined--}  -  -data BandedMV m n e = BandedMV (Banded (m,n) e) (Vector n e) deriving (Eq, Show)--instance (Arbitrary e, BLAS1 e) => Arbitrary (BandedMV m n e) where-    arbitrary = sized $ \k -> -        let k' = ceiling (sqrt $ fromInteger $ toInteger k :: Double)-        in do-            m <- choose (0,k')-            n <- choose (0,k')-            kl <- if m == 0 then return 0 else choose (0,m-1)-            ku <- if n == 0 then return 0 else choose (0,n-1)-            a <- banded (m,n) (kl,ku)             -            x <- vector n-            return $ BandedMV a x-            -    coarbitrary = undefined--data BandedMVPair m n e = BandedMVPair (Banded (m,n) e) (Vector n e) (Vector n e) -    deriving (Eq, Show)-    -instance (Arbitrary e, BLAS1 e) => Arbitrary (BandedMVPair m n e) where-    arbitrary = do-        (BandedMV a x) <- arbitrary-        y <- vector (dim x)-        return $ BandedMVPair a x y-        -    coarbitrary (BandedMVPair a x y) =-        coarbitrary (BandedMV a x, y)-        -data BandedMM m n k e = BandedMM (Banded (m,k) e) (Matrix (k,n) e) deriving (Eq, Show)--instance (Arbitrary e, BLAS1 e) => Arbitrary (BandedMM m n k e) where-    arbitrary = sized $ \s ->-        let s' = ceiling (sqrt $ fromInteger $ toInteger s :: Double)-        in do-            m <- choose (0,s')-            k <- choose (0,s')-            n <- choose (0,s')-            kl <- if m == 0 then return 0 else choose (0,m-1)-            ku <- if k == 0 then return 0 else choose (0,k-1)-            a <- banded (m,k) (kl,ku)             -            b <- matrix (k,n)-            return $ BandedMM a b-            -    coarbitrary = undefined-        -data BandedMMPair m n k e = BandedMMPair (Banded (m,k) e) (Matrix (k,n) e) (Matrix (k,n) e)-    deriving (Eq, Show)-    -instance (Arbitrary e, BLAS1 e) => Arbitrary (BandedMMPair m n k e) where-    arbitrary = do-        (BandedMM a b) <- arbitrary-        c <- matrix (shape b)-        return $ BandedMMPair a b c-        -    coarbitrary = undefined
− tests/Generators/Matrix/Dense.hs 
@@ -1,166 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : Generators.Matrix.Dense--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix.Dense (-    matrix,-    -    MatrixAt(..),-    SubMatrix(..),-    MatrixPair(..),-    MatrixMV(..),-    MatrixMVPair(..),-    MatrixMM(..),-    MatrixMMPair(..)-    ) where--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC--import Generators.Vector.Dense ( vector )-import Generators.Matrix--import Data.Vector.Dense ( Vector, dim )-import Data.Matrix.Dense hiding ( matrix )-import BLAS.Elem ( Elem, BLAS1 )--data SubMatrix m n e = -    SubMatrix (Matrix (m,n) e) -              (Int,Int) -              (Int,Int) -    deriving (Show)--matrix :: (BLAS1 e, Arbitrary e) => (Int,Int) -> Gen (Matrix (m,n) e)-matrix mn = frequency [ (3, rawMatrix mn)  -                      , (2, hermedMatrix mn)-                      , (1, subMatrix mn >>= \(SubMatrix a ij _) -> -                                 return $ submatrix a ij mn)-                      ]--rawMatrix :: (BLAS1 e, Arbitrary e) => (Int,Int) -> Gen (Matrix (m,n) e)-rawMatrix (m,n) = do-    es <- QC.vector (m*n)-    return $ listMatrix (m,n) es--hermedMatrix :: (BLAS1 e, Arbitrary e) => (Int,Int) -> Gen (Matrix (m,n) e)-hermedMatrix (m,n) = do-    x <- matrix (n,m)-    return $ (herm x)--subMatrix :: (BLAS1 e, Arbitrary e) => (Int,Int) -> Gen (SubMatrix m n e)-subMatrix (m,n) = do-    i <- choose (0,5)-    j <- choose (0,5)-    e <- choose (0,5)-    f <- choose (0,5)-    x <- matrix (i+m+e, j+n+f)--    return $ SubMatrix x (i,j) (m,n)--instance (Arbitrary e, BLAS1 e) => Arbitrary (Matrix (m,n) e) where-    arbitrary = matrixSized $ \k -> do-        m <- choose (0,k)-        n <- choose (0,k)-        matrix (m,n)-        -    coarbitrary = undefined--data MatrixAt m n e =-    MatrixAt (Matrix (m,n) e)-             (Int,Int)-    deriving (Show)-instance (Arbitrary e, BLAS1 e) => Arbitrary (MatrixAt m n e) where-    arbitrary = matrixSized $ \k -> do-        m <- choose (0,k) >>= return . (+1)-        n <- choose (0,k) >>= return . (+1)-        i <- choose (0,m-1)-        j <- choose (0,n-1)-        a <- matrix (m,n)-        return $ MatrixAt a (i,j)-        -    coarbitrary = undefined---instance (Arbitrary e, BLAS1 e) => Arbitrary (SubMatrix m n e) where-    arbitrary = matrixSized $ \k -> do-        m <- choose (0,k)-        n <- choose (0,k)-        (SubMatrix a ij mn) <- subMatrix (m,n)-        return $ SubMatrix a ij mn-        -    coarbitrary = undefined-        -data MatrixPair m n e = -    MatrixPair (Matrix (m,n) e) -               (Matrix (m,n) e) -    deriving (Show)--instance (Arbitrary e, BLAS1 e) => Arbitrary (MatrixPair m n e) where-    arbitrary = do-        a <- arbitrary-        b <- matrix (shape a)-        return $ MatrixPair a b-        -    coarbitrary = undefined-  -data MatrixMV m n e = -    MatrixMV (Matrix (m,n) e) -             (Vector n e) -    deriving (Show)--instance (Arbitrary e, BLAS1 e) => Arbitrary (MatrixMV m n e) where-    arbitrary = do-        a <- arbitrary-        x <- vector (numCols a)-        return $ MatrixMV a x-            -    coarbitrary = undefined--data MatrixMVPair m n e = -    MatrixMVPair (Matrix (m,n) e) -                 (Vector n e) -                 (Vector n e) -    deriving (Show)-    -instance (Arbitrary e, BLAS1 e) => Arbitrary (MatrixMVPair m n e) where-    arbitrary = do-        (MatrixMV a x) <- arbitrary-        y <- vector (dim x)-        return $ MatrixMVPair a x y-        -    coarbitrary = undefined--        -data MatrixMM m n k e = -    MatrixMM (Matrix (m,k) e) -             (Matrix (k,n) e) -    deriving (Show)--instance (Arbitrary e, BLAS1 e) => Arbitrary (MatrixMM m n k e) where-    arbitrary = matrixSized $ \s -> do-        a <- arbitrary-        n <- choose (0,s)-        b <- matrix (numCols a, n)-        return $ MatrixMM a b-            -    coarbitrary = undefined-        -data MatrixMMPair m n k e = -    MatrixMMPair (Matrix (m,k) e) -                 (Matrix (k,n) e) -                 (Matrix (k,n) e)-    deriving (Show)-    -instance (Arbitrary e, BLAS1 e) => Arbitrary (MatrixMMPair m n k e) where-    arbitrary = do-        (MatrixMM a b) <- arbitrary-        c <- matrix (shape b)-        return $ MatrixMMPair a b c-        -    coarbitrary = undefined
− tests/Generators/Matrix/Diag.hs 
@@ -1,111 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Generators.Matrix.Diag--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix.Diag (-    diagMatrix,-    TestDiag(..),-    DiagMV(..),-    DiagMM(..),-    DiagSV(..),-    DiagSM(..),--    ) where--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC--import qualified Generators.Vector.Dense as Test-import qualified Generators.Matrix.Dense as Test-import Generators.Matrix ( matrixSized )--import BLAS.Elem ( BLAS1, BLAS2 )--import Data.Vector.Dense ( Vector, elems )-import Data.Matrix.Dense ( Matrix, matrix, diag )-import Data.Matrix.Diag --diagMatrix :: (Arbitrary e, BLAS1 e) => Int -> Gen (Matrix (n,n) e)-diagMatrix n = do-    es <- QC.vector n-    let a = matrix (n,n) [ ((i,i),e) | (i,e) <- zip [0..(n-1)] es ]-    elements [ a, herm a ]---data TestDiag n e = -    TestDiag (Diag Vector (n,n) e) -             (Matrix (n,n) e) -    deriving Show--instance (Arbitrary e, BLAS1 e) => Arbitrary (TestDiag n e) where-    arbitrary = matrixSized $ \s -> do-        n <- choose (0,s)-        a <- diagMatrix n-        return $ TestDiag (diagFromVector $ diag a 0) a-        -    coarbitrary = undefined---data DiagMV n e = -    DiagMV (Diag Vector (n,n) e)-           (Matrix (n,n) e)-           (Vector n e)-    deriving Show-    -instance (Arbitrary e, BLAS1 e) => Arbitrary (DiagMV n e) where-    arbitrary = do-        (TestDiag d a) <- arbitrary-        x <- Test.vector (numCols a)-        return $ DiagMV d a x--    coarbitrary = undefined---data DiagMM m n e = -    DiagMM (Diag Vector (m,m) e)-           (Matrix (m,m) e)-           (Matrix (m,n) e)-    deriving Show--instance (Arbitrary e, BLAS1 e) => Arbitrary (DiagMM m n e) where-    arbitrary = matrixSized $ \s -> do-        (TestDiag d a) <- arbitrary-        n <- choose (0,s)-        b <- Test.matrix (numCols a, n)-        return $ DiagMM d a b--    coarbitrary = undefined-    -    -data DiagSV n e =-    DiagSV (Diag Vector (n,n) e)-           (Vector n e)-    deriving Show--instance (Arbitrary e, BLAS2 e) => Arbitrary (DiagSV n e) where-    arbitrary = do-        (DiagMV d _ x) <- arbitrary-        if any (==0) (elems $ vectorFromDiag d)-            then arbitrary-            else return $ DiagSV d (d <*> x)-        -    coarbitrary = undefined--data DiagSM m n e =-    DiagSM (Diag Vector (m,m) e)-           (Matrix (m,n) e)-    deriving Show-    -instance (Arbitrary e, BLAS2 e) => Arbitrary (DiagSM m n e) where-    arbitrary = do-        (DiagMM d _ b) <- arbitrary-        if any (==0) (elems $ vectorFromDiag d)-            then arbitrary-            else return $ DiagSM d (d <**> b)--    coarbitrary = undefined
− tests/Generators/Matrix/Herm/Banded.hs 
@@ -1,119 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Generators.Matrix.Herm.Banded--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix.Herm.Banded (-    HermBanded(..),-    HermBandedMV(..),-    HermBandedMM(..),-    ) where--import Control.Monad ( replicateM )--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC-import Generators.Vector.Dense ( vector )-import Generators.Matrix ( matrixSized )-import Generators.Matrix.Dense ( matrix )--import BLAS.Elem ( Elem, BLAS2, toReal, fromReal, conj )-import BLAS.Types ( flipUpLo )--import Data.Vector.Dense ( Vector )-import Data.Matrix.Banded-import Data.Matrix.Dense ( Matrix )-import Data.Matrix.Herm----hermBanded :: (BLAS2 e, Arbitrary e) => Int -> Int -> Gen (Banded (n,n) e)-hermBanded n k -    | n < 0 = -        error $ "hermBanded: n must be non-negative"-    | n == 0 =-        return $ listsBanded (0,0) (0,0) []-    | k >= n =-        error $ "hermBanded: k must be less than n"-    | k < 0 = -        error $ "hermBanded: k must be non-negative"-    | k == 0 = do-        d <- QC.vector n >>= return . realPart-        return $ listsBanded (n,n) (0,0) [d]-    | otherwise = do-        a <- hermBanded n (k-1)-        let (_,_,ds) = listsFromBanded a-        -        d <- QC.vector (n-k)-        let d'  = map conj d-            pad = replicate k 0-            ds' = [pad ++ d] ++ ds ++ [d' ++ pad]--        return $ listsBanded (n,n) (k,k) ds'-        -  where-    realPart :: Elem e => [e] -> [e]-    realPart = map (fromReal . toReal)--data HermBanded n e =-    HermBanded (Herm Banded (n,n) e)-               (Banded (n,n) e)-    deriving Show-    -instance (Arbitrary e, BLAS2 e) => Arbitrary (HermBanded n e) where-    arbitrary = matrixSized $ \s -> do-        n <- choose (0,s)-        k <- if n == 0 then return 0 else choose (0,n-1)-        l <- if n == 0 then return 0 else choose (0,n-1)-            -        a <- hermBanded n k-            -        junk <- replicateM l $ QC.vector n-        let (_,_,ds) = listsFromBanded a-            (u ,b ) = (Upper, listsBanded (n,n) (l,k) $ junk ++ (drop k ds))-            (u',b') = (Lower, listsBanded (n,n) (k,l) $ (take (k+1) ds) ++ junk)-        -        h <- elements [ fromBase u             b-                      , fromBase (flipUpLo u)  (herm b)-                      , fromBase u'            b'-                      , fromBase (flipUpLo u') (herm b')-                      ]-            -        return $ HermBanded h a--    coarbitrary = undefined--data HermBandedMV n e = -    HermBandedMV (Herm Banded (n,n) e) -                 (Banded (n,n) e) -                 (Vector n e) -    deriving Show--instance (Arbitrary e, BLAS2 e) => Arbitrary (HermBandedMV n e) where-    arbitrary = do-        (HermBanded h a) <- arbitrary-        x <- vector (numCols a)-        return $ HermBandedMV h a x--    coarbitrary = undefined-    -    -data HermBandedMM m n e = -    HermBandedMM (Herm Banded (m,m) e) -                 (Banded (m,m) e) -                 (Matrix (m,n) e) -    deriving Show-    -instance (Arbitrary e, BLAS2 e) => Arbitrary (HermBandedMM m n e) where-    arbitrary = matrixSized $ \s -> do-        (HermBanded a h) <- arbitrary-        n <- choose (0,s)-        b <- matrix (numCols h,n)--        return $ HermBandedMM a h b-            -    coarbitrary = undefined
− tests/Generators/Matrix/Herm/Dense.hs 
@@ -1,91 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Generators.Matrix.Herm.Dense--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix.Herm.Dense( -    HermMatrix(..),-    HermMatrixMV(..),-    HermMatrixMM(..),-    ) where--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC-import Generators.Vector.Dense ( vector )-import Generators.Matrix ( matrixSized )-import Generators.Matrix.Dense ( matrix )--import BLAS.Elem ( BLAS2 )-import BLAS.Types ( flipUpLo )--import Data.Vector.Dense hiding ( vector )-import Data.Matrix.Dense hiding ( matrix )-import Data.Matrix.Herm----hermMatrix :: (BLAS2 e, Arbitrary e) => Int -> Gen (Matrix (n,n) e)-hermMatrix n  = do-    a <- matrix (n,n)-    let h = (a + herm a)-    elements [ h, herm h ]---data HermMatrix n e = -    HermMatrix (Herm Matrix (n,n) e)-               (Matrix (n,n) e)-    deriving Show--instance (Arbitrary e, BLAS2 e) => Arbitrary (HermMatrix n e) where-    arbitrary = matrixSized $ \k -> do-        n <- choose (0,k)-        a <- hermMatrix n-        -        junk <- QC.vector (n*n)-        let (u ,b ) = (Upper, a // zip (filter (uncurry (>)) $ indices a) junk)-            (u',b') = (Lower, a // zip (filter (uncurry (<)) $ indices a) junk)--        h <- elements [ fromBase u             b-                      , fromBase (flipUpLo u)  (herm b)-                      , fromBase u'            b'-                      , fromBase (flipUpLo u') (herm b')-                      ]-        return $ HermMatrix h a-        -    coarbitrary = undefined---data HermMatrixMV n e = -    HermMatrixMV (Herm Matrix (n,n) e) -                 (Matrix (n,n) e) -                 (Vector n e) -    deriving Show--instance (Arbitrary e, BLAS2 e) => Arbitrary (HermMatrixMV n e) where-    arbitrary = do-        (HermMatrix h a) <- arbitrary-        x <- vector (numCols a)-        return $ HermMatrixMV h a x-        -    coarbitrary = undefined--    -data HermMatrixMM m n e = -    HermMatrixMM (Herm Matrix (m,m) e) -                 (Matrix (m,m) e) -                 (Matrix (m,n) e) -    deriving Show-    -instance (Arbitrary e, BLAS2 e) => Arbitrary (HermMatrixMM m n e) where-    arbitrary = matrixSized $ \k -> do-        (HermMatrix h a) <- arbitrary-        n <- choose (0,k)-        b <- matrix (numCols a,n)-        return $ HermMatrixMM h a b-            -    coarbitrary = undefined-
− tests/Generators/Matrix/Perm.hs 
@@ -1,104 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Generators.Matrix.Perm--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix.Perm-    where--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC--import Generators.Permutation-import Generators.Vector.Dense ( vector )-import Generators.Matrix.Dense ( matrix )-import Generators.Matrix ( matrixSized )--import BLAS.Elem ( Elem, BLAS1 )--import Data.Vector.Dense ( Vector )-import Data.Matrix.Dense ( Matrix, shape )-import Data.Matrix.Perm--pmatrix :: (Elem e) => Int -> Gen (Perm (n,n) e)-pmatrix n = frequency [ (2, rawPerm n)-                      , (2, hermedPerm n)-                      , (1, idPerm n)-                      ]--rawPerm :: Int -> Gen (Perm (n,n) e)-rawPerm n = permutation n >>= return . fromPermutation--hermedPerm :: (Elem e) => Int -> Gen (Perm (n,n) e)-hermedPerm n = rawPerm n >>= return . herm--idPerm :: Int -> Gen (Perm (n,n) e)-idPerm = return . identity---newtype TestPerm n e = TestPerm (Perm (n,n) e) deriving Show--instance (Elem e) => Arbitrary (TestPerm n e) where-    arbitrary = matrixSized $ \s -> do-        n <- choose (0,s)-        p <- pmatrix n-        return $ TestPerm p-        -    coarbitrary = undefined--data PermMBasis n e = PermMBasis (Perm (n,n) e) Int deriving Show--instance (Elem e) => Arbitrary (PermMBasis n e) where-    arbitrary = do-        (TestPerm p) <- arbitrary-        i <- choose (0, numCols p - 1)-        return $ PermMBasis p i-        -    coarbitrary = undefined-    -data PermMV n e = PermMV (Perm (n,n) e) (Vector n e) deriving Show--instance (BLAS1 e, Arbitrary e) => Arbitrary (PermMV n e) where-    arbitrary = do-        (TestPerm p) <- arbitrary-        x <- vector (numCols p)-        return $ PermMV p x-    -    coarbitrary = undefined-    -data PermMVPair n e = -    PermMVPair (Perm (n,n) e) (Vector n e) (Vector n e) deriving Show-    -instance (BLAS1 e, Arbitrary e) => Arbitrary (PermMVPair n e) where-    arbitrary = do-        (PermMV p x) <- arbitrary-        y <- vector (numCols p)-        return $ PermMVPair p x y-        -    coarbitrary = undefined-    -data PermMM m n e = PermMM (Perm (m,m) e) (Matrix (m,n) e) deriving Show--instance (BLAS1 e, Arbitrary e) => Arbitrary (PermMM m n e) where-    arbitrary = matrixSized $ \s -> do-        (TestPerm p) <- arbitrary-        n <- choose (0,s)-        a <- matrix (numCols p, n)-        return $ PermMM p a-        -    coarbitrary = undefined-    -data PermMMPair m n e = -    PermMMPair (Perm (m,m) e) (Matrix (m,n) e) (Matrix (m,n) e) deriving Show-    -instance (BLAS1 e, Arbitrary e) => Arbitrary (PermMMPair m n e) where-    arbitrary = do-        (PermMM p a)<- arbitrary-        b <- matrix (shape a)-        return $ PermMMPair p a b-        -    coarbitrary = undefined
− tests/Generators/Matrix/Tri/Banded.hs 
@@ -1,155 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module     : Generators.Matrix.Tri.Banded--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix.Tri.Banded (-    TriBanded(..),-    TriBandedMV(..),-    TriBandedMM(..),-    TriBandedSV(..),-    TriBandedSM(..),-    ) where--import Control.Monad ( replicateM )--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC-import Generators.Vector.Dense ( vector )-import Generators.Matrix.Dense ( matrix )-import Generators.Matrix ( matrixSized )--import Data.Vector.Dense ( Vector )-import Data.Matrix.Dense ( Matrix )-import Data.Matrix.Banded-import BLAS.Elem ( BLAS1, BLAS2 )--import Data.Matrix.Tri ( Tri, UpLo(..), Diag(..), fromBase )--import Unsafe.Coerce--triBanded :: (BLAS1 e, Arbitrary e) => UpLo -> Diag -> Int -> Int -> Gen (Banded (n,n) e)-triBanded Upper NonUnit n k = do-    a <- triBanded Upper Unit n k-    d <- QC.vector n-    let (_,_,(_:ds)) = listsFromBanded a-    return $ listsBanded (n,n) (0,k) (d:ds)--triBanded Lower NonUnit n k = do-    a <- triBanded Lower Unit n k-    d <- QC.vector n-    let (_,_,ds) = listsFromBanded a-        ds' = (init ds) ++ [d]-    return $ listsBanded (n,n) (k,0) ds'-    -triBanded _ Unit n 0 = do-    return $ listsBanded (n,n) (0,0) [replicate n 1]-    -triBanded Upper Unit n k = do-    a <- triBanded Upper Unit n (k-1)-    let (_,_,ds) = listsFromBanded a-    -    d <- QC.vector (n-k) >>= \xs -> return $ xs ++ replicate k 0-    -    return $ listsBanded (n,n) (0,k) $ ds ++ [d]-    -triBanded Lower Unit n k = do-    a <- triBanded Lower Unit n (k-1)-    let (_,_,ds) = listsFromBanded a--    d <- QC.vector (n-k) >>= \xs -> return $ replicate k 0 ++ xs-    -    return $ listsBanded (n,n) (k,0) $ [d] ++ ds-    -    -data TriBanded n e = -    TriBanded (Tri Banded (n,n) e) (Banded (n,n) e) deriving Show--instance (Arbitrary e, BLAS1 e) => Arbitrary (TriBanded n e) where-    arbitrary = matrixSized $ \s -> do-        u <- elements [ Upper, Lower  ]-        d <- elements [ Unit, NonUnit ]-        n <- choose (0,s)-        k <- if n == 0 then return 0 else choose (0,n-1)-        a <- triBanded u d n k--        l    <- if n == 0 then return 0 else choose (0,n-1)-        junk <- replicateM l $ QC.vector n-        diagJunk <- QC.vector n-        let (_,_,ds) = listsFromBanded a-            t = fromBase u d $ case (u,d) of -                    (Upper,NonUnit) -> -                        listsBanded (n,n) (l,k) $ junk ++ ds-                    (Upper,Unit) ->-                        listsBanded (n,n) (l,k) $ junk ++ [diagJunk] ++ tail ds-                    (Lower,NonUnit) -> -                        listsBanded (n,n) (k,l) $ ds ++ junk-                    (Lower,Unit) -> -                        listsBanded (n,n) (k,l) $ init ds ++ [diagJunk] ++ junk--        (t',a') <- elements [ (t,a), unsafeCoerce (herm t, herm a)]-        return $ TriBanded t' a'-            -    coarbitrary = undefined--data TriBandedMV n e = -    TriBandedMV (Tri Banded (n,n) e) (Banded (n,n) e) (Vector n e) deriving Show--instance (Arbitrary e, BLAS1 e) => Arbitrary (TriBandedMV n e) where-    arbitrary = do-        (TriBanded t a) <- arbitrary-        x <- vector (numCols t)-        return $ TriBandedMV t a x-        -    coarbitrary (TriBandedMV t a x) =-        coarbitrary (TriBanded t a, x)-        -data TriBandedMM m n e = -    TriBandedMM (Tri Banded (m,m) e) (Banded (m,m) e) (Matrix (m,n) e) deriving Show--instance (Arbitrary e, BLAS1 e) => Arbitrary (TriBandedMM m n e) where-    arbitrary = matrixSized $ \s -> do-        (TriBanded t a) <- arbitrary-        n <- choose (0,s)-        b <- matrix (numCols t, n)-        return $ TriBandedMM t a b-            -    coarbitrary = undefined-        -data TriBandedSV n e = -    TriBandedSV (Tri Banded (n,n) e) (Vector n e) deriving (Show)-    -instance (Arbitrary e, BLAS2 e) => Arbitrary (TriBandedSV n e) where-    arbitrary = do-        (TriBanded t a) <- arbitrary-        if any (== 0) (elems $ diagBanded a 0)-            then arbitrary-            else do-                x <- vector (numCols t)-                let y = t <*> x-                return (TriBandedSV t y)-        -    coarbitrary = undefined---data TriBandedSM m n e = -    TriBandedSM (Tri Banded (m,m) e) (Matrix (m,n) e) -    deriving (Show)-    -instance (Arbitrary e, BLAS2 e) => Arbitrary (TriBandedSM m n e) where-    arbitrary = matrixSized $ \s -> do-        (TriBandedSV t _) <- arbitrary--        n <- choose (0, s)-        a <- matrix (numCols t, n)-        -        let b = t <**> a-        return (TriBandedSM t b)-        -    coarbitrary = undefined-
− tests/Generators/Matrix/Tri/Dense.hs 
@@ -1,149 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Generators.Matrix.Tri.Dense--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Matrix.Tri.Dense (-    TriMatrix(..),-    TriMatrixMV(..),-    TriMatrixMM(..),-    TriMatrixSV(..),-    TriMatrixSM(..),-    ) where--import Data.Ix ( range )--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC-import Generators.Vector.Dense ( vector )-import qualified Generators.Matrix.Dense as Test-import Generators.Matrix ( matrixSized )--import Data.Vector.Dense hiding ( vector )-import Data.Matrix.Dense-import BLAS.Elem ( BLAS1, BLAS3 )--import Data.Matrix.Tri ( Tri, UpLo(..), Diag(..), fromBase )--import Unsafe.Coerce--triMatrix :: (BLAS1 e, Arbitrary e) => UpLo -> Diag -> (Int,Int) -> Gen (Matrix (m,n) e)-triMatrix u d (m,n) =-    let ijs = filter (isTriIndex u d) $ range ((0,0), (m-1,n-1))-    in do-        es <- QC.vector (m*n)-        let a = matrix (m,n) $ zip ijs es-            a' = case d of-                    NonUnit -> a-                    Unit    -> a // [ ((i,i),1) | i <- [0..(mn-1)] ]-        return $ a'-  where-    mn = min m n--isTriIndex :: UpLo -> Diag -> (Int,Int) -> Bool-isTriIndex Upper NonUnit (i,j) = i <= j-isTriIndex Upper Unit    (i,j) = i <  j-isTriIndex Lower NonUnit (i,j) = i >= j-isTriIndex Lower Unit    (i,j) = i >  j---- | A triangular matrix and an equivalent dense matrix-data TriMatrix m n e = -    TriMatrix (Tri Matrix (m,n) e) -              (Matrix (m,n) e) -    deriving Show--instance (Arbitrary e, BLAS1 e) => Arbitrary (TriMatrix m n e) where-    arbitrary = matrixSized $ \k -> do-        u <- elements [ Upper, Lower  ]-        d <- elements [ Unit, NonUnit ]-        m <- choose (0,k)-        n <- choose (0,k)-        a <- triMatrix u d (m,n)-        -        junk <- QC.vector (m*n)-        let ijs = [ (i,j) | i <- [0..(m-1)]-                          , j <- [0..(n-1)]-                          , (not . (isTriIndex u d)) (i,j) ]-            t   = fromBase u d $ a // zip ijs junk-            -        (t',a') <- elements [ (t,a), unsafeCoerce (herm t, herm a) ]-            -        return $ TriMatrix t' $ submatrix a' (0,0) (shape t')-            -    coarbitrary = undefined----- | A triangular matrix, and equivalent dense matrix, and a vector in--- their domain.        -data TriMatrixMV m n e = -    TriMatrixMV (Tri Matrix (m,n) e) -                (Matrix (m,n) e) -                (Vector n e) -    deriving Show--instance (Arbitrary e, BLAS1 e) => Arbitrary (TriMatrixMV m n e) where-    arbitrary = do-        (TriMatrix t a) <- arbitrary-        x <- vector (numCols a)-        return $ TriMatrixMV t a x--    coarbitrary = undefined---- | A triangular matrix, and equivalent dense matrix, and a matrix in--- their domain.        -data TriMatrixMM m k n e = -    TriMatrixMM (Tri Matrix (m,k) e) -                (Matrix (m,k) e) -                (Matrix (k,n) e) -    deriving Show--instance (Arbitrary e, BLAS1 e) => Arbitrary (TriMatrixMM m k n e) where-    arbitrary = matrixSized $ \s -> do-        (TriMatrix t a) <- arbitrary-        n <- choose (0,s)-        b <- Test.matrix (numCols a, n)-        return $ TriMatrixMM t a b-            -    coarbitrary = undefined---- | A triangular matrix and a vector in its range-data TriMatrixSV m n e = -    TriMatrixSV (Tri Matrix (m,n) e) -                (Vector m e) -    deriving Show-    -instance (Arbitrary e, BLAS3 e) => Arbitrary (TriMatrixSV m n e) where-    arbitrary = do-        (TriMatrix t a) <- arbitrary-        if any (== 0) (elems $ diag a 0)-            then arbitrary-            else do-                x <- vector (numCols a)-                let y = a <*> x-                return (TriMatrixSV t y)-        -    coarbitrary = undefined---- | A triangular matrix and a matrix in its range-data TriMatrixSM m k n e = -    TriMatrixSM (Tri Matrix (m,k) e) -                (Matrix (m,n) e) -    deriving Show-    -instance (Arbitrary e, BLAS3 e) => Arbitrary (TriMatrixSM m k n e) where-    arbitrary = matrixSized $ \s -> do-        (TriMatrix t a) <- arbitrary-        if any (== 0) (elems $ diag a 0)-            then arbitrary-            else do-                n <- choose (0, s)-                b <- Test.matrix (numCols a, n)-                let c = a <**> b-                return (TriMatrixSM t c)-        -    coarbitrary = undefined-
− tests/Generators/Permutation.hs 
@@ -1,36 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Generators.Permutation--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Permutation (-    permutation-    ) where--import Data.List ( sortBy )-import Data.Ord ( comparing )--import Test.QuickCheck--import Data.Permutation ( Permutation )-import qualified Data.Permutation as P--permutation :: Int -> Gen Permutation-permutation n = do-    xs <- vector n :: Gen [Int]-    let is = (snd . unzip) $ sortBy (comparing fst) $ zip xs [0..]-    return $ P.permutation n is-    --instance Arbitrary Permutation where-    arbitrary = do-        n <- arbitrary >>= return . abs-        p <- permutation n-        return $ p-        -    coarbitrary p = -        coarbitrary $ P.toList p
− tests/Generators/Vector/Dense.hs 
@@ -1,97 +0,0 @@--------------------------------------------------------------------------------- |--- Module     : Generators.Vector.Dense--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>--- License    : BSD3--- Maintainer : Patrick Perry <patperry@stanford.edu>--- Stability  : experimental-----module Generators.Vector.Dense (-    SubVector(..),-    VectorPair(..),-    VectorTriple(..),-    -    vector,-    ) where--import Test.QuickCheck hiding ( vector )-import qualified Test.QuickCheck as QC--import Data.Vector.Dense hiding ( vector )-import BLAS.Elem ( Elem, BLAS1 )--data SubVector n e = -    SubVector Int -              (Vector n e) -              Int -              Int -    deriving (Show)-    -data VectorPair n e = -    VectorPair (Vector n e) -               (Vector n e) -    deriving (Show)-    -data VectorTriple n e = -    VectorTriple (Vector n e) -                 (Vector n e) -                 (Vector n e) -    deriving (Show)--vector :: (BLAS1 e, Arbitrary e) => Int -> Gen (Vector n e)-vector n =-    frequency [ (3, rawVector n)  -              , (2, conjVector n)-              , (1, subVector n    >>= \(SubVector s x o _) -> -                    return $ subvectorWithStride s x o n)-              ]    --rawVector :: (BLAS1 e, Arbitrary e) => Int -> Gen (Vector n e)-rawVector n = do-    es <- QC.vector n-    return $ listVector n es--conjVector :: (BLAS1 e, Arbitrary e) => Int -> Gen (Vector n e)-conjVector n = do-    x <- vector n-    return $ (conj x)--subVector :: (BLAS1 e, Arbitrary e) => Int -> Gen (SubVector n e)-subVector n = do-    o <- choose (0,5)-    s <- choose (1,5)-    e <- choose (0,5)-    x <- vector (o + s*n + e)-    return (SubVector s x o n)--instance (Arbitrary e, BLAS1 e) => Arbitrary (Vector n e) where-    arbitrary = sized $ \m ->-        choose (0,m) >>= vector-        -    coarbitrary = undefined--instance (Arbitrary e, BLAS1 e) => Arbitrary (SubVector n e) where-    arbitrary = sized $ \m -> -        choose (0,m) >>= subVector-        -    coarbitrary = undefined--instance (Arbitrary e, BLAS1 e) => Arbitrary (VectorPair n e) where-    arbitrary = sized $ \m -> do-        n <- choose (0,m)-        x <- vector n-        y <- vector n-        return $ VectorPair x y-        -    coarbitrary = undefined-        -instance (Arbitrary e, BLAS1 e) => Arbitrary (VectorTriple n e) where-    arbitrary = sized $ \m -> do-        n <- choose (0,m)-        x <- vector n-        y <- vector n-        z <- vector n-        return $ VectorTriple x y z-    -    coarbitrary = undefined
tests/HermBanded.hs view
@@ -7,7 +7,7 @@ import Data.Matrix.Banded import Data.Vector.Dense -import Generators.Matrix.Herm.Banded+import Test.Matrix.Herm.Banded  type V = Vector Int E type B = Banded (Int,Int) E
tests/HermMatrix.hs view
@@ -7,7 +7,7 @@ import Data.Matrix.Dense import Data.Vector.Dense -import Generators.Matrix.Herm.Dense+import Test.Matrix.Herm.Dense  type V  = Vector Int E type M  = Matrix (Int,Int) E
tests/Main.hs view
@@ -7,15 +7,12 @@ import STVector import Matrix import STMatrix-import Banded import HermMatrix-import HermBanded import TriMatrix+import Banded+import HermBanded import TriBanded-import Diag-import Perm - main :: IO () main = do     args <- getArgs@@ -41,11 +38,9 @@             , ("STVector"    , tests_STVector)             , ("Matrix"      , tests_Matrix)             , ("STMatrix"    , tests_STMatrix)-            , ("Banded"      , tests_Banded)             , ("Herm Matrix" , tests_HermMatrix)-            , ("Herm Banded" , tests_HermBanded)             , ("Tri Matrix"  , tests_TriMatrix)+            , ("Banded"      , tests_Banded)+            , ("Herm Banded" , tests_HermBanded)             , ("Tri Banded"  , tests_TriBanded)-            , ("Diag"        , tests_Diag)-            , ("Perm"        , tests_Perm)             ]
− tests/Makefile 
@@ -1,13 +0,0 @@---all:-	ghc --make -fforce-recomp -XPatternSignatures -DREAL Main.hs -o test-real-	./test-real-	-	ghc --make -fforce-recomp -XPatternSignatures -DCOMPLEX Main.hs -o test-complex-	./test-complex-	-clean:-	find . -name '*.hi' | xargs rm -f-	find . -name '*.o'  | xargs rm -f-	rm -f test-real test-complex
+ tests/Makefile.in view
@@ -0,0 +1,20 @@+++all:+	ghc --make -fforce-recomp -XScopedTypeVariables -DREAL Main.hs -o test-real+	./test-real+	+	ghc --make -fforce-recomp -XScopedTypeVariables -DCOMPLEX Main.hs -o test-complex+	./test-complex+	+hpc:+	ghc --make -fforce-recomp -i. -i../lib -XScopedTypeVariables ../cbits/double.c ../cbits/zomplex.c @BLAS_LIBS@ @LIBS@ -fhpc -DCOMPLEX Main.hs -o test-complex+	./test-complex+	hpc markup test-complex+	+clean:+	find ../lib . -name '*.hi' | xargs rm -f+	find ../lib . -name '*.o'  | xargs rm -f+	find ../cbits . -name '*.o'  | xargs rm -f+	find . -name '*.html' | xargs rm -f+	rm -f test-real test-complex test-complex.tix
tests/Matrix.hs view
@@ -1,15 +1,15 @@-{-# LANGUAGE PatternSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Matrix( tests_Matrix ) where  import Driver import qualified Data.Array as Array -import BLAS.Elem+import Data.Elem.BLAS import Data.Matrix.Dense import Data.Vector.Dense -import Generators.Matrix.Dense hiding ( matrix )+import Test.Matrix.Dense hiding ( matrix )           type V = Vector Int E@@ -116,9 +116,9 @@ prop_scale_elems (a :: M) k =     and $ zipWith (~==) (elems (k *> a)) (map (k*) (elems a)) prop_herm_elem (MatrixAt (a :: M) (i,j)) =-    (herm a) ! (j,i) == conj (a!(i,j))+    (herm a) ! (j,i) == conjugate (a!(i,j)) prop_herm_scale (a :: M) k =-    herm (k *> a) === (conj k) *> (herm a)+    herm (k *> a) === (conjugate k) *> (herm a)  prop_herm_shape (a :: M) =     shape (herm a) == (numCols a, numRows a)@@ -135,15 +135,15 @@ prop_diag_herm2 (MatrixAt (a :: M) (_,k)) =     diag a k === conj (diag (herm a) (-k)) -prop_rowMatrix_shape (x :: V) =-    shape (rowMatrix x :: M) == (1,dim x)-prop_rowMatrix_elems (x :: V) =-    elems (rowMatrix x :: M) === elems x+prop_matrixFromRow_shape (x :: V) =+    shape (matrixFromRow x :: M) == (1,dim x)+prop_matrixFromRow_elems (x :: V) =+    elems (matrixFromRow x :: M) === elems x -prop_colMatrix_shape (x :: V) =-    shape (colMatrix x :: M) == (dim x,1)-prop_colMatrix_elems (x :: V) =-    elems (colMatrix x :: M) === elems x+prop_matrixFromCol_shape (x :: V) =+    shape (matrixFromCol x :: M) == (dim x,1)+prop_matrixFromCol_elems (x :: V) =+    elems (matrixFromCol x :: M) === elems x  prop_apply_basis (MatrixAt (a :: M) (_,j)) =     a <*> (basisVector (numCols a) j :: V) ~== col a j@@ -247,10 +247,10 @@     , ("subdiag . herm"        , mytest prop_diag_herm1)     , ("superdiag . herm"      , mytest prop_diag_herm2)                                -    , ("shape . rowMatrix"       , mytest prop_rowMatrix_shape)-    , ("elems . rowMatrix"       , mytest prop_rowMatrix_elems)-    , ("shape . colMatrix"       , mytest prop_colMatrix_shape)-    , ("elems . colMatrix"       , mytest prop_colMatrix_elems)+    , ("shape . matrixFromRow"       , mytest prop_matrixFromRow_shape)+    , ("elems . matrixFromRow"       , mytest prop_matrixFromRow_elems)+    , ("shape . matrixFromCol"       , mytest prop_matrixFromCol_shape)+    , ("elems . matrixFromCol"       , mytest prop_matrixFromCol_elems)      , ("apply basis"           , mytest prop_apply_basis)     , ("apply herm basis"      , mytest prop_apply_herm_basis)@@ -280,7 +280,7 @@   assocsEq :: [((Int,Int), E)] -> [((Int,Int), E)] -> Bool-assocsEq ies ies' = ordered ies ~== ordered ies'+assocsEq ies ies' = ordered ies === ordered ies'   where     ordered = sortAssocs . nubAssocs     nubAssocs = reverse . nubBy ((==) `on` fst) . reverse
− tests/Perm.hs 
@@ -1,63 +0,0 @@--module Perm( tests_Perm ) where-    -import Driver--import Data.Vector.Dense-import Data.Matrix.Dense-import Data.Matrix.Perm--import Data.Permutation ( Permutation, permutation )-import qualified Data.Permutation as P--import Generators.Matrix.Perm--type V = Vector Int E-type M = Matrix (Int,Int) E-type P = Perm (Int,Int) E--prop_perm_herm (TestPerm (p :: P)) =-    toPermutation (herm p) == P.inverse (toPermutation p)--prop_perm_apply_basis (PermMBasis (p :: P) i) =-    n > 0 ==> p <*> (basisVector n i) === basisVector n (P.apply (toPermutation p) i)-  where-    n = numCols p--prop_perm_herm_apply (PermMV (p :: P) x) =-    p <*> herm p <*> x === x--prop_herm_perm_apply (PermMV (p :: P) x) =-    herm p <*> p <*> x === x--prop_perm_solve (PermMV (p :: P) x) =-    p <\> x === herm p <*> x--prop_perm_applyMat_cols (PermMM (p :: P) a) =-    cols (p <**> a) === map (p <*>) (cols a)--prop_perm_herm_applyMat (PermMM (p :: P) a) =-    p <**> herm p <**> a === a--prop_herm_perm_applyMat (PermMM (p :: P) a) =-    herm p <**> p <**> a === a--prop_perm_solveMat_cols (PermMM (p :: P) a) =-    cols (p <\\> a) === map (p <\>) (cols a)--prop_perm_solveMat (PermMM (p :: P) a) =-    p <\\> a === herm p <**> a-    --tests_Perm =-    [ ("perm herm"             , mytest prop_perm_herm)-    , ("perm apply basis"      , mytest prop_perm_apply_basis)-    , ("perm herm apply"       , mytest prop_perm_herm_apply)-    , ("herm perm apply"       , mytest prop_herm_perm_apply)-    , ("perm solve"            , mytest prop_perm_solve)-    , ("perm applyMat cols"    , mytest prop_perm_applyMat_cols)-    , ("perm herm applyMat"    , mytest prop_perm_herm_applyMat)-    , ("herm perm applyMat"    , mytest prop_herm_perm_applyMat)-    , ("perm solveMat cols"    , mytest prop_perm_solveMat_cols)-    , ("perm solveMat"         , mytest prop_perm_solveMat)-    ]
tests/STMatrix.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE Rank2Types, PatternSignatures #-}+{-# LANGUAGE Rank2Types, ScopedTypeVariables #-} module STMatrix ( tests_STMatrix ) where  -import BLAS.Elem+import Data.Elem.BLAS import Data.Matrix.Dense import Data.Matrix.Dense.ST -import qualified Generators.Matrix.Dense as Test+import qualified Test.Matrix.Dense as Test  import Driver @@ -48,6 +48,10 @@  prop_GetIndicesLazy   = getIndices `implements`  getIndices_S prop_GetIndicesStrict = getIndices' `implements` getIndices_S++getElems_S a = ( elems a, a )+prop_GetElemsLazy   = getElems  `implements` getElems_S+prop_GetElemsStrict = getElems' `implements` getElems_S      getElemsLazyModifyWith_S f a = ( elems a', a' ) where a' = tmap f a prop_GetElemsLazyModifyWith f =@@ -114,7 +118,7 @@  -------------------------- Unsary Matrix Operations -------------------------- -doConj_S x = ( (), tmap conj x )+doConj_S x = ( (), tmap conjugate x ) prop_DoConj = doConj `implements` doConj_S  scaleBy_S k x = ( (), tmap (k*) x )@@ -126,7 +130,7 @@ modifyWith_S f x = ( (), tmap f x ) prop_ModifyWith f = modifyWith f `implements` modifyWith_S f -getConjMatrix_S x = ( tmap conj x, x )+getConjMatrix_S x = ( tmap conjugate x, x ) prop_GetConjMatrix =      (\x -> getConjMatrix x >>= abstract) `implements` getConjMatrix_S @@ -178,10 +182,10 @@ -- The specification language --     -abstract :: (BLAS1 e) => STMatrix s (m,n) e -> ST s (Matrix (m,n) e)+abstract :: (BLAS3 e) => STMatrix s (m,n) e -> ST s (Matrix (m,n) e) abstract = freezeMatrix -commutes :: (AEq a, Show a, AEq e, BLAS1 e) =>+commutes :: (AEq a, Show a, AEq e, BLAS3 e) =>     STMatrix s (m,n) e -> (STMatrix s (m,n) e -> ST s a) ->         (Matrix (m,n) e -> (a,Matrix (m,n) e)) -> ST s Bool commutes x a f = do@@ -198,7 +202,7 @@                    return passed -commutes2 :: (AEq a, Show a, AEq e, BLAS1 e) =>+commutes2 :: (AEq a, Show a, AEq e, BLAS3 e) =>     STMatrix s (m,n) e -> STMatrix s (m,n) e ->      (STMatrix s (m,n) e ->  STMatrix s (m,n) e -> ST s a) ->         (Matrix (m,n) e -> Matrix (m,n) e -> (a,Matrix (m,n) e,Matrix (m,n) e)) -> ST s Bool@@ -250,7 +254,8 @@ implementsFor mn a f =     forAll (Test.matrix mn) $ \x ->         runST $ do-            commutes (unsafeThawMatrix x) a f+            x' <- unsafeThawMatrix x+            commutes x' a f  implementsFor2 :: (AEq a, Show a) =>     (Int,Int) ->@@ -261,8 +266,9 @@     forAll (Test.matrix mn) $ \x ->     forAll (Test.matrix mn) $ \y ->         runST $ do-            commutes2 (unsafeThawMatrix x) (unsafeThawMatrix y) a f-+            x' <- unsafeThawMatrix x+            y' <- unsafeThawMatrix y+            commutes2 x' y' a f  implementsIf :: (AEq a, Show a) =>     (forall s . STMatrix s (m,n) E -> ST s Bool) ->@@ -276,7 +282,8 @@             x' <- thawMatrix x             pre x') ==>         runST ( do-            commutes (unsafeThawMatrix x) a f )+            x' <- unsafeThawMatrix x+            commutes x' a f )  implementsIf2 :: (AEq a, Show a) =>     (forall s . STMatrix s (m,n) E -> STMatrix s (m,n) E -> ST s Bool) ->@@ -292,7 +299,9 @@             y' <- thawMatrix y             pre x' y') ==>         runST ( do-            commutes2 (unsafeThawMatrix x) (unsafeThawMatrix y) a f )+            x' <- unsafeThawMatrix x+            y' <- unsafeThawMatrix y+            commutes2 x' y' a f )              ------------------------------------------------------------------------ @@ -308,10 +317,13 @@      , ("getIndices", mytest prop_GetIndicesLazy)     , ("getIndices'", mytest prop_GetIndicesStrict)-    , ("getElems", mytest prop_GetElemsLazyModifyWith)-    , ("getElems'", mytest prop_GetElemsStrictModifyWith)-    , ("getAssocs", mytest prop_GetAssocsLazyModifyWith)-    , ("getAssocs'", mytest prop_GetAssocsStrictModifyWith)+    , ("getElems", mytest prop_GetElemsLazy)+    , ("getElems'", mytest prop_GetElemsStrict)++    , ("getElems . modifyWith", mytest prop_GetElemsLazyModifyWith)+    , ("getElems' . modifyWith", mytest prop_GetElemsStrictModifyWith)+    , ("getAssocs . modifyWith", mytest prop_GetAssocsLazyModifyWith)+    , ("getAssocs' . modifyWith", mytest prop_GetAssocsStrictModifyWith)      , ("newZeroMatrix", mytest prop_NewZeroMatrix)     , ("setZeroMatrix", mytest prop_SetZeroMatrix)
tests/STVector.hs view
@@ -1,12 +1,12 @@-{-# LANGUAGE Rank2Types, PatternSignatures #-}+{-# LANGUAGE Rank2Types, ScopedTypeVariables #-} module STVector ( tests_STVector ) where  -import BLAS.Elem+import Data.Elem.BLAS import Data.Vector.Dense import Data.Vector.Dense.ST -import qualified Generators.Vector.Dense as Test+import qualified Test.Vector.Dense as Test  import Driver @@ -120,7 +120,7 @@  -------------------------- Unsary Vector Operations -------------------------- -doConj_S x = ( (), map conj x )+doConj_S x = ( (), map conjugate x ) prop_DoConj = doConj `implements` doConj_S  scaleBy_S k x = ( (), map (k*) x )@@ -132,7 +132,7 @@ modifyWith_S f x = ( (), map f x ) prop_ModifyWith f = modifyWith f `implements` modifyWith_S f -getConjVector_S x = ( map conj x, x )+getConjVector_S x = ( map conjugate x, x ) prop_GetConjVector =      (\x -> getConjVector x >>= abstract) `implements` getConjVector_S @@ -192,7 +192,7 @@ prop_GetWhichMaxAbs =      implementsIf (return . (>0) . dim) getWhichMaxAbs getWhichMaxAbs_S -getDot_S x y = ( foldl' (+) 0 $ zipWith (*) (map conj x) y, x, y )+getDot_S x y = ( foldl' (+) 0 $ zipWith (*) (map conjugate x) y, x, y ) prop_GetDot = getDot `implements2` getDot_S  @@ -201,10 +201,10 @@ -- The specification language --     -abstract :: (Elem e) => STVector s n e -> ST s [e]+abstract :: (BLAS1 e) => STVector s n e -> ST s [e] abstract = getElems' -commutes :: (AEq a, Show a, AEq e, Elem e) =>+commutes :: (AEq a, Show a, AEq e, BLAS1 e) =>     STVector s n e -> (STVector s n e -> ST s a) ->         ([e] -> (a,[e])) -> ST s Bool commutes x a f = do@@ -221,7 +221,7 @@                    return passed -commutes2 :: (AEq a, Show a, AEq e, Elem e) =>+commutes2 :: (AEq a, Show a, AEq e, BLAS1 e) =>     STVector s n e -> STVector s n e ->      (STVector s n e ->  STVector s n e -> ST s a) ->         ([e] -> [e] -> (a,[e],[e])) -> ST s Bool@@ -273,7 +273,8 @@ implementsFor n a f =     forAll (Test.vector n) $ \x ->         runST $ do-            commutes (unsafeThawVector x) a f+            x' <- unsafeThawVector x+            commutes x' a f  implementsFor2 :: (AEq a, Show a) =>     Int ->@@ -284,7 +285,9 @@     forAll (Test.vector n) $ \x ->     forAll (Test.vector n) $ \y ->         runST $ do-            commutes2 (unsafeThawVector x) (unsafeThawVector y) a f+            x' <- unsafeThawVector x+            y' <- unsafeThawVector y+            commutes2 x' y' a f  implementsIf :: (AEq a, Show a) =>     (forall s . STVector s n E -> ST s Bool) ->@@ -298,7 +301,8 @@             x' <- thawVector x             pre x') ==>         runST ( do-            commutes (unsafeThawVector x) a f )+            x' <- unsafeThawVector x+            commutes x' a f )  implementsIf2 :: (AEq a, Show a) =>     (forall s . STVector s n E -> STVector s n E -> ST s Bool) ->@@ -314,7 +318,9 @@             y' <- thawVector y             pre x' y') ==>         runST ( do-            commutes2 (unsafeThawVector x) (unsafeThawVector y) a f )+            x' <- unsafeThawVector x+            y' <- unsafeThawVector y+            commutes2 x' y' a f )               ------------------------------------------------------------------------
+ tests/Test/Matrix/Banded.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.QuickCheck.Matrix.Banded+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Test.Matrix.Banded (+    banded,+    +    BandedAt(..),+    ListsBanded(..),+    BandedMV(..),+    BandedMVPair(..),+    BandedMM(..),+    BandedMMPair(..),+    ) where++import Debug.Trace+import Control.Monad( forM )++import Test.QuickCheck hiding ( Test.vector )+import Test.QuickCheck.BLAS ( TestElem )+import qualified Test.QuickCheck.BLAS as Test++import Data.Vector.Dense ( Vector, dim )+import Data.Matrix.Dense ( Matrix )+import Data.Matrix.Banded hiding ( banded )+import Data.Elem.BLAS ( Elem, BLAS3 )++banded :: (TestElem e) => +    (Int,Int) -> (Int,Int) -> Gen (Banded (m,n) e)+banded = Test.banded++instance (TestElem e) => Arbitrary (Banded (m,n) e) where+    arbitrary = do+        (m,n)   <- Test.shape+        (kl,ku) <- Test.bandwidths (m,n)+        banded (m,n) (kl,ku)+        +    coarbitrary x = undefined++data BandedAt m n e = BandedAt (Banded (m,n) e) (Int,Int) deriving (Eq, Show)+instance (TestElem e) => Arbitrary (BandedAt m n e) where+    arbitrary = sized $ \k ->+        let k' = ceiling (sqrt $ fromInteger $ toInteger k :: Double)+        in do+            m  <- choose (1,k'+1)+            n  <- choose (1,k'+1)+            kl <- choose (0,m-1)+            ku <- choose (0,n-1)+            i  <- choose (0,m-1)+            j  <- choose (0,n-1)+            a  <- banded (m,n) (kl,ku)+            +            return $ BandedAt a (i,j)++    coarbitrary = undefined++data ListsBanded e = ListsBanded !(Int,Int) !(Int,Int) ![[e]] deriving (Eq,Show)+instance (TestElem e) => Arbitrary (ListsBanded e) where+    arbitrary = do+        (m',n') <- Test.shape+        let (m,n) = (m'+1,n'+1)+        (kl,ku) <- Test.bandwidths (m,n)++        ds <- forM [(-kl)..ku] $ \i ->+                  let beginPad = max (-i)    0+                      endPad   = max (m-n+i) 0+                      len      = m - (beginPad+endPad)+                  in do+                      xs <- Test.elements len+                      return $ replicate beginPad 0 ++ xs ++ replicate endPad 0+         +        return $ ListsBanded (m,n) (kl,ku) ds+          +    coarbitrary (ListsBanded mn lu ds) = coarbitrary (mn,lu,ds)+   +{-+                    +data MatrixPair m n e = Pair (Matrix (m,n) e) (Matrix (m,n) e) deriving (Eq, Show)++instance (Arbitrary e, Elem e) => Arbitrary (MatrixPair m n e) where+    arbitrary = sized $ \k -> +        let k' = ceiling (sqrt $ fromInteger $ toInteger k :: Double)+        in do+            m <- choose (0,k')+            n <- choose (0,k')+            a <- Test.matrix (m,n)+            b <- Test.matrix (m,n)+            return $ Pair a b+        +    coarbitrary = undefined+-}  +  +data BandedMV m n e = BandedMV (Banded (m,n) e) (Vector n e) deriving (Eq, Show)++instance (TestElem e) => Arbitrary (BandedMV m n e) where+    arbitrary = sized $ \k -> +        let k' = ceiling (sqrt $ fromInteger $ toInteger k :: Double)+        in do+            m <- choose (0,k')+            n <- choose (0,k')+            kl <- if m == 0 then return 0 else choose (0,m-1)+            ku <- if n == 0 then return 0 else choose (0,n-1)+            a <- banded (m,n) (kl,ku)             +            x <- Test.vector n+            return $ BandedMV a x+            +    coarbitrary = undefined++data BandedMVPair m n e = BandedMVPair (Banded (m,n) e) (Vector n e) (Vector n e) +    deriving (Eq, Show)+    +instance (TestElem e) => Arbitrary (BandedMVPair m n e) where+    arbitrary = do+        (BandedMV a x) <- arbitrary+        y <- Test.vector (dim x)+        return $ BandedMVPair a x y+        +    coarbitrary = undefined+        +data BandedMM m n k e = BandedMM (Banded (m,k) e) (Matrix (k,n) e) deriving (Eq, Show)++instance (TestElem e) => Arbitrary (BandedMM m n k e) where+    arbitrary = sized $ \s ->+        let s' = ceiling (sqrt $ fromInteger $ toInteger s :: Double)+        in do+            m <- choose (0,s')+            k <- choose (0,s')+            n <- choose (0,s')+            kl <- if m == 0 then return 0 else choose (0,m-1)+            ku <- if k == 0 then return 0 else choose (0,k-1)+            a <- banded (m,k) (kl,ku)             +            b <- Test.matrix (k,n)+            return $ BandedMM a b+            +    coarbitrary = undefined+        +data BandedMMPair m n k e = BandedMMPair (Banded (m,k) e) (Matrix (k,n) e) (Matrix (k,n) e)+    deriving (Eq, Show)+    +instance (TestElem e) => Arbitrary (BandedMMPair m n k e) where+    arbitrary = do+        (BandedMM a b) <- arbitrary+        c <- Test.matrix (shape b)+        return $ BandedMMPair a b c+        +    coarbitrary = undefined
+ tests/Test/Matrix/Dense.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.Matrix.Dense+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Test.Matrix.Dense (+    matrix,+    +    MatrixAt(..),+    SubMatrix(..),+    MatrixPair(..),+    MatrixMV(..),+    MatrixMVPair(..),+    MatrixMM(..),+    MatrixMMPair(..)+    ) where++import Test.QuickCheck hiding ( Test.vector )+import Test.QuickCheck.BLAS ( TestElem )+import Test.QuickCheck.BLASBase( SubMatrix(..) )+import qualified Test.QuickCheck.BLAS as Test++import Data.Vector.Dense ( Vector, dim )+import Data.Matrix.Dense hiding ( Test.matrix )+import Data.Elem.BLAS ( BLAS3 )++matrix :: (TestElem e) => (Int,Int) -> Gen (Matrix (m,n) e)+matrix = Test.matrix+++instance (TestElem e) => Arbitrary (Matrix (m,n) e) where+    arbitrary   = Test.matrix =<< Test.shape+    coarbitrary = undefined++data MatrixAt m n e =+    MatrixAt (Matrix (m,n) e)+             (Int,Int)+    deriving (Show)+instance (TestElem e) => Arbitrary (MatrixAt m n e) where+    arbitrary = do+        (m',n') <- Test.shape+        i <- choose (0,m')+        j <- choose (0,n')+        a <- Test.matrix (m'+1,n'+1)+        return $ MatrixAt a (i,j)+        +    coarbitrary = undefined++++        +data MatrixPair m n e = +    MatrixPair (Matrix (m,n) e) +               (Matrix (m,n) e) +    deriving (Show)++instance (TestElem e) => Arbitrary (MatrixPair m n e) where+    arbitrary = do+        a <- arbitrary+        b <- Test.matrix (shape a)+        return $ MatrixPair a b+        +    coarbitrary = undefined+  +data MatrixMV m n e = +    MatrixMV (Matrix (m,n) e) +             (Vector n e) +    deriving (Show)++instance (TestElem e) => Arbitrary (MatrixMV m n e) where+    arbitrary = do+        a <- arbitrary+        x <- Test.vector (numCols a)+        return $ MatrixMV a x+            +    coarbitrary = undefined++data MatrixMVPair m n e = +    MatrixMVPair (Matrix (m,n) e) +                 (Vector n e) +                 (Vector n e) +    deriving (Show)+    +instance (TestElem e) => Arbitrary (MatrixMVPair m n e) where+    arbitrary = do+        (MatrixMV a x) <- arbitrary+        y <- Test.vector (dim x)+        return $ MatrixMVPair a x y+        +    coarbitrary = undefined++        +data MatrixMM m n k e = +    MatrixMM (Matrix (m,k) e) +             (Matrix (k,n) e) +    deriving (Show)++instance (TestElem e) => Arbitrary (MatrixMM m n k e) where+    arbitrary = do+        a <- arbitrary+        (_,n) <- Test.shape+        b <- Test.matrix (numCols a, n)+        return $ MatrixMM a b+            +    coarbitrary = undefined+        +data MatrixMMPair m n k e = +    MatrixMMPair (Matrix (m,k) e) +                 (Matrix (k,n) e) +                 (Matrix (k,n) e)+    deriving (Show)+    +instance (TestElem e) => Arbitrary (MatrixMMPair m n k e) where+    arbitrary = do+        (MatrixMM a b) <- arbitrary+        c <- Test.matrix (shape b)+        return $ MatrixMMPair a b c+        +    coarbitrary = undefined
+ tests/Test/Matrix/Herm/Banded.hs view
@@ -0,0 +1,114 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.Matrix.Herm.Banded+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Test.Matrix.Herm.Banded (+    HermBanded(..),+    HermBandedMV(..),+    HermBandedMM(..),+    ) where++import Control.Monad ( liftM, replicateM )++import Test.QuickCheck hiding ( Test.vector )+import Test.QuickCheck.BLAS ( TestElem )+import qualified Test.QuickCheck.BLAS as Test++import Data.Elem.BLAS ( Elem, BLAS3, fromReal, conjugate )++import Data.Vector.Dense ( Vector )+import Data.Matrix.Banded+import Data.Matrix.Banded.Base( listsFromBanded )+import Data.Matrix.Dense ( Matrix )+import Data.Matrix.Herm++++hermBanded :: (TestElem e) => Int -> Int -> Gen (Banded (n,n) e)+hermBanded n k +    | n < 0 = +        error $ "hermBanded: n must be non-negative"+    | n == 0 =+        return $ listsBanded (0,0) (0,0) []+    | k >= n =+        error $ "hermBanded: k must be less than n"+    | k < 0 = +        error $ "hermBanded: k must be non-negative"+    | k == 0 = do+        d <- Test.realElements n+        return $ listsBanded (n,n) (0,0) [d]+    | otherwise = do+        a <- hermBanded n (k-1)+        let (_,_,ds) = listsFromBanded a+        +        d <- Test.elements (n-k)+        let d'  = map conjugate d+            pad = replicate k 0+            ds' = [pad ++ d] ++ ds ++ [d' ++ pad]++        return $ listsBanded (n,n) (k,k) ds'++data HermBanded n e =+    HermBanded (Herm Banded (n,n) e)+               (Banded (n,n) e)+    deriving Show+    +instance (TestElem e) => Arbitrary (HermBanded n e) where+    arbitrary = do+        n <- liftM fst Test.shape+        k <- if n == 0 then return 0 else choose (0,n-1)+        l <- if n == 0 then return 0 else choose (0,n-1)+            +        a <- hermBanded n k+            +        junk <- replicateM l $ Test.elements n+        let (_,_,ds) = listsFromBanded a+            (u ,b ) = (Upper, listsBanded (n,n) (l,k) $ junk ++ (drop k ds))+            (u',b') = (Lower, listsBanded (n,n) (k,l) $ (take (k+1) ds) ++ junk)+        +        h <- elements [ hermFromBase u             b+                      , hermFromBase (flipUpLo u)  (herm b)+                      , hermFromBase u'            b'+                      , hermFromBase (flipUpLo u') (herm b')+                      ]+            +        return $ HermBanded h a++    coarbitrary = undefined++data HermBandedMV n e = +    HermBandedMV (Herm Banded (n,n) e) +                 (Banded (n,n) e) +                 (Vector n e) +    deriving Show++instance (TestElem e) => Arbitrary (HermBandedMV n e) where+    arbitrary = do+        (HermBanded h a) <- arbitrary+        x <- Test.vector (numCols a)+        return $ HermBandedMV h a x++    coarbitrary = undefined+    +    +data HermBandedMM m n e = +    HermBandedMM (Herm Banded (m,m) e) +                 (Banded (m,m) e) +                 (Matrix (m,n) e) +    deriving Show+    +instance (TestElem e) => Arbitrary (HermBandedMM m n e) where+    arbitrary = do+        (HermBanded a h) <- arbitrary+        (_,n) <- Test.shape+        b <- Test.matrix (numCols h,n)++        return $ HermBandedMM a h b+            +    coarbitrary = undefined
+ tests/Test/Matrix/Herm/Dense.hs view
@@ -0,0 +1,91 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.Matrix.Herm.Dense+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Test.Matrix.Herm.Dense( +    HermMatrix(..),+    HermMatrixMV(..),+    HermMatrixMM(..),+    ) where++import Control.Monad( liftM )++import Test.QuickCheck hiding ( Test.vector )+import Test.QuickCheck.BLAS ( TestElem )+import qualified Test.QuickCheck.BLAS as Test++import Data.Elem.BLAS ( BLAS3 )++import Data.Vector.Dense hiding ( Test.vector )+import Data.Matrix.Dense hiding ( Test.matrix )+import Data.Matrix.Herm++++hermMatrix :: (TestElem e) => Int -> Gen (Matrix (n,n) e)+hermMatrix n  = do+    a <- Test.matrix (n,n)+    let h = (a + herm a)+    elements [ h, herm h ]+++data HermMatrix n e = +    HermMatrix (Herm Matrix (n,n) e)+               (Matrix (n,n) e)+    deriving Show++instance (TestElem e) => Arbitrary (HermMatrix n e) where+    arbitrary = do+        n <- liftM fst Test.shape+        a <- hermMatrix n+        +        junk <- Test.elements (n*n)+        let (u ,b ) = (Upper, a // zip (filter (uncurry (>)) $ indices a) junk)+            (u',b') = (Lower, a // zip (filter (uncurry (<)) $ indices a) junk)++        h <- elements [ hermFromBase u             b+                      , hermFromBase (flipUpLo u)  (herm b)+                      , hermFromBase u'            b'+                      , hermFromBase (flipUpLo u') (herm b')+                      ]+        return $ HermMatrix h a+        +    coarbitrary = undefined+++data HermMatrixMV n e = +    HermMatrixMV (Herm Matrix (n,n) e) +                 (Matrix (n,n) e) +                 (Vector n e) +    deriving Show++instance (TestElem e) => Arbitrary (HermMatrixMV n e) where+    arbitrary = do+        (HermMatrix h a) <- arbitrary+        x <- Test.vector (numCols a)+        return $ HermMatrixMV h a x+        +    coarbitrary = undefined++    +data HermMatrixMM m n e = +    HermMatrixMM (Herm Matrix (m,m) e) +                 (Matrix (m,m) e) +                 (Matrix (m,n) e) +    deriving Show+    +instance (TestElem e) => Arbitrary (HermMatrixMM m n e) where+    arbitrary = do+        (HermMatrix h a) <- arbitrary+        n <- liftM fst Test.shape+        b <- Test.matrix (numCols a,n)+        return $ HermMatrixMM h a b+            +    coarbitrary = undefined+
+ tests/Test/Matrix/Tri/Banded.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.Matrix.Tri.Banded+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Test.Matrix.Tri.Banded (+    TriBanded(..),+    TriBandedMV(..),+    TriBandedMM(..),+    TriBandedSV(..),+    TriBandedSM(..),+    ) where++import Control.Monad ( replicateM )++import Test.QuickCheck hiding ( Test.vector )+import Test.QuickCheck.BLAS ( TestElem )+import qualified Test.QuickCheck as QC+import qualified Test.QuickCheck.BLAS as Test++import Data.Vector.Dense ( Vector )+import Data.Matrix.Dense ( Matrix )+import Data.Matrix.Banded+import Data.Matrix.Banded.Base( listsFromBanded )+import Data.Elem.BLAS ( BLAS3 )++import Data.Matrix.Tri ( Tri, triFromBase )+import Data.Matrix.Class( UpLoEnum(..), DiagEnum(..) )++import Unsafe.Coerce++triBanded :: (TestElem e) => UpLoEnum -> DiagEnum -> Int -> Int -> Gen (Banded (n,n) e)+triBanded Upper NonUnit n k = do+    a <- triBanded Upper Unit n k+    d <- Test.elements n+    let (_,_,(_:ds)) = listsFromBanded a+    return $ listsBanded (n,n) (0,k) (d:ds)++triBanded Lower NonUnit n k = do+    a <- triBanded Lower Unit n k+    d <- Test.elements n+    let (_,_,ds) = listsFromBanded a+        ds' = (init ds) ++ [d]+    return $ listsBanded (n,n) (k,0) ds'+    +triBanded _ Unit n 0 = do+    return $ listsBanded (n,n) (0,0) [replicate n 1]+    +triBanded Upper Unit n k = do+    a <- triBanded Upper Unit n (k-1)+    let (_,_,ds) = listsFromBanded a+    +    d <- Test.elements (n-k) >>= \xs -> return $ xs ++ replicate k 0+    +    return $ listsBanded (n,n) (0,k) $ ds ++ [d]+    +triBanded Lower Unit n k = do+    a <- triBanded Lower Unit n (k-1)+    let (_,_,ds) = listsFromBanded a++    d <- Test.elements (n-k) >>= \xs -> return $ replicate k 0 ++ xs+    +    return $ listsBanded (n,n) (k,0) $ [d] ++ ds+    +    +data TriBanded n e = +    TriBanded (Tri Banded (n,n) e) (Banded (n,n) e) deriving Show++instance (TestElem e) => Arbitrary (TriBanded n e) where+    arbitrary = do+        u <- elements [ Upper, Lower  ]+        d <- elements [ Unit, NonUnit ]+        (m,n) <- Test.shape+        (_,k) <- Test.bandwidths (m,n)+        a <- triBanded u d n k++        l    <- if n == 0 then return 0 else choose (0,n-1)+        junk <- replicateM l $ Test.elements n+        diagJunk <- Test.elements n+        let (_,_,ds) = listsFromBanded a+            t = triFromBase u d $ case (u,d) of +                    (Upper,NonUnit) -> +                        listsBanded (n,n) (l,k) $ junk ++ ds+                    (Upper,Unit) ->+                        listsBanded (n,n) (l,k) $ junk ++ [diagJunk] ++ tail ds+                    (Lower,NonUnit) -> +                        listsBanded (n,n) (k,l) $ ds ++ junk+                    (Lower,Unit) -> +                        listsBanded (n,n) (k,l) $ init ds ++ [diagJunk] ++ junk++        (t',a') <- elements [ (t,a), unsafeCoerce (herm t, herm a)]+        return $ TriBanded t' a'+            +    coarbitrary = undefined++data TriBandedMV n e = +    TriBandedMV (Tri Banded (n,n) e) (Banded (n,n) e) (Vector n e) deriving Show++instance (TestElem e) => Arbitrary (TriBandedMV n e) where+    arbitrary = do+        (TriBanded t a) <- arbitrary+        x <- Test.vector (numCols t)+        return $ TriBandedMV t a x+        +    coarbitrary = undefined+        +data TriBandedMM m n e = +    TriBandedMM (Tri Banded (m,m) e) (Banded (m,m) e) (Matrix (m,n) e) deriving Show++instance (TestElem e) => Arbitrary (TriBandedMM m n e) where+    arbitrary = do+        (TriBanded t a) <- arbitrary+        (_,n) <- Test.shape+        b <- Test.matrix (numCols t, n)+        return $ TriBandedMM t a b+            +    coarbitrary = undefined+        +data TriBandedSV n e = +    TriBandedSV (Tri Banded (n,n) e) (Vector n e) deriving (Show)+    +instance (TestElem e) => Arbitrary (TriBandedSV n e) where+    arbitrary = do+        (TriBanded t a) <- arbitrary+        if any (== 0) (elems $ diagBanded a 0)+            then arbitrary+            else do+                x <- Test.vector (numCols t)+                let y = t <*> x+                return (TriBandedSV t y)+        +    coarbitrary = undefined+++data TriBandedSM m n e = +    TriBandedSM (Tri Banded (m,m) e) (Matrix (m,n) e) +    deriving (Show)+    +instance (TestElem e) => Arbitrary (TriBandedSM m n e) where+    arbitrary = do+        (TriBandedSV t _) <- arbitrary+        (_,n) <- Test.shape+        a <- Test.matrix (numCols t, n)+        +        let b = t <**> a+        return (TriBandedSM t b)+        +    coarbitrary = undefined+
+ tests/Test/Matrix/Tri/Dense.hs view
@@ -0,0 +1,151 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.Matrix.Tri.Dense+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Test.Matrix.Tri.Dense (+    TriMatrix(..),+    TriMatrixMV(..),+    TriMatrixMM(..),+    TriMatrixSV(..),+    TriMatrixSM(..),+    ) where++import Data.Ix ( range )+import Control.Monad( liftM )++import Test.QuickCheck hiding ( Test.vector )+import Test.QuickCheck.BLAS ( TestElem )+import qualified Test.QuickCheck.BLAS as Test++import Data.Vector.Dense hiding ( Test.vector )+import Data.Matrix.Dense+import Data.Elem.BLAS ( BLAS3 )++import Data.Matrix.Tri ( Tri, triFromBase )+import Data.Matrix.Class( UpLoEnum(..), DiagEnum(..) )++import Unsafe.Coerce++triMatrix :: (TestElem e) => UpLoEnum -> DiagEnum -> (Int,Int) -> Gen (Matrix (m,n) e)+triMatrix u d (m,n) =+    let ijs = filter (isTriIndex u d) $ range ((0,0), (m-1,n-1))+    in do+        es <- Test.elements (m*n)+        let a  = matrix (m,n) $ zip ijs es+            a' = case d of+                    NonUnit -> a+                    Unit    -> a // [ ((i,i),1) | i <- [0..(mn-1)] ]+        return $ a'+  where+    mn = min m n++isTriIndex :: UpLoEnum -> DiagEnum -> (Int,Int) -> Bool+isTriIndex Upper NonUnit (i,j) = i <= j+isTriIndex Upper Unit    (i,j) = i <  j+isTriIndex Lower NonUnit (i,j) = i >= j+isTriIndex Lower Unit    (i,j) = i >  j++-- | A triangular Test.matrix and an equivalent dense Test.matrix+data TriMatrix m n e = +    TriMatrix (Tri Matrix (m,n) e) +              (Matrix (m,n) e) +    deriving Show++instance (TestElem e) => Arbitrary (TriMatrix m n e) where+    arbitrary = do+        u <- elements [ Upper, Lower  ]+        d <- elements [ Unit, NonUnit ]+        (m,n) <- Test.shape+        a <- triMatrix u d (m,n)+        +        junk <- Test.elements (m*n)+        let ijs = [ (i,j) | i <- [0..(m-1)]+                          , j <- [0..(n-1)]+                          , (not . (isTriIndex u d)) (i,j) ]+            t   = triFromBase u d $ a // zip ijs junk+            +        (t',a') <- elements [ (t,a), unsafeCoerce (herm t, herm a) ]+            +        return $ TriMatrix t' $ submatrix a' (0,0) (shape t')+            +    coarbitrary = undefined+++-- | A triangular Test.matrix, and equivalent dense Test.matrix, and a Test.vector in+-- their domain.        +data TriMatrixMV m n e = +    TriMatrixMV (Tri Matrix (m,n) e) +                (Matrix (m,n) e) +                (Vector n e) +    deriving Show++instance (TestElem e) => Arbitrary (TriMatrixMV m n e) where+    arbitrary = do+        (TriMatrix t a) <- arbitrary+        x <- Test.vector (numCols a)+        return $ TriMatrixMV t a x++    coarbitrary = undefined++-- | A triangular Test.matrix, and equivalent dense Test.matrix, and a Test.matrix in+-- their domain.        +data TriMatrixMM m k n e = +    TriMatrixMM (Tri Matrix (m,k) e) +                (Matrix (m,k) e) +                (Matrix (k,n) e) +    deriving Show++instance (TestElem e) => Arbitrary (TriMatrixMM m k n e) where+    arbitrary =  do+        (TriMatrix t a) <- arbitrary+        n <- liftM fst Test.shape+        b <- Test.matrix (numCols a, n)+        return $ TriMatrixMM t a b+            +    coarbitrary = undefined++-- | A triangular Test.matrix and a Test.vector in its range+data TriMatrixSV m n e = +    TriMatrixSV (Tri Matrix (m,n) e) +                (Vector m e) +    deriving Show+    +instance (TestElem e) => Arbitrary (TriMatrixSV m n e) where+    arbitrary = do+        (TriMatrix t a) <- arbitrary+        if any (== 0) (elems $ diag a 0)+            then arbitrary+            else do+                x <- Test.vector (numCols a)+                let y  = a <*> x+                return (TriMatrixSV t y)+        +    coarbitrary = undefined++-- | A triangular Test.matrix and a Test.matrix in its range+data TriMatrixSM m k n e = +    TriMatrixSM (Tri Matrix (m,k) e) +                (Matrix (m,n) e) +    deriving Show+    +instance (TestElem e) => Arbitrary (TriMatrixSM m k n e) where+    arbitrary = do+        (TriMatrix t a) <- arbitrary+        if any (== 0) (elems $ diag a 0)+            then arbitrary+            else do+                n <- liftM fst Test.shape+                b <- Test.matrix (numCols a, n)+                let c  = a <**> b+                return (TriMatrixSM t c)+        +    coarbitrary = undefined++normF :: (BLAS3 e) => Matrix (n,p) e -> Double+normF = sum . map norm2 . cols
+ tests/Test/Vector/Dense.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Test.Vector.Dense+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>+-- License    : BSD3+-- Maintainer : Patrick Perry <patperry@stanford.edu>+-- Stability  : experimental+--++module Test.Vector.Dense (+    SubVector(..),+    VectorPair(..),+    VectorTriple(..),+    +    vector,+    ) where++import Test.QuickCheck hiding ( vector )+import Test.QuickCheck.BLAS ( TestElem )+import Test.QuickCheck.BLASBase( SubVector(..) )+import qualified Test.QuickCheck.BLAS as Test++import Data.Vector.Dense hiding ( vector )+import Data.Elem.BLAS ( BLAS1 )++vector :: (TestElem e) => Int -> Gen (Vector n e)+vector = Test.vector+    +data VectorPair n e = +    VectorPair (Vector n e) +               (Vector n e) +    deriving (Show)+    +data VectorTriple n e = +    VectorTriple (Vector n e) +                 (Vector n e) +                 (Vector n e) +    deriving (Show)++instance (TestElem e) => Arbitrary (Vector n e) where+    arbitrary = sized $ \m ->+        choose (0,m) >>= vector+        +    coarbitrary = undefined++instance (TestElem e) => Arbitrary (VectorPair n e) where+    arbitrary = sized $ \m -> do+        n <- choose (0,m)+        x <- vector n+        y <- vector n+        return $ VectorPair x y+        +    coarbitrary = undefined+        +instance (TestElem e) => Arbitrary (VectorTriple n e) where+    arbitrary = sized $ \m -> do+        n <- choose (0,m)+        x <- vector n+        y <- vector n+        z <- vector n+        return $ VectorTriple x y z+    +    coarbitrary = undefined
tests/TriBanded.hs view
@@ -9,7 +9,7 @@ import Data.Matrix.Tri    -import Generators.Matrix.Tri.Banded+import Test.Matrix.Tri.Banded   type V = Vector Int E
tests/TriMatrix.hs view
@@ -10,7 +10,7 @@ module TriMatrix ( tests_TriMatrix ) where  import Driver-import Generators.Matrix.Tri.Dense+import Test.Matrix.Tri.Dense  import Data.Vector.Dense import Data.Matrix.Dense
tests/Vector.hs view
@@ -1,15 +1,16 @@-{-# LANGUAGE PatternSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-} module Vector( tests_Vector ) where -import BLAS.Elem+import Data.Elem.BLAS import Data.Vector.Dense+import Data.Tensor.Class   import Driver import qualified Data.Array as Array-import Generators.Vector.Dense hiding ( vector )-import qualified Generators.Vector.Dense as Test-+import Test.Vector.Dense hiding ( vector )+import qualified Test.Vector.Dense as Test+import System.IO.Unsafe  type V = Vector Index E @@ -19,7 +20,9 @@ prop_vector_dim (Assocs n ies) =     dim (vector n ies :: V) == n prop_vector_assocs (Assocs n ies) =-    assocs (vector n ies :: V) `assocsEq` (zip [0..(n-1)] (repeat 0) ++ ies)+    (zip [0..(n-1)] (repeat 0) ++ ies) +    `assocsEq` +    (assocs (vector n ies :: V))  prop_listVector_dim es =     let n = length es@@ -48,7 +51,7 @@     forAll (Test.vector n) $ \x ->         let x'   = x // ies             ies' = Array.assocs $ (Array.//) (Array.array (0,n-1) $ assocs x) ies-        in assocs x' `assocsEq` ies'+        in ies' `assocsEq` assocs x'  ------------------------------ Vector Views-- -------------------------------- @@ -100,10 +103,10 @@     k *> x ~== x * constantVector (dim x) k  prop_conj_elems (x :: V) =-    and $ zipWith (===) (elems $ conj x) (map conj $ elems x)+    and $ zipWith (===) (elems $ conj x) (map conjugate $ elems x)  prop_conj_scale k (x :: V) =-    conj (k *> x) ===  (conj k *> (conj x))+    conj (k *> x) ===  (conjugate k *> (conj x))  prop_negate (x :: V) =     negate x ~== (-1) *> x@@ -155,13 +158,13 @@     (sqrt $ x <.> x) ~== (fromReal $ norm2 x)      prop_dot_conj (VectorPair (x :: V) y) =-    (x <.> y) ~== (conj $ y <.> x)+    (x <.> y) ~== (conjugate $ y <.> x)      prop_dot_scale1 k (VectorPair (x :: V) y) =     (x <.> (k *> y)) ~== k * (x <.> y)      prop_dot_scale2 k (VectorPair (x :: V) y) =-    ((k *> x) <.> y) ~== (conj k) * (x <.> y)+    ((k *> x) <.> y) ~== (conjugate k) * (x <.> y)      prop_dot_linear1 (VectorTriple (x :: V) y z) =     (x <.> (y + z)) ~== (x <.> y + x <.> z)@@ -225,7 +228,18 @@   assocsEq :: [(Int,E)] -> [(Int,E)] -> Bool-assocsEq ies ies' = ordered ies ~== ordered ies'+assocsEq ies ies' = +    if (ordered ies === ordered ies')+        then True+        else unsafePerformIO $ do+            zipWithM_ (\(i1,e1) (i2,e2) -> do+                putStr $ show i1 ++ ": " ++ show e1 ++ " " ++ show e2+                unless (e1 ~== e2) $ putStr " **** "+                putStrLn ""+                )+                (ordered ies)+                (ordered ies')+            return False   where     ordered = sortAssocs . nubAssocs     nubAssocs = reverse . nubBy ((==) `on` fst) . reverse