[Haskell] Re: Global Variables and IO initializers

[Benjamin Franksen]

[encouraging everybody to reply on haskell-cafe]

On Tuesday 23 November 2004 12:02, you wrote:
> 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.

This is funny. When I got no immediate reaction from you, I started 
implementing it myself. I ended up with something similar. It has less 
features but is also a lot simpler. This is the interface:

initGlobal :: Typeable a => a -> IO ()
getGlobal :: Typeable a => IO a

Some remarks:

 o The separation into two modules is only historical.
 o I use an MVar internally, not an IORef; since it is not exposed,
   no indefinite blocking can occur. It's just a mutex around the
   dictionary.
 o Storing (TypeRep,Dynamic) pairs is redundant, since Dynamics already
   contain their own TypeRep (that is how they are made to work).
 o Both our implementations use unsafePerformIO in an unsafe manner,
   which is why the NOINLINE flag is used.
 o I also use a list for the dictionary; and I share your view about
   TypeRep badly needing an Ord instance (probably trivial to provide
   but I could be wrong).

                      ***************

On a related note, there was some discussion recently about which IO actions 
should be considered as 'harmless' so that they are allowed for the proposed 
top-level '<-' bindings, and how to characterize them in an elegant way.

Here is yet another solution:

The only things allowed at top-level (other than pure values) will be unique 
labels (such as provided by Data.Unique). Then we take all the newXXX actions 
out of whatever monad they live in and provide them as pure functions that 
take a Unique as additional argument:

newXXX :: Unique -> a -> XXX a

This might be a bit tricky to do efficiently. Anyway, a Haskell program could 
then create top-level Unique labels instead of top-level XXX vars:

	myGlobalVarLabel <- unique

	myGlobalMVar = newMVar myGlobalVarLabel "initial content"

The concrete syntax could be made even simpler (and clearer), i.e. without the 
'<-' operator:

	unique myGlobalVarLabel

Advantages:

 o No question of what is in SafeIO and what is not.
 o No question of when top-level IO actions are performed.

                      ***************

Now what about combining the two aproaches? The point here is that in Haskell 
we can easily create new unique labels at the top-level without resorting to 
any kind of unsafe operations:

	data Uniq1 = Uniq1
	data Uniq2 = Uniq2
	...

Only these have not the same but different types. So we need a way to map them 
to a single type in such a way that their uniqueness is preserved. We already 
have such a tool and it is called "deriving Typeable":

	unique = typeOf
	type Unique = TypeRep

	data Uniq1 = Uniq1 deriving Typeable
	data Uniq2 = Uniq2 deriving Typeable

Our unique labels can now simply be defined as

	label1 = unique Uniq1
	label2 = unique Uniq2

and our global variables as

	global1 = functionalNewMVar label1 True
	global2 = functionalNewMVar label1 (117::Int)

I think this is most elegant, although there remains the questions of an 
efficient implementation of functionalNewXXX.

Ben
-------------- next part --------------
{-# OPTIONS -fglasgow-exts -fno-cse #-}
module Data.IO.Dict (
  register,
  standard,
  lookup
  ) where

import Prelude hiding (lookup)
import Foreign
import Data.Dynamic
import Data.Maybe
import Control.Concurrent
import Control.Exception

-- a collection of initialised data.
type Dict = MVar [Dynamic]

thedict :: Dict
{-# NOINLINE thedict #-}
thedict = unsafePerformIO $ newMVar []

-- Each Haskell "main" program will have one of these.
standard :: IO Dict
standard = do
  return thedict

-- register a value of type (a) in the dictionary.  Only one value of each
-- type is allowed in the dictionary; registering the same type twice will
-- cause an exception.
register :: Typeable a => Dict -> a -> IO ()
register dict_var val = modifyMVar_ dict_var register'
  where
    register' :: [Dynamic] -> IO [Dynamic]
    register' d = do
      x <- tryJust errorCalls (lookup' d `asTypeOf` (return val))
      case x of
        Left _ -> return $ (toDyn val):d
        Right val' -> error $ "Dict.register: a value of type (" ++ (show $ typeOf val) ++ ") has already been registered"

-- Get the value of (a) registered in the Dict, or raise an exception if it
-- isn't.
lookup :: Typeable a => Dict -> IO a
lookup dict_var = withMVar dict_var lookup'

lookup' :: Typeable a => [Dynamic] -> IO a
lookup' [] = error "Dict.lookup: not found"
lookup' (dyn:dyns) =
  case fromDynamic dyn of
    Just val -> return val
    Nothing -> lookup' dyns

-- thisThreadDict :: IO Dict

-- newEmptyDict :: IO Dict

-- runWithDifferentDefaultDict :: Dict -> IO a -> IO a
-------------- next part --------------
module Data.IO.Global where

import qualified Data.IO.Dict as Dict
import Data.Typeable

initGlobal :: Typeable a => a -> IO ()
initGlobal x  = do
  d <- Dict.standard
  Dict.register d x

getGlobal :: Typeable a => IO a
getGlobal = do
  d <- Dict.standard
  Dict.lookup d