Question

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

lookupStuff :: InputType -> IO OutputType

这可能是简单的事情，例如DNS查询，或针对时间不变数据的某些Web服务调用。

我们假设：

操作永远不会抛出任何异常和/或永不分歧
如果不是IO monad，则该函数将是纯函数，即对于相等的输入参数，结果总是相同
该动作是可重入的，即可以安全地从多个线程中调用它。
lookupStuff操作非常（时间）昂贵。

我面临的问题是如何正确（并且没有使用任何unsafe*IO*作弊）实现可以从多个线程调用的可重入缓存，并为相同的输入参数合并多个查询单个请求。

我想我正在采用类似于GHC的黑洞概念进行纯计算，但是在IO“计算”环境中。

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

Answer 1

是的，基本上重新实现逻辑。虽然它似乎与GHC已经在做的类似，但这是GHC的选择。 Haskell可以在工作方式非常不同的虚拟机上实现，所以从这个意义上讲，它还没有为您完成。

但是，是的，只需使用MVar (Map InputType OutputType)甚至IORef (Map InputType OutputType)（确保使用atomicModifyIORef进行修改），然后将缓存存储在那里。如果这个命令式解决方案看起来是错误的，那就是“如果不是IO，那么这个函数将是纯粹的”约束。如果它只是一个任意的IO动作，那么你必须保持状态以便知道要执行什么的想法似乎是完全自然的。问题是Haskell没有“纯IO”的类型（如果它依赖于数据库，它只是在某些条件下表现纯粹，这与遗传纯粹不同）。

import qualified Data.Map as Map
import Control.Concurrent.MVar

-- takes an IO function and returns a cached version
cache :: (Ord a) => (a -> IO b) -> IO (a -> IO b)
cache f = do
    r <- newMVar Map.empty
    return $ \x -> do
        cacheMap <- takeMVar r
        case Map.lookup x cacheMap of
            Just y -> do 
                putMVar r cacheMap
                return y
            Nothing -> do
                y <- f x
                putMVar (Map.insert x y cacheMap)
                return y

是的，内心很难看。但在外面，看看那个！它就像纯粹的memoization函数的类型，除了它有IO染色它。

Answer 2

这里有一些代码在我原来的问题中或多或少地实现了我的目标：

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')

上面的代码建立在Simon Marlow的Async抽象之上，如Tutorial: Parallel and Concurrent Programming in Haskell中所述：

-- |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

可重入缓存“引用透明”的IO调用

2 个答案: