-- TLM: Shrinking of array expressions is currently specialised to OpenAcc
--      because we need to unwrap terms to do further substitution and
--      shrinking at the Alet case.
--
shrinkA
    :: RebuildAcc OpenAcc
    -> ShrinkAcc OpenAcc
    -> UsesOfAcc OpenAcc
    -> PreOpenAcc OpenAcc aenv t
    -> PreOpenAcc OpenAcc aenv t
shrinkA k s u pacc =
  let subTop :: Arrays t => PreOpenAcc acc aenv s -> Idx (aenv,s) t -> PreOpenAcc acc aenv t
      subTop t ZeroIdx          = t
      subTop _ (SuccIdx idx)    = Avar idx
  in
  case pacc of
    Alet bnd@(OpenAcc pbnd) body@(OpenAcc pbody)
      | Avar _ <- pbnd           -> shrinkA k s u (rebuildA k (subTop pbnd)  pbody)
      | u ZeroIdx body' <= lIMIT -> shrinkA k s u (rebuildA k (subTop pbnd') pbody')
      | otherwise                -> Alet bnd' body'
      where
        bnd'@(OpenAcc pbnd')    = s bnd
        body'@(OpenAcc pbody')  = s body

        -- Allow only dead code elimination, otherwise we might inline array
        -- computations directly into scalar expressions, and later stages rely
        -- on there being only variables embedded in scalar expressions.
        --
        lIMIT   = 0
    --
    Avar ix             -> Avar ix
    Atuple tup          -> Atuple (shrinkATA s tup)
    Aprj tup a          -> Aprj tup (s a)
    Apply f a           -> Apply f (s a)
    Acond p t e         -> Acond (shrinkEA s p) (s t) (s e)
    Use a               -> Use a
    Unit e              -> Unit (shrinkEA s e)
    Reshape e a         -> Reshape (shrinkEA s e) (s a)
    Generate e f        -> Generate (shrinkEA s e) (shrinkFA s f)
    Transform sh ix f a -> Transform (shrinkEA s sh) (shrinkFA s ix) (shrinkFA s f) (s a)
    Replicate sl slix a -> Replicate sl (shrinkEA s slix) (s a)
    Slice sl a slix     -> Slice sl (s a) (shrinkEA s slix)
    Map f a             -> Map (shrinkFA s f) (s a)
    ZipWith f a1 a2     -> ZipWith (shrinkFA s f) (s a1) (s a2)
    Fold f z a          -> Fold (shrinkFA s f) (shrinkEA s z) (s a)
    Fold1 f a           -> Fold1 (shrinkFA s f) (s a)
    FoldSeg f z a b     -> FoldSeg (shrinkFA s f) (shrinkEA s z) (s a) (s b)
    Fold1Seg f a b      -> Fold1Seg (shrinkFA s f) (s a) (s b)
    Scanl f z a         -> Scanl (shrinkFA s f) (shrinkEA s z) (s a)
    Scanl' f z a        -> Scanl' (shrinkFA s f) (shrinkEA s z) (s a)
    Scanl1 f a          -> Scanl1 (shrinkFA s f) (s a)
    Scanr f z a         -> Scanr (shrinkFA s f) (shrinkEA s z) (s a)
    Scanr' f z a        -> Scanr' (shrinkFA s f) (shrinkEA s z) (s a)
    Scanr1 f a          -> Scanr1 (shrinkFA s f) (s a)
    Permute f1 a1 f2 a2 -> Permute (shrinkFA s f1) (s a1) (shrinkFA s f2) (s a2)
    Backpermute sh f a  -> Backpermute (shrinkEA s sh) (shrinkFA s f) (s a)
    Stencil f b a       -> Stencil (shrinkFA s f) b (s a)
    Stencil2 f b1 a1 b2 a2
                        -> Stencil2 (shrinkFA s f) b1 (s a1) b2 (s a2)
    Foreign ff afun a   -> Foreign ff afun $ s a
shrinkA
    :: RebuildAcc OpenAcc
    -> ShrinkAcc OpenAcc
    -> UsesOfAcc OpenAcc
    -> PreOpenAcc OpenAcc aenv t
    -> PreOpenAcc OpenAcc aenv t
