blob: 5534646c76e3a232a4165cf4d5fba98571f0d987 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
{-# OPTIONS_GHC -cpp #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
import Control.Concurrent
haskellFun :: Int -> IO ()
haskellFun c = putStrLn ("Haskell: " ++ show c)
foreign export ccall "hFun" haskellFun :: Int -> IO ()
foreign import ccall safe "hFun" hFun :: Int -> IO ()
#if defined(mingw32_HOST_OS)
foreign import stdcall safe "Sleep" _sleepBlock :: Int -> IO ()
sleepBlock n = _sleepBlock (n*1000)
#else
foreign import ccall safe "sleep" sleepBlock :: Int -> IO ()
#endif
main :: IO ()
main = do
th <- newEmptyMVar
forkIO $ do
putStrLn "newThread started"
sleepBlock 2
putStrLn "newThread back again"
putMVar th "2 secs later"
threadDelay 500000 >> putStrLn "mainThread"
-- this will not be blocked in the threaded RTS
forkIO $ (hFun 2)
-- neither will this
x <- takeMVar th
putStrLn x
putStrLn "\nshutting down"
|
