{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeOperators         #-}
{-# 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.Extra


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''

deriving instance (forall a. Show (s a)) => Show (LeftHandSide s v env env')

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

lhsToTupR :: LeftHandSide s v env env' -> TupR s v
lhsToTupR :: forall (s :: * -> *) v env env'.
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 :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, 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 (s :: * -> *) v env env'.
(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 s b -> ()
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 s b -> ()
forall b. s b -> ()
f LeftHandSide s v1 env env'
as () -> () -> ()
forall a b. a -> b -> b
`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 s b -> ()
forall b. s b -> ()
f LeftHandSide s v2 env' env'
bs

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