module Data.Repa.Scalar.Box
        ( Box           (..)
        , box, unbox)
where
import qualified Data.Vector                    as V
import qualified Data.Vector.Unboxed            as U
import qualified Data.Vector.Generic            as G
import qualified Data.Vector.Generic.Mutable    as GM



-- | Strict, boxed wrapper for a value.
--
--   Useful as a default case when defining instances for polytypic 
--   data types.
newtype Box a
        = Box a
        deriving (Box a -> Box a -> Bool
(Box a -> Box a -> Bool) -> (Box a -> Box a -> Bool) -> Eq (Box a)
forall a. Eq a => Box a -> Box a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Box a -> Box a -> Bool
== :: Box a -> Box a -> Bool
$c/= :: forall a. Eq a => Box a -> Box a -> Bool
/= :: Box a -> Box a -> Bool
Eq, Int -> Box a -> ShowS
[Box a] -> ShowS
Box a -> String
(Int -> Box a -> ShowS)
-> (Box a -> String) -> ([Box a] -> ShowS) -> Show (Box a)
forall a. Show a => Int -> Box a -> ShowS
forall a. Show a => [Box a] -> ShowS
forall a. Show a => Box a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Box a -> ShowS
showsPrec :: Int -> Box a -> ShowS
$cshow :: forall a. Show a => Box a -> String
show :: Box a -> String
$cshowList :: forall a. Show a => [Box a] -> ShowS
showList :: [Box a] -> ShowS
Show)


