At 9:45 PM +0400 9/4/05, Dmitry Vyal wrote:
Donald Bruce Stewart wrote:
Maybe your loop does no allocations, so the scheduler can't get in and do a
context switch. You could put the computation in an external
program, and run
it over a fork, using unix signals in the external program to kill the
computation after a period of time.
I thought about doing that, but function is closely connected with
the rest of the program. Running it in another process would require
some parsing of its arguments and I want circumvent these
difficulties.
Moreover, this function indeed allocates plenty of memory (creates
long lists), so It's just curiously for me to establish the reason
of this (mis)behavior. By the way, what does it mean precisely, "no
allocations".
This is the top part of program I have trouble with. "resolve" is
that sluggish function, which execution I'm trying to break. It hogs
a lot of memory, so context switching should occur regular.
I'm new to Haskell, so probably I've just made some really stupid mistake.
Thanks a lot for your help.
I believe you're just observing lazy evaluation at work. The IO
computation that you're forking is (return $ resolve cnf). `resolve`
is a pure function. Hence the forked computation succeeds
immediately--and the thread terminates (successfully)--without
evaluating (resolve cnf). It isn't until the case arm that begins
"Just (ans, stats) ->" that the result of (resolve cnf) is demanded
and hence evaluation of (resolve cnf) begins. But this is too late
for the timeout to have the intended effect.
How to fix? You need to demand (enough of) the result of (resolve
cnf) before returning from the IO computation. What "enough of"
means depends on how `resolve` is written. You may find the DeepSeq
module I wrote (see
http://www.mail-archive.com/[email protected]/msg15819.html)
helpful.
Dean
res_timeout=1000000 -- time quota in microseconds
forever a = a >> forever a
main :: IO ()
main = do args <- getArgs
if (length args /= 1) then usage
else do axioms <- readFile (head args)
let tree = parseInput axioms
case tree of
(Right exprs) ->
do let cnf = normalize $
concatMap to_cnf exprs
forever $ one_cycle cnf
(Left er) -> putStr $ show er
usage = putStr "usage: resolution <filename>\n"
one_cycle :: CNF -> IO ()
one_cycle base =
do inp <- getLine
let lex_tree = parseInput inp
case lex_tree of
(Right exprs) -> run_resolution $
normalize $ to_cnf (Not (head exprs))
++ base
(Left er) -> putStr $ show er
-- Here I start a heavy computation
run_resolution :: CNF -> IO ()
run_resolution cnf =
do res <- timeout res_timeout (return $ resolve cnf)
case res of
Just (ans, stats) -> do print stats
print ans
Nothing -> print "***timeout***"
-- These useful subroutines I saw in "Tackling The Awkward Squad"
par_io :: IO a -> IO a -> IO a
par_io t1 t2 = do c <- newEmptyMVar :: IO (MVar a)
id1 <- forkIO $ wrapper c t1
id2 <- forkIO $ wrapper c t2
res <- takeMVar c
killThread id1
killThread id2
return res
where wrapper :: MVar a -> IO a -> IO ()
wrapper mvar io = do res <- io
putMVar mvar res
timeout :: Int -> IO a -> IO (Maybe a)
timeout n t = do res <- par_io timer thr
return res
where thr = do res <- t
return $ Just res
timer = do threadDelay n
return Nothing
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
