Haskell “的可重入缓存”；“参考透明”；IO呼叫

假设我们有一个IO操作，例如

lookupStuff :: InputType -> IO OutputType

这可能是一些简单的事情，比如DNS查找，或者针对时间不变数据的一些web服务调用

让我们假设：

该操作从不抛出任何异常和/或从不发散

如果不是针对

IO

monad，函数将是纯函数，即对于相同的输入参数，结果总是相同的

该操作是可重入的，即可以同时从多个线程安全地调用它

lookupstaff

操作相当（时间）昂贵

我面临的问题是如何正确地（并且不使用任何

不安全*IO*

欺骗）实现可重入缓存，该缓存可以从多个线程调用，并将针对相同输入参数的多个查询合并到单个请求中

我想我追求的是类似于GHC的黑洞概念的纯粹计算，但在IO“计算”上下文中

---

针对所述问题的惯用Haskell/GHC解决方案是什么？

是的，基本上是重新实现逻辑。尽管这似乎与GHC已经在做的事情相似，但这是GHC的选择。Haskell可以在工作方式非常不同的VM上实现，因此从这个意义上讲，它还没有为您实现

但是是的，只需使用

MVar（Map InputType OutputType）

甚至

IORef（Map InputType OutputType）

（确保使用

atomicModifyIORef

进行修改），并将缓存存储在其中。如果这个命令式解决方案似乎是错误的，那么这就是“如果不是对于

IO

，这个函数将是纯”约束。如果它只是一个任意的

IO

操作，那么您必须保持状态才能知道执行什么或不执行什么的想法似乎是非常自然的。问题是Haskell没有“纯IO”的类型（如果它依赖于数据库，那么它只是在某些条件下表现为纯，这与遗传纯不同）

导入符合条件的数据。映射为映射
导入控制.Concurrent.MVar
--接受IO函数并返回缓存版本
缓存：：（Ord a）=>（a->IO b）->IO（a->IO b）
缓存f=do
r do
cacheMap-do
putMVar缓存映射
返回y
无事可做
y这里有一些代码或多或少实现了我在最初的问题中所追求的目标：

import           Control.Concurrent
import           Control.Exception
import           Data.Either
import           Data.Map           (Map)
import qualified Data.Map           as Map
import           Prelude            hiding (catch)

-- |Memoizing wrapper for 'IO' actions
memoizeIO :: Ord a => (a -> IO b) -> IO (a -> IO b)
memoizeIO action = do
  cache <- newMVar Map.empty
  return $ memolup cache action

  where
    -- Lookup helper
    memolup :: Ord a => MVar (Map a (Async b)) -> (a -> IO b) -> a -> IO b
    memolup cache action' args = wait' =<< modifyMVar cache lup
      where
        lup tab = case Map.lookup args tab of
          Just ares' ->
            return (tab, ares')
          Nothing    -> do
            ares' <- async $ action' args
            return (Map.insert args ares' tab, ares')

假设1、2和3似乎暗示函数是纯函数，而杂质仅仅是一个实现细节。在这种情况下，我认为使用unsafePerformIO没有任何问题。事实上，我认为这种情况下不安全的行为是存在的。1、2、3是非常强的假设，几乎永远不会适用于IO中的代码，但如果事实上你能保证这种不安全的性能是相当合理的。好吧，但我如何保证IO效果不会对同一输入参数执行多次？你需要记住纯结构，但是有很多关于如何做到这一点的文献。（请注意，您还可以以更传统的命令式方式记忆IO结构）如何确保web服务调用永远不会分离？如果网络出现问题怎么办？虽然我不确定这是否一定是一个要求，但是允许纯函数（如果不鼓励的话）发散。也就是说，对它的每次调用都被
MVar
阻止。另一种方法可能是允许同一操作多次运行。然后我将使用
IORef
和
atomicModifyIORef
。实际上，这是语义上合理的方法。如果您被包括在内，您总是可以在结果周围放置一个
unsafePerformIO
。好吧，您的实现似乎序列化了IO函数调用，即使
缓存
包装的函数是从不同的线程并发调用的。你如何使它非序列化，但不允许多次运行“相同”操作？@hvr，哦，我明白你为什么说黑洞了。因此，您只希望在已对同一个键求值时进行阻止。我认为，每个输入值都必须有一个锁，因此您的状态看起来像
Map.Map InputType（MVar OutputType）
，其中
MVar
如果当前正在计算，则为空；如果不是，则该条目不在映射中。然后您应该使用
MVar
来存储该地图，这样您就不会得到比赛条件。基本上——所有常见的并发编程垃圾<代码>IO

表示命令式编程。你只是尽量减少它的范围。非常好！你预见到用HashMap替换Data.Map会有什么问题吗？@circular Ruint，想不出任何等待：如果我使用thunk作为输入通过调用记忆函数会发生什么？AFAICS全局MVar（保护整个表的MVar，而不是保护单个值的小MVar）将在整个时间内保持，以将thunk解析为不规则的东西，从而在表中找到它的位置。这是否会阻止所有其他线程使用memo表，破坏您所追求的“无不必要的锁”理念？啊，但我想您可能不会介意，因为在您的应用程序中，您愿意或多或少地将任何纯计算（即非IO monad操作）视为“便宜”：-），我认为表上的查找/更新操作相当便宜，因此高效的

HashMap

应该更适合大型缓存；在进入当前的静音查找之前，可以先添加一个快速路径查找try w/o锁定作为第一次尝试，否则可能会导致不正确的竞争条件——但我不知道执行上面的

modifyMVar

调用的成本有多高。。。它确实应该在12月份之前进行基准测试

import           Control.Concurrent
import           Control.Exception
import           Data.Either
import           Data.Map           (Map)
import qualified Data.Map           as Map
import           Prelude            hiding (catch)

-- |Memoizing wrapper for 'IO' actions
memoizeIO :: Ord a => (a -> IO b) -> IO (a -> IO b)
memoizeIO action = do
  cache <- newMVar Map.empty
  return $ memolup cache action

  where
    -- Lookup helper
    memolup :: Ord a => MVar (Map a (Async b)) -> (a -> IO b) -> a -> IO b
    memolup cache action' args = wait' =<< modifyMVar cache lup
      where
        lup tab = case Map.lookup args tab of
          Just ares' ->
            return (tab, ares')
          Nothing    -> do
            ares' <- async $ action' args
            return (Map.insert args ares' tab, ares')

-- |Opaque type representing asynchronous results.
data Async a = Async ThreadId (MVar (Either SomeException a))

-- |Construct 'Async' result. Can be waited on with 'wait'.
async :: IO a -> IO (Async a)
async io = do
  var <- newEmptyMVar
  tid <- forkIO ((do r <- io; putMVar var (Right r))
                 `catch` \e -> putMVar var (Left e))
  return $ Async tid var

-- |Extract value from asynchronous result. May block if result is not
-- available yet. Exceptions are returned as 'Left' values.
wait :: Async a -> IO (Either SomeException a)
wait (Async _ m) = readMVar m

-- |Version of 'wait' that raises exception.
wait' :: Async a -> IO a
wait' a = either throw return =<< wait a

-- |Cancels asynchronous computation if not yet completed (non-blocking).
cancel :: Async a -> IO ()
cancel (Async t _) = throwTo t ThreadKilled