{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
-- |
-- Module      : Data.Array.Accelerate.Math.FFT.LLVM.Native.Ix
-- Copyright   : [2017..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.Math.FFT.LLVM.Native.Ix
  where

import Data.Array.Accelerate.Error
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Type


-- Converting between Accelerate multidimensional shapes/indices and those used
-- by the CArray package (Data.Ix)
--
type family IxShapeR e where
  IxShapeR ()    = ()
  IxShapeR Int   = ((),Int)
  IxShapeR (t,h) = (IxShapeR t, h)

{-# INLINE fromIxShapeR #-}
fromIxShapeR
    :: forall ix sh. (HasCallStack, IxShapeR (EltR ix) ~ sh, Elt ix)
    => sh
    -> ix
fromIxShapeR :: sh -> ix
fromIxShapeR = EltR ix -> ix
forall a. Elt a => EltR a -> a
toElt (EltR ix -> ix) -> (sh -> EltR ix) -> sh -> ix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeR (EltR ix) -> IxShapeR (EltR ix) -> EltR ix
forall ix'. TypeR ix' -> IxShapeR ix' -> ix'
go (Elt ix => TypeR (EltR ix)
forall a. Elt a => TypeR (EltR a)
eltR @ix)
  where
    go :: forall ix'. TypeR ix' -> IxShapeR ix' -> ix'
    go :: TypeR ix' -> IxShapeR ix' -> ix'
go TypeR ix'
TupRunit                                                                    ()     = ()
    go (TupRpair TupR ScalarType a1
tt TupR ScalarType b
_)                                                             (t, h) = (TupR ScalarType a1 -> IxShapeR a1 -> a1
forall ix'. TypeR ix' -> IxShapeR ix' -> ix'
go TupR ScalarType a1
tt IxShapeR a1
t, b
h)
    go (TupRsingle (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) ((),h) = ix'
h
    go TypeR ix'
_ IxShapeR ix'
_
      = String -> ix'
forall a. HasCallStack => String -> a
internalError String
"expected Int dimensions"

{-# INLINE toIxShapeR #-}
toIxShapeR
    :: forall ix sh. (HasCallStack, IxShapeR (EltR ix) ~ sh, Elt ix)
    => ix
    -> sh
toIxShapeR :: ix -> sh
toIxShapeR = TypeR (EltR ix) -> EltR ix -> IxShapeR (EltR ix)
forall ix'. TypeR ix' -> ix' -> IxShapeR ix'
go (Elt ix => TypeR (EltR ix)
forall a. Elt a => TypeR (EltR a)
eltR @ix) (EltR ix -> sh) -> (ix -> EltR ix) -> ix -> sh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ix -> EltR ix
forall a. Elt a => a -> EltR a
fromElt
  where
    go :: forall ix'. TypeR ix' -> ix' -> IxShapeR ix'
    go :: TypeR ix' -> ix' -> IxShapeR ix'
go TypeR ix'
TupRunit        ()                                                                = ()
    go (TupRsingle     (SingleScalarType (NumSingleType (IntegralNumType TypeInt{})))) ix'
h = ((), ix'
h)
    go (TupRpair TupR ScalarType a1
tt TupR ScalarType b
_) (t, h)                                                            = (TupR ScalarType a1 -> a1 -> IxShapeR a1
forall ix'. TypeR ix' -> ix' -> IxShapeR ix'
go TupR ScalarType a1
tt a1
t, b
h)
    go TypeR ix'
_ ix'
_
      = String -> IxShapeR ix'
forall a. HasCallStack => String -> a
internalError String
"not a valid Data.Ix index"