module GHC.Types.Unique.MemoFun (memoiseUniqueFun) where

import GHC.Prelude
import GHC.Types.Unique
import GHC.Types.Unique.FM

import Data.IORef
import System.IO.Unsafe

memoiseUniqueFun :: Uniquable k => (k -> a) -> k -> a
memoiseUniqueFun :: forall k a. Uniquable k => (k -> a) -> k -> a
memoiseUniqueFun k -> a
fun = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  IORef (UniqFM k a)
ref <- forall a. a -> IO (IORef a)
newIORef forall key elt. UniqFM key elt
emptyUFM
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \k
k -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    UniqFM k a
m <- forall a. IORef a -> IO a
readIORef IORef (UniqFM k a)
ref
    case forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM k a
m k
k of
      Just a
a  -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
      Maybe a
Nothing -> do
        let !a :: a
a  = k -> a
fun k
k
            !m' :: UniqFM k a
m' = forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM UniqFM k a
m k
k a
a
        forall a. IORef a -> a -> IO ()
writeIORef IORef (UniqFM k a)
ref UniqFM k a
m'
        forall (m :: * -> *) a. Monad m => a -> m a
return a
a