<commit_before>-----------------------------------------------------------------------------
-- 
-- Module      :  Control.Concurrent
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/core/LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- $Id: Concurrent.hs,v 1.1 2001/06/28 14:15:01 simonmar Exp $
--
-- A common interface to a collection of useful concurrency
-- abstractions.
--
-----------------------------------------------------------------------------

module Control.Concurrent
	( module Control.Concurrent.Chan
	, module Control.Concurrent.CVar
	, module Control.Concurrent.MVar
	, module Control.Concurrent.QSem
	, module Control.Concurrent.QSemN
	, module Control.Concurrent.SampleVar

#ifdef __HUGS__
	, forkIO	-- :: IO () -> IO ()
#elif defined(__GLASGOW_HASKELL__)
        , ThreadId

	-- Forking and suchlike
	, myThreadId 	-- :: IO ThreadId
	, killThread	-- :: ThreadId -> IO ()
	, throwTo       -- :: ThreadId -> Exception -> IO ()
#endif
	, par  		-- :: a -> b -> b
	, seq  		-- :: a -> b -> b
#ifdef __GLASGOW_HASKELL__
	, fork  	-- :: a -> b -> b
#endif
	, yield         -- :: IO ()

#ifdef __GLASGOW_HASKELL__
	, threadDelay		-- :: Int -> IO ()
	, threadWaitRead	-- :: Int -> IO ()
	, threadWaitWrite	-- :: Int -> IO ()
#endif

	 -- merging of streams
	, mergeIO	-- :: [a]   -> [a] -> IO [a]
	, nmergeIO	-- :: [[a]] -> IO [a]
    ) where

import Prelude

import Control.Exception as Exception

