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