Add indexs as a primitive
authorBen Lippmeier <benl@ouroborus.net>
Tue, 20 Dec 2011 08:50:03 +0000 (19:50 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Tue, 20 Dec 2011 08:50:53 +0000 (19:50 +1100)
dph-prim-interface/Data/Array/Parallel/Unlifted.hs
dph-prim-interface/interface/DPH_Header.h
dph-prim-interface/interface/DPH_Interface.h
dph-prim-seq/Data/Array/Parallel/Unlifted.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Combinators.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Extracts.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Stream.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Stream/Elems.hs

index f37ec03..d76e803 100644 (file)
@@ -87,6 +87,7 @@ enumFromStepLenEach size starts steps lens
 -- Projections ----------------------------------------------------------------
 length          = P.length
 index _         = (P.!!)
+indexs          = notImplemented "indexs"
 indexs_avs      = notImplemented "indexs_avs"
 
 extract xs i n  = P.take n (P.drop i xs)
index 080fc6e..63fff30 100644 (file)
@@ -21,6 +21,7 @@ module Data.Array.Parallel.Unlifted (
   -- * Projections
   length,
   index,
+  indexs,
   indexs_avs,
 
   extract,
index 8fae183..3f6b707 100644 (file)
@@ -209,6 +209,14 @@ index :: Elt a => Prelude.String -> Array a -> Int -> a
 {-# INLINE_BACKEND index #-}
 
 
+-- | O(n). Scattered indexing from a single `Array`
+indexs  :: Elt a
+        => Array a
+        -> Array Int
+        -> Array a
+{-# INLINE_BACKEND indexs #-}
+
+
 -- | O(n). Scattered indexing through a `VSegd`.
 indexs_avs
         :: (Elt a, Elts a)
@@ -269,7 +277,7 @@ drop :: Elt a => Int -> Array a -> Array a
 "indexs_avs/singletons/replicatedVSegd"
   forall arr len reps srcixs
   . indexs_avs (singletons arr) (replicatedVSegd len reps) srcixs
-  = arr `seq` map (index "rule" arr) (map snd srcixs)
+  = indexs arr (map snd srcixs)
 
  #-}
 
index 985e3d0..a9d938c 100644 (file)
@@ -43,6 +43,7 @@ enumFromStepLenEach             = U.enumFromStepLenEach
 -- Projections ----------------------------------------------------------------
 length                          = U.length
 index                           = U.index
+indexs                          = indexsFromVector
 indexs_avs                      = indexsFromVectorsUVSegd
 
 extract                         = U.extract
index 4a936a6..0a1ed8c 100644 (file)
@@ -30,6 +30,7 @@ module Data.Array.Parallel.Unlifted.Sequential
         , combineSU
         
           -- * Extracts and Indexing
+        , indexsFromVector
         , indexsFromVectorsUVSegd
         , extractsFromNestedUSSegd
         , extractsFromVectorsUSSegd
index a04c108..7654e4f 100644 (file)
@@ -35,7 +35,7 @@ foldlSU f !z segd xs
 foldlSSU :: (Unbox a, Unboxes a, Unbox b)
          => (b -> a -> b) -> b -> USSegd -> Vectors a -> Vector b
 {-# INLINE_U foldlSSU #-}
-foldlSSU f z ssegd xss
+foldlSSU f !z ssegd xss
         = unstream
         $ foldSS f z    (stream (USSegd.takeLengths ssegd))
                         (streamSegsFromVectorsUSSegd xss ssegd)
index e8e2317..a2c79bd 100644 (file)
@@ -4,7 +4,8 @@
 -- | Standard combinators for segmented unlifted arrays.
 module Data.Array.Parallel.Unlifted.Sequential.Extracts
         ( -- * Scattered indexing.
-          indexsFromVectorsUVSegd
+          indexsFromVector
+        , indexsFromVectorsUVSegd
 
           -- * Scattered extracts
         , extractsFromNestedUSSegd
@@ -20,6 +21,18 @@ import qualified Data.Vector                                    as V
 
 
 -- Indexs --------------------------------------------------------------------
+-- | Lookup elements from a `Vector`.
+indexsFromVector
+        :: Unbox a
+        => Vector a -> Vector Int -> Vector a
+
+indexsFromVector vector ixs
+        = U.unstream 
+        $ streamElemsFromVector vector 
+        $ U.stream ixs
+{-# INLINE_U indexsFromVector #-}
+
+
 -- | Lookup elements from some `Vectors` through a `UPVSegd`.
 indexsFromVectorsUVSegd 
         :: (Unbox a, US.Unboxes a)
index 806e8d1..390f742 100644 (file)
@@ -5,7 +5,7 @@ module Data.Array.Parallel.Unlifted.Stream
         , streamSrcIxsThroughUSSegd
 
           -- * Element streamers.
-        , streamElemsFromVectors
+        , streamElemsFromVector
         , streamElemsFromVectorsVSegd
 
           -- * Segment streamers.
index 957fac4..f56b44b 100644 (file)
@@ -1,17 +1,40 @@
 {-# LANGUAGE CPP, NoMonomorphismRestriction #-}
 #include "fusion-phases.h"
 module Data.Array.Parallel.Unlifted.Stream.Elems
-        ( streamElemsFromVectors
+        ( streamElemsFromVector
+        , streamElemsFromVectors
         , streamElemsFromVectorsVSegd)
 where
 import Data.Array.Parallel.Unlifted.Stream.Ixs
 import Data.Vector.Fusion.Stream.Monadic
+import Data.Array.Parallel.Unlifted.Sequential.Vector            (Unbox, Vector)
 import Data.Array.Parallel.Unlifted.Vectors                      (Unboxes, Vectors)
 import Data.Array.Parallel.Unlifted.Sequential.UVSegd            (UVSegd(..))
+import qualified Data.Array.Parallel.Unlifted.Sequential.Vector  as U
 import qualified Data.Array.Parallel.Unlifted.Vectors            as US
 import qualified Data.Array.Parallel.Unlifted.Sequential.UVSegd  as UVSegd
 
 
+streamElemsFromVector
+        :: (Monad m, Unbox a)
+        => Vector a -> Stream m Int -> Stream m a
+
+streamElemsFromVector vector (Stream mkStep s0 size0)
+ = vector `seq` Stream mkStep' s0 size0
+ where
+        {-# INLINE_INNER mkStep' #-}
+        mkStep' s
+         = do   step    <- mkStep s
+                case step of
+                 Yield ix s'
+                  -> let !result = U.index "streamElemsFromVector" vector ix
+                     in  return $ Yield result s'
+                 
+                 Skip s'        -> return $ Skip s'
+                 Done           -> return Done
+
+
+
 -- | Take a stream of chunk and chunk element indices, look them up from
 --   some vectors, and produce a stream of elements.
 streamElemsFromVectors 
@@ -29,8 +52,8 @@ streamElemsFromVectors vectors (Stream mkStep s0 size0)
                   -> let !result = US.unsafeIndex2 vectors ix1 ix2
                      in  return $ Yield result s'
 
-                 Skip s'             -> return $ Skip s'
-                 Done                -> return Done
+                 Skip s'        -> return $ Skip s'
+                 Done           -> return Done
 {-# INLINE_STREAM streamElemsFromVectors #-}