{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE CPP #-}
module Data.TLS.GHC
( TLS
, mkTLS
, getTLS
, allTLS
, forEachTLS_
, freeAllTLS
, freeTLS
) where
import Control.Monad
import Control.Concurrent
import Data.Map.Strict as M
import Data.IORef
#include "TLS_Sig.hs"
data TLS a = TLS { mkNew :: !(IO a)
, allCopies :: {-# UNPACK #-} !(IORef (Map ThreadId a)) }
mkTLS new = do
v <- newIORef $! M.empty
return $! TLS new v
getTLS TLS{mkNew,allCopies} = do
tid <- myThreadId
peek <- readIORef allCopies
case M.lookup tid peek of
Just a -> return a
Nothing -> do
a <- mkNew
atomicModifyIORef' allCopies (\ mp -> (M.insert tid a mp, ()))
return $! a
allTLS TLS{allCopies} = do
mp <- readIORef allCopies
return $! M.elems mp
forEachTLS_ tls fn = do
ls <- allTLS tls
forM_ ls fn
freeAllTLS _ =
do return ()