Tuple2.hs

{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
#include "fusion-phases.h"

-- | PR instance for tuples.
module Data.Array.Parallel.PArray.PData.Tuple2
        ( PData(..),    PDatas(..)
        , zipPD
        , ziplPR
        , unzipPD
        , unziplPD)
where
import Data.Array.Parallel.Pretty
import Data.Array.Parallel.PArray.PData.Base
import Data.Array.Parallel.PArray.PData.Nested
import GHC.Exts
import Prelude hiding (zip, unzip)
import qualified Data.Vector                    as V
import qualified Prelude                        as P
import qualified Data.Array.Parallel.Unlifted   as U

-------------------------------------------------------------------------------
data instance PData (a, b)
        = PTuple2  (PData a)  (PData b)

data instance PDatas (a, b)
        = PTuple2s (PDatas a) (PDatas b)


-- PR -------------------------------------------------------------------------
instance (PR a, PR b) => PR (a, b) where

  {-# NOINLINE validPR #-}
  validPR (PTuple2 xs ys)
        = validPR xs && validPR ys


  {-# NOINLINE nfPR #-}
  nfPR (PTuple2 arr1 arr2)
        = nfPR arr1 `seq` nfPR arr2 `seq` ()


  {-# NOINLINE similarPR #-}
  similarPR (x1, y1) (x2, y2)
        =  similarPR x1 x2
        && similarPR y1 y2


  {-# NOINLINE coversPR #-}
  coversPR weak (PTuple2 arr1 arr2) ix
        =  coversPR weak arr1 ix
        && coversPR weak arr2 ix

  {-# NOINLINE pprpPR #-}
  pprpPR (x, y)
        = text "Tuple2 " <> vcat [pprpPR x, pprpPR y]
        

  {-# NOINLINE pprpDataPR #-}
  pprpDataPR (PTuple2 xs ys)
        = text "PTuple2 " <> vcat [pprpDataPR xs, pprpDataPR ys]

  -- Constructors -------------------------------
  {-# INLINE_PDATA emptyPR #-}
  emptyPR
        = PTuple2 emptyPR emptyPR


  {-# INLINE_PDATA replicatePR #-}
  replicatePR len (x, y)
        = PTuple2 (replicatePR len x)
                  (replicatePR len y)


  {-# INLINE_PDATA replicatesPR #-}
  replicatesPR lens (PTuple2 arr1 arr2)
        = PTuple2 (replicatesPR lens arr1)
                  (replicatesPR lens arr2)


  {-# INLINE_PDATA appendPR #-}
  appendPR (PTuple2 arr11 arr12) (PTuple2 arr21 arr22)
        = PTuple2 (arr11 `appendPR` arr21)
                  (arr12 `appendPR` arr22)


  {-# INLINE_PDATA appendsPR #-}
  appendsPR segdResult segd1 (PTuple2 arrs11 arrs12) segd2 (PTuple2 arrs21 arrs22)
        = PTuple2 (appendsPR segdResult segd1 arrs11 segd2 arrs21)
                  (appendsPR segdResult segd1 arrs12 segd2 arrs22)


  -- Projections ---------------------------------
  {-# INLINE_PDATA lengthPR #-}
  lengthPR (PTuple2 arr1 _) 
        = lengthPR arr1
  
  {-# INLINE_PDATA indexPR #-}
  indexPR (PTuple2 arr1 arr2) ix
        = (indexPR arr1 ix, indexPR arr2 ix)

  {-# INLINE_PDATA indexsPR #-}
  indexsPR (PTuple2s xs ys) srcixs
        = PTuple2 (indexsPR xs srcixs)
                  (indexsPR ys srcixs)

  {-# INLINE_PDATA indexvsPR #-}
  indexvsPR (PTuple2s xs ys) vsegd srcixs
        = PTuple2 (indexvsPR xs vsegd srcixs)
                  (indexvsPR ys vsegd srcixs)

  {-# INLINE_PDATA extractPR #-}
  extractPR (PTuple2 arr1 arr2) start len
        = PTuple2 (extractPR arr1 start len) 
                  (extractPR arr2 start len)

  {-# INLINE_PDATA extractssPR #-}
  extractssPR (PTuple2s xs ys) ussegd
        = PTuple2 (extractssPR xs ussegd)
                  (extractssPR ys ussegd)

  {-# INLINE_PDATA extractvsPR #-}
  extractvsPR (PTuple2s xs ys) uvsegd
        = PTuple2 (extractvsPR xs uvsegd)
                  (extractvsPR ys uvsegd)


  -- Pack and Combine ---------------------------
  {-# INLINE_PDATA packByTagPR #-}
  packByTagPR (PTuple2 arr1 arr2) tags tag
        = PTuple2 (packByTagPR arr1 tags tag)
                  (packByTagPR arr2 tags tag)

  {-# INLINE_PDATA combine2PR #-}
  combine2PR sel (PTuple2 xs1 ys1) (PTuple2 xs2 ys2)
        = PTuple2 (combine2PR sel xs1 xs2)
                  (combine2PR sel ys1 ys2)


  -- Conversions --------------------------------
  {-# NOINLINE fromVectorPR #-}
  fromVectorPR vec
   = let (xs, ys)       = V.unzip vec
     in  PTuple2  (fromVectorPR xs)
                  (fromVectorPR ys)

  {-# NOINLINE toVectorPR #-}
  toVectorPR (PTuple2 xs ys)
        = V.zip   (toVectorPR xs)
                  (toVectorPR ys)


  -- PData --------------------------------------
  {-# INLINE_PDATA emptydPR #-}
  emptydPR      
        = PTuple2s emptydPR
                   emptydPR

  
  {-# INLINE_PDATA singletondPR #-}
  singletondPR (PTuple2 x y)
        = PTuple2s (singletondPR x)
                   (singletondPR y)


  {-# INLINE_PDATA lengthdPR #-}
  lengthdPR (PTuple2s xs _)
        = lengthdPR xs
   
   
  {-# INLINE_PDATA indexdPR #-}
  indexdPR (PTuple2s xs ys) i
        = PTuple2  (indexdPR xs i)
                   (indexdPR ys i)

   
  {-# INLINE_PDATA appenddPR #-}
  appenddPR (PTuple2s xs1 ys1) (PTuple2s xs2 ys2)
        = PTuple2s (appenddPR xs1 xs2)
                   (appenddPR ys1 ys2)
  

  {-# NOINLINE fromVectordPR #-}
  fromVectordPR vec
   = let (xss, yss) = V.unzip $ V.map (\(PTuple2 xs ys) -> (xs, ys)) vec
     in  PTuple2s  (fromVectordPR xss)
                   (fromVectordPR yss)


  {-# NOINLINE toVectordPR #-}
  toVectordPR (PTuple2s pdatas1 pdatas2)
        = V.zipWith PTuple2
                (toVectordPR pdatas1)
                (toVectordPR pdatas2)


-- PD Functions ---------------------------------------------------------------
-- These work on PData arrays of tuples, but don't need a PA or PR dictionary

-- | O(1). Zip a pair of arrays into an array of pairs.
zipPD   :: PData a -> PData b -> PData (a, b)
zipPD   = PTuple2
{-# INLINE_PA zipPD #-}


-- | Lifted zip.
ziplPR   :: (PR a, PR b) => PData (PArray a) -> PData (PArray b) -> PData (PArray (a, b))
ziplPR arr1 arr2
 = let  -- We need to flatten the data here because we can't guarantee
        -- that the vsegds of both arrays have the same form.
        -- One of the arrays may have been created with replicate, and 
        -- thus has internal sharing, while the other does not.
        (segd1, pdata1) = flattenPR arr1
        (_,     pdata2) = flattenPR arr2
        vsegd'          = U.promoteSegdToVSegd segd1

   in   PNested vsegd'
                (PTuple2s (singletondPR pdata1) (singletondPR pdata2))
                segd1
                (PTuple2  pdata1 pdata2)

{-# INLINE_PA ziplPR #-}


-- | O(1). Unzip an array of pairs into a pair of arrays.
unzipPD :: PData (a, b) -> (PData a, PData b)
unzipPD (PTuple2 xs ys) = (xs, ys)
{-# INLINE_PA unzipPD #-}


-- | Lifted unzip.
unziplPD  :: PData (PArray (a, b)) -> PData (PArray a, PArray b)
unziplPD (PNested vsegd (PTuple2s xsdata ysdata) segd (PTuple2 xflat yflat))
 =      PTuple2 (PNested vsegd xsdata segd xflat)
                (PNested vsegd ysdata segd yflat)
{-# INLINE_PA unziplPD #-}


-- Show -----------------------------------------------------------------------
deriving instance (Show (PData  a), Show (PData  b)) => Show (PData  (a, b))
deriving instance (Show (PDatas a), Show (PDatas b)) => Show (PDatas (a, b))


instance ( PR a, PR b, Show a, Show b
         , PprVirtual (PData a), PprVirtual (PData b))
        => PprVirtual (PData (a, b)) where
 pprv   (PTuple2 xs ys)
        = text $ show 
        $ P.zip (V.toList $ toVectorPR xs) 
                (V.toList $ toVectorPR ys)