{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE DefaultSignatures    #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.Sugar.Array
-- Copyright   : [2008..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Sugar.Array
  where

import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Sugar.Shape
import Data.Array.Accelerate.Representation.Type
import qualified Data.Array.Accelerate.Representation.Array         as R

import Control.DeepSeq
import Data.Kind
import Data.Typeable
import Language.Haskell.TH                                          hiding ( Type )
import Language.Haskell.TH.Extra
import System.IO.Unsafe

import GHC.Exts                                                     ( IsList )
import GHC.Generics
import qualified GHC.Exts                                           as GHC

-- $setup
-- >>> :seti -XOverloadedLists


type Scalar = Array DIM0    -- ^ Scalar arrays hold a single element
type Vector = Array DIM1    -- ^ Vectors are one-dimensional arrays
type Matrix = Array DIM2    -- ^ Matrices are two-dimensional arrays

-- | Segment descriptor (vector of segment lengths)
--
-- To represent nested one-dimensional arrays, we use a flat array of data
-- values in conjunction with a /segment descriptor/, which stores the
-- lengths of the sub-arrays.
--
type Segments = Vector


-- | Dense, regular, multi-dimensional arrays.
--
-- The 'Array' is the core computational unit of Accelerate; all programs
-- in Accelerate take zero or more arrays as input and produce one or more
-- arrays as output. The 'Array' type has two type parameters:
--
--  * /sh/: is the shape of the array, tracking the dimensionality and extent of
--    each dimension of the array; for example, 'DIM1' for one-dimensional
--    'Vector's, 'DIM2' for two-dimensional matrices, and so on.
--
--  * /e/: represents the type of each element of the array; for example,
--    'Int', 'Float', et cetera.
--
-- Array data is store unboxed in an unzipped struct-of-array representation.
-- Elements are laid out in row-major order (the right-most index of a 'Shape'
-- is the fastest varying). The allowable array element types are members of the
-- 'Elt' class, which roughly consists of:
--
--  * Signed and unsigned integers (8, 16, 32, and 64-bits wide).
--  * Floating point numbers (single and double precision)
--  * 'Char'
--  * 'Bool'
--  * ()
--  * Shapes formed from 'Z' and (':.')
--  * Nested tuples of all of these, currently up to 16-elements wide.
--
-- Note that 'Array' itself is not an allowable element type---there are no
-- nested arrays in Accelerate, regular arrays only!
--
-- If device and host memory are separate, arrays will be transferred to the
-- device when necessary (possibly asynchronously and in parallel with other
-- tasks) and cached on the device if sufficient memory is available. Arrays are
-- made available to embedded language computations via
-- 'Data.Array.Accelerate.use'.
--
-- Section "Getting data in" lists functions for getting data into and out of
-- the 'Array' type.
--
newtype Array sh e = Array (R.Array (EltR sh) (EltR e))
  deriving Typeable

instance (Shape sh, Elt e, Eq sh, Eq e) => Eq (Array sh e) where
  Array sh e
arr1 == :: Array sh e -> Array sh e -> Bool
== Array sh e
arr2 = Array sh e -> sh
forall sh e. Shape sh => Array sh e -> sh
shape Array sh e
arr1 sh -> sh -> Bool
forall a. Eq a => a -> a -> Bool
== Array sh e -> sh
forall sh e. Shape sh => Array sh e -> sh
shape Array sh e
arr2 Bool -> Bool -> Bool
&& Array sh e -> [e]
forall sh e. (Shape sh, Elt e) => Array sh e -> [e]
toList Array sh e
arr1 [e] -> [e] -> Bool
forall a. Eq a => a -> a -> Bool
== Array sh e -> [e]
forall sh e. (Shape sh, Elt e) => Array sh e -> [e]
toList Array sh e
arr2
  Array sh e
arr1 /= :: Array sh e -> Array sh e -> Bool
/= Array sh e
arr2 = Array sh e -> sh
forall sh e. Shape sh => Array sh e -> sh
shape Array sh e
arr1 sh -> sh -> Bool
forall a. Eq a => a -> a -> Bool
/= Array sh e -> sh
forall sh e. Shape sh => Array sh e -> sh
shape Array sh e
arr2 Bool -> Bool -> Bool
|| Array sh e -> [e]
forall sh e. (Shape sh, Elt e) => Array sh e -> [e]
toList Array sh e
arr1 [e] -> [e] -> Bool
forall a. Eq a => a -> a -> Bool
/= Array sh e -> [e]
forall sh e. (Shape sh, Elt e) => Array sh e -> [e]
toList Array sh e
arr2

instance (Shape sh, Elt e, Show e) => Show (Array sh e) where
  show :: Array sh e -> String
show (Array Array (EltR sh) (EltR e)
arr) = (EltR e -> ShowS)
-> ArrayR (Array (EltR sh) (EltR e))
-> Array (EltR sh) (EltR e)
-> String
forall e sh.
(e -> ShowS) -> ArrayR (Array sh e) -> Array sh e -> String
R.showArray (e -> ShowS
forall a. Show a => a -> ShowS
shows (e -> ShowS) -> (EltR e -> e) -> EltR e -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elt e => EltR e -> e
forall a. Elt a => EltR a -> a
toElt @e) ((Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
forall sh e. (Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
arrayR @sh @e) Array (EltR sh) (EltR e)
arr

instance Elt e => IsList (Array DIM1 e) where
  type Item (Vector e) = e
  toList :: Array DIM1 e -> [Item (Array DIM1 e)]
toList      = Array DIM1 e -> [Item (Array DIM1 e)]
forall sh e. (Shape sh, Elt e) => Array sh e -> [e]
toList
  fromListN :: Int -> [Item (Array DIM1 e)] -> Array DIM1 e
fromListN Int
n = DIM1 -> [e] -> Array DIM1 e
forall sh e. (Shape sh, Elt e) => sh -> [e] -> Array sh e
fromList (Z
ZZ -> Int -> DIM1
forall tail head. tail -> head -> tail :. head
:.Int
n)
  fromList :: [Item (Array DIM1 e)] -> Array DIM1 e
fromList [Item (Array DIM1 e)]
xs = Int -> [Item (Array DIM1 e)] -> Array DIM1 e
forall l. IsList l => Int -> [Item l] -> l
GHC.fromListN ([e] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
[Item (Array DIM1 e)]
xs) [Item (Array DIM1 e)]
xs

instance (Shape sh, Elt e) => NFData (Array sh e) where
  rnf :: Array sh e -> ()
rnf (Array Array (EltR sh) (EltR e)
arr) = ArrayR (Array (EltR sh) (EltR e)) -> Array (EltR sh) (EltR e) -> ()
forall a. ArrayR a -> a -> ()
R.rnfArray ((Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
forall sh e. (Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
arrayR @sh @e) Array (EltR sh) (EltR e)
arr

-- Note: [Embedded class constraints on Array]
--
-- Previously, we had embedded 'Shape' and 'Elt' constraints on the 'Array'
-- constructor. This was occasionally convenient, however, this has a negative
-- impact on the kind of code which GHC can generate. For example, if we write
-- the function:
--
-- > (!) :: Array sh e -> sh -> e
--
-- Without the 'Shape' and 'Elt' constraints on the type signature, and instead
-- recover those when pattern matching on 'Array', then GHC is unable to
-- specialise functions past this point. In this example, even if 'sh' and 'e'
-- are fixed, GHC would not be able to inline the definitions from 'ArrayElt'
-- which perform the actual data accesses.
--
--   - TLM 2018-09-13
--

-- | Yield an array's shape
--
shape :: Shape sh => Array sh e -> sh
shape :: Array sh e -> sh
shape (Array Array (EltR sh) (EltR e)
arr) = EltR sh -> sh
forall a. Elt a => EltR a -> a
toElt (Array (EltR sh) (EltR e) -> EltR sh
forall sh e. Array sh e -> sh
R.shape Array (EltR sh) (EltR e)
arr)

-- | Change the shape of an array without altering its contents. The 'size' of
-- the source and result arrays must be identical.
--
reshape :: forall sh sh' e. (Shape sh, Shape sh') => sh -> Array sh' e -> Array sh e
reshape :: sh -> Array sh' e -> Array sh e
reshape sh
sh (Array Array (EltR sh') (EltR e)
arr) = Array (EltR sh) (EltR e) -> Array sh e
forall sh e. Array (EltR sh) (EltR e) -> Array sh e
Array (Array (EltR sh) (EltR e) -> Array sh e)
-> Array (EltR sh) (EltR e) -> Array sh e
forall a b. (a -> b) -> a -> b
$ ShapeR (EltR sh)
-> EltR sh
-> ShapeR (EltR sh')
-> Array (EltR sh') (EltR e)
-> Array (EltR sh) (EltR e)
forall sh sh' e.
HasCallStack =>
ShapeR sh -> sh -> ShapeR sh' -> Array sh' e -> Array sh e
R.reshape (Shape sh => ShapeR (EltR sh)
forall sh. Shape sh => ShapeR (EltR sh)
shapeR @sh) (sh -> EltR sh
forall a. Elt a => a -> EltR a
fromElt sh
sh) (Shape sh' => ShapeR (EltR sh')
forall sh. Shape sh => ShapeR (EltR sh)
shapeR @sh') Array (EltR sh') (EltR e)
arr

-- | Return the value of an array at the given multidimensional index
--
infixl 9 !
(!) :: forall sh e. (Shape sh, Elt e) => Array sh e -> sh -> e
(!) (Array Array (EltR sh) (EltR e)
arr) sh
ix = EltR e -> e
forall a. Elt a => EltR a -> a
toElt (EltR e -> e) -> EltR e -> e
forall a b. (a -> b) -> a -> b
$ ArrayR (Array (EltR sh) (EltR e))
-> Array (EltR sh) (EltR e) -> EltR sh -> EltR e
forall sh e. ArrayR (Array sh e) -> Array sh e -> sh -> e
R.indexArray ((Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
forall sh e. (Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
arrayR @sh @e) Array (EltR sh) (EltR e)
arr (sh -> EltR sh
forall a. Elt a => a -> EltR a
fromElt sh
ix)

-- | Return the value of an array at given the linear (row-major) index
--
infixl 9 !!
(!!) :: forall sh e. Elt e => Array sh e -> Int -> e
!! :: Array sh e -> Int -> e
(!!) (Array Array (EltR sh) (EltR e)
arr) Int
i = EltR e -> e
forall a. Elt a => EltR a -> a
toElt (EltR e -> e) -> EltR e -> e
forall a b. (a -> b) -> a -> b
$ TypeR (EltR e) -> Array (EltR sh) (EltR e) -> Int -> EltR e
forall e sh. TypeR e -> Array sh e -> Int -> e
R.linearIndexArray (Elt e => TypeR (EltR e)
forall a. Elt a => TypeR (EltR a)
eltR @e) Array (EltR sh) (EltR e)
arr Int
i

-- | Create an array from its representation function, applied at each
-- index of the array
--
fromFunction :: (Shape sh, Elt e) => sh -> (sh -> e) -> Array sh e
fromFunction :: sh -> (sh -> e) -> Array sh e
fromFunction sh
sh sh -> e
f = IO (Array sh e) -> Array sh e
forall a. IO a -> a
unsafePerformIO (IO (Array sh e) -> Array sh e) -> IO (Array sh e) -> Array sh e
forall a b. (a -> b) -> a -> b
$! sh -> (sh -> IO e) -> IO (Array sh e)
forall sh e.
(Shape sh, Elt e) =>
sh -> (sh -> IO e) -> IO (Array sh e)
fromFunctionM sh
sh (e -> IO e
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> IO e) -> (sh -> e) -> sh -> IO e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> e
f)

-- | Create an array using a monadic function applied at each index
--
-- @since 1.2.0.0
--
fromFunctionM :: forall sh e. (Shape sh, Elt e) => sh -> (sh -> IO e) -> IO (Array sh e)
fromFunctionM :: sh -> (sh -> IO e) -> IO (Array sh e)
fromFunctionM sh
sh sh -> IO e
f = Array (EltR sh) (EltR e) -> Array sh e
forall sh e. Array (EltR sh) (EltR e) -> Array sh e
Array (Array (EltR sh) (EltR e) -> Array sh e)
-> IO (Array (EltR sh) (EltR e)) -> IO (Array sh e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArrayR (Array (EltR sh) (EltR e))
-> EltR sh
-> (EltR sh -> IO (EltR e))
-> IO (Array (EltR sh) (EltR e))
forall sh e.
ArrayR (Array sh e) -> sh -> (sh -> IO e) -> IO (Array sh e)
R.fromFunctionM ((Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
forall sh e. (Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
arrayR @sh @e) (sh -> EltR sh
forall a. Elt a => a -> EltR a
fromElt sh
sh) EltR sh -> IO (EltR e)
f'
  where
    f' :: EltR sh -> IO (EltR e)
f' EltR sh
x = do
      e
y <- sh -> IO e
f (EltR sh -> sh
forall a. Elt a => EltR a -> a
toElt EltR sh
x)
      EltR e -> IO (EltR e)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> EltR e
forall a. Elt a => a -> EltR a
fromElt e
y)

-- | Create a vector from the concatenation of the given list of vectors
--
concatVectors :: forall e. Elt e => [Vector e] -> Vector e
concatVectors :: [Vector e] -> Vector e
concatVectors = Array ((), Int) (EltR e) -> Vector e
forall a. Arrays a => ArraysR a -> a
toArr (Array ((), Int) (EltR e) -> Vector e)
-> ([Vector e] -> Array ((), Int) (EltR e))
-> [Vector e]
-> Vector e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeR (EltR e)
-> [Array ((), Int) (EltR e)] -> Array ((), Int) (EltR e)
forall e. TypeR e -> [Vector e] -> Vector e
R.concatVectors (Elt e => TypeR (EltR e)
forall a. Elt a => TypeR (EltR a)
eltR @e) ([Array ((), Int) (EltR e)] -> Array ((), Int) (EltR e))
-> ([Vector e] -> [Array ((), Int) (EltR e)])
-> [Vector e]
-> Array ((), Int) (EltR e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector e -> Array ((), Int) (EltR e))
-> [Vector e] -> [Array ((), Int) (EltR e)]
forall a b. (a -> b) -> [a] -> [b]
map Vector e -> Array ((), Int) (EltR e)
forall a. Arrays a => a -> ArraysR a
fromArr

-- | Creates a new, uninitialized Accelerate array
--
allocateArray :: forall sh e. (Shape sh, Elt e) => sh -> IO (Array sh e)
allocateArray :: sh -> IO (Array sh e)
allocateArray sh
sh = Array (EltR sh) (EltR e) -> Array sh e
forall sh e. Array (EltR sh) (EltR e) -> Array sh e
Array (Array (EltR sh) (EltR e) -> Array sh e)
-> IO (Array (EltR sh) (EltR e)) -> IO (Array sh e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArrayR (Array (EltR sh) (EltR e))
-> EltR sh -> IO (Array (EltR sh) (EltR e))
forall sh e. ArrayR (Array sh e) -> sh -> IO (Array sh e)
R.allocateArray ((Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
forall sh e. (Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
arrayR @sh @e) (sh -> EltR sh
forall a. Elt a => a -> EltR a
fromElt sh
sh)

-- | Convert elements of a list into an Accelerate 'Array'
--
-- This will generate a new multidimensional 'Array' of the specified shape and
-- extent by consuming elements from the list and adding them to the array in
-- row-major order.
--
-- >>> fromList (Z:.10) [0..] :: Vector Int
-- Vector (Z :. 10) [0,1,2,3,4,5,6,7,8,9]
--
-- Note that we pull elements off the list lazily, so infinite lists are
-- accepted:
--
-- >>> fromList (Z:.5:.10) (repeat 0) :: Matrix Float
-- Matrix (Z :. 5 :. 10)
--   [ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
--     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
--     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
--     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
--     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
--
-- You can also make use of the @OverloadedLists@ extension to produce
-- one-dimensional vectors from a /finite/ list.
--
-- >>> [0..9] :: Vector Int
-- Vector (Z :. 10) [0,1,2,3,4,5,6,7,8,9]
--
-- Note that this requires first traversing the list to determine its length,
-- and then traversing it a second time to collect the elements into the array,
-- thus forcing the spine of the list to be manifest on the heap.
--
fromList :: forall sh e. (Shape sh, Elt e) => sh -> [e] -> Array sh e
fromList :: sh -> [e] -> Array sh e
fromList sh
sh [e]
xs = ArraysR (Array sh e) -> Array sh e
forall a. Arrays a => ArraysR a -> a
toArr (ArraysR (Array sh e) -> Array sh e)
-> ArraysR (Array sh e) -> Array sh e
forall a b. (a -> b) -> a -> b
$ ArrayR (Array (EltR sh) (EltR e))
-> EltR sh -> [EltR e] -> Array (EltR sh) (EltR e)
forall sh e. ArrayR (Array sh e) -> sh -> [e] -> Array sh e
R.fromList ((Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
forall sh e. (Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
arrayR @sh @e) (sh -> EltR sh
forall a. Elt a => a -> EltR a
fromElt sh
sh) ([EltR e] -> Array (EltR sh) (EltR e))
-> [EltR e] -> Array (EltR sh) (EltR e)
forall a b. (a -> b) -> a -> b
$ (e -> EltR e) -> [e] -> [EltR e]
forall a b. (a -> b) -> [a] -> [b]
map e -> EltR e
forall a. Elt a => a -> EltR a
fromElt [e]
xs

-- | Convert an accelerated 'Array' to a list in row-major order
--
toList :: forall sh e. (Shape sh, Elt e) => Array sh e -> [e]
toList :: Array sh e -> [e]
toList = (EltR e -> e) -> [EltR e] -> [e]
forall a b. (a -> b) -> [a] -> [b]
map EltR e -> e
forall a. Elt a => EltR a -> a
toElt ([EltR e] -> [e]) -> (Array sh e -> [EltR e]) -> Array sh e -> [e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayR (Array (EltR sh) (EltR e))
-> Array (EltR sh) (EltR e) -> [EltR e]
forall sh e. ArrayR (Array sh e) -> Array sh e -> [e]
R.toList ((Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
forall sh e. (Shape sh, Elt e) => ArrayR (Array (EltR sh) (EltR e))
arrayR @sh @e) (Array (EltR sh) (EltR e) -> [EltR e])
-> (Array sh e -> Array (EltR sh) (EltR e))
-> Array sh e
-> [EltR e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array sh e -> Array (EltR sh) (EltR e)
forall a. Arrays a => a -> ArraysR a
fromArr


-- | The 'Arrays' class characterises the types which can appear in collective
-- Accelerate computations of type 'Data.Array.Accelerate.Acc'.
--
-- 'Arrays' consists of nested tuples of individual 'Array's, currently up
-- to 16-elements wide. Accelerate computations can thereby return multiple
-- results.
--
class Arrays a where
  -- | Type representation mapping, which explains how to convert from the
  -- surface type into the internal representation type, which consists
  -- only of 'Array', and '()' and '(,)' as type-level nil and snoc.
  --
  type ArraysR a :: Type
  type ArraysR a = GArraysR () (Rep a)

  arraysR :: R.ArraysR (ArraysR a)
  toArr   :: ArraysR  a -> a
  fromArr :: a -> ArraysR  a

  default arraysR
    :: (GArrays (Rep a), ArraysR a ~ GArraysR () (Rep a))
    => R.ArraysR (ArraysR a)
  arraysR = ArraysR () -> ArraysR (GArraysR () (Rep a))
forall (f :: * -> *) t.
GArrays f =>
ArraysR t -> ArraysR (GArraysR t f)
garrays @(Rep a) ArraysR ()
forall (s :: * -> *). TupR s ()
TupRunit

  default toArr
    :: (Generic a, GArrays (Rep a), ArraysR a ~ GArraysR () (Rep a))
    => ArraysR a -> a
  toArr = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a)
-> (GArraysR () (Rep a) -> Rep a Any) -> GArraysR () (Rep a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), Rep a Any) -> Rep a Any
forall a b. (a, b) -> b
snd (((), Rep a Any) -> Rep a Any)
-> (GArraysR () (Rep a) -> ((), Rep a Any))
-> GArraysR () (Rep a)
-> Rep a Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GArraysR () (Rep a) -> ((), Rep a a)
forall (f :: * -> *) t a. GArrays f => GArraysR t f -> (t, f a)
gtoArr @(Rep a) @()

  default fromArr
    :: (Generic a, GArrays (Rep a), ArraysR a ~ GArraysR () (Rep a))
    => a -> ArraysR a
  fromArr = (Rep a Any -> () -> GArraysR () (Rep a)
forall (f :: * -> *) a t. GArrays f => f a -> t -> GArraysR t f
`gfromArr` ()) (Rep a Any -> GArraysR () (Rep a))
-> (a -> Rep a Any) -> a -> GArraysR () (Rep a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

arrayR :: forall sh e. (Shape sh, Elt e) => R.ArrayR (R.Array (EltR sh) (EltR e))
arrayR :: ArrayR (Array (EltR sh) (EltR e))
arrayR = ShapeR (EltR sh)
-> TypeR (EltR e) -> ArrayR (Array (EltR sh) (EltR e))
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
R.ArrayR (Shape sh => ShapeR (EltR sh)
forall sh. Shape sh => ShapeR (EltR sh)
shapeR @sh) (Elt e => TypeR (EltR e)
forall a. Elt a => TypeR (EltR a)
eltR @e)

class GArrays f where
  type GArraysR t f
  garrays  :: R.ArraysR t -> R.ArraysR (GArraysR t f)
  gfromArr :: f a -> t -> GArraysR t f
  gtoArr   :: GArraysR t f -> (t, f a)

instance GArrays U1 where
  type GArraysR t U1 = t
  garrays :: ArraysR t -> ArraysR (GArraysR t U1)
garrays       =  ArraysR t -> ArraysR (GArraysR t U1)
forall a. a -> a
id
  gfromArr :: U1 a -> t -> GArraysR t U1
gfromArr U1 a
U1   =  t -> GArraysR t U1
forall a. a -> a
id
  gtoArr :: GArraysR t U1 -> (t, U1 a)
gtoArr      GArraysR t U1
t = (t
GArraysR t U1
t, U1 a
forall k (p :: k). U1 p
U1)

instance GArrays a => GArrays (M1 i c a) where
  type GArraysR t (M1 i c a) = GArraysR t a
  garrays :: ArraysR t -> ArraysR (GArraysR t (M1 i c a))
garrays         = forall t. GArrays a => ArraysR t -> ArraysR (GArraysR t a)
forall (f :: * -> *) t.
GArrays f =>
ArraysR t -> ArraysR (GArraysR t f)
garrays @a
  gfromArr :: M1 i c a a -> t -> GArraysR t (M1 i c a)
gfromArr (M1 a a
x) = a a -> t -> GArraysR t a
forall (f :: * -> *) a t. GArrays f => f a -> t -> GArraysR t f
gfromArr a a
x
  gtoArr :: GArraysR t (M1 i c a) -> (t, M1 i c a a)
gtoArr       GArraysR t (M1 i c a)
x  = let (t
t, a a
x1) = GArraysR t a -> (t, a a)
forall (f :: * -> *) t a. GArrays f => GArraysR t f -> (t, f a)
gtoArr GArraysR t a
GArraysR t (M1 i c a)
x in (t
t, a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 a a
x1)

instance Arrays a => GArrays (K1 i a) where
  type GArraysR t (K1 i a) = (t, ArraysR a)
  garrays :: ArraysR t -> ArraysR (GArraysR t (K1 i a))
garrays         ArraysR t
t = ArraysR t -> TupR ArrayR (ArraysR a) -> TupR ArrayR (t, ArraysR a)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
TupRpair ArraysR t
t (Arrays a => TupR ArrayR (ArraysR a)
forall a. Arrays a => ArraysR (ArraysR a)
arraysR @a)
  gfromArr :: K1 i a a -> t -> GArraysR t (K1 i a)
gfromArr (K1 a
x) t
t = (t
t, a -> ArraysR a
forall a. Arrays a => a -> ArraysR a
fromArr a
x)
  gtoArr :: GArraysR t (K1 i a) -> (t, K1 i a a)
gtoArr   (t, x)   = (t
t, a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (ArraysR a -> a
forall a. Arrays a => ArraysR a -> a
toArr ArraysR a
x))

instance (GArrays a, GArrays b) => GArrays (a :*: b) where
  type GArraysR t (a :*: b) = GArraysR (GArraysR t a) b
  garrays :: ArraysR t -> ArraysR (GArraysR t (a :*: b))
garrays            = forall t. GArrays b => ArraysR t -> ArraysR (GArraysR t b)
forall (f :: * -> *) t.
GArrays f =>
ArraysR t -> ArraysR (GArraysR t f)
garrays @b (ArraysR (GArraysR t a) -> ArraysR (GArraysR (GArraysR t a) b))
-> (ArraysR t -> ArraysR (GArraysR t a))
-> ArraysR t
-> ArraysR (GArraysR (GArraysR t a) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. GArrays a => ArraysR t -> ArraysR (GArraysR t a)
forall (f :: * -> *) t.
GArrays f =>
ArraysR t -> ArraysR (GArraysR t f)
garrays @a
  gfromArr :: (:*:) a b a -> t -> GArraysR t (a :*: b)
gfromArr (a a
a :*: b a
b) = b a -> GArraysR t a -> GArraysR (GArraysR t a) b
forall (f :: * -> *) a t. GArrays f => f a -> t -> GArraysR t f
gfromArr b a
b (GArraysR t a -> GArraysR (GArraysR t a) b)
-> (t -> GArraysR t a) -> t -> GArraysR (GArraysR t a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a a -> t -> GArraysR t a
forall (f :: * -> *) a t. GArrays f => f a -> t -> GArraysR t f
gfromArr a a
a
  gtoArr :: GArraysR t (a :*: b) -> (t, (:*:) a b a)
gtoArr GArraysR t (a :*: b)
t =
    let (GArraysR t a
t1, b a
b) = GArraysR (GArraysR t a) b -> (GArraysR t a, b a)
forall (f :: * -> *) t a. GArrays f => GArraysR t f -> (t, f a)
gtoArr GArraysR t (a :*: b)
GArraysR (GArraysR t a) b
t
        (t
t2, a a
a) = GArraysR t a -> (t, a a)
forall (f :: * -> *) t a. GArrays f => GArraysR t f -> (t, f a)
gtoArr GArraysR t a
t1
    in
    (t
t2, a a
a a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
b)


instance Arrays () where
  type ArraysR () = ()
  arraysR :: ArraysR (ArraysR ())
arraysR = ArraysR (ArraysR ())
forall (s :: * -> *). TupR s ()
TupRunit
  fromArr :: () -> ArraysR ()
fromArr = () -> ArraysR ()
forall a. a -> a
id
  toArr :: ArraysR () -> ()
toArr   = ArraysR () -> ()
forall a. a -> a
id

instance (Shape sh, Elt e) => Arrays (Array sh e) where
  type ArraysR (Array sh e) = R.Array (EltR sh) (EltR e)
  arraysR :: ArraysR (ArraysR (Array sh e))
arraysR = ShapeR (EltR sh)
-> TypeR (EltR e) -> ArraysR (Array (EltR sh) (EltR e))
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
R.arraysRarray (Shape sh => ShapeR (EltR sh)
forall sh. Shape sh => ShapeR (EltR sh)
shapeR @sh) (Elt e => TypeR (EltR e)
forall a. Elt a => TypeR (EltR a)
eltR @e)
  fromArr :: Array sh e -> ArraysR (Array sh e)
fromArr (Array Array (EltR sh) (EltR e)
arr) = Array (EltR sh) (EltR e)
ArraysR (Array sh e)
arr
  toArr :: ArraysR (Array sh e) -> Array sh e
toArr               = ArraysR (Array sh e) -> Array sh e
forall sh e. Array (EltR sh) (EltR e) -> Array sh e
Array

runQ $ do
  let
      mkTuple :: Int -> Q Dec
      mkTuple n =
        let
            xs  = [ mkName ('x' : show i) | i <- [0 .. n-1] ]
            ts  = map varT xs
            res = tupT ts
            ctx = mapM (appT [t| Arrays |]) ts
        in
        instanceD ctx [t| Arrays $res |] []
  --
  mapM mkTuple [2..16]