{-# LANGUAGE GADTs           #-}
{-# LANGUAGE KindSignatures  #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.AST.LeftHandSide
-- 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.AST.LeftHandSide
  where

import Data.Array.Accelerate.Representation.Type

import Language.Haskell.TH


data Exists f where
  Exists :: f a -> Exists f

data LeftHandSide s v env env' where
  LeftHandSideSingle
    :: s v
    -> LeftHandSide s v env (env, v)

  LeftHandSideWildcard
    :: TupR s v
    -> LeftHandSide s v env env

  LeftHandSidePair
    :: LeftHandSide s v1       env  env'
    -> LeftHandSide s v2       env' env''
    -> LeftHandSide s (v1, v2) env  env''

pattern LeftHandSideUnit
    :: ()                   -- required
    => (env' ~ env, v ~ ()) -- provided
    => LeftHandSide s v env env'
pattern $bLeftHandSideUnit :: LeftHandSide s v env env'
$mLeftHandSideUnit :: forall r env' env v (s :: * -> *).
LeftHandSide s v env env'
-> ((env' ~ env, v ~ ()) => r) -> (Void# -> r) -> r
LeftHandSideUnit = LeftHandSideWildcard TupRunit

lhsToTupR :: LeftHandSide s v env env' -> TupR s v
lhsToTupR :: LeftHandSide s v env env' -> TupR s v
lhsToTupR (LeftHandSideSingle s v
s)   = s v -> TupR s v
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle s v
s
lhsToTupR (LeftHandSideWildcard TupR s v
r) = TupR s v
r
lhsToTupR (LeftHandSidePair LeftHandSide s v1 env env'
as LeftHandSide s v2 env' env'
bs) = TupR s v1 -> TupR s v2 -> TupR s (v1, v2)
forall (s :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
TupRpair (LeftHandSide s v1 env env' -> TupR s v1
forall (s :: * -> *) v env env'.
LeftHandSide s v env env' -> TupR s v
lhsToTupR LeftHandSide s v1 env env'
as) (LeftHandSide s v2 env' env' -> TupR s v2
forall (s :: * -> *) v env env'.
LeftHandSide s v env env' -> TupR s v
lhsToTupR LeftHandSide s v2 env' env'
bs)

rnfLeftHandSide :: (forall b. s b -> ()) -> LeftHandSide s v env env' -> ()
rnfLeftHandSide :: (forall b. s b -> ()) -> LeftHandSide s v env env' -> ()
rnfLeftHandSide forall b. s b -> ()
f (LeftHandSideWildcard TupR s v
r) = (forall b. s b -> ()) -> TupR s v -> ()
forall (s :: * -> *) a. (forall b. s b -> ()) -> TupR s a -> ()
rnfTupR forall b. s b -> ()
f TupR s v
r
rnfLeftHandSide forall b. s b -> ()
f (LeftHandSideSingle s v
s)   = s v -> ()
forall b. s b -> ()
f s v
s
rnfLeftHandSide forall b. s b -> ()
f (LeftHandSidePair LeftHandSide s v1 env env'
as LeftHandSide s v2 env' env'
bs) = (forall b. s b -> ()) -> LeftHandSide s v1 env env' -> ()
forall (s :: * -> *) v env env'.
(forall b. s b -> ()) -> LeftHandSide s v env env' -> ()
rnfLeftHandSide forall b. s b -> ()
f LeftHandSide s v1 env env'
as () -> () -> ()
`seq` (forall b. s b -> ()) -> LeftHandSide s v2 env' env' -> ()
forall (s :: * -> *) v env env'.
(forall b. s b -> ()) -> LeftHandSide s v env env' -> ()
rnfLeftHandSide forall b. s b -> ()
f LeftHandSide s v2 env' env'
bs

liftLeftHandSide :: (forall u. s u -> Q (TExp (s u))) -> LeftHandSide s v env env' -> Q (TExp (LeftHandSide s v env env'))
liftLeftHandSide :: (forall u. s u -> Q (TExp (s u)))
-> LeftHandSide s v env env'
-> Q (TExp (LeftHandSide s v env env'))
liftLeftHandSide forall u. s u -> Q (TExp (s u))
f (LeftHandSideSingle s v
s)   = [|| LeftHandSideSingle $$(f s) ||]
liftLeftHandSide forall u. s u -> Q (TExp (s u))
f (LeftHandSideWildcard TupR s v
r) = [|| LeftHandSideWildcard $$(liftTupR f r) ||]
liftLeftHandSide forall u. s u -> Q (TExp (s u))
f (LeftHandSidePair LeftHandSide s v1 env env'
as LeftHandSide s v2 env' env'
bs) = [|| LeftHandSidePair $$(liftLeftHandSide f as) $$(liftLeftHandSide f bs) ||]