[Haskell-cafe] forkM fails

Daniel Fischer daniel.is.fischer at web.de
Fri Sep 4 18:57:56 EDT 2009


Am Samstag 05 September 2009 00:06:50 schrieb Alberto G. Corona:
> Hi
>
> I need to execute a procedure not in the IO monad, but in an any monad:
>
> I defined:
>
> forkM :: Monad m=> m a ->  IO ThreadId
> forkM proc=forkIO $ proc  `seq` return()
>
> I assumed  that seq will force the evaluation of proc and after, it
> will discard his type (m a) and return () in the IO monad.as forkIO
> expect.
>
> however proc is not executed
>
> Prelude> Control.Concurrent.forkIO $ print "hola"
> ThreadId 331
> "hola"
> Prelude>
> Prelude> let forkM p=Control.Concurrent.forkIO $ p `seq` return ()
> Prelude> forkM $ print "hola"
> ThreadId 493
> Prelude>
>
> Any idea?. Thanks in advance

seq forces proc to weak head normal form, that could be e.g. a lambda.
You would have to force the value returned by proc, like

class (Monad m) => RunnableMonad m where
    runM :: m a -> a

forkM :: (RunnableMonad m) => m a -> IO ()
forkM proc = let a = runM proc in forkIO $ a `seq` return ()

(untested, might also not work)


More information about the Haskell-Cafe mailing list