Реентеративное кэширование «референтно прозрачных» вызовов ввода-вывода - PullRequest
Новая
       19

Реентеративное кэширование «референтно прозрачных» вызовов ввода-вывода

6 голосов
/ 30 марта 2011

Предположим, у нас есть действие ввода-вывода, такое как 

lookupStuff :: InputType -> IO OutputType

, которое может быть чем-то простым, например, поиск DNS или какой-либо вызов веб-службы для данных, не зависящих от времени.

Давайтепредположим, что:

  1. Операция никогда не выдает никаких исключений и / или никогда не расходится

  2. Если это не было для монады IO,функция была бы чистой, то есть результат всегда одинаков для равных входных параметров

  3. Действие является реентерабельным, то есть его можно безопасно вызывать из нескольких потоков одновременно.

  4. Операция lookupStuff довольно дорогая (*).

Проблема, с которой я сталкиваюсь, заключается в том, как правильно (и безиспользуя любой unsafe*IO* чит), реализуйте реентрантный кеш, который можно вызывать из нескольких потоков, и объединяет несколько запросов для одних и тех же входных параметров в один запрос.

Я думаю, что после чего-то похожегоКонцепция черной дыры GHC для чистых вычислений, но в расчетах IOon "context.

Каково идиоматическое решение Haskell / GHC для указанной проблемы?

Ответы [ 2 ]

4 голосов
/ 30 марта 2011

Да, в основном переопределить логику.Хотя это похоже на то, что GHC уже делает, это выбор GHC.Haskell может быть реализован на виртуальных машинах, которые работают совсем по-другому, поэтому в этом смысле это еще не сделано для вас.

Но да, просто используйте MVar (Map InputType OutputType) или даже IORef (Map InputType OutputType) (не забудьте изменитьс atomicModifyIORef), и просто храните кеш там.Если это императивное решение кажется неправильным, это ограничение «если бы не IO, эта функция была бы чистой».Если бы это было просто произвольное действие IO, то идея о том, что вам нужно было бы сохранять состояние, чтобы знать, что выполнять или нет, кажется совершенно естественной.Проблема в том, что у Haskell нет типа для «чистого ввода-вывода» (который, если он зависит от базы данных, просто ведет себя чисто при определенных условиях, что не то же самое, что наследственно чистый). 

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

Да, уродливо внутри.Но снаружи посмотри на это!Это похоже на функцию чистой памяти, за исключением того, что на ней есть IO.

2 голосов
/ 21 июня 2011

Вот некоторый код, реализующий более или менее то, что я использовал в моем первоначальном вопросе: 

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

Приведенный выше код основан на абстракции Async Саймона Марлоу, как описано в Учебное пособие: параллельное и параллельное программирование в 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
...