Hi, i used forkIO to write a 'por' (parallel or) implementation
(just a proof of concept), arguments are evaluated in different
threads and as soon as one of the threads returns true the other
thread is killed and true is returned.
If both threads return false the result of the computation is false.
I have been doing a few tests and looks like that in some cases
the function that do not terminate (that i used to test the por
correctness) seam not be preempted, and thus the program do not
terminate.
The very strange thing is that the program (that i am attaching)
works as expected if it is compiled with -O, but hangs if compiled
without optimization!
Any idea?
Thanks
--
Ciao
Maurizio
"Well we all shine on
Like the moon and the stars and the sun" (John Lennon)
--
-- Compile with (with or without -O):
-- ghc -fglasgow-exts -o por por.hs
--
import System.IO
import System.IO.Unsafe
import System.Environment
import Control.Concurrent
import Control.Monad
import Control.Monad.Fix
import Data.IORef
-- A utility function (not in the Prelude?)
untupM :: Monad m => (m a, m b) -> m (a, b)
untupM (ma,mb) = do
a <- ma
b <- mb
return (a,b)
-- The code that will evaluate one bool expression, dummy way
thread1 :: Bool -> IORef (Bool, Bool) -> IO ()
thread1 bcomp ref = do
putStr " Starting Computation...\n"
result <- return $! bcomp
writeIORef ref (True, result)
putStr " Computation Done!\n"
return ()
-- Parallel OR implementation, dummy way
por1 :: Bool -> Bool -> IO Bool
por1 b1 b2 = mdo
r1 <- newIORef (False,False)
r2 <- newIORef (False,False)
t1 <- forkIO (thread1 b1 r1)
t2 <- forkIO (thread1 b2 r2)
let poll () = do
yield
(f1,e1) <- readIORef r1
(f2,e2) <- readIORef r2
if (e1 || e2)
then if not f1
then do{ killThread t1; return True }
else if not f2
then do{ killThread t2; return True }
else return True
else if (f1 && f1)
then return (e1 || e2)
else poll ()
res <- poll ()
putStr " POR Done!\n"
return res
-- alternative por implementation, this also do not work for some misterious reason
-- The code that will evaluate one bool expression and kill the other thread, mdo way
thread2 :: Bool -> IORef (Bool, Bool) -> ThreadId -> IO ()
thread2 bcomp ref othth = do
putStr $ " Starting Computation... (oth is "++(show othth)++")\n"
result <- return $! bcomp
writeIORef ref (True, result)
if result
then killThread othth
else return ()
me <- myThreadId
putStr $ " Computation Done: "++(show result)++" ("++(show me)++")\n"
-- Parallel OR implementation, mdo way
por2 :: Bool -> Bool -> IO Bool
por2 b1 b2 = mdo
r1 <- newIORef (False,False)
r2 <- newIORef (False,False)
-- use the recursive do (mdo) to give each thread the id of the other thread
(t1,t2) <- untupM ( forkIO (thread2 b1 r1 t2), forkIO (thread2 b2 r2 t1) )
let poll () = do
yield
(f1,e1) <- readIORef r1
(f2,e2) <- readIORef r2
if e1 || e2 || (f1 && f2)
then return (e1 || e2)
else poll ()
res <- poll ()
putStr " POR Done!\n"
return res
--
-- A few functions that do not terminate
--
-- do not work
bottom1 x =
bottom1 x
-- works (even if i am doing very nasty things :)
bottom2 x =
unsafePerformIO $ do
putStr ""
return $ bottom2 x
-- do not work
bottom3 x =
case x of
True -> bottom3 True
False -> bottom3 False
-- do not work
bottom4 x =
case x of
True -> bottom3 (3==3)
False -> bottom3 (3==5)
-- do not work
bottom5a x =
bottom5b x
bottom5b x =
bottom5a x
-- bottom function to use
bottom :: Bool -> Bool
bottom = bottom1
-- Parallel OR operator
(|=|) :: Bool -> Bool -> IO Bool
(|=|) b1 b2 = por1 b1 b2
-- Parallel AND, for sake of completeness :)
(&=&) :: Bool -> Bool -> IO Bool
(&=&) b1 b2 = (liftM not) $ (not b1) |=| (not b2)
-- Main
main :: IO ()
main = do
putStr $ "Calculating b|t:\n"
pippo1 <- (bottom True) |=| True
putStr $ "-> "++(show pippo1)++"\n\n"
putStr $ "Calculating t|b:\n"
pippo2 <- True |=| (bottom True)
putStr $ "-> "++(show pippo2)++"\n\n"
putStr $ "Calculating b|b (this will always hang):\n"
pippo3 <- (bottom True) |=| (bottom True)
putStr $ "-> "++(show pippo3)++"\n\n"
_______________________________________________
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell
