diff --git a/BLAS/Access.hs b/BLAS/Access.hs
deleted file mode 100644
--- a/BLAS/Access.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE EmptyDataDecls #-}
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Access
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
--- Types for access control.
-module BLAS.Access (
-    Mut,
-    Imm
-    ) where
-
--- | Tag for mutable types.
-data Mut
-
--- | Tag for immutable types.
-data Imm
diff --git a/BLAS/C/Level1.hs b/BLAS/C/Level1.hs
--- a/BLAS/C/Level1.hs
+++ b/BLAS/C/Level1.hs
@@ -12,11 +12,14 @@
 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
         
@@ -42,7 +45,20 @@
     -- | 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
@@ -57,6 +73,10 @@
     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 =
@@ -124,3 +144,8 @@
                         
                     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
diff --git a/BLAS/Conj.hs b/BLAS/Conj.hs
new file mode 100644
--- /dev/null
+++ b/BLAS/Conj.hs
@@ -0,0 +1,33 @@
+{-# 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 #-}
diff --git a/BLAS/Elem/Base.hs b/BLAS/Elem/Base.hs
--- a/BLAS/Elem/Base.hs
+++ b/BLAS/Elem/Base.hs
@@ -9,19 +9,17 @@
 --
 
 module BLAS.Elem.Base (
-    Elem(..)
+    Elem(..),
+    module BLAS.Conj,
     ) where
 
-import Data.Complex             ( Complex(..), conjugate, magnitude )
+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) => Elem e where
-    -- | Take the complex conjugate of a value.  For real values
-    -- this is equal to @id@.
-    conj :: e -> e
-    
+class (Storable e, Fractional e, Conj e) => Elem e where
     -- | Get the magnitude of a value.
     norm :: e -> Double
     
@@ -34,16 +32,13 @@
     -- | Coerce an element to a double
     toReal :: e -> Double
     
-
 instance Elem Double where
-    conj     = id
     norm     = abs
     norm1    = abs
     fromReal = id
     toReal   = id
     
 instance Elem (Complex Double) where
-    conj             = conjugate
     norm             = magnitude
     norm1 (x :+ y)   = abs x + abs y
     fromReal x       = x :+ 0
diff --git a/BLAS/Internal.hs b/BLAS/Internal.hs
--- a/BLAS/Internal.hs
+++ b/BLAS/Internal.hs
@@ -33,15 +33,19 @@
     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) )
@@ -288,3 +292,27 @@
             ("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 #-}
diff --git a/BLAS/Matrix.hs b/BLAS/Matrix.hs
--- a/BLAS/Matrix.hs
+++ b/BLAS/Matrix.hs
@@ -10,11 +10,11 @@
 module BLAS.Matrix (
     module BLAS.Matrix.Base,
     module BLAS.Matrix.Immutable,
-    module BLAS.Matrix.ReadOnly,
+    module BLAS.Matrix.Mutable,
     module BLAS.Matrix.Solve,
     ) where
 
 import BLAS.Matrix.Base
 import BLAS.Matrix.Immutable
-import BLAS.Matrix.ReadOnly
+import BLAS.Matrix.Mutable
 import BLAS.Matrix.Solve
diff --git a/BLAS/Matrix/Base.hs b/BLAS/Matrix/Base.hs
--- a/BLAS/Matrix/Base.hs
+++ b/BLAS/Matrix/Base.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : BLAS.Matrix.Base
@@ -9,40 +9,38 @@
 --
 
 module BLAS.Matrix.Base (
-    Matrix(..),
+    BaseMatrix(..),
+    numRows,
+    numCols,
     isSquare,
     isFat,
     isTall,
     ) where
 
-import BLAS.Elem.Base ( Elem )
-import BLAS.Tensor.Base
+import BLAS.Tensor
 
 -- | A base class for matrices.
-class Matrix a where
-    -- | The number of rows in the matrix.
-    numRows :: a (m,n) e -> Int
-    
-    -- | The number of columns in the matrix.
-    numCols :: a (m,n) e -> Int
-    
+class (BaseTensor a (Int,Int)) => BaseMatrix a where
     -- | Creates a new matrix view that conjugates and transposes the 
     -- given matrix.
-    herm :: Elem e => a (m,n) e -> a (n,m) e
+    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 #-}
 
-isSquare :: (Matrix a) => a (m,n) e -> Bool
+-- | 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 :: (Matrix a) => a (m,n) e -> Bool
+isFat :: (BaseMatrix a) => a mn e -> Bool
 isFat a = numRows a <= numCols a
 
-isTall :: (Matrix a) => a (m,n) e -> Bool
+isTall :: (BaseMatrix a) => a mn e -> Bool
 isTall a = numRows a >= numCols a
 
-instance (Matrix a) => Tensor (a (m,n)) (Int,Int) e where
-    shape a = (numRows a, numCols a)
-    
-    bounds a = ((0,0), (m-1,n-1))
-      where (m,n) = shape a
-      
diff --git a/BLAS/Matrix/Immutable.hs b/BLAS/Matrix/Immutable.hs
--- a/BLAS/Matrix/Immutable.hs
+++ b/BLAS/Matrix/Immutable.hs
@@ -2,7 +2,7 @@
 {-# OPTIONS_GHC -fglasgow-exts #-}
 -----------------------------------------------------------------------------
 -- |
--- Module     : BLAS.Matrix.Immutable
+-- Module     : BLAS.Matrix.Apply.Immutable
 -- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
 -- License    : BSD3
 -- Maintainer : Patrick Perry <patperry@stanford.edu>
@@ -10,58 +10,97 @@
 --
 
 module BLAS.Matrix.Immutable (
-    IMatrix(..)
+    -- * Rows and columns
+    row,
+    col,
+    rows,
+    cols,
+
+    -- * Multiplication
+    (<*>),
+    (<**>),
+    sapply,
+    sapplyMat,
+    
+    IMatrix(..),
+    unsafeApply,
+    unsafeApplyMat,
     ) where
 
-import BLAS.Access
-import BLAS.Elem ( BLAS3 )
-import BLAS.Internal ( checkMatVecMult, checkMatMatMult )
-import BLAS.Matrix.ReadOnly
+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 System.IO.Unsafe ( unsafePerformIO )
+import Data.Matrix.Dense.Class( unsafeRowView, unsafeColView )
+import Data.Matrix.Dense.ST( runSTMatrix )
 
 infixr 7 <*>, <**>
 
-class (RMatrix a e) => IMatrix a e where
-    -- | Apply to a vector
-    (<*>) :: a (m,n) e -> Vector n e -> Vector m e
-    (<*>) a x = 
-        checkMatVecMult (shape a) (dim x) $ unsafeApply a x
-        
-    -- | Apply to a matrix
-    (<**>) :: a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e
-    (<**>) a b = 
-        checkMatMatMult (numRows a, numCols a) 
-                        (numRows b, numCols b) $ unsafeApplyMat a b
+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
 
-    sapply :: e -> a (m,n) e -> Vector n e -> Vector m e
-    sapply k a x =
-        checkMatVecMult (numRows a, numCols a) (dim x) $ unsafeSApply k a x
-        
-    sapplyMat :: e -> a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e    
-    sapplyMat k a b = 
-        checkMatMatMult (numRows a, numCols a) 
-                        (numRows b, numCols b) $ unsafeSApplyMat k a b
+    -- | 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
 
 
-    unsafeApply :: a (m,n) e -> Vector n e -> Vector m e
-    unsafeApply = unsafeSApply 1
+-- | 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
     
-    unsafeApplyMat :: a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e
-    unsafeApplyMat = unsafeSApplyMat 1
+-- | 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
     
-    unsafeSApply :: e -> a (m,n) e -> Vector n e -> Vector m e
-    unsafeSApply alpha a x = unsafePerformIO $ unsafeGetSApply alpha a x
-    {-# NOINLINE unsafeSApply #-}
+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
 
-    unsafeSApplyMat :: e -> a (m,k) e -> Matrix (k,n) e -> Matrix (m,n) e
-    unsafeSApplyMat alpha a b = unsafePerformIO $ unsafeGetSApplyMat alpha a b
-    {-# NOINLINE unsafeSApplyMat #-}
+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 (DMatrix Imm) e where
+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
diff --git a/BLAS/Matrix/Mutable.hs b/BLAS/Matrix/Mutable.hs
new file mode 100644
--- /dev/null
+++ b/BLAS/Matrix/Mutable.hs
@@ -0,0 +1,278 @@
+{-# 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
diff --git a/BLAS/Matrix/ReadOnly.hs b/BLAS/Matrix/ReadOnly.hs
deleted file mode 100644
--- a/BLAS/Matrix/ReadOnly.hs
+++ /dev/null
@@ -1,259 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Matrix.ReadOnly
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Matrix.ReadOnly (
-    RMatrix(..),
-    
-    -- * Matrix and vector multiplication
-    getApply,
-    getApplyMat,
-    getSApply,
-    getSApplyMat,
-    
-    -- * In-place multiplication
-    doApply,
-    doApplyAdd,
-    doApplyMat,
-    doApplyAddMat,
-    doSApply,
-    doSApplyAdd,
-    doSApplyMat,
-    doSApplyAddMat,
-    doApply_,
-    doApplyMat_,
-    doSApply_,
-    doSApplyMat_,
-    
-    -- * Unsafe operations
-    unsafeGetApply,
-    unsafeGetApplyMat,
-    unsafeGetSApply,
-    unsafeGetSApplyMat,
-    
-    ) where
-
-import BLAS.Elem ( BLAS1, BLAS3 )
-import BLAS.Internal ( checkMatVecMult, checkMatMatMult, checkMatVecMultAdd,
-    checkMatMatMultAdd, checkSquare )
-import qualified BLAS.Matrix.Base as Base
-import Data.Vector.Dense.Internal
-import Data.Vector.Dense.Operations
-import qualified Data.Vector.Dense.Operations as V
-import Data.Matrix.Dense.Internal
-import Data.Matrix.Dense.Operations
-import qualified Data.Matrix.Dense.Operations as M
-
-import Unsafe.Coerce
-
--- | Minimal complete definition: (unsafeDoSApplyAdd, unsafeDoSApplyAddMat)
--- or (unsafeDoSApply, unsafeDoSApplyMat)
-class (Base.Matrix a, BLAS1 e) => RMatrix a e where
-    unsafeDoApply :: a (m,n) e -> DVector t n e -> IOVector m e -> IO ()
-    unsafeDoApply =
-        unsafeDoSApply 1
-        
-    unsafeDoApplyAdd :: a (m,n) e -> DVector t n e -> e -> IOVector m e -> IO ()
-    unsafeDoApplyAdd a x beta y =
-        unsafeDoSApplyAdd 1 a x beta y
-
-    unsafeDoSApply :: e -> a (m,n) e -> DVector t n e -> IOVector m e -> IO ()
-    unsafeDoSApply alpha a x y =
-        unsafeDoSApplyAdd alpha a x 0 y
-
-    unsafeDoApplyMat :: a (m,k) e -> DMatrix t (k,n) e -> IOMatrix (m,n) e -> IO ()
-    unsafeDoApplyMat a b c =
-        unsafeDoSApplyMat 1 a b c
-        
-    unsafeDoApplyAddMat :: a (m,k) e -> DMatrix t (k,n) e -> e -> IOMatrix (m,n) e -> IO ()
-    unsafeDoApplyAddMat a b beta c =
-        unsafeDoSApplyAddMat 1 a b beta c
-
-    unsafeDoSApplyMat :: e -> a (m,k) e -> DMatrix t (k,n) e -> IOMatrix (m,n) e -> IO ()
-    unsafeDoSApplyMat alpha a b c =
-        unsafeDoSApplyAddMat alpha a b 0 c
-    
-    unsafeDoApply_ :: a (n,n) e -> IOVector n e -> IO ()
-    unsafeDoApply_ a x =
-        unsafeDoSApply_ 1 a x
-        
-    unsafeDoApplyMat_ :: a (m,m) e -> IOMatrix (m,n) e -> IO ()
-    unsafeDoApplyMat_ a b =
-        unsafeDoSApplyMat_ 1 a b
-
-    unsafeDoSApply_ :: e -> a (n,n) e -> IOVector n e -> IO ()
-    unsafeDoSApply_ alpha a x = do
-        y <- newVector_ (dim x)
-        unsafeDoSApply alpha a x y
-        unsafeCopyVector x y
-
-    unsafeDoSApplyMat_ :: e -> a (m,m) e -> IOMatrix (m,n) e -> IO ()
-    unsafeDoSApplyMat_ alpha a b = do
-        c <- newMatrix_ (shape b)
-        unsafeDoSApplyMat alpha a b c
-        unsafeCopyMatrix b c
-        
-    unsafeDoSApplyAdd :: e -> a (m,n) e -> DVector t n e -> e -> IOVector m e -> IO ()
-    unsafeDoSApplyAdd alpha a x beta y = do
-        y' <- unsafeGetApply a x
-        V.scaleBy beta y
-        V.unsafeAxpy alpha y' y
-        
-    unsafeDoSApplyAddMat :: e -> a (m,k) e -> DMatrix t (k,n) e -> e -> IOMatrix (m,n) e -> IO ()
-    unsafeDoSApplyAddMat alpha a b beta c = do
-        c' <- unsafeGetApplyMat a b
-        M.scaleBy beta c
-        M.axpy alpha c' c
-
-
-unsafeGetApply :: (RMatrix a e) =>
-    a (m,n) e -> DVector t n e -> IO (DVector r m e)
-unsafeGetApply = unsafeGetSApply 1
-
-unsafeGetApplyMat :: (RMatrix a e) =>
-    a (m,k) e -> DMatrix t (k,n) e -> IO (DMatrix r (m,n) e)
-unsafeGetApplyMat = unsafeGetSApplyMat 1
-
-unsafeGetSApply :: (RMatrix a e) =>
-    e -> a (m,n) e -> DVector t n e -> IO (DVector r m e)
-unsafeGetSApply alpha a x = do
-    y <- newZero (numRows a)
-    unsafeDoSApply alpha a x y
-    return (unsafeCoerce y)
-
-unsafeGetSApplyMat :: (RMatrix a e) =>
-    e -> a (m,k) e -> DMatrix t (k,n) e -> IO (DMatrix r (m,n) e)
-unsafeGetSApplyMat alpha a b = do
-    c <- newZero (numRows a, numCols b)
-    unsafeDoSApplyMat alpha a b c
-    return (unsafeCoerce c)
-
-
-
-
--- | Apply to a vector
-getApply :: (RMatrix a e) =>
-    a (m,n) e -> DVector t n e -> IO (DVector r m e)
-getApply a x =
-    checkMatVecMult (shape a) (dim x) $ do
-        unsafeGetApply a x
-
--- | Apply to a matrix
-getApplyMat :: (RMatrix a e) =>
-    a (m,k) e -> DMatrix t (k,n) e -> IO (DMatrix r (m,n) e)
-getApplyMat a b =
-    checkMatMatMult (shape a) (shape b) $
-        unsafeGetApplyMat a b
-
--- | Scale and apply to a vector
-getSApply :: (RMatrix a e) =>
-    e -> a (m,n) e -> DVector t n e -> IO (DVector r m e)
-getSApply k a x =
-    checkMatVecMult (shape a) (dim x) $ 
-        unsafeGetSApply k a x
-
--- | Scale and apply to a matrix
-getSApplyMat :: (RMatrix a e) =>
-    e -> a (m,k) e -> DMatrix t (k,n) e -> IO (DMatrix r (m,n) e)
-getSApplyMat k a b =
-    checkMatMatMult (shape a) (shape b) $
-        unsafeGetSApplyMat k a b
-    
--- | Apply to a vector and store the result in another vector
-doApply :: (RMatrix a e) =>
-    a (m,n) e -> DVector t n e -> IOVector m e -> IO ()
-doApply a x y =
-    checkMatVecMultAdd (numRows a, numCols a) (dim x) (dim y) $
-        unsafeDoApply a x y
-    
--- | @y := a x + beta y@
-doApplyAdd :: (RMatrix a e) =>
-    a (m,n) e -> DVector t n e -> e -> IOVector m e -> IO ()
-doApplyAdd a x beta y =
-    checkMatVecMultAdd (shape a) (dim x) (dim y) $
-        unsafeDoApplyAdd a x beta y
-
--- | @y := alpha a x@
-doSApply :: (RMatrix a e) =>
-    e -> a (m,n) e -> DVector t n e -> IOVector m e -> IO ()
-doSApply alpha a x y =
-    checkMatVecMultAdd (shape a) (dim x) (dim y) $
-        unsafeDoSApply alpha a x y
-
--- | @y := alpha a x + beta y@    
-doSApplyAdd :: (RMatrix a e) =>
-    e -> a (m,n) e -> DVector t n e -> e -> IOVector m e -> IO ()
-doSApplyAdd alpha a x beta y =
-    checkMatVecMultAdd (shape a) (dim x) (dim y) $
-        unsafeDoSApplyAdd alpha a x beta y
-
--- | Apply to a matrix and store the result in another matrix
-doApplyMat :: (RMatrix a e) =>
-    a (m,k) e -> DMatrix t (k,n) e -> IOMatrix (m,n) e -> IO ()
-doApplyMat a b c =
-    checkMatMatMultAdd (shape a) (shape b) (shape c) $
-        unsafeDoApplyMat a b c
-    
--- | @c := a b + beta c@
-doApplyAddMat :: (RMatrix a e) =>
-    a (m,k) e -> DMatrix t (k,n) e -> e -> IOMatrix (m,n) e -> IO ()
-doApplyAddMat a b beta c =
-    checkMatMatMultAdd (shape a) (shape b) (shape c)
-        unsafeDoApplyAddMat a b beta c
-
--- | Scale and apply to a matrix and store the result in another matrix
-doSApplyMat :: (RMatrix a e) => 
-    e -> a (m,k) e -> DMatrix t (k,n) e -> IOMatrix (m,n) e -> IO ()
-doSApplyMat alpha a b c =
-    checkMatMatMultAdd (shape a) (shape b) (shape c) $
-        unsafeDoSApplyMat alpha a b c
-        
--- | @c := alpha a b + beta c@
-doSApplyAddMat :: (RMatrix a e) =>
-    e -> a (m,k) e -> DMatrix t (k,n) e -> e -> IOMatrix (m,n) e -> IO ()
-doSApplyAddMat alpha a b beta c =
-    checkMatMatMultAdd (shape a) (shape b) (shape c)
-        unsafeDoSApplyAddMat alpha a b beta c
-
--- | @x := a x@    
-doApply_ :: (RMatrix a e) =>
-    a (n,n) e -> IOVector n e -> IO ()
-doApply_ a x =
-    checkSquare (shape a) $
-        checkMatVecMult (shape a) (dim x) $
-            unsafeDoApply_ a x
-
--- | @ b := a b@
-doApplyMat_ :: (RMatrix a e) =>
-    a (m,m) e -> IOMatrix (m,n) e -> IO ()
-doApplyMat_ a b =
-    checkSquare (shape a) $
-        checkMatMatMult (shape a) (shape b) $
-            unsafeDoApplyMat_ a b
-
--- | @ x := alpha a x@        
-doSApply_ :: (RMatrix a e) =>
-    e -> a (n,n) e -> IOVector n e -> IO ()
-doSApply_ alpha a x =
-    checkSquare (shape a) $
-        checkMatVecMult (shape a) (dim x) $
-            unsafeDoSApply_ alpha a x
-
--- | @ b := alpha a b@
-doSApplyMat_ :: (RMatrix a e) =>
-    e -> a (m,m) e -> IOMatrix (m,n) e -> IO ()
-doSApplyMat_ alpha a b =
-    checkSquare (shape a) $
-        checkMatMatMult (shape a) (shape b) $
-            unsafeDoSApplyMat_ alpha a b
-
-
-instance (BLAS3 e) => RMatrix (DMatrix t) e where
-    unsafeDoSApplyAdd    = M.gemv
-    unsafeDoSApplyAddMat = M.gemm
diff --git a/BLAS/Matrix/Solve.hs b/BLAS/Matrix/Solve.hs
--- a/BLAS/Matrix/Solve.hs
+++ b/BLAS/Matrix/Solve.hs
@@ -9,8 +9,8 @@
 
 module BLAS.Matrix.Solve (
     module BLAS.Matrix.Solve.Immutable,
-    module BLAS.Matrix.Solve.ReadOnly,
+    module BLAS.Matrix.Solve.Mutable,
     ) where
 
 import BLAS.Matrix.Solve.Immutable
-import BLAS.Matrix.Solve.ReadOnly
+import BLAS.Matrix.Solve.Mutable
diff --git a/BLAS/Matrix/Solve/Immutable.hs b/BLAS/Matrix/Solve/Immutable.hs
--- a/BLAS/Matrix/Solve/Immutable.hs
+++ b/BLAS/Matrix/Solve/Immutable.hs
@@ -17,36 +17,25 @@
     
     ) where
 
+import BLAS.Elem
 import BLAS.Internal ( checkMatVecSolv, checkMatMatSolv )
-import BLAS.Matrix.Solve.ReadOnly
+import BLAS.Matrix.Base
 
 import Data.Vector.Dense ( Vector, dim )
 import Data.Matrix.Dense ( Matrix, shape )
 
-import System.IO.Unsafe ( unsafePerformIO )
-
 infixr 7 <\>, <\\>
 
-class RSolve a e => ISolve a e where
+class (BaseMatrix a, BLAS1 e) => ISolve a e where
     unsafeSolve :: a (m,n) e -> Vector m e -> Vector n e
-    unsafeSolve a y =
-        unsafePerformIO $ unsafeGetSolve a y
-    {-# NOINLINE unsafeSolve #-}
+    unsafeSolve = unsafeSSolve 1
     
     unsafeSolveMat :: a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e
-    unsafeSolveMat a c =
-        unsafePerformIO $ unsafeGetSolveMat a c
-    {-# NOINLINE unsafeSolveMat #-}
+    unsafeSolveMat = unsafeSSolveMat 1
 
     unsafeSSolve :: e -> a (m,n) e -> Vector m e -> Vector n e
-    unsafeSSolve alpha a y =
-        unsafePerformIO $ unsafeGetSSolve alpha a y
-    {-# NOINLINE unsafeSSolve #-}
     
     unsafeSSolveMat :: e -> a (m,n) e -> Matrix (m,k) e -> Matrix (n,k) e
-    unsafeSSolveMat alpha a c =
-        unsafePerformIO $ unsafeGetSSolveMat alpha a c
-    {-# NOINLINE unsafeSSolveMat #-}
 
 
 -- | Solve for a vector
diff --git a/BLAS/Matrix/Solve/Mutable.hs b/BLAS/Matrix/Solve/Mutable.hs
new file mode 100644
--- /dev/null
+++ b/BLAS/Matrix/Solve/Mutable.hs
@@ -0,0 +1,193 @@
+{-# 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
diff --git a/BLAS/Matrix/Solve/ReadOnly.hs b/BLAS/Matrix/Solve/ReadOnly.hs
deleted file mode 100644
--- a/BLAS/Matrix/Solve/ReadOnly.hs
+++ /dev/null
@@ -1,191 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Matrix.Solve.ReadOnly
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Matrix.Solve.ReadOnly (
-    RSolve(..),
-    
-    -- * Matrix and vector solving
-    getSolve,
-    getSolveMat,
-    getSSolve,
-    getSSolveMat,
-    
-    -- * In-place solving
-    doSolve,
-    doSolveMat,
-    doSSolve,
-    doSSolveMat,
-    doSolve_,
-    doSolveMat_,
-    doSSolve_,
-    doSSolveMat_,
-    
-    -- * unsafe operations
-    unsafeGetSolve,
-    unsafeGetSolveMat,
-    unsafeGetSSolve,
-    unsafeGetSSolveMat,
-
-    ) where
-
-import BLAS.Internal ( checkMatVecSolv, checkMatMatSolv, checkMatVecSolvTo,
-    checkMatMatSolvTo, checkSquare )
-
-import Data.Vector.Dense.IO ( DVector, IOVector, dim, newVector_ )
-import qualified Data.Vector.Dense.IO as V
-import Data.Matrix.Dense.IO ( DMatrix, IOMatrix, RMatrix, numCols, shape, newMatrix_ )
-import qualified Data.Matrix.Dense.IO as M
-
-import Unsafe.Coerce
-
-
-class RMatrix a e => RSolve a e where
-    unsafeDoSolve :: a (m,n) e -> DVector t m e -> IOVector n e -> IO ()
-    unsafeDoSolve = unsafeDoSSolve 1
-    
-    unsafeDoSolveMat :: a (m,n) e -> DMatrix t (m,k) e -> IOMatrix (n,k) e -> IO ()
-    unsafeDoSolveMat = unsafeDoSSolveMat 1
-    
-    unsafeDoSSolve :: e -> a (m,n) e -> DVector t m e -> IOVector n e -> IO ()
-    unsafeDoSSolve alpha a y x = do
-        unsafeDoSolve a y x
-        V.scaleBy alpha x
-    
-    unsafeDoSSolveMat :: e -> a (m,n) e -> DMatrix t (m,k) e -> IOMatrix (n,k) e -> IO ()
-    unsafeDoSSolveMat alpha a c b = do
-        unsafeDoSolveMat a c b
-        M.scaleBy alpha b
-
-    unsafeDoSolve_ :: a (n,n) e -> IOVector n e -> IO ()
-    unsafeDoSolve_ = unsafeDoSSolve_ 1
-
-    unsafeDoSSolve_ :: e -> a (n,n) e -> IOVector n e -> IO ()
-    unsafeDoSSolve_ alpha a x = do
-        V.scaleBy alpha x
-        unsafeDoSolve_ a x
-        
-    unsafeDoSolveMat_ :: a (m,m) e -> IOMatrix (m,n) e -> IO ()
-    unsafeDoSolveMat_ = unsafeDoSSolveMat_ 1
-        
-    unsafeDoSSolveMat_ :: e -> a (m,m) e -> IOMatrix (m,n) e -> IO ()
-    unsafeDoSSolveMat_ alpha a b = do
-        M.scaleBy alpha b
-        unsafeDoSolveMat_ a b
-
-
-unsafeGetSolve :: (RSolve a e) => 
-    a (m,n) e -> DVector t m e -> IO (DVector r n e)
-unsafeGetSolve a y = do
-    x <- newVector_ (numCols a)
-    unsafeDoSolve a y x
-    return (unsafeCoerce x)
-    
-unsafeGetSSolve :: (RSolve a e) => 
-    e -> a (m,n) e -> DVector t m e -> IO (DVector r n e)
-unsafeGetSSolve alpha a y = do
-    x <- newVector_ (numCols a)
-    unsafeDoSSolve alpha a y x
-    return (unsafeCoerce x)
-    
-unsafeGetSolveMat :: (RSolve a e) => 
-    a (m,n) e -> DMatrix t (m,k) e -> IO (DMatrix r (n,k) e)
-unsafeGetSolveMat a c = do
-    b <- newMatrix_ (numCols a, numCols c)
-    unsafeDoSolveMat a c b
-    return (unsafeCoerce b)
-
-unsafeGetSSolveMat :: (RSolve a e) => 
-    e -> a (m,n) e -> DMatrix t (m,k) e -> IO (DMatrix r (n,k) e)
-unsafeGetSSolveMat alpha a c = do
-    b <- newMatrix_ (numCols a, numCols c)
-    unsafeDoSSolveMat alpha a c b
-    return (unsafeCoerce b)
-
--- | Solve for a vector
-getSolve :: (RSolve a e) => 
-    a (m,n) e -> DVector t m e -> IO (DVector r n e)
-getSolve a y = 
-    checkMatVecSolv (shape a) (dim y) $
-        unsafeGetSolve a y
-
--- | Solve for a vector and scale
-getSSolve :: (RSolve a e) => 
-    e -> a (m,n) e -> DVector t m e -> IO (DVector r n e)
-getSSolve alpha a y = 
-    checkMatVecSolv (shape a) (dim y) $
-        unsafeGetSSolve alpha a y
-
--- | Solve for a matrix
-getSolveMat :: (RSolve a e) => 
-    a (m,n) e -> DMatrix t (m,k) e -> IO (DMatrix r (n,k) e)
-getSolveMat a b =
-    checkMatMatSolv (shape a) (shape b) $
-            unsafeGetSolveMat a b
-            
--- | Solve for a matrix and scale
-getSSolveMat :: (RSolve a e) => 
-    e -> a (m,n) e -> DMatrix t (m,k) e -> IO (DMatrix r (n,k) e)
-getSSolveMat alpha a b =
-    checkMatMatSolv (shape a) (shape b) $
-            unsafeGetSSolveMat alpha a b
-
-
-doSolve :: (RSolve a e) => 
-    a (m,n) e -> DVector t m e -> IOVector n e -> IO ()
-doSolve a y x =
-    checkMatVecSolvTo (shape a) (dim y) (dim x) $
-        unsafeDoSolve a y x
-        
-doSolveMat :: (RSolve a e) => 
-    a (m,n) e -> DMatrix t (m,k) e -> IOMatrix (n,k) e -> IO ()
-doSolveMat a c b =
-    checkMatMatSolvTo (shape a) (shape c) (shape b) $
-        unsafeDoSolveMat a c b
-    
-doSSolve :: (RSolve a e) => 
-    e -> a (m,n) e -> DVector t m e -> IOVector n e -> IO ()
-doSSolve alpha a y x =
-    checkMatVecSolvTo (shape a) (dim y) (dim x) $
-        unsafeDoSSolve alpha a y x
-
-doSSolveMat :: (RSolve a e) => 
-    e -> a (m,n) e -> DMatrix t (m,k) e -> IOMatrix (n,k) e -> IO ()
-doSSolveMat alpha a c b =
-    checkMatMatSolvTo (shape a) (shape c) (shape b) $
-        unsafeDoSSolveMat alpha a c b
-
-doSolve_ :: (RSolve a e) => 
-    a (n,n) e -> IOVector n e -> IO ()
-doSolve_ a x =
-    checkSquare (shape a) $
-        checkMatVecSolv (shape a) (dim x) $
-            unsafeDoSolve_ a x
-
-doSSolve_ :: (RSolve a e) => 
-    e -> a (n,n) e -> IOVector n e -> IO ()
-doSSolve_ alpha a x =
-    checkSquare (shape a) $
-        checkMatVecSolv (shape a) (dim x) $
-            unsafeDoSSolve_ alpha a x
-
-doSolveMat_ :: (RSolve a e) => 
-    a (m,m) e -> IOMatrix (m,n) e -> IO ()
-doSolveMat_ a b =
-    checkSquare (shape a) $
-        checkMatMatSolv (shape a) (shape b) $
-            unsafeDoSolveMat_ a b
-
-doSSolveMat_ :: (RSolve a e) => 
-    e -> a (m,m) e -> IOMatrix (m,n) e -> IO ()
-doSSolveMat_ alpha a b =
-    checkSquare (shape a) $
-        checkMatMatSolv (shape a) (shape b) $
-            unsafeDoSSolveMat_ alpha a b
-
diff --git a/BLAS/Tensor.hs b/BLAS/Tensor.hs
--- a/BLAS/Tensor.hs
+++ b/BLAS/Tensor.hs
@@ -9,16 +9,12 @@
 
 module BLAS.Tensor (
     module BLAS.Tensor.Base,
-    module BLAS.Tensor.Dense,
-    module BLAS.Tensor.Scalable,
     module BLAS.Tensor.Immutable,
-    module BLAS.Tensor.ReadOnly,
-    module BLAS.Tensor.Mutable
+    module BLAS.Tensor.Read,
+    module BLAS.Tensor.Write,
     ) where
 
 import BLAS.Tensor.Base
-import BLAS.Tensor.Dense
-import BLAS.Tensor.Scalable
-import BLAS.Tensor.Immutable
-import BLAS.Tensor.ReadOnly
-import BLAS.Tensor.Mutable
+import BLAS.Tensor.Immutable 
+import BLAS.Tensor.Read
+import BLAS.Tensor.Write
diff --git a/BLAS/Tensor/Base.hs b/BLAS/Tensor/Base.hs
--- a/BLAS/Tensor/Base.hs
+++ b/BLAS/Tensor/Base.hs
@@ -9,17 +9,17 @@
 --
 
 module BLAS.Tensor.Base (
-    Tensor(..),
+    BaseTensor(..),
     ) where
 
 import Data.Ix
 
 -- | The base class for tensors (i.e. Vector, Matrix, etc.).
-class (Ix i) => Tensor x i e | x -> i where
+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 e -> i
+    shape :: x n e -> i
     
     -- | Get the range of valid indices in the tensor.
-    bounds :: x e -> (i,i)
+    bounds :: x n e -> (i,i)
diff --git a/BLAS/Tensor/Dense.hs b/BLAS/Tensor/Dense.hs
deleted file mode 100644
--- a/BLAS/Tensor/Dense.hs
+++ /dev/null
@@ -1,16 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Tensor.Dense
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Tensor.Dense (
-    module BLAS.Tensor.Dense.Immutable,
-    module BLAS.Tensor.Dense.ReadOnly,
-    ) where
-
-import BLAS.Tensor.Dense.Immutable
-import BLAS.Tensor.Dense.ReadOnly
diff --git a/BLAS/Tensor/Dense/Immutable.hs b/BLAS/Tensor/Dense/Immutable.hs
deleted file mode 100644
--- a/BLAS/Tensor/Dense/Immutable.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Tensor.Dense.Immutable
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Tensor.Dense.Immutable (
-    IDTensor(..),
-    ) where
-
-import BLAS.Tensor.Immutable
-
--- | Class for immutable dense tensors.
-class (ITensor x i e) => (IDTensor x i e) where
-    -- | Get a zero tensor of the given shape.
-    zero :: i -> x e
-    
-    -- | Get a new constant tensor of the given shape.
-    constant :: i -> e -> x e
-
-    -- | Apply a function to pairs of elements of tensors that are the 
-    -- same shape.
-    azipWith :: (ITensor x i f, ITensor x i g) => (e -> f -> g) -> x e -> x f -> x g
-    
diff --git a/BLAS/Tensor/Dense/ReadOnly.hs b/BLAS/Tensor/Dense/ReadOnly.hs
deleted file mode 100644
--- a/BLAS/Tensor/Dense/ReadOnly.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Tensor.Dense.ReadOnly
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Tensor.Dense.ReadOnly (
-    RDTensor(..),
-    ) where
-
-import BLAS.Tensor.ReadOnly
-
--- | Class for mutable dense read-only tensors.
-class (RTensor x i e m) => RDTensor x i e m where
-    -- | Creates a new tensor with elements all initialized to zero.
-    newZero :: i -> m (x e)
-    
-    -- | Creates a new tensor with elements all initialized to the 
-    -- given value.
-    newConstant :: i -> e -> m (x e)
-    
diff --git a/BLAS/Tensor/Immutable.hs b/BLAS/Tensor/Immutable.hs
--- a/BLAS/Tensor/Immutable.hs
+++ b/BLAS/Tensor/Immutable.hs
@@ -17,43 +17,54 @@
 import BLAS.Elem
 import Data.Ix
 
+
 infixl 9 !
+infixl 7 *>
+infixl 5 `shift`
 
+
 -- | A class for immutable tensors.
-class (BLAS1 e, Tensor x i e) => ITensor x i e where
+class (BaseTensor x i) => ITensor x i where
     -- | Get the numer of elements stored in the tensor.
-    size :: x e -> Int
+    size :: x n e -> Int
     
     -- | Get a new tensor by replacing the elements at the given indices.
-    (//) :: x e -> [(i,e)] -> x e
+    (//) :: (BLAS1 e) => x n e -> [(i,e)] -> x n e
 
     -- | Get the value at the given index, without doing any bounds-checking.
-    unsafeAt :: x e -> i -> e
+    unsafeAt :: (Elem e) => x n e -> i -> e
     
     -- | Same as '(//)' but doesn't do any bounds-checking.
-    unsafeReplace :: x e -> [(i,e)] -> x e
+    unsafeReplace :: (BLAS1 e) => x n e -> [(i,e)] -> x n e
     
     -- | Get the indices of the elements stored in the tensor.
-    indices :: x e -> [i]
-    indices = fst . unzip . assocs
+    indices :: x n e -> [i]
     
     -- | Get the elements stored in the tensor.
-    elems :: x e -> [e]
+    elems :: (Elem e) => x n e -> [e]
     elems = snd . unzip . assocs
 
     -- | Get the list of @(@index@,@ element@)@ pairs stored in the tensor.
-    assocs :: x e -> [(i,e)]
+    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.
-    amap :: (ITensor x i e') => (e -> e') -> x e -> x e'
+    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 e, Show i) => x e -> i -> e
+(!) :: (ITensor x i, Elem e) => x n e -> i -> e
 (!) x i =
     case (inRange b i) of
         False -> 
diff --git a/BLAS/Tensor/Mutable.hs b/BLAS/Tensor/Mutable.hs
deleted file mode 100644
--- a/BLAS/Tensor/Mutable.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Tensor.Mutable
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Tensor.Mutable (
-    MTensor(..),
-    writeElem,
-    modifyElem,
-    ) where
-
-import BLAS.Tensor.Base
-import BLAS.Tensor.ReadOnly
-
--- | Class for modifiable mutable tensors.
-class (RTensor x i e m) => (MTensor x i e m) where
-    -- | Get the maximum number of elements that can be stored in the tensor.
-    getMaxSize :: x e -> m Int
-    getMaxSize = getSize
-    
-    -- | Sets all stored elements to zero.
-    setZero :: x e -> m ()
-    
-    -- | Sets all stored elements to the given value.
-    setConstant :: e -> x e -> m ()
-
-    -- | True if the value at a given index can be changed
-    canModifyElem :: x e -> i -> m Bool
-    
-    -- | Set the value of the element at the given index, without doing any
-    -- range checking.
-    unsafeWriteElem :: x e -> i -> e -> m ()
-    
-    -- | Modify the value of the element at the given index, without doing
-    -- any range checking.
-    unsafeModifyElem :: x 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 :: (e -> e) -> x e -> m ()
-    
--- | Set the value of the element at the given index.
-writeElem :: (MTensor x i e m, Show i) => x e -> i -> e -> m ()
-writeElem x i e = do
-    ok <- canModifyElem x i
-    case ok 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 :: (MTensor x i e m, Show i) => x 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
-    
diff --git a/BLAS/Tensor/Read.hs b/BLAS/Tensor/Read.hs
new file mode 100644
--- /dev/null
+++ b/BLAS/Tensor/Read.hs
@@ -0,0 +1,79 @@
+{-# 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
diff --git a/BLAS/Tensor/ReadOnly.hs b/BLAS/Tensor/ReadOnly.hs
deleted file mode 100644
--- a/BLAS/Tensor/ReadOnly.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Tensor.ReadOnly
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Tensor.ReadOnly (
-    RTensor(..),
-    readElem,
-    ) where
-
-import Data.Ix
-import BLAS.Tensor.Base
-
--- | Class for mutable read-only tensors.
-class (Tensor x i e, Monad m) => RTensor x i e m where
-    -- | Get the number of elements stored in the tensor.
-    getSize :: x e -> m Int
-    
-    -- | Get a copy of the tensor.
-    newCopy :: x e -> m (x e)
-    
-    -- | Get the value at the specified index, without doing any 
-    -- range-checking.
-    unsafeReadElem :: x 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.
-    getIndices :: x e -> m [i]
-    getIndices x = getAssocs x >>= return . fst . unzip
-
-    -- | Returns a lazy list of the elements in the tensor.  
-    -- Because of the laziness, this function should be used with care.
-    getElems :: x 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.
-    getAssocs :: x 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 :: (RTensor x i e m, Show i) => x 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
diff --git a/BLAS/Tensor/Scalable.hs b/BLAS/Tensor/Scalable.hs
deleted file mode 100644
--- a/BLAS/Tensor/Scalable.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Tensor.Scalable
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Tensor.Scalable (
-    Scalable(..)
-    ) where
-
-infixl 7 *>
-
--- | A class for scalable tensors.
-class (Num e) => Scalable x e where
-    -- | Scale a tensor by the given value.
-    (*>) :: e -> x e -> x e
diff --git a/BLAS/Tensor/Write.hs b/BLAS/Tensor/Write.hs
new file mode 100644
--- /dev/null
+++ b/BLAS/Tensor/Write.hs
@@ -0,0 +1,112 @@
+{-# 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
diff --git a/BLAS/UnsafeIOToM.hs b/BLAS/UnsafeIOToM.hs
new file mode 100644
--- /dev/null
+++ b/BLAS/UnsafeIOToM.hs
@@ -0,0 +1,34 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 #-}
diff --git a/BLAS/Vector.hs b/BLAS/Vector.hs
deleted file mode 100644
--- a/BLAS/Vector.hs
+++ /dev/null
@@ -1,25 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : BLAS.Vector
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module BLAS.Vector (
-    Vector(..)
-    ) where
-
-import BLAS.Elem.Base ( Elem )
-
--- | A class for vectors.
-class Vector x where
-    -- | Get the dimension of the vector.
-    dim :: x n e -> Int
-    
-    -- | Returns a view into an existing vector that takes the complex 
-    -- conjugate of every element.  For real vectors, this should compile
-    -- to a no-op.
-    conj :: (Elem e) => x n e -> x n e
-     
diff --git a/Data/Matrix/Banded.hs b/Data/Matrix/Banded.hs
--- a/Data/Matrix/Banded.hs
+++ b/Data/Matrix/Banded.hs
@@ -9,61 +9,41 @@
 --
 
 module Data.Matrix.Banded (
-    -- * Banded matrix type
-    Banded,
-    
-    module BLAS.Matrix.Base,
-    module BLAS.Tensor.Base,
-    module BLAS.Tensor.Dense.Immutable,
-    module BLAS.Tensor.Immutable,
-    module BLAS.Tensor.Scalable,
-    module Data.Matrix.Banded.Operations,
-
-    -- * Creating banded matrices
-    banded, 
-    listsBanded,
-    
-    -- * Properties
-    numLower,
-    numUpper,
-    bandwidth,
+    module Data.Matrix.Banded.Internal,
     
-    -- * Rows and columns
-    row,
-    col,
-    rows,
-    cols,
+    -- * Converting between mutable and immutable banded matrices
+    UnsafeFreezeBanded(..),
+    UnsafeThawBanded(..),
+    freezeBanded,
+    thawBanded,
+    ) where
 
-    -- * Diagonals
-    diag,
-    toLists,
+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
 
-    -- * Casting matrices
-    coerceBanded,
-    
-    -- * Converting between vectors and matrices
+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    
     
-    -- * Unsafe operations
-    unsafeBanded,
-    unsafeRow,
-    unsafeCol,
-    unsafeDiag,
+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
     
-    ) where
-
-import BLAS.Access
-import BLAS.Elem ( BLAS1 )
-import BLAS.Matrix.Base hiding ( Matrix )
-import BLAS.Tensor.Base
-import BLAS.Tensor.Dense.Immutable
-import BLAS.Tensor.Immutable
-import BLAS.Tensor.Scalable
-
-import Data.Matrix.Banded.Internal
-import qualified Data.Matrix.Banded.Internal as B
-import Data.Matrix.Banded.Operations hiding ( RMatrix(..), getScaled, 
-    getInvScaled, doConj, scaleBy, invScaleBy )
-import Data.Vector.Dense hiding ( scale, invScale )
+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')
 
-instance (BLAS1 e) => Scalable (BMatrix Imm (m,n)) e where
-    (*>) = scale
+thawBanded :: (WriteBanded a y m, BLAS1 e) =>
+    Banded mn e -> m (a mn e)
+thawBanded = newCopyBanded
diff --git a/Data/Matrix/Banded/Class.hs b/Data/Matrix/Banded/Class.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Banded/Class.hs
@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Matrix/Banded/Class/Copying.hs b/Data/Matrix/Banded/Class/Copying.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Banded/Class/Copying.hs
@@ -0,0 +1,86 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+    
diff --git a/Data/Matrix/Banded/Class/Creating.hs b/Data/Matrix/Banded/Class/Creating.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Banded/Class/Creating.hs
@@ -0,0 +1,60 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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'
+
diff --git a/Data/Matrix/Banded/Class/Elements.hs b/Data/Matrix/Banded/Class/Elements.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Banded/Class/Elements.hs
@@ -0,0 +1,17 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Matrix/Banded/Class/Internal.hs b/Data/Matrix/Banded/Class/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Banded/Class/Internal.hs
@@ -0,0 +1,558 @@
+{-# 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
diff --git a/Data/Matrix/Banded/Class/Special.hs b/Data/Matrix/Banded/Class/Special.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Banded/Class/Special.hs
@@ -0,0 +1,19 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+
diff --git a/Data/Matrix/Banded/Class/Views.hs b/Data/Matrix/Banded/Class/Views.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Banded/Class/Views.hs
@@ -0,0 +1,53 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Matrix/Banded/IO.hs b/Data/Matrix/Banded/IO.hs
--- a/Data/Matrix/Banded/IO.hs
+++ b/Data/Matrix/Banded/IO.hs
@@ -1,72 +1,18 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Data.Matrix.Banded.IO
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- 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 mutable banded matrix data type
-    BMatrix(..),
+    -- * The IOBanded data type
     IOBanded,
     
-    module BLAS.Matrix.Base,
-    module BLAS.Tensor.Base,
-    module BLAS.Tensor.Dense.ReadOnly,
-    module BLAS.Tensor.ReadOnly,
-    module BLAS.Tensor.Mutable,
-    
-    -- * Creating new matrices
-    newBanded,
-    newBanded_,
-    newListsBanded,
-
-    -- * Views
-    -- ** Rows and columns
-    rowView,
-    colView,
-    getRow,
-    getCol,
-    
-    -- ** Diagonals
-    diag,
-    
-    -- * Operations
-    module Data.Matrix.Banded.Operations,
-    
-    -- * Converting to and from banded matrices
-    -- ** @ForeignPtr@s
-    toForeignPtr,
-    fromForeignPtr,
-
-    -- * Bandwith properties
-    bandwidth,
-    numLower,
-    numUpper,
-    
-    -- * Coercing
-    coerceBanded,
-    
-    -- * Unsafe operations
-    unsafeNewBanded,
-    unsafeWithElemPtr,
-    unsafeRowView,
-    unsafeColView,
-    unsafeGetRow,
-    unsafeGetCol,
-    unsafeDiag,
-    unsafeFreeze,
-    unsafeThaw,
-    
+    module Data.Matrix.Banded.Class,
     ) where
 
-import Data.Matrix.Banded.Internal
-import Data.Matrix.Banded.Operations hiding ( IMatrix(..), scale, invScale )
-    
-import BLAS.Matrix.Base hiding ( Matrix )
-import BLAS.Tensor.Base
-import BLAS.Tensor.Dense.ReadOnly
-import BLAS.Tensor.ReadOnly
-import BLAS.Tensor.Mutable
+import Data.Matrix.Banded.Class.Internal( IOBanded )
+import Data.Matrix.Banded.Class
diff --git a/Data/Matrix/Banded/Internal.hs b/Data/Matrix/Banded/Internal.hs
--- a/Data/Matrix/Banded/Internal.hs
+++ b/Data/Matrix/Banded/Internal.hs
@@ -10,468 +10,257 @@
 --
 
 module Data.Matrix.Banded.Internal (
-    -- * Banded matrix data types
-    BMatrix(..),
-    Banded,
-    IOBanded,
+    -- * Banded matrix type
+    Banded(..),
 
+    -- * Banded shape
+    module BLAS.Tensor.Base,
     module BLAS.Matrix.Base,
-    module BLAS.Tensor,
-
-    -- * Converting to and from foreign pointers
-    toForeignPtr,
-    fromForeignPtr,
-    
-    -- * To and from the underlying storage matrix
-    toRawMatrix,
-    fromRawMatrix,
-    
-    -- * Bandwith properties
     bandwidth,
     numLower,
     numUpper,
-    
-    -- * Creating new matrices
-    -- ** Pure
+    coerceBanded,
+
+    -- * Creating banded matrices
     banded,
     listsBanded,
-    -- ** Impure
-    newBanded_,
-    newBanded,
-    newListsBanded,
-    
-    -- * Getting rows and columns
-    row,
-    col,
-    rows,
-    cols,
-    getRow,
-    getCol,
-    toLists,
+    unsafeBanded,
+
+    -- * Reading banded matrix elements
+    module BLAS.Tensor.Immutable,
     
+    -- * Special banded matrices
+    zeroBanded,
+    constantBanded,
+
     -- * Vector views
-    diag,
-    rowView,
-    colView,
-    
-    -- * Casting matrices
-    coerceBanded,
+    diagBanded,
+    unsafeDiagBanded,
+
+    -- * Converting to lists
+    listsFromBanded,
+
+    -- * Low-level properties
+    ldaOfBanded,
+    isHermBanded,
     
-    -- * Unsafe operations
-    unsafeBanded,
-    unsafeNewBanded,
-    unsafeFreeze,
-    unsafeThaw,
-    unsafeWithElemPtr,
-    unsafeWithBasePtr,
-    unsafeDiag,
-    unsafeGetRow,
-    unsafeGetCol,
-    unsafeRow,
-    unsafeCol,
-    unsafeRowView,
-    unsafeColView,
+    -- * Matrix and vector multiplication
+    module BLAS.Matrix.Immutable,
+
     ) where
 
-import Control.Arrow ( second )
-import Control.Monad ( zipWithM_ )
-import Data.Ix ( inRange, range )
-import Data.List ( foldl' )
-import Data.Maybe ( fromJust )
-import Foreign
+import Data.AEq
 import System.IO.Unsafe
-import Unsafe.Coerce          
 
-import BLAS.Access
-import BLAS.Elem ( Elem, BLAS1 )
-import qualified BLAS.Elem as E
-import BLAS.Internal ( checkedRow, checkedCol, checkedDiag, diagStart, 
-    diagLen, clearArray, inlinePerformIO )
-                  
-import BLAS.Matrix.Base hiding ( Matrix )
-import qualified BLAS.Matrix.Base as C
-import BLAS.Tensor
 
-import Data.AEq
+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 Data.Matrix.Dense.Internal ( DMatrix )
-import qualified Data.Matrix.Dense.Internal as M
-                                
-import Data.Vector.Dense.Internal ( DVector, Vector, conj, dim, newListVector )
-import qualified Data.Vector.Dense.Internal as V
+import BLAS.Matrix.Base hiding ( BaseMatrix )
+import BLAS.Matrix.Immutable
+import BLAS.Matrix.Mutable
+import qualified BLAS.Matrix.Base as BLAS
 
-        
-data BMatrix t mn e 
-    = BM { fptrOf   :: {-# UNPACK #-} !(ForeignPtr e)
-         , offsetOf :: {-# UNPACK #-} !Int
-         , size1    :: {-# UNPACK #-} !Int
-         , size2    :: {-# UNPACK #-} !Int
-         , lowBW    :: {-# UNPACK #-} !Int
-         , upBW     :: {-# UNPACK #-} !Int
-         , ldaOf    :: {-# UNPACK #-} !Int
-         , isHerm   :: {-# UNPACK #-} !Bool
-         }
+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 )
 
-type Banded = BMatrix Imm
-type IOBanded = BMatrix Mut
+import Data.Vector.Dense( Vector, zeroVector )
+import Data.Vector.Dense.ST( runSTVector )
+import Data.Matrix.Dense.ST( runSTMatrix )
 
-fromForeignPtr :: ForeignPtr e -> Int -> (Int,Int) -> (Int,Int) -> Int -> Bool
-    -> BMatrix t (m,n) e
-fromForeignPtr f o (m,n) (kl,ku) l h = BM f o m n kl ku l h
+newtype Banded mn e = B (IOBanded mn e)
 
-toForeignPtr :: BMatrix t (m,n) e -> (ForeignPtr e, Int, (Int,Int), (Int,Int), Int, Bool)
-toForeignPtr (BM f o m n kl ku l h) = (f, o, (m,n), (kl,ku), l, h)
+unsafeFreezeIOBanded :: IOBanded mn e -> Banded mn e
+unsafeFreezeIOBanded = B
 
-unsafeFreeze :: BMatrix t mn e -> Banded mn e
-unsafeFreeze = unsafeCoerce
+unsafeThawIOBanded :: Banded mn e -> IOBanded mn e
+unsafeThawIOBanded (B a) = a
 
-unsafeThaw :: BMatrix t mn e -> IOBanded mn e
-unsafeThaw = unsafeCoerce
 
--- | Coerce the phantom shape type from one type to another.
-coerceBanded :: BMatrix t mn e -> BMatrix t kl e
-coerceBanded = unsafeCoerce
+liftBanded :: (IOBanded mn e -> a) -> Banded mn e -> a
+liftBanded f (B x) = f x
+{-# INLINE liftBanded #-}
 
-toLists :: (BLAS1 e) => Banded (m,n) e -> ((Int,Int), (Int,Int),[[e]])
-toLists 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 $ diag a i) ++ (padEnd i)
 
-toRawMatrix :: (Elem e) => BMatrix t (m,n) e -> ((Int,Int), (Int,Int), DMatrix t (m',n') e, Bool)
-toRawMatrix (BM f o m n kl ku ld h) = 
-    ((m,n), (kl,ku), M.fromForeignPtr f o (kl+1+ku,n) ld False, h)
+-- 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 #-}
 
-fromRawMatrix :: (Elem e) => (Int,Int) -> (Int,Int) -> DMatrix t (m,n) e -> Bool -> Maybe (BMatrix t (m',n') e)
-fromRawMatrix (m,n) (kl,ku) a h = 
-    if M.isHerm a 
-        then Nothing
-        else let (f,o,(m',n'),ld,_) = M.toForeignPtr a
-             in case undefined of
-                 _ | m' /= kl+1+ku -> 
-                     error $ "fromMatrix: number of rows must be equal to number of diagonals"
-                 _ | n' /= n ->
-                     error $ "fromMatrix: numbers of columns must be equal"
-                 _ ->
-                     Just $ BM f o m n kl ku ld h
-                
 
-bandwidth :: BMatrix t (m,n) e -> (Int,Int)
-bandwidth a = 
-    let (kl,ku) = (numLower a, numUpper a)
-    in (negate kl, ku)
-
-numLower :: BMatrix t (m,n) e -> Int
-numLower a | isHerm a  = upBW a
-           | otherwise = lowBW a
-
-numUpper :: BMatrix t (m,n) e -> Int
-numUpper a | isHerm a  = lowBW a
-           | otherwise = upBW a
+inlineLiftBanded :: (IOBanded n e -> IO a) -> Banded n e -> a
+inlineLiftBanded f = inlinePerformIO . liftBanded f
+{-# INLINE inlineLiftBanded #-}
 
 
-newBanded_ :: (Elem e) => (Int,Int) -> (Int,Int) -> IO (BMatrix t (m,n) 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 off = 0
-            m'  = kl + 1 + ku
-            l   = m'
-            h   = False
-        in do    
-            ptr <- mallocForeignPtrArray (m' * n)
-            return $ fromForeignPtr ptr off (m,n) (kl,ku) l h
-    where
-      err s = ioError $ userError $ 
-                  "newBanded_ " ++ show (m,n) ++ " " ++ show (kl,ku) ++ ": " ++ s
-
 banded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> Banded (m,n) e
-banded mn kl ijes = unsafePerformIO $ newBanded mn kl ijes
+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 = unsafePerformIO $ unsafeNewBanded mn kl ijes
+unsafeBanded mn kl ijes = 
+    unsafeFreezeIOBanded $ unsafePerformIO $ unsafeNewBanded mn kl ijes
 {-# NOINLINE unsafeBanded #-}
 
-newBanded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> IO (BMatrix t (m,n) e)
-newBanded = newBandedHelp writeElem
-
-unsafeNewBanded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> [((Int,Int), e)] -> IO (BMatrix t (m,n) e)
-unsafeNewBanded = newBandedHelp unsafeWriteElem
-
-newBandedHelp :: (BLAS1 e) => 
-       (IOBanded (m,n) e -> (Int,Int) -> e -> IO ()) 
-    -> (Int,Int) -> (Int,Int) -> [((Int,Int),e)] -> IO (BMatrix t (m,n) e)
-newBandedHelp set (m,n) (kl,ku) ijes = do
-    x <- newBanded_ (m,n) (kl,ku)
-    withForeignPtr (fptrOf x) $ flip clearArray ((kl+1+ku)*n)
-    mapM_ (uncurry $ set $ unsafeThaw x) ijes
-    return x
-
 listsBanded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> [[e]] -> Banded (m,n) e
-listsBanded mn kl xs = unsafePerformIO $ newListsBanded mn kl xs
+listsBanded mn kl xs = 
+    unsafeFreezeIOBanded $ unsafePerformIO $ newListsBanded mn kl xs
 {-# NOINLINE listsBanded #-}
 
-newListsBanded :: (BLAS1 e) => (Int,Int) -> (Int,Int) -> [[e]] -> IO (BMatrix t (m,n) e)
-newListsBanded (m,n) (kl,ku) xs = do
-    a <- newBanded_ (m,n) (kl,ku)
-    zipWithM_ (writeDiagElems (unsafeThaw a)) [(negate kl)..ku] xs
-    return a
-  where
-    writeDiagElems a i es =
-        let d   = diag a i
-            nb  = max 0 (negate i)
-            es' = drop nb es
-        in zipWithM_ (unsafeWriteElem d) [0..(dim d - 1)] es'
-
-unsafeDiag :: (Elem e) => BMatrix t (m,n) e -> Int -> DVector t k e
-unsafeDiag a d
-    | isHerm a = conj $ unsafeDiag (herm a) (negate d)
-    | otherwise =
-        let f      = fptrOf a
-            off    = indexOf a (diagStart d)
-            len    = diagLen (shape a) d
-            stride = ldaOf a
-            c      = False
-        in V.fromForeignPtr f off len stride c
-        
-diag :: (Elem e) => BMatrix t (m,n) e -> Int -> DVector t k e
-diag a = checkedDiag (shape a) (unsafeDiag a) 
-
-
-indexOf :: BMatrix t (m,n) e -> (Int,Int) -> Int
-indexOf (BM _ off _ _ _ ku ld h) (i,j) =
-    let (i',j') = if h then (j,i) else (i,j)
-    in off + ku + (i' - j') + j' * ld
-    --off + i' * tda + (j' - i' + kl)
-           
-
-hasStorage :: BMatrix t (m,n) e -> (Int,Int) -> Bool
-hasStorage (BM _ _ m n kl ku _ h) (i,j) =
-    let (i',j') = if h then (j,i) else (i,j)
-    in (  inRange (0,m-1) i'
-       && inRange (0,n-1) j'
-       && inRange (max 0 (j'-ku), min (m-1) (j'+kl)) i'
-       )
-              
-            
-unsafeWithElemPtr :: (Elem e) => BMatrix t (m,n) e -> (Int,Int) -> (Ptr e -> IO a) -> IO a
-unsafeWithElemPtr a (i,j) f
-    | isHerm a  = unsafeWithElemPtr (herm a) (j,i) f
-    | otherwise = withForeignPtr (fptrOf a) $ \ptr ->
-                      f $ ptr `advancePtr` (indexOf a (i,j))
-
-unsafeWithBasePtr :: (Elem e) => BMatrix t (m,n) e -> (Ptr e -> IO a) -> IO a
-unsafeWithBasePtr a f =
-    withForeignPtr (fptrOf a) $ \ptr ->
-        f $ ptr `advancePtr` (offsetOf a)
-
-row :: (BLAS1 e) => Banded (m,n) e -> Int -> Vector n e
-row a = checkedRow (shape a) (unsafeRow a)
-
-unsafeRow :: (BLAS1 e) => Banded (m,n) e -> Int -> Vector n e
-unsafeRow a i = unsafePerformIO $ getRow a i
-{-# NOINLINE unsafeRow #-}
-
-getRow :: (BLAS1 e) => BMatrix t (m,n) e -> Int -> IO (DVector r n e)
-getRow a = checkedRow (shape a) (unsafeGetRow a)
-
-unsafeGetRow :: (BLAS1 e) => BMatrix t (m,n) e -> Int -> IO (DVector r n e)
-unsafeGetRow a i = 
-    let (nb,x,na) = unsafeRowView a i
-        n = numCols a
-    in do
-        es <- getElems x
-        newListVector n $ (replicate nb 0) ++ es ++ (replicate na 0)
-
-col :: (BLAS1 e) => Banded (m,n) e -> Int -> Vector m e
-col a = checkedCol (shape a) (unsafeCol a)
-
-unsafeCol :: (BLAS1 e) => Banded (m,n) e -> Int -> Vector m e
-unsafeCol a i = unsafePerformIO $ getCol a i
-{-# NOINLINE unsafeCol #-}
-
-getCol :: (BLAS1 e) => BMatrix t (m,n) e -> Int -> IO (DVector r m e)
-getCol a = checkedCol (shape a) (unsafeGetCol a)
-
-unsafeGetCol :: (BLAS1 e) => BMatrix t (m,n) e -> Int -> IO (DVector r m e)
-unsafeGetCol a j = unsafeGetRow (herm a) j >>= return . conj
-
-rows :: (BLAS1 e) => Banded (m,n) e -> [Vector n e]
-rows a = [ unsafeRow a i | i <- [0..(numRows a - 1)] ]
-
-cols :: (BLAS1 e) => Banded (m,n) e -> [Vector m e]
-cols a = [ unsafeCol a i | i <- [0..(numCols a - 1)] ]
-
-unsafeColView :: (Elem e) => BMatrix t (m,n) e -> Int -> (Int, DVector t k e, Int)
-unsafeColView a@(BM f off m _ kl ku ld _) j
-    | isHerm a = 
-        case unsafeRowView (herm a) j of (nb, v, na) -> (nb, conj v, na)
-    | otherwise =
-        let nb     = max (j - ku)         0
-            na     = max (m - 1 - j - kl) 0
-            r      = max (ku - j) 0 
-            c      = j 
-            off'   = off + r + c * ld
-            stride = 1
-            len    = m - (nb + na)
-        in if len >= 0
-            then (nb, V.fromForeignPtr f off' len stride False, na)
-            else (m , V.fromForeignPtr f off' 0   stride False,  0)
-
-
-unsafeRowView :: (Elem e) => BMatrix t (m,n) e -> Int -> (Int, DVector t k e, Int)
-unsafeRowView a@(BM f off _ n kl ku ld _) i
-    | isHerm a =
-        case unsafeColView (herm a) i of (nb, v, na) -> (nb, conj v, na)        
-    | otherwise =
-        let nb     = max (i - kl)         0
-            na     = max (n - 1 - i - ku) 0
-            r      = min (ku + i)         (kl + ku)
-            c      = max (i - kl)         0 
-            off'   = off + r + c * ld
-            stride = ld - 1
-            len    = n - (nb + na)
-        in if len >= 0 
-            then (nb, V.fromForeignPtr f off' len stride False, na)
-            else (n , V.fromForeignPtr f off' 0   stride False,  0)
+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 #-}
 
-rowView :: (Elem e) => BMatrix t (m,n) e -> Int -> (Int, DVector t k e, Int)
-rowView a = checkedRow (shape a) (unsafeRowView a) 
+-- | 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)
 
-colView :: (Elem e) => BMatrix t (m,n) e -> Int -> (Int, DVector t k e, Int)
-colView a = checkedCol (shape a) (unsafeColView 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 C.Matrix (BMatrix t) where
-    numRows a | isHerm a  = size2 a
-              | otherwise = size1 a
-              
-    numCols a | isHerm a  = size1 a
-              | otherwise = size2 a
-
-    herm a = let h' = (not . isHerm) a
-             in coerceBanded $ a{ isHerm=h' }
+instance BaseTensor Banded (Int,Int) where
+    shape  = shapeBanded . unsafeThawIOBanded
+    bounds = boundsBanded . unsafeThawIOBanded
 
-    
-instance (BLAS1 e) => ITensor (BMatrix Imm (m,n)) (Int,Int) e where
-    size = inlinePerformIO . getSize
+instance ITensor Banded (Int,Int) where
+    (//)          = replaceHelp writeElem
+    unsafeReplace = replaceHelp unsafeWriteElem
     
-    unsafeAt a = inlinePerformIO . (unsafeReadElem a)
+    unsafeAt x i  = inlineLiftBanded (flip unsafeReadElem i) x
+    {-# INLINE unsafeAt #-}
     
-    indices = inlinePerformIO . getIndices
-    elems   = inlinePerformIO . getElems
-    assocs  = inlinePerformIO . getAssocs
+    size          = inlineLiftBanded getSize
+    elems         = inlineLiftBanded getElems
+    indices       = inlineLiftBanded getIndices
+    assocs        = inlineLiftBanded getAssocs
 
-    (//)          = replaceHelp writeElem
-    unsafeReplace = replaceHelp unsafeWriteElem
+    tmap f a      = coerceBanded $ listsBanded mn bw (map (map f) es)
+      where (mn,bw,es) = listsFromBanded a
 
-    amap f a = banded (shape a) (numLower a, numUpper a) ies
-      where
-        ies = map (second f) (assocs 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 (m,n) e -> (Int,Int) -> e -> IO ())
-    -> Banded (m,n) e -> [((Int,Int), e)] -> Banded (m,n) e
+       (IOBanded mn e -> (Int,Int) -> e -> IO ())
+    -> Banded mn e -> [((Int,Int), e)] -> Banded mn e
 replaceHelp set x ies =
-    unsafeFreeze $ unsafePerformIO $ do
-        y  <- newCopy (unsafeThaw x)
+    unsafeFreezeIOBanded $ unsafePerformIO $ do
+        y  <- newCopyBanded (unsafeThawIOBanded x)
         mapM_ (uncurry $ set y) ies
         return y
 {-# NOINLINE replaceHelp #-}
-    
-    
-    
-instance (BLAS1 e) => RTensor (BMatrix t (m,n)) (Int,Int) e IO where
-    newCopy b = 
-        let (mn,kl,a,h) = toRawMatrix b
-        in do
-            a' <- newCopy a
-            return $ fromJust $ fromRawMatrix mn kl a' h
-    
-    getSize (BM _ _ m n kl ku _ _) = 
-        return $ foldl' (+) 0 $ 
-             map (diagLen (m,n)) [(-kl)..ku]
-    
-    unsafeReadElem a (i,j)
-        | isHerm a = 
-            unsafeReadElem (herm a) (j,i) >>= return . E.conj
-        | hasStorage a (i,j) =
-            withForeignPtr (fptrOf a) $ \ptr ->
-                peekElemOff ptr (indexOf a (i,j))
-        | otherwise =
-            return 0
 
-    getIndices a =
-        return $ filter (\ij -> inlinePerformIO $ canModifyElem (unsafeThaw a) ij)
-                        (range $ bounds a)
 
-    getElems a = getAssocs a >>= return . (map snd)
-
-    getAssocs a = do
-        is <- unsafeInterleaveIO $ getIndices a
-        mapM (\i -> unsafeReadElem a i >>= \e -> return (i,e)) is
+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 (BLAS1 e) => MTensor (BMatrix Mut (m,n)) (Int,Int) e IO where
-    setZero a = case toRawMatrix a of (_,_,a',_) -> setZero a'
+instance BLAS.BaseMatrix Banded where
+    herm (B a) = B (herm a)
     
-    setConstant e a = 
-        let (_,_,a',h) = toRawMatrix a
-            e' = if h then E.conj e else e
-        in setConstant e' a'
-        
-    canModifyElem a ij = return $ hasStorage a ij
+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
 
-    unsafeWriteElem a (i,j) e
-        | isHerm a = 
-            unsafeWriteElem (herm a) (j,i) (E.conj e)
-        | otherwise =
-            withForeignPtr (fptrOf a) $ \ptr ->
-                pokeElemOff ptr (indexOf a (i,j)) e
+instance (UnsafeIOToM m) => ReadBanded Banded Vector m where
 
-    modifyWith f a = 
-        let (_,_,a',h) = toRawMatrix a
-        in if h then modifyWith f a'
-                else modifyWith f (herm a)
+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 (BLAS1 e) => Show (BMatrix Imm (m,n) e) where
+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 
-        | isHerm a = 
-           "herm (" ++ show (herm a) ++ ")"
+        | isHermBanded a = 
+           "herm (" ++ show (herm $ coerceBanded a) ++ ")"
         | otherwise = 
-             let (mn,kl,es) = toLists a 
+             let (mn,kl,es) = listsFromBanded a 
              in "listsBanded " ++ show mn ++ " " ++ show kl ++ " " ++ show es
-       
-       
+
 compareHelp :: (BLAS1 e) => 
-    (e -> e -> Bool) -> Banded (m,n) e -> Banded (m,n) e -> Bool
-compareHelp cmp x y
-    | isHerm x && isHerm y =
-        compareHelp cmp (herm x) (herm y)
-compareHelp cmp x y =
-    (shape x == shape y) && (and $ zipWith cmp (elems x) (elems y))
+    (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 (BMatrix Imm (m,n) e) where
+instance (BLAS1 e, Eq e) => Eq (Banded mn e) where
     (==) = compareHelp (==)
 
-instance (BLAS1 e, AEq e) => AEq (BMatrix Imm (m,n) e) where
+instance (BLAS1 e, AEq e) => AEq (Banded mn e) where
     (===) = compareHelp (===)
-    (~==) = compareHelp (~==)       
-             
+    (~==) = compareHelp (~==)
diff --git a/Data/Matrix/Banded/Operations.hs b/Data/Matrix/Banded/Operations.hs
deleted file mode 100644
--- a/Data/Matrix/Banded/Operations.hs
+++ /dev/null
@@ -1,148 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
------------------------------------------------------------------------------
--- |
--- Module     : Data.Matrix.Banded.Operations
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Data.Matrix.Banded.Operations (
-    module BLAS.Matrix.Immutable,
-    module BLAS.Matrix.ReadOnly,
-    
-    -- * Matrix Arithmetic
-    -- ** Pure
-    scale,
-    invScale,
-    
-    -- ** Impure
-    getScaled,
-    getInvScaled,
-    
-    -- * In-place operations
-    doConj,
-    scaleBy,
-    invScaleBy,
-
-    ) where
-
-import System.IO.Unsafe
-import Unsafe.Coerce
-
-import Data.Matrix.Banded.Internal
-import Data.Matrix.Dense.Internal ( DMatrix, IOMatrix)
-import Data.Vector.Dense.Internal hiding ( unsafeWithElemPtr, unsafeThaw, 
-    unsafeFreeze )
-import qualified Data.Vector.Dense.Operations as V
-import qualified Data.Vector.Dense.Internal as V
-import qualified Data.Matrix.Dense.Internal as M
-import qualified Data.Matrix.Dense.Operations as M
-
-import BLAS.Access
-import BLAS.C ( CBLASTrans, colMajor, noTrans, conjTrans )
-import qualified BLAS.C as BLAS
-import BLAS.Elem ( BLAS1, BLAS2  )
-import qualified BLAS.Elem as E
-import BLAS.Matrix.Immutable
-import BLAS.Matrix.ReadOnly
-
-infixl 7 `scale`, `invScale`
-
-
--- | Form a new matrix by multiplying every element by a value.
-getScaled :: (BLAS1 e) => e -> BMatrix t (m,n) e -> IO (BMatrix r (m,n) e)
-getScaled k = unaryOp (scaleBy k)
-
--- | Form a new matrix by dividing every element by a value.
-getInvScaled :: (BLAS1 e) => e -> BMatrix t (m,n) e -> IO (BMatrix r (m,n) e)
-getInvScaled k = unaryOp (invScaleBy k)
-
--- | Conjugate every element in a matrix.
-doConj  :: (BLAS1 e) => IOBanded (m,n) e -> IO ()
-doConj a = let (_,_,a',_) = toRawMatrix a
-           in M.doConj a'
-
--- | Scale every element in a matrix by the given value.
-scaleBy :: (BLAS1 e) => e -> IOBanded (m,n) e -> IO ()
-scaleBy k a = 
-    let (_,_,a',h) = toRawMatrix a
-        k' = if h then E.conj k else k
-    in M.scaleBy k' a'
-    
--- | Divide every element by the given value.
-invScaleBy :: (BLAS1 e) => e -> IOBanded (m,n) e -> IO ()
-invScaleBy k a = 
-    let (_,_,a',h) = toRawMatrix a
-        k' = if h then E.conj k else k
-    in M.invScaleBy k' a'
-
-blasTransOf :: BMatrix t (m,n) e -> CBLASTrans
-blasTransOf a = 
-    case (isHerm a) of
-          False -> noTrans
-          True  -> conjTrans
-
-flipShape :: (Int,Int) -> (Int,Int)
-flipShape (m,n) = (n,m)
-
-
--- | @gbmv alpha a x beta y@ replaces @y := alpha a * x + beta y@
-gbmv :: (BLAS2 e) => e -> BMatrix s (m,n) e -> DVector t n e -> e -> IOVector m e -> IO ()
-gbmv alpha a x beta y
-    | numRows a == 0 || numCols a == 0 =
-        return ()
-    | isConj x = do
-        x' <- V.getConj (conj x)
-        gbmv alpha a x' beta y
-    | isConj y = do
-        V.doConj y
-        gbmv alpha a x beta (conj y)
-        V.doConj y
-    | otherwise =
-        let order  = colMajor
-            transA = blasTransOf a
-            (m,n)  = case (isHerm a) of
-                         False -> shape a
-                         True  -> (flipShape . shape) a
-            (kl,ku) = case (isHerm a) of
-                          False -> (numLower a, numUpper a)
-                          True  -> (numUpper a, numLower a)
-            ldA    = ldaOf a
-            incX   = V.strideOf x
-            incY   = V.strideOf y
-        in unsafeWithBasePtr a $ \pA ->
-               V.unsafeWithElemPtr x 0 $ \pX ->
-                    V.unsafeWithElemPtr y 0 $ \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 :: (BLAS2 e) => e -> BMatrix s (m,k) e -> DMatrix t (k,n) e -> e -> IOMatrix (m,n) e -> IO ()
-gbmm alpha a b beta c =
-    sequence_ $
-        zipWith (\x y -> gbmv alpha a x beta y) (M.cols b) (M.cols c)
-
-unaryOp :: (BLAS1 e) => (IOBanded (m,n) e -> IO ()) 
-    -> BMatrix t (m,n) e -> IO (BMatrix r (m,n) e)
-unaryOp f a = do
-    a' <- newCopy a
-    f (unsafeThaw a')
-    return (unsafeCoerce a')
-
--- | Create a new matrix by scaling another matrix by the given value.
-scale :: (BLAS1 e) => e -> Banded (m,n) e -> Banded (m,n) e
-scale k a = unsafePerformIO $ getScaled k a
-{-# NOINLINE scale #-}
-
--- | Form a new matrix by dividing every element by a value.
-invScale :: (BLAS1 e) => e -> Banded (m,n) e -> Banded (m,n) e
-invScale k a = unsafePerformIO $ getInvScaled k a
-{-# NOINLINE invScale #-}
-
-instance (BLAS2 e) => RMatrix (BMatrix s) e where
-    unsafeDoSApplyAdd    = gbmv
-    unsafeDoSApplyAddMat = gbmm
-
-instance (BLAS2 e) => IMatrix (BMatrix Imm) e
-
diff --git a/Data/Matrix/Banded/ST.hs b/Data/Matrix/Banded/ST.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Banded/ST.hs
@@ -0,0 +1,31 @@
+{-# 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
diff --git a/Data/Matrix/Dense.hs b/Data/Matrix/Dense.hs
--- a/Data/Matrix/Dense.hs
+++ b/Data/Matrix/Dense.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Data.Matrix.Dense
@@ -9,154 +8,45 @@
 --
 
 module Data.Matrix.Dense (
-    -- * Dense matrix type
-    Matrix,
+    module Data.Matrix.Dense.Internal,
     
-    module BLAS.Matrix.Base,
+    -- * Matrix and vector multiplication
     module BLAS.Matrix.Immutable,
-    module BLAS.Tensor.Base,
-    module BLAS.Tensor.Dense.Immutable,
-    module BLAS.Tensor.Immutable,
-    module BLAS.Tensor.Scalable,
-
-    -- * Creating matrices
-    matrix, 
-    listMatrix,
-    fromCols,
-    fromRows,
     
-    -- * Special matrices
-    identity,
-
-    -- * Rows and columns
-    row,
-    col,
-    rows,
-    cols,
-
-    -- * Diagonals
-    diag,
-
-    -- * Augmenting matrices
-    submatrix,
-
-    -- * Matrix arithmetic
-    shift,
-    scale,
-    invScale,
-
-    -- * Casting matrices
-    coerceMatrix,
-    
-    -- * Converting between vectors and matrices
-    fromRow,
-    fromCol,
-    
-    -- * Unsafe operations
-    unsafeMatrix,
-    unsafeRow,
-    unsafeCol,
-    unsafeDiag,
-    unsafeSubmatrix,
-    
+    -- * Converting between mutable and immutable matrices
+    UnsafeFreezeMatrix(..),
+    UnsafeThawMatrix(..),
+    freezeMatrix,
+    thawMatrix,
     ) where
 
-import Data.Maybe                  ( fromJust )
-import System.IO.Unsafe            ( unsafePerformIO )
-
-import BLAS.Access
-import BLAS.Elem ( BLAS1, BLAS2 )
-import BLAS.Matrix.Base hiding ( Matrix )
+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
-import BLAS.Tensor.Base
-import BLAS.Tensor.Dense.Immutable
-import BLAS.Tensor.Immutable
-import BLAS.Tensor.Scalable
 
-import Data.Matrix.Dense.Internal
-import qualified Data.Matrix.Dense.Internal as M
-import Data.Matrix.Dense.Operations ( shift, scale, invScale, plus, minus, 
-    times, divide )
-import Data.Vector.Dense hiding ( scale, invScale, shift )
-
-
--- | 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 = unsafePerformIO $ newMatrix mn ies
-{-# NOINLINE matrix #-}
-
--- | 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 = unsafePerformIO $ unsafeNewMatrix mn ies
-{-# NOINLINE unsafeMatrix #-}
-
--- | Create a matrix of the given shape from a list of columns
-fromCols :: (BLAS1 e) => (Int,Int) -> [Vector m e] -> Matrix (m,n) e
-fromCols mn cs = unsafePerformIO $ newColsMatrix mn cs
-{-# NOINLINE fromCols #-}
-
--- | Create a matrix of the given shape from a list of rows
-fromRows :: (BLAS1 e) => (Int,Int) -> [Vector n e] -> Matrix (m,n) e
-fromRows mn rs = unsafePerformIO $ newRowsMatrix mn rs
-{-# NOINLINE fromRows #-}
-
--- | Get a new matrix of the given shape with ones along the diagonal and
--- zeroes everywhere else.
-identity :: (BLAS1 e) => (Int,Int) -> Matrix (m,n) e
-identity mn = unsafePerformIO $ newIdentity mn
-{-# NOINLINE identity #-}
-
--- | Get a matrix from a row vector.
-fromRow :: (BLAS1 e) => Vector n e -> Matrix (one,n) e
-fromRow x = 
-    case maybeFromRow x of
-        Just x' -> x'
-        Nothing -> fromJust $ maybeFromRow $ unsafePerformIO $ newCopy x
-{-# NOINLINE fromRow #-}
-
--- | Get a matrix from a column vector.
-fromCol :: (BLAS1 e) => Vector m e -> Matrix (m,one) e
-fromCol x = 
-    case maybeFromCol x of
-        Just x' -> x'
-        Nothing -> fromJust $ maybeFromCol $ unsafePerformIO $ newCopy x
-{-# NOINLINE fromCol #-}
-
-
-instance (BLAS1 e) => Scalable (DMatrix Imm (m,n)) e where
-    (*>) = scale
-        
-instance (BLAS2 e) => Num (DMatrix Imm (m,n) e) where
-    (+)           = plus
-    (-)           = minus
-    (*)           = times
-    negate        = scale (-1)
-    abs           = amap abs
-    signum        = amap signum
-    fromInteger n = constant (1,1) (fromInteger n)
-    
-instance (BLAS2 e) => Fractional (DMatrix Imm (m,n) e) where
-    (/) a b        = divide a b
-    recip          = amap recip
-    fromRational q = constant (1,1) (fromRational q)
+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    
     
-instance (BLAS2 e, Floating e) => Floating (DMatrix Imm (m,n) e) where
-    pi       = constant (1,1) pi
-    exp      = amap exp 
-    sqrt     = amap sqrt
-    log      = amap log
-    (**)     = azipWith (**)
-    sin      = amap sin
-    cos      = amap cos
-    tan      = amap tan
-    asin     = amap asin
-    acos     = amap acos
-    atan     = amap atan
-    sinh     = amap sinh
-    cosh     = amap cosh
-    tanh     = amap tanh
-    asinh    = amap asinh
-    acosh    = amap acosh
-    atanh    = amap atanh
+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
diff --git a/Data/Matrix/Dense/Class.hs b/Data/Matrix/Dense/Class.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/Class.hs
@@ -0,0 +1,46 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Matrix/Dense/Class/Copying.hs b/Data/Matrix/Dense/Class/Copying.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/Class/Copying.hs
@@ -0,0 +1,63 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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)
diff --git a/Data/Matrix/Dense/Class/Creating.hs b/Data/Matrix/Dense/Class/Creating.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/Class/Creating.hs
@@ -0,0 +1,84 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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]
+
diff --git a/Data/Matrix/Dense/Class/Elements.hs b/Data/Matrix/Dense/Class/Elements.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/Class/Elements.hs
@@ -0,0 +1,17 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Matrix/Dense/Class/Internal.hs b/Data/Matrix/Dense/Class/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/Class/Internal.hs
@@ -0,0 +1,719 @@
+{-# 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
diff --git a/Data/Matrix/Dense/Class/Operations.hs b/Data/Matrix/Dense/Class/Operations.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/Class/Operations.hs
@@ -0,0 +1,193 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Matrix/Dense/Class/Special.hs b/Data/Matrix/Dense/Class/Special.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/Class/Special.hs
@@ -0,0 +1,41 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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)
diff --git a/Data/Matrix/Dense/Class/Views.hs b/Data/Matrix/Dense/Class/Views.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/Class/Views.hs
@@ -0,0 +1,123 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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)
diff --git a/Data/Matrix/Dense/IO.hs b/Data/Matrix/Dense/IO.hs
--- a/Data/Matrix/Dense/IO.hs
+++ b/Data/Matrix/Dense/IO.hs
@@ -1,87 +1,18 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Data.Matrix.Dense.IO
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
+-- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
 -- License    : BSD3
 -- Maintainer : Patrick Perry <patperry@stanford.edu>
 -- Stability  : experimental
 --
--- This modules defines a mutable dense matrix and associate operations.
+
 module Data.Matrix.Dense.IO (
-    -- * The mutable dense matrix data type
-    DMatrix(..),
+    -- * The IOMatrix data type
     IOMatrix,
     
-    module BLAS.Matrix.Base,
-    module BLAS.Matrix.ReadOnly,
-    module BLAS.Tensor.Base,
-    module BLAS.Tensor.Dense.ReadOnly,
-    module BLAS.Tensor.ReadOnly,
-    module BLAS.Tensor.Mutable,
-    
-    -- * Creating new matrices
-    newMatrix,
-    newMatrix_,
-    newListMatrix,
-    newColsMatrix,
-    newRowsMatrix,
-
-    -- * Special matrices
-    newIdentity,
-    setIdentity,
-    
-    -- * Views
-    -- ** Rows and columns
-    row,
-    col,
-    rows,
-    cols,
-    
-    -- ** Diagonals
-    diag,
-    
-    -- ** Matrix views
-    submatrix,
-
-    -- * Operations
-    module Data.Matrix.Dense.Operations,
-    
-    -- ** Lifting scalar and vector operations
-    liftV,
-    liftV2,
-
-    -- * Converting to and from matrices
-    -- ** Vectors
-    maybeFromRow,
-    maybeFromCol,
-    maybeToVector,
-    
-    -- ** @ForeignPtr@s
-    toForeignPtr,
-    fromForeignPtr,
-    
-    -- ** Coercing
-    coerceMatrix,
-    
-    -- * Unsafe operations
-    unsafeNewMatrix,
-    unsafeWithElemPtr,
-    unsafeRow,
-    unsafeCol,
-    unsafeDiag,
-    unsafeSubmatrix,
-    unsafeFreeze,
-    unsafeThaw,
-    
+    module Data.Matrix.Dense.Class,
     ) where
 
-import Data.Matrix.Dense.Internal
-import Data.Matrix.Dense.Operations hiding ( add, plus, minus, times, divide, 
-    gemv, gemm )
-    
-import BLAS.Matrix.Base hiding ( Matrix )
-import BLAS.Matrix.ReadOnly
-import BLAS.Tensor.Base
-import BLAS.Tensor.Dense.ReadOnly
-import BLAS.Tensor.ReadOnly
-import BLAS.Tensor.Mutable
+import Data.Matrix.Dense.Class.Internal( IOMatrix )
+import Data.Matrix.Dense.Class
diff --git a/Data/Matrix/Dense/Internal.hs b/Data/Matrix/Dense/Internal.hs
--- a/Data/Matrix/Dense/Internal.hs
+++ b/Data/Matrix/Dense/Internal.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-{-# OPTIONS_GHC -fglasgow-exts #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Data.Matrix.Dense.Internal
@@ -10,515 +9,324 @@
 --
 
 module Data.Matrix.Dense.Internal (
-    -- * Dense matrix data types
-    DMatrix(..),
-    IOMatrix,
-    Matrix,
+    -- * Dense matrix type
+    Matrix(..),
 
+    -- * Matrix shape
+    module BLAS.Tensor.Base,
     module BLAS.Matrix.Base,
-    module BLAS.Tensor,
-
-    -- * Converting to and from foreign pointers
-    toForeignPtr,
-    fromForeignPtr,
+    coerceMatrix,
 
-    -- * Creating new matrices
-    newMatrix,
-    newMatrix_,
-    newListMatrix,
-    newColsMatrix,
-    newRowsMatrix,
-    
+    -- * Creating matrices
+    matrix, 
     listMatrix,
-
-    -- * Special matrices
-    newIdentity,
-    setIdentity,
-    
-    -- * Row and column views
-    row,
-    col,
-    rows,
-    cols,
+    rowsMatrix,
+    colsMatrix,
+    rowMatrix,
+    colMatrix,
+    unsafeMatrix,
     
-    -- * Diagonal views
-    diag,
+    -- * Reading matrix elements
+    module BLAS.Tensor.Immutable,
     
+    -- * Special matrices
+    zeroMatrix,
+    constantMatrix,
+    identityMatrix,
+
     -- * Matrix views
     submatrix,
-
-    -- * Converting to/from vectors
-    maybeFromRow,
-    maybeFromCol,
-    maybeToVector,
-    
-    -- * Lifting scalar and vector operations
-    liftV,
-    liftV2,
-    
-    -- * Casting matrices
-    coerceMatrix,
+    splitRowsAt,
+    splitColsAt,
+    unsafeSubmatrix,
+    unsafeSplitRowsAt,
+    unsafeSplitColsAt,
     
-    -- * Unsafe operations
-    unsafeThaw,
-    unsafeFreeze,
-    unsafeNewMatrix,
-    unsafeWithElemPtr,
-    unsafeRow,
-    unsafeCol,
+    -- * Vector views
+    diag,
     unsafeDiag,
-    unsafeSubmatrix,
-    ) where
 
-import Control.Monad ( forM_, zipWithM_ )
-import Data.Ix ( inRange, range )
-import Foreign
-import System.IO.Unsafe   
-import Unsafe.Coerce
+    -- * Low-level properties
+    ldaOfMatrix,
+    isHermMatrix,
+    ) where
 
 import Data.AEq
-
-import Data.Vector.Dense.Internal hiding ( toForeignPtr, fromForeignPtr,
-    unsafeFreeze, unsafeThaw, storageOf, offsetOf, unsafeWithElemPtr )
-import qualified Data.Vector.Dense.Internal as V
-import qualified Data.Vector.Dense.Operations as V
+import System.IO.Unsafe
 
-import BLAS.Access
-import BLAS.Internal ( inlinePerformIO, checkedRow, checkedCol, checkedDiag,
-    checkedSubmatrix, diagStart, diagLen )
 import BLAS.Elem ( Elem, BLAS1 )
-import qualified BLAS.Elem as E
-import BLAS.Matrix.Base hiding ( Matrix )
-import qualified BLAS.Matrix.Base as C
+import BLAS.Internal ( inlinePerformIO )
+import BLAS.UnsafeIOToM
+
+import BLAS.Tensor.Base
+import BLAS.Tensor.Immutable
 import BLAS.Tensor
-import BLAS.Types
 
+import BLAS.Matrix.Base hiding ( BaseMatrix )
+import qualified BLAS.Matrix.Base as BLAS
 
--- | 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 DMatrix t mn e =
-      DM { storageOf :: {-# UNPACK #-} !(ForeignPtr e) -- ^ a pointer to the storage region
-         , offsetOf  :: {-# UNPACK #-} !Int            -- ^ an offset (in elements, not bytes) to the first element in the matrix. 
-         , size1     :: {-# UNPACK #-} !Int            -- ^ the number of rows in the matrix
-         , size2     :: {-# UNPACK #-} !Int            -- ^ the number of columns in the matrix
-         , ldaOf     :: {-# UNPACK #-} !Int            -- ^ the leading dimension size of the matrix
-         , isHerm    :: {-# UNPACK #-} !Bool           -- ^ indicates whether or not the matrix is transposed and conjugated
-         }
+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
 
-type Matrix = DMatrix Imm
-type IOMatrix = DMatrix Mut
+newtype Matrix mn e = M (IOMatrix mn e)
 
-unsafeFreeze :: DMatrix t mn e -> Matrix mn e
-unsafeFreeze = unsafeCoerce
+unsafeFreezeIOMatrix :: IOMatrix mn e -> Matrix mn e
+unsafeFreezeIOMatrix = M
 
-unsafeThaw :: DMatrix t mn e -> IOMatrix mn e
-unsafeThaw = unsafeCoerce
+unsafeThawIOMatrix :: Matrix mn e -> IOMatrix mn e
+unsafeThawIOMatrix (M a) = a
 
--- | Coerce the phantom shape type from one type to another.
-coerceMatrix :: DMatrix t mn e -> DMatrix t kl e
-coerceMatrix = unsafeCoerce
 
--- | @fromForeignPtr f o mn l h@ creates a matrix view of the data pointed to
--- by @f@ starting at offset @o@ and having shape @mn@ and lda @l@.  If @h@
--- is @True@ the matrix is interpreted as transposed and conjugated.
-fromForeignPtr :: ForeignPtr e -> Int -> (Int,Int) -> Int -> Bool -> DMatrix t (m,n) e
-fromForeignPtr f o (m,n) l h = DM f o m n l h
+liftMatrix :: (IOMatrix n e -> a) -> Matrix n e -> a
+liftMatrix f (M x) = f x
+{-# INLINE liftMatrix #-}
 
--- | Convert a dense matrix to a pointer, offset, size, lda, herm.
-toForeignPtr :: DMatrix t (m,n) e -> (ForeignPtr e, Int, (Int,Int), Int, Bool)
-toForeignPtr a = (storageOf a, offsetOf a, (size1 a, size2 a), ldaOf a, isHerm a)
+liftMatrix2 :: 
+    (IOMatrix n e -> IOMatrix n e -> a) -> 
+        Matrix n e -> Matrix n e -> a
+liftMatrix2 f x = liftMatrix (liftMatrix f x)
+{-# INLINE liftMatrix2 #-}
 
-indexOf :: DMatrix t (m,n) e -> (Int,Int) -> Int
-indexOf a (i,j) = 
-    let (i',j') = case isHerm a of
-                        True  -> (j,i)
-                        False -> (i,j)
-        o = offsetOf a
-        l = ldaOf a
-    in o + i' + j'*l
-{-# INLINE indexOf #-}
-    
--- | Create a new matrix of the given size and initialize the given elements to
--- the given values.  All other elements get initialized to zero.
-newMatrix :: (BLAS1 e) => (Int,Int) -> [((Int,Int), e)] -> IO (DMatrix t (m,n) e)
-newMatrix = newMatrixHelp writeElem
+unsafeLiftMatrix :: (IOMatrix n e -> IO a) -> Matrix n e -> a
+unsafeLiftMatrix f = unsafePerformIO . liftMatrix f
+{-# NOINLINE unsafeLiftMatrix #-}
 
--- | Same as 'newMatrix' but do not do any bounds-checking.
-unsafeNewMatrix :: (BLAS1 e) => (Int,Int) -> [((Int,Int), e)] -> IO (DMatrix t (m,n) e)
-unsafeNewMatrix = newMatrixHelp unsafeWriteElem
+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 #-}
 
-newMatrixHelp :: (BLAS1 e) => 
-       (IOMatrix (m,n) e -> (Int,Int) -> e -> IO ()) 
-    -> (Int,Int) -> [((Int,Int),e)] -> IO (DMatrix t (m,n) e)
-newMatrixHelp set mn ijes = do
-    x <- newZero mn
-    io <- unsafeInterleaveIO $ mapM_ (uncurry $ set $ unsafeThaw x) ijes
-    return $ io `seq` x
+inlineLiftMatrix :: (IOMatrix n e -> IO a) -> Matrix n e -> a
+inlineLiftMatrix f = inlinePerformIO . liftMatrix f
+{-# INLINE inlineLiftMatrix #-}
 
--- | Create a new matrix of given shape, but do not initialize the elements.
-newMatrix_ :: (Elem e) => (Int,Int) -> IO (DMatrix t (m,n) e)
-newMatrix_ (m,n) 
-    | m < 0 || n < 0 =
-        ioError $ userError $ 
-            "Tried to create a matrix with shape `" ++ show (m,n) ++ "'"
-    | otherwise = do
-        f <- mallocForeignPtrArray (m*n)
-        return $ fromForeignPtr f 0 (m,n) (max 1 m) False
 
--- | Create a new matrix with the given elements in column-major order.
-newListMatrix :: (Elem e) => (Int,Int) -> [e] -> IO (DMatrix t (m,n) e)
-newListMatrix (m,n) es = do
-    a <- newMatrix_ (m,n)
-    unsafeWithElemPtr a (0,0) $ flip pokeArray (take (m*n) es)
-    return a
+-- | 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 :: (Elem e) => (Int,Int) -> [e] -> Matrix (m,n) e
-listMatrix mn es = unsafePerformIO $ newListMatrix mn es
+listMatrix :: (BLAS1 e) => (Int,Int) -> [e] -> Matrix (m,n) e
+listMatrix mn es = unsafeFreezeIOMatrix $ unsafePerformIO $ newListMatrix mn es
 {-# NOINLINE listMatrix #-}
 
--- | Create a new matrix of the given shape with ones along the diagonal, 
--- and zeros everywhere else.
-newIdentity :: (BLAS1 e) => (Int,Int) -> IO (DMatrix t (m,n) e)
-newIdentity mn = do
-    a <- newMatrix_ mn
-    setIdentity (unsafeThaw a)
-    return a
+-- | 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 #-}
 
--- | Set the diagonal to ones, and set everywhere else to zero.
-setIdentity :: (BLAS1 e) => IOMatrix (m,n) e -> IO ()
-setIdentity a = do
-    s <- getSize a
-    case s of
-        0 -> return ()
-        _ -> setZero a >>
-             setConstant 1 (diag a 0)
+-- | 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 #-}
 
--- | Form a matrix from a list of column vectors.
-newColsMatrix :: (BLAS1 e) => (Int,Int) -> [DVector t m e] -> IO (DMatrix r (m,n) e)
-newColsMatrix (m,n) cs = do
-    a <- newZero (m,n)
-    forM_ (zip [0..(n-1)] cs) $ \(j,c) ->
-        V.copyVector (unsafeCol (unsafeThaw a) j) c
-    return a
+-- | 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 #-}
 
--- | Form a matrix from a list of row vectors.
-newRowsMatrix :: (BLAS1 e) => (Int,Int) -> [DVector t n e] -> IO (DMatrix r (m,n) e)
-newRowsMatrix (m,n) rs = do
-    a <- newZero (m,n)
-    forM_ (zip [0..(m-1)] rs) $ \(i,r) ->
-        V.copyVector (unsafeRow (unsafeThaw a) i) r
-    return a
+-- | 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 #-}
 
--- | Evaluate a function with a pointer to the raw storage for the element
--- at the given index.  It may be necessary to conjugate or scale values before
--- reading or writing to or from the location.
-unsafeWithElemPtr :: (Elem e) => DMatrix t (m,n) e -> (Int,Int) -> (Ptr e -> IO a) -> IO a
-unsafeWithElemPtr a ij f =
-    withForeignPtr (storageOf a) $ \ptr ->
-        let ptr' = ptr `advancePtr` (indexOf a ij)
-        in f ptr'
-        
--- | Get a vector view of the given row in a matrix.
-row :: (Elem e) => DMatrix t (m,n) e -> Int -> DVector t n e
-row a = checkedRow (shape a) (unsafeRow a)
+-- | 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 list of vector views of the rows of the matrix.
-rows :: (Elem e) => DMatrix t (m,n) e -> [DVector t n e]
-rows a = [ unsafeRow a i | i <- [0..numRows a - 1] ]
+-- | 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 list of vector views of the columns of the matrix.
-cols :: (Elem e) => DMatrix t (m,n) e -> [DVector t m e]
-cols a = [ unsafeCol a j | j <- [0..numCols a - 1] ]
+-- | 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 vector view of the given column in a matrix.
-col :: (Elem e) => DMatrix t (m,n) e -> Int -> DVector t m e
-col a = checkedCol (shape a) (unsafeCol a)
+-- | 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 #-}
 
--- | Same as 'row', but does not do any bounds checking.
-unsafeRow ::  (Elem e) => DMatrix t (m,n) e -> Int -> DVector t n e
-unsafeRow a i
-    | isHerm a =
-        conj $ unsafeCol (herm a) i
-    | otherwise =
-        let f = storageOf a
-            o = indexOf a (i,0)
-            n = numCols a
-            s = ldaOf a
-            c = False
-        in V.fromForeignPtr f o n s c
 
--- | Same as 'col', but does not do any bounds checking.
-unsafeCol :: (Elem e) => DMatrix t (m,n) e -> Int -> DVector t m e
-unsafeCol a j 
-    | isHerm a =
-        conj $ unsafeRow (herm a) j
-    | otherwise =
-        let f = storageOf a
-            o = indexOf a (0,j)
-            m = numRows a
-            s = 1
-            c = False
-        in V.fromForeignPtr f o m s c
-
--- | @diag a 0@ gets a vector view of the main diagonal of @a@.  @diag a k@ for 
--- @k@ positive gets a view of the @k@th superdiagonal.  For @k@ negative, it
--- gets a view of the @(-k)@th subdiagonal.
-diag :: (Elem e) => DMatrix t (m,n) e -> Int -> DVector t k e
-diag a = checkedDiag (shape a) (unsafeDiag a)
-
--- | Same as 'diag', but does not do any bounds checking.
-unsafeDiag :: (Elem e) => DMatrix t (m,n) e -> Int -> DVector t k e
-unsafeDiag a i 
-    | isHerm a = 
-        conj $ unsafeDiag (herm a) (negate i)
-    | otherwise =            
-        let f = storageOf a
-            o = indexOf a (diagStart i)
-            n = diagLen (shape a) i
-            s = ldaOf a + 1
-            c = False
-        in V.fromForeignPtr f o n s c
-
--- | @submatrix a ij mn@ returns a view of the submatrix of @a@ with element @(0,0)@
+-- | @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) => DMatrix t (m,n) e -> (Int,Int) -> (Int,Int) -> DMatrix t (k,l) e
-submatrix a = checkedSubmatrix (shape a) (unsafeSubmatrix a)
-
--- | Same as 'submatrix' but does not do any bounds checking.
-unsafeSubmatrix :: (Elem e) => DMatrix t (m,n) e -> (Int,Int) -> (Int,Int) -> DMatrix t (k,l) e
-unsafeSubmatrix a (i,j) (m,n)
-    | isHerm a  = 
-        herm $ unsafeSubmatrix (herm a) (j,i) (n,m)
-    | otherwise =
-        let f = storageOf a
-            o = indexOf a (i,j)
-            l = ldaOf a
-        in fromForeignPtr f o (m,n) l False
-    
-
--- | Create a matrix view of a row vector.  This will fail if the
--- vector is conjugated and the stride is not @1@.
-maybeFromRow :: (Elem e) => DVector t m e -> Maybe (DMatrix t (one,m) e)
-maybeFromRow x
-    | isConj x && strideOf x == 1 =
-        let f = V.storageOf x
-            o = V.offsetOf x
-            n = dim x
-            l = max 1 n
-            h = True
-        in Just $ fromForeignPtr f o (n,1) l h
-    | (not . isConj) x =
-        let f = V.storageOf x
-            o = V.offsetOf x
-            n = dim x
-            s = strideOf x
-            l = max 1 s
-            h = False
-        in Just $ fromForeignPtr f o (1,n) l h
-    | otherwise =
-        Nothing
-
-
--- | 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 :: (Elem e) => DVector t n e -> Maybe (DMatrix t (n,one) e)
-maybeFromCol x
-    | isConj x = maybeFromRow (conj x) >>= return . herm
-    | strideOf x == 1 =
-        let f = V.storageOf x
-            o = V.offsetOf x
-            m = dim x
-            l = max 1 m
-        in Just $ fromForeignPtr f o (m,1) l False
-    | otherwise =
-        Nothing
-
-maybeToVector :: (Elem e) => DMatrix t (m,n) e -> Maybe (Order, DVector t k e)
-maybeToVector a@(DM f o m n ld h) 
-    | h = 
-        maybeToVector (herm a) >>= (\(ord,x) -> return (flipOrder ord, conj x))
-    | ld == m =
-        Just $ (ColMajor, V.fromForeignPtr f o (m*n) 1  False)
-    | m == 1 =
-        Just $ (ColMajor, V.fromForeignPtr f o n     ld False)
-    | otherwise =
-        Nothing
+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
 
--- | Take a unary elementwise vector operation and apply it to the elements of a matrix.
-liftV :: (Elem e) => (DVector t k e -> IO ()) -> DMatrix t (m,n) e -> IO ()
-liftV f a =
-    case maybeToVector a of
-        Just (_,x) -> f x
-        _ -> 
-            let xs  = case isHerm a of
-                          True  -> rows (coerceMatrix a)
-                          False -> cols (coerceMatrix a)
-            in mapM_ f xs
+-- | 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
 
--- | Take a binary elementwise vector operation and apply it to the elements of a pair
--- of matrices.
-liftV2 :: (Elem e) => (DVector s k e -> DVector t k e -> IO ()) 
-       -> DMatrix s (m,n) e -> DMatrix t (m,n) e -> IO ()
-liftV2 f a b =
-    case (maybeToVector a, maybeToVector b) of
-        (Just (RowMajor,x), Just (RowMajor,y)) -> f x y
-        (Just (ColMajor,x), Just (ColMajor,y)) -> f x y
-        _ -> 
-            let (xs,ys) = case isHerm a of
-                               True  -> (rows (coerceMatrix a), rows (coerceMatrix b))
-                               False -> (cols (coerceMatrix a), cols (coerceMatrix b))
-            in zipWithM_ f xs ys
+-- | Same as 'diag' but index is not range-checked.
+unsafeDiag :: (Elem e) => Matrix mn e -> Int -> Vector k e
+unsafeDiag = unsafeDiagView
 
 
-instance C.Matrix (DMatrix t) where
-    numRows a | isHerm a  = size2 a
-              | otherwise = size1 a
-
-    numCols a | isHerm a  = size1 a
-              | otherwise = size2 a
-
-    herm a = a{ isHerm=(not . isHerm) a }
-
+instance BaseTensor Matrix (Int,Int) where
+    shape  = liftMatrix shape
+    bounds = liftMatrix bounds
 
-instance (BLAS1 e) => ITensor (DMatrix Imm (m,n)) (Int,Int) e where
-    size a = (numRows a * numCols a)
+instance ITensor Matrix (Int,Int) where
+    (//)          = replaceHelp writeElem
+    unsafeReplace = replaceHelp unsafeWriteElem
     
-    unsafeAt a = inlinePerformIO . unsafeReadElem a
+    unsafeAt a i  = inlineLiftMatrix (flip unsafeReadElem i) a
     {-# INLINE unsafeAt #-}
     
-    indices a = [ (i,j) | j <- range (0,n-1), i <- range (0,m-1) ]
-      where (m,n) = shape a
-    {-# INLINE indices #-}
-    
-    elems = inlinePerformIO . getElems
-    {-# INLINE elems #-}
-    
-    assocs = inlinePerformIO . getAssocs
-    {-# INLINE assocs #-}
+    size          = inlineLiftMatrix getSize
+    elems         = inlineLiftMatrix getElems
+    indices       = inlineLiftMatrix getIndices
+    assocs        = inlineLiftMatrix getAssocs
 
-    (//) = replaceHelp writeElem
-    unsafeReplace = replaceHelp unsafeWriteElem
+    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
 
-    amap f a = listMatrix (shape a) (map f $ elems a)
+    (*>) k x = unsafeFreezeIOMatrix $ unsafeLiftMatrix (getScaledMatrix k) x
+    {-# NOINLINE (*>) #-}
 
+    shift k x = unsafeFreezeIOMatrix $ unsafeLiftMatrix (getShiftedMatrix k) x
+    {-# NOINLINE shift #-}
 
+
+
 replaceHelp :: (BLAS1 e) => 
-       (IOMatrix (m,n) e -> (Int,Int) -> e -> IO ())
-    -> Matrix (m,n) e -> [((Int,Int), e)] -> Matrix (m,n) e
-replaceHelp set x ies = 
-    unsafeFreeze $ unsafePerformIO $ do
-        y  <- newCopy (unsafeThaw x)
+    (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 y
+        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 (BLAS1 e) => IDTensor (DMatrix Imm (m,n)) (Int,Int) e where
-    zero = unsafePerformIO . newZero
-    {-# NOINLINE zero #-}
-     
-    constant mn = unsafePerformIO . newConstant mn
-    {-# NOINLINE constant #-}
-     
-    azipWith f a b
-        | shape b /= mn =
-            error ("azipWith: matrix shapes differ; first has shape `"
-                   ++ show mn ++ "' and second has shape `" 
-                   ++ show (shape b) ++ "'")
-        | otherwise =
-            listMatrix mn (zipWith f (elems a) (elems b))
-        where
-            mn = shape a
-     
-     
-instance (BLAS1 e) => RTensor (DMatrix t (m,n)) (Int,Int) e IO where
-    getSize a = return (numRows a * numCols a)
-    
-    newCopy a | isHerm a  = 
-                  newCopy (herm a) >>= return . herm
-              | otherwise = do
-                  a' <- newMatrix_ (shape a)
-                  liftV2 V.copyVector (unsafeThaw a') a
-                  return a'
-           
-    unsafeReadElem a (i,j)
-        | isHerm a  = unsafeReadElem (herm a) (j,i) >>= return . E.conj
-        | otherwise = withForeignPtr (storageOf a) $ \ptr ->
-                          peekElemOff ptr (indexOf a (i,j))
-    {-# INLINE unsafeReadElem #-}
+instance BLAS.BaseMatrix Matrix where
+    herm (M a) = M (herm a)
     
-    getIndices = return . indices . unsafeFreeze
-    {-# INLINE getIndices #-}
-
-    getElems a = return $ go (cols a)
-        where go cs | cs `seq` False = undefined
-              go []     = []
-              go (c:cs) =
-                  let e  = inlinePerformIO $ getElems c
-                      es = go cs
-                  in e ++ es
-    {-# NOINLINE getElems #-}
-
-    getAssocs a = return $ go (cols a) 0
-        where go cs j | cs `seq` j `seq` False = undefined
-              go []     _ = []
-              go (c:cs) j =
-                  let ie   = inlinePerformIO $ getAssocs c
-                      ije  = map (\(i,e) -> ((i,j),e)) ie
-                      ijes = go cs (j+1)
-                  in ije ++ ijes
-    {-# NOINLINE getAssocs #-}
+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) => RDTensor (DMatrix t (m,n)) (Int,Int) e IO where
-    newZero mn = do
-        a <- newMatrix_ mn
-        setZero (unsafeThaw a)
-        return a
-    
-    newConstant mn e = do
-        a <- newMatrix_ mn
-        setConstant e (unsafeThaw a)
-        return a
-    
-    
-instance (BLAS1 e) => MTensor (DMatrix Mut (m,n)) (Int,Int) e IO where 
-    setZero = liftV setZero
-    setConstant e = liftV (setConstant e)
+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
     
-    canModifyElem a ij =
-        return $ inRange (bounds a) ij
-    {-# INLINE canModifyElem #-}
+instance (BLAS1 e) => Fractional (Matrix mn e) where
+    (/) x y      = unsafeFreezeIOMatrix $ unsafeLiftMatrix2 getDivMatrix x y
+    recip        = tmap recip
+    fromRational = coerceMatrix . (constantMatrix (1,1)) . fromRational 
 
-    unsafeWriteElem a (i,j) e
-        | isHerm a  = unsafeWriteElem (herm a) (j,i) $ E.conj e
-        | otherwise = withForeignPtr (storageOf a) $ \ptr ->
-                          pokeElemOff ptr (indexOf a (i,j)) e
-    
-    modifyWith f = liftV (modifyWith f)       
+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 (DMatrix Imm (m,n) e) where
-    show a | isHerm a = 
-                "herm (" ++ show (herm a) ++ ")"
+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 (m,n) e -> Matrix (m,n) e -> Bool
-compareHelp cmp x y
-    | isHerm x && isHerm y =
-        compareHelp cmp (herm x) (herm y)
-compareHelp cmp x y =
-    (shape x == shape y) && (and $ zipWith cmp (elems x) (elems y))
+    (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 (DMatrix Imm (m,n) e) where
+instance (BLAS1 e, Eq e) => Eq (Matrix mn e) where
     (==) = compareHelp (==)
 
-instance (BLAS1 e, AEq e) => AEq (DMatrix Imm (m,n) e) where
+instance (BLAS1 e, AEq e) => AEq (Matrix mn e) where
     (===) = compareHelp (===)
     (~==) = compareHelp (~==)
-    
diff --git a/Data/Matrix/Dense/Operations.hs b/Data/Matrix/Dense/Operations.hs
deleted file mode 100644
--- a/Data/Matrix/Dense/Operations.hs
+++ /dev/null
@@ -1,296 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module     : Data.Matrix.Dense.Operations
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Data.Matrix.Dense.Operations (
-    -- * Copy and swap
-    copyMatrix,
-    swapMatrices,
-
-    -- * Matrix Arithmetic
-    -- ** Pure
-    shift,
-    scale,
-    invScale,
-    add,
-    plus,
-    minus,
-    times,
-    divide,
-    
-    -- ** Impure
-    getShifted,
-    getScaled,
-    getInvScaled,
-    getSum,
-    getDiff,
-    getProduct,
-    getRatio,
-    
-    -- * In-place operations
-    doConj,
-    shiftBy,
-    scaleBy,
-    invScaleBy,
-    axpy,
-    (+=),
-    (-=),
-    (*=),
-    (//=),
-    
-    -- * BLAS operations
-    gemv,
-    gemm,
-    
-    -- * Unsafe operations
-    unsafeCopyMatrix,
-    unsafeSwapMatrices,
-    
-    ) where
-
-import Data.Maybe ( fromJust )
-import System.IO.Unsafe
-import Unsafe.Coerce
-
-import BLAS.Internal ( checkMatMatOp )
-import Data.Matrix.Dense.Internal
-import Data.Vector.Dense.Internal hiding ( unsafeWithElemPtr, unsafeThaw, 
-    unsafeFreeze )
-import qualified Data.Vector.Dense.Operations as V
-import qualified Data.Vector.Dense.Internal as V
-
-import BLAS.C ( CBLASTrans, colMajor, noTrans, conjTrans )
-import qualified BLAS.C as BLAS
-import BLAS.Elem ( BLAS1, BLAS2, BLAS3 )
-import qualified BLAS.Elem as E
-
-infixl 7 `scale`, `invScale`
-infixl 6 `shift`
-infixl 1 +=, -=, *=, //=
-
--- | @copy dst src@ copies the elements from the second argument to the first.
-copyMatrix :: (BLAS1 e) => IOMatrix (m,n) e -> DMatrix t (m,n) e -> IO ()
-copyMatrix a b = 
-    checkMatMatOp "copyMatrix" (shape a) (shape b) $ unsafeCopyMatrix a b
-
-unsafeCopyMatrix :: (BLAS1 e) => IOMatrix (m,n) e -> DMatrix t (m,n) e -> IO ()
-unsafeCopyMatrix = liftV2 (V.unsafeCopyVector)
-
--- | @swap a b@ exchanges the elements stored in two matrices.
-swapMatrices :: (BLAS1 e) => IOMatrix (m,n) e -> IOMatrix (m,n) e -> IO ()
-swapMatrices a b = 
-    checkMatMatOp "swapMatrices" (shape a) (shape b) $ unsafeSwapMatrices a b
-
-unsafeSwapMatrices :: (BLAS1 e) => IOMatrix (m,n) e -> IOMatrix (m,n) e -> IO ()
-unsafeSwapMatrices = liftV2 (V.unsafeSwapVectors)
-
--- | Form a new matrix by adding a value to every element in a matrix.
-getShifted :: (BLAS1 e) => e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-getShifted k = unaryOp (shiftBy k)
-
--- | Form a new matrix by multiplying every element by a value.
-getScaled :: (BLAS1 e) => e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-getScaled k = unaryOp (scaleBy k)
-
--- | Form a new matrix by dividing every element by a value.
-getInvScaled :: (BLAS1 e) => e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-getInvScaled k = unaryOp (invScaleBy k)
-
--- | Create a new matrix by taking the elementwise sum of two matrices.
-getSum :: (BLAS1 e) => e -> DMatrix s (m,n) e -> e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-getSum alpha a beta b = 
-    checkMatMatOp "getSum" (shape a) (shape b) $ unsafeGetSum alpha a beta b
-
-unsafeGetSum :: (BLAS1 e) => e -> DMatrix s (m,n) e -> e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-unsafeGetSum alpha a beta b 
-    | isHerm a = do
-        s <- unsafeGetSum (E.conj alpha) (herm a) (E.conj beta) (herm b)
-        return (herm s)
-    | otherwise = do
-        s <- getScaled alpha a
-        axpy beta b (unsafeThaw s)
-        return (unsafeCoerce s)
-
--- | Create a new matrix by taking the elementwise difference of two matrices.
-getDiff :: (BLAS1 e) => DMatrix s (m,n) e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-getDiff a b = checkMatMatOp "minus" (shape a) (shape b) $ unsafeGetSum 1 a (-1) b
-
--- | Create a new matrix by taking the elementwise product of two matrices.
-getProduct :: (BLAS2 e) => DMatrix s (m,n) e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-getProduct = binaryOp "times" (*=)
-
--- | Create a new matrix by taking the elementwise ratio of two matrices.
-getRatio :: (BLAS2 e) => DMatrix s (m,n) e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-getRatio = binaryOp "getRatio" (//=)
-
--- | Conjugate every element in a matrix.
-doConj  :: (BLAS1 e) => IOMatrix (m,n) e -> IO ()
-doConj a | isHerm a  = doConj (herm a)
-         | otherwise = liftV (\x -> V.doConj x >> return ()) a
-
--- | Scale every element in a matrix by the given value.
-scaleBy :: (BLAS1 e) => e -> IOMatrix (m,n) e -> IO ()
-scaleBy k = liftV (\x -> V.scaleBy k x >> return ())
-    
--- | Scale every element by the given value.
-shiftBy :: (BLAS1 e) => e -> IOMatrix (m,n) e -> IO ()
-shiftBy k = liftV (V.shiftBy k)
-
--- | Divide every element by the given value.
-invScaleBy :: (BLAS1 e) => e -> IOMatrix (m,n) e -> IO ()
-invScaleBy k = liftV (V.invScaleBy k)
-
-axpy :: (BLAS1 e) => e -> DMatrix t (m,n) e -> IOMatrix (m,n) e -> IO ()
-axpy alpha = liftV2 (V.axpy alpha)
-
--- | In-place elementwise add.
-(+=) :: (BLAS1 e) => IOMatrix (m,n) e -> DMatrix t (m,n) e -> IO ()
-(+=) = liftV2 (V.+=)
-
--- | In-place elementwise subtract.
-(-=) :: (BLAS1 e) => IOMatrix (m,n) e -> DMatrix t (m,n) e -> IO ()
-(-=) = liftV2 (V.-=)
-
--- | In-place elementwise product.
-(*=) :: (BLAS2 e) => IOMatrix (m,n) e -> DMatrix t (m,n) e -> IO ()
-(*=) = liftV2 (V.*=)
-
--- | In-place elementwise divide.
-(//=) :: (BLAS2 e) => IOMatrix (m,n) e -> DMatrix t (m,n) e -> IO ()
-(//=) = liftV2 (V.//=)
-
-blasTransOf :: DMatrix t (m,n) e -> CBLASTrans
-blasTransOf a = 
-    case (isHerm a) of
-          False -> noTrans
-          True  -> conjTrans
-
-flipShape :: (Int,Int) -> (Int,Int)
-flipShape (m,n) = (n,m)
-
--- | @gemv alpha a x beta y@ replaces @y := alpha a * x + beta y@.
-gemv :: (BLAS3 e) => e -> DMatrix s (m,n) e -> DVector t n e -> e -> IOVector m e -> IO ()
-gemv alpha a x beta y
-    | numRows a == 0 || numCols a == 0 =
-        return ()
-    | isConj x =
-        let b = fromJust $ maybeFromCol x
-        in case maybeFromCol y of
-               Just c  -> gemm alpha a b beta c
-               Nothing -> do
-                   V.doConj y
-                   gemm alpha a b beta (fromJust $ maybeFromCol $ V.conj y)
-                   V.doConj y
-    | isConj y = 
-        let c = fromJust $ maybeFromCol y
-        in case maybeFromCol x of
-               Just b  -> gemm alpha a b beta c
-               Nothing -> do
-                   x' <- V.newCopy (V.unsafeThaw x)
-                   V.doConj x'
-                   gemm alpha a (fromJust $ maybeFromCol $ V.conj x') beta c
-    | otherwise =
-        let order  = colMajor
-            transA = blasTransOf a
-            (m,n)  = case (isHerm a) of
-                         False -> shape a
-                         True  -> (flipShape . shape) a
-            ldA    = ldaOf a
-            incX   = V.strideOf x
-            incY   = V.strideOf y
-        in unsafeWithElemPtr a (0,0) $ \pA ->
-               V.unsafeWithElemPtr x 0 $ \pX ->
-                    V.unsafeWithElemPtr y 0 $ \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) => e -> DMatrix s (m,k) e -> DMatrix t (k,n) e -> e -> IOMatrix (m,n) e -> IO ()
-gemm alpha a b beta c
-    | numRows a == 0 || numCols a == 0 || numCols b == 0 = return ()
-    | isHerm c = gemm (E.conj alpha) (herm b) (herm a) (E.conj beta) (herm c)
-    | otherwise =
-        let order  = colMajor
-            transA = blasTransOf a
-            transB = blasTransOf b
-            (m,n)  = shape c
-            k      = numCols a
-            ldA    = ldaOf a
-            ldB    = ldaOf b
-            ldC    = ldaOf c
-        in unsafeWithElemPtr a (0,0) $ \pA ->
-               unsafeWithElemPtr b (0,0) $ \pB ->
-                   unsafeWithElemPtr c (0,0) $ \pC ->
-                       BLAS.gemm order transA transB m n k alpha pA ldA pB ldB beta pC ldC
-
-
-unaryOp :: (BLAS1 e) => (IOMatrix (m,n) e -> IO ()) 
-    -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-unaryOp f a = do
-    a' <- newCopy a
-    f (unsafeThaw a')
-    return (unsafeCoerce a')
-
-binaryOp :: (BLAS1 e) => String -> (IOMatrix (m,n) e -> DMatrix t (m,n) e -> IO ()) 
-    -> DMatrix s (m,n) e -> DMatrix t (m,n) e -> IO (DMatrix r (m,n) e)
-binaryOp name f a b = 
-    checkMatMatOp name (shape a) (shape b) $ do
-        a' <- newCopy a
-        f (unsafeThaw a') b
-        return (unsafeCoerce a')
-            
--- | Create a new matrix by scaling another matrix by the given value.
-scale :: (BLAS1 e) => e -> Matrix (m,n) e -> Matrix (m,n) e
-scale k a = unsafePerformIO $ getScaled k a
-{-# NOINLINE scale #-}
-
--- | Form a new matrix by adding a value to every element in a matrix.
-shift :: (BLAS1 e) => e -> Matrix (m,n) e -> Matrix (m,n) e
-shift k a = unsafePerformIO $ getShifted k a
-{-# NOINLINE shift #-}
-
--- | Form a new matrix by dividing every element by a value.
-invScale :: (BLAS1 e) => e -> Matrix (m,n) e -> Matrix (m,n) e
-invScale k a = unsafePerformIO $ getInvScaled k a
-{-# NOINLINE invScale #-}
-
--- | Create a new matrix by taking the elementwise sum of two matrices.
-add :: (BLAS1 e) => e -> Matrix (m,n) e -> e -> Matrix (m,n) e -> Matrix (m,n) e
-add alpha a beta b = unsafePerformIO $ getSum alpha a beta b
-{-# NOINLINE add #-}
-
--- | Create a new matrix by taking the elementwise sum of two matrices.
-plus :: (BLAS1 e) => Matrix (m,n) e -> Matrix (m,n) e -> Matrix (m,n) e
-plus a b = add 1 a 1 b
-
--- | Create a new matrix by taking the elementwise difference of two matrices.
-minus :: (BLAS1 e) => Matrix (m,n) e -> Matrix (m,n) e -> Matrix (m,n) e
-minus a b = unsafePerformIO $ getDiff a b
-{-# NOINLINE minus #-}
-
--- | Create a new matrix by taking the elementwise product of two matrices.
-times :: (BLAS2 e) => Matrix (m,n) e -> Matrix (m,n) e -> Matrix (m,n) e
-times a b = unsafePerformIO $ getProduct a b
-{-# NOINLINE times #-}
-
--- | Create a new matrix by taking the elementwise ratio of two matrices.
-divide :: (BLAS2 e) => Matrix (m,n) e -> Matrix (m,n) e -> Matrix (m,n) e
-divide a b = unsafePerformIO $ getRatio a b
-{-# NOINLINE divide #-}        
-
-{-# RULES
-"scale.plus/add"   forall k l x y. plus (scale k x) (scale l y) = add k x l y
-"scale1.plus/add"  forall k x y.   plus (scale k x) y = add k x 1 y
-"scale2.plus/add"  forall k x y.   plus x (scale k y) = add 1 x k y
-
-"scale.minus/add"  forall k l x y. minus (scale k x) (scale l y) = add k x (-l) y
-"scale1.minus/add" forall k x y.   minus (scale k x) y = add k x (-1) y
-"scale2.minus/add" forall k x y.   minus x (scale k y) = add 1 x (-k) y
-  #-}
-  
diff --git a/Data/Matrix/Dense/ST.hs b/Data/Matrix/Dense/ST.hs
new file mode 100644
--- /dev/null
+++ b/Data/Matrix/Dense/ST.hs
@@ -0,0 +1,31 @@
+{-# 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
diff --git a/Data/Matrix/Diag.hs b/Data/Matrix/Diag.hs
--- a/Data/Matrix/Diag.hs
+++ b/Data/Matrix/Diag.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ExistentialQuantification #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Data.Matrix.Diag
@@ -9,87 +9,209 @@
 --
 
 module Data.Matrix.Diag (
-    module BLAS.Matrix,
-    module BLAS.Tensor,
-
     -- * The diagonal matrix types
-    DiagMatrix,
     Diag,
-    IODiag,
     
     -- * Converting to and from @Vector@s
-    fromVector,
-    toVector,
-
+    diagFromVector,
+    vectorFromDiag,
+    
+    -- * Coercing shapes
+    coerceDiag,
+    
+    module BLAS.Matrix,
+    
     ) where
 
-import BLAS.Access
-import BLAS.Elem ( BLAS1, BLAS2 )
-import BLAS.Matrix hiding ( Matrix )
-import qualified BLAS.Matrix as Base
-import BLAS.Tensor
+import Control.Monad( zipWithM_ )
+import Control.Monad.ST( ST )
 
-import Control.Monad ( zipWithM_ )
+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.Internal ( rows )
-import Data.Matrix.Dense.Operations ( unsafeCopyMatrix )
-import qualified Data.Matrix.Dense.Operations as M
-import qualified Data.Matrix.Dense.Internal as M
-import Data.Vector.Dense.Internal
-import qualified Data.Vector.Dense.Internal as V
-import qualified Data.Vector.Dense.Operations as V
-import Data.Vector.Dense.Operations ( (//=), scaleBy, invScaleBy,
-    unsafeCopyVector )
 
-import System.IO.Unsafe
-import Unsafe.Coerce
+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 )
 
-newtype DiagMatrix t mn e = Diag (DVector t mn e)
-type Diag   = DiagMatrix Imm
-type IODiag = DiagMatrix Mut
+data Diag x nn e = forall n. Diag (x n e)
 
-coerceDiag :: DiagMatrix t mn e -> DiagMatrix t mn' e
+coerceDiag :: Diag x mn e -> Diag x mn' e
 coerceDiag = unsafeCoerce
 
-fromVector :: DVector t n e -> DiagMatrix t (n,n) e
-fromVector = Diag . unsafeCoerce
-
-toVector :: DiagMatrix t (n,n) e -> DVector t n e
-toVector (Diag x) = unsafeCoerce x
+diagFromVector :: (BaseVector x) => x n e -> Diag x (n,n) e
+diagFromVector = Diag . coerceVector
 
-instance (BLAS1 e) => Scalable (DiagMatrix Imm (n,n)) e where
-    (*>) k (Diag x) = Diag $ k *> x
+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
 
-replaceHelp :: (BLAS1 e) => 
-       (Vector n e -> [(Int,e)] -> Vector n e) 
-    -> Diag (n,n) e -> [((Int,Int),e)] -> Diag (n,n) e
-replaceHelp f a ijes =
-    let iies = filter (\((i,j),_) -> i == j) ijes
-        ies  = map (\((i,_),e) -> (i,e)) iies
-        x'   = f (toVector a) ies
-    in fromVector x'
-    
+instance (BaseVector x) => BLAS.BaseMatrix (Diag x) where
+    herm (Diag x) = Diag (conj x)
     
-instance (BLAS1 e) => ITensor (DiagMatrix Imm (n,n)) (Int,Int) e where
-    size = size . toVector
+        
+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 $ toVector a
+        let ies = assocs $ vectorFromDiag $ coerceDiag a
         in map (\(i,e) -> ((i,i),e)) ies
     
     (//) = replaceHelp (//)
     
-    amap f a = fromVector (amap f $ toVector a)
+    tmap f a = (coerceDiag . diagFromVector) 
+                   (tmap f $ vectorFromDiag $ coerceDiag a)
     
     unsafeAt a (i,j) | i /= j = 0
-                     | otherwise = unsafeAt (toVector a) i
+                     | 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) => RTensor (DiagMatrix t (n,n)) (Int,Int) e IO where
+    
+instance (BLAS1 e) => ReadTensor (Diag Vector) (Int,Int) e IO where
     getSize = getSize . toVector
     
     newCopy a = do
@@ -100,6 +222,7 @@
         | 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
@@ -112,69 +235,4 @@
     
     modifyWith f a = modifyWith f (toVector a)
     
-        
-instance Base.Matrix (DiagMatrix t) where
-    numRows (Diag x) = dim x
-    numCols = numRows
-
-    herm (Diag x) = unsafeCoerce $ Diag (conj x)
-
-
-instance (BLAS2 e) => IMatrix (DiagMatrix Imm) e
-
-instance (BLAS2 e) => RMatrix (DiagMatrix t) e where
-    unsafeDoSApplyAdd alpha a x beta y = do
-        x' <- newCopy x
-        unsafeDoSApply_ 1 (coerceDiag a) (V.unsafeThaw x')
-        scaleBy beta y
-        V.unsafeAxpy alpha x' (V.coerceVector y)
-
-    unsafeDoSApplyAddMat alpha a b beta c = do
-        M.scaleBy beta c
-        ks <- unsafeInterleaveIO $ getElems (toVector $ coerceDiag a)
-        let (kxs) = zip ks (rows b)
-            ys    = rows c
-        zipWithM_ (\(k,x) y -> V.unsafeAxpy (alpha*k) x y) kxs ys
-
-    unsafeDoSApply_ alpha a x = do
-        V.unsafeTimesEquals x (toVector a)
-        V.scaleBy alpha x
-
-    unsafeDoSApplyMat_ alpha a b = do
-        ks <- unsafeInterleaveIO $ getElems (toVector a)
-        zipWithM_ (\k r -> scaleBy (alpha*k) r) ks (rows b)
-
-
-instance (BLAS2 e) => ISolve (DiagMatrix Imm) e
-
-
-instance (BLAS2 e) => RSolve (DiagMatrix Imm) e where
-    unsafeDoSSolve alpha a y x = do
-        unsafeCopyVector x (unsafeCoerce y)
-        unsafeDoSSolve_ alpha (coerceDiag a) x
-        
-    unsafeDoSSolveMat alpha a c b = do
-        unsafeCopyMatrix b (unsafeCoerce c)
-        unsafeDoSSolveMat_ alpha (coerceDiag a) b
-    
-    unsafeDoSSolve_ alpha a x = do
-        V.scaleBy alpha x
-        x //= (toVector a)
-
-    unsafeDoSSolveMat_ alpha a b = do
-        M.scaleBy alpha b
-        ks <- unsafeInterleaveIO $ getElems (toVector a)
-        zipWithM_ (\k r -> invScaleBy k r) ks (rows b)
-
-
-instance (Show e, BLAS1 e) => Show (DiagMatrix Imm (n,n) e) where
-    show (Diag x) = "fromVector (" ++ show x ++ ")"
-
-
-instance (Eq e, BLAS1 e) => Eq (DiagMatrix Imm (n,n) e) where
-    (==) (Diag x) (Diag y) = (==) x y
-
-
-instance (AEq e, BLAS1 e) => AEq (DiagMatrix Imm (n,n) e) where
-    (===) (Diag x) (Diag y) = (===) x y
-    (~==) (Diag x) (Diag y) = (~==) x y
+-}
diff --git a/Data/Matrix/Herm.hs b/Data/Matrix/Herm.hs
--- a/Data/Matrix/Herm.hs
+++ b/Data/Matrix/Herm.hs
@@ -23,11 +23,29 @@
 
     ) 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(..) )
+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
@@ -48,9 +66,11 @@
 hermU :: a (n,n) e -> Herm a (n,n) e
 hermU = Herm Upper
       
-instance Matrix a => Matrix (Herm a) where
-    numRows (Herm _ a) = numRows a
-    numCols (Herm _ a) = numCols a
+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
@@ -59,3 +79,158 @@
         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'
+
diff --git a/Data/Matrix/Herm/Banded.hs b/Data/Matrix/Herm/Banded.hs
deleted file mode 100644
--- a/Data/Matrix/Herm/Banded.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module     : Data.Matrix.Herm.Banded
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Data.Matrix.Herm.Banded (
-    module Data.Matrix.Herm,
-    module BLAS.Matrix.Immutable,
-    module BLAS.Matrix.ReadOnly,
-    ) where
-
-import Control.Monad ( zipWithM_ )
-
-import BLAS.Access
-import BLAS.C ( BLAS2, colMajor, cblasUpLo )
-import BLAS.Types ( flipUpLo )
-import qualified BLAS.C as BLAS
-
-import Data.Matrix.Banded.Internal
-import Data.Matrix.Dense.Internal ( DMatrix, IOMatrix, coerceMatrix )
-import Data.Vector.Dense.Internal
-import qualified Data.Matrix.Banded.Internal as B
-import qualified Data.Matrix.Dense.Internal as M
-import qualified Data.Vector.Dense.Internal as V
-import qualified Data.Vector.Dense.Operations as V
-
-import Data.Matrix.Herm
-import BLAS.Matrix.Immutable
-import BLAS.Matrix.ReadOnly
-
-instance (BLAS2 e) => IMatrix (Herm (BMatrix Imm)) e where
-
-instance (BLAS2 e) => RMatrix (Herm (BMatrix s)) e where
-    unsafeDoSApplyAdd alpha a x beta y = 
-        hbmv alpha (coerceHerm a) x beta (coerceVector y)
-        
-    unsafeDoSApplyAddMat alpha a b beta c = 
-        hbmm alpha (coerceHerm a) b beta (coerceMatrix c)
-
-
-hbmv :: (BLAS2 e) => e -> Herm (BMatrix t) (n,n) e -> DVector s n e -> e -> IOVector n e -> IO ()
-hbmv alpha h x beta y
-    | numRows h == 0 =
-        return ()
-    | isConj y = do
-        V.doConj y
-        hbmv alpha h x beta (V.conj y)
-        V.doConj y
-    | isConj x = do
-        x' <- newCopy x
-        V.doConj (V.unsafeThaw 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 (isHerm a) of
-                        True  -> flipUpLo u
-                        False -> u
-            uploA = cblasUpLo u'
-            ldA   = ldaOf a
-            incX  = strideOf x
-            incY  = strideOf y
-            withPtrA 
-                  = case u' of Upper -> B.unsafeWithBasePtr a
-                               Lower -> B.unsafeWithElemPtr a (0,0)
-                    
-        in withPtrA $ \pA ->
-               V.unsafeWithElemPtr x 0 $ \pX ->
-                    V.unsafeWithElemPtr y 0 $ \pY -> do
-                        BLAS.hbmv order uploA n k alpha pA ldA pX incX beta pY incY
-
-
-hbmm :: (BLAS2 e) => e -> Herm (BMatrix t) (m,m) e -> DMatrix s (m,n) e -> e -> IOMatrix (m,n) e -> IO ()
-hbmm alpha h b beta c =
-    zipWithM_ (\x y -> hbmv alpha h x beta y) (M.cols b) (M.cols c)
diff --git a/Data/Matrix/Herm/Dense.hs b/Data/Matrix/Herm/Dense.hs
deleted file mode 100644
--- a/Data/Matrix/Herm/Dense.hs
+++ /dev/null
@@ -1,94 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module     : Data.Matrix.Herm.Dense
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Data.Matrix.Herm.Dense (
-    module Data.Matrix.Herm,
-    module BLAS.Matrix.Immutable,
-    module BLAS.Matrix.ReadOnly,
-    ) where
-
-import Control.Monad ( zipWithM_ )
-
-import BLAS.Access
-import BLAS.C ( BLAS2, BLAS3, colMajor, rightSide, leftSide, cblasUpLo )
-import BLAS.Types ( flipUpLo )
-import qualified BLAS.C as BLAS
-
-import Data.Matrix.Dense.Internal
-import Data.Vector.Dense.Internal
-import qualified Data.Matrix.Dense.Internal as M
-import qualified Data.Vector.Dense.Internal as V
-import qualified Data.Vector.Dense.Operations as V
-
-import Data.Matrix.Herm
-import BLAS.Matrix.Immutable
-import BLAS.Matrix.ReadOnly
-
-
-instance (BLAS3 e) => IMatrix (Herm (DMatrix Imm)) e where
-
-instance (BLAS3 e) => RMatrix (Herm (DMatrix s)) e where
-    unsafeDoSApplyAdd alpha a x beta y = 
-        hemv alpha (coerceHerm a) x beta (coerceVector y)
-        
-    unsafeDoSApplyAddMat alpha a b beta c = 
-        hemm alpha (coerceHerm a) b beta (coerceMatrix c)
-
-
-hemv :: (BLAS2 e) => e -> Herm (DMatrix t) (n,n) e -> DVector s n e -> e -> IOVector n e -> IO ()
-hemv alpha h x beta y
-    | numRows h == 0 =
-        return ()
-    | isConj y = do
-        V.doConj y
-        hemv alpha h x beta (V.conj y)
-        V.doConj y
-    | isConj x = do
-        x' <- newCopy x
-        V.doConj (V.unsafeThaw x')
-        hemv alpha h (conj x') beta y
-    | otherwise =
-        let order = colMajor
-            (u,a) = toBase h
-            n     = numCols a
-            u'    = case isHerm a of
-                        True  -> flipUpLo u
-                        False -> u
-            uploA = cblasUpLo u'
-            ldA   = ldaOf a
-            incX  = strideOf x
-            incY  = strideOf y
-        in M.unsafeWithElemPtr a (0,0) $ \pA ->
-               V.unsafeWithElemPtr x 0 $ \pX ->
-                    V.unsafeWithElemPtr y 0 $ \pY -> do
-                        BLAS.hemv order uploA n alpha pA ldA pX incX beta pY incY
-
-hemm :: (BLAS3 e) => e -> Herm (DMatrix t) (m,m) e -> DMatrix s (m,n) e -> e -> IOMatrix (m,n) e -> IO ()
-hemm alpha h b beta c
-    | numRows b == 0 || numCols b == 0 || numCols c == 0 = return ()
-    | (isHerm a) /= (isHerm c) || (isHerm a) /= (isHerm b) =
-        zipWithM_ (\x y -> hemv alpha h x beta y) (cols b) (cols c)
-    | otherwise =
-        let order   = colMajor
-            (m,n)   = shape c
-            (side,u',m',n')
-                    = if isHerm a
-                          then (rightSide, flipUpLo u, n, m)
-                          else (leftSide,  u,          m, n)
-            uploA   = cblasUpLo u'
-            ldA     = ldaOf a
-            ldB     = ldaOf b
-            ldC     = ldaOf c
-        in M.unsafeWithElemPtr a (0,0) $ \pA ->
-               M.unsafeWithElemPtr b (0,0) $ \pB ->
-                   M.unsafeWithElemPtr c (0,0) $ \pC ->
-                       BLAS.hemm order side uploA m' n' alpha pA ldA pB ldB beta pC ldC
-    where
-      (u,a) = toBase h
diff --git a/Data/Matrix/Perm.hs b/Data/Matrix/Perm.hs
--- a/Data/Matrix/Perm.hs
+++ b/Data/Matrix/Perm.hs
@@ -9,11 +9,7 @@
 --
 
 module Data.Matrix.Perm (
-    module BLAS.Matrix.Base,
-    module BLAS.Matrix.Immutable,
-    module BLAS.Matrix.ReadOnly,
-    module BLAS.Matrix.Solve.Immutable,
-    module BLAS.Matrix.Solve.ReadOnly,
+    module BLAS.Matrix,
 
     Perm(..),
     
@@ -30,20 +26,23 @@
     ) where
 
 import Control.Monad ( forM_ )
-import Foreign ( peek, poke )
+import Data.AEq
 
-import BLAS.Elem ( Elem, BLAS1 )
-import qualified BLAS.Elem as E
+import BLAS.Elem
+import BLAS.Matrix
+import BLAS.Tensor
+import BLAS.UnsafeIOToM
 
-import BLAS.Matrix.Base hiding ( Matrix )
-import qualified BLAS.Matrix.Base as Base
-import BLAS.Matrix.Immutable
-import BLAS.Matrix.ReadOnly
-import BLAS.Matrix.Solve.Immutable
-import BLAS.Matrix.Solve.ReadOnly
+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.AEq
+{-
 
+
 import Data.Vector.Dense.IO ( dim, isConj, conj, unsafeSwapVectors, 
     unsafeCopyVector, unsafeWithElemPtr, unsafeReadElem, unsafeWriteElem, 
     coerceVector )
@@ -51,6 +50,7 @@
     
 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
@@ -77,89 +77,108 @@
 coercePerm :: Perm mn e -> Perm mn' e
 coercePerm = unsafeCoerce
 
-          
-instance Base.Matrix Perm where
-    numRows (P sigma _) = P.size sigma
-    numRows (I n)       = n
+instance BaseTensor Perm (Int,Int) where
+    shape (P sigma _) = (n,n) where n = P.size sigma
+    shape (I n)       = (n,n)
     
-    numCols a = numRows a
+    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 _)   = (unsafeCoerce a)
+    herm a@(I _)   = coercePerm a
 
 
+{-          
 instance (BLAS1 e) => IMatrix Perm e where
-          
-         
 instance (BLAS1 e) => RMatrix Perm e where
-    unsafeDoApply_   (I _)   _ = return ()
-    unsafeDoApply_ p@(P _ _) x
-        | isHerm p  = P.invertWith swap sigma
-        | otherwise = P.applyWith swap sigma
-      where
-        sigma = baseOf p
-        swap i j = 
-            unsafeWithElemPtr x i $ \pI ->
-                unsafeWithElemPtr x j $ \pJ -> do
-                    xi <- peek pI
-                    xj <- peek pJ
-                    poke pI xj
-                    poke pJ xi
 
+-}
 
-    unsafeDoApplyMat_   (I _)   _ = return ()
-    unsafeDoApplyMat_ p@(P _ _) a
-        | isHerm p  = P.invertWith swap sigma
-        | otherwise = P.applyWith swap sigma
-      where
-        sigma = baseOf p
-        swap i j = unsafeSwapVectors (unsafeRow a i) (unsafeRow a j)
+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_
 
-    unsafeDoSApply k (I _) x y = do
-        unsafeCopyVector y (coerceVector x)
-        V.scaleBy k y
-    unsafeDoSApply k p x y
-        | isConj x =
-            unsafeDoSApply (E.conj k) p (conj x) (conj y)
-        | otherwise =
-            let n     = dim x
-                sigma = baseOf p
-            in do
-                forM_ [0..(n-1)] $ \i ->
-                    let i' = P.unsafeApply sigma i
-                    in case (isHerm p) of
-                           False -> unsafeReadElem x i  
-                                    >>= unsafeWriteElem y i'
-                           True  -> unsafeReadElem x i' 
-                                    >>= unsafeWriteElem y i
-                V.scaleBy k y
 
+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
 
-    unsafeDoSApplyMat alpha (I _) b c = do
-        unsafeCopyMatrix c (coerceMatrix b)
-        M.scaleBy alpha c
-    unsafeDoSApplyMat alpha p b c =
-        let m     = numCols p
+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
-            forM_ [0..(m-1)] $ \i ->
+            scaleBy beta y
+            forM_ [0..(n-1)] $ \i ->
                 let i' = P.unsafeApply sigma i
                 in case (isHerm p) of
-                       False -> unsafeCopyVector (unsafeRow c i') 
-                                                 (unsafeRow b i)
-                       True  -> unsafeCopyVector (unsafeRow c i)
-                                                 (unsafeRow b i')
-            M.scaleBy alpha c
+                       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) => RSolve Perm e where    
-    unsafeDoSolve_ p          = unsafeDoApply_ (herm p)
-    unsafeDoSolveMat_ p       = unsafeDoApplyMat_ (herm p)
-    unsafeDoSSolve alpha p    = unsafeDoSApply alpha (coercePerm $ herm p)
-    unsafeDoSSolveMat alpha p = unsafeDoSApplyMat alpha (coercePerm $ herm p)
+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
@@ -168,7 +187,7 @@
            | otherwise = "fromPermutation (" ++ show (baseOf p) ++ ")"
     
     
-instance (Elem e) => Eq (Perm (n,n) e) where
+instance Eq (Perm (n,n) e) where
     (==) (I n) (I n') = n == n'
     (==) (I n) p
         | isHerm p   = (==) (I n) (herm p)
@@ -181,7 +200,7 @@
                       && sigma == (P.inverse sigma')
 
 
-instance (Elem e) => AEq (Perm (n,n) e) where
+instance AEq (Perm (n,n) e) where
     (===) = (==)
     (~==) = (==)
     
diff --git a/Data/Matrix/Tri.hs b/Data/Matrix/Tri.hs
--- a/Data/Matrix/Tri.hs
+++ b/Data/Matrix/Tri.hs
@@ -33,16 +33,39 @@
     upperUTall,
 
     coerceTri,
-
+    
+    module BLAS.Matrix,
     ) where
 
-import BLAS.Internal ( checkSquare, checkFat, checkTall )
 import BLAS.Matrix
-import BLAS.Tensor
-import BLAS.Types ( UpLo(..), Diag(..), flipUpLo )
 
+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.
@@ -59,57 +82,57 @@
 toBase (Tri u d a) = (u,d,a)
 
 
-lower :: (Matrix a) => a (n,n) e -> Tri a (n,n) e
+lower :: (BaseMatrix a) => a (n,n) e -> Tri a (n,n) e
 lower a = checkSquare (shape a) $ Tri Lower NonUnit a
 
-lowerFat :: (Matrix a) => a (m,n) e -> Tri a (m,m) e
+lowerFat :: (BaseMatrix a) => a (m,n) e -> Tri a (m,m) e
 lowerFat a = checkFat (shape a) $ Tri Lower NonUnit (unsafeCoerce a)
 
-lowerTall :: (Matrix a) => a (m,n) e -> Tri a (m,n) e
+lowerTall :: (BaseMatrix a) => a (m,n) e -> Tri a (m,n) e
 lowerTall a = checkTall (shape a) $ Tri Lower NonUnit a
 
 
-lowerU :: (Matrix a) => a (n,n) e -> Tri a (n,n) e
+lowerU :: (BaseMatrix a) => a (n,n) e -> Tri a (n,n) e
 lowerU a = checkSquare (shape a) $ Tri Lower Unit a
 
-lowerUFat :: (Matrix a) => a (m,n) e -> Tri a (m,m) e
+lowerUFat :: (BaseMatrix a) => a (m,n) e -> Tri a (m,m) e
 lowerUFat a = checkFat (shape a) $ Tri Lower Unit (unsafeCoerce a)
 
-lowerUTall :: (Matrix a) => a (m,n) e -> Tri a (m,n) e
+lowerUTall :: (BaseMatrix a) => a (m,n) e -> Tri a (m,n) e
 lowerUTall a = checkTall (shape a) $ Tri Lower Unit a
 
 
-upper :: (Matrix a) => a (n,n) e -> Tri a (n,n) e
+upper :: (BaseMatrix a) => a (n,n) e -> Tri a (n,n) e
 upper a = checkSquare (shape a) $ Tri Upper NonUnit a
 
-upperFat :: (Matrix a) => a (m,n) e -> Tri a (m,n) e
+upperFat :: (BaseMatrix a) => a (m,n) e -> Tri a (m,n) e
 upperFat a = checkFat (shape a) $ Tri Upper NonUnit a
 
-upperTall :: (Matrix a) => a (m,n) e -> Tri a (n,n) e
+upperTall :: (BaseMatrix a) => a (m,n) e -> Tri a (n,n) e
 upperTall a = checkTall (shape a) $ Tri Upper NonUnit (unsafeCoerce a)
 
 
-upperU :: (Matrix a) => a (n,n) e -> Tri a (n,n) e
+upperU :: (BaseMatrix a) => a (n,n) e -> Tri a (n,n) e
 upperU a = checkSquare (shape a) $ Tri Upper Unit a
 
-upperUFat :: (Matrix a) => a (m,n) e -> Tri a (m,n) e
+upperUFat :: (BaseMatrix a) => a (m,n) e -> Tri a (m,n) e
 upperUFat a = checkFat (shape a) $ Tri Upper Unit a
 
-upperUTall :: (Matrix a) => a (m,n) e -> Tri a (n,n) e
+upperUTall :: (BaseMatrix a) => a (m,n) e -> Tri a (n,n) e
 upperUTall a = checkTall (shape a) $ Tri Upper Unit (unsafeCoerce a)
 
       
-instance Matrix a => Matrix (Tri a) where
-    numRows (Tri Lower _ a) = numRows a
-    numRows (Tri Upper _ a) = min (numRows a) (numCols 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)
     
-    numCols (Tri Lower _ a) = min (numRows a) (numCols a)
-    numCols (Tri Upper _ 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), Matrix a) => Show (Tri a (m,n) e) where
+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
@@ -123,3 +146,508 @@
                        _ | 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
diff --git a/Data/Matrix/Tri/Banded.hs b/Data/Matrix/Tri/Banded.hs
deleted file mode 100644
--- a/Data/Matrix/Tri/Banded.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module     : Data.Matrix.Tri.Banded
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Data.Matrix.Tri.Banded (
-    module Data.Matrix.Tri,
-    module BLAS.Matrix.Immutable,
-    module BLAS.Matrix.ReadOnly,
-    module BLAS.Matrix.Solve,
-    ) where
-
-
-import Data.Matrix.Banded.Internal
-import qualified Data.Matrix.Banded.Internal as B
-import Data.Matrix.Dense.IO ( IOMatrix, coerceMatrix, unsafeCopyMatrix )
-import qualified Data.Matrix.Dense.IO as M
-import Data.Vector.Dense.IO ( IOVector, isConj, strideOf, conj, coerceVector, 
-    unsafeCopyVector )
-import qualified Data.Vector.Dense.IO as V
-
-import BLAS.Access
-import BLAS.Types ( flipUpLo )
-
-import BLAS.C ( BLAS2, cblasDiag, cblasUpLo, colMajor, noTrans, conjTrans )                                   
-import qualified BLAS.C as BLAS
-
-import BLAS.Matrix.Immutable
-import BLAS.Matrix.ReadOnly
-import BLAS.Matrix.Solve
-
-import Data.Matrix.Tri
-
-instance (BLAS2 e) => IMatrix (Tri (BMatrix Imm)) e where
-
-instance (BLAS2 e) => RMatrix (Tri (BMatrix s)) e where
-
-    unsafeDoSApply alpha a x y = do
-        unsafeCopyVector (coerceVector y) x
-        unsafeDoSApply_ alpha (coerceTri a) y
-    
-    unsafeDoSApplyMat alpha a b c = do
-        unsafeCopyMatrix (coerceMatrix c) b
-        unsafeDoSApplyMat_ alpha (coerceTri a) c
-        
-    unsafeDoSApply_    = tbmv
-    unsafeDoSApplyMat_ = tbmm
-
-instance (BLAS2 e) => ISolve (Tri (BMatrix Imm)) e where
-
-instance (BLAS2 e) => RSolve (Tri (BMatrix s)) e where
-    unsafeDoSSolve alpha a y x = do
-        unsafeCopyVector (coerceVector x) y
-        unsafeDoSSolve_ alpha (coerceTri a) x
-    
-    unsafeDoSSolveMat alpha a c b = do
-        unsafeCopyMatrix (coerceMatrix b) c
-        unsafeDoSSolveMat_ alpha (coerceTri a) b
-
-    unsafeDoSSolve_    = tbsv
-    unsafeDoSSolveMat_ = tbsm
-
-
-tbmv :: (BLAS2 e) => e -> Tri (BMatrix t) (n,n) e -> IOVector n e -> IO ()
-tbmv alpha t x | isConj x = do
-    V.doConj x
-    tbmv alpha t (conj x)
-    V.doConj x
-
-tbmv alpha t x =
-    let (u,d,a) = toBase t
-        order     = colMajor
-        (transA,u') = if isHerm 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       = ldaOf a
-        incX      = strideOf x
-        withPtrA  = case u' of 
-                        Upper -> B.unsafeWithBasePtr a
-                        Lower -> B.unsafeWithElemPtr a (0,0)
-    in withPtrA $ \pA ->
-           V.unsafeWithElemPtr x 0 $ \pX -> do
-               V.scaleBy alpha x
-               BLAS.tbmv order uploA transA diagA n k pA ldA pX incX
-              
-               
-tbmm :: (BLAS2 e) => e -> Tri (BMatrix t) (m,m) e -> IOMatrix (m,n) e -> IO ()
-tbmm 1     t b = mapM_ (\x -> tbmv 1 t x) (M.cols b)
-tbmm alpha t b = M.scaleBy alpha b >> tbmm 1 t b
-
-
-tbsv :: (BLAS2 e) => e -> Tri (BMatrix t) (n,n) e -> IOVector n e -> IO ()
-tbsv alpha t x | isConj x = do
-    V.doConj x
-    tbsv alpha t (conj x)
-    V.doConj x
-    
-tbsv alpha t x = 
-    let (u,d,a) = toBase t
-        order     = colMajor
-        (transA,u') = if isHerm 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       = ldaOf a
-        incX      = strideOf x
-        withPtrA  = case u' of 
-                        Upper -> B.unsafeWithBasePtr a
-                        Lower -> B.unsafeWithElemPtr a (0,0)
-    in withPtrA $ \pA ->
-           V.unsafeWithElemPtr x 0 $ \pX -> do
-               V.scaleBy alpha x
-               BLAS.tbsv order uploA transA diagA n k pA ldA pX incX
-
-
-tbsm :: (BLAS2 e) => e -> Tri (BMatrix t) (m,m) e -> IOMatrix (m,n) e -> IO ()
-tbsm 1     t b = mapM_ (\x -> tbsv 1 t x) (M.cols b)
-tbsm alpha t b = M.scaleBy alpha b >> tbsm 1 t b
diff --git a/Data/Matrix/Tri/Dense.hs b/Data/Matrix/Tri/Dense.hs
deleted file mode 100644
--- a/Data/Matrix/Tri/Dense.hs
+++ /dev/null
@@ -1,286 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module     : Data.Matrix.Tri.Dense
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Data.Matrix.Tri.Dense (
-    module Data.Matrix.Tri,
-    module BLAS.Matrix.Immutable,
-    module BLAS.Matrix.ReadOnly,
-    module BLAS.Matrix.Solve,
-
-    trmv,
-    trsv,
-    trmm,    
-    trsm,
-    
-    ) where
-
-import Control.Monad ( when )
-import Data.Maybe ( fromJust )
-
-import Data.Matrix.Dense.Internal hiding ( diag )
-import qualified Data.Matrix.Dense.Internal as M
-import qualified Data.Matrix.Dense.Operations as M
-import Data.Vector.Dense.Internal
-import Data.Vector.Dense.Operations( unsafeCopyVector )
-import Data.Matrix.Dense.Operations( unsafeCopyMatrix )
-import qualified Data.Vector.Dense.Internal as V
-import qualified Data.Vector.Dense.Operations as V
-
-import BLAS.Access
-import BLAS.Elem ( Elem, BLAS3 )
-import qualified BLAS.Elem as E
-import BLAS.C.Types ( cblasDiag, cblasUpLo, cblasTrans, colMajor, 
-    noTrans, conjTrans, leftSide, rightSide )
-import BLAS.Types ( Trans(..), flipTrans, flipUpLo )
-                                   
-import qualified BLAS.C as BLAS
-import qualified BLAS.C.Types as BLAS
-
-import BLAS.Matrix.Immutable
-import BLAS.Matrix.ReadOnly
-import BLAS.Matrix.Solve
-
-import Data.Matrix.Tri
-
-instance (BLAS3 e) => IMatrix (Tri (DMatrix Imm)) e where
-instance (BLAS3 e) => ISolve (Tri (DMatrix Imm)) e where
-
-
-toLower :: (Elem e) => Diag -> DMatrix s (m,n) e 
-        -> Either (Tri (DMatrix s) (m,m) e) 
-                  (Tri (DMatrix s) (n,n) e, DMatrix s (d,n) e)
-toLower diag a =
-    if m <= n
-        then Left $  fromBase Lower diag (unsafeSubmatrix a (0,0) (m,m))
-        else let t = fromBase Lower diag (unsafeSubmatrix a (0,0) (n,n))
-                 r = unsafeSubmatrix a (n,0) (d,n)
-             in Right (t,r)
-  where
-    (m,n) = shape a
-    d     = m - n
-    
-toUpper :: (Elem e) => Diag -> DMatrix s (m,n) e
-        -> Either (Tri (DMatrix s) (n,n) e)
-                  (Tri (DMatrix s) (m,m) e, DMatrix s (m,d) e)
-toUpper diag a =
-    if n <= m
-        then Left $  fromBase Upper diag (unsafeSubmatrix a (0,0) (n,n))
-        else let t = fromBase Upper diag (unsafeSubmatrix a (0,0) (m,m))
-                 r = unsafeSubmatrix a (0,m) (m,d)
-             in Right (t,r)
-  where
-    (m,n) = shape a
-    d     = n - m
-
-
-instance (BLAS3 e) => RMatrix (Tri (DMatrix s)) e where
-    unsafeDoSApply_    = trmv
-    unsafeDoSApplyMat_ = trmm
-    
-    unsafeDoSApply 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
-                unsafeDoSApply alpha r x 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
-
-
-    unsafeDoSApplyMat 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 = unsafeSubmatrix c (0,0)          (numRows t',numCols c)
-                    c2 = unsafeSubmatrix c (numRows t',0) (numRows r ,numCols c)
-                unsafeCopyMatrix c1 b
-                trmm alpha t' c1
-                unsafeDoSApplyMat alpha r b c2
-                
-            (Upper,_,Left t') -> do
-                unsafeCopyMatrix (coerceMatrix c) b
-                trmm alpha t' (coerceMatrix c)
-
-            (Upper,_,Right (t',r)) ->
-                let b1 = unsafeSubmatrix b (0,0)          (numCols t',numCols b)
-                    b2 = unsafeSubmatrix 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
-        
-    
-instance (BLAS3 e) => RSolve (Tri (DMatrix s)) e where
-    unsafeDoSSolve_    = trsv
-    unsafeDoSSolveMat_ = trsm
-
-    unsafeDoSSolve 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
-
-
-    unsafeDoSSolveMat 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 = unsafeSubmatrix 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 = unsafeSubmatrix b (0,0)          (numCols t',numCols b)
-                    b2 = unsafeSubmatrix 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
-
-
-trmv :: (BLAS3 e) => e -> Tri (DMatrix t) (n,n) e -> IOVector n e -> IO ()
-trmv alpha t x 
-    | dim x == 0 = 
-        return ()
-    | isConj x =
-        let b = fromJust $ maybeFromCol x
-        in trmm alpha t b
-    | otherwise =
-        let (u,d,a)   = toBase t
-            order     = colMajor
-            (transA,u') = if isHerm a then (conjTrans, flipUpLo u) else (noTrans, u)
-            uploA     = cblasUpLo u'
-            diagA     = cblasDiag d
-            n         = dim x
-            ldA       = ldaOf a
-            incX      = strideOf x
-        in M.unsafeWithElemPtr a (0,0) $ \pA ->
-               V.unsafeWithElemPtr x 0 $ \pX -> do
-                   when (alpha /= 1) $ V.scaleBy alpha x
-                   BLAS.trmv order uploA transA diagA n pA ldA pX incX
-
-               
-trmm :: (BLAS3 e) => e -> Tri (DMatrix t) (m,m) e -> IOMatrix (m,n) e -> IO ()
-trmm _ _ b
-    | M.numRows b == 0 || M.numCols b == 0 = return ()
-trmm alpha t b =
-    let (u,d,a)   = toBase t
-        order     = colMajor
-        (h,u')    = if isHerm a then (ConjTrans, flipUpLo u) else (NoTrans, u)
-        (m,n)     = shape b
-        (side,h',m',n',alpha')
-                  = if M.isHerm b
-                        then (rightSide, flipTrans h, n, m, E.conj alpha)
-                        else (leftSide , h          , m, n, alpha       )
-        uploA     = cblasUpLo u'
-        transA    = cblasTrans h'
-        diagA     = cblasDiag d
-        ldA       = ldaOf a
-        ldB       = ldaOf b
-    in M.unsafeWithElemPtr a (0,0) $ \pA ->
-           M.unsafeWithElemPtr b (0,0) $ \pB ->
-               BLAS.trmm order side uploA transA diagA m' n' alpha' pA ldA pB ldB
-
-
-trsv :: (BLAS3 e) => e -> Tri (DMatrix t) (n,n) e -> IOVector n e -> IO ()
-trsv _ _ x
-    | dim x == 0 = return ()
-trsv alpha t x
-    | isConj x =
-        let b = fromJust $ maybeFromCol x
-        in trsm alpha t b
-trsv alpha t x =
-    let (u,d,a) = toBase t
-        order     = colMajor
-        (transA,u') = if isHerm a then (conjTrans, flipUpLo u) else (noTrans, u)
-        uploA     = cblasUpLo u'
-        diagA     = cblasDiag d
-        n         = dim x
-        ldA       = ldaOf a
-        incX      = strideOf x
-    in M.unsafeWithElemPtr a (0,0) $ \pA ->
-           V.unsafeWithElemPtr x 0 $ \pX -> do
-               when (alpha /= 1) $ V.scaleBy alpha x
-               BLAS.trsv order uploA transA diagA n pA ldA pX incX
-
-
-trsm :: (BLAS3 e) => e -> Tri (DMatrix t) (m,m) e -> IOMatrix (m,n) e -> IO ()
-trsm _ _ b
-    | M.numRows b == 0 || M.numCols b == 0 = return ()
-trsm alpha t b =
-    let (u,d,a)   = toBase t
-        order     = colMajor
-        (h,u')    = if isHerm a then (ConjTrans, flipUpLo u) else (NoTrans, u)
-        (m,n)     = shape b
-        (side,h',m',n',alpha')
-                  = if isHerm b
-                        then (rightSide, flipTrans h, n, m, E.conj alpha)
-                        else (leftSide , h          , m, n, alpha       )
-        uploA     = cblasUpLo u'
-        transA    = cblasTrans h'
-        diagA     = cblasDiag d
-        ldA       = ldaOf a
-        ldB       = ldaOf b
-    in M.unsafeWithElemPtr a (0,0) $ \pA ->
-           M.unsafeWithElemPtr b (0,0) $ \pB -> do
-               BLAS.trsm order side uploA transA diagA m' n' alpha' pA ldA pB ldB
-
-               
diff --git a/Data/Vector/Dense.hs b/Data/Vector/Dense.hs
--- a/Data/Vector/Dense.hs
+++ b/Data/Vector/Dense.hs
@@ -1,135 +1,50 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# OPTIONS_HADDOCK prune #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Data.Vector.Dense
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
 -- License    : BSD3
 -- Maintainer : Patrick Perry <patperry@stanford.edu>
 -- Stability  : experimental
 --
-module Data.Vector.Dense (
-    Vector,
-    module BLAS.Vector,
-    module BLAS.Tensor.Base,
-    module BLAS.Tensor.Dense.Immutable,
-    module BLAS.Tensor.Immutable,
-    module BLAS.Tensor.Scalable,
 
-    -- * Creating vectors
-    vector, 
-    listVector,
-
-    -- * Special vectors
-    basis,
-
-    -- * Augmenting vectors
-    subvector,
-    subvectorWithStride,
-
-    -- * Norms and dot product
-    sumAbs,
-    norm2,
-    whichMaxAbs,
-    (<.>),
-
-    -- * Vector arithmetic
-    shift,
-    scale,
-    invScale,
+module Data.Vector.Dense (
+    module Data.Vector.Dense.Internal,
 
-    -- * Converting to and from lists
-    toList,
-    fromList,
-    
-    -- * Casting vectors
-    coerceVector,
+    -- * Converting between mutable and immutable vectors
+    UnsafeFreezeVector(..),
+    UnsafeThawVector(..),
+    freezeVector,
+    thawVector,
     
-    -- * Unsafe operations
-    unsafeVector,
-    unsafeSubvector,
-    unsafeSubvectorWithStride,
     ) where
 
-import System.IO.Unsafe           
-
-import Data.Vector.Dense.Internal 
-import Data.Vector.Dense.Operations
-
-import BLAS.Access
-import BLAS.Elem ( BLAS1, BLAS2 )
-import BLAS.Vector hiding ( Vector )
-import BLAS.Tensor.Base
-import BLAS.Tensor.Dense.Immutable
-import BLAS.Tensor.Immutable
-import BLAS.Tensor.Scalable
-
-
--- | 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 = unsafeFreeze $ 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 = unsafeFreeze $ unsafePerformIO $ unsafeNewVector n ies
-{-# NOINLINE unsafeVector #-}
-
--- | Create a vector of the given dimension with elements initialized
--- to the values from the list.
-listVector :: (BLAS1 e) => Int -> [e] -> Vector n e
-listVector n es = unsafePerformIO $ newListVector n es
-{-# NOINLINE listVector #-}
-
--- | @basis n i@ creates a vector of dimension @n@ with zeros everywhere but
--- position @i@, where there is a one.
-basis :: (BLAS1 e) => Int -> Int -> Vector n e
-basis n i = unsafeFreeze $ unsafePerformIO $ newBasis n i
-{-# NOINLINE basis #-}
-
--- | Convert a vector to a list.  Same as @elems@.
-toList :: (BLAS1 e) => Vector n e -> [e]
-toList = elems
+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
 
--- | Convert a list to a vector.  @fromList xs = listVector (length xs) xs@.
-fromList :: (BLAS1 e) => [e] -> Vector n e
-fromList es = listVector (length es) es
-{-# INLINE fromList #-}
+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
 
-instance (BLAS1 e) => Scalable (DVector Imm n) e where
-    (*>) = scale
-        
-instance (BLAS2 e) => Num (DVector Imm n e) where
-    (+)         = plus
-    (-)         = minus
-    (*)         = times
-    negate      = (*>) (-1)
-    abs         = amap abs
-    signum      = amap signum
-    fromInteger = (constant 1) . fromInteger
-    
-instance (BLAS2 e) => Fractional (DVector Imm n e) where
-    (/)          = divide
-    recip        = amap recip
-    fromRational = (constant 1) . fromRational 
-    
-instance (BLAS2 e, Floating e) => Floating (DVector Imm n e) where
-    pi    = constant 1 pi
-    exp   = amap exp
-    sqrt  = amap sqrt
-    log   = amap log
-    (**)  = azipWith (**)
-    sin   = amap sin
-    cos   = amap cos
-    tan   = amap tan
-    asin  = amap asin
-    acos  = amap acos
-    atan  = amap atan
-    sinh  = amap sinh
-    cosh  = amap cosh
-    tanh  = amap tanh
-    asinh = amap asinh
-    acosh = amap acosh
-    atanh = amap atanh
+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
diff --git a/Data/Vector/Dense/Class.hs b/Data/Vector/Dense/Class.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class.hs
@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Vector/Dense/Class/Copying.hs b/Data/Vector/Dense/Class/Copying.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Copying.hs
@@ -0,0 +1,43 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 #-}
+
diff --git a/Data/Vector/Dense/Class/Creating.hs b/Data/Vector/Dense/Class/Creating.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Creating.hs
@@ -0,0 +1,53 @@
+{-# 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
diff --git a/Data/Vector/Dense/Class/Elements.hs b/Data/Vector/Dense/Class/Elements.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Elements.hs
@@ -0,0 +1,17 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Vector/Dense/Class/Internal.hs b/Data/Vector/Dense/Class/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Internal.hs
@@ -0,0 +1,475 @@
+{-# 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
diff --git a/Data/Vector/Dense/Class/Internal/Base.hs b/Data/Vector/Dense/Class/Internal/Base.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Internal/Base.hs
@@ -0,0 +1,56 @@
+{-# 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 #-}
diff --git a/Data/Vector/Dense/Class/Operations.hs b/Data/Vector/Dense/Class/Operations.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Operations.hs
@@ -0,0 +1,191 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Vector/Dense/Class/Properties.hs b/Data/Vector/Dense/Class/Properties.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Properties.hs
@@ -0,0 +1,65 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 #-}
diff --git a/Data/Vector/Dense/Class/Special.hs b/Data/Vector/Dense/Class/Special.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Special.hs
@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 
diff --git a/Data/Vector/Dense/Class/Views.hs b/Data/Vector/Dense/Class/Views.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/Class/Views.hs
@@ -0,0 +1,48 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/Data/Vector/Dense/IO.hs b/Data/Vector/Dense/IO.hs
--- a/Data/Vector/Dense/IO.hs
+++ b/Data/Vector/Dense/IO.hs
@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module     : Data.Vector.Dense.Mutable
+-- Module     : Data.Vector.Dense.IO
 -- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
 -- License    : BSD3
 -- Maintainer : Patrick Perry <patperry@stanford.edu>
@@ -8,55 +8,11 @@
 --
 
 module Data.Vector.Dense.IO (
-    -- * Mutable dense vector data type
+    -- * The IOVector data type
     IOVector,
-    DVector(..),
     
-    module BLAS.Vector,
-    module BLAS.Tensor.Base,
-    module BLAS.Tensor.Dense.ReadOnly,
-    module BLAS.Tensor.ReadOnly,
-    module BLAS.Tensor.Mutable,
-    
-    -- * Creating vectors
-    newVector, 
-    newVector_,
-    newListVector,
-    
-    -- * Special vectors
-    newBasis,
-    setBasis,
-
-    -- * Vector views
-    subvector,
-    subvectorWithStride,
-
-    module Data.Vector.Dense.Operations,
-    
-    -- * Conversion to and from @ForeignPtr@s
-    fromForeignPtr,
-    toForeignPtr,
-    
-    -- * Converting between mutable and immutable vectors
-    unsafeFreeze,
-    unsafeThaw,
-    
-    -- * Casting vectors
-    coerceVector,
-    
-    -- * Unsafe operations
-    unsafeNewVector,
-    unsafeWithElemPtr,
-    unsafeSubvector,
-    unsafeSubvectorWithStride,
-    
+    module Data.Vector.Dense.Class,
     ) where
 
-import Data.Vector.Dense.Internal
-import Data.Vector.Dense.Operations hiding ( axpy, sumAbs, norm2, whichMaxAbs, 
-    (<.>), shift, scale, invScale, plus, minus, times, divide )
-import BLAS.Vector hiding ( Vector )
-import BLAS.Tensor.Base
-import BLAS.Tensor.Dense.ReadOnly
-import BLAS.Tensor.ReadOnly
-import BLAS.Tensor.Mutable
+import Data.Vector.Dense.Class.Internal( IOVector )
+import Data.Vector.Dense.Class
diff --git a/Data/Vector/Dense/Internal.hs b/Data/Vector/Dense/Internal.hs
--- a/Data/Vector/Dense/Internal.hs
+++ b/Data/Vector/Dense/Internal.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE BangPatterns, FlexibleInstances, MultiParamTypeClasses #-}
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Data.Vector.Dense.Internal
@@ -8,388 +7,278 @@
 -- Maintainer : Patrick Perry <patperry@stanford.edu>
 -- Stability  : experimental
 --
-
 module Data.Vector.Dense.Internal (
-    -- * Vector data types
-    Vector,
-    IOVector,
-    DVector(..),
+    -- * The Vector type
+    Vector(..),
 
-    module BLAS.Vector,
-    module BLAS.Tensor,
+    -- * Vector shape
+    dim,
+    coerceVector,
+    module BLAS.Tensor.Base,
 
-    -- * Conversion to and from @ForeignPtr@s.
-    fromForeignPtr,
-    toForeignPtr,
-    
+    -- * Conjugating vectors
+    module BLAS.Conj,
+
     -- * Creating new vectors
-    newVector, 
-    newVector_,
-    newListVector,
-    
+    vector, 
+    listVector,
+    unsafeVector,
+
+    -- * Reading vector elements
+    module BLAS.Tensor.Immutable,
+
     -- * Special vectors
-    newBasis,
-    setBasis,
+    zeroVector,
+    constantVector,
+    basisVector,
 
     -- * Vector views
     subvector,
     subvectorWithStride,
-    
-    -- * Casting vectors
-    coerceVector,
-    
-    -- * Unsafe operations
-    unsafeNewVector,
-    unsafeWithElemPtr,
     unsafeSubvector,
     unsafeSubvectorWithStride,
-    
-    unsafeFreeze,
-    unsafeThaw,
-    
+
+    -- * Vector properties
+    sumAbs,
+    norm2,
+    whichMaxAbs,
+    (<.>),
+
+    -- * Low-level vector properties
+    stride,
+    isConj,
     ) where
-  
-  
-import Control.Monad
-import Data.Ix
-import Foreign 
-import System.IO.Unsafe       
-import Unsafe.Coerce
 
 import Data.AEq
+import System.IO.Unsafe
 
-import BLAS.Access
-import BLAS.Elem.Base ( Elem )
-import qualified BLAS.Elem.Base as E
-import BLAS.Vector hiding ( Vector )
-import qualified BLAS.Vector as C
-import BLAS.Tensor
+import BLAS.Conj
+import BLAS.Tensor.Base
+import BLAS.Tensor.Immutable
 
-import BLAS.Internal  ( clearArray, inlinePerformIO, checkedSubvector,
-    checkedSubvectorWithStride )
-import BLAS.C.Level1  ( BLAS1, copy )
+import BLAS.Elem ( BLAS1 )
+import BLAS.Internal ( inlinePerformIO )
+import BLAS.UnsafeIOToM
 
+import Data.Vector.Dense.IO
+import Data.Vector.Dense.Class
 
--- | A dense vector.  @t@ is a type that will usually be @Imm@ or @Mut@.  
--- @n@ is a phantom type for the dimension of the vector, and @e@ is the 
--- element type.  A @DVector@ @x@ stores @dim x@ elements.  Indices into
--- the vector are @0@-based.
-data DVector t n e = 
-      DV { storageOf :: {-# UNPACK #-} !(ForeignPtr e) -- ^ a pointer to the storage region
-         , offsetOf  :: {-# UNPACK #-} !Int            -- ^ an offset (in elements, not bytes) to the first element in the vector. 
-         , lengthOf  :: {-# UNPACK #-} !Int            -- ^ the length of the vector
-         , strideOf  :: {-# UNPACK #-} !Int            -- ^ the stride (in elements, not bytes) between elements.
-         , isConj    :: {-# UNPACK #-} !Bool           -- ^ indicates whether or not the vector is conjugated
-         }
 
-type Vector n e = DVector Imm n e
-type IOVector n e = DVector Mut n e
+infixl 7 <.>
 
--- | Cast the phantom length type.
-coerceVector :: DVector t n e -> DVector t m e
-coerceVector = unsafeCoerce
-{-# INLINE coerceVector #-}
 
--- | @fromForeignPtr fptr offset n inc c@ creates a vector view of a
--- region in memory starting at the given offset and having dimension @n@,
--- with a stride of @inc@, and with @isConj@ set to @c@.
-fromForeignPtr :: ForeignPtr e -> Int -> Int -> Int -> Bool -> DVector t n e
-fromForeignPtr = DV
-{-# INLINE fromForeignPtr #-}
+newtype Vector n e = V (IOVector n e)
 
--- | Gets the tuple @(fptr,offset,n,inc,c)@, where @n@ is the dimension and 
--- @inc@ is the stride of the vector, and @c@ indicates whether or not the
--- vector is conjugated.
-toForeignPtr :: DVector t n e -> (ForeignPtr e, Int, Int, Int, Bool)
-toForeignPtr (DV f o n s c) = (f, o, n, s, c)
-{-# INLINE toForeignPtr #-}
 
--- | @subvector x o n@ creates a subvector view of @x@ starting at index @o@ 
--- and having length @n@.
-subvector :: DVector t n e -> Int -> Int -> DVector t m e
-subvector x = checkedSubvector (dim x) (unsafeSubvector x)
+unsafeFreezeIOVector :: IOVector n e -> Vector n e
+unsafeFreezeIOVector = V
+unsafeThawIOVector :: Vector n e -> IOVector n e
+unsafeThawIOVector (V x) = x
 
--- | Same as 'subvector' but arguments are not range-checked.
-unsafeSubvector :: DVector t n e -> Int -> Int -> DVector t m e
-unsafeSubvector = unsafeSubvectorWithStride 1
 
--- | @subvectorWithStride s x o n@ creates a subvector view of @x@ starting 
--- at index @o@, having length @n@ and stride @s@.
-subvectorWithStride :: Int -> DVector t n e -> Int -> Int -> DVector t m e
-subvectorWithStride s x = 
-    checkedSubvectorWithStride s (dim x) (unsafeSubvectorWithStride s x)
-    
--- | Same as 'subvectorWithStride' but arguments are not range-checked.
-unsafeSubvectorWithStride :: Int -> DVector t n e -> Int -> Int -> DVector t m e
-unsafeSubvectorWithStride s x o n =
-    let f  = storageOf x
-        o' = indexOf x o
-        n' = n
-        s' = s * (strideOf x)
-        c  = isConj x
-    in 
-        fromForeignPtr f o' n' s' c
+liftVector :: (IOVector n e -> a) -> Vector n e -> a
+liftVector f (V x) = f x
+{-# INLINE liftVector #-}
 
--- | Creates a new vector of the given length.  The elements will be 
--- uninitialized.
-newVector_ :: (Elem e) => Int -> IO (DVector t n e)
-newVector_ n
-    | n < 0 = 
-        ioError $ userError $ 
-            "Tried to create a vector with `" ++ show n ++ "' elements."
-    | otherwise = do
-        arr <- mallocForeignPtrArray n
-        return $ fromForeignPtr arr 0 n 1 False
+liftVector2 :: 
+    (IOVector n e -> IOVector n e -> a) -> 
+        Vector n e -> Vector n e -> a
+liftVector2 f x = liftVector (liftVector f x)
+{-# INLINE liftVector2 #-}
 
--- | 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 :: (Elem e) => Int -> [e] -> IO (DVector t n e)
-newListVector n es = do
-    x <- newVector_ n
-    withForeignPtr (storageOf x) $ flip pokeArray $ take n es
-    return x
+unsafeLiftVector :: (IOVector n e -> IO a) -> Vector n e -> a
+unsafeLiftVector f = unsafePerformIO . liftVector f
+{-# NOINLINE unsafeLiftVector #-}
 
--- | @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 :: (Elem e) => Int -> [e] -> Vector n e
-listVector n es = unsafeFreeze $ unsafePerformIO $ newListVector n es
-{-# NOINLINE listVector #-}
+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 #-}
 
--- | Creates a new vector with the given association list.  Unspecified
--- indices will get initialized to zero.
-newVector :: (BLAS1 e) => Int -> [(Int,e)] -> IO (DVector t n e)
-newVector =
-    newVectorHelp writeElem
+-- | 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 'newVector' but indices are not range-checked.
-unsafeNewVector :: (BLAS1 e) => Int -> [(Int,e)] -> IO (DVector t n e)
-unsafeNewVector =
-    newVectorHelp unsafeWriteElem
+-- | 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 #-}
 
-newVectorHelp :: (BLAS1 e) => 
-       (IOVector n e -> Int -> e -> IO ()) 
-    -> Int -> [(Int,e)] -> IO (DVector t n e)
-newVectorHelp set n ies = do
-    x <- newZero n
-    mapM_ (uncurry $ set x) ies
-    return (unsafeCoerce x)
+-- | 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 #-}
 
--- | @newBasis n i@ creates a vector of length @n@ that is all zero except for
--- at position @i@, where it equal to one.
-newBasis :: (BLAS1 e) => Int -> Int -> IO (IOVector n e)
-newBasis n i = do
-    x <- newVector_ n
-    setBasis i x
-    return x
+-- | @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 #-}
 
--- | @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'.
-setBasis :: (BLAS1 e) => Int -> IOVector n e -> IO ()
-setBasis i x
-    | i < 0 || i >= dim x =
-        ioError $ userError $ 
-            "tried to set a vector of dimension `" ++ show (dim x) ++ "'"
-            ++ " to basis vector `" ++ show i ++ "'"
-    | otherwise = do
-        setZero x
-        unsafeWriteElem x i 1 
+-- | @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 #-}
 
-indexOf :: DVector t n e -> Int -> Int
-indexOf x i = offsetOf x + i * strideOf x
-{-# INLINE indexOf #-}
+-- | @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 #-}
 
--- | Evaluate a function with a pointer to the value stored at the given
--- index.  Note that the value may need to conjugated before using it.  See
--- 'isConj'.
-unsafeWithElemPtr :: (Elem e) => DVector t n e -> Int -> (Ptr e -> IO a) -> IO a
-unsafeWithElemPtr x i f =
-    withForeignPtr (storageOf x) $ \ptr ->
-        let elemPtr = ptr `advancePtr` (indexOf x i)
-        in f elemPtr
-{-# INLINE unsafeWithElemPtr #-}
+-- | Compute the sum of absolute values of entries in the vector.
+sumAbs :: (BLAS1 e) => Vector n e -> Double
+sumAbs = unsafeLiftVector getSumAbs
+{-# NOINLINE sumAbs #-}
 
--- | Cast the access type to @Imm@.
-unsafeFreeze :: DVector t n e -> Vector n e
-unsafeFreeze = unsafeCoerce
+-- | Compute the 2-norm of a vector.
+norm2 :: (BLAS1 e) => Vector n e -> Double
+norm2 = unsafeLiftVector getNorm2
+{-# NOINLINE norm2 #-}
 
--- | Cast the access type to @Mut@.
-unsafeThaw :: DVector t n e -> IOVector n e
-unsafeThaw = unsafeCoerce
+-- | 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 #-}
 
-instance C.Vector (DVector t) where
-    dim = lengthOf
-    {-# INLINE dim #-}
+-- | Compute the dot product of two vectors.
+(<.>) :: (BLAS1 e) => Vector n e -> Vector n e -> e
+(<.>) = unsafeLiftVector2 getDot
+{-# NOINLINE (<.>) #-}
 
-    conj x = let c' = (not . isConj) x 
-             in x { isConj=c' }
-    {-# INLINE conj #-}
 
+instance BaseTensor Vector Int where
+    shape  = liftVector shape
+    bounds = liftVector bounds
 
-instance Tensor (DVector t n) Int e where
-    shape = dim
-    {-# INLINE shape #-}
+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
 
-    bounds x = (0, dim x - 1)
-    {-# INLINE bounds #-}
+    tmap f x      = listVector (dim x) (map f $ elems x)
 
-instance (BLAS1 e) => ITensor (DVector Imm n) Int e where
-    size = dim
-    
-    indices = range . bounds
-    {-# INLINE indices #-}
+    (*>) k x = unsafeFreezeIOVector $ unsafeLiftVector (getScaledVector k) x
+    {-# NOINLINE (*>) #-}
 
-    elems  = inlinePerformIO . getElems . unsafeThaw
-    assocs = inlinePerformIO . getAssocs . unsafeThaw
+    shift k x = unsafeFreezeIOVector $ unsafeLiftVector (getShiftedVector k) x
+    {-# NOINLINE shift #-}
 
-    unsafeAt x = inlinePerformIO . unsafeReadElem (unsafeThaw x)
-    {-# INLINE unsafeAt #-}
-    
-    amap f x = listVector (dim x) (map f $ elems x)
-    
-    (//) = replaceHelp writeElem
-    unsafeReplace = replaceHelp unsafeWriteElem
 
 replaceHelp :: (BLAS1 e) => 
-       (IOVector n e -> Int -> e -> IO ())
-    -> Vector n e -> [(Int, e)] -> Vector n e
+    (IOVector n e -> Int -> e -> IO ()) ->
+        Vector n e -> [(Int, e)] -> Vector n e
 replaceHelp set x ies =
-    unsafeFreeze $ unsafePerformIO $ do
-        y  <- newCopy (unsafeThaw x)
+    unsafePerformIO $ do
+        y  <- newCopyVector (unsafeThawIOVector x)
         mapM_ (uncurry $ set y) ies
-        return y
+        return (unsafeFreezeIOVector y)
 {-# NOINLINE replaceHelp #-}
 
-
-instance (BLAS1 e) => IDTensor (DVector Imm n) Int e where
-    zero n = unsafeFreeze $ unsafePerformIO $ newZero n
-    {-# NOINLINE zero #-}
+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
     
-    constant n e = unsafeFreeze $ unsafePerformIO $ newConstant n e
-    {-# NOINLINE constant #-}
 
-    azipWith f x y
-        | dim y /= n =
-            error ("amap2: 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) => RTensor (DVector t n) Int e IO where
-    getSize = return . dim
+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
     
-    newCopy x
-        | isConj x = 
-            newCopy (conj x) >>= return . conj
-        | otherwise = do
-            y <- newVector_ (dim x)
-            unsafeWithElemPtr x 0 $ \pX ->
-                unsafeWithElemPtr y 0 $ \pY ->
-                    let n    = dim x
-                        incX = strideOf x
-                        incY = strideOf y
-                    in copy n pX incX pY incY >> 
-                       return y
-                       
-    getIndices = return . indices . unsafeFreeze
-    {-# INLINE getIndices #-}
+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
     
-    unsafeReadElem x i
-        | isConj x = 
-            unsafeReadElem (conj x) i >>= return . E.conj
-        | otherwise =
-            withForeignPtr (storageOf x) $ \ptr ->
-                peekElemOff ptr (indexOf x i) 
+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
 
-    getAssocs x
-        | isConj x =
-            getAssocs (conj x) >>= return . map (\(i,e) -> (i,E.conj e))
-        | otherwise =
-            let (f,o,n,incX,_) = toForeignPtr x
-                ptr = (unsafeForeignPtrToPtr f) `advancePtr` o
-            in return $ go n f incX ptr 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)
-    {-# NOINLINE getAssocs #-}
+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) => RDTensor (DVector t n) Int e IO where
-    newZero n = newVector_ n >>= (\x -> setZero (unsafeThaw x) >> return x)
-    
-    newConstant n e = newVector_ n >>= (\x -> setConstant e (unsafeThaw x) >> return x)
-    
-    
-instance (BLAS1 e) => MTensor (DVector Mut n) Int e IO where
-    setZero x 
-        | strideOf x == 1 = unsafeWithElemPtr x 0 $ flip clearArray (dim x)
-        | otherwise       = setConstant 0 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)
 
-    setConstant e x 
-        | isConj x  = setConstant (E.conj e) (conj x)
-        | otherwise = unsafeWithElemPtr x 0 $ go (dim x)
-      where
-        go !n !ptr | n <= 0 = return ()
-                   | otherwise = let ptr' = ptr `advancePtr` (strideOf x)
-                                     n'   = n - 1
-                                 in poke ptr e >> 
-                                    go n' ptr'
-    
-    unsafeWriteElem x i e =
-        let e' = if isConj x then E.conj e else e
-        in withForeignPtr (storageOf x) $ \ptr -> 
-               pokeElemOff ptr (indexOf x i) e'
-                        
-    canModifyElem x i = return $ inRange (bounds x) i
-    {-# INLINE canModifyElem #-}
-    
-    modifyWith f x
-        | isConj x  = modifyWith (E.conj . f . E.conj) (conj x)
-        | otherwise = withForeignPtr (storageOf x) $ 
-                          \ptr -> go (dim x) (ptr `advancePtr` offsetOf x)
-      where
-        go !n !ptr | n <= 0 = return ()
-                   | otherwise = do
-                       peek ptr >>= poke ptr . f
-                       go (n-1) (ptr `advancePtr` incX)
+instance (BLAS1 e, Eq e) => Eq (Vector n e) where
+    (==) = compareHelp (==)
 
-        incX = strideOf x
-    
+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
+    (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))
 
-instance (BLAS1 e, Eq e) => Eq (DVector Imm n e) where
-    (==) = compareHelp (==)
-
-instance (BLAS1 e, AEq e) => AEq (DVector Imm n e) where
-    (===) = compareHelp (===)
-    (~==) = compareHelp (~==)
-
-instance (BLAS1 e, Show e) => Show (DVector Imm n e) where
-    show x
-        | isConj x  = "conj (" ++ show (conj x) ++ ")"
-        | otherwise = "listVector " ++ show (dim x) ++ " " ++ show (elems x)
-    
+            
diff --git a/Data/Vector/Dense/Operations.hs b/Data/Vector/Dense/Operations.hs
deleted file mode 100644
--- a/Data/Vector/Dense/Operations.hs
+++ /dev/null
@@ -1,407 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module     : Data.Vector.Dense.Operations
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Data.Vector.Dense.Operations (
-    -- * Copy and swap
-    copyVector,
-    swapVectors,
-
-    -- * Vector norms and inner products
-    -- ** Pure
-    sumAbs,
-    norm2,
-    whichMaxAbs,
-    (<.>),
-    
-    getSumAbs,
-    getNorm2,
-    getWhichMaxAbs,
-    getDot,
-
-    -- * Vector arithmetic
-    -- ** Pure
-    shift,
-    scale,
-    invScale,
-    add,
-    plus,
-    minus,
-    times,
-    divide,
-    
-    -- ** Impure
-    getConj,
-    getShifted,
-    getScaled,
-    getInvScaled,
-    getSum,
-    getDiff,
-    getProduct,
-    getRatio,
-    
-    -- * In-place arithmetic
-    doConj,
-    scaleBy,
-    shiftBy,
-    invScaleBy,
-    (+=),
-    (-=),
-    (*=),
-    (//=),
-
-    -- * BLAS calls
-    axpy,
-    
-    -- * Unsafe operations
-    unsafeCopyVector,
-    unsafeSwapVectors,
-    unsafeGetDot,
-    unsafeAxpy,
-    unsafePlusEquals,
-    unsafeMinusEquals,
-    unsafeTimesEquals,
-    unsafeDivideEquals,
-    
-    ) where
-  
-import Control.Monad ( forM_ )
-import Data.Vector.Dense.Internal
-import BLAS.Tensor
-import BLAS.Elem.Base ( Elem )
-import qualified BLAS.Elem.Base as E
-
-import Foreign ( Ptr )
-import System.IO.Unsafe
-import Unsafe.Coerce
-
-import BLAS.Internal  ( inlinePerformIO, checkVecVecOp )
-import BLAS.C hiding ( copy, swap, iamax, conj, axpy, acxpy )
-import qualified BLAS.C as BLAS
-import qualified BLAS.C.Types as T
-
-infixl 7 <.>, `times`, `divide`, `scale`, `invScale`
-infixl 6 `plus`, `minus`, `shift`
-infixl 1 +=, -=, *=, //=
-
-
--- | @copyVector dst src@ replaces the elements in @dst@ with the values from @src@.
--- This may result in a loss of precision.
-copyVector :: (BLAS1 e) => IOVector n e -> DVector t n e -> IO ()
-copyVector x y = 
-    checkVecVecOp "copyVector" (dim x) (dim y) $ unsafeCopyVector x y
-
--- | Same as 'copyVector' but does not check the dimensions of the arguments.
-unsafeCopyVector :: (BLAS1 e) => IOVector n e -> DVector t n e -> IO ()
-unsafeCopyVector x y 
-    | isConj x && isConj y =
-        unsafeCopyVector (conj x) (conj y)
-    | isConj x || isConj y =
-        forM_ [0..(dim x - 1)] $ \i -> do
-            unsafeReadElem y i >>= unsafeWriteElem x i
-    | otherwise =
-        call2 BLAS.copy y x
-
--- | @swapVectors x y@ replaces the elements in @x@ with the values from @y@, and 
--- replaces the elements in @y@ with the values from @x@.  This may result in 
--- a loss of precision.
-swapVectors :: (BLAS1 e) => IOVector n e -> IOVector n e -> IO ()
-swapVectors x y = 
-    checkVecVecOp "swapVectors" (dim x) (dim y) $ unsafeSwapVectors x y
-
--- | Same as 'swap' but does not check the dimensions of the arguments.
-unsafeSwapVectors :: (BLAS1 e) => IOVector n e -> IOVector n e -> IO ()
-unsafeSwapVectors x y
-    | isConj x && isConj y =
-        unsafeSwapVectors (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 =
-        call2 BLAS.swap x y
-
--- | Gets the sum of the absolute values of the vector entries.
-getSumAbs :: (BLAS1 e) => DVector t n e -> IO Double
-getSumAbs = call asum
-    
--- | Gets the 2-norm of a vector.
-getNorm2 :: (BLAS1 e) => DVector t n e -> IO Double
-getNorm2 = call 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 :: (BLAS1 e) => DVector t n e -> IO (Int, e)
-getWhichMaxAbs x =
-    case (dim x) of
-        0 -> ioError $ userError $ "getWhichMaxAbs of an empty vector"
-        _ -> do
-            i <- call BLAS.iamax x
-            e <- unsafeReadElem x i
-            return (i,e)
-
--- | Computes the dot product of two vectors.
-getDot :: (BLAS1 e) => DVector s n e -> DVector t n e -> IO e
-getDot x y = checkVecVecOp "dot" (dim x) (dim y) $ unsafeGetDot x y
-{-# INLINE getDot #-}
-
-unsafeGetDot :: (BLAS1 e) => DVector s n e -> DVector t n e -> IO e
-unsafeGetDot x y =
-    case (isConj x, isConj y) of
-        (False, False) -> call2 dotc x y
-        (True , False) -> call2 dotu x y
-        (False, True ) -> call2 dotu x y >>= return . E.conj
-        (True , True)  -> call2 dotc x y >>= return . E.conj
-{-# INLINE unsafeGetDot #-}
-
-unsafeGetDotDouble :: DVector s n Double -> DVector t n Double -> IO Double
-unsafeGetDotDouble x y = call2 dotc x y
-{-# INLINE unsafeGetDotDouble #-}
-
-{-# RULES "unsafeGetDot/Double" unsafeGetDot = unsafeGetDotDouble #-}
-
-
--- | Create a new vector by taking the conjugate of a vector.  The
--- resulting vector will have 'isConj' equal to 'False'.
-getConj :: (BLAS1 e) => DVector t n e -> IO (DVector r n e)
-getConj x 
-    | isConj x = do
-        y <- newCopy (conj x)
-        return (unsafeCoerce y)
-    | otherwise = do
-        y <- newCopy x
-        doConj (unsafeThaw y)
-        return (unsafeCoerce y)
-
--- | Create a new vector by adding a value to every element in a vector.
-getShifted :: (BLAS1 e) => e -> DVector t n e -> IO (DVector r n e)
-getShifted k x = do
-    y <- newCopy x
-    shiftBy k (unsafeThaw y)
-    return (unsafeCoerce y)
-
--- | Create a new vector by scaling every element by a value.  @scale'k x@
--- is equal to @newCopy' (scale k x)@.
-getScaled :: (BLAS1 e) => e -> DVector t n e -> IO (DVector r n e)
-getScaled k x = do
-    y <- newCopy x
-    scaleBy k (unsafeThaw y)
-    return (unsafeCoerce y)
-
--- | Create a new vector by dividing every element by a value.
-getInvScaled :: (BLAS1 e) => e -> DVector t n e -> IO (DVector r n e)
-getInvScaled k x = do
-    y <- newCopy x
-    invScaleBy k (unsafeThaw y)
-    return (unsafeCoerce y)
-
--- | Computes the sum of two vectors.
-getSum :: (BLAS1 e) => e -> DVector s n e -> e -> DVector t n e -> IO (DVector r n e)
-getSum alpha x beta y = checkVecVecOp "getSum" (dim x) (dim y) $ unsafeGetSum alpha x beta y
-
-unsafeGetSum :: (BLAS1 e) => e -> DVector s n e -> e -> DVector t n e -> IO (DVector r n e)
-unsafeGetSum 1 x beta y
-    | beta /= 1 = unsafeGetSum beta y 1 x
-unsafeGetSum alpha x beta y
-    | isConj x = do
-        s <- unsafeGetSum (E.conj alpha) (conj x) (E.conj beta) (conj y)
-        return (conj s)
-    | otherwise = do
-        s <- newCopy y
-        scaleBy beta (unsafeThaw s)
-        axpy alpha x (unsafeThaw s)
-        return (unsafeCoerce s)
-            
--- | Computes the difference of two vectors.
-getDiff :: (BLAS1 e) => DVector s n e -> DVector t n e -> IO (DVector r n e)
-getDiff x y = checkVecVecOp "getDiff" (dim x) (dim y) $ unsafeGetSum 1 x (-1) y
-
--- | Computes the elementwise product of two vectors.
-getProduct :: (BLAS2 e) => DVector s n e -> DVector t n e -> IO (DVector r n e)
-getProduct = binaryOp "getProduct" (*=)
-
--- | Computes the elementwise ratio of two vectors.
-getRatio :: (BLAS2 e) => DVector s n e -> DVector t n e -> IO (DVector r n e)
-getRatio = binaryOp "getRatio" (//=)
-
--- | Replace every element with its complex conjugate.  See also 'conj'.
-doConj  :: (BLAS1 e) => IOVector n e -> IO ()
-doConj = call BLAS.conj
-            
--- | Add a value to every element in a vector.
-shiftBy :: (BLAS1 e) => e -> IOVector n e -> IO ()
-shiftBy alpha x | isConj x  = shiftBy (E.conj alpha) (conj x)
-                | otherwise = modifyWith (alpha+) x
-
--- | Scale every element in the vector by the given value, and return a view
--- to the scaled vector.  See also 'scale'.
-scaleBy :: (BLAS1 e) => e -> IOVector n e -> IO ()
-scaleBy 1 _ = return ()
-scaleBy k x | isConj x  = scaleBy (E.conj k) (conj x)
-            | otherwise = call (flip scal k) x
-
--- | Divide every element by a value.
-invScaleBy :: (BLAS1 e) => e -> IOVector n e -> IO ()
-invScaleBy k x | isConj x  = invScaleBy (E.conj k) (conj x)
-               | otherwise = modifyWith (/k) x
-
-axpy :: (BLAS1 e) => e -> DVector t n e -> IOVector n e -> IO ()
-axpy alpha x y = checkVecVecOp "axpy" (dim x) (dim y) $ unsafeAxpy alpha x y
-
-unsafeAxpy :: (BLAS1 e) => e -> DVector t n e -> IOVector n e -> IO ()
-unsafeAxpy alpha x y
-    | isConj y =
-        axpy (E.conj alpha) (conj x) (conj y)
-    | isConj x =
-        call2 (flip BLAS.acxpy alpha) x y
-    | otherwise =
-        call2 (flip BLAS.axpy alpha) x y
-
--- | @y += x@ replaces @y@ by @y + x@.
-(+=) :: (BLAS1 e) => IOVector n e -> DVector t n e -> IO ()
-(+=) y x = checkVecVecOp "(+=)" (dim y) (dim x) $ unsafePlusEquals y x
-
-unsafePlusEquals :: (BLAS1 e) => IOVector n e -> DVector t n e -> IO ()
-unsafePlusEquals y x = axpy 1 x y
-
--- | @y -= x@ replaces @y@ by @y - x@.
-(-=) :: (BLAS1 e) => IOVector n e -> DVector t n e -> IO ()
-(-=) y x = checkVecVecOp "(-=)" (dim y) (dim x) $ unsafeMinusEquals y x
-
-unsafeMinusEquals :: (BLAS1 e) => IOVector n e -> DVector t n e -> IO ()
-unsafeMinusEquals y x = unsafeAxpy (-1) x y
-
--- | @y *= x@ replaces @y@ by @x * y@, the elementwise product.
-(*=) :: (BLAS2 e) => IOVector n e -> DVector t n e -> IO ()
-(*=) y x = checkVecVecOp "(*=)" (dim y) (dim x) $ unsafeTimesEquals y x
-
-unsafeTimesEquals :: (BLAS2 e) => IOVector n e -> DVector t n e -> IO ()
-unsafeTimesEquals y x
-    | isConj y =
-        unsafeTimesEquals (conj y) (conj x)
-    | isConj x =
-        call2 (flip (tbmv T.colMajor T.upper T.conjTrans T.nonUnit) 0) x y    
-    | otherwise =
-        call2 (flip (tbmv T.colMajor T.upper T.noTrans T.nonUnit) 0) x y
-
--- | @y //= x@ replaces @y@ by @y / x@, the elementwise ratio.
-(//=) :: (BLAS2 e) => IOVector n e -> DVector t n e -> IO ()
-(//=) y x = checkVecVecOp "(//=)" (dim y) (dim x) $ unsafeDivideEquals y x
-
-unsafeDivideEquals :: (BLAS2 e) => IOVector n e -> DVector t n e -> IO ()
-unsafeDivideEquals y x
-    | isConj y =
-        unsafeDivideEquals (conj y) (conj x)
-    | isConj x =
-        call2 (flip (tbsv T.colMajor T.upper T.conjTrans T.nonUnit) 0) x y
-    | otherwise =
-        call2 (flip (tbsv T.colMajor T.upper T.noTrans T.nonUnit) 0) x y
-               
-call :: (Elem e) => (Int -> Ptr e -> Int -> IO a) -> DVector t n e -> IO a
-call f x =
-    let n    = dim x
-        incX = strideOf x
-    in unsafeWithElemPtr x 0 $ \pX -> f n pX incX
-{-# INLINE call #-}
-
-call2 :: (Elem e) => 
-       (Int -> Ptr e -> Int -> Ptr e -> Int -> IO a) 
-    -> DVector s n e -> DVector t m e -> IO a
-call2 f x y =
-    let n    = dim x
-        incX = strideOf x
-        incY = strideOf y
-    in unsafeWithElemPtr x 0 $ \pX ->
-           unsafeWithElemPtr y 0 $ \pY ->
-               f n pX incX pY incY
-{-# INLINE call2 #-}
-
-binaryOp :: (BLAS1 e) => String -> (IOVector n e -> DVector t n e -> IO ()) 
-    -> DVector s n e -> DVector t n e -> IO (DVector r n e)
-binaryOp name f x y =
-    checkVecVecOp name (dim x) (dim y) $ do
-        x' <- newCopy x >>= return . unsafeThaw
-        f x' y
-        return $! (unsafeCoerce x')
-
-
-
--- | Compute the sum of absolute values of entries in the vector.
-sumAbs :: (BLAS1 e) => Vector n e -> Double
-sumAbs x = inlinePerformIO $ getSumAbs x
-{-# NOINLINE sumAbs #-}
-
--- | Compute the 2-norm of a vector.
-norm2 :: (BLAS1 e) => Vector n e -> Double
-norm2 x = inlinePerformIO $ 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 x = inlinePerformIO $ getWhichMaxAbs x
-{-# NOINLINE whichMaxAbs #-}
-
--- | Compute the dot product of two vectors.
-(<.>) :: (BLAS1 e) => Vector n e -> Vector n e -> e
-(<.>) x y = inlinePerformIO $ getDot x y
-{-# NOINLINE (<.>) #-}
-
--- | Add a value to every element in a vector.
-shift :: (BLAS1 e) => e -> Vector n e -> Vector n e
-shift k x = unsafePerformIO $ getShifted k x
-{-# NOINLINE shift #-}
-
--- | Scale every element by the given value.
-scale :: (BLAS1 e) => e -> Vector n e -> Vector n e
-scale k x = unsafePerformIO $ getScaled k x
-{-# NOINLINE scale #-}
-
--- | Divide every element by a value.
-invScale :: (BLAS1 e) => e -> Vector n e -> Vector n e
-invScale k x = unsafePerformIO $ getInvScaled k x
-{-# NOINLINE invScale #-}
-
-add :: (BLAS1 e) => e -> Vector n e -> e -> Vector n e -> Vector n e
-add alpha x beta y = unsafePerformIO $ getSum alpha x beta y
-{-# NOINLINE add #-}
-
--- | Sum of two vectors.
-plus :: (BLAS1 e) => Vector n e -> Vector n e -> Vector n e
-plus x y = add 1 x 1 y
-
--- | Difference of vectors.
-minus :: (BLAS1 e) => Vector n e -> Vector n e -> Vector n e
-minus x y = unsafePerformIO $ getDiff x y
-{-# NOINLINE minus #-}
-
--- | Elementwise vector product.
-times :: (BLAS2 e) => Vector n e -> Vector n e -> Vector n e
-times x y = unsafePerformIO $ getProduct x y
-{-# NOINLINE times #-}
-
--- | Elementwise vector ratio.
-divide :: (BLAS2 e) => Vector n e -> Vector n e -> Vector n e
-divide x y =  unsafePerformIO $ getRatio x y
-{-# NOINLINE divide #-}
-
-
-{-# 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
-  #-}
-  
diff --git a/Data/Vector/Dense/ST.hs b/Data/Vector/Dense/ST.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector/Dense/ST.hs
@@ -0,0 +1,30 @@
+{-# 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
diff --git a/INSTALL b/INSTALL
--- a/INSTALL
+++ b/INSTALL
@@ -75,8 +75,13 @@
 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.  You must have the "pqc" package installed (available on hackage)
-to build and run 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
diff --git a/NEWS b/NEWS
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,19 @@
 
+Changes in 0.6:
+
+* Massive overhaul of the types.  It is now possible to do mutable operations
+  in the ST monad.  Access control is done via type classes now instead of
+  phantom types.
+  
+* No more orphan instances.
+
+* Change some function names.  You should never have to "import qualified"
+  anything now.
+  
+* Put row/col operations in the Matrix type classes.  Generic matrix types
+  now provide access to rows and columns.
+  
+
 Changes in 0.5:
 
 * Add Banded matrix data type, as well as Tri Banded and Herm Banded.
diff --git a/Setup.lhs b/Setup.lhs
--- a/Setup.lhs
+++ b/Setup.lhs
@@ -1,27 +1,3 @@
 #!/usr/bin/env runhaskell
 > import Distribution.Simple
-> import System.Cmd
->
-> testing _ _ _ _ = do
->     system "runhaskell -lcblas -DREAL    tests/Vector.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/Vector.hs"
->     system "runhaskell -lcblas -DREAL    tests/Matrix.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/Matrix.hs"
->     system "runhaskell -lcblas -DREAL    tests/HermMatrix.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/HermMatrix.hs"
->     system "runhaskell -lcblas -DREAL    tests/TriMatrix.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/TriMatrix.hs"
->     system "runhaskell -lcblas -DREAL    tests/Banded.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/Banded.hs"
->     system "runhaskell -lcblas -DREAL    tests/HermBanded.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/HermBanded.hs"
->     system "runhaskell -lcblas -DREAL    tests/TriBanded.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/TriBanded.hs"
->     system "runhaskell -lcblas -DREAL    tests/Perm.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/Perm.hs"
->     system "runhaskell -lcblas -DREAL    tests/Diag.hs"
->     system "runhaskell -lcblas -DCOMPLEX tests/Diag.hs"
->     return ()
->
-> main = defaultMainWithHooks defaultUserHooks{ runTests=testing }
->
+> main = defaultMain
diff --git a/TODO b/TODO
new file mode 100644
--- /dev/null
+++ b/TODO
@@ -0,0 +1,74 @@
+
+* Add getSum/sum.  Put in re-write rules from scale and add to axpy.  Here
+ is the old code and re-write rules:
+ 
+    unsafeGetSum :: (BLAS1 e) => 
+        e -> DVector s n e -> e -> DVector t n e -> IO (DVector r n e)
+    unsafeGetSum 1 x beta y
+        | beta /= 1 = unsafeGetSum beta y 1 x
+    unsafeGetSum alpha x beta y
+        | isConj x = do
+            s <- unsafeGetSum (E.conj alpha) (conj x) (E.conj beta) (conj y)
+            return (conj s)
+        | otherwise = do
+            s <- newCopy y
+            scaleBy beta (unsafeThaw s)
+            axpy alpha x (unsafeThaw s)
+            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
+      #-}
+
+* Matrix creation functions are inconsistent in phantom types.  Some have
+  pairs, some do not.
+
+* Add getSubmatrix function to MMatrix.
+
+* Add getDense/toDense to MMatrix/IMatrix
+
+* Add addVector, subVector, addMatrix, subMatrix, etc.
+
+* Put better checks in swapElem for WriteTensor
+
+* STDiag and IODiag instead of current type?
+
+* Merge UnsafeIOToM and UnsafeInterleaveM
+
+* Add "Mult" class and get rid of <**> ?
+
+* Add "Solv" class and get rid of <\\> ?
+
+* lazy getRows/getCols needs to be re-implemented
+
+* Optimization: Put 'isReal' in Elem class and specialize swap, copy, axpy, dot.
+
+* Optimization: better "swapElem" for vector and matrix
+
+* Optimization: Put vector/matrix fields in the typeclass and inline them.  
+Implementation for IOVector:
+
+    fptrOfVector (DV f _ _ _ _) = f
+    {-# INLINE fptrOfVector #-}
+
+    offsetOfVector (DV _ o _ _ _) = o
+    {-# INLINE offsetOfVector #-}
+    
+    dim (DV _ _ n _ _) = n
+    {-# INLINE dim #-}
+    
+    stride (DV _ _ _ s _) = s
+    {-# INLINE stride #-}
+    
+    isConj (DV _ _ _ _ c) = c
+    {-# INLINE isConj #-}
+
+* Optimization: The ReadTensor/WriteTensor functions for Banded matrices are
+really terrible.  Re-write these to be more efficient.
diff --git a/Test/QuickCheck/Complex.hs b/Test/QuickCheck/Complex.hs
deleted file mode 100644
--- a/Test/QuickCheck/Complex.hs
+++ /dev/null
@@ -1,24 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Complex
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Complex
-    where
-
-import Test.QuickCheck 
-
-import Data.Complex
-
-newtype TestComplex e = TestComplex (Complex e)
-
-instance (Arbitrary e, RealFloat e) => Arbitrary (TestComplex e) where
-    arbitrary = do
-        (x,y) <- arbitrary
-        return $ TestComplex (x :+ y)
-    coarbitrary (TestComplex (x :+ y)) = 
-        coarbitrary (x,y)
diff --git a/Test/QuickCheck/Matrix.hs b/Test/QuickCheck/Matrix.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix.hs
+++ /dev/null
@@ -1,48 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Matrix
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Matrix
-    where
-                
-import Data.List ( nub )
-import Test.QuickCheck.Vector ( Index(..) )
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-
-newtype IndexPair = IndexPair (Int,Int) deriving (Eq, Show)
-instance Arbitrary IndexPair where
-    arbitrary = sized $ \k ->
-        let k' = floor (sqrt $ fromInteger $ toInteger k :: Double)
-        in resize k' $
-            two arbitrary >>= (\((Index i), (Index j)) -> return $ IndexPair (i,j))
-    coarbitrary (IndexPair ij) = coarbitrary ij
-    
-data Assocs e = Assocs (Int,Int) [((Int,Int),e)] deriving (Eq, Show)
-instance Arbitrary e => Arbitrary (Assocs e) where
-    arbitrary = sized $ \k -> 
-        let k' = floor (sqrt $ fromInteger $ toInteger k :: Double)
-        in do
-            m <- choose (0,k')
-            n <- choose (0,k')
-            ijs <- QC.vector (m*n)
-            let ijs' = filter (\(i,j) -> i < m && j < n) 
-                           $ nub 
-                           $ map (\(IndexPair ij) -> ij) ijs
-            es <- QC.vector (length ijs')
-            return $ Assocs (m,n) (zip ijs' es)
-        
-    coarbitrary (Assocs mn ijes) = coarbitrary (mn,ijes)
-
-matrixSized :: (Int -> Gen a) -> Gen a
-matrixSized f = 
-    sized $ \s ->
-        let s' = ceiling (sqrt $ fromInteger $ toInteger s :: Double)
-        in f s'
-        
diff --git a/Test/QuickCheck/Matrix/Banded.hs b/Test/QuickCheck/Matrix/Banded.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix/Banded.hs
+++ /dev/null
@@ -1,177 +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 Test.QuickCheck.Matrix.Banded
-    where
-
-import Control.Monad( forM )
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-import Test.QuickCheck.Vector.Dense ( TestVector(..), dvector )
-import Test.QuickCheck.Matrix.Dense ( dmatrix )
-
-import Data.Vector.Dense ( Vector, dim )
-import Data.Matrix.Dense ( Matrix )
-import Data.Matrix.Banded
-import BLAS.Elem ( Elem, BLAS1 )
-
-newtype TestBanded m n e = TestBanded (Banded (m,n) e) deriving (Eq, Show)
-
-bmatrix :: (BLAS1 e, Arbitrary e) => 
-    (Int,Int) -> (Int,Int) -> Gen (Banded (m,n) e)
-bmatrix 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 (TestBanded 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)
-            bmatrix (m,n) (kl,ku) >>= return . TestBanded
-        
-    coarbitrary (TestBanded x) =
-        coarbitrary (elems 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  <- bmatrix (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 <- dmatrix (m,n)
-            b <- dmatrix (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 <- bmatrix (m,n) (kl,ku)             
-            x <- dvector 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 <- dvector (dim x)
-        return $ BandedMVPair a x y
-        
-    coarbitrary (BandedMVPair a x y) =
-        coarbitrary (BandedMV a x, TestVector 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 <- bmatrix (m,k) (kl,ku)             
-            b <- dmatrix (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 <- dmatrix (shape b)
-        return $ BandedMMPair a b c
-        
-    coarbitrary = undefined
diff --git a/Test/QuickCheck/Matrix/Dense.hs b/Test/QuickCheck/Matrix/Dense.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix/Dense.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Matrix.Dense
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Matrix.Dense
-    where
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-import Test.QuickCheck.Vector.Dense ( TestVector(..), dvector )
-
-import Data.Vector.Dense ( Vector, dim )
-import Data.Matrix.Dense
-import BLAS.Elem ( Elem, BLAS1 )
-
-newtype TestMatrix m n e = TestMatrix (Matrix (m,n) e) deriving (Eq, Show)
-data SubMatrix m n e = SubMatrix (Matrix (m,n) e) (Int,Int) (Int,Int) deriving (Eq, Show)
-
-dmatrix :: (Elem e, Arbitrary e) => (Int,Int) -> Gen (Matrix (m,n) e)
-dmatrix mn = frequency [ (3, rawMatrix mn)  
-                       , (2, hermedMatrix mn)
-                       , (1, subMatrix mn 
-                             >>= \(SubMatrix a ij _) -> 
-                                 return $ submatrix a ij mn)
-                       ]
-
-rawMatrix :: (Elem 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 :: (Elem e, Arbitrary e) => (Int,Int) -> Gen (Matrix (m,n) e)
-hermedMatrix (m,n) = do
-    x <- dmatrix (n,m)
-    return $ (herm x)
-
-subMatrix :: (Elem 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 <- dmatrix (i+m+e, j+n+f)
-
-    return $ SubMatrix x (i,j) (m,n)
-
-
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (TestMatrix 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')
-            dmatrix (m,n) >>= return . TestMatrix
-        
-    coarbitrary (TestMatrix x) =
-        coarbitrary (elems x)
-
-data MatAt m n e = MatAt (Matrix (m,n) e) (Int,Int) deriving (Eq, Show)
-instance (Arbitrary e, Elem e) => Arbitrary (MatAt 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)
-            i <- choose (0,m-1)
-            j <- choose (0,n-1)
-            a <- dmatrix (m,n)
-            return $ MatAt a (i,j)
-
-    coarbitrary = undefined
-            
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (SubMatrix 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')
-            (SubMatrix a ij mn) <- subMatrix (m,n)
-            return $ SubMatrix a ij mn
-        
-    coarbitrary (SubMatrix a ij mn) =
-        coarbitrary (elems a, ij, mn)
-        
-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 <- dmatrix (m,n)
-            b <- dmatrix (m,n)
-            return $ Pair a b
-        
-    coarbitrary = undefined
-  
-data MultMV m n e = MultMV (Matrix (m,n) e) (Vector n e) deriving (Eq, Show)
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (MultMV 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 <- dmatrix (m,n)
-            x <- dvector n
-            return $ MultMV a x
-            
-    coarbitrary = undefined
-
-data MultMVPair m n e = MultMVPair (Matrix (m,n) e) (Vector n e) (Vector n e) 
-    deriving (Eq, Show)
-    
-instance (Arbitrary e, BLAS1 e) => Arbitrary (MultMVPair m n e) where
-    arbitrary = do
-        (MultMV a x) <- arbitrary
-        y <- dvector (dim x)
-        return $ MultMVPair a x y
-        
-    coarbitrary (MultMVPair a x y) =
-        coarbitrary (MultMV a x, TestVector y)
-        
-data MultMM m n k e = MultMM (Matrix (m,k) e) (Matrix (k,n) e) deriving (Eq, Show)
-
-instance (Arbitrary e, Elem e) => Arbitrary (MultMM m n k e) where
-    arbitrary = sized $ \s ->
-        let s' = ceiling (sqrt $ fromInteger $ toInteger s :: Double)
-        in do
-            m <- choose (0,s')
-            n <- choose (0,s')
-            k <- choose (0,s')
-            a <- dmatrix (m,k)
-            b <- dmatrix (k,n)
-            return $ MultMM a b
-            
-    coarbitrary = undefined
-        
-data MultMMPair m n k e = MultMMPair (Matrix (m,k) e) (Matrix (k,n) e) (Matrix (k,n) e)
-    deriving (Eq, Show)
-    
-instance (Arbitrary e, Elem e) => Arbitrary (MultMMPair m n k e) where
-    arbitrary = do
-        (MultMM a b) <- arbitrary
-        c <- dmatrix (shape b)
-        return $ MultMMPair a b c
-        
-    coarbitrary = undefined
diff --git a/Test/QuickCheck/Matrix/Diag.hs b/Test/QuickCheck/Matrix/Diag.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix/Diag.hs
+++ /dev/null
@@ -1,100 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Matrix.Diag
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Matrix.Diag
-    where
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-
-import Test.QuickCheck.Vector.Dense ( dvector )
-import Test.QuickCheck.Matrix.Dense ( dmatrix )
-import Test.QuickCheck.Matrix ( matrixSized )
-
-import BLAS.Elem ( BLAS1, BLAS2 )
-
-import Data.Vector.Dense ( Vector )
-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 (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 (fromVector $ diag a 0) a
-        
-    coarbitrary = undefined
-
-
-data DiagMV n e = 
-    DiagMV (Diag (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 <- dvector (numCols a)
-        return $ DiagMV d a x
-
-    coarbitrary = undefined
-
-
-data DiagMM m n e = 
-    DiagMM (Diag (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 <- dmatrix (numCols a, n)
-        return $ DiagMM d a b
-
-    coarbitrary = undefined
-    
-    
-data DiagSV n e =
-    DiagSV (Diag (n,n) e)
-           (Vector n e)
-    deriving Show
-
-instance (Arbitrary e, BLAS2 e) => Arbitrary (DiagSV n e) where
-    arbitrary = do
-        (DiagMV d _ x) <- arbitrary
-        return $ DiagSV d (d <*> x)
-        
-    coarbitrary = undefined
-
-data DiagSM m n e =
-    DiagSM (Diag (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
-        return $ DiagSM d (d <**> b)
-
-    coarbitrary = undefined
diff --git a/Test/QuickCheck/Matrix/Herm/Banded.hs b/Test/QuickCheck/Matrix/Herm/Banded.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix/Herm/Banded.hs
+++ /dev/null
@@ -1,116 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Matrix.Herm.Banded
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Matrix.Herm.Banded 
-    where
-
-import Control.Monad ( replicateM )
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-import Test.QuickCheck.Vector.Dense ( dvector )
-import Test.QuickCheck.Matrix ( matrixSized )
-import Test.QuickCheck.Matrix.Dense ( dmatrix )
-
-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) = toLists 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) = toLists 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 <- dvector (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 <- dmatrix (numCols h,n)
-
-        return $ HermBandedMM a h b
-            
-    coarbitrary = undefined
diff --git a/Test/QuickCheck/Matrix/Herm/Dense.hs b/Test/QuickCheck/Matrix/Herm/Dense.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix/Herm/Dense.hs
+++ /dev/null
@@ -1,88 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Matrix.Herm.Dense
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Matrix.Herm.Dense 
-    where
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-import Test.QuickCheck.Vector.Dense ( dvector )
-import Test.QuickCheck.Matrix ( matrixSized )
-import Test.QuickCheck.Matrix.Dense ( dmatrix, rawMatrix )
-
-import BLAS.Elem ( BLAS2 )
-import BLAS.Types ( flipUpLo )
-
-import Data.Vector.Dense
-import Data.Matrix.Dense
-import Data.Matrix.Herm
-
-
-
-hermMatrix :: (BLAS2 e, Arbitrary e) => Int -> Gen (Matrix (n,n) e)
-hermMatrix n  = do
-    a <- rawMatrix (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 <- dvector (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 <- dmatrix (numCols a,n)
-        return $ HermMatrixMM h a b
-            
-    coarbitrary = undefined
-        
diff --git a/Test/QuickCheck/Matrix/Perm.hs b/Test/QuickCheck/Matrix/Perm.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix/Perm.hs
+++ /dev/null
@@ -1,104 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Matrix.Perm
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Matrix.Perm
-    where
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-
-import Test.QuickCheck.Permutation
-import Test.QuickCheck.Vector.Dense ( dvector )
-import Test.QuickCheck.Matrix.Dense ( dmatrix )
-import Test.QuickCheck.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 <- dvector (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 <- dvector (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 <- dmatrix (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 <- dmatrix (shape a)
-        return $ PermMMPair p a b
-        
-    coarbitrary = undefined
diff --git a/Test/QuickCheck/Matrix/Tri/Banded.hs b/Test/QuickCheck/Matrix/Tri/Banded.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix/Tri/Banded.hs
+++ /dev/null
@@ -1,151 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Matrix.Tri.Banded
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Matrix.Tri.Banded
-    where
-
-import Control.Monad ( replicateM )
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-import Test.QuickCheck.Vector.Dense ( TestVector(..), dvector )
-import Test.QuickCheck.Matrix.Dense ( dmatrix )
-import Test.QuickCheck.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.Banded ( Tri, UpLo(..), Diag(..), fromBase )
-
-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)) = toLists 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) = toLists 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) = toLists 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) = toLists 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) = toLists a
-            t = 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' = fromBase u d t 
-
-        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 <- dvector (numCols t)
-        return $ TriBandedMV t a x
-        
-    coarbitrary (TriBandedMV t a x) =
-        coarbitrary (TriBanded t a, TestVector 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 <- dmatrix (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 _) <- arbitrary
-        t' <- elements [ t
-                       , herm t
-                       ]
-        x <- dvector (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
-        t' <- elements [ t
-                       , herm t
-                       ]
-
-        n <- choose (0, s)
-        a <- dmatrix (numCols t, n)
-        
-        let b = t' <**> a
-        return (TriBandedSM t' b)
-        
-    coarbitrary = undefined
-    
diff --git a/Test/QuickCheck/Matrix/Tri/Dense.hs b/Test/QuickCheck/Matrix/Tri/Dense.hs
deleted file mode 100644
--- a/Test/QuickCheck/Matrix/Tri/Dense.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Matrix.Tri.Dense
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Matrix.Tri.Dense
-    where
-
-import Data.Ix ( range )
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-import Test.QuickCheck.Vector.Dense ( dvector )
-import Test.QuickCheck.Matrix.Dense ( dmatrix )
-import Test.QuickCheck.Matrix ( matrixSized )
-
-import Data.Vector.Dense
-import Data.Matrix.Dense
-import BLAS.Elem ( BLAS1, BLAS3 )
-
-import Data.Matrix.Tri.Dense ( 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 <- dvector (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 <- dmatrix (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
-        x <- dvector (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
-        n <- choose (0, s)
-        b <- dmatrix (numCols a, n)
-        let c = a <**> b
-        return (TriMatrixSM t c)
-        
-    coarbitrary = undefined
-    
diff --git a/Test/QuickCheck/Permutation.hs b/Test/QuickCheck/Permutation.hs
deleted file mode 100644
--- a/Test/QuickCheck/Permutation.hs
+++ /dev/null
@@ -1,36 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Permutation
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.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
-    
-newtype TestPermutation = TestPermutation Permutation deriving Show
-
-instance Arbitrary TestPermutation where
-    arbitrary = do
-        n <- arbitrary >>= return . abs
-        p <- permutation n
-        return $ TestPermutation p
-        
-    coarbitrary (TestPermutation p) = 
-            coarbitrary $ P.toList p
diff --git a/Test/QuickCheck/Vector.hs b/Test/QuickCheck/Vector.hs
deleted file mode 100644
--- a/Test/QuickCheck/Vector.hs
+++ /dev/null
@@ -1,50 +0,0 @@
-
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Vector
--- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Vector
-    where
-
-import Data.List ( nub )
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-
-
-newtype Index = Index Int deriving (Eq, Show)
-instance Arbitrary Index where
-    arbitrary = sized $ \n -> do
-        i <- if n == 0 
-                then return 0
-                else choose (0,n-1)
-        return (Index i)
-        
-    coarbitrary (Index i) = coarbitrary i
-    
-data Basis = Basis Int Int deriving (Eq, Show)
-instance Arbitrary Basis where
-    arbitrary = do
-        n <- arbitrary >>= (\(Index x) -> return (x+1))
-        i <- choose (0,n-1)
-        return $ Basis n i
-
-    coarbitrary (Basis n i) = coarbitrary (n,i)
-
-data Assocs e = Assocs Int [(Int,e)] deriving (Eq, Show)
-instance Arbitrary e => Arbitrary (Assocs e) where
-    arbitrary = sized $ \n -> do
-        m <- choose (0,n)
-        is <- QC.vector m 
-              >>= mapM (\(Index i) -> return i) 
-              >>= return . nub 
-              >>= return . filter (<n)
-        es <- QC.vector m
-        return $ Assocs n (zip is es)
-        
-    coarbitrary (Assocs n ies) = coarbitrary (n,ies)
-    
diff --git a/Test/QuickCheck/Vector/Dense.hs b/Test/QuickCheck/Vector/Dense.hs
deleted file mode 100644
--- a/Test/QuickCheck/Vector/Dense.hs
+++ /dev/null
@@ -1,92 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Test.QuickCheck.Vector.Dense
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-module Test.QuickCheck.Vector.Dense (
-    TestVector(..),
-    SubVector(..),
-    VectorPair(..),
-    VectorTriple(..),
-    
-    dvector,
-    rawVector,
-    conjVector,
-    subVector
-    ) where
-
-import Test.QuickCheck hiding ( vector )
-import qualified Test.QuickCheck as QC
-
-import Data.Vector.Dense
-import BLAS.Elem ( BLAS1 )
-
-newtype TestVector n e = TestVector (Vector n e) deriving (Eq, Show)
-data SubVector n e = SubVector Int (Vector n e) Int Int deriving (Eq, Show)
-data VectorPair n e = Pair (Vector n e) (Vector n e) deriving (Eq, Show)
-data VectorTriple n e = Triple (Vector n e) (Vector n e) (Vector n e) deriving (Eq, Show)
-
-
-dvector :: (BLAS1 e, Arbitrary e) => Int -> Gen (Vector n e)
-dvector 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 <- dvector 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 <- dvector (o + s*n + e)
-    return (SubVector s x o n)
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (TestVector n e) where
-    arbitrary = sized $ \m ->
-        choose (0,m) >>= dvector >>= return . TestVector
-    coarbitrary (TestVector x) =
-        coarbitrary (elems x)
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (SubVector n e) where
-    arbitrary = sized $ \m -> 
-        choose (0,m) >>= subVector
-    coarbitrary (SubVector s x o n) = 
-        coarbitrary (s,TestVector x,o,n)
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (VectorPair n e) where
-    arbitrary = sized $ \m -> do
-        n <- choose (0,m)
-        x <- dvector n
-        y <- dvector n
-        return $ Pair x y
-        
-    coarbitrary (Pair x y) = 
-        coarbitrary (TestVector x, TestVector y)
-        
-instance (Arbitrary e, BLAS1 e) => Arbitrary (VectorTriple n e) where
-    arbitrary = sized $ \m -> do
-        n <- choose (0,m)
-        x <- dvector n
-        y <- dvector n
-        z <- dvector n
-        return $ Triple x y z
-        
-    coarbitrary (Triple x y z) = 
-        coarbitrary (TestVector x, TestVector y, TestVector z)
-        
diff --git a/blas.cabal b/blas.cabal
--- a/blas.cabal
+++ b/blas.cabal
@@ -1,5 +1,5 @@
 name:            blas
-version:         0.5
+version:         0.6
 homepage:        http://stat.stanford.edu/~patperry/code/blas
 synopsis:        Bindings to the BLAS library
 description:
@@ -21,21 +21,42 @@
 author:          Patrick Perry
 maintainer:      Patrick Perry <patperry@stanford.edu>
 cabal-version:   >= 1.2.0
-build-type:      Custom
-tested-with:     GHC == 6.8.2
+build-type:      Simple
+tested-with:     GHC == 6.8.3
 
 extra-source-files:     INSTALL
                         NEWS
+                        TODO
+                        
+                        examples/LU.hs
+                        
                         tests/Makefile
+                        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/Matrix.hs
                         tests/Perm.hs
                         tests/HermMatrix.hs
                         tests/HermBanded.hs
                         tests/TriBanded.hs
                         tests/TriMatrix.hs
-                        tests/Vector.hs
 
 
 -- Below are the flags for specifying which CBLAS to link with.  If no flag
@@ -65,83 +86,95 @@
     -- You must edit this file below to use this option.  
 
 library
-    exposed-modules:    BLAS.Access
+    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.ReadOnly
+                            BLAS.Matrix.Mutable
                             BLAS.Matrix.Solve
                                 BLAS.Matrix.Solve.Immutable
-                                BLAS.Matrix.Solve.ReadOnly
+                                BLAS.Matrix.Solve.Mutable
+
                         BLAS.Tensor
                             BLAS.Tensor.Base
-                            BLAS.Tensor.Dense
-                                BLAS.Tensor.Dense.Immutable
-                                BLAS.Tensor.Dense.ReadOnly
                             BLAS.Tensor.Immutable
-                            BLAS.Tensor.ReadOnly
-                            BLAS.Tensor.Mutable
-                            BLAS.Tensor.Scalable
+                            BLAS.Tensor.Read
+                            BLAS.Tensor.Write
+
                         BLAS.Types
-                        BLAS.Vector
-                        
+
+                        BLAS.UnsafeIOToM
+
                         Data.Matrix.Banded
                             Data.Matrix.Banded.IO
-                            Data.Matrix.Banded.Internal
-                            Data.Matrix.Banded.Operations
-                        
-                        Data.Matrix.Diag
+                            Data.Matrix.Banded.ST
+                            Data.Matrix.Banded.Class
                         
                         Data.Matrix.Dense
                             Data.Matrix.Dense.IO
-                            Data.Matrix.Dense.Internal
-                            Data.Matrix.Dense.Operations
-                        
+                            Data.Matrix.Dense.ST
+                            Data.Matrix.Dense.Class
+
+                        Data.Matrix.Diag 
                         Data.Matrix.Perm
-                        
                         Data.Matrix.Herm
-                            Data.Matrix.Herm.Banded
-                            Data.Matrix.Herm.Dense
-                        
                         Data.Matrix.Tri
-                            Data.Matrix.Tri.Banded
-                            Data.Matrix.Tri.Dense
-                        
+
                         Data.Vector.Dense
                             Data.Vector.Dense.IO
-                            Data.Vector.Dense.Internal
-                            Data.Vector.Dense.Operations
+                            Data.Vector.Dense.ST
+                            Data.Vector.Dense.Class
+
+
+    other-modules:      BLAS.C.Double
+                        BLAS.C.Zomplex
                         
-                        Test.QuickCheck.Complex
-                        Test.QuickCheck.Permutation
-                        Test.QuickCheck.Vector
-                        Test.QuickCheck.Vector.Dense
-                        Test.QuickCheck.Matrix
-                        Test.QuickCheck.Matrix.Banded
-                        Test.QuickCheck.Matrix.Dense
-                        Test.QuickCheck.Matrix.Diag
-                        Test.QuickCheck.Matrix.Perm
-                        Test.QuickCheck.Matrix.Herm.Banded
-                        Test.QuickCheck.Matrix.Herm.Dense
-                        Test.QuickCheck.Matrix.Tri.Banded
-                        Test.QuickCheck.Matrix.Tri.Dense
+                        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
                         
-    other-modules:      BLAS.C.Double
-                        BLAS.C.Zomplex    
+                        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
                         
-    ghc-options:        -Wall                   
-    extensions:         BangPatterns, EmptyDataDecls, FlexibleContexts, 
+                        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
+                        
+    ghc-options:        -Wall
+    extensions:         BangPatterns, FlexibleContexts, 
                         FlexibleInstances, ForeignFunctionInterface, 
                         FunctionalDependencies, MultiParamTypeClasses
-    build-depends:      base, ieee, permutation, storable-complex, QuickCheck
+    build-depends:      base, ieee, permutation, storable-complex
 
     
     if flag(atlas)
diff --git a/examples/LU.hs b/examples/LU.hs
new file mode 100644
--- /dev/null
+++ b/examples/LU.hs
@@ -0,0 +1,65 @@
+
+module LU ( luFactorize ) where
+
+import BLAS.Elem( BLAS3 )
+
+import Control.Monad
+import Control.Monad.ST
+
+import Data.Matrix.Dense
+import Data.Matrix.Dense.ST
+import Data.Matrix.Tri
+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)
+            )
+
+
+{-
+ - Recursive LU factorization with row pivoting.  Takes a matrix
+ - A and factors it as P A = L U, where P is a permutation matrix, 
+ - L is a lower triangular matrix with ones along the diagonal, and 
+ - U is an upper triangular matrix.  On successful return, the values of
+ - L and U are stored in A, and a list of the row swaps are returned.
+ - On failure, the index of the failing column is returned.
+ -}      
+luFactorize :: (BLAS3 e) => STMatrix s (m,n) e -> ST s (Either Int [Int])
+luFactorize a
+    | mn > 1 =
+        let nleft = mn `div` 2
+            (a_1, a_2) = splitColsAt nleft a
+            (a11, a21) = splitRowsAt nleft a_1
+            (a12, a22) = splitRowsAt nleft a_2
+        in luFactorize a_1 >>=
+               either (return . Left) (\pivots -> do
+                   zipWithM_ (swapRows a_2) [0..] pivots
+                   doSolveMat_ (lowerU a11) a12
+                   doSApplyAddMat (-1) a21 a12 1 a22
+                   luFactorize a22 >>=
+                       either (return . Left . (nleft+)) (\pivots' -> do
+                           zipWithM_ (swapRows a21) [0..] pivots'
+                           return (Right $ pivots ++ map (nleft+) pivots')
+                       )
+               )
+    | mn == 1 = 
+        let x = colView a 0
+        in getWhichMaxAbs x >>= \(i,e) ->
+            if (e /= 0) 
+                then do
+                    scaleBy (1/e) x
+                    readElem x 0 >>= writeElem x i
+                    writeElem x 0 e
+                    return $ Right [i]
+                else
+                    return $ Left 0
+    | otherwise =
+        return (Right [])
+  where
+    (m,n) = shape a
+    mn    = min m n
diff --git a/tests/Banded.hs b/tests/Banded.hs
--- a/tests/Banded.hs
+++ b/tests/Banded.hs
@@ -7,96 +7,50 @@
 -- Stability  : experimental
 --
 
+module Banded( tests_Banded ) where
 
-import qualified Data.Array as Array
-import Data.Ix   ( inRange, range )
-import Data.List ( nub, sortBy, foldl' )
-import Data.Ord  ( comparing )
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
+import Driver
 
+import BLAS.Elem
+import Data.Vector.Dense 
+import Data.Matrix.Dense ( Matrix, identityMatrix )
 import Data.Matrix.Banded
 
-import BLAS.Elem ( BLAS1 )
-import qualified BLAS.Elem as E
-
-import Data.Complex ( Complex(..) )
-import Data.Vector.Dense hiding ( invScale )
-import Data.Matrix.Dense ( Matrix, identity )
-import qualified Data.Matrix.Dense as M
-
-import Data.AEq
-import Numeric.IEEE
-
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Vector hiding ( Assocs )
-import Test.QuickCheck.Vector.Dense hiding ( Pair )
-import Test.QuickCheck.Matrix
-import Test.QuickCheck.Matrix.Banded
-        
-isUndefR x = isNaN x || isInfinite x
-isUndefC (x :+ y) = isUndefR x || isUndefR y
+import Generators.Matrix
+import Generators.Matrix.Banded hiding ( banded )
         
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-isUndef = isUndefC
-#else
-field = "Double"
-type E = Double
-isUndef = isUndefR
-#endif        
-
 type V = Vector Int E
 type M = Matrix (Int,Int) E
 type B = Banded (Int,Int) E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (Vector n e) where
-    arbitrary   = arbitrary >>= \(TestVector x) -> return x
-    coarbitrary = coarbitrary . TestVector
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (Banded (m,n) e) where
-    arbitrary   = arbitrary >>= \(TestBanded x) -> return x
-    coarbitrary = coarbitrary . TestBanded
-
-
-assocsEq :: (BLAS1 e, AEq e) => Banded (m,n) e -> [((Int,Int), e)] -> Bool
-assocsEq x ijes =
-    let ijs = fst $ unzip ijes
-    in filter (\(ij,e) -> ij `elem` ijs) (sortBy (comparing fst) $ assocs x) === sortBy (comparing fst) ijes
-       && (all (==0) $ map snd $ filter (\(ij,e) -> not $ ij `elem` ijs) $ assocs x)
-
-fromAssocs (Assocs mn ijes) =
+fromAssocs (Assocs2 mn ijes) =
     let kl = foldl' max 0 $ map (\((i,j),_) -> (i-j)) ijes
         ku = foldl' max 0 $ map (\((i,j),_) -> (j-i)) ijes
     in banded mn (kl,ku) ijes 
     
-prop_banded_shape a@(Assocs mn _) =
+prop_banded_shape a@(Assocs2 mn _) =
     shape (fromAssocs a :: B) == mn
     
-prop_banded_assocs a@(Assocs mn ijes) =
-    (fromAssocs a :: B) `assocsEq` ijes
+prop_banded_assocs a@(Assocs2 (m,n) ijes) =
+    let as    = (assocs (fromAssocs a :: B))
+        ijes' = (reverse . (nubBy ((==) `on` fst)) . reverse) ijes
+    in (all (==0) $ map snd (as \\ ijes'))
+       && (length (as `intersect` ijes') === length ijes')
 
 prop_listsBanded_shape (ListsBanded mn lu ds) =
     shape (listsBanded mn lu ds :: B) == mn
     
-prop_listsBanded_toLists (ListsBanded mn lu ds) =
-    toLists (listsBanded mn lu ds :: B) === (mn,lu,ds)
-
-
+prop_listsBanded_listsFromBanded (ListsBanded mn lu ds) =
+    listsFromBanded (listsBanded mn lu ds :: B) === (mn,lu,ds)
 
-prop_replace_elems (a :: B) (Assocs _ ijes) =
+prop_replace_elems (a :: B) (Assocs2 _ ijes) =
     let ijes' = filter (\((i,j),_) -> i < numRows a 
-                                      && j < numCols a
-                                      && (i-j) <= numLower a
-                                      && (j-i) <= numUpper a) ijes
+                                   && j < numCols a
+                                   && (i-j) <= numLower a
+                                   && (j-i) <= numUpper a) ijes
         old = filter (\(ij,_) -> not $ ij `elem` (fst . unzip) ijes') $ assocs a
-        expected = sortBy (comparing fst) $ old ++ ijes'
+        new = (reverse . nubBy ((==) `on` fst) . reverse) ijes'
+        expected = sortBy (comparing fst) $ old ++ new
         actual   = sortBy (comparing fst) $ assocs (a // ijes')
     in expected === actual
 
@@ -116,17 +70,9 @@
 
 prop_bounds (a :: B) =
     bounds a == ((0,0), (numRows a - 1, numCols a - 1))
-    
+  
 prop_at (BandedAt (a :: B) ij@(i,j)) =
-    (a!ij) === expected
-    
-  where
-    (_,(kl,ku),ds) = toLists a
-    d = ds !! (kl + (j-i))
-    expected = case undefined of
-                   _ | i - j > kl -> 0
-                   _ | j - i > ku -> 0
-                   _ | otherwise  -> d!!i
+    (a!ij) === (diagBanded a (j-i))!(min i j)
     
 prop_row_dim (BandedAt (a :: B) (i,_)) =
     dim (row a i) == numCols a
@@ -157,11 +103,11 @@
     all (\(ij,e) -> a!ij === e) $ assocs a
 
 prop_scale_elems (a :: B) k =
-    and $ zipWith (~==) (elems (k *> a)) (map (k*) (elems a))
+    (assocs (k *> a)) `assocsEq` (map (second (*k)) (assocs a))
 prop_herm_elem (BandedAt (a :: B) (i,j)) =
-    (herm a) ! (j,i) === E.conj (a!(i,j))
+    (herm a) ! (j,i) === conj (a!(i,j))
 prop_herm_scale (a :: B) k =
-    herm (k *> a) === (E.conj k) *> (herm a)
+    herm (k *> a) === (conj k) *> (herm a)
 
 prop_herm_shape (a :: B) =
     shape (herm a) == (numCols a, numRows a)
@@ -174,17 +120,15 @@
     herm (herm a) === a
 
 prop_diag_herm1 (BandedAt (a :: B) (k,_)) =
-    diag a (-k) === conj (diag (herm a) k)
+    diagBanded a (-k) === conj (diagBanded (herm a) k)
 prop_diag_herm2 (BandedAt (a :: B) (_,k)) =
-    diag a k === conj (diag (herm a) (-k))
+    diagBanded a k === conj (diagBanded (herm a) (-k))
 
 
 prop_apply_basis (BandedAt (a :: B) (_,j)) =
-    a <*> (basis (numCols a) j :: V) ~== col a j
-    || (any isUndef $ elems a)
+    a <*> (basisVector (numCols a) j :: V) ~== col a j
 prop_apply_herm_basis (BandedAt (a :: B) (i,_)) =
-    (herm a) <*> (basis (numRows a) i :: V) ~== conj (row a i)
-    || (any isUndef $ elems a)    
+    (herm a) <*> (basisVector (numRows a) i :: V) ~== conj (row a i)
 prop_apply_scale k (BandedMV (a :: B) x) =
     a <*> (k *> x) ~== k *> (a <*> x)
 prop_apply_linear (BandedMVPair (a :: B) x y) =
@@ -196,82 +140,73 @@
     (k *> a) <**> b ~== k *> (a <**> b)
 prop_applyMat_linear (BandedMMPair (a :: B) b c) =
     (a <**> (b + c) ~== a <**> b + a <**> c)
-    || (any isUndef $ elems (a <**> b + a <**> c))
 prop_applyMat_cols (BandedMM (a :: B) b) =
-    M.cols (a <**> b) ~== map (a <*> ) (M.cols b)
+    cols (a <**> b) ~== map (a <*> ) (cols b)
 
 prop_scale k (a :: B) =
-    k *> a ~== amap (\e -> e * k) a
-prop_invScale k (a :: B) =
-    invScale k a ~== amap (\e -> e / k) a
-
+    k *> a ~== tmap (\e -> e * k) a
 
-properties =
-    [ ("shape of banded"       , pDet prop_banded_shape)
-    , ("assocs of banded"      , pDet prop_banded_assocs)
-    , ("shape of listsBanded"  , pDet prop_listsBanded_shape)
-    , ("listsBanded/toLists"   , pDet prop_listsBanded_toLists)
+tests_Banded =
+    [ ("shape of banded"       , mytest prop_banded_shape)
+    , ("assocs of banded"      , mytest prop_banded_assocs)
+    , ("shape of listsBanded"  , mytest prop_listsBanded_shape)
+    , ("listsFromBanded/listsBanded"
+                               , mytest prop_listsBanded_listsFromBanded)
 
-    , ("elems of replace"      , pDet prop_replace_elems)
+    , ("elems of replace"      , mytest prop_replace_elems)
     
-    , ("numRows/numCols"       , pDet prop_shape)
-    , ("numLower/numUpper"     , pDet prop_bandwidth)
-    , ("size"                  , pDet prop_size)
-    , ("bounds"                , pDet prop_bounds)
+    , ("numRows/numCols"       , mytest prop_shape)
+    , ("numLower/numUpper"     , mytest prop_bandwidth)
+    , ("size"                  , mytest prop_size)
+    , ("bounds"                , mytest prop_bounds)
 
-    , ("at"                    , pDet prop_at)
-    , ("row dim"               , pDet prop_row_dim)
-    , ("col dim"               , pDet prop_col_dim)
-    , ("rows length"           , pDet prop_rows_len)
-    , ("cols length"           , pDet prop_cols_len)
-    , ("rows dims"             , pDet prop_rows_dims)
-    , ("cols dims"             , pDet prop_cols_dims)
+    , ("at"                    , mytest prop_at)
+    , ("row dim"               , mytest prop_row_dim)
+    , ("col dim"               , mytest prop_col_dim)
+    , ("rows length"           , mytest prop_rows_len)
+    , ("cols length"           , mytest prop_cols_len)
+    , ("rows dims"             , mytest prop_rows_dims)
+    , ("cols dims"             , mytest prop_cols_dims)
 
-    , ("indices length"        , pDet prop_indices_length)
-    , ("indices low bw"        , pDet prop_indices_lower)
-    , ("indices up bw"         , pDet prop_indices_upper)
+    , ("indices length"        , mytest prop_indices_length)
+    , ("indices low bw"        , mytest prop_indices_lower)
+    , ("indices up bw"         , mytest prop_indices_upper)
 
-    , ("elems length"          , pDet prop_elems_length)
+    , ("elems length"          , mytest prop_elems_length)
 
-    , ("assocs"                , pDet prop_assocs)
-    , ("assocs/at"             , pDet prop_assocs_at)
+    , ("assocs"                , mytest prop_assocs)
+    , ("assocs/at"             , mytest prop_assocs_at)
 
-    , ("elems of scale"        , pDet prop_scale_elems)
-    , ("elem of herm"          , pDet prop_herm_elem)
-    , ("herm/scale"            , pDet prop_herm_scale)
+    , ("elems of scale"        , mytest prop_scale_elems)
+    , ("elem of herm"          , mytest prop_herm_elem)
+    , ("herm/scale"            , mytest prop_herm_scale)
                                
-    , ("shape . herm"          , pDet prop_herm_shape)
-    , ("rows . herm"           , pDet prop_herm_rows)
-    , ("cols . herm"           , pDet prop_herm_cols)
+    , ("shape . herm"          , mytest prop_herm_shape)
+    , ("rows . herm"           , mytest prop_herm_rows)
+    , ("cols . herm"           , mytest prop_herm_cols)
                                
-    , ("herm . herm == id"     , pDet prop_herm_herm)
+    , ("herm . herm == id"     , mytest prop_herm_herm)
                                
-    , ("subdiag . herm"        , pDet prop_diag_herm1)
-    , ("superdiag . herm"      , pDet prop_diag_herm2)
+    , ("subdiag . herm"        , mytest prop_diag_herm1)
+    , ("superdiag . herm"      , mytest prop_diag_herm2)
                                
-    , ("apply basis"           , pDet prop_apply_basis)
-    , ("apply herm basis"      , pDet prop_apply_herm_basis)
-    , ("apply scale"           , pDet prop_apply_scale)
-    , ("apply linear"          , pDet prop_apply_linear)
+    , ("apply basis"           , mytest prop_apply_basis)
+    , ("apply herm basis"      , mytest prop_apply_herm_basis)
+    , ("apply scale"           , mytest prop_apply_scale)
+    , ("apply linear"          , mytest prop_apply_linear)
     
-    , ("applyMat scale left"   , pDet prop_applyMat_scale_left)
-    , ("applyMat scale right"  , pDet prop_applyMat_scale_right)
-    , ("applyMat linear"       , pDet prop_applyMat_linear)
-    , ("applyMat cols"         , pDet prop_applyMat_cols)
+    , ("applyMat scale left"   , mytest prop_applyMat_scale_left)
+    , ("applyMat scale right"  , mytest prop_applyMat_scale_right)
+    , ("applyMat linear"       , mytest prop_applyMat_linear)
+    , ("applyMat cols"         , mytest prop_applyMat_cols)
     
-    , ("scale"                 , pDet prop_scale)
-    , ("invScale"              , pDet prop_invScale)
+    , ("scale"                 , mytest prop_scale)
     
     ]
 
-
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
-
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 400 properties
+assocsEq :: [((Int,Int), E)] -> [((Int,Int), E)] -> Bool
+assocsEq ies ies' = ordered ies ~== ordered ies'
+  where
+    ordered = sortAssocs . nubAssocs
+    nubAssocs = reverse . nubBy ((==) `on` fst) . reverse      
+    sortAssocs = sortBy (comparing fst)
diff --git a/tests/Diag.hs b/tests/Diag.hs
--- a/tests/Diag.hs
+++ b/tests/Diag.hs
@@ -1,51 +1,18 @@
-{-# OPTIONS -fglasgow-exts -fno-excess-precision -cpp #-}
------------------------------------------------------------------------------
--- |
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
+module Diag( tests_Diag ) where
+    
+import Driver
 
-import Data.Complex ( Complex(..) )
+import Generators.Matrix.Diag
 
 import qualified BLAS.Elem as E
 import Data.Vector.Dense
 import Data.Matrix.Dense
 import Data.Matrix.Diag
 
-import Data.AEq
-import Numeric.IEEE
-
-import Debug.Trace
-
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Matrix.Diag
-
-isUndefR x = isNaN x || isInfinite x
-isUndefC (x :+ y) = isUndefR x || isUndefR y
-        
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-isUndef = isUndefC
-#else
-field = "Double"
-type E = Double
-isUndef = isUndefR
-#endif        
-
 type V = Vector Int E
 type M = Matrix (Int,Int) E
-type D = Diag (Int,Int) E
+type D = Diag Vector (Int,Int) E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
 
 prop_diag_apply (DiagMV (d :: D) a x) =
     d <*> x ~== a <*> x
@@ -62,40 +29,28 @@
 
 prop_diag_solve (DiagSV (d :: D) y) =
     let x = d <\> y
-    in d <*> x ~== y || (any isUndef $ elems x)
+    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 || (any isUndef $ elems a)
+    in d <**> a ~== b
 
 prop_diag_ssolveMat k (DiagSM (d :: D) b) =
     ssolveMat k d b ~== d <\\> (k *> b)
 
 
-properties =
-    [ ("diag apply"             , pDet prop_diag_apply)
-    , ("diag sapply"            , pDet prop_diag_sapply)
-    , ("diag applyMat"          , pDet prop_diag_applyMat)
-    , ("diag sapplyMat"         , pDet prop_diag_sapplyMat)
+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"             , pDet prop_diag_solve)
-    , ("diag ssolve"            , pDet prop_diag_ssolve)
-    , ("diag solveMat"          , pDet prop_diag_solveMat)
-    , ("diag ssolveMat"         , pDet prop_diag_ssolveMat)
+    , ("diag solve"             , mytest prop_diag_solve)
+    , ("diag ssolve"            , mytest prop_diag_ssolve)
+    , ("diag solveMat"          , mytest prop_diag_solveMat)
+    , ("diag ssolveMat"         , mytest prop_diag_ssolveMat)
     
     ]
-
-
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
-
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 200 properties
diff --git a/tests/Driver.hs b/tests/Driver.hs
new file mode 100644
--- /dev/null
+++ b/tests/Driver.hs
@@ -0,0 +1,195 @@
+{-# LANGUAGE CPP #-}
+module Driver (
+    E,
+    
+    Natural(..),
+    Index(..),
+    Assocs(..),
+    
+    Natural2(..),
+    Index2(..),
+    Assocs2(..),
+    
+    module Control.Arrow,
+    module Control.Monad,
+    module Control.Monad.ST,
+    
+    module Data.AEq,
+    module Data.Function,
+    module Data.Ix,
+    module Data.List,
+    module Data.Ord,
+    
+    module Debug.Trace,
+    
+    module Test.QuickCheck,
+    
+    module Text.Printf,
+
+    field,
+
+    mytest,
+    mycheck,
+    mytests,
+    done,
+
+    ) where
+
+import Control.Arrow
+import Control.Monad
+import Control.Monad.ST
+
+import Data.AEq
+import Data.Complex
+import Data.Ix
+import Data.Function
+import Data.List
+import Data.Ord
+
+import Debug.Trace
+
+import System.IO
+import System.Random
+
+import Test.QuickCheck hiding ( vector )
+
+import Text.Printf
+import Text.Show.Functions
+
+import Generators.Matrix
+
+#ifdef COMPLEX
+field = "Complex Double"
+type E = Complex Double 
+#else
+field = "Double"
+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
+        n <- arbitrary
+        return $ Nat (abs n)
+        
+    coarbitrary = undefined
+
+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)
+        
+    coarbitrary = undefined
+
+data Index = Index Int Int deriving (Eq,Show)
+instance Arbitrary Index where
+    arbitrary = do
+        n <- arbitrary
+        i <- choose (0, abs n)
+        return $ Index i (abs n + 1)
+        
+    coarbitrary = undefined
+
+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)
+    
+    coarbitrary = undefined
+
+data Assocs = Assocs Int [(Int,E)] deriving (Eq,Show)
+instance Arbitrary Assocs where
+    arbitrary = do
+        (Nat n) <- arbitrary
+        (Nat s) <- if n == 0 then return (Nat 0) else arbitrary
+        ies <- replicateM s $ liftM2 (,) (choose (0,n-1)) arbitrary
+        return $ Assocs n ies
+        
+    coarbitrary = undefined
+
+data Assocs2 = Assocs2 (Int,Int) [((Int,Int),E)] deriving (Eq,Show)
+instance Arbitrary Assocs2 where
+    arbitrary = do
+        (Nat2 (m,n)) <- arbitrary
+        (Nat s) <- if m == 0 || n == 0 then return (Nat 0) else arbitrary
+        ijes <- replicateM s $ liftM2 (,) (liftM2 (,) (choose (0,m-1)) 
+                                                      (choose (0,n-1)))
+                                          arbitrary
+        return $ Assocs2 (m,n) ijes
+        
+    coarbitrary = undefined
+
+
+------------------------------------------------------------------------
+--
+-- QC driver ( taken from xmonad-0.6 )
+--
+
+debug = False
+
+mytest :: Testable a => a -> Int -> IO (Bool, Int)
+mytest a n = mycheck defaultConfig
+    { configMaxTest=n
+    , configEvery   = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] } a
+ -- , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
+
+mycheck :: Testable a => Config -> a -> IO (Bool, Int)
+mycheck config a = do
+    rnd <- newStdGen
+    mytests config (evaluate a) rnd 0 0 []
+
+mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO (Bool, Int)
+mytests config gen rnd0 ntest nfail stamps
+    | ntest == configMaxTest config = done "OK," ntest stamps >> return (True, ntest)
+    | nfail == configMaxFail config = done "Arguments exhausted after" ntest stamps >> return (True, ntest)
+    | otherwise               =
+      do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
+         case ok result of
+           Nothing    ->
+             mytests config gen rnd1 ntest (nfail+1) stamps
+           Just True  ->
+             mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
+           Just False ->
+             putStr ( "Falsifiable after "
+                   ++ show ntest
+                   ++ " tests:\n"
+                   ++ unlines (arguments result)
+                    ) >> hFlush stdout >> return (False, ntest)
+     where
+      result      = generate (configSize config ntest) rnd2 gen
+      (rnd1,rnd2) = split rnd0
+
+done :: String -> Int -> [[String]] -> IO ()
+done mesg ntest stamps = putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
+  where
+    table = display
+            . map entry
+            . reverse
+            . sort
+            . map pairLength
+            . group
+            . sort
+            . filter (not . null)
+            $ stamps
+
+    display []  = ".\n"
+    display [x] = " (" ++ x ++ ").\n"
+    display xs  = ".\n" ++ unlines (map (++ ".") xs)
+
+    pairLength xss@(xs:_) = (length xss, xs)
+    entry (n, xs)         = percentage n ntest
+                       ++ " "
+                       ++ concat (intersperse ", " xs)
+
+    percentage n m        = show ((100 * n) `div` m) ++ "%"
+
+------------------------------------------------------------------------
+
diff --git a/tests/Generators/Matrix.hs b/tests/Generators/Matrix.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix.hs
@@ -0,0 +1,20 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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'
+        
diff --git a/tests/Generators/Matrix/Banded.hs b/tests/Generators/Matrix/Banded.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix/Banded.hs
@@ -0,0 +1,184 @@
+{-# 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
diff --git a/tests/Generators/Matrix/Dense.hs b/tests/Generators/Matrix/Dense.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix/Dense.hs
@@ -0,0 +1,166 @@
+{-# 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
diff --git a/tests/Generators/Matrix/Diag.hs b/tests/Generators/Matrix/Diag.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix/Diag.hs
@@ -0,0 +1,111 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/tests/Generators/Matrix/Herm/Banded.hs b/tests/Generators/Matrix/Herm/Banded.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix/Herm/Banded.hs
@@ -0,0 +1,119 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/tests/Generators/Matrix/Herm/Dense.hs b/tests/Generators/Matrix/Herm/Dense.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix/Herm/Dense.hs
@@ -0,0 +1,91 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+        
diff --git a/tests/Generators/Matrix/Perm.hs b/tests/Generators/Matrix/Perm.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix/Perm.hs
@@ -0,0 +1,104 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/tests/Generators/Matrix/Tri/Banded.hs b/tests/Generators/Matrix/Tri/Banded.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix/Tri/Banded.hs
@@ -0,0 +1,155 @@
+{-# 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
+    
diff --git a/tests/Generators/Matrix/Tri/Dense.hs b/tests/Generators/Matrix/Tri/Dense.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Matrix/Tri/Dense.hs
@@ -0,0 +1,149 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+    
diff --git a/tests/Generators/Permutation.hs b/tests/Generators/Permutation.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Permutation.hs
@@ -0,0 +1,36 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/tests/Generators/Vector/Dense.hs b/tests/Generators/Vector/Dense.hs
new file mode 100644
--- /dev/null
+++ b/tests/Generators/Vector/Dense.hs
@@ -0,0 +1,97 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
diff --git a/tests/HermBanded.hs b/tests/HermBanded.hs
--- a/tests/HermBanded.hs
+++ b/tests/HermBanded.hs
@@ -1,45 +1,18 @@
-{-# OPTIONS -fglasgow-exts -fno-excess-precision -cpp #-}
------------------------------------------------------------------------------
--- |
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
 
-import Data.AEq
-import Numeric.IEEE
-
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
-
+module HermBanded( tests_HermBanded ) where
 
-import qualified BLAS.Elem as E
-import Data.Complex ( Complex(..) )
+import Driver
 
-import Data.Matrix.Herm.Banded
+import Data.Matrix.Herm
 import Data.Matrix.Banded
 import Data.Vector.Dense
 
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Matrix.Herm.Banded
-
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-#else
-field = "Double"
-type E = Double
-#endif
+import Generators.Matrix.Herm.Banded
 
 type V = Vector Int E
 type B = Banded (Int,Int) E
 type HB = Herm Banded (Int,Int) E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
 
 prop_herm_apply (HermBandedMV (h :: HB) a x) =
     h <*> x ~== a <*> x
@@ -60,23 +33,12 @@
     herm h <**> b ~== h <**> b
 
 
-properties =
-    [ ("herm apply"            , pDet prop_herm_apply)
-    , ("herm sapply"           , pDet prop_herm_sapply)
-    , ("herm herm apply"       , pDet prop_herm_herm_apply)
+tests_HermBanded =
+    [ ("herm apply"            , mytest prop_herm_apply)
+    , ("herm sapply"           , mytest prop_herm_sapply)
+    , ("herm herm apply"       , mytest prop_herm_herm_apply)
 
-    , ("herm applyMat"         , pDet prop_herm_applyMat)
-    , ("herm sapplyMat"        , pDet prop_herm_sapplyMat)
-    , ("herm herm applyMat"    , pDet prop_herm_herm_applyMat)
+    , ("herm applyMat"         , mytest prop_herm_applyMat)
+    , ("herm sapplyMat"        , mytest prop_herm_sapplyMat)
+    , ("herm herm applyMat"    , mytest prop_herm_herm_applyMat)
     ]
-
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
-
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 400 properties
diff --git a/tests/HermMatrix.hs b/tests/HermMatrix.hs
--- a/tests/HermMatrix.hs
+++ b/tests/HermMatrix.hs
@@ -1,46 +1,18 @@
-{-# OPTIONS -fglasgow-exts -fno-excess-precision -cpp #-}
------------------------------------------------------------------------------
--- |
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
 
-import Data.AEq
-import Numeric.IEEE
-
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
-
+module HermMatrix( tests_HermMatrix ) where
 
-import qualified BLAS.Elem as E
-import Data.Complex ( Complex(..) )
+import Driver
 
-import Data.Matrix.Herm.Dense
+import Data.Matrix.Herm
 import Data.Matrix.Dense
 import Data.Vector.Dense
 
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Matrix.Herm.Dense
-
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-#else
-field = "Double"
-type E = Double
-#endif
+import Generators.Matrix.Herm.Dense
 
 type V  = Vector Int E
 type M  = Matrix (Int,Int) E
 type HM = Herm Matrix (Int,Int) E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
-
 prop_herm_apply (HermMatrixMV (h :: HM) a x) =
     h <*> x ~== a <*> x
 
@@ -59,24 +31,12 @@
 prop_herm_herm_applyMat (HermMatrixMM (h :: HM) _ b) =
     herm h <**> b ~== h <**> b
 
-properties =
-    [ ("herm apply"            , pDet prop_herm_apply)
-    , ("herm sapply"           , pDet prop_herm_sapply)
-    , ("herm herm apply"       , pDet prop_herm_herm_apply)
+tests_HermMatrix =
+    [ ("herm apply"            , mytest prop_herm_apply)
+    , ("herm sapply"           , mytest prop_herm_sapply)
+    , ("herm herm apply"       , mytest prop_herm_herm_apply)
 
-    , ("herm applyMat"         , pDet prop_herm_applyMat)
-    , ("herm sapplyMat"        , pDet prop_herm_sapplyMat)
-    , ("herm herm applyMat"    , pDet prop_herm_herm_applyMat)
+    , ("herm applyMat"         , mytest prop_herm_applyMat)
+    , ("herm sapplyMat"        , mytest prop_herm_sapplyMat)
+    , ("herm herm applyMat"    , mytest prop_herm_herm_applyMat)
     ]
-
-
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
-
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 400 properties
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,51 @@
+
+import System.Environment
+
+import Driver
+
+import Vector
+import STVector
+import Matrix
+import STMatrix
+import Banded
+import HermMatrix
+import HermBanded
+import TriMatrix
+import TriBanded
+import Diag
+import Perm
+
+
+main :: IO ()
+main = do
+    args <- getArgs
+    let n = if null args then 100 else read (head args)
+    
+    printf "\nRunnings tests for field `%s'\n" field
+    
+    (results, passed) <- liftM unzip $
+        foldM ( \prev (name,subtests) -> do
+                     printf "\n%s\n" name
+                     printf "%s\n" $ replicate (length name) '-'
+                     cur <- mapM (\(s,a) -> printf "%-30s: " s >> a n) subtests
+                     return (prev ++ cur)
+              )
+              []
+              tests
+               
+    printf "\nPassed %d tests!\n\n" (sum passed)
+    when (not . and $ results) $ fail "\nNot all tests passed!"
+ where
+
+    tests = [ ("Vector"      , tests_Vector)
+            , ("STVector"    , tests_STVector)
+            , ("Matrix"      , tests_Matrix)
+            , ("STMatrix"    , tests_STMatrix)
+            , ("Banded"      , tests_Banded)
+            , ("Herm Matrix" , tests_HermMatrix)
+            , ("Herm Banded" , tests_HermBanded)
+            , ("Tri Matrix"  , tests_TriMatrix)
+            , ("Tri Banded"  , tests_TriBanded)
+            , ("Diag"        , tests_Diag)
+            , ("Perm"        , tests_Perm)
+            ]
diff --git a/tests/Makefile b/tests/Makefile
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -1,71 +1,13 @@
-# To build and run the tests, make sure you have blas installed and that you
-# also have the "pqc" package installed.
 
 
-# Change NTHREADS to the number of cores on your machine to run the tests
-# in parallel.
-NTHREADS = 1
-THREADS  = $(NTHREADS) +RTS -N$(NTHREADS) -RTS
-
 all:
-	ghc --make -fforce-recomp -O -DREAL -threaded Vector.hs -o vector-real
-	./vector-real $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded Vector.hs -o vector-cplx
-	./vector-cplx $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DREAL -threaded Matrix.hs -o matrix-real
-	./matrix-real $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded Matrix.hs -o matrix-cplx
-	./matrix-cplx $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DREAL -threaded HermMatrix.hs -o herm-matrix-real
-	./herm-matrix-real $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded HermMatrix.hs -o herm-matrix-cplx
-	./herm-matrix-cplx $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DREAL -threaded TriMatrix.hs -o tri-matrix-real
-	./tri-matrix-real $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded TriMatrix.hs -o tri-matrix-cplx
-	./tri-matrix-cplx $(THREADS)
-
-	ghc --make -fforce-recomp -O -DREAL -threaded Banded.hs -o banded-real
-	./banded-real $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded Banded.hs -o banded-cplx
-	./banded-cplx $(THREADS)
-
-	ghc --make -fforce-recomp -O -DREAL -threaded HermBanded.hs -o herm-banded-real
-	./herm-banded-real $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded HermBanded.hs -o herm-banded-cplx
-	./herm-banded-cplx $(THREADS)
-
-	ghc --make -fforce-recomp -O -DREAL -threaded TriBanded.hs -o tri-banded-real
-	./tri-banded-real $(THREADS)
-	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded TriBanded.hs -o tri-banded-cplx
-	./tri-banded-cplx $(THREADS)
-
-	ghc --make -fforce-recomp -O -DREAL -threaded Perm.hs -o perm-real
-	./perm-real $(THREADS)
+	ghc --make -fforce-recomp -XPatternSignatures -DREAL Main.hs -o test-real
+	./test-real
 	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded Perm.hs -o perm-cplx
-	./perm-cplx $(THREADS)
-
-	ghc --make -fforce-recomp -O -DREAL -threaded Diag.hs -o diag-real
-	./diag-real $(THREADS)
+	ghc --make -fforce-recomp -XPatternSignatures -DCOMPLEX Main.hs -o test-complex
+	./test-complex
 	
-	ghc --make -fforce-recomp -O -DCOMPLEX -threaded Diag.hs -o diag-cplx
-	./diag-cplx $(THREADS)
-
-
-
 clean:
-	rm -f *~ *.hi *.o vector-real vector-cplx matrix-real matrix-cplx \
-	herm-matrix-real herm-matrix-cplx tri-matrix-real tri-matrix-cplx \
-	banded-real banded-cplx herm-banded-real herm-banded-cplx \
-	tri-banded-real tri-banded-cplx perm-real perm-cplx diag-real diag-cplx
+	find . -name '*.hi' | xargs rm -f
+	find . -name '*.o'  | xargs rm -f
+	rm -f test-real test-complex
diff --git a/tests/Matrix.hs b/tests/Matrix.hs
--- a/tests/Matrix.hs
+++ b/tests/Matrix.hs
@@ -1,104 +1,60 @@
-{-# OPTIONS -fglasgow-exts -fno-excess-precision -cpp #-}
------------------------------------------------------------------------------
--- |
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
+{-# LANGUAGE PatternSignatures #-}
 
+module Matrix( tests_Matrix ) where
 
+import Driver
 import qualified Data.Array as Array
-import Data.Ix   ( inRange, range )
-import Data.List ( nub, sortBy )
-import Data.Ord  ( comparing )
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
 
+import BLAS.Elem
 import Data.Matrix.Dense
-import Data.Vector.Dense hiding ( shift, scale, invScale )
-
-import BLAS.Elem ( BLAS1 )
-import qualified BLAS.Elem as E
-
-import Data.Complex ( Complex(..) )
-
-import Data.AEq
-import Numeric.IEEE
+import Data.Vector.Dense
 
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Vector hiding ( Assocs )
-import Test.QuickCheck.Vector.Dense hiding ( Pair )
-import Test.QuickCheck.Matrix
-import Test.QuickCheck.Matrix.Dense
+import Generators.Matrix.Dense hiding ( matrix )
         
 
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-#else
-field = "Double"
-type E = Double
-#endif
-
 type V = Vector Int E
 type M = Matrix (Int,Int) E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
 
-instance (Arbitrary e, BLAS1 e) => Arbitrary (Vector n e) where
-    arbitrary   = arbitrary >>= \(TestVector x) -> return x
-    coarbitrary = coarbitrary . TestVector
-
-instance (Arbitrary e, BLAS1 e) => Arbitrary (Matrix (m,n) e) where
-    arbitrary   = arbitrary >>= \(TestMatrix x) -> return x
-    coarbitrary = coarbitrary . TestMatrix
-
-
-assocsEq :: (BLAS1 e, AEq e) => Matrix (m,n) e -> [((Int,Int), e)] -> Bool
-assocsEq x ijes =
-    let ijs = fst $ unzip ijes
-    in filter (\(ij,e) -> ij `elem` ijs) (sortBy (comparing fst) $ assocs x) === sortBy (comparing fst) ijes
-       && (all (==0) $ map snd $ filter (\(ij,e) -> not $ ij `elem` ijs) $ assocs x)
-
-prop_matrix_shape (Assocs mn ijes) =
+prop_matrix_shape (Assocs2 mn ijes) =
     shape (matrix mn ijes :: M) == mn
-prop_matrix_assocs (Assocs mn ijes) =
-    (matrix mn ijes :: M) `assocsEq` ijes
+prop_matrix_assocs (Assocs2 (m,n) ijes) =
+    assocs (matrix (m,n) ijes :: M) 
+    `assocsEq` 
+    (zip (range ((0,0),(m-1,n-1))) (repeat 0) ++ ijes)
 
-prop_listMatrix_shape (IndexPair mn) es =
+prop_listMatrix_shape (Nat2 mn) es =
     shape (listMatrix mn es :: M) == mn
-prop_listMatrix_assocs (IndexPair (m,n)) es =
+prop_listMatrix_assocs (Nat2 (m,n)) es =
     let es' = repeat es
-    in assocs (listMatrix (m,n) es' :: M) === zip [(i,j) | j <- range (0,n-1), i <- range (0,m-1)] es'
+    in assocs (listMatrix (m,n) es' :: M) 
+       === 
+       zip [(i,j) | j <- range (0,n-1), i <- range (0,m-1)] es'
 
-prop_zero_shape (IndexPair mn) =
-    shape (zero mn :: M) == mn
-prop_zero_elems (IndexPair (m,n)) =
-    elems (zero (m,n) :: M) == replicate (m*n) 0
+prop_zero_shape (Nat2 mn) =
+    shape (zeroMatrix mn :: M) == mn
+prop_zero_elems (Nat2 (m,n)) =
+    elems (zeroMatrix (m,n) :: M) == replicate (m*n) 0
 
-prop_constant_shape (IndexPair mn) (e :: E) =
-    shape (constant mn e :: M) == mn
-prop_constant_elems (IndexPair (m,n)) (e :: E) =
-    elems (constant (m,n) e :: M) == replicate (m*n) e
+prop_constant_shape (Nat2 mn) (e :: E) =
+    shape (constantMatrix mn e :: M) == mn
+prop_constant_elems (Nat2 (m,n)) (e :: E) =
+    elems (constantMatrix (m,n) e :: M) == replicate (m*n) e
 
-prop_identity_shape (IndexPair mn) =
-    shape (identity mn :: M) == mn
-prop_identity_diag (IndexPair (m,n)) =
-    diag (identity (m,n) :: M) 0 === (constant (min m n) 1)
-prop_identity_row (Basis m i) (Basis n _) =
+prop_identityMatrix_shape (Nat2 mn) =
+    shape (identityMatrix mn :: M) == mn
+prop_identityMatrix_diag (Nat2 (m,n)) =
+    diag (identityMatrix (m,n) :: M) 0 === (constantVector (min m n) 1)
+prop_identityMatrix_row (Index i m) (Index _ n) =
     if i < min m n 
-        then row (identity (m,n) :: M) i === basis n i
-        else row (identity (m,n) :: M) i === zero n
-prop_identity_col (Basis m _) (Basis n j) =
+        then row (identityMatrix (m,n) :: M) i === basisVector n i
+        else row (identityMatrix (m,n) :: M) i === zeroVector n
+prop_identityMatrix_col (Index _ m) (Index j n) =
     if j < min m n
-        then col (identity (m,n) :: M) j === basis m j
-        else col (identity (m,n) :: M) j === zero m
+        then col (identityMatrix (m,n) :: M) j === basisVector m j
+        else col (identityMatrix (m,n) :: M) j === zeroVector m
 
-prop_replace_elems (a :: M) (Assocs _ ijes) =
+prop_replace_elems (a :: M) (Assocs2 _ ijes) =
     let ijes' = filter (\((i,j),_) -> i < numRows a && j < numCols a) ijes
         a'   = a // ijes'
         mn   = (numRows a - 1, numCols a - 1)
@@ -111,7 +67,7 @@
     shape (submatrix a ij mn :: M) == mn
 prop_submatrix_rows (SubMatrix a (i,j) (m,n)) =
     rows (submatrix a (i,j) (m,n) :: M) === map (\k -> subvector (row a (i+k)) j n) [0..(m-1)]
-prop_submatrix_cols (SubMatrix a (i,j) (m,n)) (Index l) =
+prop_submatrix_cols (SubMatrix a (i,j) (m,n)) =
     cols (submatrix a (i,j) (m,n) :: M) === map (\l -> subvector (col a (j+l)) i m) [0..(n-1)]
 
 prop_shape (a :: M) = 
@@ -121,15 +77,17 @@
 prop_bounds (a :: M) =
     bounds a == ((0,0), (numRows a - 1, numCols a - 1))
     
-prop_at (MatAt (a :: M) (i,j)) =
+prop_at (MatrixAt (a :: M) (i,j)) =
     let ij = (i,j)
-        k  = i + j * numRows a
+        k  = if isHermMatrix a then j + i * numCols a
+                               else i + j * numRows a
     in (a!ij) === ((elems a) !! k)
     
-prop_row_dim (MatAt (a :: M) (i,_)) =
+prop_row_dim (MatrixAt (a :: M) (i,_)) =
     dim (row a i) == numCols a
-prop_col_dim (MatAt (a :: M) (_,j)) =
+prop_col_dim (MatrixAt (a :: M) (_,j)) =
     dim (col a j) == numRows a
+    
 prop_rows_len (a :: M) =
     length (rows a) == numRows a
 prop_cols_len (a :: M) =
@@ -139,20 +97,28 @@
 prop_cols_dims (a :: M) =
     map dim (cols a) == replicate (numCols a) (numRows a)
 
-prop_indices (a :: M) =
-    let (m,n) = shape a
-    in indices a == [(i,j) | j <- range (0,n-1), i <- range(0,m-1)]
-prop_elems (a :: M) =
-    and $ zipWith (===) (elems a) $ concatMap elems (cols a)
+prop_indices (a :: M)
+    | isHermMatrix a =
+        indices a == [(i,j) | i <- range (0,m-1), j <- range(0,n-1)]
+    | otherwise =
+        indices a == [(i,j) | j <- range (0,n-1), i <- range(0,m-1)]
+  where (m,n) = shape a
+  
+prop_elems (a :: M) 
+    | isHermMatrix a =
+        elems a === concatMap elems (rows a)        
+    | otherwise =
+        elems a === concatMap elems (cols a)
+        
 prop_assocs (a :: M) = 
     assocs a === zip (indices a) (elems a)
 
 prop_scale_elems (a :: M) k =
     and $ zipWith (~==) (elems (k *> a)) (map (k*) (elems a))
-prop_herm_elem (MatAt (a :: M) (i,j)) =
-    (herm a) ! (j,i) == E.conj (a!(i,j))
+prop_herm_elem (MatrixAt (a :: M) (i,j)) =
+    (herm a) ! (j,i) == conj (a!(i,j))
 prop_herm_scale (a :: M) k =
-    herm (k *> a) === (E.conj k) *> (herm a)
+    herm (k *> a) === (conj k) *> (herm a)
 
 prop_herm_shape (a :: M) =
     shape (herm a) == (numCols a, numRows a)
@@ -164,64 +130,63 @@
 prop_herm_herm (a :: M) =
     herm (herm a) === a
 
-prop_diag_herm1 (MatAt (a :: M) (k,_)) =
+prop_diag_herm1 (MatrixAt (a :: M) (k,_)) =
     diag a (-k) === conj (diag (herm a) k)
-prop_diag_herm2 (MatAt (a :: M) (_,k)) =
+prop_diag_herm2 (MatrixAt (a :: M) (_,k)) =
     diag a k === conj (diag (herm a) (-k))
 
-prop_fromRow_shape (x :: V) =
-    shape (fromRow x :: M) == (1,dim x)
-prop_fromRow_elems (x :: V) =
-    elems (fromRow x :: M) === elems x
-
-prop_fromCol_shape (x :: V) =
-    shape (fromCol x :: M) == (dim x,1)
-prop_fromCol_elems (x :: V) =
-    elems (fromCol x :: M) === elems x
+prop_rowMatrix_shape (x :: V) =
+    shape (rowMatrix x :: M) == (1,dim x)
+prop_rowMatrix_elems (x :: V) =
+    elems (rowMatrix 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_apply_basis (MatAt (a :: M) (_,j)) =
-    a <*> (basis (numCols a) j :: V) ~== col a j
-prop_apply_herm_basis (MatAt (a :: M) (i,_)) =
-    (herm a) <*> (basis (numRows a) i :: V) ~== conj (row a i)
-prop_apply_scale k (MultMV (a :: M) x) =
-    a <*> (k *> x) ~== k *> (a <*> x)
-prop_apply_linear (MultMVPair (a :: M) x y) =
+prop_apply_basis (MatrixAt (a :: M) (_,j)) =
+    a <*> (basisVector (numCols a) j :: V) ~== col a j
+prop_apply_herm_basis (MatrixAt (a :: M) (i,_)) =
+    (herm a) <*> (basisVector (numRows a) i :: V) ~== conj (row a i)
+prop_apply_scale k (MatrixMV (a :: M) x) =
+    sapply k a x ~== k *> (a <*> x)
+prop_apply_linear (MatrixMVPair (a :: M) x y) =
     a <*> (x + y) ~== a <*> x + a <*> y
 
-prop_compose_id_right (a :: M) =
+prop_applyMat_id_right (a :: M) =
     let n = numCols a
-    in a <**> (identity (n,n) :: M) ~== a
-prop_compose_id_left (a :: M) =
+    in a <**> (identityMatrix (n,n) :: M) ~== a
+prop_applyMat_id_left (a :: M) =
     let m = numRows a
-    in (identity (m,m) :: M) <**> a ~== a
-prop_compose_scale_left (MultMM (a:: M) b) k =
+    in (identityMatrix (m,m) :: M) <**> a ~== a
+prop_applyMat_scale_left (MatrixMM (a:: M) b) k =
     a <**> (k *> b) ~== k *> (a <**> b)    
-prop_compose_scale_right (MultMM (a:: M) b) k =
+prop_applyMat_scale_right (MatrixMM (a:: M) b) k =
     (k *> a) <**> b ~== k *> (a <**> b)
-prop_compose_linear (MultMMPair (a :: M) b c) =
+prop_applyMat_linear (MatrixMMPair (a :: M) b c) =
     a <**> (b + c) ~== a <**> b + a <**> c
-prop_compose_herm (MultMM (a :: M) b) =
+prop_applyMat_herm (MatrixMM (a :: M) b) =
     herm b <**> herm a ~== herm (a <**> b)
-prop_compose_cols (MultMM (a :: M) b) =
+prop_applyMat_cols (MatrixMM (a :: M) b) =
     cols (a <**> b) ~== map (a <*> ) (cols b)
 
 prop_shift k (a :: M) =
-    shift k a ~== a + constant (shape a) k
+    shift k a ~== a + constantMatrix (shape a) k
 prop_scale k (a :: M) =
-    k *> a ~== a * constant (shape a) k
-prop_invScale k (a :: M) =
-    invScale k a ~== a / constant (shape a) k
+    k *> a ~== a * constantMatrix (shape a) k
 
-prop_plus (Pair (a :: M) b) =
-    elems (a + b) ~== zipWith (+) (elems a) (elems b)
-prop_minus (Pair (a :: M) b) =
-    elems (a - b) ~== zipWith (-) (elems a) (elems b)
-prop_times (Pair (a :: M) b) =
-    elems (a * b) ~== zipWith (*) (elems a) (elems b)
-prop_divide (Pair (a :: M) b) =
-    elems (a / b) ~== zipWith (/) (elems a) (elems b)
+prop_plus (MatrixPair (a :: M) b) =
+    colElems (a + b) ~== zipWith (+) (colElems a) (colElems b)
+prop_minus (MatrixPair (a :: M) b) =
+    colElems (a - b) ~== zipWith (-) (colElems a) (colElems b)
+prop_times (MatrixPair (a :: M) b) =
+    colElems (a * b) ~== zipWith (*) (colElems a) (colElems b)
+prop_divide (MatrixPair (a :: M) b) =
+    colElems (a / b) ~== zipWith (/) (colElems a) (colElems b)
 
+colElems a = concatMap elems (cols a)
+
 prop_negate (a :: M) =
     negate a ~== (-1) *> a
     
@@ -232,98 +197,91 @@
 prop_recip (a :: M) =
     elems (recip a) ~== (map recip $ elems a)
 
-properties =
-    [ ("shape of matrix"       , pDet prop_matrix_shape)
-    , ("assocs of matrix"      , pDet prop_matrix_assocs)
-    , ("shape of listMatrix"   , pDet prop_listMatrix_shape)
-    , ("assocs of listMatrix"  , pDet prop_listMatrix_assocs)
-    , ("shape of zero"         , pDet prop_zero_shape)
-    , ("elems of zero"         , pDet prop_zero_elems)
+tests_Matrix =
+    [ ("shape of matrix"       , mytest prop_matrix_shape)
+    , ("assocs of matrix"      , mytest prop_matrix_assocs)
+    , ("shape of listMatrix"   , mytest prop_listMatrix_shape)
+    , ("assocs of listMatrix"  , mytest prop_listMatrix_assocs)
+    , ("shape of zero"         , mytest prop_zero_shape)
+    , ("elems of zero"         , mytest prop_zero_elems)
     
-    , ("shape of constant"     , pDet prop_constant_shape)
-    , ("elems of constant"     , pDet prop_constant_elems)
+    , ("shape of constant"     , mytest prop_constant_shape)
+    , ("elems of constant"     , mytest prop_constant_elems)
     
-    , ("shape of identity"     , pDet prop_identity_shape)
-    , ("diag of identity"      , pDet prop_identity_diag)
-    , ("row of identity"       , pDet prop_identity_row)
-    , ("col of identity"       , pDet prop_identity_col)
+    , ("shape of identityMatrix"     , mytest prop_identityMatrix_shape)
+    , ("diag of identityMatrix"      , mytest prop_identityMatrix_diag)
+    , ("row of identityMatrix"       , mytest prop_identityMatrix_row)
+    , ("col of identityMatrix"       , mytest prop_identityMatrix_col)
     
-    , ("elems of replace"      , pDet prop_replace_elems)
+    , ("elems of replace"      , mytest prop_replace_elems)
     
-    , ("numRows/numCols"       , pDet prop_shape)
-    , ("size"                  , pDet prop_size)
-    , ("bounds"                , pDet prop_bounds)
-    , ("at"                    , pDet prop_at)
-    , ("row dim"               , pDet prop_row_dim)
-    , ("col dim"               , pDet prop_col_dim)
-    , ("rows length"           , pDet prop_rows_len)
-    , ("cols length"           , pDet prop_cols_len)
-    , ("rows dims"             , pDet prop_rows_dims)
-    , ("cols dims"             , pDet prop_cols_dims)
+    , ("numRows/numCols"       , mytest prop_shape)
+    , ("size"                  , mytest prop_size)
+    , ("bounds"                , mytest prop_bounds)
+    , ("at"                    , mytest prop_at)
+    , ("row dim"               , mytest prop_row_dim)
+    , ("col dim"               , mytest prop_col_dim)
+    , ("rows length"           , mytest prop_rows_len)
+    , ("cols length"           , mytest prop_cols_len)
+    , ("rows dims"             , mytest prop_rows_dims)
+    , ("cols dims"             , mytest prop_cols_dims)
 
-    , ("indices"               , pDet prop_indices)
-    , ("elems"                 , pDet prop_elems)
-    , ("assocs"                , pDet prop_assocs)
+    , ("indices"               , mytest prop_indices)
+    , ("elems"                 , mytest prop_elems)
+    , ("assocs"                , mytest prop_assocs)
     
-    , ("shape of submatrix"    , pDet prop_submatrix_shape)
-    , ("rows of submatrix"     , pDet prop_submatrix_rows)
-    , ("col of submatrix"      , pDet prop_submatrix_cols)
+    , ("shape of submatrix"    , mytest prop_submatrix_shape)
+    , ("rows of submatrix"     , mytest prop_submatrix_rows)
+    , ("col of submatrix"      , mytest prop_submatrix_cols)
     
-    , ("elems of scale"        , pDet prop_scale_elems)
-    , ("elem of herm"          , pDet prop_herm_elem)
-    , ("herm/scale"            , pDet prop_herm_scale)
-                               
-    , ("shape . herm"          , pDet prop_herm_shape)
-    , ("rows . herm"           , pDet prop_herm_rows)
-    , ("cols . herm"           , pDet prop_herm_cols)
+    , ("elems of scale"        , mytest prop_scale_elems)
+    , ("elem of herm"          , mytest prop_herm_elem)
+    , ("herm/scale"            , mytest prop_herm_scale)
                                
-    , ("herm . herm == id"     , pDet prop_herm_herm)
+    , ("shape . herm"          , mytest prop_herm_shape)
+    , ("rows . herm"           , mytest prop_herm_rows)
+    , ("cols . herm"           , mytest prop_herm_cols)
                                
-    , ("subdiag . herm"        , pDet prop_diag_herm1)
-    , ("superdiag . herm"      , pDet prop_diag_herm2)
+    , ("herm . herm == id"     , mytest prop_herm_herm)
                                
-    , ("shape . fromRow"       , pDet prop_fromRow_shape)
-    , ("elems . fromRow"       , pDet prop_fromRow_elems)
-    , ("shape . fromCol"       , pDet prop_fromCol_shape)
-    , ("elems . fromCol"       , pDet prop_fromCol_elems)
+    , ("subdiag . herm"        , mytest prop_diag_herm1)
+    , ("superdiag . herm"      , mytest prop_diag_herm2)
                                
-    , ("apply basis"           , pDet prop_apply_basis)
-    , ("apply herm basis"      , pDet prop_apply_herm_basis)
-    , ("apply scale"           , pDet prop_apply_scale)
-    , ("apply linear"          , pDet prop_apply_linear)
-    
-    , ("compose id left"       , pDet prop_compose_id_left)
-    , ("compose id right"      , pDet prop_compose_id_right)
-    , ("compose scale left"    , pDet prop_compose_scale_left)
-    , ("compose scale right"   , pDet prop_compose_scale_right)
-    , ("compose linear"        , pDet prop_compose_linear)
-    , ("compose herm"          , pDet prop_compose_herm)
-    , ("compose cols"          , pDet prop_compose_cols)
+    , ("shape . rowMatrix"       , mytest prop_rowMatrix_shape)
+    , ("elems . rowMatrix"       , mytest prop_rowMatrix_elems)
+    , ("shape . colMatrix"       , mytest prop_colMatrix_shape)
+    , ("elems . colMatrix"       , mytest prop_colMatrix_elems)
+
+    , ("apply basis"           , mytest prop_apply_basis)
+    , ("apply herm basis"      , mytest prop_apply_herm_basis)
+    , ("apply scale"           , mytest prop_apply_scale)
+    , ("apply linear"          , mytest prop_apply_linear)
     
-    , ("shift"                 , pDet prop_shift)
-    , ("scale"                 , pDet prop_scale)
-    , ("invScale"              , pDet prop_invScale)
+    , ("applyMat id left"       , mytest prop_applyMat_id_left)
+    , ("applyMat id right"      , mytest prop_applyMat_id_right)
+    , ("applyMat scale left"    , mytest prop_applyMat_scale_left)
+    , ("applyMat scale right"   , mytest prop_applyMat_scale_right)
+    , ("applyMat linear"        , mytest prop_applyMat_linear)
+    , ("applyMat herm"          , mytest prop_applyMat_herm)
+    , ("applyMat cols"          , mytest prop_applyMat_cols)
+    , ("shift"                 , mytest prop_shift)
+    , ("scale"                 , mytest prop_scale)
     
-    , ("plus"                  , pDet prop_plus)
-    , ("minus"                 , pDet prop_minus)
-    , ("times"                 , pDet prop_times)
-    , ("divide"                , pDet prop_divide)
+    , ("plus"                  , mytest prop_plus)
+    , ("minus"                 , mytest prop_minus)
+    , ("times"                 , mytest prop_times)
+    , ("divide"                , mytest prop_divide)
     
-    , ("negate"                , pDet prop_negate)
-    , ("abs"                   , pDet prop_abs)
-    , ("signum"                , pDet prop_signum)
-    , ("recip"                 , pDet prop_recip)
-
+    , ("negate"                , mytest prop_negate)
+    , ("abs"                   , mytest prop_abs)
+    , ("signum"                , mytest prop_signum)
+    , ("recip"                 , mytest prop_recip)
     ]
 
 
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
-
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 400 properties
+assocsEq :: [((Int,Int), E)] -> [((Int,Int), E)] -> Bool
+assocsEq ies ies' = ordered ies ~== ordered ies'
+  where
+    ordered = sortAssocs . nubAssocs
+    nubAssocs = reverse . nubBy ((==) `on` fst) . reverse      
+    sortAssocs = sortBy (comparing fst)
diff --git a/tests/Perm.hs b/tests/Perm.hs
--- a/tests/Perm.hs
+++ b/tests/Perm.hs
@@ -1,19 +1,8 @@
-{-# OPTIONS -fglasgow-exts -fno-excess-precision -cpp #-}
------------------------------------------------------------------------------
--- |
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
 
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
-
-import Data.Complex ( Complex(..) )
+module Perm( tests_Perm ) where
+    
+import Driver
 
-import qualified BLAS.Elem as E
 import Data.Vector.Dense
 import Data.Matrix.Dense
 import Data.Matrix.Perm
@@ -21,38 +10,17 @@
 import Data.Permutation ( Permutation, permutation )
 import qualified Data.Permutation as P
 
-import Data.AEq
-import Numeric.IEEE
-
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Matrix.Perm
-
-isUndefR x = isNaN x || isInfinite x
-isUndefC (x :+ y) = isUndefR x || isUndefR y
-        
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-isUndef = isUndefC
-#else
-field = "Double"
-type E = Double
-isUndef = isUndefR
-#endif        
+import Generators.Matrix.Perm
 
 type V = Vector Int E
 type M = Matrix (Int,Int) E
 type P = Perm (Int,Int) E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
-
 prop_perm_herm (TestPerm (p :: P)) =
     toPermutation (herm p) == P.inverse (toPermutation p)
 
 prop_perm_apply_basis (PermMBasis (p :: P) i) =
-    n > 0 ==> p <*> (basis n i) === basis n (P.apply (toPermutation p) i)
+    n > 0 ==> p <*> (basisVector n i) === basisVector n (P.apply (toPermutation p) i)
   where
     n = numCols p
 
@@ -81,27 +49,15 @@
     p <\\> a === herm p <**> a
     
 
-properties =
-    [ ("perm herm"             , pDet prop_perm_herm)
-    , ("perm apply basis"      , pDet prop_perm_apply_basis)
-    , ("perm herm apply"       , pDet prop_perm_herm_apply)
-    , ("herm perm apply"       , pDet prop_herm_perm_apply)
-    , ("perm solve"            , pDet prop_perm_solve)
-    , ("perm applyMat cols"    , pDet prop_perm_applyMat_cols)
-    , ("perm herm applyMat"    , pDet prop_perm_herm_applyMat)
-    , ("herm perm applyMat"    , pDet prop_herm_perm_applyMat)
-    , ("perm solveMat cols"    , pDet prop_perm_solveMat_cols)
-    , ("perm solveMat"         , pDet prop_perm_solveMat)
+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)
     ]
-
-
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
-
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 400 properties
diff --git a/tests/STMatrix.hs b/tests/STMatrix.hs
new file mode 100644
--- /dev/null
+++ b/tests/STMatrix.hs
@@ -0,0 +1,347 @@
+{-# LANGUAGE Rank2Types, PatternSignatures #-}
+module STMatrix ( tests_STMatrix ) where
+
+
+import BLAS.Elem
+import Data.Matrix.Dense
+import Data.Matrix.Dense.ST
+
+import qualified Generators.Matrix.Dense as Test
+
+import Driver
+
+
+
+-------------------------- Creating Matrices --------------------------------
+
+newMatrix_S = matrix
+
+prop_NewMatrix (Assocs2 mn ijes) =
+    newMatrix mn ijes `equivalent` newMatrix_S mn ijes
+
+newListMatrix_S = listMatrix
+
+prop_NewListMatrix (Nat2 mn) es =
+    newListMatrix mn es `equivalent` newListMatrix_S mn es
+
+---------------------- Reading and Writing Elements --------------------------
+
+getSize_S a = ( size a, a )
+prop_GetSize = getSize `implements` getSize_S
+
+readElem_S a ij = ( a!ij, a )
+prop_ReadElem (Index2 ij mn) =
+    implementsFor mn (`readElem` ij) (`readElem_S` ij)
+
+canModifyElem_S a ij = ( True, a )
+prop_CanModifyElem ij = (`canModifyElem` ij) `implements` (`canModifyElem_S` ij)
+
+writeElem_S a ij e = ( (), a // [(ij,e)] )
+prop_WriteElem (Index2 ij mn) e =
+    implementsFor mn (\a -> writeElem a ij e) (\a -> writeElem_S a ij e)
+
+modifyElem_S a ij f = writeElem_S a ij $ f (a!ij)
+prop_ModifyElem (Index2 ij mn) f =
+    implementsFor mn (\a -> modifyElem a ij f) (\a -> modifyElem_S a ij f)
+
+getIndices_S a = ( indices a, a )
+
+prop_GetIndicesLazy   = getIndices `implements`  getIndices_S
+prop_GetIndicesStrict = getIndices' `implements` getIndices_S
+    
+getElemsLazyModifyWith_S f a = ( elems a', a' ) where a' = tmap f a
+prop_GetElemsLazyModifyWith f =
+    (\a -> do { es <- getElems a ; modifyWith f a ; return es })
+    `implements `
+    (getElemsLazyModifyWith_S f)
+
+getElemsStrictModifyWith_S f a = ( elems a, a' ) where a' = tmap f a
+prop_GetElemsStrictModifyWith f =
+    (\a -> do { es <- getElems' a ; modifyWith f a ; return es })
+    `implements `
+    (getElemsStrictModifyWith_S f)
+
+getAssocsLazyModifyWith_S f a = ( assocs a', a' ) where a' = tmap f a
+prop_GetAssocsLazyModifyWith f =
+    (\a -> do { ijes <- getAssocs a ; modifyWith f a ; return ijes })
+    `implements` 
+    getAssocsLazyModifyWith_S f
+
+getAssocsStrictModifyWith_S f a = ( assocs a, a' ) where a' = tmap f a
+prop_GetAssocsStrictModifyWith f =
+    (\a -> do { ijes <- getAssocs' a ; modifyWith f a ; return ijes })
+    `implements` 
+    getAssocsStrictModifyWith_S f
+
+
+----------------------------- Special Matrices --------------------------------
+
+newZeroMatrix_S = zeroMatrix
+prop_NewZeroMatrix (Nat2 mn) = 
+    newZeroMatrix mn `equivalent` newZeroMatrix_S mn
+
+setZeroMatrix_S a = ( (), newZeroMatrix_S (shape a) )
+prop_SetZeroMatrix = setZeroMatrix `implements` setZeroMatrix_S
+
+newConstantMatrix_S mn e = constantMatrix mn e
+prop_NewConstantMatrix (Nat2 mn) e = 
+    newConstantMatrix mn e `equivalent` newConstantMatrix_S mn e
+
+setConstantMatrix_S e a = ( (), newConstantMatrix_S (shape a) e )
+prop_SetConstantMatrix e = setConstantMatrix e `implements` setConstantMatrix_S e
+
+newIdentityMatrix_S = identityMatrix
+prop_NewIdentityMatrix (Nat2 mn) = 
+    newIdentityMatrix mn `equivalent` newIdentityMatrix_S mn
+
+setIdentityMatrix_S a = ( (), newIdentityMatrix_S (shape a) )
+prop_SetIdentityMatrix =
+    setIdentityMatrix `implements` setIdentityMatrix_S
+
+
+---------------------------- Copying Matrices --------------------------------
+
+newCopyMatrix_S a = ( a, a )
+prop_NewCopyMatrix = 
+    (\a -> newCopyMatrix a >>= abstract) `implements` newCopyMatrix_S
+
+copyMatrix_S a b = ( (), b, b )
+prop_CopyMatrix = copyMatrix `implements2` copyMatrix_S
+
+swapMatrix_S a b = ( (), b, a )
+prop_SwapMatrix = swapMatrix `implements2` swapMatrix_S
+
+
+-------------------------- Unsary Matrix Operations --------------------------
+
+doConj_S x = ( (), tmap conj x )
+prop_DoConj = doConj `implements` doConj_S
+
+scaleBy_S k x = ( (), tmap (k*) x )
+prop_ScaleBy k = scaleBy k `implements` scaleBy_S k
+
+shiftBy_S k x = ( (), tmap (k+) x )
+prop_ShiftBy k = shiftBy k `implements` shiftBy_S k
+
+modifyWith_S f x = ( (), tmap f x )
+prop_ModifyWith f = modifyWith f `implements` modifyWith_S f
+
+getConjMatrix_S x = ( tmap conj x, x )
+prop_GetConjMatrix = 
+    (\x -> getConjMatrix x >>= abstract) `implements` getConjMatrix_S
+
+getScaledMatrix_S k x = ( tmap (k*) x, x )
+prop_GetScaledMatrix k = 
+    (\x -> getScaledMatrix k x >>= abstract) `implements` (getScaledMatrix_S k)
+
+getShiftedMatrix_S k x = ( tmap (k+) x, x )
+prop_GetShiftedMatrix k = 
+    (\x -> getShiftedMatrix k x >>= abstract) `implements` (getShiftedMatrix_S k)
+
+
+------------------------- Binary Matrix Operations ---------------------------
+
+addMatrix_S x y = ( (), x + y, y )
+prop_AddMatrix = addMatrix `implements2` addMatrix_S
+
+subMatrix_S x y = ( (), x - y, y )
+prop_SubMatrix = subMatrix `implements2` subMatrix_S
+
+axpyMatrix_S alpha x y = ( (), x, alpha *> x + y )
+prop_AxpyMatrix alpha = axpyMatrix alpha `implements2` axpyMatrix_S alpha
+
+mulMatrix_S x y = ( (), x * y, y )
+prop_MulMatrix = mulMatrix `implements2` mulMatrix_S
+
+divMatrix_S x y = ( (), x / y, y )
+prop_DivMatrix = divMatrix `implements2` divMatrix_S
+
+getAddMatrix_S x y = ( x + y, x, y )
+prop_GetAddMatrix =
+    (\x y -> getAddMatrix x y >>= abstract) `implements2` getAddMatrix_S
+
+getSubMatrix_S x y = ( x - y, x, y )
+prop_GetSubMatrix =
+    (\x y -> getSubMatrix x y >>= abstract) `implements2` getSubMatrix_S
+
+getMulMatrix_S x y = ( x * y, x, y )
+prop_GetMulMatrix =
+    (\x y -> getMulMatrix x y >>= abstract) `implements2` getMulMatrix_S
+
+getDivMatrix_S x y = ( x / y, x, y )
+prop_GetDivMatrix =
+    (\x y -> getDivMatrix x y >>= abstract) `implements2` getDivMatrix_S
+
+
+------------------------------------------------------------------------
+-- 
+-- The specification language
+--
+    
+abstract :: (BLAS1 e) => STMatrix s (m,n) e -> ST s (Matrix (m,n) e)
+abstract = freezeMatrix
+
+commutes :: (AEq a, Show a, AEq e, BLAS1 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
+    old <- abstract x
+    r <- a x
+    new <- abstract x
+    let s      = f old
+        s'     = (r,new)
+        passed = s ~== s'
+        
+    when (not passed) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
+              return ()
+              
+    return passed
+
+commutes2 :: (AEq a, Show a, AEq e, BLAS1 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
+commutes2 x y a f = do
+    oldX <- abstract x
+    oldY <- abstract y
+    r <- a x y
+    newX <- abstract x
+    newY <- abstract y
+    let s      = f oldX oldY
+        s'     = (r,newX,newY)
+        passed = s ~== s'
+        
+    when (not passed) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
+            return ()
+            
+    return passed
+
+equivalent :: (forall s . ST s (STMatrix s (m,n) E)) -> Matrix (m,n) E -> Bool
+equivalent x s = runST $ do
+    x' <- (x >>= abstract)
+    when (not $ x' === s) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show x'))
+            return ()
+    return (x' === s)
+    
+implements :: (AEq a, Show a) =>
+    (forall s . STMatrix s (m,n) E -> ST s a) ->
+    (Matrix (m,n) E -> (a,Matrix (m,n) E)) -> 
+        Property
+a `implements` f =
+    forAll arbitrary $ \(Nat2 mn) ->
+        implementsFor mn a f
+
+implements2 :: (AEq a, Show a) =>
+    (forall s . 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)) -> 
+        Property
+a `implements2` f =
+    forAll arbitrary $ \(Nat2 mn) ->
+        implementsFor2 mn a f
+
+implementsFor :: (AEq a, Show a) =>
+    (Int,Int) ->
+    (forall s . STMatrix s (m,n) E -> ST s a) ->
+    (Matrix (m,n) E -> (a,Matrix (m,n) E)) -> 
+        Property
+implementsFor mn a f =
+    forAll (Test.matrix mn) $ \x ->
+        runST $ do
+            commutes (unsafeThawMatrix x) a f
+
+implementsFor2 :: (AEq a, Show a) =>
+    (Int,Int) ->
+    (forall s . 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)) -> 
+        Property
+implementsFor2 mn a f =
+    forAll (Test.matrix mn) $ \x ->
+    forAll (Test.matrix mn) $ \y ->
+        runST $ do
+            commutes2 (unsafeThawMatrix x) (unsafeThawMatrix y) a f
+
+
+implementsIf :: (AEq a, Show a) =>
+    (forall s . STMatrix s (m,n) E -> ST s Bool) ->
+    (forall s . STMatrix s (m,n) E -> ST s a) ->
+    (Matrix (m,n) E -> (a,Matrix (m,n) E)) -> 
+        Property
+implementsIf pre a f =
+    forAll arbitrary $ \(Nat2 mn) ->
+    forAll (Test.matrix mn) $ \x ->
+        runST ( do
+            x' <- thawMatrix x
+            pre x') ==>
+        runST ( do
+            commutes (unsafeThawMatrix x) a f )
+
+implementsIf2 :: (AEq a, Show a) =>
+    (forall s . STMatrix s (m,n) E -> STMatrix s (m,n) E -> ST s Bool) ->
+    (forall s . 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)) -> 
+        Property
+implementsIf2 pre a f =
+    forAll arbitrary $ \(Nat2 mn) ->
+    forAll (Test.matrix mn) $ \x ->
+    forAll (Test.matrix mn) $ \y ->
+        runST ( do
+            x' <- thawMatrix x
+            y' <- thawMatrix y
+            pre x' y') ==>
+        runST ( do
+            commutes2 (unsafeThawMatrix x) (unsafeThawMatrix y) a f )
+            
+------------------------------------------------------------------------
+
+tests_STMatrix =
+    [ ("newMatrix", mytest prop_NewMatrix)
+    , ("newListMatrix", mytest prop_NewListMatrix)
+    
+    , ("getSize", mytest prop_GetSize)
+    , ("readElem", mytest prop_ReadElem)
+    , ("canModifyElem", mytest prop_CanModifyElem)
+    , ("writeElem", mytest prop_WriteElem)
+    , ("modifyElem", mytest prop_ModifyElem)
+
+    , ("getIndices", mytest prop_GetIndicesLazy)
+    , ("getIndices'", mytest prop_GetIndicesStrict)
+    , ("getElems", mytest prop_GetElemsLazyModifyWith)
+    , ("getElems'", mytest prop_GetElemsStrictModifyWith)
+    , ("getAssocs", mytest prop_GetAssocsLazyModifyWith)
+    , ("getAssocs'", mytest prop_GetAssocsStrictModifyWith)
+
+    , ("newZeroMatrix", mytest prop_NewZeroMatrix)
+    , ("setZeroMatrix", mytest prop_SetZeroMatrix)
+    , ("newConstantMatrix", mytest prop_NewConstantMatrix)
+    , ("setConstantMatrix", mytest prop_SetConstantMatrix)
+    , ("newIdentityMatrix", mytest prop_NewIdentityMatrix)
+    , ("setIdentityMatrix", mytest prop_SetIdentityMatrix)
+    
+    , ("newCopyMatrix", mytest prop_NewCopyMatrix)
+    , ("copyMatrix", mytest prop_CopyMatrix)
+    , ("swapMatrix", mytest prop_SwapMatrix)
+
+    , ("doConj", mytest prop_DoConj)
+    , ("scaleBy", mytest prop_ScaleBy)
+    , ("shiftBy", mytest prop_ShiftBy)
+    , ("modifyWith", mytest prop_ModifyWith)
+    
+    , ("getConjMatrix", mytest prop_GetConjMatrix)
+    , ("getScaledMatrix", mytest prop_GetScaledMatrix)
+    , ("getShiftedMatrix", mytest prop_GetShiftedMatrix)
+
+    , ("axpyMatrix", mytest prop_AxpyMatrix)
+    , ("addMatrix", mytest prop_AddMatrix)
+    , ("subMatrix", mytest prop_SubMatrix)
+    , ("mulMatrix", mytest prop_MulMatrix)
+    , ("divMatrix", mytest prop_DivMatrix)
+    
+    , ("getAddMatrix", mytest prop_GetAddMatrix)
+    , ("getSubMatrix", mytest prop_GetSubMatrix)
+    , ("getMulMatrix", mytest prop_GetMulMatrix)
+    , ("getDivMatrix", mytest prop_GetDivMatrix)
+
+    ]
diff --git a/tests/STVector.hs b/tests/STVector.hs
new file mode 100644
--- /dev/null
+++ b/tests/STVector.hs
@@ -0,0 +1,375 @@
+{-# LANGUAGE Rank2Types, PatternSignatures #-}
+module STVector ( tests_STVector ) where
+
+
+import BLAS.Elem
+import Data.Vector.Dense
+import Data.Vector.Dense.ST
+
+import qualified Generators.Vector.Dense as Test
+
+import Driver
+
+
+
+---------------------------- Creating Vectors --------------------------------
+
+newVector_S n ies = 
+    (snd . unzip) $ sortAssocs $ 
+        unionBy ((==) `on` fst) 
+                (nubAssocs ies)
+                (zip [0..(n-1)] (repeat 0))
+  where
+    nubAssocs = reverse . nubBy ((==) `on` fst) . reverse      
+    sortAssocs = sortBy (comparing fst)
+
+prop_NewVector (Assocs n ies) =
+    newVector n ies `equivalent` newVector_S n ies
+
+newListVector_S n es = take n $ es ++ repeat 0
+prop_NewListVector (Nat n) es =
+    newListVector n es `equivalent` newListVector_S n es
+
+
+---------------------- Reading and Writing Elements --------------------------
+
+getSize_S x = ( length x, x )
+prop_GetSize = getSize `implements` getSize_S
+
+readElem_S x i = ( x !! i, x )
+prop_ReadElem (Index i n) =
+    implementsFor n (`readElem` i) (`readElem_S` i)
+
+canModifyElem_S x i = ( True, x )
+prop_CanModifyElem i = (`canModifyElem` i) `implements` (`canModifyElem_S` i)
+
+writeElem_S x i e = ( (), take i x ++ [e] ++ drop (i+1) x )
+prop_WriteElem (Index i n) e =
+    implementsFor n (\x -> writeElem x i e) (\x -> writeElem_S x i e)
+
+modifyElem_S x i f = writeElem_S x i $ f (x!!i)
+prop_ModifyElem (Index i n) f =
+    implementsFor n (\x -> modifyElem x i f) (\x -> modifyElem_S x i f)
+
+getIndices_S x = ( [0..(length x - 1)], x )
+prop_GetIndicesLazy = getIndices `implements` getIndices_S
+prop_GetIndicesStrict = getIndices' `implements` getIndices_S
+
+getElemsLazyModifyWith_S f x = ( y, y ) where y = map f x
+prop_GetElemsLazyModifyWith f = 
+    (\x -> do { es <- getElems x ; modifyWith f x ; return es })
+    `implements` 
+    getElemsLazyModifyWith_S f
+
+getElemsStrictModifyWith_S f x = ( x, y ) where y = map f x
+prop_GetElemsStrictModifyWith f =
+    (\x -> do { es <- getElems' x ; modifyWith f x ; return es })
+    `implements` 
+    getElemsStrictModifyWith_S f
+
+getAssocsLazyModifyWith_S f x = ( zip [0..] y, y ) where y = map f x
+prop_GetAssocsLazyModifyWith f =
+    (\x -> do { ies <- getAssocs x ; modifyWith f x ; return ies })
+    `implements` 
+    getAssocsLazyModifyWith_S f
+
+getAssocsStrictModifyWith_S f x = ( zip [0..] x, y ) where y = map f x
+prop_GetAssocsStrictModifyWith f =
+    (\x -> do { ies <- getAssocs' x ; modifyWith f x ; return ies })
+    `implements` 
+    getAssocsStrictModifyWith_S f
+
+
+----------------------------- Special Vectors --------------------------------
+
+newZeroVector_S n = replicate n 0
+prop_NewZeroVector (Nat n) = 
+    newZeroVector n `equivalent` newZeroVector_S n
+
+setZero_S x = ( (), newZeroVector_S (length x) )
+prop_SetZero = setZero `implements` setZero_S
+
+newConstantVector_S n e = replicate n e
+prop_NewConstantVector (Nat n) e = 
+    newConstantVector n e `equivalent` newConstantVector_S n e
+
+setConstant_S e x = ( (), newConstantVector_S (length x) e )
+prop_SetConstant e = setConstant e `implements` setConstant_S e
+
+newBasisVector_S n i = replicate i 0 ++ [1] ++ replicate (n-i-1) 0
+prop_NewBasisVector (Index i n) = 
+    newBasisVector n i `equivalent` newBasisVector_S n i
+
+setBasisVector_S i x = ( (), newBasisVector_S (length x) i )
+prop_SetBasisVector (Index i n) = 
+    implementsFor n (setBasisVector i) (setBasisVector_S i)
+
+
+----------------------------- Copying Vectors --------------------------------
+
+newCopyVector_S x = ( x, x )
+prop_NewCopyVector = 
+    (\x -> newCopyVector x >>= abstract) `implements` newCopyVector_S
+
+copyVector_S x y = ( (), y, y )
+prop_CopyVector = copyVector `implements2` copyVector_S
+
+swapVector_S x y = ( (), y, x )
+prop_SwapVector = swapVector `implements2` swapVector_S
+
+
+-------------------------- Unsary Vector Operations --------------------------
+
+doConj_S x = ( (), map conj x )
+prop_DoConj = doConj `implements` doConj_S
+
+scaleBy_S k x = ( (), map (k*) x )
+prop_ScaleBy k = scaleBy k `implements` scaleBy_S k
+
+shiftBy_S k x = ( (), map (k+) x )
+prop_ShiftBy k = shiftBy k `implements` shiftBy_S k
+
+modifyWith_S f x = ( (), map f x )
+prop_ModifyWith f = modifyWith f `implements` modifyWith_S f
+
+getConjVector_S x = ( map conj x, x )
+prop_GetConjVector = 
+    (\x -> getConjVector x >>= abstract) `implements` getConjVector_S
+
+getScaledVector_S k x = ( map (k*) x, x )
+prop_GetScaledVector k = 
+    (\x -> getScaledVector k x >>= abstract) `implements` (getScaledVector_S k)
+
+getShiftedVector_S k x = ( map (k+) x, x )
+prop_GetShiftedVector k = 
+    (\x -> getShiftedVector k x >>= abstract) `implements` (getShiftedVector_S k)
+
+
+------------------------- Binary Vector Operations ---------------------------
+
+addVector_S x y = ( (), zipWith (+) x y, y )
+prop_AddVector = addVector `implements2` addVector_S
+
+subVector_S x y = ( (), zipWith (-) x y, y )
+prop_SubVector = subVector `implements2` subVector_S
+
+axpyVector_S alpha x y = ( (), x, zipWith (\xi yi -> alpha * xi + yi) x y )
+prop_AxpyVector alpha = axpyVector alpha `implements2` axpyVector_S alpha
+
+mulVector_S x y = ( (), zipWith (*) x y, y )
+prop_MulVector = mulVector `implements2` mulVector_S
+
+divVector_S x y = ( (), zipWith (/) x y, y )
+prop_DivVector = divVector `implements2` divVector_S
+
+getAddVector_S x y = ( zipWith (+) x y, x, y )
+prop_GetAddVector =
+    (\x y -> getAddVector x y >>= abstract) `implements2` getAddVector_S
+
+getSubVector_S x y = ( zipWith (-) x y, x, y )
+prop_GetSubVector =
+    (\x y -> getSubVector x y >>= abstract) `implements2` getSubVector_S
+
+getMulVector_S x y = ( zipWith (*) x y, x, y )
+prop_GetMulVector =
+    (\x y -> getMulVector x y >>= abstract) `implements2` getMulVector_S
+
+getDivVector_S x y = ( zipWith (/) x y, x, y )
+prop_GetDivVector =
+    (\x y -> getDivVector x y >>= abstract) `implements2` getDivVector_S
+
+
+-------------------------- Vector Properties ---------------------------------
+
+getSumAbs_S x = ( foldl' (+) 0 $ map norm1 x, x )
+prop_GetSumAbs = getSumAbs `implements` getSumAbs_S
+
+getNorm2_S x = ( sqrt $ foldl' (+) 0 $ map (**2) $ map norm x, x )
+prop_GetNorm2 = getNorm2 `implements` getNorm2_S
+
+getWhichMaxAbs_S x = ( (i,x!!i), x) 
+    where i = fst $ maximumBy (comparing snd) $ reverse $ zip [0..] $ map norm1 x
+prop_GetWhichMaxAbs = 
+    implementsIf (return . (>0) . dim) getWhichMaxAbs getWhichMaxAbs_S
+
+getDot_S x y = ( foldl' (+) 0 $ zipWith (*) (map conj x) y, x, y )
+prop_GetDot = getDot `implements2` getDot_S
+
+
+------------------------------------------------------------------------
+-- 
+-- The specification language
+--
+    
+abstract :: (Elem e) => STVector s n e -> ST s [e]
+abstract = getElems'
+
+commutes :: (AEq a, Show a, AEq e, Elem e) =>
+    STVector s n e -> (STVector s n e -> ST s a) ->
+        ([e] -> (a,[e])) -> ST s Bool
+commutes x a f = do
+    old <- abstract x
+    r <- a x
+    new <- abstract x
+    let s      = f old
+        s'     = (r,new)
+        passed = s ~== s'
+        
+    when (not passed) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
+              return ()
+              
+    return passed
+
+commutes2 :: (AEq a, Show a, AEq e, Elem 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
+commutes2 x y a f = do
+    oldX <- abstract x
+    oldY <- abstract y
+    r <- a x y
+    newX <- abstract x
+    newY <- abstract y
+    let s      = f oldX oldY
+        s'     = (r,newX,newY)
+        passed = s ~== s'
+        
+    when (not passed) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show s'))
+            return ()
+            
+    return passed
+
+equivalent :: (forall s . ST s (STVector s n E)) -> [E] -> Bool
+equivalent x s = runST $ do
+    x' <- (x >>= abstract)
+    when (not $ x' === s) $
+        trace (printf ("expected `%s' but got `%s'") (show s) (show x'))
+            return ()
+    return (x' === s)
+    
+implements :: (AEq a, Show a) =>
+    (forall s . STVector s n E -> ST s a) ->
+    ([E] -> (a,[E])) -> 
+        Property
+a `implements` f =
+    forAll arbitrary $ \(Nat n) ->
+        implementsFor n a f
+
+implements2 :: (AEq a, Show a) =>
+    (forall s . STVector s n E -> STVector s n E -> ST s a) ->
+    ([E] -> [E] -> (a,[E],[E])) -> 
+        Property
+a `implements2` f =
+    forAll arbitrary $ \(Nat n) ->
+        implementsFor2 n a f
+
+implementsFor :: (AEq a, Show a) =>
+    Int ->
+    (forall s . STVector s n E -> ST s a) ->
+    ([E] -> (a,[E])) -> 
+        Property
+implementsFor n a f =
+    forAll (Test.vector n) $ \x ->
+        runST $ do
+            commutes (unsafeThawVector x) a f
+
+implementsFor2 :: (AEq a, Show a) =>
+    Int ->
+    (forall s . STVector s n E -> STVector s n E -> ST s a) ->
+    ([E] -> [E] -> (a,[E],[E])) -> 
+        Property
+implementsFor2 n a f =
+    forAll (Test.vector n) $ \x ->
+    forAll (Test.vector n) $ \y ->
+        runST $ do
+            commutes2 (unsafeThawVector x) (unsafeThawVector y) a f
+
+implementsIf :: (AEq a, Show a) =>
+    (forall s . STVector s n E -> ST s Bool) ->
+    (forall s . STVector s n E -> ST s a) ->
+    ([E] -> (a,[E])) -> 
+        Property
+implementsIf pre a f =
+    forAll arbitrary $ \(Nat n) ->
+    forAll (Test.vector n) $ \x ->
+        runST ( do
+            x' <- thawVector x
+            pre x') ==>
+        runST ( do
+            commutes (unsafeThawVector x) a f )
+
+implementsIf2 :: (AEq a, Show a) =>
+    (forall s . STVector s n E -> STVector s n E -> ST s Bool) ->
+    (forall s . STVector s n E -> STVector s n E -> ST s a) ->
+    ([E] -> [E] -> (a,[E],[E])) -> 
+        Property
+implementsIf2 pre a f =
+    forAll arbitrary $ \(Nat n) ->
+    forAll (Test.vector n) $ \x ->
+    forAll (Test.vector n) $ \y ->
+        runST ( do
+            x' <- thawVector x
+            y' <- thawVector y
+            pre x' y') ==>
+        runST ( do
+            commutes2 (unsafeThawVector x) (unsafeThawVector y) a f )
+
+            
+------------------------------------------------------------------------
+
+tests_STVector =
+    [ ("newVector", mytest prop_NewVector)
+    , ("newListVector", mytest prop_NewListVector)
+    
+    , ("getSize", mytest prop_GetSize)
+    , ("readElem", mytest prop_ReadElem)
+    , ("canModifyElem", mytest prop_CanModifyElem)
+    , ("writeElem", mytest prop_WriteElem)
+    , ("modifyElem", mytest prop_ModifyElem)
+
+    , ("getIndices", mytest prop_GetIndicesLazy)
+    , ("getIndices'", mytest prop_GetIndicesStrict)
+    , ("getElems", mytest prop_GetElemsLazyModifyWith)
+    , ("getElems'", mytest prop_GetElemsStrictModifyWith)
+    , ("getAssocs", mytest prop_GetAssocsLazyModifyWith)
+    , ("getAssocs'", mytest prop_GetAssocsStrictModifyWith)
+
+    , ("newZeroVector", mytest prop_NewZeroVector)
+    , ("setZero", mytest prop_SetZero)
+    , ("newConstantVector", mytest prop_NewConstantVector)
+    , ("setConstant", mytest prop_SetConstant)
+    , ("newBasisVector", mytest prop_NewBasisVector)
+    , ("setBasisVector", mytest prop_SetBasisVector)
+    
+    , ("newCopyVector", mytest prop_NewCopyVector)
+    , ("copyVector", mytest prop_CopyVector)
+    , ("swapVector", mytest prop_SwapVector)
+
+    , ("doConj", mytest prop_DoConj)
+    , ("scaleBy", mytest prop_ScaleBy)
+    , ("shiftBy", mytest prop_ShiftBy)
+    , ("modifyWith", mytest prop_ModifyWith)
+    
+    , ("getConjVector", mytest prop_GetConjVector)
+    , ("getScaledVector", mytest prop_GetScaledVector)
+    , ("getShiftedVector", mytest prop_GetShiftedVector)
+
+    , ("addVector", mytest prop_AddVector)
+    , ("subVector", mytest prop_SubVector)
+    , ("axpyVector", mytest prop_AxpyVector)
+    , ("mulVector", mytest prop_MulVector)
+    , ("divVector", mytest prop_DivVector)
+    
+    , ("getAddVector", mytest prop_GetAddVector)
+    , ("getSubVector", mytest prop_GetSubVector)
+    , ("getMulVector", mytest prop_GetMulVector)
+    , ("getDivVector", mytest prop_GetDivVector)
+
+    , ("getSumAbs", mytest prop_GetSumAbs)
+    , ("getNorm2", mytest prop_GetNorm2)
+    , ("getWhichMaxAbs", mytest prop_GetWhichMaxAbs)
+    , ("getDot", mytest prop_GetDot)
+
+    ]
diff --git a/tests/TriBanded.hs b/tests/TriBanded.hs
--- a/tests/TriBanded.hs
+++ b/tests/TriBanded.hs
@@ -1,51 +1,22 @@
-{-# OPTIONS -fglasgow-exts -fno-excess-precision -cpp #-}
------------------------------------------------------------------------------
--- |
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
 
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
+module TriBanded( tests_TriBanded ) where
 
-import Data.Complex ( Complex(..) )
+import Driver
 
-import qualified BLAS.Elem as E
 import Data.Vector.Dense
 import Data.Matrix.Dense
 import Data.Matrix.Banded
-import Data.Matrix.Tri.Banded  
+import Data.Matrix.Tri  
 
-import Data.AEq
-import Numeric.IEEE
 
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Matrix.Tri.Banded
+import Generators.Matrix.Tri.Banded
 
-isUndefR x = isNaN x || isInfinite x
-isUndefC (x :+ y) = isUndefR x || isUndefR y
-        
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-isUndef = isUndefC
-#else
-field = "Double"
-type E = Double
-isUndef = isUndefR
-#endif        
 
 type V = Vector Int E
 type M = Matrix (Int,Int) E
 type B = Banded (Int,Int) E
 type TB = Tri Banded (Int,Int) E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
 
 prop_tri_apply (TriBandedMV (t :: TB) a x) =
     t <*> x ~== a <*> x
@@ -75,44 +46,32 @@
 
 prop_tri_solve (TriBandedSV (t :: TB) y) =
     let x = t <\> y
-    in t <*> x ~== y || (any isUndef $ elems x)
+    in t <*> x ~== y
 
 prop_tri_ssolve k (TriBandedSV (t :: TB) y) =
     ssolve k t y ~== t <\> (k*>y)
 
 prop_tri_solveMat (TriBandedSM (t :: TB) c) =
     let b = t <\\> c
-    in t <**> b ~== c || (any isUndef $ elems b)
+    in t <**> b ~== c
 
 prop_tri_ssolveMat k (TriBandedSM (t :: TB) c) =
     ssolveMat k t c ~== t <\\> (k*>c)
 
-properties =
-    [ ("tri apply"             , pDet prop_tri_apply)
-    , ("scale tri apply"       , pDet prop_scale_tri_apply)
-    , ("herm tri apply"        , pDet prop_herm_tri_apply)
-    , ("scale herm tri apply"  , pDet prop_scale_herm_tri_apply)
+tests_TriBanded =
+    [ ("tri apply"             , mytest prop_tri_apply)
+    , ("scale tri apply"       , mytest prop_scale_tri_apply)
+    , ("herm tri apply"        , mytest prop_herm_tri_apply)
+    , ("scale herm tri apply"  , mytest prop_scale_herm_tri_apply)
     
-    , ("tri compose"           , pDet prop_tri_compose)
-    , ("scale tri compose"     , pDet prop_scale_tri_compose)
-    , ("herm tri compose"      , pDet prop_herm_tri_compose)
-    , ("scale herm tri compose", pDet prop_scale_herm_tri_compose)
+    , ("tri compose"           , mytest prop_tri_compose)
+    , ("scale tri compose"     , mytest prop_scale_tri_compose)
+    , ("herm tri compose"      , mytest prop_herm_tri_compose)
+    , ("scale herm tri compose", mytest prop_scale_herm_tri_compose)
     
-    , ("tri solve"             , pDet prop_tri_solve)
-    , ("tri solveMat"          , pDet prop_tri_solveMat)
-    , ("tri ssolve"            , pDet prop_tri_ssolve)
-    , ("tri ssolveMat"         , pDet prop_tri_ssolveMat)
+    , ("tri solve"             , mytest prop_tri_solve)
+    , ("tri solveMat"          , mytest prop_tri_solveMat)
+    , ("tri ssolve"            , mytest prop_tri_ssolve)
+    , ("tri ssolveMat"         , mytest prop_tri_ssolveMat)
 
     ]
-
-
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
-
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 400 properties
diff --git a/tests/TriMatrix.hs b/tests/TriMatrix.hs
--- a/tests/TriMatrix.hs
+++ b/tests/TriMatrix.hs
@@ -1,49 +1,31 @@
-{-# OPTIONS -fglasgow-exts -fno-excess-precision -cpp #-}
 -----------------------------------------------------------------------------
 -- |
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
+-- Module     : TriMatrix
+-- Copyright  : Copyright (c) , Patrick Perry <patperry@stanford.edu>
 -- License    : BSD3
 -- Maintainer : Patrick Perry <patperry@stanford.edu>
 -- Stability  : experimental
 --
 
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
+module TriMatrix ( tests_TriMatrix ) where
 
-import Data.Complex ( Complex(..) )
+import Driver
+import Generators.Matrix.Tri.Dense
 
-import qualified BLAS.Elem as E
 import Data.Vector.Dense
 import Data.Matrix.Dense
-import Data.Matrix.Tri.Dense  
+import Data.Matrix.Tri
 
-import Data.AEq
-import Numeric.IEEE
 
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Matrix.Tri.Dense
-
+{-
 isUndefR x = isNaN x || isInfinite x
 isUndefC (x :+ y) = isUndefR x || isUndefR y
+-}
         
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-isUndef = isUndefC
-#else
-field = "Double"
-type E = Double
-isUndef = isUndefR
-#endif        
-
 type V = Vector Int E
 type M = Matrix (Int,Int) E
-type TM = Tri (Matrix) (Int,Int) E
+type TM = Tri Matrix (Int,Int) E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
 
 prop_tri_apply (TriMatrixMV (t :: TM) a x) =
     t <*> x ~== a <*> x
@@ -57,43 +39,29 @@
 prop_tri_sapplyMat k (TriMatrixMM (t :: TM) a b) =
     sapplyMat k t b ~== sapplyMat k a b
 
-
 prop_tri_solve (TriMatrixSV (t :: TM) y) =
     let x = t <\> y
-    in t <*> x ~== y || (any isUndef $ elems x)
+    in t <*> x ~== y
 
 prop_tri_ssolve k (TriMatrixSV (t :: TM) y) =
     ssolve k t y ~== t <\> (k *> y)
 
 prop_tri_solveMat (TriMatrixSM (t :: TM) b) =
     let a = t <\\> b
-    in t <**> a ~== b || (any isUndef $ elems a)
+    in t <**> a ~== b
 
 prop_tri_ssolveMat k (TriMatrixSM (t :: TM) b) =
     ssolveMat k t b ~== t <\\> (k *> b)
 
 
-properties =
-    [ ("tri apply"             , pDet prop_tri_apply)
-    , ("tri sapply"            , pDet prop_tri_sapply)
-    , ("tri applyMat"          , pDet prop_tri_applyMat)
-    , ("tri sapplyMat"         , pDet prop_tri_sapplyMat)
+tests_TriMatrix =
+    [ ("tri apply"             , mytest prop_tri_apply)
+    , ("tri sapply"            , mytest prop_tri_sapply)
+    , ("tri applyMat"          , mytest prop_tri_applyMat)
+    , ("tri sapplyMat"         , mytest prop_tri_sapplyMat)
 
-    , ("tri solve"             , pDet prop_tri_solve)
-    , ("tri ssolve"            , pDet prop_tri_ssolve)
-    , ("tri solveMat"          , pDet prop_tri_solveMat)
-    , ("tri ssolveMat"         , pDet prop_tri_ssolveMat)
-    
+    , ("tri solve"             , mytest prop_tri_solve)
+    , ("tri ssolve"            , mytest prop_tri_ssolve)
+    , ("tri solveMat"          , mytest prop_tri_solveMat)
+    , ("tri ssolveMat"         , mytest prop_tri_ssolveMat)
     ]
-
-
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
-
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 200 properties
diff --git a/tests/Vector.hs b/tests/Vector.hs
--- a/tests/Vector.hs
+++ b/tests/Vector.hs
@@ -1,93 +1,60 @@
-{-# OPTIONS -fglasgow-exts -cpp #-}
------------------------------------------------------------------------------
--- |
--- Copyright  : Copyright (c) 2008, Patrick Perry <patperry@stanford.edu>
--- License    : BSD3
--- Maintainer : Patrick Perry <patperry@stanford.edu>
--- Stability  : experimental
---
-
-import qualified Data.Array as Array
-import Data.Ix   ( inRange )
-import Data.List ( nub, sortBy )
-import Data.Ord  ( comparing )
-import System.Environment ( getArgs )
-import Test.QuickCheck.Parallel hiding ( vector )
-import qualified Test.QuickCheck as QC
+{-# LANGUAGE PatternSignatures #-}
+module Vector( tests_Vector ) where
 
+import BLAS.Elem
 import Data.Vector.Dense
-import BLAS.Elem ( BLAS1 )
-import qualified BLAS.Elem as E
-import Data.Complex ( Complex(..) )
 
-import Data.AEq
-import Numeric.IEEE
 
-import Test.QuickCheck.Complex
-import Test.QuickCheck.Vector
-import Test.QuickCheck.Vector.Dense
+import Driver
+import qualified Data.Array as Array
+import Generators.Vector.Dense hiding ( vector )
+import qualified Generators.Vector.Dense as Test
 
 
-#ifdef COMPLEX
-field = "Complex Double"
-type E = Complex Double
-#else
-field = "Double"
-type E = Double
-#endif
-
 type V = Vector Index E
 
-instance (Arbitrary e, RealFloat e) => Arbitrary (Complex e) where
-    arbitrary   = arbitrary >>= \(TestComplex x) -> return x
-    coarbitrary = coarbitrary . TestComplex
 
-instance (Arbitrary e, BLAS1 e) => Arbitrary (Vector n e) where
-    arbitrary   = arbitrary >>= \(TestVector x) -> return x
-    coarbitrary = coarbitrary . TestVector
-
-assocsEq x ies =
-    let is = fst $ unzip ies
-    in filter (\(i,e) -> i `elem` is) (assocs x) === sortBy (comparing fst) ies
-       && (all (==0) $ map snd $ filter (\(i,e) -> not $ i `elem` is) $ assocs x)
+---------------------------- Creating Vectors --------------------------------
 
 prop_vector_dim (Assocs n ies) =
     dim (vector n ies :: V) == n
 prop_vector_assocs (Assocs n ies) =
-    (vector n ies :: V) `assocsEq` ies
+    assocs (vector n ies :: V) `assocsEq` (zip [0..(n-1)] (repeat 0) ++ ies)
 
 prop_listVector_dim es =
     let n = length es
     in dim (listVector n es :: V) == n
 prop_listVector_assocs es =
     let n = length es
-    in (listVector n es :: V) `assocsEq` (zip [0..] es)
+    in assocs (listVector n es :: V) `assocsEq` (zip [0..] es)
 
-prop_zero_dim (Index n) =
-    dim (zero n :: V) == n
-prop_zero_elems (Index n) =
-    elems (zero n :: V) == replicate n 0
-    
-prop_constant_dim (Index n) e =
-    dim (constant n e :: V) == n
-prop_constant_elems (Index n) (e :: E) =
-    elems (constant n e :: V) === replicate n e
 
-prop_basis_dim (Basis n i) =
-    dim (basis n i :: V) == n
-prop_basis_elems (Basis n i) =
-    elems (basis n i :: V) == (replicate i 0) ++ [1] ++ (replicate (n-i-1) 0)
+---------------------- Reading and Writing Elements --------------------------
 
-prop_replace_elems (x :: V) (Assocs _ ies) =
-    let ies' = filter (\(i,e) -> i < dim x) ies
-        x'   = x // ies'
-        n    = dim x
-    in and $ zipWith (\(i1,e1) (i2,e2) -> (i1 == i2) && (e1 === e2))
-                     (assocs x')
-                     (Array.assocs $ (Array.//) (Array.array (0,n-1) $ assocs x) ies')
+prop_dim (x :: V) = 
+    dim x == length (elems x)
+prop_bounds (x :: V) =
+    bounds x == (0, dim x - 1)
+prop_at (Index i n) =
+    forAll (Test.vector n) $ \(x :: V) -> 
+        (x!i) === ((elems x) !! i)
 
+prop_indices (x :: V) =
+    indices x == [0..(dim x - 1)]
+prop_assocs (x :: V) = 
+    assocs x === zip (indices x) (elems x)
+
+prop_replace_elems (Assocs n ies) =
+    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'
+
+------------------------------ Vector Views-- --------------------------------
+
 prop_subvector_dim (SubVector _ (x :: V) o n) =
     dim (subvector x o n) == n
+    
 prop_subvector_elems (SubVector _ (x :: V) o n) =
     elems (subvector x o n) === (take n $ drop o $ elems x)
     
@@ -103,153 +70,164 @@
     in expected === actual
         
 
-prop_dim (x :: V) = 
-    dim x == length (elems x)
-prop_bounds (x :: V) =
-    bounds x == (0, dim x - 1)
-prop_at (x :: V) (Index i) = 
-    i < dim x ==> (x!i) === ((elems x) !! i)
+----------------------------- Special Vectors --------------------------------
 
+prop_zeroVector_dim (Nat n) =
+    dim (zeroVector n :: V) == n
+    
+prop_zeroVector_elems (Nat n) =
+    elems (zeroVector n :: V) == replicate n 0
+    
+prop_constantVector_dim (Nat n) e =
+    dim (constantVector n e :: V) == n
+    
+prop_constantVector_elems (Nat n) (e :: E) =
+    elems (constantVector n e :: V) === replicate n e
 
-prop_indices (x :: V) =
-    indices x == [0..(dim x - 1)]
-prop_assocs (x :: V) = 
-    assocs x === zip (indices x) (elems x)
+prop_basisVector_dim (Index i n) =
+    dim (basisVector n i :: V) == n
+    
+prop_basisVector_elems (Index i n) =
+    elems (basisVector n i :: V) == (replicate i 0) ++ [1] ++ (replicate (n-i-1) 0)
 
-prop_scale_elems k (x :: V) =
-    (elems $ k *> x) ~== (map (k*) $ elems x)
-prop_conj_elems (x :: V) =
-    and $ zipWith (===) (elems (conj x)) (map (E.conj) (elems x))
-prop_conj_scale k (x :: V) =
-    conj (k *> x) ===  (E.conj k *> (conj x))
 
-prop_to_from_list es =
-    toList (fromList es :: V) === es
-
-prop_sumAbs (x :: V) =
-    sumAbs x ~== (sum $ map E.norm1 $ elems x)
-prop_norm2 (x :: V) =
-    norm2 x ~== (sqrt $ sum $ map (^2) $ map E.norm $ elems x)
-prop_whichMaxAbs1 (x :: V) =
-    (dim x > 0) && all (not . isNaN) (map E.norm1 $ elems x) ==>
-        let (i,e) = whichMaxAbs x
-        in x ! i === e
-prop_whichMaxAbs2 (x :: V) =
-    (dim x > 0) && all (not . isNaN) (map E.norm1 $ elems x) ==>
-        let a = E.norm1 $ snd $ whichMaxAbs x
-        in all (<= a) (map E.norm1 $ elems x)
-        
-prop_dot_self (x :: V) =
-    (sqrt $ x <.> x) ~== (E.fromReal $ norm2 x)
-prop_dot_conj (Pair (x :: V) y) =
-    (x <.> y) ~== (E.conj $ y <.> x)
-prop_dot_scale1 k (Pair (x :: V) y) =
-    (x <.> (k *> y)) ~== k * (x <.> y)
-prop_dot_scale2 k (Pair (x :: V) y) =
-    ((k *> x) <.> y) ~== (E.conj k) * (x <.> y)
-prop_dot_linear1 (Triple (x :: V) y z) =
-    (x <.> (y + z)) ~== (x <.> y + x <.> z)
-prop_dot_linear2 (Triple (x :: V) y z) =
-    ((x + y) <.> z) ~== (x <.> z + y <.> z)
+-------------------------- Unsary Vector Operations --------------------------
 
 prop_shift k (x :: V) =
-    shift k x ~== x + constant (dim x) k
+    shift k x ~== x + constantVector (dim x) k
+
 prop_scale k (x :: V) =
-    scale k x ~== x * constant (dim x) k
-prop_invScale k (x :: V) =
-    invScale k x ~== x / constant (dim x) k
+    k *> x ~== x * constantVector (dim x) k
 
-prop_plus (Pair (x :: V) y) =
-    elems (x + y) ~== zipWith (+) (elems x) (elems y)
-prop_minus (Pair (x :: V) y) =
-    elems (x - y) ~== zipWith (-) (elems x) (elems y)
-prop_times (Pair (x :: V) y) =
-    elems (x * y) ~== zipWith (*) (elems x) (elems y)
-prop_divide (Pair (x :: V) y) =
-    elems (x / y) ~== zipWith (/) (elems x) (elems y)
+prop_conj_elems (x :: V) =
+    and $ zipWith (===) (elems $ conj x) (map conj $ elems x)
 
+prop_conj_scale k (x :: V) =
+    conj (k *> x) ===  (conj k *> (conj x))
+
 prop_negate (x :: V) =
     negate x ~== (-1) *> x
+
 prop_abs (x :: V) =
     elems (abs x) ~== map abs (elems x)
+
 prop_signum (x :: V) =
-    elems (signum x) === map signum (elems x)
+    elems (signum x) ~== map signum (elems x)
+
 prop_recip (x :: V) =
     elems (recip x) ~== (map recip $ elems x)
 
-properties =
-    [ ("dim of vector"        , pDet prop_vector_dim)
-    , ("assocs of vector"     , pDet prop_vector_assocs)
+
+------------------------- Binary Vector Operations ---------------------------
+
+prop_plus (VectorPair (x :: V) y) =
+    elems (x + y) ~== zipWith (+) (elems x) (elems y)
     
-    , ("dim of listVector"    , pDet prop_listVector_dim)
-    , ("assocs of listVector" , pDet prop_listVector_assocs)
+prop_minus (VectorPair (x :: V) y) =
+    elems (x - y) ~== zipWith (-) (elems x) (elems y)
     
-    , ("dim of zero"          , pDet prop_zero_dim)
-    , ("elems of zero"        , pDet prop_zero_elems)
+prop_times (VectorPair (x :: V) y) =
+    elems (x * y) ~== zipWith (*) (elems x) (elems y)
     
-    , ("dim of constant"      , pDet prop_constant_dim)
-    , ("elems of constant"    , pDet prop_constant_elems)
+prop_divide (VectorPair (x :: V) y) =
+    elems (x / y) ~== zipWith (/) (elems x) (elems y)
 
-    , ("dim of basis"         , pDet prop_basis_dim)
-    , ("elems of basis"       , pDet prop_basis_elems)
 
-    , ("dim of subvector"     , pDet prop_subvector_dim)
-    , ("elems of subvector"   , pDet prop_subvector_elems)
+-------------------------- Vector Properties ---------------------------------
+
+prop_sumAbs (x :: V) =
+    sumAbs x ~== (sum $ map norm1 $ elems x)
     
-    , ("dim of subvectorWithStride"  
-                              , pDet prop_subvectorWithStride_dim)
-    , ("elems of subvectorWithStride"   
-                              , pDet prop_subvectorWithStride_elems)
+prop_norm2 (x :: V) =
+    norm2 x ~== (sqrt $ sum $ map (^2) $ map norm $ elems x)
     
-    , ("elems of replace"     , pDet prop_replace_elems)
-    , ("elems of scale"       , pDet prop_scale_elems)
-    , ("elems of conj"        , pDet prop_conj_elems)
-    , ("conj/scale"           , pDet prop_conj_scale)
+prop_whichMaxAbs1 (x :: V) =
+    (dim x > 0) && all (not . isNaN) (map norm1 $ elems x) ==>
+        let (i,e) = whichMaxAbs x
+        in x ! i === e
+        
+prop_whichMaxAbs2 (x :: V) =
+    (dim x > 0) && all (not . isNaN) (map norm1 $ elems x) ==>
+        let a = norm1 $ snd $ whichMaxAbs x
+        in all (<= a) (map norm1 $ elems x)
+        
+prop_dot_self (x :: V) =
+    (sqrt $ x <.> x) ~== (fromReal $ norm2 x)
     
-    , ("dim"                  , pDet prop_dim)
-    , ("bounds"               , pDet prop_bounds)
-    , ("at"                   , pDet prop_at)
+prop_dot_conj (VectorPair (x :: V) y) =
+    (x <.> y) ~== (conj $ 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)
+    
+prop_dot_linear1 (VectorTriple (x :: V) y z) =
+    (x <.> (y + z)) ~== (x <.> y + x <.> z)
+    
+prop_dot_linear2 (VectorTriple (x :: V) y z) =
+    ((x + y) <.> z) ~== (x <.> z + y <.> z)
 
-    , ("indices"              , pDet prop_indices)
-    , ("assocs"               , pDet prop_assocs)
+------------------------------------------------------------------------------
+tests_Vector =
+    [ ("vector/dim", mytest prop_vector_dim)
+    , ("vector/assocs", mytest prop_vector_assocs)
+    , ("listVector/dim", mytest prop_listVector_dim)
+    , ("listVector/assocs", mytest prop_listVector_assocs)
     
-    , ("to/from list"         , pDet prop_to_from_list)
+    , ("dim", mytest prop_dim)
+    , ("bounds", mytest prop_bounds)
+    , ("(!)", mytest prop_at)
+    , ("indices", mytest prop_indices)
+    , ("assocs", mytest prop_assocs)
+    , ("(//)", mytest prop_replace_elems)
     
-    , ("sumAbs"               , pDet prop_sumAbs)
-    , ("norm2"                , pDet prop_norm2)
-    , ("whichMaxAbs1"         , pDet prop_whichMaxAbs1)
-    , ("whichMaxAbs2"         , pDet prop_whichMaxAbs2)
+    , ("subvector/dim", mytest prop_subvector_dim)
+    , ("subvector/elems", mytest prop_subvector_elems)
+    , ("subvectorWithStride/dim", mytest prop_subvectorWithStride_dim)
+    , ("subvectorWithStride/elems", mytest prop_subvectorWithStride_elems)
     
-    , ("dot self"             , pDet prop_dot_self)
-    , ("dot conj"             , pDet prop_dot_conj)
-    , ("dot scale1"           , pDet prop_dot_scale1)
-    , ("dot scale2"           , pDet prop_dot_scale2)
-    , ("dot linear1"          , pDet prop_dot_linear1)
-    , ("dot linear2"          , pDet prop_dot_linear2)
+    , ("zeroVector/dim", mytest prop_zeroVector_dim)
+    , ("zeroVector/elems", mytest prop_zeroVector_elems)
+    , ("constantVector/dim", mytest prop_constantVector_dim)
+    , ("constantVector/elems", mytest prop_constantVector_elems)
+    , ("basisVector/dim", mytest prop_basisVector_dim)
+    , ("basisVector/elems", mytest prop_basisVector_elems)
+
+    , ("conj", mytest prop_conj_elems)
+    , ("(*>)", mytest prop_scale)
+    , ("shift", mytest prop_shift)
+    , ("conj . (*>)", mytest prop_conj_scale)
+    , ("negate", mytest prop_negate)
+    , ("abs", mytest prop_abs)
+    , ("signum", mytest prop_signum)
+    , ("recip", mytest prop_recip)
     
-    , ("shift"                , pDet prop_shift)
-    , ("scale"                , pDet prop_scale)
-    , ("invScale"             , pDet prop_invScale)
+    , ("(+)", mytest prop_plus)
+    , ("(-)", mytest prop_minus)
+    , ("(*)", mytest prop_times)
+    , ("(/)", mytest prop_divide)
     
-    , ("plus"                 , pDet prop_plus)
-    , ("minus"                , pDet prop_minus)
-    , ("times"                , pDet prop_times)
-    , ("divide"               , pDet prop_divide)
+    , ("sumAbs", mytest prop_sumAbs)
+    , ("norm2", mytest prop_norm2)
+    , ("whichMaxAbs1", mytest prop_whichMaxAbs1)
+    , ("whichMaxAbs2", mytest prop_whichMaxAbs2)
+    , ("dot self", mytest prop_dot_self)
+    , ("dot conj", mytest prop_dot_conj)
+    , ("dot scale1", mytest prop_dot_scale1)
+    , ("dot scale2", mytest prop_dot_scale2)
+    , ("dot linear1", mytest prop_dot_linear1)
+    , ("dot linear2", mytest prop_dot_linear2)
     
-    , ("negate"               , pDet prop_negate)
-    , ("abs"                  , pDet prop_abs)
-    , ("signum"               , pDet prop_signum)
-    , ("recip"                , pDet prop_recip)
     ]
 
 
-main = do
-    args <- getArgs
-    n <- case args of
-             (a:_) -> readIO a
-             _     -> return 1
-    main' n
 
-main' n = do
-    putStrLn $ "Running tests for " ++ field
-    pRun n 500 properties
+assocsEq :: [(Int,E)] -> [(Int,E)] -> Bool
+assocsEq ies ies' = ordered ies ~== ordered ies'
+  where
+    ordered = sortAssocs . nubAssocs
+    nubAssocs = reverse . nubBy ((==) `on` fst) . reverse      
+    sortAssocs = sortBy (comparing fst)
+