examples/fenv-race.hs

   1 {-
   2  - Copyright (C) 2010 Nick Bowler.
   3  -
   4  - License BSD2:  2-clause BSD license.  See LICENSE for full terms.
   5  - This is free software: you are free to change and redistribute it.
   6  - There is NO WARRANTY, to the extent permitted by law.
   7  -}
   8
   9 -- | Demonstration of why the functions in "Data.Floating.Environment" are
  10 -- not safe for use concurrently with unbound threads that perform floating
  11 -- point operations.
  12
  13 {-# LANGUAGE NoImplicitPrelude #-}
  14 module Main where
  15
  16 import Data.Floating.Prelude
  17 import Data.Floating.Environment
  18 import Control.Concurrent
  19 import Control.Exception
  20
  21 theThread :: MVar () -> MVar Double -> IO ()
  22 theThread input output = do
  23     takeMVar input
  24     evaluate (1/10) >>= putMVar output
  25
  26 main :: IO ()
  27 main = do
  28     input  <- newEmptyMVar
  29     output <- newEmptyMVar
  30     forkIO $ theThread input output
  31     ref <- evaluate (1 / 10)
  32     -- This rounding mode should not be visible to the other thread.
  33     unsafeSetRoundingMode TowardZero
  34     putMVar input ()
  35     ret <- takeMVar output
  36     -- At this point, the output should equal the reference value.
  37     print $ ref == ret