shrinkA k s u pacc =
  let subTop :: Arrays t => PreOpenAcc acc aenv s -> Idx (aenv,s) t -> PreOpenAcc acc aenv t
      subTop t ZeroIdx          = t
      subTop _ (SuccIdx idx)    = Avar idx
  in
  case pacc of
    Alet bnd@(OpenAcc pbnd) body@(OpenAcc pbody)
      | Avar _ <- pbnd           -> shrinkA k s u (rebuildA k (subTop pbnd)  pbody)
      | u ZeroIdx body' <= lIMIT -> shrinkA k s u (rebuildA k (subTop pbnd') pbody')
      | otherwise                -> Alet bnd' body'
      where
        bnd'@(OpenAcc pbnd')    = s bnd
        body'@(OpenAcc pbody')  = s body

        -- Allow only dead code elimination, otherwise we might inline array
        -- computations directly into scalar expressions, and later stages rely
        -- on there being only variables embedded in scalar expressions.
        --
        lIMIT   = 0
    --
    Avar ix             -> Avar ix
    Atuple tup          -> Atuple (shrinkATA s tup)
    Aprj tup a          -> Aprj tup (s a)
    Apply f a           -> Apply f (s a)
    Acond p t e         -> Acond (shrinkEA s p) (s t) (s e)
    Use a               -> Use a
    Unit e              -> Unit (shrinkEA s e)
    Reshape e a         -> Reshape (shrinkEA s e) (s a)
    Generate e f        -> Generate (shrinkEA s e) (shrinkFA s f)
    Transform sh ix f a -> Transform (shrinkEA s sh) (shrinkFA s ix) (shrinkFA s f) (s a)
    Replicate sl slix a -> Replicate sl (shrinkEA s slix) (s a)
    Slice sl a slix     -> Slice sl (s a) (shrinkEA s slix)
    Map f a             -> Map (shrinkFA s f) (s a)
    ZipWith f a1 a2     -> ZipWith (shrinkFA s f) (s a1) (s a2)
    Fold f z a          -> Fold (shrinkFA s f) (shrinkEA s z) (s a)
    Fold1 f a           -> Fold1 (shrinkFA s f) (s a)
    FoldSeg f z a b     -> FoldSeg (shrinkFA s f) (shrinkEA s z) (s a) (s b)
    Fold1Seg f a b      -> Fold1Seg (shrinkFA s f) (s a) (s b)
    Scanl f z a         -> Scanl (shrinkFA s f) (shrinkEA s z) (s a)
    Scanl' f z a        -> Scanl' (shrinkFA s f) (shrinkEA s z) (s a)
    Scanl1 f a          -> Scanl1 (shrinkFA s f) (s a)
    Scanr f z a         -> Scanr (shrinkFA s f) (shrinkEA s z) (s a)
    Scanr' f z a        -> Scanr' (shrinkFA s f) (shrinkEA s z) (s a)
    Scanr1 f a          -> Scanr1 (shrinkFA s f) (s a)
    Permute f1 a1 f2 a2 -> Permute (shrinkFA s f1) (s a1) (shrinkFA s f2) (s a2)
    Backpermute sh f a  -> Backpermute (shrinkEA s sh) (shrinkFA s f) (s a)
    Stencil f b a       -> Stencil (shrinkFA s f) b (s a)
    Stencil2 f b1 a1 b2 a2
                        -> Stencil2 (shrinkFA s f) b1 (s a1) b2 (s a2)
    Foreign ff afun a   -> Foreign ff afun $ s a
shrinkA k s u pacc =
  let subTop :: Arrays t => PreOpenAcc acc aenv s -> Idx (aenv,s) t -> PreOpenAcc acc aenv t
      subTop t ZeroIdx          = t
      subTop _ (SuccIdx idx)    = Avar idx
  in
  case pacc of
    Alet bnd@(OpenAcc pbnd) body@(OpenAcc pbody)
      | Avar _ <- pbnd           -> shrinkA k s u (rebuildA k (subTop pbnd)  pbody)
      | u ZeroIdx body' <= lIMIT -> shrinkA k s u (rebuildA k (subTop pbnd') pbody')
      | otherwise                -> Alet bnd' body'
      where
        bnd'@(OpenAcc pbnd')    = s bnd
        body'@(OpenAcc pbody')  = s body

        -- Allow only dead code elimination, otherwise we might inline array
        -- computations directly into scalar expressions, and later stages rely
        -- on there being only variables embedded in scalar expressions.
        --
        lIMIT   = 0
    --
    Avar ix             -> Avar ix
    Atuple tup          -> Atuple (shrinkATA s tup)
    Aprj tup a          -> Aprj tup (s a)
    Apply f a           -> Apply f (s a)
    Acond p t e         -> Acond (shrinkEA s p) (s t) (s e)
    Use a               -> Use a
    Unit e              -> Unit (shrinkEA s e)
    Reshape e a         -> Reshape (shrinkEA s e) (s a)
    Generate e f        -> Generate (shrinkEA s e) (shrinkFA s f)
    Transform sh ix f a -> Transform (shrinkEA s sh) (shrinkFA s ix) (shrinkFA s f) (s a)
    Replicate sl slix a -> Replicate sl (shrinkEA s slix) (s a)
    Slice sl a slix     -> Slice sl (s a) (shrinkEA s slix)
    Map f a             -> Map (shrinkFA s f) (s a)
    ZipWith f a1 a2     -> ZipWith (shrinkFA s f) (s a1) (s a2)
    Fold f z a          -> Fold (shrinkFA s f) (shrinkEA s z) (s a)
    Fold1 f a           -> Fold1 (shrinkFA s f) (s a)
    FoldSeg f z a b     -> FoldSeg (shrinkFA s f) (shrinkEA s z) (s a) (s b)
    Fold1Seg f a b      -> Fold1Seg (shrinkFA s f) (s a) (s b)
    Scanl f z a         -> Scanl (shrinkFA s f) (shrinkEA s z) (s a)
    Scanl' f z a        -> Scanl' (shrinkFA s f) (shrinkEA s z) (s a)
    Scanl1 f a          -> Scanl1 (shrinkFA s f) (s a)
    Scanr f z a         -> Scanr (shrinkFA s f) (shrinkEA s z) (s a)
    Scanr' f z a        -> Scanr' (shrinkFA s f) (shrinkEA s z) (s a)
    Scanr1 f a          -> Scanr1 (shrinkFA s f) (s a)
    Permute f1 a1 f2 a2 -> Permute (shrinkFA s f1) (s a1) (shrinkFA s f2) (s a2)
    Backpermute sh f a  -> Backpermute (shrinkEA s sh) (shrinkFA s f) (s a)
    Stencil f b a       -> Stencil (shrinkFA s f) b (s a)
    Stencil2 f b1 a1 b2 a2
                        -> Stencil2 (shrinkFA s f) b1 (s a1) b2 (s a2)
    Foreign ff afun a   -> Foreign ff afun $ s a