Playing with capabilities.

Test.hs

module Main where

import Control.Monad
import Control.Concurrent

import Text.Printf

import Foreign.C.Types

foreign import ccall safe "getchar" c_getchar :: IO CChar

loop :: Int -> IO ()
loop x = do
  forever $ do
    tid <- myThreadId

    cap  <- fst <$> threadCapability tid
    c_getchar
    cap' <- fst <$> threadCapability tid

    when (cap /= cap') $
      printf "Thread changed capability: %d\t(%d, %d)\n" x cap cap'

{-
   $ ghc -threaded Test.hs -o Test -with-rtsopts=-N2
   $ yes | ./Test
-}
main :: IO ()
main = do
  forM_ [1..32] $
    forkIO . loop

  threadDelay (10 * 1000 * 1000)