@@ -1,62 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−module Control.Concurrent.ThreadLocal.Internal where
3−
4−import Control.Concurrent (ThreadId, myThreadId, mkWeakThreadId)
5−import Control.Concurrent.MVar
6−import Control.Monad ((<=<), guard)
7−import Data.Foldable (toList)
8−import Data.Maybe (isJust)
9−import Data.Vector (Vector)
10−import qualified Data.Vector as Vector
11−import Data.Witherable
12−import System.Mem.Weak
13−
14−data LocalValue a = LocalValue {-# UNPACK #-} !(Weak ThreadId) -- ^ ThreadId reference used as a key
15− String -- ^ String representation of ThreadId, for debugging
16− a
17−
18−localThread :: LocalValue a -> IO (Maybe ThreadId)
19−localThread (LocalValue weak _ _) = deRefWeak weak
20−
21−derefLocal :: LocalValue a -> IO (Maybe (ThreadId, a))
22−derefLocal (LocalValue weak _ a) = fmap (,a) <$> deRefWeak weak
23−
24−makeLocal :: ThreadId -> a -> IO (LocalValue a)
25−makeLocal tid a = do weak <- mkWeakThreadId tid
26− pure (LocalValue weak (show tid) a)
27−
28−newtype ThreadLocal a = ThreadLocal { values :: MVar (Vector (LocalValue a))
29− }
30−
31−-- | Create a new thread local storage of type 'a'
32−newThreadLocal :: IO (ThreadLocal a)
33−newThreadLocal = do var <- newMVar Vector.empty
34− return (ThreadLocal var)
35−
36−-- | Insert a value for the current thread
37−insertThreadLocal :: a -> ThreadLocal a -> IO ()
38−insertThreadLocal val (ThreadLocal var) = do tid <- myThreadId
39− loc <- makeLocal tid val
40− modifyMVar_ var $ \v ->
41− do ts <- filterA (\l -> do tid' <- localThread l
42− pure (isJust tid' && Just tid /= tid')
43− ) (toList v)
44− pure (Vector.fromList (loc:ts))
45−
46−-- | Fetch a value for the current thread. If none was inserted previously, return Nothing.
47−fetchThreadLocal :: ThreadLocal a -> IO (Maybe a)
48−fetchThreadLocal (ThreadLocal var) = do tid <- myThreadId
49− v <- readMVar var
50− f tid <$> wither derefLocal v
51− where f tid vec = do ((tid',v),_) <- Vector.uncons vec
52− guard (tid == tid')
53− pure v
54−
55−gcThreadLocal :: ThreadLocal a -> IO ()
56−gcThreadLocal (ThreadLocal var) = modifyMVar_ var (filterA (fmap isJust . localThread))
57−
58−dumpThreadLocal :: ThreadLocal a -> IO [(Maybe ThreadId, String, a)]
59−dumpThreadLocal (ThreadLocal var) = traverse (\l@(LocalValue _ s v) -> (,s,v) <$> localThread l) . toList =<< readMVar var
60−
61−printThreadLocal :: Show a => ThreadLocal a -> IO ()
62−printThreadLocal = print <=< dumpThreadLocal