Here is a slightly nicer version using the Codensity monad of STM. Thanks go to Andrea Vezzosi for figuring out an annoying hanging bug I was having.
-Edward Kmett {-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving, DeriveFunctor #-}module STMOracle ( Oracle, Ref , newRef, readRef, writeRef, modifyRef, needRef ) whereimport Control.Applicativeimport Control.Monadimport Control.Concurrent.STMinstance Applicative STM where pure = return (<*>) = apnewtype Ref s a = Ref (TVar (Maybe a))newtype Oracle s a = Oracle { unOracle :: forall r. (a -> STM r) -> STM r } deriving (Functor)instance Monad (Oracle s) where return x = Oracle (\k -> k x) Oracle m >>= f = Oracle (\k -> m (\a -> unOracle (f a) k))mkOracle m = Oracle (m >>=)runOracle :: (forall s. Oracle s a) -> IO arunOracle t = atomically (unOracle t return)newRef :: a -> Oracle s (Ref s a)newRef a = mkOracle $ Ref <$> newTVar (Just a)readRef :: Ref s a -> Oracle s areadRef (Ref r) = mkOracle $ do m <- readTVar r maybe retry return mwriteRef :: a -> Ref s a -> Oracle s awriteRef a (Ref r) = mkOracle $ do writeTVar r (Just a) return amodifyRef :: (a -> a) -> Ref s a -> Oracle s amodifyRef f r = do a <- readRef r writeRef (f a) rneedRef :: Ref s a -> Oracle s BoolneedRef (Ref slot) = Oracle $ \k -> (writeTVar slot Nothing >> k False) `orElse` k True-- test case: refMaybe b dflt ref = if b then readRef ref else return dfltrefIgnore ref = return "blablabla"refFst ref = fst `fmap` readRef reftest = do a <- newRef "x" b <- newRef 1 c <- newRef ('z', Just 0) -- no performLocalGC required x <- needRef a y <- needRef b z <- needRef c u <- refMaybe y "t" a -- note that it wouldn't actually read "a", -- but it won't be known until runtime. w <- refIgnore b v <- refFst c return (x, y, z) On Wed, Jan 6, 2010 at 10:28 PM, Edward Kmett <ekm...@gmail.com> wrote: > I don't believe you can get quite the semantics you want. However, you can > get reasonably close, by building a manual store and backtracking. > > {-# LANGUAGE Rank2Types #-} > -- lets define an Oracle that tracks whether or not you might need the > reference, by backtracking. > module Oracle > ( Oracle, Ref > , newRef, readRef, writeRef, modifyRef, needRef > ) where > > import Control.Applicative > import Control.Arrow (first) > import Control.Monad > import Data.IntMap (IntMap) > import qualified Data.IntMap as M > import Unsafe.Coerce (unsafeCoerce) > import GHC.Prim (Any) > > -- we need to track our own worlds, otherwise we'd have to build over ST, > change optimistically, and track how to backtrack the state of the Store. > Much uglier. > -- values are stored as 'Any's for safety, see GHC.Prim for a discussion on > the hazards of risking the storage of function types using unsafeCoerce as > anything else. > data World s = World { store :: !(IntMap Any), hwm :: !Int } > > -- references into our store > newtype Ref s a = Ref Int deriving (Eq) > > -- our monad that can 'see the future' ~ StateT (World s) [] > newtype Oracle s a = Oracle { unOracle :: World s -> [(a, World s)] } > > -- we rely on the fact that the list is always non-empty for any oracle you > can run. we are only allowed to backtrack if we thought we wouldn't need the > reference, and wound up needing it, so head will always succeed. > runOracle :: (forall s. Oracle s a) -> a > runOracle f = fst $ head $ unOracle f $ World M.empty 1 > > > instance Monad (Oracle s) where > return a = Oracle $ \w -> [(a,w)] > Oracle m >>= k = Oracle $ \s -> do > (a,s') <- m s > unOracle (k a) s' > > -- note: you cannot safely define fail here without risking a crash in > runOracle > -- Similarly, we're not a MonadPlus instance because we always want to > succeed eventually. > > instance Functor (Oracle s) where > fmap f (Oracle g) = Oracle $ \w -> first f <$> g w > > instance Applicative (Oracle s) where > pure = return > (<*>) = ap > > -- new ref allocates a fresh slot and inserts the value into the store. the > type level brand 's' keeps us safe, and we don't export the Ref constructor. > newRef :: a -> Oracle s (Ref s a) > newRef a = Oracle $ \(World w t) -> > [(Ref t, World (M.insert t (unsafeCoerce a) w) (t + 1))] > > -- readRef is the only thing that ever backtracks, if we try to read a > reference we claimed we wouldn't need, then we backtrack to when we decided > we didn't need the reference, and continue with its value. > readRef :: Ref s a -> Oracle s a > readRef (Ref slot) = Oracle $ \world -> > maybe [] (\a -> [(unsafeCoerce a, world)]) $ M.lookup slot (store > world) > > -- note, writeRef dfoesn't 'need' the ref's current value, so needRef will > report False if you writeRef before you read it after this. > writeRef :: a -> Ref s a -> Oracle s a > writeRef a (Ref slot) = Oracle $ \world -> > [(a, world { store = M.insert slot (unsafeCoerce a) $ store world > })] > > {- > -- alternate writeRef where writing 'needs' the ref. > writeRef :: a -> Ref s a -> Oracle s a > writeRef a (Ref slot) = Oracle $ \World store v -> do > (Just _, store') <- return $ updateLookupWithKey replace slot store > [(a, World store' v)] > where > replace _ _ = Just (unsafeCoerce a) > -} > > -- modifying a reference of course needs its current value. > modifyRef :: (a -> a) -> Ref s a -> Oracle s a > modifyRef f r = do > a <- readRef r > writeRef (f a) r > > -- needRef tries to continue executing the world without the element in the > store in question. if that fails, then we'll backtrack to here, and try > again with the original world, and report that the element was in fact > needed. > needRef :: Ref s a -> Oracle s Bool > needRef (Ref slot) = Oracle $ \world -> > [ (False, world { store = M.delete slot $ store world }) > , (True, world) > ] > > -- test case: > refMaybe b dflt ref = if b then readRef ref else return dflt > refIgnore ref = return "blablabla" > refFst ref = fst <$> readRef ref > test = do > a <- newRef "x" > b <- newRef 1 > c <- newRef ('z', Just 0) > -- no performLocalGC required > x <- needRef a > y <- needRef b > z <- needRef c > u <- refMaybe y "t" a -- note that it wouldn't actually read "a", > -- but it won't be known until runtime. > w <- refIgnore b > v <- refFst c > return (x, y, z) > > -- This will disagree with your desired answer, returning: > > *Oracle> runOracle test > Loading package syb ... linking ... done. > Loading package array-0.2.0.0 ... linking ... done. > Loading package containers-0.2.0.1 ... linking ... done. > (False,False,True) > > rather than (True, False, True), because the oracle is able to see into the > future (via backtracking) to see that refMaybe doesn't use the reference > after all. > > This probably won't suit your needs, but it was a fun little exercise. > > -Edward Kmett > > On Wed, Jan 6, 2010 at 4:05 PM, Miguel Mitrofanov > <miguelim...@yandex.ru>wrote: > >> >> On 6 Jan 2010, at 23:21, Edward Kmett wrote: >> >> You probably just want to hold onto weak references for your >>> 'isStillNeeded' checks. >>> >> >> That's what I do now. But I want to minimize the network traffic, so I >> want referenced values to be garbage collected as soon as possible - and I >> couldn't find anything except System.Mem.performIO to do the job - which is >> a bit too global for me. >> >> Otherwise the isStillNeeded check itself will keep you from garbage >>> collecting! >>> >> >> Not necessary. What I'm imagining is that there is essentially only one >> way to access the value stored in the reference - with readRef. So, if there >> isn't any chance that readRef would be called, the value can be garbage >> collected; "isStillNeeded" function only needs the reference, not the value. >> >> Well, yeah, that's kinda like weak references. >> >> >> http://cvs.haskell.org/Hugs/pages/libraries/base/System-Mem-Weak.html >>> >>> -Edward Kmett >>> >>> On Wed, Jan 6, 2010 at 9:39 AM, Miguel Mitrofanov <miguelim...@yandex.ru> >>> wrote: >>> I'll take a look at them. >>> >>> I want something like this: >>> >>> refMaybe b dflt ref = if b then readRef ref else return dflt >>> refIgnore ref = return "blablabla" >>> refFst ref = >>> do >>> (v, w) <- readRef ref >>> return v >>> test = >>> do >>> a <- newRef "x" >>> b <- newRef 1 >>> c <- newRef ('z', Just 0) >>> performLocalGC -- if necessary >>> x <- isStillNeeded a >>> y <- isStillNeeded b >>> z <- isStillNeeded c >>> u <- refMaybe y "t" a -- note that it wouldn't actually read "a", >>> -- but it won't be known until runtime. >>> w <- refIgnore b >>> v <- refFst c >>> return (x, y, z) >>> >>> so that "run test" returns (True, False, True). >>> >>> >>> Dan Doel wrote: >>> On Wednesday 06 January 2010 8:52:10 am Miguel Mitrofanov wrote: >>> Is there any kind of "ST" monad that allows to know if some STRef is no >>> longer needed? >>> >>> The problem is, I want to send some data to an external storage over a >>> network and get it back later, but I don't want to send unnecessary >>> data. >>> >>> I've managed to do something like that with weak pointers, >>> System.Mem.performGC and unsafePerformIO, but it seems to me that >>> invoking >>> GC every time is an overkill. >>> >>> Oh, and I'm ready to trade the purity of runST for that, if necessary. >>> >>> You may be able to use something like Oleg's Lightweight Monadic Regions >>> to get this effect. I suppose it depends somewhat on what qualifies a >>> reference as "no longer needed". >>> >>> http://www.cs.rutgers.edu/~ccshan/capability/region-io.pdf >>> >>> I'm not aware of anything out-of-the-box that does what you want, though. >>> >>> -- Dan >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe@haskell.org >>> http://www.haskell.org/mailman/listinfo/haskell-cafe >>> >>> >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe@haskell.org >>> http://www.haskell.org/mailman/listinfo/haskell-cafe >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe@haskell.org >>> http://www.haskell.org/mailman/listinfo/haskell-cafe >>> >> >> >
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe