<commit_before>{-# LANGUAGE CPP, GADTs, PatternGuards, TemplateHaskell #-}
{-# LANGUAGE TupleSections, TypeFamilies, TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}   -- CUDA.Context
-- |
-- Module      : Data.Array.Accelerate.CUDA.State
-- Copyright   : [2008..2010] <NAME>, <NAME>, <NAME>
--               [2009..2012] <NAME>, <NAME>, <NAME>
-- License     : BSD3
--
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-partable (GHC extensions)
--
-- This module defines a state monad token which keeps track of the code
-- generator state, including memory transfers and external compilation
-- processes.
--

module Data.Array.Accelerate.CUDA.State (

  -- Types
  CIO, KernelTable, KernelKey, KernelEntry(KernelEntry), KernelObject(KernelObject),

  -- Evaluating computations
  evalCUDA, defaultContext, deviceProps,
  memoryTable, kernelTable, kernelName, kernelStatus

) where

-- friends
import Data.Array.Accelerate.CUDA.FullList              ( FullList )
import Data.Array.Accelerate.CUDA.Debug                 ( message, verbose )
import Data.Array.Accelerate.CUDA.Array.Table           as MT
import Data.Array.Accelerate.CUDA.Analysis.Device

-- library
import Numeric
import Data.List
import Data.Label
import Control.Exception
import Data.ByteString                                  ( ByteString )
import Control.Monad.State.Strict                       ( StateT(..), evalStateT )
import System.Process                                   ( ProcessHandle )
import System.IO.Unsafe
import Text.PrettyPrint
import qualified Foreign.CUDA.Driver                    as CUDA hiding ( device )
import qualified Foreign.CUDA.Driver.Context            as CUDA
import qualified Foreign.CUDA.Analysis                  as CUDA
import qualified Data.HashTable.IO                      as HT

#ifdef ACCELERATE_CUDA_PERSISTENT_CACHE
import Data.Binary                                      ( encodeFile, decodeFile )
import Control.Arrow                                    ( second )
import Paths_accelerate                                 ( getDataDir )
#endif


-- An exact association between an accelerate computation and its
-- implementation, which is either a reference to the external compiler (nvcc)
-- or the resulting binary module.
--
-- Note that since we now support running in multiple contexts, we also need to
-- keep track of
--   a) the compute architecture the code was compiled for
--   b) which contexts have linked the code
--
-- We aren't concerned with true (typed) equality of an OpenAcc expression,
-- since we largely want to disregard the array environment; we really only want
-- to assert the type and index of those variables that are accessed by the
-- computation and no more, but we can not do that. Instead, this is keyed to
-- the generated kernel code.
--
type KernelTable = HT.BasicHashTable KernelKey KernelEntry

type KernelKey   = (CUDA.Compute, ByteString)
data KernelEntry = KernelEntry
  {
    _kernelName         :: FilePath,
    _kernelStatus       :: Either ProcessHandle KernelObject
  }

data KernelObject = KernelObject
  {
    _binaryData         :: !ByteString,
    _activeContexts     :: !(FullList CUDA.Context CUDA.Module)
  }

-- The state token for accelerated CUDA array operations
--
type CIO        = StateT CUDAState IO
data CUDAState  = CUDAState
  {
    _deviceProps        :: CUDA.DeviceProperties,
    _kernelTable        :: !KernelTable,
    _memoryTable        :: !MemoryTable
  }

instance Eq CUDA.Context where
  CUDA.Context p1 == CUDA.Context p2    = p1 == p2

$(mkLabels [''CUDAState, ''KernelEntry])


-- Execution State
-- ---------------

-- |Evaluate a CUDA array computation
--
evalCUDA :: CUDA.Context -> CIO a -> IO a
evalCUDA ctx acc = bracket setup teardown $ evalStateT acc
  where
    teardown _  = CUDA.pop
    setup       = do
      CUDA.push ctx
      dev       <- CUDA.device
      prp       <- CUDA.props dev
      return $ initialise { _deviceProps = prp }