-- | Put a value in a box.
box   :: a -> Box a
box :: forall a. a -> Box a
box !a
x = a -> Box a
forall a. a -> Box a
Box a
x
{-# INLINE box #-}


-- | Take the value from the box.
unbox :: Box a -> a
unbox :: forall a. Box a -> a
unbox (Box a
x) = a
x
{-# INLINE unbox #-}


instance Functor Box where
 fmap :: forall a b. (a -> b) -> Box a -> Box b
fmap a -> b
f (Box a
x) = b -> Box b
forall a. a -> Box a
Box (a -> b
f a
x)
 {-# INLINE fmap #-}


-- Unboxed ----------------------------------------------------------------------------------------
-- Unboxed instance adapted from:
-- http://code.haskell.org/vector/internal/unbox-tuple-instances
--
data instance U.Vector (Box a)
  = V_Box
        {-# UNPACK #-} !Int 
        !(V.Vector a)


data instance U.MVector s (Box a)
  = MV_Box
        {-# UNPACK #-} !Int 
        !(V.MVector s a)


instance GM.MVector U.MVector (Box a) where

  basicLength :: forall s. MVector s (Box a) -> Int
basicLength (MV_Box Int
n MVector s a
_as) = Int
n
  {-# INLINE basicLength  #-}

  basicUnsafeSlice :: forall s. Int -> Int -> MVector s (Box a) -> MVector s (Box a)
basicUnsafeSlice Int
i Int
m (MV_Box Int
_n MVector s a
as)
   =  Int -> MVector s a -> MVector s (Box a)
forall s a. Int -> MVector s a -> MVector s (Box a)
MV_Box Int
m (Int -> Int -> MVector s a -> MVector s a
forall s. Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GM.basicUnsafeSlice Int
i Int
m MVector s a
as)
  {-# INLINE basicUnsafeSlice  #-}

  basicOverlaps :: forall s. MVector s (Box a) -> MVector s (Box a) -> Bool
basicOverlaps (MV_Box Int
_n1 MVector s a
as1) (MV_Box Int
_n2 MVector s a
as2)
   =  MVector s a -> MVector s a -> Bool
forall s. MVector s a -> MVector s a -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
GM.basicOverlaps MVector s a
as1 MVector s a
as2
  {-# INLINE basicOverlaps  #-}

  basicUnsafeNew :: forall s. Int -> ST s (MVector s (Box a))
basicUnsafeNew Int
n
   = do MVector s a
as <- Int -> ST s (MVector s a)
forall s. Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
GM.basicUnsafeNew Int
n
        MVector s (Box a) -> ST s (MVector s (Box a))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector s (Box a) -> ST s (MVector s (Box a)))
-> MVector s (Box a) -> ST s (MVector s (Box a))
forall a b. (a -> b) -> a -> b
$ Int -> MVector s a -> MVector s (Box a)
forall s a. Int -> MVector s a -> MVector s (Box a)
MV_Box Int
n MVector s a
as
  {-# INLINE basicUnsafeNew  #-}

  basicInitialize :: forall s. MVector s (Box a) -> ST s ()
basicInitialize (MV_Box Int
_n MVector s a
as)
   = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicInitialize MVector s a
as
  {-# INLINE basicInitialize  #-}

  basicUnsafeReplicate :: forall s. Int -> Box a -> ST s (MVector s (Box a))
basicUnsafeReplicate Int
n (Box a
a)
   = do MVector s a
as <- Int -> a -> ST s (MVector s a)
forall s. Int -> a -> ST s (MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
GM.basicUnsafeReplicate Int
n a
a
        MVector s (Box a) -> ST s (MVector s (Box a))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector s (Box a) -> ST s (MVector s (Box a)))
-> MVector s (Box a) -> ST s (MVector s (Box a))
forall a b. (a -> b) -> a -> b
$ Int -> MVector s a -> MVector s (Box a)
forall s a. Int -> MVector s a -> MVector s (Box a)
MV_Box Int
n MVector s a
as
  {-# INLINE basicUnsafeReplicate  #-}

  basicUnsafeRead :: forall s. MVector s (Box a) -> Int -> ST s (Box a)
basicUnsafeRead (MV_Box Int
_n MVector s a
as) Int
i
   = do a
v  <- MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GM.basicUnsafeRead MVector s a
as Int
i
        Box a -> ST s (Box a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Box a -> ST s (Box a)) -> Box a -> ST s (Box a)
forall a b. (a -> b) -> a -> b
$ a -> Box a
forall a. a -> Box a
Box a
v
  {-# INLINE basicUnsafeRead  #-}

  basicUnsafeWrite :: forall s. MVector s (Box a) -> Int -> Box a -> ST s ()
basicUnsafeWrite (MV_Box Int
_n MVector s a
as) Int
i (Box a
a)
   = a
a a -> ST s () -> ST s ()
forall a b. a -> b -> b
`seq` MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GM.basicUnsafeWrite MVector s a
as Int
i a
a
  {-# INLINE basicUnsafeWrite  #-}

  basicClear :: forall s. MVector s (Box a) -> ST s ()
basicClear (MV_Box Int
_n MVector s a
as)
   =    MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicClear MVector s a
as
  {-# INLINE basicClear  #-}

  basicSet :: forall s. MVector s (Box a) -> Box a -> ST s ()
basicSet   (MV_Box Int
_n MVector s a
as) (Box a
a)
   =    MVector s a -> a -> ST s ()
forall s. MVector s a -> a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
GM.basicSet MVector s a
as a
a
  {-# INLINE basicSet  #-}

  basicUnsafeCopy :: forall s. MVector s (Box a) -> MVector s (Box a) -> ST s ()
basicUnsafeCopy (MV_Box Int
_n1 MVector s a
as1) (MV_Box  Int
_n2 MVector s a
as2)
   =    MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeCopy MVector s a
as1 MVector s a
as2
  {-# INLINE basicUnsafeCopy  #-}

  basicUnsafeMove :: forall s. MVector s (Box a) -> MVector s (Box a) -> ST s ()
basicUnsafeMove (MV_Box Int
_n1 MVector s a
as1) (MV_Box Int
_n2 MVector s a
as2)
   =    MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeMove MVector s a
as1 MVector s a
as2
  {-# INLINE basicUnsafeMove  #-}

  basicUnsafeGrow :: forall s. MVector s (Box a) -> Int -> ST s (MVector s (Box a))
basicUnsafeGrow (MV_Box Int
n MVector s a
as) Int
m
   = do MVector s a
as' <- MVector s a -> Int -> ST s (MVector s a)
forall s. MVector s a -> Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
GM.basicUnsafeGrow MVector s a
as Int
m
        MVector s (Box a) -> ST s (MVector s (Box a))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector s (Box a) -> ST s (MVector s (Box a)))
-> MVector s (Box a) -> ST s (MVector s (Box a))
forall a b. (a -> b) -> a -> b
$ Int -> MVector s a -> MVector s (Box a)
forall s a. Int -> MVector s a -> MVector s (Box a)
MV_Box (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) MVector s a
as'
  {-# INLINE basicUnsafeGrow  #-}


instance G.Vector U.Vector (Box a) where

  basicUnsafeFreeze :: forall s. Mutable Vector s (Box a) -> ST s (Vector (Box a))
basicUnsafeFreeze (MV_Box Int
n MVector s a
as)
   = do Vector a
as' <- Mutable Vector s a -> ST s (Vector a)
forall s. Mutable Vector s a -> ST s (Vector a)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze MVector s a
Mutable Vector s a
as
        Vector (Box a) -> ST s (Vector (Box a))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector (Box a) -> ST s (Vector (Box a)))
-> Vector (Box a) -> ST s (Vector (Box a))
forall a b. (a -> b) -> a -> b
$ Int -> Vector a -> Vector (Box a)
forall a. Int -> Vector a -> Vector (Box a)
V_Box Int
n Vector a
as'
  {-# INLINE basicUnsafeFreeze  #-}

  basicUnsafeThaw :: forall s. Vector (Box a) -> ST s (Mutable Vector s (Box a))
basicUnsafeThaw (V_Box Int
n Vector a
as)
   = do MVector s a
as' <- Vector a -> ST s (Mutable Vector s a)
forall s. Vector a -> ST s (Mutable Vector s a)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector a
as
        MVector s (Box a) -> ST s (MVector s (Box a))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector s (Box a) -> ST s (MVector s (Box a)))
-> MVector s (Box a) -> ST s (MVector s (Box a))
forall a b. (a -> b) -> a -> b
$ Int -> MVector s a -> MVector s (Box a)
forall s a. Int -> MVector s a -> MVector s (Box a)
MV_Box Int
n MVector s a
as'
  {-# INLINE basicUnsafeThaw  #-}

  basicLength :: Vector (Box a) -> Int
basicLength (V_Box Int
n Vector a
_as) 
   = Int
n
  {-# INLINE basicLength  #-}

  basicUnsafeSlice :: Int -> Int -> Vector (Box a) -> Vector (Box a)
basicUnsafeSlice Int
i Int
m (V_Box Int
_n Vector a
as)
   = Int -> Vector a -> Vector (Box a)
forall a. Int -> Vector a -> Vector (Box a)
V_Box Int
m (Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i Int
m Vector a
as)
  {-# INLINE basicUnsafeSlice  #-}

  basicUnsafeIndexM :: Vector (Box a) -> Int -> Box (Box a)
basicUnsafeIndexM (V_Box Int
_n Vector a
as) Int
i
   = do a
a <- Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
as Int
i
        Box a -> Box (Box a)
forall a. a -> Box a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Box a
forall a. a -> Box a
Box a
a)
  {-# INLINE basicUnsafeIndexM  #-}

  basicUnsafeCopy :: forall s. Mutable Vector s (Box a) -> Vector (Box a) -> ST s ()
basicUnsafeCopy (MV_Box Int
_n1 MVector s a
as1) (V_Box Int
_n2 Vector a
as2)
   =    Mutable Vector s a -> Vector a -> ST s ()
forall s. Mutable Vector s a -> Vector a -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy MVector s a
Mutable Vector s a
as1 Vector a
as2
  {-# INLINE basicUnsafeCopy  #-}

  elemseq :: forall b. Vector (Box a) -> Box a -> b -> b
elemseq Vector (Box a)
_ (Box a
a)
      = Vector a -> a -> b -> b
forall b. Vector a -> a -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (Vector a
forall a. HasCallStack => a
undefined :: V.Vector a) a
a
  {-# INLINE elemseq  #-}