content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE RankNTypes   #-}
  
  ------------------------------------------------------------------------------
  module Data.HeterogeneousEnvironment
    ( KeyGen
    , HeterogeneousEnvironment
    , Key
    , newKeyGen
    , empty
    , makeKey
    , lookup
    , insert
    , delete
    , adjust
    , getKeyId
    ) where
  
  ------------------------------------------------------------------------------
  import           Control.Monad
  import           Data.IntMap   (IntMap)
  import qualified Data.IntMap   as IM
  import           Data.IORef
  import           GHC.Exts
  import           Prelude hiding (lookup)
  import           Unsafe.Coerce
  
  ------------------------------------------------------------------------------
  data HeterogeneousEnvironment = HeterogeneousEnvironment (IntMap Any)
  newtype Key a = Key Int
  newtype KeyGen = KeyGen (IORef Int)
  
  
  ------------------------------------------------------------------------------
  -- | If you use two different KeyGens to work with the same map, you deserve
  -- what you get.
  newKeyGen :: IO KeyGen
  newKeyGen = liftM KeyGen $ newIORef 0
  
  
  ------------------------------------------------------------------------------
  getKeyId :: Key a -> Int
  getKeyId (Key x) = x
  
  
  ------------------------------------------------------------------------------
  empty :: HeterogeneousEnvironment
  empty = HeterogeneousEnvironment $ IM.empty
  
  
  ------------------------------------------------------------------------------
  makeKey :: KeyGen -> IO (Key a)
  makeKey (KeyGen gen) = do
      k <- atomicModifyIORef gen nextKey
      return $ Key k
    where
      nextKey !x = if x >= maxBound-1
                     then error "too many keys generated"
                     else let !x' = x+1 in (x',x)
  
  
  ------------------------------------------------------------------------------
  lookup :: Key a -> HeterogeneousEnvironment -> Maybe a
  lookup (Key k) (HeterogeneousEnvironment m) = fmap unsafeCoerce $ IM.lookup k m
  
  
  ------------------------------------------------------------------------------
  insert :: Key a -> a -> HeterogeneousEnvironment -> HeterogeneousEnvironment
  insert (Key k) v (HeterogeneousEnvironment m) = HeterogeneousEnvironment $
                                                  IM.insert k (unsafeCoerce v) m
  
  
  ------------------------------------------------------------------------------
  delete :: Key a -> HeterogeneousEnvironment -> HeterogeneousEnvironment
  delete (Key k) (HeterogeneousEnvironment m) = HeterogeneousEnvironment $
                                                IM.delete k m
  
  
  ------------------------------------------------------------------------------
  adjust :: (a -> a) -> Key a -> HeterogeneousEnvironment -> HeterogeneousEnvironment
  adjust f (Key k) (HeterogeneousEnvironment m) = HeterogeneousEnvironment $
                                                  IM.adjust f' k m
    where
      f' = unsafeCoerce . f . unsafeCoerce
  