I want to write a function that takes a time limit (in seconds) and a list, and computes as many elements of the list as possible within the time limit.
My first att
You can implement timeOut
with the type you gave using timeout and evaluate. It looks something like this (I've omitted the part that computes how much time is left -- use getCurrentTime
or similar for that):
timeoutPure :: Int -> a -> IO (Maybe a)
timeoutPure t a = timeout t (evaluate a)
If you want more forcing than just weak-head normal form, you can call this with an already-seq'd argument, e.g. timeoutPure (deepseq v)
instead of timeoutPure v
.
I would use two threads together with TVars and raise an exception (that causes every ongoing transaction to be rolled back) in the computation thread when the timeout has been reached:
forceIntoTVar :: (NFData a) => [a] -> TVar [a] -> IO [()]
forceIntoTVar xs v = mapM (atomically . modifyTVar v . forceCons) xs
-- | Returns function that does actual computation and cons' to tvar value
forceCons :: (NFData a) => a -> [a] -> [a]
forceCons x = (force x:)
main = do
v <- newTVarIO []
tID <- forkIO $ forceIntoTVar args v
threadDelay 200
killThread tID
readTVarIO v
In this example you (may) need to adjust forceIntoTVar a bit so that e.g. the list nodes are NOT computet inside the atomic transaction but first computed and then a atomic transaction is started to cons them onto the list.
In any case, when the exception is raised the ongoing transaction is rolled back or the ongoing computation is stopped before the result is consed to the list and that is what you want.
What you need to consider is that when the individual computations to prepare a node run with high frequency then this example is probably very costly compared to not using STM.
Here's an example I was able to cook up using some of the suggestions above. I've not done huge amounts of testing to ensure work is cut off exactly when the timer runs out, but based on the docs for timeout, this should work for all things not using FFI.
import Control.Concurrent.STM
import Control.DeepSeq
import System.Timeout
type Time = Int
-- | Compute as many items of a list in given timeframe (microseconds)
-- This is done by running a function that computes (with `force`)
-- list items and pushed them onto a `TVar [a]`. When the requested time
-- expires, ghc will terminate the execution of `forceIntoTVar`, and we'll
-- return what has been pushed onto the tvar.
timeLimited :: (NFData a) => Time -> [a] -> IO [a]
timeLimited t xs = do
v <- newTVarIO []
_ <- timeout t (forceIntoTVar xs v)
readTVarIO v
-- | Force computed values into given tvar
forceIntoTVar :: (NFData a) => [a] -> TVar [a] -> IO [()]
forceIntoTVar xs v = mapM (atomically . modifyTVar v . forceCons) xs
-- | Returns function that does actual computation and cons' to tvar value
forceCons :: (NFData a) => a -> [a] -> [a]
forceCons x = (force x:)
Now let's try it on something costly:
main = do
xs <- timeLimited 100000 expensiveThing -- run for 100 milliseconds
print $ length $ xs -- how many did we get?
-- | Some high-cost computation
expensiveThing :: [Integer]
expensiveThing = sieve [2..]
where
sieve (p:xs) = p : sieve [x|x <- xs, x `mod` p > 0]
Compiled and run with time
, it seems to work (obviously there is some overhead outside the timed portion, but I'm at roughly 100ms:
$ time ./timeLimited
1234
./timeLimited 0.10s user 0.01s system 97% cpu 0.112 total
Also, something to note about this approach; since I'm enclosing the entire operation of running the computations and pushing them onto the tvar inside one call to timeout
, some time here is likely lost in creating the return structure, though I'm assuming (if your computations are costly) it won't account or much of your overall time.
Update
Now that I've had some time to think about it, due to Haskell's laziness, I'm not 100% positive the note above (about time-spent creating the return structure) is correct; either way, let me know if this is not precise enough for what you are trying to accomplish.