module Data.Array.Repa.Repr.Undefined
        ( X, Array (..))
where
import Data.Array.Repa.Base
import Data.Array.Repa.Shape
import Data.Array.Repa.Eval


-- | An array with undefined elements.
-- 
--   * This is normally used as the last representation in a partitioned array, 
--     as the previous partitions are expected to provide full coverage.
data X


-- | Undefined array elements. Inspecting them yields `error`.
--
instance Source X e where
 data Array X sh e
        = AUndefined !sh

 deepSeqArray :: Array X sh e -> b -> b
deepSeqArray Array X sh e
_ b
x
        = b
x
 {-# INLINE deepSeqArray #-}

 extent :: Array X sh e -> sh
extent (AUndefined sh) 
        = sh
sh
 {-# INLINE extent #-}

 index :: Array X sh e -> sh -> e
index (AUndefined _) sh
_ 
        = [Char] -> e
forall a. HasCallStack => [Char] -> a
error ([Char] -> e) -> [Char] -> e
forall a b. (a -> b) -> a -> b
$ [Char]
"Repa: array element is undefined."
 {-# INLINE index #-}
        
 linearIndex :: Array X sh e -> Int -> e
linearIndex (AUndefined _) Int
ix
        = [Char] -> e
forall a. HasCallStack => [Char] -> a
error ([Char] -> e) -> [Char] -> e
forall a b. (a -> b) -> a -> b
$ [Char]
"Repa: array element at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is undefined."
 {-# INLINE linearIndex #-}


deriving instance Show sh 
        => Show (Array X sh e)

deriving instance Read sh 
        => Read (Array X sh e)


instance Shape sh => Load X sh e where
 loadS :: Array X sh e -> MVec r2 e -> IO ()
loadS Array X sh e
_ MVec r2 e
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 loadP :: Array X sh e -> MVec r2 e -> IO ()
loadP Array X sh e
_ MVec r2 e
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()