import GHC.Read
#ifndef __HADDOCK__
-import {-# SOURCE #-} Data.Dynamic
+import {-# SOURCE #-} GHC.Dynamic
#endif
-- ---------------------------------------------------------------------------
-}
{-# NOINLINE unsafePerformIO #-}
unsafePerformIO :: IO a -> a
-unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+unsafePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
-- Why do we NOINLINE unsafePerformIO? See the comment with
-- GHC.ST.runST. Essentially the issue is that the IO computation
-- not at all. If we let the compiler see the application of the IO
-- to realWorld#, it might float out part of the IO.
+-- Why is there a call to 'lazy' in unsafePerformIO?
+-- If we don't have it, the demand analyser discovers the following strictness
+-- for unsafePerformIO: C(U(AV))
+-- But then consider
+-- unsafePerformIO (\s -> let r = f x in
+-- case writeIORef v r s of (# s1, _ #) ->
+-- (# s1, r #)
+-- The strictness analyser will find that the binding for r is strict,
+-- (becuase of uPIO's strictness sig), and so it'll evaluate it before
+-- doing the writeIORef. This actually makes tests/lib/should_run/memo002
+-- get a deadlock!
+--
+-- Solution: don't expose the strictness of unsafePerformIO,
+-- by hiding it with 'lazy'
+
+
{-|
'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
When passed a value of type @IO a@, the 'IO' will only be performed
showsPrec _ (RecConError err) = showString err
showsPrec _ (RecUpdError err) = showString err
showsPrec _ (AssertionFailed err) = showString err
- showsPrec _ (DynException _err) = showString "unknown exception"
+ showsPrec _ (DynException err) = showString "exception :: " . showsTypeRep (dynTypeRep err)
showsPrec _ (AsyncException e) = shows e
showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
showsPrec _ (BlockedIndefinitely) = showString "thread blocked indefinitely"
-- Although 'throwIO' has a type that is an instance of the type of 'throw', the
-- two functions are subtly different:
--
--- > throw e `seq` return () ===> throw e
--- > throwIO e `seq` return () ===> return ()
+-- > throw e `seq` x ===> throw e
+-- > throwIO e `seq` x ===> x
--
-- The first example will cause the exception @e@ to be raised,
-- whereas the second one won\'t. In fact, 'throwIO' will only cause