{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
module Feldspar.Data.Array
( Nest (nestNumSegs, nestSegLength)
, nest
, nestEvery
, unnest
, Dim, Dim1, Dim2, Dim3, Dim4
, InnerExtent (..)
, listExtent
, MultiNest
, multiNest
, InnerExtent' (..)
, listExtent'
, tailExtent'
, convInnerExtent
, Finite2 (..)
, numRows
, numCols
) where
import Prelude (Functor, Foldable, Traversable, error, product, reverse)
import Feldspar.Run
data Nest a = Nest
{ Nest a -> Data Length
nestNumSegs :: Data Length
, Nest a -> Data Length
nestSegLength :: Data Length
, Nest a -> a
_nestInner :: a
}
deriving (a -> Nest b -> Nest a
(a -> b) -> Nest a -> Nest b
(forall a b. (a -> b) -> Nest a -> Nest b)
-> (forall a b. a -> Nest b -> Nest a) -> Functor Nest
forall a b. a -> Nest b -> Nest a
forall a b. (a -> b) -> Nest a -> Nest b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Nest b -> Nest a
$c<$ :: forall a b. a -> Nest b -> Nest a
fmap :: (a -> b) -> Nest a -> Nest b
$cfmap :: forall a b. (a -> b) -> Nest a -> Nest b
Functor, Nest a -> Bool
(a -> m) -> Nest a -> m
(a -> b -> b) -> b -> Nest a -> b
(forall m. Monoid m => Nest m -> m)
-> (forall m a. Monoid m => (a -> m) -> Nest a -> m)
-> (forall m a. Monoid m => (a -> m) -> Nest a -> m)
-> (forall a b. (a -> b -> b) -> b -> Nest a -> b)
-> (forall a b. (a -> b -> b) -> b -> Nest a -> b)
-> (forall b a. (b -> a -> b) -> b -> Nest a -> b)
-> (forall b a. (b -> a -> b) -> b -> Nest a -> b)
-> (forall a. (a -> a -> a) -> Nest a -> a)
-> (forall a. (a -> a -> a) -> Nest a -> a)
-> (forall a. Nest a -> [a])
-> (forall a. Nest a -> Bool)
-> (forall a. Nest a -> Int)
-> (forall a. Eq a => a -> Nest a -> Bool)
-> (forall a. Ord a => Nest a -> a)
-> (forall a. Ord a => Nest a -> a)
-> (forall a. Num a => Nest a -> a)
-> (forall a. Num a => Nest a -> a)
-> Foldable Nest
forall a. Eq a => a -> Nest a -> Bool
forall a. Num a => Nest a -> a
forall a. Ord a => Nest a -> a
forall m. Monoid m => Nest m -> m
forall a. Nest a -> Bool
forall a. Nest a -> Int
forall a. Nest a -> [a]
forall a. (a -> a -> a) -> Nest a -> a
forall m a. Monoid m => (a -> m) -> Nest a -> m
forall b a. (b -> a -> b) -> b -> Nest a -> b
forall a b. (a -> b -> b) -> b -> Nest a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Nest a -> a
$cproduct :: forall a. Num a => Nest a -> a
sum :: Nest a -> a
$csum :: forall a. Num a => Nest a -> a
minimum :: Nest a -> a
$cminimum :: forall a. Ord a => Nest a -> a
maximum :: Nest a -> a
$cmaximum :: forall a. Ord a => Nest a -> a
elem :: a -> Nest a -> Bool
$celem :: forall a. Eq a => a -> Nest a -> Bool
length :: Nest a -> Int
$clength :: forall a. Nest a -> Int
null :: Nest a -> Bool
$cnull :: forall a. Nest a -> Bool
toList :: Nest a -> [a]
$ctoList :: forall a. Nest a -> [a]
foldl1 :: (a -> a -> a) -> Nest a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Nest a -> a
foldr1 :: (a -> a -> a) -> Nest a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Nest a -> a
foldl' :: (b -> a -> b) -> b -> Nest a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Nest a -> b
foldl :: (b -> a -> b) -> b -> Nest a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Nest a -> b
foldr' :: (a -> b -> b) -> b -> Nest a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Nest a -> b
foldr :: (a -> b -> b) -> b -> Nest a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Nest a -> b
foldMap' :: (a -> m) -> Nest a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Nest a -> m
foldMap :: (a -> m) -> Nest a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Nest a -> m
fold :: Nest m -> m
$cfold :: forall m. Monoid m => Nest m -> m
Foldable, Functor Nest
Foldable Nest
Functor Nest
-> Foldable Nest
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Nest a -> f (Nest b))
-> (forall (f :: * -> *) a.
Applicative f =>
Nest (f a) -> f (Nest a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Nest a -> m (Nest b))
-> (forall (m :: * -> *) a. Monad m => Nest (m a) -> m (Nest a))
-> Traversable Nest
(a -> f b) -> Nest a -> f (Nest b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Nest (m a) -> m (Nest a)
forall (f :: * -> *) a. Applicative f => Nest (f a) -> f (Nest a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Nest a -> m (Nest b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Nest a -> f (Nest b)
sequence :: Nest (m a) -> m (Nest a)
$csequence :: forall (m :: * -> *) a. Monad m => Nest (m a) -> m (Nest a)
mapM :: (a -> m b) -> Nest a -> m (Nest b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Nest a -> m (Nest b)
sequenceA :: Nest (f a) -> f (Nest a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Nest (f a) -> f (Nest a)
traverse :: (a -> f b) -> Nest a -> f (Nest b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Nest a -> f (Nest b)
$cp2Traversable :: Foldable Nest
$cp1Traversable :: Functor Nest
Traversable)
instance Slicable a => Indexed (Nest a)
where
type IndexedElem (Nest a) = a
Nest Data Length
l Data Length
w a
a ! :: Nest a -> Data Length -> IndexedElem (Nest a)
! Data Length
i = Data Length -> Data Length -> a -> a
forall a. Slicable a => Data Length -> Data Length -> a -> a
slice (Data Length
wData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
i') Data Length
w a
a
where
i' :: Data Length
i' = AssertionLabel -> Data Bool -> String -> Data Length -> Data Length
forall a.
Syntax a =>
AssertionLabel -> Data Bool -> String -> a -> a
guardValLabel AssertionLabel
InternalAssertion (Data Length
iData Length -> Data Length -> Data Bool
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data Bool
<Data Length
l) String
"invalid Nest slice" Data Length
i
instance Finite (Nest a)
where
length :: Nest a -> Data Length
length (Nest Data Length
l Data Length
_ a
_) = Data Length
l
instance Slicable a => Slicable (Nest a)
where
slice :: Data Length -> Data Length -> Nest a -> Nest a
slice Data Length
from Data Length
n (Nest Data Length
l Data Length
w a
a) = Data Length -> Data Length -> a -> Nest a
forall a. Data Length -> Data Length -> a -> Nest a
Nest Data Length
n' Data Length
w (a -> Nest a) -> a -> Nest a
forall a b. (a -> b) -> a -> b
$ Data Length -> Data Length -> a -> a
forall a. Slicable a => Data Length -> Data Length -> a -> a
slice (Data Length
from'Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
w) (Data Length
n'Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
w) a
a
where
guard :: Data Length -> Data Length
guard = AssertionLabel -> Data Bool -> String -> Data Length -> Data Length
forall a.
Syntax a =>
AssertionLabel -> Data Bool -> String -> a -> a
guardValLabel AssertionLabel
InternalAssertion (Data Length
fromData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
+Data Length
nData Length -> Data Length -> Data Bool
forall a. (Ord a, PrimType a) => Data a -> Data a -> Data Bool
<=Data Length
l) String
"invalid Nest slice"
from' :: Data Length
from' = Data Length -> Data Length
guard Data Length
from
n' :: Data Length
n' = Data Length -> Data Length
guard Data Length
n
instance MarshalFeld a => MarshalFeld (Nest a)
where
type HaskellRep (Nest a) = (Length, Length, HaskellRep a)
fwrite :: Handle -> Nest a -> Run ()
fwrite Handle
hdl (Nest Data Length
h Data Length
w a
a) = Handle -> (Data Length, Data Length, a) -> Run ()
forall a. MarshalFeld a => Handle -> a -> Run ()
fwrite Handle
hdl (Data Length
h,Data Length
w,a
a)
fread :: Handle -> Run (Nest a)
fread Handle
hdl = do
(Data Length
h,Data Length
w,a
a) <- Handle -> Run (Data Length, Data Length, a)
forall a. MarshalFeld a => Handle -> Run a
fread Handle
hdl
Nest a -> Run (Nest a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Nest a -> Run (Nest a)) -> Nest a -> Run (Nest a)
forall a b. (a -> b) -> a -> b
$ Data Length -> Data Length -> a -> Nest a
forall a. Data Length -> Data Length -> a -> Nest a
Nest Data Length
h Data Length
w a
a
nest :: Finite a
=> Data Length
-> Data Length
-> a
-> Nest a
nest :: Data Length -> Data Length -> a -> Nest a
nest Data Length
l Data Length
w a
a = Data Length -> Data Length -> a -> Nest a
forall a. Data Length -> Data Length -> a -> Nest a
Nest (Data Length -> Data Length
guard Data Length
l) (Data Length -> Data Length
guard Data Length
w) a
a
where
guard :: Data Length -> Data Length
guard = AssertionLabel -> Data Bool -> String -> Data Length -> Data Length
forall a.
Syntax a =>
AssertionLabel -> Data Bool -> String -> a -> a
guardValLabel
AssertionLabel
InternalAssertion
(Data Length
lData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
w Data Length -> Data Length -> Data Bool
forall a. PrimType a => Data a -> Data a -> Data Bool
== a -> Data Length
forall a. Finite a => a -> Data Length
length a
a)
String
"nest: unbalanced nesting"
nestEvery :: Finite a
=> Data Length
-> a
-> Nest a
nestEvery :: Data Length -> a -> Nest a
nestEvery Data Length
n a
a = Data Length -> Data Length -> a -> Nest a
forall a. Data Length -> Data Length -> a -> Nest a
Nest (a -> Data Length
forall a. Finite a => a -> Data Length
length a
a Data Length -> Data Length -> Data Length
forall a. (Integral a, PrimType a) => Data a -> Data a -> Data a
`unsafeBalancedDiv` Data Length
n) Data Length
n a
a
unnest :: Slicable a => Nest a -> a
unnest :: Nest a -> a
unnest (Nest Data Length
l Data Length
w a
a) = Data Length -> Data Length -> a -> a
forall a. Slicable a => Data Length -> Data Length -> a -> a
slice Data Length
0 (Data Length
lData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
w) a
a
data Dim d
type Dim1 = Dim ()
type Dim2 = Dim Dim1
type Dim3 = Dim Dim2
type Dim4 = Dim Dim3
data InnerExtent d
where
NoExt :: InnerExtent ()
Outer :: InnerExtent (Dim ())
(:>) :: InnerExtent (Dim d) -> Data Length -> InnerExtent (Dim (Dim d))
infixl 5 :>
listExtent :: InnerExtent d -> [Data Length]
listExtent :: InnerExtent d -> [Data Length]
listExtent = [Data Length] -> [Data Length]
forall a. [a] -> [a]
reverse ([Data Length] -> [Data Length])
-> (InnerExtent d -> [Data Length])
-> InnerExtent d
-> [Data Length]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InnerExtent d -> [Data Length]
forall d. InnerExtent d -> [Data Length]
go
where
go :: InnerExtent d -> [Data Length]
go :: InnerExtent d -> [Data Length]
go InnerExtent d
NoExt = []
go InnerExtent d
Outer = []
go (InnerExtent (Dim d)
e :> Data Length
l) = Data Length
l Data Length -> [Data Length] -> [Data Length]
forall a. a -> [a] -> [a]
: InnerExtent (Dim d) -> [Data Length]
forall d. InnerExtent d -> [Data Length]
go InnerExtent (Dim d)
e
type family MultiNest d a
where
MultiNest (Dim ()) a = a
MultiNest (Dim (Dim d)) a = Nest (MultiNest (Dim d) a)
multiNest :: forall a d . Finite a =>
InnerExtent (Dim d) -> a -> MultiNest (Dim d) a
multiNest :: InnerExtent (Dim d) -> a -> MultiNest (Dim d) a
multiNest InnerExtent (Dim d)
e a
a = InnerExtent (Dim d) -> [Data Length] -> MultiNest (Dim d) a
forall d'.
InnerExtent (Dim d') -> [Data Length] -> MultiNest (Dim d') a
go InnerExtent (Dim d)
e [Data Length]
lsAll
where
lsInner :: [Data Length]
lsInner = InnerExtent (Dim d) -> [Data Length]
forall d. InnerExtent d -> [Data Length]
listExtent InnerExtent (Dim d)
e
lsAll :: [Data Length]
lsAll = Data Length -> Data Length -> Data Length
forall a. (Integral a, PrimType a) => Data a -> Data a -> Data a
unsafeBalancedDiv (a -> Data Length
forall a. Finite a => a -> Data Length
length a
a) ([Data Length] -> Data Length
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Data Length]
lsInner) Data Length -> [Data Length] -> [Data Length]
forall a. a -> [a] -> [a]
: [Data Length]
lsInner
go :: InnerExtent (Dim d') -> [Data Length] -> MultiNest (Dim d') a
go :: InnerExtent (Dim d') -> [Data Length] -> MultiNest (Dim d') a
go InnerExtent (Dim d')
Outer [Data Length]
_ = a
MultiNest (Dim d') a
a
go (InnerExtent (Dim d)
e :> Data Length
_) (Data Length
l1:Data Length
l2:[Data Length]
ls) = Data Length
-> Data Length -> MultiNest (Dim d) a -> Nest (MultiNest (Dim d) a)
forall a. Data Length -> Data Length -> a -> Nest a
Nest Data Length
l1 Data Length
l2 (MultiNest (Dim d) a -> Nest (MultiNest (Dim d) a))
-> MultiNest (Dim d) a -> Nest (MultiNest (Dim d) a)
forall a b. (a -> b) -> a -> b
$ InnerExtent (Dim d) -> [Data Length] -> MultiNest (Dim d) a
forall d'.
InnerExtent (Dim d') -> [Data Length] -> MultiNest (Dim d') a
go InnerExtent (Dim d)
e (Data Length
l1Data Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
l2 Data Length -> [Data Length] -> [Data Length]
forall a. a -> [a] -> [a]
: [Data Length]
ls)
go (InnerExtent (Dim d)
e :> Data Length
_) [Data Length]
_ = String -> Nest (MultiNest (Dim d) a)
forall a. HasCallStack => String -> a
error String
"impossible"
data InnerExtent' d
where
ZE :: InnerExtent' ()
OE :: InnerExtent' (Dim ())
SE :: Data Length -> InnerExtent' d -> InnerExtent' (Dim d)
listExtent' :: InnerExtent' d -> [Data Length]
listExtent' :: InnerExtent' d -> [Data Length]
listExtent' InnerExtent' d
ZE = []
listExtent' InnerExtent' d
OE = []
listExtent' (SE Data Length
l InnerExtent' d
e) = Data Length
l Data Length -> [Data Length] -> [Data Length]
forall a. a -> [a] -> [a]
: InnerExtent' d -> [Data Length]
forall d. InnerExtent' d -> [Data Length]
listExtent' InnerExtent' d
e
tailExtent' :: InnerExtent' (Dim d) -> InnerExtent' d
tailExtent' :: InnerExtent' (Dim d) -> InnerExtent' d
tailExtent' InnerExtent' (Dim d)
OE = InnerExtent' d
InnerExtent' ()
ZE
tailExtent' (SE Data Length
_ InnerExtent' d
ls) = InnerExtent' d
InnerExtent' d
ls
convInnerExtent :: InnerExtent d -> InnerExtent' d
convInnerExtent :: InnerExtent d -> InnerExtent' d
convInnerExtent InnerExtent d
e = InnerExtent d -> [Data Length] -> InnerExtent' d
forall d. InnerExtent d -> [Data Length] -> InnerExtent' d
go InnerExtent d
e (InnerExtent d -> [Data Length]
forall d. InnerExtent d -> [Data Length]
listExtent InnerExtent d
e)
where
go :: InnerExtent d -> [Data Length] -> InnerExtent' d
go :: InnerExtent d -> [Data Length] -> InnerExtent' d
go InnerExtent d
NoExt [Data Length]
_ = InnerExtent' d
InnerExtent' ()
ZE
go InnerExtent d
Outer [Data Length]
_ = InnerExtent' d
InnerExtent' (Dim ())
OE
go (InnerExtent (Dim d)
e :> Data Length
_) (Data Length
l:[Data Length]
ls) = Data Length -> InnerExtent' (Dim d) -> InnerExtent' (Dim (Dim d))
forall d. Data Length -> InnerExtent' d -> InnerExtent' (Dim d)
SE Data Length
l (InnerExtent' (Dim d) -> InnerExtent' (Dim (Dim d)))
-> InnerExtent' (Dim d) -> InnerExtent' (Dim (Dim d))
forall a b. (a -> b) -> a -> b
$ InnerExtent (Dim d) -> [Data Length] -> InnerExtent' (Dim d)
forall d. InnerExtent d -> [Data Length] -> InnerExtent' d
go InnerExtent (Dim d)
e [Data Length]
ls
go (InnerExtent (Dim d)
_ :> Data Length
_) [Data Length]
_ = String -> InnerExtent' d
forall a. HasCallStack => String -> a
error String
"convInnerExtent: impossible"
class Finite2 a
where
extent2
:: a
-> (Data Length, Data Length)
numRows :: Finite2 a => a -> Data Length
numRows :: a -> Data Length
numRows = (Data Length, Data Length) -> Data Length
forall a b. (a, b) -> a
fst ((Data Length, Data Length) -> Data Length)
-> (a -> (Data Length, Data Length)) -> a -> Data Length
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2
numCols :: Finite2 a => a -> Data Length
numCols :: a -> Data Length
numCols = (Data Length, Data Length) -> Data Length
forall a b. (a, b) -> b
snd ((Data Length, Data Length) -> Data Length)
-> (a -> (Data Length, Data Length)) -> a -> Data Length
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2
instance Finite2 (Nest a)
where
extent2 :: Nest a -> (Data Length, Data Length)
extent2 Nest a
n = (Nest a -> Data Length
forall a. Nest a -> Data Length
nestNumSegs Nest a
n, Nest a -> Data Length
forall a. Nest a -> Data Length
nestSegLength Nest a
n)