packages feed

sparse 0.6 → 0.7

raw patch · 10 files changed

+299/−81 lines, 10 filesdep +hlintdep ~QuickCheckdep ~base

Dependencies added: hlint

Dependency ranges changed: QuickCheck, base

Files

.travis.yml view
@@ -1,4 +1,19 @@ language: haskell+before_install:+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update+  - cabal update++  # Try installing some of the build-deps with apt-get for speed.+  - travis/cabal-apt-install $mode --force-reinstalls++install:+  - cabal configure -flib-Werror $mode+  - cabal build++script:+  - $script+ notifications:   irc:     channels:@@ -6,3 +21,6 @@     skip_join: true     template:       - "\x0313sparse\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++env:+  - mode="--enable-tests" script="cabal test --show-details=always"
+ CHANGELOG.markdown view
@@ -0,0 +1,11 @@+0.7+---+* Switched to using an internal vector type that unboxes as much as it can. This lets type inference work much better when playing around at the ghci REPL.++0.6+---+* Version bumped to exceed the # of Hans Hoglund's `sparse` package. He started and released his library during the creation of this library, but graciously offered to let me take over the name. His library is now on hackage as `sparser`.++0.1+---+* Repository initialized.
+ README.markdown view
@@ -0,0 +1,15 @@+sparse+======++[![Build Status](https://secure.travis-ci.org/ekmett/sparse.png?branch=master)](http://travis-ci.org/ekmett/sparse)++A sparse linear algebra playground based on Morton ordering.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett
benchmarks/mm.hs view
@@ -1,42 +1,41 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} import Control.Applicative import Control.DeepSeq import Criterion.Main import Data.Array.Unboxed as A-import Data.Vector.Generic as G-import Data.Vector.Unboxed as U import Sparse.Matrix as M-import Sparse.Matrix.Heap as Heap+import Sparse.Matrix.Internal.Heap as Heap  instance NFData (UArray i e)  main :: IO () main = defaultMain   [ bench "naive I_32"  $ nf (\x -> mmul x x) $ array ((0,0),(31,31)) $ [ ((i, j), if i == j then 1 else 0) | i <- [0..31], j <- [0..31] ]-  , bench "I_32 new"     $ nf (\x -> x * x) (ident 32 :: Mat U.Vector Int)-  , bench "I_64 new"     $ nf (\x -> x * x) (ident 64 :: Mat U.Vector Int)-  , bench "I_128 new"    $ nf (\x -> x * x) (ident 128 :: Mat U.Vector Int)-  -- , bench "I_256"       $ nf (\x -> x * x) (ident 256 :: Mat U.Vector Int)-  -- , bench "I_512"      $ nf (\x -> x * x) (ident 1024 :: Mat U.Vector Int)-  -- , bench "I_1024"      $ nf (\x -> x * x) (ident 1024 :: Mat U.Vector Int)+  , bench "I_32 new"     $ nf (\x -> x * x) (ident 32 :: Mat Int)+  , bench "I_64 new"     $ nf (\x -> x * x) (ident 64 :: Mat Int)+  , bench "I_128 new"    $ nf (\x -> x * x) (ident 128 :: Mat Int)+  -- , bench "I_256"       $ nf (\x -> x * x) (ident 256 :: Mat Int)+  -- , bench "I_512"      $ nf (\x -> x * x) (ident 1024 :: Mat Int)+  -- , bench "I_1024"      $ nf (\x -> x * x) (ident 1024 :: Mat Int)   , bench "naive 32x32"  $ nf (\x -> mmul x x) $ listArray ((0,0),(31,31)) $ Prelude.replicate (32*32) 1   , bench "32x32 Int"    $ nf (\x -> x * x) blockInt   , bench "32x32 ()"     $ nf (\x -> multiplyWith const (Heap.streamHeapWith const) x x) blockUnit-  , bench "naive 128x128"  $ nf (\x -> mmul x x) $ listArray ((0,0),(127,127)) $ Prelude.replicate (128*128) 1-  , bench "128x128 Int"    $ nf (\x -> x * x) blockInt128-  , bench "128x128 ()"     $ nf (\x -> multiplyWith const (Heap.streamHeapWith const) x x) blockUnit128+  , bench "naive 64x64"  $ nf (\x -> mmul x x) $ listArray ((0,0),(63,63)) $ Prelude.replicate (64*64) 1+  , bench "64x64 Int"    $ nf (\x -> x * x) blockInt64+  , bench "64x64 ()"     $ nf (\x -> multiplyWith const (Heap.streamHeapWith const) x x) blockUnit64   ] -blockInt :: Mat U.Vector Int+blockInt :: Mat Int blockInt = M.fromList $ Prelude.zip (Key <$> [0..31] <*> [0..31]) (repeat 1) -blockInt128 :: Mat U.Vector Int-blockInt128 = M.fromList $ Prelude.zip (Key <$> [0..127] <*> [0..127]) (repeat 1)+blockInt64 :: Mat Int+blockInt64 = M.fromList $ Prelude.zip (Key <$> [0..63] <*> [0..63]) (repeat 1) -blockUnit :: Mat U.Vector ()+blockUnit :: Mat () blockUnit = M.fromList $ Prelude.zip (Key <$> [0..31] <*> [0..31]) (repeat ()) -blockUnit128 :: Mat U.Vector ()-blockUnit128 = M.fromList $ Prelude.zip (Key <$> [0..127] <*> [0..127]) (repeat ())+blockUnit64 :: Mat ()+blockUnit64 = M.fromList $ Prelude.zip (Key <$> [0..63] <*> [0..63]) (repeat ())  mmul :: UArray (Int,Int) Int -> UArray (Int,Int) Int -> UArray (Int,Int) Int mmul x y = accumArray (+) 0 ((i0,k0),(i1,k1)) $ do
sparse.cabal view
@@ -1,6 +1,6 @@ name:          sparse category:      Data, Vector-version:       0.6+version:       0.7 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -18,6 +18,8 @@   .travis.yml   .gitignore   .vim.custom+  CHANGELOG.markdown+  README.markdown  description:   A playground of sparse linear algebra primitives using Morton ordering@@ -48,8 +50,14 @@   default: True   manual: True +-- You can disable the hlint test suite with -f-test-hlint+flag test-hlint+  default: True+  manual: True++-- You can disable the optimizations -f-optimize for faster builds flag optimize-  default: False+  default: True   manual: True  flag llvm@@ -75,6 +83,7 @@     Sparse.Matrix.Internal.Fusion     Sparse.Matrix.Internal.Heap     Sparse.Matrix.Internal.Key+    Sparse.Matrix.Internal.Vectored    ghc-options: -Wall @@ -103,7 +112,7 @@       hybrid-vectors,       lens,       linear                     >= 1.2 && < 2,-      QuickCheck                 >= 2.5,+      QuickCheck                 >= 2.5 && < 2.6,       sparse,       test-framework             >= 0.6,       test-framework-quickcheck2 >= 0.3,@@ -111,6 +120,19 @@       transformers,       vector +test-suite hlint+  type: exitcode-stdio-1.0+  main-is: hlint.hs+  ghc-options: -w -threaded -rtsopts -with-rtsopts=-N+  hs-source-dirs: tests++  if !flag(test-hlint)+    buildable: False+  else+    build-depends:+      base,+      hlint >= 1.7+ -- Verify the results of the examples test-suite doctests   type:           exitcode-stdio-1.0@@ -140,7 +162,7 @@ benchmark mm   type:           exitcode-stdio-1.0   main-is:        mm.hs-  ghc-options:    -Wall -O2 -threaded -fdicts-cheap -funbox-strict-fields -fsimpl-tick-factor=400000+  ghc-options:    -Wall -O2 -threaded -funbox-strict-fields -fsimpl-tick-factor=400000   hs-source-dirs: benchmarks   build-depends:     array,
src/Sparse/Matrix.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}  ----------------------------------------------------------------------------- -- |@@ -44,6 +45,8 @@   -- * Customization   , addWith   , multiplyWith+  -- * Storage+  , Vectored(..)   -- * Lenses   , _Mat, keys, values   ) where@@ -54,7 +57,6 @@ import Control.Lens import Data.Bits import Data.Complex-import Data.Foldable import Data.Function (on) import qualified Data.Vector as V import qualified Data.Vector.Algorithms.Insertion as Sort@@ -68,6 +70,7 @@ import Prelude hiding (head, last, null) import Sparse.Matrix.Internal.Fusion as Fusion import Sparse.Matrix.Internal.Key+import Sparse.Matrix.Internal.Vectored as I import Sparse.Matrix.Internal.Heap as Heap hiding (head) import Text.Read @@ -76,7 +79,7 @@  -- * Distinguishable Zero -class Num a => Eq0 a where+class (Vectored a, Num a) => Eq0 a where   -- | Return whether or not the element is 0.   --   -- It may be okay to never return 'True', but you won't be@@ -114,7 +117,7 @@   -- @   -- 'addMats' = 'addWith0' '$' 'nonZero' ('+')   -- @-  addMats :: G.Vector v a => Mat v a -> Mat v a -> Mat v a+  addMats :: Mat a -> Mat a -> Mat a   addMats = addWith0 $ nonZero (+)   {-# INLINE addMats #-} @@ -147,61 +150,54 @@ -- * Sparse Matrices  -- invariant: all vectors are the same length-data Mat v a = Mat {-# UNPACK #-} !Int !(U.Vector Word) !(U.Vector Word) !(v a)-  deriving (Eq,Ord)+data Mat a = Mat {-# UNPACK #-} !Int !(U.Vector Word) !(U.Vector Word) !(I.Vector a)+ --  deriving (Eq,Ord) -instance (G.Vector v a, Show a) => Show (Mat v a) where+deriving instance (Vectored a, Eq (I.Vector a)) => Eq (Mat a)+-- Mat n xs ys vs == Mat n' xs' ys' vs' = n == n' && xs == xs' && ys == ys' && vs == vs'++deriving instance (Vectored a, Ord (I.Vector a)) => Ord (Mat a)++instance (Vectored a, Show a) => Show (Mat a) where   showsPrec d m = G.showsPrec d (m^._Mat) -instance (G.Vector v a, Read a) => Read (Mat v a) where-  readPrec = (_Mat #) <$> G.readPrec+instance (Vectored a, Read a) => Read (Mat a) where+  readPrec = (_Mat # ) <$> G.readPrec -instance NFData (v a) => NFData (Mat v a) where+instance NFData (I.Vector a) => NFData (Mat a) where   rnf (Mat _ xs ys vs) = rnf xs `seq` rnf ys `seq` rnf vs `seq` ()  -- | bundle up the matrix in a form suitable for vector-algorithms-_Mat :: Iso (Mat u a) (Mat v b) (H.Vector U.Vector u (Key, a)) (H.Vector U.Vector v (Key, b))+_Mat :: Vectored a => Iso' (Mat a) (H.Vector U.Vector (Vec a) (Key, a)) _Mat = iso (\(Mat n xs ys vs) -> H.V (V_Key n xs ys) vs)            (\(H.V (V_Key n xs ys) vs) -> Mat n xs ys vs) {-# INLINE _Mat #-}  -- | Access the keys of a matrix-keys :: Lens' (Mat v a) (U.Vector Key)+keys :: Lens' (Mat a) (U.Vector Key) keys f (Mat n xs ys vs) = f (V_Key n xs ys) <&> \ (V_Key n' xs' ys') -> Mat n' xs' ys' vs {-# INLINE keys #-}  -- | Access the keys of a matrix-values :: Lens (Mat u a) (Mat v b) (u a) (v b)+values :: Lens (Mat a) (Mat b) (I.Vector a) (I.Vector b) values f (Mat n xs ys vs) = Mat n xs ys <$> f vs {-# INLINE values #-} -instance Functor v => Functor (Mat v) where-  fmap = over (values.mapped)-  {-# INLINE fmap #-}--instance Foldable v => Foldable (Mat v) where-  foldMap = foldMapOf (values.folded)-  {-# INLINE foldMap #-}--instance Traversable v => Traversable (Mat v) where-  traverse = values.traverse-  {-# INLINE traverse #-}--type instance IxValue (Mat v a) = a-type instance Index (Mat v a) = Key+type instance IxValue (Mat a) = a+type instance Index (Mat a) = Key  -- traverse a Vector eachV :: (Applicative f, G.Vector v a, G.Vector v b) => (a -> f b) -> v a -> f (v b) eachV f v = G.fromListN (G.length v) <$> traverse f (G.toList v) -instance (Applicative f, G.Vector v a, G.Vector v b) => Each f (Mat v a) (Mat v b) a b where+instance (Applicative f, Vectored a, a ~ b) => Each f (Mat a) (Mat b) a b where   each f = _Mat $ eachV $ \(k,v) -> (,) k <$> indexed f k v   {-# INLINE each #-} -instance (Functor f, Contravariant f, G.Vector v a) => Contains f (Mat v a) where+instance (Functor f, Contravariant f, Vectored a) => Contains f (Mat a) where   contains = containsIx -instance (Applicative f, G.Vector v a) => Ixed f (Mat v a) where+instance (Applicative f, Vectored a) => Ixed f (Mat a) where   ix ij@(Key i j) f m@(Mat n xs ys vs)     | Just i' <- xs U.!? l, i == i'     , Just j' <- ys U.!? l, j == j' = indexed f ij (vs G.! l) <&> \v -> Mat n xs ys (vs G.// [(l,v)])@@ -209,40 +205,43 @@     where l = search (\k -> Key (xs U.! k) (ys U.! k) >= ij) 0 n   {-# INLINE ix #-} -instance (G.Vector v a, Num a, Eq0 a) => Eq0 (Mat v a) where+instance Vectored a => Vectored (Mat a) where+  type Vec (Mat a) = V.Vector -- boxed++instance (Vectored a, Eq0 a) => Eq0 (Mat a) where   isZero (Mat n _ _ _) = n == 0   {-# INLINE isZero #-}  -- * Construction  -- | Build a sparse matrix.-fromList :: G.Vector v a => [(Key, a)] -> Mat v a+fromList :: Vectored a => [(Key, a)] -> Mat a fromList xs = _Mat # H.modify (Sort.sortBy (compare `on` fst)) (H.fromList xs) {-# INLINABLE fromList #-}  -- | Transpose a matrix-transpose :: G.Vector v a => Mat v a -> Mat v a+transpose :: Vectored a => Mat a -> Mat a transpose xs = xs & _Mat %~ H.modify (Sort.sortBy (compare `on` fst)) . H.map (first swap) {-# INLINE transpose #-}  -- | @singleton@ makes a matrix with a singleton value at a given location-singleton :: G.Vector v a => Key -> a -> Mat v a+singleton :: Vectored a => Key -> a -> Mat a singleton k v = _Mat # H.singleton (k,v) {-# INLINE singleton #-}  -- | @ident n@ makes an @n@ x @n@ identity matrix ----- >>> ident 4 :: Mat U.Vector Int+-- >>> ident 4 -- fromList [(Key 0 0,1),(Key 1 1,1),(Key 2 2,1),(Key 3 3,1)]-ident :: (G.Vector v a, Num a) => Int -> Mat v a+ident :: (Vectored a, Num a) => Int -> Mat a ident w = Mat w (U.generate w fromIntegral) (U.generate w fromIntegral) (G.replicate w 1) {-# INLINE ident #-}  -- | The empty matrix ----- >>> empty :: Mat U.Vector Int+-- >>> empty :: Mat Int -- fromList []-empty :: G.Vector v a => Mat v a+empty :: Vectored a => Mat a empty = Mat 0 U.empty U.empty G.empty {-# INLINE empty #-} @@ -250,24 +249,23 @@  -- | Count the number of non-zero entries in the matrix ----- >>> size (ident 4 :: Mat U.Vector Int)+-- >>> size (ident 4) -- 4-size :: Mat v a -> Int+size :: Mat a -> Int size (Mat n _ _ _) = n {-# INLINE size #-}  -- |--- >>> null (empty :: Mat U.Vector Int)+-- >>> null (empty :: Mat Int) -- True-null :: Mat v a -> Bool+null :: Mat a -> Bool null (Mat n _ _ _) = n == 0 {-# INLINE null #-} -instance (G.Vector v a, Num a, Eq0 a) => Num (Mat v a) where-  {-# SPECIALIZE instance (Num a, Eq0 a) => Num (Mat V.Vector a) #-}-  {-# SPECIALIZE instance Num (Mat U.Vector Int) #-}-  {-# SPECIALIZE instance Num (Mat U.Vector Double) #-}-  {-# SPECIALIZE instance Num (Mat U.Vector (Complex Double)) #-}+instance (Vectored a, Eq0 a) => Num (Mat a) where+  {-# SPECIALIZE instance Num (Mat Int) #-}+  {-# SPECIALIZE instance Num (Mat Double) #-}+  {-# SPECIALIZE instance Num (Mat (Complex Double)) #-}   abs    = over each abs   {-# INLINE abs #-}   signum = over each signum@@ -282,7 +280,7 @@   (-) = addWith0 $ nonZero (-)   {-# INLINE (-) #-}   (*) = multiplyWith (*) addHeap-  {-# INLINEABLE (*) #-}+  {-# INLINE (*) #-}  -- * Utilities @@ -296,7 +294,7 @@     where m = l + div (h-l) 2 {-# INLINE search #-} -split1 :: G.Vector v a => Word -> Word -> Mat v a -> (Mat v a, Mat v a)+split1 :: Vectored a => Word -> Word -> Mat a -> (Mat a, Mat a) split1 ai bi (Mat n xs ys vs) = (m0,m1)   where     !aibi = xor ai bi@@ -308,7 +306,7 @@     !m1 = Mat (n-k) xs1 ys1 vs1 {-# INLINE split1 #-} -split2 :: G.Vector v a => Word -> Word -> Mat v a -> (Mat v a, Mat v a)+split2 :: Vectored a => Word -> Word -> Mat a -> (Mat a, Mat a) split2 aj bj (Mat n xs ys vs) = (m0,m1)   where     !ajbj = xor aj bj@@ -322,23 +320,23 @@  -- | Merge two matrices where the indices coincide into a new matrix. This provides for generalized -- addition, but where the summation of two non-zero entries is necessarily non-zero.-addWith :: G.Vector v a => (a -> a -> a) -> Mat v a -> Mat v a -> Mat v a+addWith :: Vectored a => (a -> a -> a) -> Mat a -> Mat a -> Mat a addWith f xs ys = _Mat # G.unstream (mergeStreamsWith f (G.stream (xs^._Mat)) (G.stream (ys^._Mat))) {-# INLINE addWith #-}  -- | Merge two matrices where the indices coincide into a new matrix. This provides for generalized -- addition. Return 'Nothing' for zero.-addWith0 :: G.Vector v a => (a -> a -> Maybe a) -> Mat v a -> Mat v a -> Mat v a+addWith0 :: Vectored a => (a -> a -> Maybe a) -> Mat a -> Mat a -> Mat a addWith0 f xs ys = _Mat # G.unstream (mergeStreamsWith0 f (G.stream (xs^._Mat)) (G.stream (ys^._Mat))) {-# INLINE addWith0 #-}  -- | Multiply two matrices using the specified multiplication and addition operation.-multiplyWith :: G.Vector v a => (a -> a -> a) -> (Maybe (Heap a) -> Stream (Key, a)) -> Mat v a -> Mat v a -> Mat v a+multiplyWith :: Vectored a => (a -> a -> a) -> (Maybe (Heap a) -> Stream (Key, a)) -> Mat a -> Mat a -> Mat a {-# INLINEABLE multiplyWith #-} multiplyWith times make x0 y0 = case compare (size x0) 1 of   LT -> empty   EQ | size y0 == 1 -> _Mat # (G.unstream $ hint $ make $ go11 (lo x0) (head x0) (lo y0) (head y0))-     | otherwise     -> _Mat # (G.unstream $ hint $ make $ go12 (lo x0) (head x0) (lo y0) y0 (hi y0))+     | otherwise    -> _Mat # (G.unstream $ hint $ make $ go12 (lo x0) (head x0) (lo y0) y0 (hi y0))   GT -> case compare (size y0) 1 of       LT -> empty       EQ -> _Mat # (G.unstream $ hint $ make $ go21 (lo x0) x0 (hi x0) (lo y0) (head y0))@@ -405,6 +403,5 @@     hi (Mat _ xs ys _) = Key (U.last xs) (U.last ys)     {-# INLINE hi #-} -    head :: G.Vector v a => Mat v a -> a     head (Mat _ _ _ vs) = G.head vs     {-# INLINE head #-}
src/Sparse/Matrix/Internal/Key.hs view
@@ -38,8 +38,8 @@   , compares   , lts, les, eqs, nes, ges, gts   -- * Unboxed vector constructors-  , U.MVector(..)-  , U.Vector(..)+  , U.MVector(MV_Key)+  , U.Vector(V_Key)   ) where  import Data.Bits
+ src/Sparse/Matrix/Internal/Vectored.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Sparse.Matrix.Internal.Vectored+  ( Vectored(..)+  , Vector+  -- * Internals+  , V_Complex(V_Complex)+  , MV_Complex(MV_Complex)+  ) where++import Control.Monad+import Data.Complex+import Data.Int+import Data.Monoid+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as GM+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Fusion.Stream as Stream+import qualified Data.Vector as B+import Data.Word+import qualified Sparse.Matrix.Internal.Key as Key+import Text.Read++-- * Data types that know how to store themselves in a Vector optimally, maximizing the level of unboxing provided.++type Vector a = Vec a a++class (G.Vector (Vec a) a, Monoid (Vec a a)) => Vectored a where+  type Vec a :: * -> *+  type Vec a = U.Vector++-- * Unboxed vectors++instance Vectored ()+instance Vectored Double+instance Vectored Float+instance Vectored Int+instance Vectored Int8+instance Vectored Int16+instance Vectored Int32+instance Vectored Int64+instance Vectored Key.Key+instance Vectored Word+instance Vectored Word8+instance Vectored Word16+instance Vectored Word32+instance Vectored Word64++-- * Boxed vectors++instance Vectored Integer where+  type Vec Integer = B.Vector++-- * Complex numbers are boxed or unboxed based on their components++#ifndef HLINT+data MV_Complex :: * -> * -> * where+  MV_Complex :: {-# UNPACK #-} !Int -> !(G.Mutable (Vec a) s a) -> !(G.Mutable (Vec a) s a) -> MV_Complex s (Complex a)++data V_Complex :: * -> * where+  V_Complex :: {-# UNPACK #-} !Int -> !(Vector a) -> !(Vector a) -> V_Complex (Complex a)+#endif++type instance G.Mutable V_Complex = MV_Complex++instance (Vectored a, RealFloat a) => GM.MVector MV_Complex (Complex a) where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicOverlaps #-}+  {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicUnsafeReplicate #-}+  {-# INLINE basicUnsafeRead #-}+  {-# INLINE basicUnsafeWrite #-}+  {-# INLINE basicClear #-}+  {-# INLINE basicSet #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE basicUnsafeGrow #-}+  basicLength (MV_Complex l _ _) = l+  basicUnsafeSlice i n (MV_Complex _ u v)                   = MV_Complex n (GM.basicUnsafeSlice i n u) (GM.basicUnsafeSlice i n v)+  basicOverlaps (MV_Complex _ u1 v1) (MV_Complex _ u2 v2)   = GM.basicOverlaps u1 u2 || GM.basicOverlaps v1 v2+  basicUnsafeNew n                                          = liftM2 (MV_Complex n) (GM.basicUnsafeNew n) (GM.basicUnsafeNew n)+  basicUnsafeReplicate n (x :+ y)                           = liftM2 (MV_Complex n) (GM.basicUnsafeReplicate n x) (GM.basicUnsafeReplicate n y)+  basicUnsafeRead (MV_Complex _ u v) i                      = liftM2 (:+) (GM.basicUnsafeRead u i) (GM.basicUnsafeRead v i)+  basicUnsafeWrite (MV_Complex _ u v) i (x :+ y)            = GM.basicUnsafeWrite u i x >> GM.basicUnsafeWrite v i y+  basicClear (MV_Complex _ u v)                             = GM.basicClear u >> GM.basicClear v+  basicSet (MV_Complex _ u v) (x :+ y)                      = GM.basicSet u x >> GM.basicSet v y+  basicUnsafeCopy (MV_Complex _ u1 v1) (MV_Complex _ u2 v2) = GM.basicUnsafeCopy u1 u2 >> GM.basicUnsafeCopy v1 v2+  basicUnsafeMove (MV_Complex _ u1 v1) (MV_Complex _ u2 v2) = GM.basicUnsafeMove u1 u2 >> GM.basicUnsafeMove v1 v2+  basicUnsafeGrow (MV_Complex _ u v) n                      = liftM2 (MV_Complex n) (GM.basicUnsafeGrow u n) (GM.basicUnsafeGrow v n)++instance (Vectored a, RealFloat a) => G.Vector V_Complex (Complex a) where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeFreeze #-}+  {-# INLINE basicUnsafeThaw #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicUnsafeIndexM #-}+  {-# INLINE elemseq #-}+  basicLength (V_Complex v _ _) = v+  basicUnsafeFreeze (MV_Complex n u v)                   = liftM2 (V_Complex n) (G.basicUnsafeFreeze u) (G.basicUnsafeFreeze v)+  basicUnsafeThaw (V_Complex n u v)                      = liftM2 (MV_Complex n) (G.basicUnsafeThaw u) (G.basicUnsafeThaw v)+  basicUnsafeSlice i n (V_Complex _ u v)                 = V_Complex n (G.basicUnsafeSlice i n u) (G.basicUnsafeSlice i n v)+  basicUnsafeIndexM (V_Complex _ u v) i                  = liftM2 (:+) (G.basicUnsafeIndexM u i) (G.basicUnsafeIndexM v i)+  basicUnsafeCopy (MV_Complex _ mu mv) (V_Complex _ u v) = G.basicUnsafeCopy mu u >> G.basicUnsafeCopy mv v+  elemseq _ (x :+ y) z = G.elemseq (undefined :: Vec a a) x+                       $ G.elemseq (undefined :: Vec a a) y z++instance (Vectored a, RealFloat a, Show a, b ~ Complex a) => Show (V_Complex b) where+  showsPrec = G.showsPrec++instance (Vectored a, RealFloat a, Read a, b ~ Complex a) => Read (V_Complex b) where+  readPrec = G.readPrec+  readListPrec = readListPrecDefault++instance (Vectored a, RealFloat a, Eq a, b ~ Complex a) => Eq (V_Complex b) where+  xs == ys = Stream.eq (G.stream xs) (G.stream ys)+  {-# INLINE (==) #-}++instance (Vectored a, RealFloat a, b ~ Complex a) => Monoid (V_Complex b) where+  mappend = (G.++)+  {-# INLINE mappend #-}+  mempty = G.empty+  {-# INLINE mempty #-}+  mconcat = G.concat+  {-# INLINE mconcat #-}++instance (Vectored a, RealFloat a) => Vectored (Complex a) where+  type Vec (Complex a) = V_Complex
+ tests/hlint.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (hlint)+-- Copyright   :  (C) 2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module runs HLint on the lens source tree.+-----------------------------------------------------------------------------+module Main where++import Control.Monad+import Language.Haskell.HLint+import System.Environment+import System.Exit++main :: IO ()+main = do+    args <- getArgs+    hints <- hlint $ ["src", "--cpp-define=HLINT"] ++ args+    unless (null hints) exitFailure
tests/properties.hs view
@@ -31,10 +31,10 @@ sane :: Linear Int -> Linear Int sane = M.filter (not . M.null) -toLinear :: Mat U.Vector Int -> Linear Int+toLinear :: Mat Int -> Linear Int toLinear = sane . H.foldr (\(k,v) r -> r & at (k^._1) . nonEmpty . at (k^._2) ?~ v) M.empty . view _Mat -fromLinear :: Linear Int -> Mat U.Vector Int+fromLinear :: Linear Int -> Mat Int fromLinear m = SM.fromList $ do   (i, n) <- M.toList m   (j, a) <- M.toList n@@ -43,7 +43,7 @@ prop_to_from x = toLinear (fromLinear x) == sane x prop_from_to x = fromLinear (toLinear x) == x -prop_model :: Mat U.Vector Int -> Mat U.Vector Int -> Gen Prop+prop_model :: Mat Int -> Mat Int -> Gen Prop prop_model x y | z <- x * y, z' <- fromLinear (toLinear x !*! toLinear y)   = label (show z Prelude.++ " == " Prelude.++ show z') (z == z')