{-# LANGUAGE RankNTypes #-}

module Data.Type.Internal.Key where

import Prelude hiding (lookup)
import System.IO.Unsafe
import Control.Concurrent.MVar
import Data.Int
import Data.HashTable

class Hash a where
	hashValue :: a -> Int32
	hashEqual :: a -> a -> Bool

keyTable :: forall x k. (Hash x) => (k -> k) -> k -> IO (x -> k)
keyTable f i = do
	table <- new hashEqual hashValue
	nextk <- newMVar i
	let
		{-# NOINLINE h #-}
		h x
			= unsafePerformIO . modifyMVar nextk
			$ \nk -> lookup table x >>= \mr -> case mr of
				Just k  -> return (nk,k)
				Nothing -> do
					insert table x nk
					return (f nk,nk)
	return h