content: {-# LANGUAGE GADTs           #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE TypeFamilies    #-}
  {-# OPTIONS_HADDOCK hide #-}
  -- |
  -- Module      : Data.Array.Accelerate.LLVM.Execute.Environment
  -- Copyright   : [2014..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.LLVM.Execute.Environment
    where
  
  import Data.Array.Accelerate.AST                                    ( ALeftHandSide, ELeftHandSide )
  import Data.Array.Accelerate.AST.Idx
  import Data.Array.Accelerate.AST.LeftHandSide
  import Data.Array.Accelerate.Representation.Array
  
  import Data.Array.Accelerate.LLVM.Execute.Async
  
  
  -- Environments
  -- ------------
  
  -- Valuation for an environment of futures
  --
  data ValR arch env where
    Empty :: ValR arch ()
    Push  :: ValR arch env -> FutureR arch t -> ValR arch (env, t)
  
  push :: ValR arch env -> (ALeftHandSide t env env', FutureArraysR arch t) -> ValR arch env'
  push env (LeftHandSideWildcard _     , _       ) = env
  push env (LeftHandSideSingle ArrayR{}, a       ) = env `Push` a
  push env (LeftHandSidePair l1 l2     , (a1, a2)) = push env (l1, a1) `push` (l2, a2)
  
  pushE :: Async arch => ValR arch env -> (ELeftHandSide t env env', FutureR arch t) -> Par arch (ValR arch env')
  pushE env (LeftHandSideSingle _  , e) = return $ env `Push` e
  pushE env (LeftHandSideWildcard _, _) = return env
  pushE env (LeftHandSidePair l1 l2, e) = do
    -- TODO: This code creates many intermediate Futures, in case of deeply nested pairs.
    -- We could improve this to only construct Futures for the values actually stored
    -- in the environment and not have any intermediate ones. We can do that in a similar
    -- way as done in Data.Array.Accelerate.LLVM.Execute.split
    --
    e1 <- new
    e2 <- new
    fork $ do
      (v1, v2) <- get e
      put e1 v1
      put e2 v2
    env' <- pushE env (l1, e1)
    pushE env' (l2, e2)
  
  -- Projection of a value from a valuation using a de Bruijn index.
  --
  prj :: Idx env t -> ValR arch env -> FutureR arch t
  prj ZeroIdx       (Push _   x) = x
  prj (SuccIdx idx) (Push val _) = prj idx val
  
  