-- Select and initialise the CUDA device, and create a new execution context.
-- This will be done only once per program execution, as initialising the CUDA
-- context is relatively expensive.
--
{-# NOINLINE initialise #-}
initialise :: CUDAState
initialise = unsafePerformIO $ do
  knl   <- HT.new<commit_msg>force GC at the end of each run<commit_after>{-# LANGUAGE CPP, GADTs, PatternGuards, TemplateHaskell #-}
{-# LANGUAGE TupleSections, TypeFamilies, TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}   -- CUDA.Context
-- |
-- Module      : Data.Array.Accelerate.CUDA.State
-- Copyright   : [2008..2010] <NAME>, <NAME>, <NAME>
--               [2009..2012] <NAME>, <NAME>, <NAME>
-- License     : BSD3
--
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-partable (GHC extensions)
--
-- This module defines a state monad token which keeps track of the code
-- generator state, including memory transfers and external compilation
-- processes.
--

module Data.Array.Accelerate.CUDA.State (

  -- Types
  CIO, KernelTable, KernelKey, KernelEntry(KernelEntry), KernelObject(KernelObject),

  -- Evaluating computations
  evalCUDA, defaultContext, deviceProps,
  memoryTable, kernelTable, kernelName, kernelStatus

) where

-- friends
import Data.Array.Accelerate.CUDA.FullList              ( FullList )
import Data.Array.Accelerate.CUDA.Debug                 ( message, verbose )
import Data.Array.Accelerate.CUDA.Array.Table           as MT
import Data.Array.Accelerate.CUDA.Analysis.Device

-- library
import Numeric
import Data.List
import Data.Label
import Control.Exception
import Data.ByteString                                  ( ByteString )
import Control.Monad.State.Strict                       ( StateT(..), evalStateT )
import System.Process                                   ( ProcessHandle )
import System.Mem
import System.IO.Unsafe
import Text.PrettyPrint
import qualified Foreign.CUDA.Driver                    as CUDA hiding ( device )
import qualified Foreign.CUDA.Driver.Context            as CUDA
import qualified Foreign.CUDA.Analysis                  as CUDA
import qualified Data.HashTable.IO                      as HT

#ifdef ACCELERATE_CUDA_PERSISTENT_CACHE
import Data.Binary                                      ( encodeFile, decodeFile )
import Control.Arrow                                    ( second )
import Paths_accelerate                                 ( getDataDir )
#endif


-- An exact association between an accelerate computation and its
-- implementation, which is either a reference to the external compiler (nvcc)
-- or the resulting binary module.
--
-- Note that since we now support running in multiple contexts, we also need to
-- keep track of
--   a) the compute architecture the code was compiled for
--   b) which contexts have linked the code
--
-- We aren't concerned with true (typed) equality of an OpenAcc expression,
-- since we largely want to disregard the array environment; we really only want
-- to assert the type and index of those variables that are accessed by the
-- computation and no more, but we can not do that. Instead, this is keyed to
-- the generated kernel code.
--
type KernelTable = HT.BasicHashTable KernelKey KernelEntry

type KernelKey   = (CUDA.Compute, ByteString)
data KernelEntry = KernelEntry
  {
    _kernelName         :: FilePath,
    _kernelStatus       :: Either ProcessHandle KernelObject
  }

data KernelObject = KernelObject
  {
    _binaryData         :: !ByteString,
    _activeContexts     :: !(FullList CUDA.Context CUDA.Module)
  }

-- The state token for accelerated CUDA array operations
--
type CIO        = StateT CUDAState IO
data CUDAState  = CUDAState
  {
    _deviceProps        :: CUDA.DeviceProperties,
    _kernelTable        :: !KernelTable,
    _memoryTable        :: !MemoryTable
  }

instance Eq CUDA.Context where
  CUDA.Context p1 == CUDA.Context p2    = p1 == p2

$(mkLabels [''CUDAState, ''KernelEntry])


-- Execution State
-- ---------------

-- |Evaluate a CUDA array computation
--
evalCUDA :: CUDA.Context -> CIO a -> IO a
evalCUDA ctx acc = bracket setup teardown $ evalStateT acc
  where
    teardown _  = performGC >> CUDA.pop
    setup       = do
      CUDA.push ctx
      dev       <- CUDA.device
      prp       <- CUDA.props dev
      return $ initialise { _deviceProps = prp }


-- Select and initialise the CUDA device, and create a new execution context.
-- This will be done only once per program execution, as initialising the CUDA
-- context is relatively expensive.
--
{-# NOINLINE initialise #-}
initialise :: CUDAState
initialise = unsafePerformIO $ do
  knl   <- HT.new
{'fraction_non_alphanumeric': 0.0896471949103528, 'fraction_numerical': 0.004858299595141701, 'mean_word_length': 2.4848851269649335, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 27, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4022186', 'n_tokens_mistral': 2520, 'n_tokens_neox': 2381, 'n_words': 807}