[Haskell-cafe] One-shot? (was: Global variables and stuff)

[Judah Jacobson]

On Fri, 12 Nov 2004 14:53:33 +0000, Adrian Hey <ahey at iee.org> wrote:
> On Thursday 11 Nov 2004 12:27 pm, Ben Rudiak-Gould wrote:
> 
> 
> > On the other hand, these are perfectly safe:
> >
> >     once' :: IO a -> IO (IO a)
> >     oncePerString :: String -> IO a -> IO a
> >     oncePerType   :: Typeable a => IO a -> IO a
> >
> > once' seems virtually useless unless you have top-level <-, but the
> > other two don't need it. I'm not sure which would be preferable. I lean
> > toward oncePerString as more flexible and predictable, though it
> > requires a certain discipline on the part of its users.
> 
> Having taken a bit of time to look at this, I have to say that IMO
> saying they are "perfectly safe" is over stating things a bit :-)
> 

How is oncePerType in particular unsound?  I've given a quick example
implementation below.  It's a referentially transparent function (no
use of unsafePerformIO except to implement an internal global
hashtable), it's type-safe, and I imagine that the discipline involved
is no worse than that of dynamic exceptions, for example.

I'm not necessarily suggesting that this solves the discussion, but it
could be good enough to replace unsafePerformIO in many situations.

Incidentally, a similar idea was suggested by George Russell, but not
really followed up on:
http://www.haskell.org/pipermail/haskell/2004-June/014104.html
(This was perhaps the first message in the current months-long discussion?)

-Judah

---------------
module OnceType(oncePerType) where

import Data.Dynamic
import Data.Hashtable as HT
import Data.Int(Int32)
import GHC.IOBase (unsafePerformIO)

type Dict = HT.HashTable TypeRep Dynamic

oncePerType :: Typeable a => IO a -> IO a
oncePerType (action :: IO a) = do
    let rep = typeOf (undefined :: a)
    l <- HT.lookup globalDict rep
    case l of
	Nothing -> do -- run the action
		    x <- action
		    HT.insert globalDict (typeOf x) (toDyn x)
		    return x
	Just dyn -> case fromDynamic dyn of
		    -- since we store values according to their TypeRep,
		    -- fromDynamic should never fail.
			Just x -> return x

{-# NOINLINE globalDict #-}
globalDict :: Dict
globalDict = unsafePerformIO $ HT.new (==) hashTypeRep

-- this could be implemented better using the internals of Data.Typeable
hashTypeRep :: TypeRep -> Int32
hashTypeRep = hashString . show