5

我有一个功能

f :: MonadIO m => a -> m b

它接受一些输入并返回将产生输出的 IO 计算。我想“记忆” f，以便我只为每个输入执行一次这些计算。例如，如果

f :: String -> IO String
f s = putStrLn ("hello " ++ s) >> return s

然后我想要一个memoize这样的功能

do
  mf <- memoize f
  s <- mf "world"
  t <- mf "world"
  return (s,t)

只打印"hello world"一次并返回("world", "world"). 我正在编写的程序是多线程的，所以即使不同的线程都在调用mf.

以下是我迄今为止提出的（可怕的）解决方案。我的问题是它是否以及如何改进。

memoize :: (MonadIO m, Ord a) => (a -> m b) -> m (a -> m b)
memoize f = do
  cache <- liftIO $ newTVarIO Map.empty
  return $ \a -> do
              v <- liftIO $ atomically $ lookupInsert cache a
              b <- maybe (f a) return =<< liftIO (atomically $ takeTMVar v)
              liftIO $ atomically $ putTMVar v $ Just b
              return b
    where
      lookupInsert :: Ord a => TVar (Map a (TMVar (Maybe b))) -> a -> STM (TMVar (Maybe b))
      lookupInsert cache a = do
                         mv <- Map.lookup a <$> readTVar cache
                         case mv of
                           Just v -> return v
                           Nothing -> do
                                   v <- newTMVar Nothing
                                   modifyTVar cache (Map.insert a v)
                                   return v

这里发生了一些事情：

1)cache有类型TVar (Map a (TMVar (Maybe b)))。它将输入映射到TMVar包含计算值或Nothing（表示尚未计算值）的输入。该函数lookupInsert检查cache，并插入一个新的TMVar初始化 toNothing如果已经不存在。

2) 返回的操作首先获取v :: TMVar (Maybe b)关联的 to a，然后获取它，然后执行计算f a以获得结果，或者返回存储在 中的值（Maybe如果可用）。这take和put模式是为了让两个不同的线程f a在看到它还没有运行之后不会同时运行计算。

4

1 回答 1

1

我以为你想要的是不可能的，但事实证明它是。

https://stackoverflow.com/a/9458721/1798971

我仍然无法弄清楚为什么会这样！

于 2013-04-11T00:16:15.180 回答