#ifdef __GLASGOW_HASKELL__
import GHC.Conc
import GHC.TopHandler   ( reportStackOverflow, reportError )
import GHC.IOBase	( IO(..) )
import GHC.IOBase	( unsafePerformIO , unsafeInterleaveIO )
import GHC.Base		( fork# )
import GHC.Prim		( Addr#, unsafeCoerce# )
#endif

#ifdef __HUGS__
import IOExts ( unsafeInterleaveIO, unsafePerformIO )
import ConcBase
#endif

import Control.Concurrent.MVar
import Control.Concurrent.CVar
import Control.Concurrent.Chan
import Control.Concurrent.QSem
import Control.Concurrent.QSemN
import Control.Concurrent.SampleVar

#ifdef __GLASGOW_HASKELL__
infixr 0 `fork`
#endif

-- Thread Ids, specifically the instances of Eq and Ord for these things.
-- The ThreadId type itself is defined in std/PrelConc.lhs.

-- Rather than define a new primitve, we use a little helper function
-- cmp_thread in the RTS.

#ifdef __GLASGOW_HASKELL__
foreign import ccall "cmp_thread" unsafe cmp_thread :: Addr# -> Addr# -> Int
-- Returns -1, 0, 1

cmpThread :: ThreadId -> ThreadId -> Ordering
cmpThread (ThreadId t1) (ThreadId t2) = 
   case cmp_thread (unsafeCoerce# t1) (unsafeCoerce# t2) of
      -1 -> LT
      0  -> EQ
      _  -> GT -- must be 1

instance Eq ThreadId where
   t1 == t2 = 
      case t1 `cmpThread` t2 of
         EQ -> True
         _  -> False

instance Ord ThreadId where
   compare = cmpThread

forkIO :: IO () -> IO ThreadId
forkIO action = IO $ \ s -> 
   case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
 where
  action_plus = Exception.catch action childHandler

childHandler :: Exception -> IO ()
childHandler err = Exception.catch (real_handler err) childHandler

real_handler :: Exception -> IO ()
real_handler ex =
  case ex of
	-- ignore thread GC and killThread exceptions:
	BlockedOnDeadMVar            -> return ()
	AsyncException ThreadKilled  -> return ()

	-- report all others:
	AsyncException StackOverflow -> reportStackOverflow False
	ErrorCall s -> reportError False s
	other       -> reportError False (showsPrec 0 other "\n")

{-# INLINE fork #-}
fork :: a -> b -> b
fork x y = unsafePerformIO (forkIO (x `seq` return ())) `seq` y

#endif /* __GLASGOW_HASKELL__ */


max_buff_size :: Int
max_buff_size = 1<commit_msg>[project @ 2001-08-07 15:25:04 by simonmar] Remove 'fork' (unsafe, and not used), and don't export 'seq' and 'par'.<commit_after>-----------------------------------------------------------------------------
-- 
-- Module      :  Control.Concurrent
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/core/LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- $Id: Concurrent.hs,v 1.2 2001/08/07 15:25:04 simonmar Exp $
--
-- A common interface to a collection of useful concurrency
-- abstractions.
--
-----------------------------------------------------------------------------

module Control.Concurrent (
	module Control.Concurrent.Chan,
	module Control.Concurrent.CVar,
	module Control.Concurrent.MVar,
	module Control.Concurrent.QSem,
	module Control.Concurrent.QSemN,
	module Control.Concurrent.SampleVar,

	forkIO,			-- :: IO () -> IO ()
	yield,         		-- :: IO ()

#ifdef __GLASGOW_HASKELL__
        ThreadId,

	-- Forking and suchlike
	myThreadId, 		-- :: IO ThreadId
	killThread,		-- :: ThreadId -> IO ()
	throwTo,		-- :: ThreadId -> Exception -> IO ()

	threadDelay,		-- :: Int -> IO ()
	threadWaitRead,		-- :: Int -> IO ()
	threadWaitWrite,	-- :: Int -> IO ()
#endif

	 -- merging of streams
	mergeIO,		-- :: [a]   -> [a] -> IO [a]
	nmergeIO		-- :: [[a]] -> IO [a]
    ) where

import Prelude

import Control.Exception as Exception

#ifdef __GLASGOW_HASKELL__
import GHC.Conc
import GHC.TopHandler   ( reportStackOverflow, reportError )
import GHC.IOBase	( IO(..) )
import GHC.IOBase	( unsafeInterleaveIO )
import GHC.Base		( fork# )
import GHC.Prim		( Addr#, unsafeCoerce# )
#endif

#ifdef __HUGS__
import IOExts ( unsafeInterleaveIO )
import ConcBase
#endif

import Control.Concurrent.MVar
import Control.Concurrent.CVar
import Control.Concurrent.Chan
import Control.Concurrent.QSem
import Control.Concurrent.QSemN
import Control.Concurrent.SampleVar

-- Thread Ids, specifically the instances of Eq and Ord for these things.
-- The ThreadId type itself is defined in std/PrelConc.lhs.

-- Rather than define a new primitve, we use a little helper function
-- cmp_thread in the RTS.

#ifdef __GLASGOW_HASKELL__
foreign import ccall "cmp_thread" unsafe cmp_thread :: Addr# -> Addr# -> Int
-- Returns -1, 0, 1

cmpThread :: ThreadId -> ThreadId -> Ordering
cmpThread (ThreadId t1) (ThreadId t2) = 
   case cmp_thread (unsafeCoerce# t1) (unsafeCoerce# t2) of
      -1 -> LT
      0  -> EQ
      _  -> GT -- must be 1

instance Eq ThreadId where
   t1 == t2 = 
      case t1 `cmpThread` t2 of
         EQ -> True
         _  -> False

instance Ord ThreadId where
   compare = cmpThread

forkIO :: IO () -> IO ThreadId
forkIO action = IO $ \ s -> 
   case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
 where
  action_plus = Exception.catch action childHandler

childHandler :: Exception -> IO ()
childHandler err = Exception.catch (real_handler err) childHandler

real_handler :: Exception -> IO ()
real_handler ex =
  case ex of
	-- ignore thread GC and killThread exceptions:
	BlockedOnDeadMVar            -> return ()
	AsyncException ThreadKilled  -> return ()

	-- report all others:
	AsyncException StackOverflow -> reportStackOverflow False
	ErrorCall s -> reportError False s
	other       -> reportError False (showsPrec 0 other "\n")

#endif /* __GLASGOW_HASKELL__ */


max_buff_size :: Int
max_buff_size = 1
{'fraction_non_alphanumeric': 0.15817321080478974, 'fraction_numerical': 0.012670565302144249, 'mean_word_length': 2.545409674234946, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 71, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3381780', 'n_tokens_mistral': 2434, 'n_tokens_neox': 2309, 'n_words': 691}