<html><body style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space; ">Alright, I have tested it now. I still feel funny about most of the names I chose for the types and functions, and it's still very ugly, but the code appears to work correctly. In this version I have also added "retry" and "orElse" functions so that it can feel more like the STM monad. I think the biggest downside to this monad is the potential confusion about whether to use "could" or "must," but I have a feeling that better naming choices would reduce the ambiguity.<div><br></div><div>Thoughts?</div><div><br></div><div><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">module CachedSTM where</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">import Control.Applicative</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">import Control.Concurrent.STM as S</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">import Control.Monad</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">data CachedSTM a = CSTM {</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> getMust :: STM (),</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> getCould :: STM a</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> }</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">instance Functor CachedSTM where</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> f `fmap` (CSTM m s) = CSTM m $ f <$> s</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">joinCSTM :: CachedSTM (CachedSTM a) -> CachedSTM a</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">joinCSTM cstm = CSTM m s</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> where m = do cstm' <- getCould cstm</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> getMust cstm' `S.orElse` return ()</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> getMust cstm `S.orElse` return ()</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> s = getCould =<< getCould cstm</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">instance Applicative CachedSTM where</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> pure = return</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> (<*>) = ap</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">instance Monad CachedSTM where</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> return = CSTM (return ()) . return</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> x >>= f = joinCSTM $ f <$> x</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">maybeAtomicallyC :: CachedSTM a -> IO (Maybe a)</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">maybeAtomicallyC cstm = atomically $ do</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> getMust cstm</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> liftM Just (getCould cstm) `S.orElse` return Nothing</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">could :: STM a -> CachedSTM a</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">could stm = CSTM (return ()) stm</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">must :: STM () -> CachedSTM ()</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">must stm = CSTM (stm `S.orElse` return ()) $ return ()</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">retry :: CachedSTM a</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">retry = could S.retry</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">orElse :: CachedSTM a -> CachedSTM a -> CachedSTM a</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">orElse a b = do must $ getMust a</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> temp <- could newEmptyTMVar</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> must $ (getCould a >>= putTMVar temp) `S.orElse` getMust b</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> could $ takeTMVar temp `S.orElse` getCould b</font></blockquote><br></div><div>I don't think the IVar code has changed (no version control for this), but here it is again for quick reference:</div><div><br></div><div><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">module IVal where</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">import CachedSTM</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">import Control.Applicative</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">import Control.Concurrent.STM</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">import Control.Monad</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">import System.IO.Unsafe</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">newtype IVal a = IVal (TVar (Either (CachedSTM a) a))</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">newIVal :: CachedSTM a -> CachedSTM (IVal a)</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">newIVal = fmap IVal . could . newTVar . Left</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">newIValIO :: CachedSTM a -> IO (IVal a)</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">newIValIO = fmap IVal . newTVarIO . Left</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">cached :: CachedSTM a -> IVal a</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">cached = unsafePerformIO . newIValIO</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">force :: IVal a -> CachedSTM a</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">force (IVal tv) = could (readTVar tv) >>= either compute return</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> where compute wait = do x <- wait</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> must . writeTVar tv $ Right x</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> return x</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">instance Functor IVal where</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> f `fmap` x = cached $ f <$> force x</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">instance Applicative IVal where</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> pure = return</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> (<*>) = ap</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"><br></font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE">instance Monad IVal where</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> return = cached . return</font></blockquote><blockquote type="cite"><font class="Apple-style-span" color="#144FAE"> x >>= f = cached (force x >>= force . f)</font></blockquote><br></div><div>- Jake</div></body></html>