content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  Control.Concurrent.SHFSTM.Internal.TVar
  -- Copyright   :  (c) D. Sabel, Goethe-University, Frankfurt a.M., Germany
  -- License     :  BSD-style 
  -- 
  -- Maintainer  :  sabel <at> ki.cs.uni-frankfurt.de
  -- Stability   :  experimental
  -- Portability :  non-portable (needs GHC and extensions)
  --
  --  
  -- This module implements the interface to the STM implementation.
  -----------------------------------------------------------------------------
  
  
  module Control.Concurrent.STM.Internal.TVar (
    -- * Types
    TVar(..),
    TVarA(..),
    TVarAny(..),
    ITVar(..),
    TVarId,
    -- * Operations
    nextCounter
    ) where
  
  import Prelude hiding(catch)
  import System.IO.Unsafe
  import Data.IORef
  import qualified Data.List
  import Control.Concurrent.STM.Internal.Map as Map
  import Control.Concurrent.STM.Internal.Set as Set
  import Control.Concurrent
  import Control.Exception
  import Data.Maybe
  import Data.Typeable
      
  -- =============================================================
  -- Implementation of the TVar with local and global components
  -- Everything is packed by pointers to allow easy (side-effecting) 
  -- updates
  
  -- | The 'TVar'-type represents transactional variables
  -- Internally it is represented by a pair of transactional variables:
  -- a 'TVarA' and a 'TVarAny', both represent the same transactional
  -- variable, but 'TVarA' is  explictely polymorphically typed, while
  -- the type is hidden in TVarAny
  newtype TVar a = TVar (TVarA a,TVarAny)
  
  -- | 'TVarA' is an 'MVar' containing an 'ITVar'
  newtype TVarA a = TVarA (MVar (ITVar a))
  
  -- | 'TVarAny' contains an identifier (of type 'TVarId') and
  -- and an 'MVar' which contains an 'ITVar'.
  -- The content type is hidden using existential types
  data  TVarAny = forall a. TVarAny (TVarId, MVar (ITVar a))
  
  -- | 'tvarAToTVarAny' converts a 'TVarA' a into a 'TVar' 
  tvarAToTVar :: TVarA a -> TVarId -> IO (TVar a)
  tvarAToTVar (TVarA p) tid = 
   do return (TVar (TVarA p, TVarAny (tid,p)))
  
  instance Eq TVarAny where
   (TVarAny (i,_)) == (TVarAny (j,_)) = i == j
  
  instance Ord TVarAny where
   compare (TVarAny (i,_)) (TVarAny (j,_)) = compare i j
   
  instance Show TVarAny where
   show (TVarAny (i,_)) = show i
  
  instance Eq (TVar a) where
   (TVar (TVarA l,_)) == (TVar (TVarA r,_)) = l == r
  
  -- | The real content of a TVar is stored in the 'ITVar' type which has five components,
  --   all of them are packed into 'MVar's to allow safe access and efficient updates
  data ITVar a = 
    TV { 
         -- | The global content of the TVar
        globalContent :: MVar a                                
         -- | The local copies: for every Thread a TVar-Stack (protected by a pointer)
       ,localContent  :: MVar (Map.Map ThreadId (IORef [a])) 
         -- | The notify-List: a set of thread identifiers, for those threads which are inside
         -- transactions and want to be notfied when their state becomes conflicting.
         -- If this case occurs all threads in notifyList will receive an exception                                                     
       ,notifyList    :: MVar (Set.Set ThreadId) -- a channel of thread ids
         -- | The exclusive lock is used to lock the TVar by the committing transaction
       ,lock          :: MVar ThreadId 
         -- | The waitingQueue is used to block, if the TVar is locked, the blocked thread will 
         -- be woken up by the committing thread
       ,waitingQueue  :: MVar [MVar ()]
       }
  -- | Identifiers 'TVarId' are 'Integer's. They are only necessary for the 'Ord'-instance of 'TVarAny'
       
  type TVarId = Integer
  
  
  {-# NOINLINE globalCounter #-}
  -- | The 'globalCounter' is used to generate new 'TVarId's
  globalCounter :: MVar TVarId
  globalCounter = unsafePerformIO $ newMVar 0
  
  -- | 'nextCounter' generates a new 'TVarId'
  nextCounter :: IO TVarId
  nextCounter = 
   mask_ $ do
     i <- takeMVar globalCounter
     putMVar globalCounter (i+1)
     return i
  
     
  