Editing Thread-local storage (section)

== Proposal 2 ==

Frederik Eaton posted an example API to the Haskell mailing list [http://www.haskell.org/pipermail/haskell/2006-July/018300.html]. It depends on two new functions 'withParams' and 'getParams'.

(new version 2006/8/9)

<pre>
module Fu.IOParam (
    forkIO,
    newIOParam,
    withIOParam,
    getIOParam,
    modifyIOParam,
    _getParams,
    _withParams
) where

import qualified Data.Map as M
import Data.Maybe
import Data.Unique
import Data.IORef
import Data.Typeable
import Data.Dynamic
import qualified Control.Concurrent as CC
import Control.Concurrent hiding (forkIO)
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import System.IO.Unsafe

type IOParam a = IORef (Unique, a)

newIOParam :: Typeable a => a -> IO (IOParam a)
newIOParam def = do
    k <- newUnique
    newIORef (k,def)

withIOParam :: Typeable v => IOParam v -> v -> IO a -> IO a
withIOParam p value act = do
    (k,def) <- readIORef p
    m <- _getParams
    _withParams (M.insert k (toDyn value) m) act

getIOParam :: Typeable v => IOParam v -> IO v
getIOParam p = do
    (k,def) <- readIORef p
    m <- _getParams
    let vm = liftM (flip fromDyn $ (error "internal error in IOParam")) $ M.lookup k m
    return $ fromMaybe def vm

-- | convenience function
modifyIOParam :: Typeable v => IOParam v -> (v -> v) -> IO a -> IO a
modifyIOParam p fm act = do
    v <- getIOParam p
    let v' = fm v
    withIOParam p v' act

forkIO act = do
  p <- _getParams
  CC.forkIO $ _withParams p act

----------------------------------------------------------------
-- non-exposed
type ParamsMap = M.Map Unique Dynamic

_withParams :: ParamsMap -> IO a -> IO a
_withParams newmap act = do
    myid <- myThreadId
    t <- readMVar threadMap
    let oldmap = fromMaybe (M.empty) (M.lookup myid t)
    modifyMVar_ threadMap (return . M.insert myid newmap)
    act `finally`
      modifyMVar_ threadMap (\tm ->
        if M.null oldmap then
          return $ M.delete myid tm
        else
          return $ M.insert myid oldmap tm)

_getParams :: IO ParamsMap
_getParams = do
    myid <- myThreadId
    t <- readMVar threadMap
    return $ fromMaybe (M.empty) (M.lookup myid t)

{-# NOINLINE threadMap #-}
threadMap :: MVar (M.Map ThreadId ParamsMap)
threadMap = unsafePerformIO $ do
--    tid <- myThreadId
--    newMVar $ M.singleton tid M.empty
    newMVar $ M.empty
----------------------------------------------------------------
</pre>

=== Comments (feel free to delete) ===

* Is it possible to set default values for threads where the IOParam was not set?

:: I'm not sure what this means. You can set a value to ''undefined'' or ''error ...''. You can change the default for a group of threads by setting up new values with ''withIOParam'' and then forking threads from this context.

* Is it possible to have a value in TLS that is not Typeable?

:: No, but I think everything should be ''Typeable''.

* Would the idea be to use unsafePerformIO to create the Uniques for top-level keys?

:: Please clarify.

=== Comparison to Proposal 3 ===

From the mailing list: [http://www.haskell.org/pipermail/haskell/2006-August/018345.html]

<pre>
The main difference between my and your proposals, as I see it, is
that your proposal is based on "keys" which can be used for other
things.

I think that leads to an interface which is less natural. In my
proposal, the IOParam type is quite similar to an IORef - it has a
user-specified initial state, and the internal implementation is
hidden from the user - yours differs in both of these aspects.

...

> *  A key issue is this: when forking a thread, does the new thread
> inherit the current thread's bindings, or does it get a
> freshly-initialised set.  Sometimes you want one, sometimes the other,
> alas.

I think the inheritance semantics are more useful and also more
general: If I wanted a freshly-initialized set of bindings, and I only
had inheritance semantics, then I could start a thread early on when
all the bindings are in their initial state, and have this thread read
actions from a channel and execute them in sub-threads of itself, and
implement a 'fork' variant based on this. More generally, I could do
the same thing from a sub-thread of the main thread - I could start a
thread with any set of bindings, and use it to launch other threads
with those bindings. In this way, the "initial" set of bindings is not
specially privileged over intermediate sets of bindings.
</pre>