Reentrante almacenamiento en caché de "referencialmente transparente" IO llama

Question

Asumamos que tenemos una acción IO como

lookupStuff :: InputType -> IO OutputType 

que podría ser algo tan simple como la búsqueda de DNS, o alguna llamada de servicio web contra un conjunto de datos invariables en el tiempo.

Vamos a suponer que:

1. La operación nunca se lanza ninguna excepción y/o nunca diverge

2. Si no fuera por la IO mónada, la función sería pura, es decir, el resultado es siempre igual para los parámetros de entrada iguales

3. La acción es reentrante, es decir, se puede invocar desde varios hilos al mismo tiempo de forma segura.

4. La operación lookupStuff es bastante (costosa).

El problema que estoy enfrentando es la manera correcta (y w/o utilizando cualquier unsafe*IO* tramposo) implementar una memoria caché de reentrada, que pueden ser llamados desde varios subprocesos, y coalesce varias consultas para los mismos parámetros de entrada- en una sola solicitud.

Supongo que estoy buscando algo similar al concepto de agujero negro de GHC para cálculos puros pero en el contexto de "cálculo" IO.

¿Cuál es la solución Haskell/GHC idiomática para el problema indicado?

Answer 1

Sí, básicamente reimplante la lógica. Aunque parece similar a lo que GHC ya está haciendo, esa es la elección de GHC. Haskell se puede implementar en máquinas virtuales que funcionan de manera muy diferente, por lo que en ese sentido no está hecho para ti.

Pero sí, solo use un MVar (Map InputType OutputType) o incluso un IORef (Map InputType OutputType) (asegúrese de modificarlo con atomicModifyIORef), y simplemente almacene el caché allí. Si esta solución imperativa parece incorrecta, es la restricción "si no fuera por el IO, esta función sería pura". Si se tratara de una acción arbitraria IO, entonces la idea de que tendrías que mantener el estado para saber qué ejecutar o no parece perfectamente natural. El problema es que Haskell no tiene un tipo para "IO puro" (que, si depende de una base de datos, simplemente se comporta puro bajo ciertas condiciones, que no es lo mismo que ser hereditariamente puro).

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 

Sí, es feo en el interior. Pero afuera, mira eso! Es como el tipo de una función de memoria pura, a excepción de que tiene IO manchado por todas partes.

Answer 2

Aquí hay un código implementando más o menos lo que yo buscaba en mi pregunta original:

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

El código anterior se basa en Async abstracción de Simon Marlow como se describe en 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