<commit_before>-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Concurrent
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  non-portable (concurrency)
--
-- A common interface to a collection of useful concurrency
-- abstractions.
--
-----------------------------------------------------------------------------

module Control.Concurrent (
	-- * Concurrent Haskell

	-- $conc_intro

	-- * Basic concurrency operations

        ThreadId,
	myThreadId,

	forkIO,
	killThread,
	throwTo,

	-- * Scheduling

	-- $conc_scheduling	
	yield,         		-- :: IO ()

	-- ** Blocking
	
	-- $blocking

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

	-- * Communication abstractions

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

	-- * Merging of streams
	mergeIO,		-- :: [a]   -> [a] -> IO [a]
	nmergeIO,		-- :: [[a]] -> IO [a]
	-- $merge

	-- * GHC's implementation of concurrency

	-- |This section describes features specific to GHC's
	-- implementation of Concurrent Haskell.
	
	-- ** Terminating the program

	-- $termination

	-- ** Pre-emption

	-- $preemption

    ) 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
#endif

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

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

{- $conc_intro

The concurrency extension for Haskell is described in the paper
/Concurrent Haskell/
<http://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz>.

Concurrency is \"lightweight\", which means that both thread creation
and context switching overheads are extremely low.  Scheduling of
Haskell threads is done internally in the Haskell runtime system, and
doesn't make use of any operating system-supplied thread packages.

Haskell threads can communicate via 'MVar's, a kind of synchronised
mutable variable (see "Control.Concurrent.MVar").  Several common
concurrency abstractions can be built from 'MVar's, and these are
provided by the "Concurrent" library.  Threads may also communicate
via exceptions. 
-}

{- $conc_scheduling

    Scheduling may be either pre-emptive or co-operative,
    depending on the implementation of Concurrent Haskell (see below
    for imformation related to specific compilers).  In a co-operative
    system, context switches only occur when you use one of the
    primitives defined in this module.  This means that programs such
    as:


>   main = forkIO (write 'a') >> write 'b'
>     where write c = putChar c >> write c

    will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,
    instead of some random interleaving of @a@s and @b@s.  In
    practice, cooperative multitasking is sufficient for writing
    simple graphical user interfaces.  
-}

{- $blocking
Calling a foreign C procedure (such as @getchar@) that blocks waiting
for input will block /all/ threads, unless the @threadsafe@ attribute
is used on the foreign call (and your compiler \/ operating system
supports it).  GHC's I\/O system uses non-blocking I\/O internally to
implement thread-friendly I\/O, so calling standard Haskell I\/O
functions blocks only the thread making the call.
-}

-- 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 unsafe "cmp_thread" 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

foreign import ccall unsafe "rts_getThreadId" getThreadId :: Addr# -> Int

instance Show ThreadId where
   showsPrec d (ThreadId t) = 
   	showString "ThreadId " . 
        showsPrec d (getThreadId (unsafeCoerce# t))<commit_msg>[project @ 2002-10-03 13:29:07 by panne] Warning police #7: Improved typing of TSOs a bit, getting rid of a bunch of C compiler warnings.<commit_after>-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Concurrent
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  non-portable (concurrency)
--
-- A common interface to a collection of useful concurrency
-- abstractions.
--
-----------------------------------------------------------------------------

module Control.Concurrent (
	-- * Concurrent Haskell

	-- $conc_intro

	-- * Basic concurrency operations

        ThreadId,
	myThreadId,

	forkIO,
	killThread,
	throwTo,

	-- * Scheduling

	-- $conc_scheduling	
	yield,         		-- :: IO ()

	-- ** Blocking
	
	-- $blocking

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

	-- * Communication abstractions

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

	-- * Merging of streams
	mergeIO,		-- :: [a]   -> [a] -> IO [a]
	nmergeIO,		-- :: [[a]] -> IO [a]
	-- $merge

	-- * GHC's implementation of concurrency

	-- |This section describes features specific to GHC's
	-- implementation of Concurrent Haskell.
	
	-- ** Terminating the program

	-- $termination

	-- ** Pre-emption

	-- $preemption

    ) 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
import GHC.Ptr
#endif

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

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

{- $conc_intro

The concurrency extension for Haskell is described in the paper
/Concurrent Haskell/
<http://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz>.

Concurrency is \"lightweight\", which means that both thread creation
and context switching overheads are extremely low.  Scheduling of
Haskell threads is done internally in the Haskell runtime system, and
doesn't make use of any operating system-supplied thread packages.

Haskell threads can communicate via 'MVar's, a kind of synchronised
mutable variable (see "Control.Concurrent.MVar").  Several common
concurrency abstractions can be built from 'MVar's, and these are
provided by the "Concurrent" library.  Threads may also communicate
via exceptions. 
-}

{- $conc_scheduling

    Scheduling may be either pre-emptive or co-operative,
    depending on the implementation of Concurrent Haskell (see below
    for imformation related to specific compilers).  In a co-operative
    system, context switches only occur when you use one of the
    primitives defined in this module.  This means that programs such
    as:


>   main = forkIO (write 'a') >> write 'b'
>     where write c = putChar c >> write c

    will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,
    instead of some random interleaving of @a@s and @b@s.  In
    practice, cooperative multitasking is sufficient for writing
    simple graphical user interfaces.  
-}

{- $blocking
Calling a foreign C procedure (such as @getchar@) that blocks waiting
for input will block /all/ threads, unless the @threadsafe@ attribute
is used on the foreign call (and your compiler \/ operating system
supports it).  GHC's I\/O system uses non-blocking I\/O internally to
implement thread-friendly I\/O, so calling standard Haskell I\/O
functions blocks only the thread making the call.
-}

-- 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__
type StgTSO = Ptr ()

id2TSO :: ThreadId -> StgTSO
id2TSO (ThreadId t) = unsafeCoerce# t

foreign import ccall unsafe "cmp_thread" cmp_thread :: StgTSO -> StgTSO -> Int
-- Returns -1, 0, 1

cmpThread :: ThreadId -> ThreadId -> Ordering
cmpThread t1 t2 = 
   case cmp_thread (id2TSO t1) (id2TSO 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

foreign import ccall unsafe "rts_getThreadId" getThreadId :: StgTSO -> Int

instance Show ThreadId where
   showsPrec d t = 
   	showString "ThreadId " . 
        showsPrec d (getThreadId (id2TSO t))
{'fraction_non_alphanumeric': 0.12323294406883835, 'fraction_numerical': 0.005736529399713174, 'mean_word_length': 2.8528018942383584, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 52, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 4, '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': '5177028', 'n_tokens_mistral': 3093, 'n_tokens_neox': 2889, 'n_words': 1045}