Eq and Ord instances
[darcs-mirrors/vector.git] / Data / Vector / Unboxed.hs
index 9518ce5..703ce5f 100644 (file)
@@ -1,98 +1,56 @@
-{-# LANGUAGE RankNTypes, CPP #-}
-
-#include "phases.h"
-
-module Data.Vector.Unboxed
-where
-
-import qualified Data.Vector.Unboxed.Prim as Prim
+{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances, MultiParamTypeClasses #-}
+
+-- |
+-- Module      : Data.Vector.Unboxed
+-- Copyright   : (c) Roman Leshchinskiy 2008
+-- License     : BSD-style
+--
+-- Maintainer  : rl@cse.unsw.edu.au
+-- Stability   : experimental
+-- Portability : non-portable
+-- 
+-- Unboxed vectors based on 'Unbox'.
+--
+
+module Data.Vector.Unboxed (
+  Vector(..), module Data.Vector.IVector
+) where
+
+import           Data.Vector.IVector
 import qualified Data.Vector.Unboxed.Mutable as Mut
-import           Data.Vector.Unboxed.Unbox ( Unbox )
-
-import qualified Data.Vector.Stream as Stream
-import           Data.Vector.Stream ( Step(..), 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
-                       {-# 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 get i n
-  where
-    n' = n+i
-
-    {-# INLINE get #-}
-    get j | j < n'    = Yield (Prim.at arr j) (j+1)
-          | otherwise = Done
-
-unstream :: Unbox a => Stream a -> Vector a
-{-# INLINE_STREAM unstream #-}
-unstream s@(Stream _ _ n) = new n (\mv ->
-  do
-    n' <- Mut.fill mv s
-    return $ Mut.slice mv 0 n'
-  )
-
-{-# 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)
+                                      ByteArray#
 
-at :: Unbox a => Vector a -> Int -> a
-{-# INLINE at #-}
-at v i = assert (i >= 0 && i < length v)
-       $ unsafeAt v i
+instance Unbox a => IVector Vector a where
+  {-# INLINE vnew #-}
+  vnew init = runST (do
+                       Mut.Vector i n marr# <- init
+                       ST (\s# -> case unsafeFreezeByteArray# marr# s# of
+                            (# s2#, arr# #) -> (# s2#, Vector i n arr# #)))
 
+  {-# INLINE vlength #-}
+  vlength (Vector _ n _) = n
 
-map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
-{-# INLINE map #-}
-map f = unstream . Stream.map f . stream
+  {-# INLINE unsafeSlice #-}
+  unsafeSlice (Vector i _ arr#) j n = Vector (i+j) n arr#
 
-filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a
-{-# INLINE filter #-}
-filter f = unstream . Stream.filter f . stream
+  {-# INLINE unsafeIndex #-}
+  unsafeIndex (Vector (I# i#) _ arr#) (I# j#) f = f (at# arr# (i# +# j#))
 
-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)
+instance (Unbox a, Eq a) => Eq (Vector a) where
+  {-# INLINE (==) #-}
+  (==) = eq
 
-foldl' :: Unbox a => (a -> b -> b) -> b -> Vector a -> b
-{-# INLINE foldl' #-}
-foldl' f z = Stream.foldl' f z . stream
+instance (Unbox a, Ord a) => Ord (Vector a) where
+  {-# INLINE compare #-}
+  compare = cmp