examples/fenv-impure.hs

   1 {-
   2  - Copyright (C) 2009-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 "Data.Floating.Environment" still doesn't give us
  10 -- referential transparency if the user is not careful.  It is important that
  11 -- all non-FEnv floating point expressions are forced *before* they are used
  12 -- in a FEnv expression.
  13 {-# LANGUAGE NoImplicitPrelude #-}
  14 module Main where
  15
  16 import Data.Floating.Prelude
  17 import Data.Floating.Environment
  18
  19 -- | The largest integral value representable in an IEEE double with no
  20 -- larger non-integral value.
  21 bigDouble :: Double
  22 bigDouble = 4503599627370496
  23
  24 -- | Here be dragons!
  25 broken :: IO ()
  26 broken = let
  27         -- x and y are values formed by passing the same inputs to the same
  28         -- function, (+).  Referential transparency says that x and y are
  29         -- interchangable...
  30         (x, y) = (bigDouble + 0.5, bigDouble + 0.5)
  31     in do
  32         putStrLn $ "x = " ++ show x
  33         fenvEval (withRoundingMode Upward (seq y <$> 0)) >>= print
  34         putStrLn $ "y = " ++ show y
  35         print (x == y)
  36         --- ...but now x and y are different.
  37
  38 -- | The problem with the 'broken' function is that the argument to 'fmap',
  39 -- namely @seq y@, forces a pure floating point expression.  The easiest way
  40 -- to avoid these kind of problems is to only use such expressions as the
  41 -- argument to 'pure', which will ensure that they are forced before 'fenvEval'
  42 -- is called.  The above function could be rewritten as follows.
  43 notBroken :: IO ()
  44 notBroken = let
  45         -- x and y are values formed by passing the same inputs to the same
  46         -- function, (+).  Referential transparency says that x and y are
  47         -- interchangable...
  48         (x, y) = (bigDouble + 0.5, bigDouble + 0.5)
  49     in do
  50         putStrLn $ "x = " ++ show x
  51         fenvEval (withRoundingMode Upward (seq <$> pure y <*> 0)) >>= print
  52         putStrLn $ "y = " ++ show y
  53         print (x == y)
  54         -- ... and indeed they seem to be!
  55
  56 main :: IO ()
  57 main = do
  58     putStrLn "Non-broken behaviour:"
  59     notBroken
  60     putStrLn "\nBroken behaviour:"
  61     broken