That is kind of what I thought you were doing.<br><br>Retooling to see if we can get any better performance out of collecting, it seems that System.Mem.PerformGC does a foreign call out to performMajorGC to ask for a global collection. But I would hazard that you might be able to get most of the benefit by just asking for the nursery to be cleaned up. <br>
<br>To that end, perhaps it would be worthwhile to consider switching to something like:<br><span class="keyword"><br>foreign</span> <span class="keyword">import</span> <span class="keyword">ccall</span> <span class="comment">{-safe-}</span> <span class="str">"performGC"</span> <span class="varid">performMinorGC</span> <span class="keyglyph">::</span> <span class="conid">IO</span> <span class="conid">()</span><br>
<br>-- System.Mem imports performMajorGC as 'performGC' but the minor collection appears to be called performGC, hence the rename.<br><br>This should let you call for a minor collection, which should be considerably less time consuming. Especially as if you call it frequently you'll be dealing with a mostly cleared nursery anyways.<br>
<br>-Edward Kmett<br><br><div class="gmail_quote">On Thu, Jan 7, 2010 at 4:39 PM, Miguel Mitrofanov <span dir="ltr"><<a href="mailto:miguelimo38@yandex.ru">miguelimo38@yandex.ru</a>></span> wrote:<br><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
I liked it too. Seems like I have to show some real code, and my apologies for a long e-mail.<br>
<br>
Well, that's what I'm actually trying to do and what I've managed to achieve so far.<br>
<br>
> module Ask where<br>
> import Control.Monad<br>
> import Data.IORef<br>
> import Data.Maybe<br>
> import System.IO.Unsafe -- Yes, I would need that<br>
> import System.Mem<br>
> import System.Mem.Weak<br>
<br>
Suppose we're writing a RESTful server, which keeps all state on the client. We want it to send questions to the client and get back the answers. We can also send some state data to the client and we are sure that the client would return them back unchanged. So, that's the type of our server:<br>
<br>
> type Server medium = Maybe (medium, String) -> IO (Maybe (medium, String))<br>
<br>
The client starts interaction, sending "Nothing"; when server finally returns "Nothing", the session stops. I would emulate the client in GHCi with the following function:<br>
<br>
> client :: Show medium => Bool -> Server medium -> IO ()<br>
> client debug server = client' Nothing where<br>
> client' query =<br>
> do response <- server query<br>
> case response of<br>
> Nothing -> return ()<br>
> Just (medium, question) -><br>
> do when debug $ putStr "Debug: " >> print medium<br>
> putStrLn question<br>
> putStr "--> "<br>
> answer <- getLine<br>
> client' $ Just (medium, answer)<br>
<br>
Nothing very interesting. The only thing to note is that the boolean argument allows us to see the state sent by server - for debugging purposes.<br>
<br>
But I want something more high-level. The goal is to solve the Graham's "arc challenge". So the high-level interface is implemented by this type:<br>
<br>
> data Ask a = Finish a | Continue String (String -> Ask a)<br>
<br>
A possible application would be:<br>
<br>
> test :: Ask ()<br>
> test =<br>
> do s1 <- ask "Enter the first number"<br>
> let n1 = read s1<br>
> s2 <- ask "Enter the second number"<br>
> let n2 = read s2<br>
> ask $ show $ n1 + n2<br>
> return ()<br>
<br>
Well, to do that, I need a Monad instance for Ask:<br>
<br>
> instance Monad Ask where<br>
> return = Finish<br>
> Finish x >>= h = h x<br>
> Continue question k >>= h = Continue question $ \answer -> k answer >>= h<br>
<br>
and an "ask" function:<br>
<br>
> ask :: String -> Ask String<br>
> ask question = Continue question $ \answer -> return answer<br>
<br>
Now, the problem is with the route from high level to the low level. We can do it relatively simply:<br>
<br>
> simpleServer :: Ask () -> Server [String]<br>
> simpleServer anything = return . simpleServer' anything . maybe [] (\(medium, answer) -> medium ++ [answer]) where<br>
> simpleServer' (Finish ()) _ = Nothing<br>
> simpleServer' (Continue question _) [] = Just ([], question)<br>
> simpleServer' (Continue _ k) (s : ss) =<br>
> do (medium, question) <- simpleServer' (k s) ss<br>
> return (s : medium, question)<br>
<br>
And indeed, our test example works:<br>
<br>
*Ask> client False $ simpleServer test<br>
Enter the first number<br>
--> 3<br>
Enter the second number<br>
--> 4<br>
7<br>
--><br>
<br>
But, as you've probably guessed already, this "simpleServer" sends way too much information over network:<br>
<br>
> nonsense :: Ask ()<br>
> nonsense =<br>
> do a <- ask "?"<br>
> b <- ask a<br>
> c <- ask b<br>
> d <- ask c<br>
> e <- ask b -- Note this "b" instead of "d", it's deliberate.<br>
> return ()<br>
<br>
*Ask> client True $ simpleServer nonsense<br>
Debug: []<br>
?<br>
--> a<br>
Debug: ["a"]<br>
a<br>
--> b<br>
Debug: ["a","b"]<br>
b<br>
--> c<br>
Debug: ["a","b","c"]<br>
c<br>
--> d<br>
Debug: ["a","b","c","d"]<br>
b<br>
--> e<br>
<br>
All user answers from the very beginning get transmitted.<br>
<br>
I want to transmit only those answers that are actually used. I'm gonna write another server, a (relatively) smart one.<br>
<br>
A simple boxing type:<br>
<br>
> data Box a = Box {unBox :: a}<br>
<br>
Now, the server. I use "Nothing" for those user answers that are no longer needed.<br>
<br>
> smartServer :: Ask () -> Server [Maybe String]<br>
> smartServer anything = smartServerIO anything . maybe [] (\(medium, answer) -> medium ++ [Just answer]) where<br>
> smartServerIO anything query =<br>
<br>
Sometimes a value is not used anymore just because it WAS used already. So I'll use a mutable list to keep track of those values that are actually dereferenced:<br>
<br>
> do usedList <- newIORef []<br>
<br>
Then, I'll make weak pointers for all user answers:<br>
<br>
> let boxedQuery = map Box query<br>
> weakPtrs <- mapM (\box -> mkWeak box () Nothing) boxedQuery<br>
<br>
and actually run my "Ask" value.<br>
<br>
> case findWeakPtrs 0 anything boxedQuery usedList of<br>
> Finish () -> return Nothing<br>
> Continue question rest -><br>
<br>
Now, the interesting part. I'd invoke a garbage collector to get rid of those boxes that aren't necessary anymore.<br>
<br>
> do performGC<br>
<br>
Now, weak pointers tell me what boxes are not dereferenced but can be dereferenced in the future, and my mutable list has the numbers of boxes that were dereferenced.<br>
<br>
> danglingNumbers <- mapM deRefWeak weakPtrs<br>
> usedNumbers <- readIORef usedList<br>
<br>
I also need to keep this "future" alive, so that usable boxes don't get garbage collected.<br>
<br>
> case rest undefined of _ -> return ()<br>
<br>
And now all I need to do is to filter out those boxes that are not in any of the two lists:<br>
<br>
> return $ Just (zipWith3 (isUsed usedNumbers) [0..] danglingNumbers query, question)<br>
<br>
Helper function has an interesting detail:<br>
<br>
> findWeakPtrs _ (Finish ()) _ _ = Finish ()<br>
> findWeakPtrs _ response [] _ = response<br>
<br>
I use unsafePerformIO to track those boxes that get actually dereferenced:<br>
<br>
> findWeakPtrs n (Continue _ k) (s : ss) usedList =<br>
> findWeakPtrs (n+1) (k (unsafePerformIO $ modifyIORef usedList (n :) >> return (fromJust $ unBox s))) ss usedList<br>
<br>
A filtering function is not very interesting:<br>
<br>
> isUsed usedNumbers index Nothing _ | not (index `elem` usedNumbers) = Nothing<br>
> isUsed _ _ _ answer = answer<br>
<br>
And it works:<br>
<br>
*Ask> client True $ smartServer nonsense<br>
Debug: []<br>
?<br>
--> a<br>
Debug: [Just "a"]<br>
a<br>
--> b<br>
Debug: [Nothing,Just "b"]<br>
b<br>
--> c<br>
Debug: [Nothing,Just "b",Just "c"]<br>
c<br>
--> d<br>
Debug: [Nothing,Just "b",Nothing,Nothing]<br>
b<br>
--> e<br>
<br>
So, the problem is, I don't think calling performGC every time is a good idea. I'd like to tell explicitly what values are to be garbage collected. It doesn't seem like it's possible with current version of GHC, though.<div>
<div></div><div class="h5"><br>
<br>
On 7 Jan 2010, at 23:07, Edward Kmett wrote:<br>
<br>
<blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
Thats a shame, I was rather fond of this monad. To get that last 'True', you'll really have to rely on garbage collection to approximate reachability for you, leaving the weak reference solution the best you can hope for.<br>
<br>
-Edward Kmett<br>
<br>
On Thu, Jan 7, 2010 at 12:39 PM, Miguel Mitrofanov <<a href="mailto:miguelimo38@yandex.ru" target="_blank">miguelimo38@yandex.ru</a>> wrote:<br>
Damn. Seems like I really need (True, False, True) as a result of "test".<br>
<br>
<br>
On 7 Jan 2010, at 08:52, Miguel Mitrofanov wrote:<br>
<br>
Seems very nice. Thanks.<br>
<br>
On 7 Jan 2010, at 08:01, Edward Kmett wrote:<br>
<br>
Here is a slightly nicer version using the Codensity monad of STM.<br>
<br>
Thanks go to Andrea Vezzosi for figuring out an annoying hanging bug I was having.<br>
<br>
-Edward Kmett<br>
<br>
{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving, DeriveFunctor #-}<br>
module STMOracle<br>
( Oracle, Ref<br>
, newRef, readRef, writeRef, modifyRef, needRef<br>
) where<br>
<br>
import Control.Applicative<br>
import Control.Monad<br>
import Control.Concurrent.STM<br>
<br>
instance Applicative STM where<br>
pure = return<br>
(<*>) = ap<br>
<br>
newtype Ref s a = Ref (TVar (Maybe a))<br>
newtype Oracle s a = Oracle { unOracle :: forall r. (a -> STM r) -> STM r } deriving (Functor)<br>
<br>
instance Monad (Oracle s) where<br>
return x = Oracle (\k -> k x)<br>
Oracle m >>= f = Oracle (\k -> m (\a -> unOracle (f a) k))<br>
<br>
mkOracle m = Oracle (m >>=)<br>
<br>
runOracle :: (forall s. Oracle s a) -> IO a<br>
runOracle t = atomically (unOracle t return)<br>
<br>
newRef :: a -> Oracle s (Ref s a)<br>
newRef a = mkOracle $ Ref <$> newTVar (Just a)<br>
<br>
readRef :: Ref s a -> Oracle s a<br>
readRef (Ref r) = mkOracle $ do<br>
m <- readTVar r<br>
maybe retry return m<br>
<br>
writeRef :: a -> Ref s a -> Oracle s a<br>
writeRef a (Ref r) = mkOracle $ do<br>
writeTVar r (Just a)<br>
return a<br>
<br>
modifyRef :: (a -> a) -> Ref s a -> Oracle s a<br>
modifyRef f r = do<br>
a <- readRef r<br>
writeRef (f a) r<br>
<br>
needRef :: Ref s a -> Oracle s Bool<br>
needRef (Ref slot) = Oracle $ \k -><br>
(writeTVar slot Nothing >> k False)<br>
`orElse` k True<br>
<br>
-- test case: refMaybe b dflt ref = if b then readRef ref else return dflt<br>
refIgnore ref = return "blablabla"<br>
refFst ref = fst `fmap` readRef ref<br>
test = do<br>
a <- newRef "x"<br>
b <- newRef 1<br>
c <- newRef ('z', Just 0)<br>
-- no performLocalGC required<br>
x <- needRef a<br>
y <- needRef b<br>
z <- needRef c<br>
u <- refMaybe y "t" a -- note that it wouldn't actually read "a",<br>
-- but it won't be known until runtime.<br>
w <- refIgnore b<br>
v <- refFst c<br>
return (x, y, z)<br>
<br>
<br>
<br>
On Wed, Jan 6, 2010 at 10:28 PM, Edward Kmett <<a href="mailto:ekmett@gmail.com" target="_blank">ekmett@gmail.com</a>> wrote:<br>
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.<br>
<br>
{-# LANGUAGE Rank2Types #-}<br>
-- lets define an Oracle that tracks whether or not you might need the reference, by backtracking.<br>
module Oracle<br>
( Oracle, Ref<br>
, newRef, readRef, writeRef, modifyRef, needRef<br>
) where<br>
<br>
import Control.Applicative<br>
import Control.Arrow (first)<br>
import Control.Monad<br>
import Data.IntMap (IntMap)<br>
import qualified Data.IntMap as M<br>
import Unsafe.Coerce (unsafeCoerce)<br>
import GHC.Prim (Any)<br>
<br>
-- 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.<br>
-- 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.<br>
data World s = World { store :: !(IntMap Any), hwm :: !Int }<br>
<br>
-- references into our store<br>
newtype Ref s a = Ref Int deriving (Eq)<br>
<br>
-- our monad that can 'see the future' ~ StateT (World s) []newtype Oracle s a = Oracle { unOracle :: World s -> [(a, World s)] }<br>
<br>
-- 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.<br>
runOracle :: (forall s. Oracle s a) -> a<br>
runOracle f = fst $ head $ unOracle f $ World M.empty 1<br>
<br>
<br>
instance Monad (Oracle s) where<br>
return a = Oracle $ \w -> [(a,w)]<br>
Oracle m >>= k = Oracle $ \s -> do<br>
(a,s') <- m s<br>
unOracle (k a) s'<br>
<br>
-- note: you cannot safely define fail here without risking a crash in runOracle<br>
-- Similarly, we're not a MonadPlus instance because we always want to succeed eventually.<br>
<br>
instance Functor (Oracle s) where<br>
fmap f (Oracle g) = Oracle $ \w -> first f <$> g w<br>
<br>
instance Applicative (Oracle s) where<br>
pure = return<br>
(<*>) = ap<br>
<br>
-- 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.<br>
newRef :: a -> Oracle s (Ref s a)<br>
newRef a = Oracle $ \(World w t) -><br>
[(Ref t, World (M.insert t (unsafeCoerce a) w) (t + 1))]<br>
<br>
-- 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.<br>
readRef :: Ref s a -> Oracle s a<br>
readRef (Ref slot) = Oracle $ \world -><br>
maybe [] (\a -> [(unsafeCoerce a, world)]) $ M.lookup slot (store world)<br>
<br>
-- note, writeRef dfoesn't 'need' the ref's current value, so needRef will report False if you writeRef before you read it after this.<br>
writeRef :: a -> Ref s a -> Oracle s a<br>
writeRef a (Ref slot) = Oracle $ \world -><br>
[(a, world { store = M.insert slot (unsafeCoerce a) $ store world })]<br>
<br>
{-<br>
-- alternate writeRef where writing 'needs' the ref.<br>
writeRef :: a -> Ref s a -> Oracle s a<br>
writeRef a (Ref slot) = Oracle $ \World store v -> do<br>
(Just _, store') <- return $ updateLookupWithKey replace slot store<br>
[(a, World store' v)]<br>
where<br>
replace _ _ = Just (unsafeCoerce a)<br>
-}<br>
<br>
-- modifying a reference of course needs its current value.<br>
modifyRef :: (a -> a) -> Ref s a -> Oracle s a<br>
modifyRef f r = do<br>
a <- readRef r<br>
writeRef (f a) r<br>
<br>
-- 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.<br>
needRef :: Ref s a -> Oracle s Bool<br>
needRef (Ref slot) = Oracle $ \world -><br>
[ (False, world { store = M.delete slot $ store world })<br>
, (True, world)<br>
]<br>
<br>
-- test case:<br>
refMaybe b dflt ref = if b then readRef ref else return dflt<br>
refIgnore ref = return "blablabla"<br>
refFst ref = fst <$> readRef ref<br>
test = do<br>
a <- newRef "x"<br>
b <- newRef 1<br>
c <- newRef ('z', Just 0)<br>
-- no performLocalGC required<br>
x <- needRef a<br>
y <- needRef b<br>
z <- needRef c<br>
u <- refMaybe y "t" a -- note that it wouldn't actually read "a",<br>
-- but it won't be known until runtime.<br>
w <- refIgnore b<br>
v <- refFst c<br>
return (x, y, z)<br>
<br>
-- This will disagree with your desired answer, returning:<br>
<br>
*Oracle> runOracle test<br>
Loading package syb ... linking ... done.<br>
Loading package array-0.2.0.0 ... linking ... done.<br>
Loading package containers-0.2.0.1 ... linking ... done.<br>
(False,False,True)<br>
<br>
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.<br>
<br>
This probably won't suit your needs, but it was a fun little exercise.<br>
<br>
-Edward Kmett<br>
<br>
On Wed, Jan 6, 2010 at 4:05 PM, Miguel Mitrofanov <<a href="mailto:miguelimo38@yandex.ru" target="_blank">miguelimo38@yandex.ru</a>> wrote:<br>
<br>
On 6 Jan 2010, at 23:21, Edward Kmett wrote:<br>
<br>
You probably just want to hold onto weak references for your 'isStillNeeded' checks.<br>
<br>
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.<br>
<br>
Otherwise the isStillNeeded check itself will keep you from garbage collecting!<br>
<br>
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.<br>
<br>
Well, yeah, that's kinda like weak references.<br>
<br>
<br>
<a href="http://cvs.haskell.org/Hugs/pages/libraries/base/System-Mem-Weak.html" target="_blank">http://cvs.haskell.org/Hugs/pages/libraries/base/System-Mem-Weak.html</a><br>
<br>
-Edward Kmett<br>
<br>
On Wed, Jan 6, 2010 at 9:39 AM, Miguel Mitrofanov <<a href="mailto:miguelimo38@yandex.ru" target="_blank">miguelimo38@yandex.ru</a>> wrote:<br>
I'll take a look at them.<br>
<br>
I want something like this:<br>
<br>
refMaybe b dflt ref = if b then readRef ref else return dflt<br>
refIgnore ref = return "blablabla"<br>
refFst ref =<br>
do<br>
(v, w) <- readRef ref<br>
return v<br>
test =<br>
do<br>
a <- newRef "x"<br>
b <- newRef 1<br>
c <- newRef ('z', Just 0)<br>
performLocalGC -- if necessary<br>
x <- isStillNeeded a<br>
y <- isStillNeeded b<br>
z <- isStillNeeded c<br>
u <- refMaybe y "t" a -- note that it wouldn't actually read "a",<br>
-- but it won't be known until runtime.<br>
w <- refIgnore b<br>
v <- refFst c<br>
return (x, y, z)<br>
<br>
so that "run test" returns (True, False, True).<br>
<br>
<br>
Dan Doel wrote:<br>
On Wednesday 06 January 2010 8:52:10 am Miguel Mitrofanov wrote:<br>
Is there any kind of "ST" monad that allows to know if some STRef is no<br>
longer needed?<br>
<br>
The problem is, I want to send some data to an external storage over a<br>
network and get it back later, but I don't want to send unnecessary data.<br>
<br>
I've managed to do something like that with weak pointers,<br>
System.Mem.performGC and unsafePerformIO, but it seems to me that invoking<br>
GC every time is an overkill.<br>
<br>
Oh, and I'm ready to trade the purity of runST for that, if necessary.<br>
<br>
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".<br>
<br>
<a href="http://www.cs.rutgers.edu/%7Eccshan/capability/region-io.pdf" target="_blank">http://www.cs.rutgers.edu/~ccshan/capability/region-io.pdf</a><br>
<br>
I'm not aware of anything out-of-the-box that does what you want, though.<br>
<br>
-- Dan<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
<br>
<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
<br>
<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</blockquote>
<br>
</div></div></blockquote></div><br>