[Haskell-cafe] Concurrency question

[Dmitry Vyal]

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