<commit_before>{-# LANGUAGE BangPatterns  #-}
{-# LANGUAGE MagicHash     #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Data.Array.Accelerate.CUDA.Execute.Event
-- Copyright   : [2008..2010] <NAME>, <NAME>, <NAME>
--               [2009..2013] <NAME>, <NAME>, <NAME>
-- License     : BSD3
--
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
module Data.Array.Accelerate.CUDA.Execute.Event (

  Event, create, waypoint, after, block,

) where

-- friends
import qualified Data.Array.Accelerate.CUDA.Debug               as D

-- libraries
import Foreign.CUDA.Driver.Event                                ( Event(..) )
import Foreign.CUDA.Driver.Stream                               ( Stream )
import qualified Foreign.CUDA.Driver.Event                      as Event

import GHC.Base


-- Create a new event that will be automatically garbage collected. The event is
-- not suitable for timing purposes.
--
{-# INLINE create #-}
create :: IO Event
create = do
  event <- Event.create [Event.DisableTiming]
  addEventFinalizer event (Event.destroy event)
  return event

-- Create a new event marker that will be filled once execution in the specified
-- stream has completed all previously submitted work.
--
{-# INLINE waypoint #-}
waypoint :: Stream -> IO Event
waypoint stream = do
  event <- create
  Event.record event (Just stream)
--  message $ "waypoint " ++ show event ++ " in " ++ show stream
  return event

-- Make all future work submitted to the given stream wait until the event
-- reports completion before beginning execution.
--
{-# INLINE after #-}
after :: Event -> Stream -> IO ()
after event stream = do
--  message $ "after " ++ show event ++ " in " ++ show stream
  Event.wait event (Just stream) []

-- Block the calling thread until the event is recorded
--
{-# INLINE block #-}
block :: Event -> IO ()
block = Event.block


-- Add a finaliser to an event token
--
addEventFinalizer :: Event -> IO () -> IO ()
addEventFinalizer e@(Event e#) f = IO $ \s ->
  case mkWeak# e# e f s of (# s', _w #) -> (# s', () #)


-- Debug
-- -----
{--
{-# INLINE trace #-}
trace :: String -> IO a -> IO a
trace msg next = D.message D.dump_exec ("event: " ++ msg) >> next

{-# INLINE message #-}
message :: String -> IO ()
message s = s `trace` return ()
--}
<commit_msg>actually fix event finalisers<commit_after>{-# LANGUAGE BangPatterns  #-}
{-# LANGUAGE MagicHash     #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Data.Array.Accelerate.CUDA.Execute.Event
-- Copyright   : [2008..2010] <NAME>, <NAME>, <NAME>
--               [2009..2013] <NAME>, <NAME>, <NAME>
-- License     : BSD3
--
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
module Data.Array.Accelerate.CUDA.Execute.Event (

  Event, create, waypoint, after, block,

) where

-- friends
import qualified Data.Array.Accelerate.CUDA.Debug               as D

-- libraries
import Foreign.CUDA.Driver.Event                                ( Event(..) )
import Foreign.CUDA.Driver.Stream                               ( Stream )
import qualified Foreign.CUDA.Driver.Event                      as Event

import GHC.Base
import GHC.Ptr


-- Create a new event that will be automatically garbage collected. The event is
-- not suitable for timing purposes.
--
{-# INLINE create #-}
create :: IO Event
create = do
  event <- Event.create [Event.DisableTiming]
  addEventFinalizer event $ trace ("destroy " ++ show event) (Event.destroy event)
  return event

-- Create a new event marker that will be filled once execution in the specified
-- stream has completed all previously submitted work.
--
{-# INLINE waypoint #-}
waypoint :: Stream -> IO Event
waypoint stream = do
  event <- create
  Event.record event (Just stream)
--  message $ "waypoint " ++ show event ++ " in " ++ show stream
  return event

-- Make all future work submitted to the given stream wait until the event
-- reports completion before beginning execution.
--
{-# INLINE after #-}
after :: Event -> Stream -> IO ()
after event stream = do
--  message $ "after " ++ show event ++ " in " ++ show stream
  Event.wait event (Just stream) []

-- Block the calling thread until the event is recorded
--
{-# INLINE block #-}
block :: Event -> IO ()
block = Event.block


-- Add a finaliser to an event token
--
addEventFinalizer :: Event -> IO () -> IO ()
addEventFinalizer e@(Event (Ptr e#)) f = IO $ \s ->
  case mkWeak# e# e f s of (# s', _w #) -> (# s', () #)


-- Debug
-- -----

{-# INLINE trace #-}
trace :: String -> IO a -> IO a
trace msg next = D.message D.dump_exec ("event: " ++ msg) >> next

{-# INLINE message #-}
message :: String -> IO ()
message s = s `trace` return ()

{'fraction_non_alphanumeric': 0.14390602055800295, 'fraction_numerical': 0.0071323683658485425, 'mean_word_length': 2.531851851851852, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3422638', 'n_tokens_mistral': 1471, 'n_tokens_neox': 1420, 'n_words': 500}