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. 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