2013-04-09 5 views
5

Ich habe eine FunktionMemoizing IO Computations in Haskell

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

, die eine Eingabe und gibt einen IO-Berechnung nimmt die Ausgabe ergibt. Ich möchte f "Memoize", so dass ich diese Berechnungen nur einmal für jeden Eingang durchführen. Zum Beispiel, wenn

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

dann möchte ich eine Funktion memoize so dass

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

druckt "hello world" genau einmal und gibt ("world", "world"). Das Programm, das ich schreibe, ist Multi-Threaded, also sollte diese Eigenschaft auch dann gelten, wenn alle Threads alle aufrufen.

Unten ist die (schreckliche) Lösung, die ich bisher gefunden habe. Meine Frage ist, ob und wie es verbessert werden kann.

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 

Es gibt ein paar Dinge, die sich hier:

1) cache hat TVar (Map a (TMVar (Maybe b))) geben. Es ordnet Eingaben in TMVar zu, die entweder einen berechneten Wert enthalten, oder Nothing (was anzeigt, dass ein Wert noch nicht berechnet wurde). Die Funktion lookupInsert prüft cache und fügt eine neue TMVar ein, die auf Nothing initialisiert wurde, wenn noch keine vorhanden ist.

2) Der zurück Aktion erhält zuerst die v :: TMVar (Maybe b) zugeordnet a, dauert es dann, und führt die Berechnung entweder f a um ein Ergebnis zu erhalten, oder gibt den in dem Maybe gespeicherten Wert, wenn es verfügbar ist. Dieses take und put Muster ist so, dass zwei verschiedene Threads die Berechnung f a nicht ausführen, nachdem festgestellt wird, dass es noch nicht ausgeführt worden ist.

+0

Ich denke, Sie wollen die Werte in der Karte entweder 'TVar (Vielleicht a)' oder 'TMVar b' (was äquivalent zu' TVar (Vielleicht b) 'unter der Haube ist). Du hast zwei Ebenen der Leere, wenn es so aussieht, als würdest du nur eine brauchen. Zweitens sollten Sie alle Ihre "atomischen" Aktionen in einer einzigen Transaktion kombinieren, um Race-Bedingungen zu vermeiden. –

+0

Ich bin nicht sicher, wie man die "atomaren" Aktionen kombiniert, da wir die Berechnung 'f a' in der Mitte durchführen müssen. Letzteres existiert in der Monade "m", so scheint es, als müssten die "Take" und "Put" auf "m" gehoben werden. – davidsd

+0

Sieht ein bisschen so aus, als wärst du in der falschen Monade. – leftaroundabout

Antwort

Verwandte Themen