Thanks to the encouraging post http://www.haskell.org//pipermail/haskell/2004-November/014748.html from Benjamin Franksen, I have implemented my proposal which allows the user to define new global variables without unsafePerformIO, NOINLINE and other such horrors. http://www.haskell.org//pipermail/haskell/2004-November/014748.html The module itself is in GlobalVariables.hs; a short example of its use and a test case (generating unique natural numbers) is in TestGlobalVariables.hs. Both files are attached to this message. Here are some things I think people should like about this method. (1) It's typesafe. (2) The order in which things happen is well-defined, provided that the order in which the external functions are called is. (3) It needs no extensions to the Haskell language, and only fairly standard hierarchical libraries like Data.IORef. (4) With withEmptyDict, you can run actions within your program that start with a completely clean slate and don't clobber your existing global variables. (This could be used if you are GHCi and want to run code inside a sandbox, or if you have separate processors and want each to have its own global variables.) (5) We avoid any concurrency primitives which might block (no MVars!). Some things people might not like so much. (1) You are not allowed to have two global variables with the same type (since they are indexed by type. (2) Global variables can only be accessed by an IO action. (You could not implement stdout :: Handle, you'd have to implement getstdout :: IO Handle.) (3) To implement withEmptyDict, it is necessary to (a) use ThreadId's, which means the code won't work on Hugs; (b) use a special version of forkIO (whose implementation is included) which makes sure new dictionaries are inherited. (4) Dictionaries are unnecessarily slow (linear access time in numbers of entries). Neither (1) or (2) bother me much, because I virtually always use global variables like that anyway. I hope (3)(a) will be addressed someday by Hugs implementing ThreadId's, and for (3)(b) I would suggest either making this the default forkIO action, or providing a "Who's my parent" primitive. (4) would be easy to resolve if Data.Dynamic.TypeRep were made to instance Ord, which I think should be trivial (for GHC at least). Anyway, it's not perfect, but I think it's the best solution, and I condemn it to haskell.org ... {- Program to test global variables by implementing a source of unique natural numbers. -} module Main where import Data.Dynamic import Data.IORef import Data.GlobalVariables import Control.Concurrent.MVar -- -------------------------------------------------------------------- -- Source of unique natural numbers -- -------------------------------------------------------------------- data UniqueNaturalSource = UniqueNaturalSource (IORef Integer) deriving (Typeable) mkUniqueNaturalSource :: IO UniqueNaturalSource mkUniqueNaturalSource = do ioRef <- newIORef 1 return (UniqueNaturalSource ioRef) getNextNatural :: IO Integer getNextNatural = do (UniqueNaturalSource ioRef) <- lookupWithRegister mkUniqueNaturalSource atomicModifyIORef ioRef (\ i -> (i+1,i)) -- -------------------------------------------------------------------- -- A little test program -- -------------------------------------------------------------------- main :: IO () main = do let p = do n <- getNextNatural putStrLn (show n) -- put in lots of forkIO's to make things interesting. let testNumbers i = do putStrLn ("Numbers starting at " ++ show i) wait <- newEmptyMVar forkIO ( do p p p forkIO ( do p forkIO ( do p putMVar wait () ) return () ) return () ) takeMVar wait -- print 5 numbers beginning at 1. testNumbers 1 -- print 5 numbers beginning at 1 again, with a new dictionary. withEmptyDict (testNumbers 1) -- print 5 numbers beginning at 6, still using the old dictionary testNumbers 6 -- | -- Description: Tool for initialising global variables -- -- At the moment this is inefficient, mainly because of the pitiful -- support by the standard libraries for indexing on TypeRep's and ThreadId's. -- Someone please make TypeRep instance Ord and provide a hash function for -- ThreadId!! module Data.GlobalVariables( lookupWithRegister, withEmptyDict, withFreshDict, forkIO, ) where import Maybe import List import Data.IORef import Data.Dynamic import Data.FiniteMap import System.IO.Unsafe import Control.Exception import Control.Concurrent hiding (forkIO) import qualified Control.Concurrent -- ----------------------------------------------------------------------- -- The user interface -- ----------------------------------------------------------------------- -- | Look up some global variable. The initial action constructs it if -- necessary. lookupWithRegister :: Typeable a => IO a -> IO a lookupWithRegister initialisationAction = do let updateFn dict = case lookupDict dict of Just a -> (dict,a) Nothing -> let a = unsafePerformIO initialisationAction Just dict2 = addToDict dict a in (dict2,a) a <- updateDictState updateFn seq a (return a) -- | Perform some action and the child threads it splits off with -- an alternative dictionary which is initially empty. withEmptyDict :: IO a -> IO a withEmptyDict = withOtherDict (\ _ -> emptyDict) -- | Perform some action and the child threads it splits off with -- a fresh dictionary split off from the current one. withFreshDict :: IO a -> IO a withFreshDict = withOtherDict id -- | Perform some action and the child threads it splits off with -- a dictionary computed from the current one. withOtherDict :: (Dict -> Dict) -> IO a -> IO a withOtherDict newDictFn action = do oldDictRefOpt <- getDictRefOpt oldDict <- readIORef (case oldDictRefOpt of Nothing -> defaultDict theDictState Just oldDictRef -> oldDictRef ) let newDict = newDictFn oldDict newDictRef <- newIORef newDict setDictRef newDictRef finally action (case oldDictRefOpt of Nothing -> forgetDict Just oldDictRef -> setDictRef oldDictRef ) -- ----------------------------------------------------------------------- -- The Dict type -- ----------------------------------------------------------------------- -- | Stores a set of elements with distinct types indexed by type -- NB. Needs to use a FiniteMap, when TypeRep's instance Ord. newtype Dict = Dict [(TypeRep,Dynamic)] -- | Dict with no elements. emptyDict :: Dict emptyDict = Dict [] -- | Retrieve an element from the dictionary, if one of that type exists. lookupDict :: Typeable a => Dict -> Maybe a lookupDict (Dict list) = let -- construct a dummy value of the required type so we can get at its -- TypeRep. Just dummy = (Just undefined) `asTypeOf` aOpt -- get at the required result type. dynOpt = lookup (typeOf dummy) list aOpt = case dynOpt of Nothing -> Nothing Just dyn -> Just ( fromMaybe (error "Inconsistent type in Dict") (fromDynamic dyn) ) in aOpt -- | Add an element to the dictionary if possible, or return Nothing if it -- isn't because one of that type already exists. addToDict :: Typeable a => Dict -> a -> Maybe Dict addToDict (Dict list) val = let typeRep = typeOf val in case lookup typeRep list of Just _ -> Nothing Nothing -> Just (Dict ((typeRep,toDyn val) : list)) -- | Delete an element from the dictionary, if one is in it, or return Nothing -- if it isn't. delFromDict :: Typeable a => Dict -> a -- ^ this value is only interesting for its type, and isn't looked at. -> Maybe Dict delFromDict (Dict list) val = let typeRep = typeOf val dList [] = Nothing dList ((hd@(typeRep2,_)):list2) = if typeRep == typeRep2 then Just list2 else fmap (hd:) (dList list2) in fmap Dict (dList list) -- ------------------------------------------------------------------------- -- The DictState type. This should contain all your program's global state. -- ------------------------------------------------------------------------- data DictState = DictState { stateRef :: IORef (FiniteMap ThreadId (IORef Dict)), defaultDict :: IORef Dict -- this corresponds to the main program and is used when we can't -- determine a dictionary for a thread. } theDictState :: DictState theDictState = unsafePerformIO ( do stateRef <- newIORef emptyFM defaultDict <- newIORef emptyDict return (DictState {stateRef = stateRef,defaultDict = defaultDict}) ) {-# NOINLINE theDictState #-} -- | Get the current DictRef for a thread getDictRef :: IO (IORef Dict) getDictRef = do dictRefOpt <- getDictRefOpt return (fromMaybe (defaultDict theDictState) dictRefOpt) -- | Update the dictionary for this thread with the given update function -- and returning the result. updateDictState :: (Dict -> (Dict,result)) -> IO result updateDictState modifyFn = do dictRef <- getDictRef atomicModifyIORef dictRef modifyFn -- | Get the dictionary for this thread, if any. getDictRefOpt :: IO (Maybe (IORef Dict)) getDictRefOpt = do threadId <- myThreadId fm0 <- readIORef (stateRef theDictState) return (lookupFM fm0 threadId) -- | Set the dictionary ref for this thread. setDictRef :: IORef Dict -> IO () setDictRef dictRef = do threadId <- myThreadId atomicModifyIORef (stateRef theDictState) (\ fm0 -> (addToFM fm0 threadId dictRef,())) -- | Forget this thread's dictionary. (This is necessary for garbage -- collection.) forgetDict :: IO () forgetDict = do threadId <- myThreadId atomicModifyIORef (stateRef theDictState) (\ fm0 -> (delFromFM fm0 threadId,())) -- Use as a substitute for normal forkIO, so that dictionaries get -- inherited. forkIO :: IO () -> IO ThreadId forkIO actToFork = do dictRefOpt <- getDictRefOpt case dictRefOpt of Nothing -> Control.Concurrent.forkIO actToFork Just dictRef -> let actToFork2 = finally ( do setDictRef dictRef actToFork ) forgetDict in Control.Concurrent.forkIO actToFork2