Generic Vector framework
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Fri, 11 Jul 2008 07:23:12 +0000 (07:23 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Fri, 11 Jul 2008 07:23:12 +0000 (07:23 +0000)
Data/Vector.hs
Data/Vector/Base.hs [new file with mode: 0644]
Data/Vector/Base/Mutable.hs [new file with mode: 0644]
Data/Vector/Mutable.hs
Data/Vector/Prim.hs [deleted file]
Data/Vector/Stream.hs
Data/Vector/Unboxed.hs
Data/Vector/Unboxed/Mutable.hs
Data/Vector/Unboxed/Prim.hs [deleted file]
vector.cabal

index c730264..583156d 100644 (file)
-{-# LANGUAGE RankNTypes, CPP #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances, MultiParamTypeClasses #-}
 
 
-#include "phases.h"
+module Data.Vector (
+  Vector(..), module Data.Vector.Base
+) where
 
 
-module Data.Vector
-where
-
-import qualified Data.Vector.Prim    as Prim
+import           Data.Vector.Base
 import qualified Data.Vector.Mutable as Mut
 
 import qualified Data.Vector.Mutable as Mut
 
-import           Data.Vector.Stream.Size ( Size(..) )
-import qualified Data.Vector.Stream  as Stream
-import           Data.Vector.Stream ( Stream )
-
-import Control.Exception ( assert )
-import Control.Monad.ST  ( ST, runST )
+import Control.Monad.ST ( runST )
 
 
-import Prelude hiding ( length, (++) )
+import GHC.ST   ( ST(..) )
+import GHC.Prim ( Array#, unsafeFreezeArray#, indexArray#, (+#) )
+import GHC.Base ( Int(..) )
 
 data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
 
 data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
-                       {-# UNPACK #-} !(Prim.Vector a)
-
-new :: Int -> (forall s. Mut.Vector s a -> ST s (Mut.Vector s a)) -> Vector a
-{-# INLINE new #-}
-new n init = runST (
-  do
-    mv <- Mut.new n
-    mv' <- init mv
-    let (mprim, i, n') = Mut.dataOf mv'
-    prim <- Prim.unsafeFreeze mprim
-    return $ Vector i n' prim
-  )
-
-new' :: Int -> a -> (forall s. Mut.Vector s a -> ST s (Mut.Vector s a)) -> Vector a
-{-# INLINE new' #-}
-new' n x init = runST (
-  do
-    mv <- Mut.new' n x
-    mv' <- init mv
-    let (mprim, i, n') = Mut.dataOf mv'
-    prim <- Prim.unsafeFreeze mprim
-    return $ Vector i n' prim
-  )
-
-stream :: Vector a -> Stream a
-{-# INLINE_STREAM stream #-}
-stream (Vector i n arr) = Stream.unfold get i `Stream.sized` Exact n
-  where
-    n' = n+i
-
-    {-# INLINE get #-}
-    get j | j < n'    = Prim.at' arr j $ \x -> Just (x, j+1)
-          | otherwise = Nothing
-
-unstream :: Stream a -> Vector a
-{-# INLINE_STREAM unstream #-}
-unstream s = runST (do
-    mv <- Mut.unstream s
-    let (mprim, i, n) = Mut.dataOf mv
-    prim <- Prim.unsafeFreeze mprim
-    return $ Vector i n prim
-  )
-
-{-# RULES
-
-"stream/unstream [Vector]" forall s.
-  stream (unstream s) = s
-
- #-}
-
-length :: Vector a -> Int
-{-# INLINE length #-}
-length (Vector _ n _) = n
-
-slice :: Vector a -> Int -> Int -> Vector a
-{-# INLINE slice #-}
-slice (Vector i n arr) j m
-  = assert (j + m <= n && j >= 0 && m >= 0)
-  $ Vector (i+j) m arr
-
-unsafeAt ::Vector a -> Int -> a
-{-# INLINE unsafeAt #-}
-unsafeAt (Vector i _ arr) j = Prim.at arr (i+j)
-
-at :: Vector a -> Int -> a
-{-# INLINE at #-}
-at v i = assert (i >= 0 && i < length v)
-       $ unsafeAt v i
-
-infixr ++
-(++) :: Vector a -> Vector a -> Vector a
-{-# INLINE (++) #-}
-v ++ w = unstream (stream v Stream.++ stream w)
-
-map :: (a -> b) -> Vector a -> Vector b
-{-# INLINE map #-}
-map f = unstream . Stream.map f . stream
-
-filter :: (a -> Bool) -> Vector a -> Vector a
-{-# INLINE filter #-}
-filter f = unstream . Stream.filter f . stream
-
-zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c
-{-# INLINE zipWith #-}
-zipWith f v w = unstream
-              $ Stream.zipWith f (stream v) (stream w)
-
-foldl' :: (a -> b -> b) -> b -> Vector a -> b
-{-# INLINE foldl' #-}
-foldl' f z = Stream.foldl' f z . stream
+                                      (Array# a)
+
+instance Base Vector a where
+  {-# INLINE create #-}
+  create init = runST (do
+      Mut.Vector i n marr# <- init
+      ST (\s# -> case unsafeFreezeArray# marr# s# of
+                   (# s2#, arr# #) -> (# s2#, Vector i n arr# #)
+         )
+    )
+
+  {-# INLINE length #-}
+  length (Vector _ n _) = n
+
+  {-# INLINE unsafeSlice #-}
+  unsafeSlice (Vector i _ arr#) j n = Vector (i+j) n arr#
+
+  {-# INLINE unsafeIndex #-}
+  unsafeIndex (Vector (I# i#) _ arr#) (I# j#) f
+    = case indexArray# arr# (i# +# j#) of (# x #) -> f x
 
 
diff --git a/Data/Vector/Base.hs b/Data/Vector/Base.hs
new file mode 100644 (file)
index 0000000..c2a954a
--- /dev/null
@@ -0,0 +1,65 @@
+{-# LANGUAGE TypeFamilies, FlexibleContexts, RankNTypes, MultiParamTypeClasses, BangPatterns, CPP #-}
+
+#include "phases.h"
+
+module Data.Vector.Base
+where
+
+import qualified Data.Vector.Base.Mutable as Mut
+
+import qualified Data.Vector.Stream as Stream
+import           Data.Vector.Stream ( Stream )
+import           Data.Vector.Stream.Size
+
+import Prelude hiding ( length, map, zipWith, sum )
+
+class Base v a where
+  create       :: (forall mv. Mut.Base mv a => Mut.Trans mv (mv a)) -> v a
+
+  length       :: v a -> Int
+  unsafeSlice  :: v a -> Int -> Int -> v a
+
+  unsafeIndex  :: v a -> Int -> (a -> b) -> b
+
+stream :: Base v a => v a -> Stream a
+{-# INLINE_STREAM stream #-}
+stream !v = Stream.unfold get 0 `Stream.sized` Exact n
+  where
+    n = length v
+
+    {-# INLINE get #-}
+    get i | i < n     = unsafeIndex v i $ \x -> Just (x, i+1)
+          | otherwise = Nothing
+
+unstream :: Base v a => Stream a -> v a
+{-# INLINE_STREAM unstream #-}
+unstream s = create (Mut.unstream s)
+
+{-# RULES
+
+"stream/unstream [Vector.Base]" forall s.
+  stream (unstream s) = s
+
+ #-}
+
+infixr ++
+(++) :: Base v a => v a -> v a -> v a
+{-# INLINE (++) #-}
+v ++ w = unstream (stream v Stream.++ stream w)
+
+map :: (Base v a, Base v b) => (a -> b) -> v a -> v b
+{-# INLINE map #-}
+map f = unstream . Stream.map f . stream
+
+zipWith :: (Base v a, Base v b, Base v c) => (a -> b -> c) -> v a -> v b -> v c
+{-# INLINE zipWith #-}
+zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys))
+
+foldl' :: Base v b => (a -> b -> a) -> a -> v b -> a
+{-# INLINE foldl' #-}
+foldl' f z = Stream.foldl' f z . stream
+
+sum :: (Base v a, Num a) => v a -> a
+{-# INLINE sum #-}
+sum = foldl' (+) 0
+
diff --git a/Data/Vector/Base/Mutable.hs b/Data/Vector/Base/Mutable.hs
new file mode 100644 (file)
index 0000000..f6cc57b
--- /dev/null
@@ -0,0 +1,148 @@
+{-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses #-}
+module Data.Vector.Base.Mutable (
+  Base(..),
+
+  slice, new, newWith, read, write, copy, grow, unstream
+) where
+
+import qualified Data.Vector.Stream      as Stream
+import           Data.Vector.Stream      ( Stream )
+import           Data.Vector.Stream.Size
+
+import Control.Monad.ST ( ST )
+import Control.Exception ( assert )
+
+import GHC.Float (
+    double2Int, int2Double
+  )
+
+import Prelude hiding ( length, read )
+
+gROWTH_FACTOR :: Double
+gROWTH_FACTOR = 1.5
+
+class Monad (Trans v) => Base v a where
+  type Trans   v :: * -> *
+
+  length           :: v a -> Int
+  unsafeSlice      :: v a -> Int -> Int -> v a
+
+  unsafeNew        :: Int -> Trans v (v a)
+  unsafeNewWith    :: Int -> a -> Trans v (v a)
+
+  unsafeRead       :: v a -> Int -> Trans v a
+  unsafeWrite      :: v a -> Int -> a -> Trans v ()
+
+  set              :: v a -> a -> Trans v ()
+  unsafeCopy       :: v a -> v a -> Trans v ()
+  unsafeGrow       :: v a -> Int -> Trans v (v a)
+
+  overlaps         :: v a -> v a -> Bool
+
+  {-# INLINE unsafeNewWith #-}
+  unsafeNewWith n x = do
+                        v <- unsafeNew n
+                        set v x
+                        return v
+
+  {-# INLINE set #-}
+  set v x = do_set 0
+    where
+      n = length v
+
+      do_set i | i < n = do
+                            unsafeWrite v i x
+                            do_set (i+1)
+                | otherwise = return ()
+
+  {-# INLINE unsafeCopy #-}
+  unsafeCopy dst src = do_copy 0
+    where
+      n = length src
+
+      do_copy i | i < n = do
+                            x <- unsafeRead src i
+                            unsafeWrite dst i x
+                            do_copy (i+1)
+                | otherwise = return ()
+
+  {-# INLINE unsafeGrow #-}
+  unsafeGrow v by = do
+                      v' <- unsafeNew (n+by)
+                      unsafeCopy (unsafeSlice v' 0 n) v
+                      return v'
+    where
+      n = length v
+
+inBounds :: Base v a => v a -> Int -> Bool
+{-# INLINE inBounds #-}
+inBounds v i = i >= 0 && i < length v
+
+slice :: Base v a => v a -> Int -> Int -> v a
+{-# INLINE slice #-}
+slice v i n = assert (i >=0 && n >= 0 && i+n <= length v)
+            $ unsafeSlice v i n
+
+new :: (Base v a, m ~ Trans v) => Int -> m (v a)
+{-# INLINE new #-}
+new n = assert (n >= 0) $ unsafeNew n
+
+newWith :: (Base v a, m ~ Trans v) => Int -> a -> m (v a)
+{-# INLINE newWith #-}
+newWith n x = assert (n >= 0) $ unsafeNewWith n x
+
+read :: (Base v a, m ~ Trans v) => v a -> Int -> m a
+{-# INLINE read #-}
+read v i = assert (inBounds v i) $ unsafeRead v i
+
+write :: (Base v a, m ~ Trans v) => v a -> Int -> a -> m ()
+{-# INLINE write #-}
+write v i x = assert (inBounds v i) $ unsafeWrite v i x
+
+copy :: (Base v a, m ~ Trans v) => v a -> v a -> m ()
+{-# INLINE copy #-}
+copy dst src = assert (not (dst `overlaps` src) && length dst == length src)
+             $ unsafeCopy dst src
+
+grow :: (Base v a, m ~ Trans v) => v a -> Int -> m (v a)
+{-# INLINE grow #-}
+grow v by = assert (by >= 0)
+          $ unsafeGrow v by
+
+
+unstream :: (Base v a, m ~ Trans v) => Stream a -> m (v a)
+{-# INLINE unstream #-}
+unstream s = case upperBound (Stream.size s) of
+               Just n  -> unstreamMax     s n
+               Nothing -> unstreamUnknown s
+
+unstreamMax :: (Base v a, m ~ Trans v) => Stream a -> Int -> m (v a)
+{-# INLINE unstreamMax #-}
+unstreamMax s n
+  = do
+      v  <- new n
+      let put i x = do { write v i x; return (i+1) }
+      n' <- Stream.foldM put 0 s
+      return $ slice v 0 n'
+
+unstreamUnknown :: (Base v a, m ~ Trans v) => Stream a -> m (v a)
+{-# INLINE unstreamUnknown #-}
+unstreamUnknown s
+  = do
+      v <- new 0
+      (v', n) <- Stream.foldM put (v, 0) s
+      return $ slice v' 0 n
+  where
+    {-# INLINE put #-}
+    put (v, i) x = do
+                     v' <- enlarge v i
+                     unsafeWrite v' i x
+                     return (v', i+1)
+
+    {-# INLINE enlarge #-}
+    enlarge v i | i < length v = return v
+                | otherwise    = unsafeGrow v
+                                 . max 1
+                                 . double2Int
+                                 $ int2Double (length v) * gROWTH_FACTOR
+
index 244d996..be2b360 100644 (file)
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
 
 
-module Data.Vector.Mutable (
-  Vector,
+module Data.Vector.Mutable ( Vector(..) )
+where
 
 
-  new, new', length, slice, read, write, unstream, fill,
-  dataOf
-) where
+import qualified Data.Vector.Base.Mutable as Base
 
 
-import qualified Data.Vector.Prim as Prim
+import GHC.Prim ( MutableArray#,
+                  newArray#, readArray#, writeArray#, sameMutableArray#, (+#) )
 
 
-import           Data.Vector.Stream.Size ( upperBound )
-import qualified Data.Vector.Stream as Stream
-import           Data.Vector.Stream ( Stream )
+import GHC.ST   ( ST(..) )
 
 
-import Control.Exception ( assert )
-import Control.Monad.ST  ( ST )
-
-import Prelude hiding ( length, read )
+import GHC.Base ( Int(..) )
 
 data Vector s a = Vector {-# UNPACK #-} !Int
                          {-# UNPACK #-} !Int
 
 data Vector s a = Vector {-# UNPACK #-} !Int
                          {-# UNPACK #-} !Int
-                         {-# UNPACK #-} !(Prim.MutableVector s a)
-
-dataOf :: Vector s a -> (Prim.MutableVector s a, Int, Int)
-{-# INLINE dataOf #-}
-dataOf (Vector i n v) = (v, i, n)
-
-new :: Int -> ST s (Vector s a)
-{-# INLINE new #-}
-new n = new' n (error "Data.Vector.Mutable: uninitialised element")
-
-new' :: Int -> a -> ST s (Vector s a)
-{-# INLINE new' #-}
-new' n x = assert (n >= 0)
-         $ Vector 0 n `fmap` Prim.new' n x
-
-length :: Vector s a -> Int
-{-# INLINE length #-}
-length (Vector _ n _) = n
-
-slice :: Vector s a -> Int -> Int -> Vector s a
-{-# INLINE slice #-}
-slice (Vector i n v) j m
-  = assert (j + m <= n && j >= 0 && m >= 0)
-  $ Vector (i+j) m v
-
-read :: Vector s a -> Int -> ST s a
-{-# INLINE read #-}
-read (Vector i n v) j
-  = assert (j < n)
-  $ Prim.read v (i+j)
-
-write :: Vector s a -> Int -> a -> ST s ()
-{-# INLINE write #-}
-write (Vector i n v) j x
-  = assert (j < n)
-  $ Prim.write v (i+j) x
-
-unstream :: Stream a -> ST s (Vector s a)
-{-# INLINE unstream #-}
-unstream s = case upperBound (Stream.size s) of
-               Just n  -> unstream_known   s n
-               Nothing -> unstream_unknown s
-
-gROWTH_FACTOR :: Double
-gROWTH_FACTOR = 1.6
-
-unstream_known :: Stream a -> Int -> ST s (Vector s a)
-{-# INLINE unstream_known #-}
-unstream_known s n
-  = do
-      v  <- new n
-      n' <- fill v s
-      return $ slice v 0 n'
-
-unstream_unknown :: Stream a -> ST s (Vector s a)
-{-# INLINE unstream_unknown #-}
-unstream_unknown s
-  = do
-      v <- Prim.new 0
-      (w, n, _) <- Stream.foldM put (v, 0, 0) s
-      return $ Vector 0 n w
-  where
-    {-# INLINE put #-}
-    put (v, i, n) x = do
-                        (v', n') <- enlarge v i n
-                        Prim.write v' i x
-                        return (v', i+1, n')
-
-    {-# INLINE enlarge #-}
-    enlarge v i n | i < n     = return (v, n)
-                  | otherwise = Prim.grow v n gROWTH_FACTOR
-
-fill :: Vector s a -> Stream a -> ST s Int
-{-# INLINE fill #-}
-fill !v s = Stream.foldM put 0 s
-  where
-    {-# INLINE put #-}
-    put i x = do { write v i x; return (i+1) }
+                                        (MutableArray# s a)
+
+instance Base.Base (Vector s) a where
+  type Base.Trans (Vector s) = ST s
+
+  length (Vector _ n _) = n
+  unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#
+
+  {-# INLINE unsafeNew #-}
+  unsafeNew = unsafeNew
+
+  {-# INLINE unsafeNewWith #-}
+  unsafeNewWith = unsafeNewWith
+
+  {-# INLINE unsafeRead #-}
+  unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (readArray# arr# (i# +# j#))
+
+  {-# INLINE unsafeWrite #-}
+  unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->
+      case writeArray# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)
+    )
+
+  {-# INLINE overlaps #-}
+  overlaps (Vector i m arr1#) (Vector j n arr2#)
+    = sameMutableArray# arr1# arr2#
+      && (between i j (j+n) || between j i (i+m))
+    where
+      between x y z = x >= y && x < z
+
+unsafeNew :: Int -> ST s (Vector s a)
+{-# INLINE unsafeNew #-}
+unsafeNew n = unsafeNewWith n (error "Data.Vector.Mutable: uninitialised elemen t")
+
+unsafeNewWith :: Int -> a -> ST s (Vector s a)
+{-# INLINE unsafeNewWith #-}
+unsafeNewWith (I# n#) x = ST (\s# ->
+    case newArray# n# x s# of
+      (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)
+  )
 
 
diff --git a/Data/Vector/Prim.hs b/Data/Vector/Prim.hs
deleted file mode 100644 (file)
index f9eb004..0000000
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
-
-module Data.Vector.Prim (
-  Vector, MutableVector,
-  new, new', unsafeFreeze, at, at', read, write, copy, grow
-) where
-
-import GHC.Prim (
-    Array#, MutableArray#,
-    newArray#, readArray#, writeArray#, indexArray#, unsafeFreezeArray#
-  )
-import GHC.Float (
-    double2Int, int2Double
-  )
-import GHC.ST (
-    ST(..)
-  )
-import GHC.Base (
-    Int(..)
-  )
-
-import Prelude hiding ( read )
-
-data Vector          a = Vector (Array# a)
-data MutableVector s a = MutableVector (MutableArray# s a)
-
-new :: Int -> ST s (MutableVector s a)
-{-# INLINE new #-}
-new n = new' n (error "Data.Vector: uninitialised element")
-
-new' :: Int -> a -> ST s (MutableVector s a)
-{-# INLINE new' #-}
-new' (I# n#) x = ST $ \s# ->
-  case newArray# n# x s# of
-    (# s2#, arr# #) -> (# s2#, MutableVector arr# #)
-
-unsafeFreeze :: MutableVector s a -> ST s (Vector a)
-{-# INLINE unsafeFreeze #-}
-unsafeFreeze (MutableVector arr#) = ST $ \s# ->
-  case unsafeFreezeArray# arr# s# of
-    (# s2, frozen# #) -> (# s2, Vector frozen# #)
-
-at :: Vector a -> Int -> a
-{-# INLINE at #-}
-at v i = at' v i id
-
-at' :: Vector a -> Int -> (a -> b) -> b
-{-# INLINE at' #-}
-at' (Vector arr#) (I# n#) f = case indexArray# arr# n# of (# x #) -> f x
-
-read :: MutableVector s a -> Int -> ST s a
-{-# INLINE read #-}
-read (MutableVector arr#) (I# n#) = ST $ readArray# arr# n#
-
-write :: MutableVector s a -> Int -> a -> ST s ()
-{-# INLINE write #-}
-write (MutableVector arr#) (I# n#) x = ST $ \s# ->
-  case writeArray# arr# n# x s# of s2# -> (# s2#, () #)
-
-copy :: MutableVector s a -> Int -> MutableVector s a -> Int -> Int -> ST s ()
-{-# INLINE copy #-}
-copy mv i mw j n = do_copy i j n
-  where
-    do_copy i j 0 = return ()
-    do_copy i j n = do
-                      x <- read mw j
-                      write mv i x
-                      do_copy (i+1) (j+1) (n-1)
-
-grow :: MutableVector s a -> Int -> Double -> ST s (MutableVector s a, Int)
-{-# INLINE grow #-}
-grow v n r
-  = do
-      w <- new m
-      copy w 0 v 0 n
-      return (w, m)
-  where
-    n' = double2Int (int2Double n * r)
-    m | n' <= n   = n+1
-      | otherwise = n'
-
index 0ef303c..782dfa2 100644 (file)
@@ -5,7 +5,7 @@
 module Data.Vector.Stream (
   Step(..), Stream(..),
 
 module Data.Vector.Stream (
   Step(..), Stream(..),
 
-  size, sized, unfold,
+  size, sized, unfold, toList, fromList,
   empty, singleton, replicate, (++),
   map, filter, zipWith,
   foldr, foldl, foldl',
   empty, singleton, replicate, (++),
   map, filter, zipWith,
   foldr, foldl, foldl',
@@ -41,6 +41,17 @@ unfold f s = Stream step s Unknown
                Just (x, s') -> Yield x s'
                Nothing      -> Done
 
                Just (x, s') -> Yield x s'
                Nothing      -> Done
 
+toList :: Stream a -> [a]
+{-# INLINE toList #-}
+toList s = foldr (:) [] s
+
+fromList :: [a] -> Stream a
+{-# INLINE_STREAM fromList #-}
+fromList xs = Stream step xs Unknown
+  where
+    step (x:xs) = Yield x xs
+    step []     = Done
+
 empty :: Stream a
 {-# INLINE_STREAM empty #-}
 empty = Stream (const Done) () (Exact 0)
 empty :: Stream a
 {-# INLINE_STREAM empty #-}
 empty = Stream (const Done) () (Exact 0)
@@ -112,21 +123,21 @@ zipWith f (Stream stepa sa na) (Stream stepb sb nb)
                                Skip    sb' -> Skip          (sa, sb', Just x)
                                Done        -> Done
 
                                Skip    sb' -> Skip          (sa, sb', Just x)
                                Done        -> Done
 
-foldl :: (a -> b -> b) -> b -> Stream a -> b
+foldl :: (a -> b -> a) -> a -> Stream b -> a
 {-# INLINE_STREAM foldl #-}
 foldl f z (Stream step s _) = foldl_go z s
   where
     foldl_go z s = case step s of
 {-# INLINE_STREAM foldl #-}
 foldl f z (Stream step s _) = foldl_go z s
   where
     foldl_go z s = case step s of
-                     Yield x s' -> foldl_go (f x z) s'
+                     Yield x s' -> foldl_go (f z x) s'
                      Skip    s' -> foldl_go z       s'
                      Done       -> z
 
                      Skip    s' -> foldl_go z       s'
                      Done       -> z
 
-foldl' :: (a -> b -> b) -> b -> Stream a -> b
+foldl' :: (a -> b -> a) -> a -> Stream b -> a
 {-# INLINE_STREAM foldl' #-}
 {-# INLINE_STREAM foldl' #-}
-foldl' f z (Stream step s _) = foldl_go z s
+foldl' f !z (Stream step s _) = foldl_go z s
   where
     foldl_go !z s = case step s of
   where
     foldl_go !z s = case step s of
-                      Yield x s' -> foldl_go (f x z) s'
+                      Yield x s' -> foldl_go (f z x) s'
                       Skip    s' -> foldl_go z       s'
                       Done       -> z
 
                       Skip    s' -> foldl_go z       s'
                       Done       -> z
 
index 6deb862..bd2250d 100644 (file)
-{-# LANGUAGE RankNTypes, CPP #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances, MultiParamTypeClasses #-}
 
 
-#include "phases.h"
+module Data.Vector.Unboxed (
+  Vector(..), module Data.Vector.Base
+) where
 
 
-module Data.Vector.Unboxed
-where
-
-import qualified Data.Vector.Unboxed.Prim as Prim
+import           Data.Vector.Base
 import qualified Data.Vector.Unboxed.Mutable as Mut
 import qualified Data.Vector.Unboxed.Mutable as Mut
-import           Data.Vector.Unboxed.Unbox ( Unbox )
-
-import           Data.Vector.Stream.Size ( Size(..) )
-import qualified Data.Vector.Stream as Stream
-import           Data.Vector.Stream ( Stream )
+import           Data.Vector.Unboxed.Unbox
 
 
-import Control.Exception ( assert )
-import Control.Monad.ST  ( ST, runST )
+import Control.Monad.ST ( runST )
 
 
-import Prelude hiding ( length, (++) )
+import GHC.ST   ( ST(..) )
+import GHC.Prim ( ByteArray#, unsafeFreezeByteArray#, (+#) )
+import GHC.Base ( Int(..) )
 
 data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
 
 data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
-                       {-# UNPACK #-} !(Prim.Vector a)
-
-new :: Unbox a
-    => Int -> (forall s. Mut.Vector s a -> ST s (Mut.Vector s a)) -> Vector a
-{-# INLINE new #-}
-new n init = runST (
-  do
-    mv  <- Mut.new n
-    mv' <- init mv
-    let (mprim, i, n') = Mut.dataOf mv'
-    prim <- Prim.unsafeFreeze mprim
-    return $ Vector i n' prim
-  )
-
-stream :: Unbox a => Vector a -> Stream a
-{-# INLINE_STREAM stream #-}
-stream (Vector i n arr) = Stream.unfold get i `Stream.sized` Exact n
-  where
-    n' = n+i
-
-    {-# INLINE get #-}
-    get j | j < n'    = Just (Prim.at arr j, j+1)
-          | otherwise = Nothing
-
-unstream :: Unbox a => Stream a -> Vector a
-{-# INLINE_STREAM unstream #-}
-unstream s = runST (do
-    mv <- Mut.unstream s
-    let (mprim, i, n) = Mut.dataOf mv
-    prim <- Prim.unsafeFreeze mprim
-    return $ Vector i n prim
-  )
-
-{-# RULES
-
-"stream/unstream [Vector.Unboxed]" forall s.
-  stream (unstream s) = s
-
- #-}
-
-length :: Unbox a => Vector a -> Int
-{-# INLINE length #-}
-length (Vector _ n _) = n
-
-slice :: Unbox a => Vector a -> Int -> Int -> Vector a
-{-# INLINE slice #-}
-slice (Vector i n arr) j m
-  = assert (j + m <= n && j >= 0 && m >= 0)
-  $ Vector (i+j) m arr
-
-unsafeAt :: Unbox a => Vector a -> Int -> a
-{-# INLINE unsafeAt #-}
-unsafeAt (Vector i _ arr) j = Prim.at arr (i+j)
-
-at :: Unbox a => Vector a -> Int -> a
-{-# INLINE at #-}
-at v i = assert (i >= 0 && i < length v)
-       $ unsafeAt v i
-
-infixr ++
-(++) :: Unbox a => Vector a -> Vector a -> Vector a
-{-# INLINE (++) #-}
-v ++ w = unstream (stream v Stream.++ stream w)
+                                      ByteArray#
 
 
-map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
-{-# INLINE map #-}
-map f = unstream . Stream.map f . stream
+instance Unbox a => Base Vector a where
+  {-# INLINE create #-}
+  create init = runST (do
+      Mut.Vector i n marr# <- init
+      ST (\s# -> case unsafeFreezeByteArray# marr# s# of
+                   (# s2#, arr# #) -> (# s2#, Vector i n arr# #)
+         )
+    )
 
 
-filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a
-{-# INLINE filter #-}
-filter f = unstream . Stream.filter f . stream
+  {-# INLINE length #-}
+  length (Vector _ n _) = n
 
 
-zipWith :: (Unbox a, Unbox b, Unbox c)
-        => (a -> b -> c) -> Vector a -> Vector b -> Vector c
-{-# INLINE zipWith #-}
-zipWith f v w = unstream
-              $ Stream.zipWith f (stream v) (stream w)
+  {-# INLINE unsafeSlice #-}
+  unsafeSlice (Vector i _ arr#) j n = Vector (i+j) n arr#
 
 
-foldl' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b
-{-# INLINE foldl' #-}
-foldl' f z = Stream.foldl' f z . stream
+  {-# INLINE unsafeIndex #-}
+  unsafeIndex (Vector (I# i#) _ arr#) (I# j#) f = f (at# arr# (i# +# j#))
 
 
index 32fb5fd..ed02898 100644 (file)
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}
 
 
-module Data.Vector.Unboxed.Mutable (
-  Vector,
+module Data.Vector.Unboxed.Mutable ( Vector(..) )
+where
 
 
-  new, length, slice, read, write, unstream, fill, fillIndexed,
-  dataOf
-) where
+import qualified Data.Vector.Base.Mutable as Base
+import           Data.Vector.Unboxed.Unbox
 
 
-import qualified Data.Vector.Unboxed.Prim as Prim
-import           Data.Vector.Unboxed.Unbox ( Unbox )
+import GHC.Prim ( MutableByteArray#,
+                  newByteArray#, sameMutableByteArray#, (+#) )
 
 
-import           Data.Vector.Stream.Size ( upperBound )
-import qualified Data.Vector.Stream as Stream
-import           Data.Vector.Stream ( Stream )
+import GHC.ST   ( ST(..) )
 
 
-import Control.Exception ( assert )
-import Control.Monad.ST  ( ST )
+import GHC.Base ( Int(..) )
 
 
-import Prelude hiding ( length, read )
+data Vector s a = Vector {-# UNPACK #-} !Int
+                         {-# UNPACK #-} !Int
+                                        (MutableByteArray# s)
 
 
-data Vector s a = Vector {-# UNPACK #-} !Int                       -- ^ start
-                         {-# UNPACK #-} !Int                       -- ^ length
-                         {-# UNPACK #-} !(Prim.MutableVector s a)  -- ^ data
 
 
-dataOf :: Vector s a -> (Prim.MutableVector s a, Int, Int)
-{-# INLINE dataOf #-}
-dataOf (Vector i n v) = (v, i, n)
+instance Unbox a => Base.Base (Vector s) a where
+  type Base.Trans (Vector s) = ST s
 
 
-new :: Unbox a => Int -> ST s (Vector s a)
-{-# INLINE new #-}
-new n = assert (n >= 0)
-      $ Vector 0 n `fmap` Prim.new n
+  length (Vector _ n _) = n
+  unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#
 
 
-length :: Unbox a => Vector s a -> Int
-{-# INLINE length #-}
-length (Vector _ n _) = n
+  {-# INLINE unsafeNew #-}
+  unsafeNew (I# n#) = ST (\s# ->
+      case newByteArray# (size# (undefined :: a) n#) s# of
+        (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)
+    )
 
 
-slice :: Unbox a => Vector s a -> Int -> Int -> Vector s a
-{-# INLINE slice #-}
-slice (Vector i n v) j m
-  = assert (j + m <= n && j >= 0 && m >= 0)
-  $ Vector (i+j) m v
+  {-# INLINE unsafeRead #-}
+  unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (read# arr# (i# +# j#))
 
 
-slicel :: Unbox a => Vector s a -> Int -> Vector s a
-{-# INLINE slicel #-}
-slicel (Vector i n v) m
-  = assert (m <= n && m >= 0)
-  $ Vector i m v
+  {-# INLINE unsafeWrite #-}
+  unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->
+      case write# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)
+    )
 
 
-read :: Unbox a => Vector s a -> Int -> ST s a
-{-# INLINE read #-}
-read (Vector i n v) j
-  = assert (j < n)
-  $ Prim.read v (i+j)
-
-write :: Unbox a => Vector s a -> Int -> a -> ST s ()
-{-# INLINE write #-}
-write (Vector i n v) j x
-  = assert (j < n)
-  $ Prim.write v (i+j) x
-
-unstream :: Unbox a => Stream a -> ST s (Vector s a)
-{-# INLINE unstream #-}
-unstream s = case upperBound (Stream.size s) of
-               Just n  -> unstream_known   s n
-               Nothing -> unstream_unknown s
-
-gROWTH_FACTOR :: Double
-gROWTH_FACTOR = 1.6
-
-unstream_known :: Unbox a => Stream a -> Int -> ST s (Vector s a)
-{-# INLINE unstream_known #-}
-unstream_known s n
-  = do
-      v  <- new n
-      n' <- fill v s
-      return $ slice v 0 n'
-
-unstream_unknown :: Unbox a => Stream a -> ST s (Vector s a)
-{-# INLINE unstream_unknown #-}
-unstream_unknown s
-  = do
-      v <- Prim.new 0
-      (w, n, _) <- Stream.foldM put (v, 0, 0) s
-      return $ Vector 0 n w
-  where
-    {-# INLINE put #-}
-    put (v, i, n) x = do
-                        (v', n') <- enlarge v i n
-                        Prim.write v' i x
-                        return (v', i+1, n')
-
-    {-# INLINE enlarge #-}
-    enlarge v i n | i < n     = return (v, n)
-                  | otherwise = Prim.grow v n gROWTH_FACTOR
-
-fill :: Unbox a => Vector s a -> Stream a -> ST s Int
-{-# INLINE fill #-}
-fill !v s = Stream.foldM put 0 s
-  where
-    {-# INLINE put #-}
-    put i x = do { write v i x; return (i+1) }
-
-fillIndexed :: Unbox a => Vector s a -> Stream (Int, a) -> ST s ()
-{-# INLINE fillIndexed #-}
-fillIndexed !v s = Stream.mapM_ put s
-  where
-    {-# INLINE put #-}
-    put (i,x) = write v i x
-
-copyTo :: Unbox a => Vector s a -> Vector s a -> ST s ()
-{-# INLINE copyTo #-}
-copyTo !v !w = assert (length v == length w)
-             $ copy_loop 0
-  where
-    n = length v
-
-    copy_loop i | i < n     = do
-                                x <- read v i
-                                write w i x
-                                copy_loop (i+1)
-                | otherwise = return ()
-
-clone :: Unbox a => Vector s a -> ST s (Vector s a)
-{-# INLINE clone #-}
-clone v = do
-            w <- new (length v)
-            v `copyTo` w
-            return w
+  {-# INLINE overlaps #-}
+  overlaps (Vector i m arr1#) (Vector j n arr2#)
+    = sameMutableByteArray# arr1# arr2#
+      && (between i j (j+n) || between j i (i+m))
+    where
+      between x y z = x >= y && x < z
 
 
diff --git a/Data/Vector/Unboxed/Prim.hs b/Data/Vector/Unboxed/Prim.hs
deleted file mode 100644 (file)
index 12ca5cd..0000000
+++ /dev/null
@@ -1,84 +0,0 @@
-{-# LANGUAGE MagicHash, UnboxedTuples, ScopedTypeVariables #-}
-
-module Data.Vector.Unboxed.Prim (
-  Unbox(..), Vector, MutableVector,
-
-  size, new, unsafeFreeze, at, read, write,
-  copy, grow
-) where
-
-import Data.Vector.Unboxed.Unbox
-
-import GHC.Prim (
-    ByteArray#, MutableByteArray#,
-    newByteArray#, unsafeFreezeByteArray#,
-  )
-import GHC.Float (
-    int2Double, double2Int
-  )
-import GHC.ST (
-    ST(..)
-  )
-import GHC.Base (
-    Int(..)
-  )
-
-import Prelude hiding ( read )
-
-data Vector          a = Vector        ByteArray#
-data MutableVector s a = MutableVector (MutableByteArray# s)
-
-size :: Unbox a => a -> Int -> Int
-{-# INLINE size #-}
-size a (I# i#) = I# (size# a i#)
-
-new :: forall s a. Unbox a => Int -> ST s (MutableVector s a)
-{-# INLINE new #-}
-new (I# n#) = ST $ \s# ->
-  case newByteArray# (size# (undefined :: a) n#) s# of
-    (# s2#, arr# #) -> (# s2#, MutableVector arr# #)
-
-unsafeFreeze :: Unbox a => MutableVector s a -> ST s (Vector a)
-{-# INLINE unsafeFreeze #-}
-unsafeFreeze (MutableVector arr#) = ST $ \s# ->
-  case unsafeFreezeByteArray# arr# s# of
-    (# s2, frozen# #) -> (# s2, Vector frozen# #)
-
-at :: Unbox a => Vector a -> Int -> a
-{-# INLINE at #-}
-at (Vector arr#) (I# i#) = at# arr# i#
-
-read :: Unbox a => MutableVector s a -> Int -> ST s a
-{-# INLINE read #-}
-read (MutableVector arr#) (I# i#) = ST $ read# arr# i#
-
-write :: Unbox a => MutableVector s a -> Int -> a -> ST s ()
-{-# INLINE write #-}
-write (MutableVector arr#) (I# i#) x = ST $ \s# ->
-  case write# arr# i# x s# of s2# -> (# s2#, () #)
-
-copy :: Unbox a => MutableVector s a -> Int
-                -> MutableVector s a -> Int -> Int
-                -> ST s ()
-{-# INLINE copy #-}
-copy mv i mw j n = do_copy i j n
-  where
-    do_copy i j 0 = return ()
-    do_copy i j n = do
-                      x <- read mw j
-                      write mv i x
-                      do_copy (i+1) (j+1) (n-1)
-
-grow :: Unbox a => MutableVector s a -> Int -> Double
-                -> ST s (MutableVector s a, Int)
-{-# INLINE grow #-}
-grow v n r
-  = do
-      w <- new m
-      copy w 0 v 0 n
-      return (w, m)
-  where
-    n' = double2Int (int2Double n * r)
-    m | n' <= n   = n+1
-      | otherwise = n'
-
index 45fd9a4..8740862 100644 (file)
@@ -15,12 +15,13 @@ Library
         Data.Vector.Stream.Size
         Data.Vector.Stream
 
         Data.Vector.Stream.Size
         Data.Vector.Stream
 
+        Data.Vector.Base.Mutable
+        Data.Vector.Base
+
         Data.Vector.Unboxed.Unbox
         Data.Vector.Unboxed.Unbox
-        Data.Vector.Unboxed.Prim
         Data.Vector.Unboxed.Mutable
         Data.Vector.Unboxed
 
         Data.Vector.Unboxed.Mutable
         Data.Vector.Unboxed
 
-        Data.Vector.Prim
         Data.Vector.Mutable
         Data.Vector
   Include-Dirs:
         Data.Vector.Mutable
         Data.Vector
   Include-Dirs: