Merge branch 'monad-comp'

diff --git a/GHC/Event.hs b/GHC/Event.hs
index 6bb975e..7920895 100644 (file)
--- a/GHC/Event.hs
+++ b/GHC/Event.hs
@@ -8,6 +8,7 @@ module GHC.Event
 
       -- * Creation
     , new
+    , getSystemEventManager
 
       -- * Running
     , loop
@@ -37,3 +38,4 @@ module GHC.Event
     ) where
 
 import GHC.Event.Manager
+import GHC.Event.Thread (getSystemEventManager)

diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index dbfb14f..42bf541 100644 (file)
--- a/GHC/Event/Thread.hs
+++ b/GHC/Event/Thread.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE BangPatterns, ForeignFunctionInterface, NoImplicitPrelude #-}
 
 module GHC.Event.Thread
-    (
-      ensureIOManagerIsRunning
+    ( getSystemEventManager
+    , ensureIOManagerIsRunning
     , threadWaitRead
     , threadWaitWrite
     , closeFdWith
@@ -36,7 +36,7 @@ import System.Posix.Types (Fd)
 -- run /earlier/ than specified.
 threadDelay :: Int -> IO ()
 threadDelay usecs = mask_ $ do
-  Just mgr <- readIORef eventManager
+  Just mgr <- getSystemEventManager
   m <- newEmptyMVar
   reg <- registerTimeout mgr usecs (putMVar m ())
   takeMVar m `onException` M.unregisterTimeout mgr reg
@@ -47,7 +47,7 @@ threadDelay usecs = mask_ $ do
 registerDelay :: Int -> IO (TVar Bool)
 registerDelay usecs = do
   t <- atomically $ newTVar False
-  Just mgr <- readIORef eventManager
+  Just mgr <- getSystemEventManager
   _ <- registerTimeout mgr usecs . atomically $ writeTVar t True
   return t
 
@@ -80,19 +80,26 @@ closeFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.
             -> Fd                   -- ^ File descriptor to close.
             -> IO ()
 closeFdWith close fd = do
-  Just mgr <- readIORef eventManager
+  Just mgr <- getSystemEventManager
   M.closeFd mgr close fd
 
 threadWait :: Event -> Fd -> IO ()
 threadWait evt fd = mask_ $ do
   m <- newEmptyMVar
-  Just mgr <- readIORef eventManager
+  Just mgr <- getSystemEventManager
   reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt
   evt' <- takeMVar m `onException` unregisterFd_ mgr reg
   if evt' `eventIs` evtClose
     then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing
     else return ()
 
+-- | Retrieve the system event manager.
+--
+-- This function always returns 'Just' the system event manager when using the
+-- threaded RTS and 'Nothing' otherwise.
+getSystemEventManager :: IO (Maybe EventManager)
+getSystemEventManager = readIORef eventManager
+
 foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"
     getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)
 

diff --git a/GHC/Int.hs b/GHC/Int.hs
index 05d10c5..7a42bb3 100644 (file)
--- a/GHC/Int.hs
+++ b/GHC/Int.hs
@@ -88,28 +88,28 @@ instance Enum Int8 where
 instance Integral Int8 where
     quot    x@(I8# x#) y@(I8# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I8# (narrow8Int# (x# `quotInt#` y#))
     rem     x@(I8# x#) y@(I8# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I8# (narrow8Int# (x# `remInt#` y#))
     div     x@(I8# x#) y@(I8# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I8# (narrow8Int# (x# `divInt#` y#))
     mod     x@(I8# x#) y@(I8# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I8# (narrow8Int# (x# `modInt#` y#))
     quotRem x@(I8# x#) y@(I8# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I8# (narrow8Int# (x# `quotInt#` y#)),
                                        I8# (narrow8Int# (x# `remInt#` y#)))
     divMod  x@(I8# x#) y@(I8# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I8# (narrow8Int# (x# `divInt#` y#)),
                                        I8# (narrow8Int# (x# `modInt#` y#)))
     toInteger (I8# x#)               = smallInteger x#
@@ -230,28 +230,28 @@ instance Enum Int16 where
 instance Integral Int16 where
     quot    x@(I16# x#) y@(I16# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I16# (narrow16Int# (x# `quotInt#` y#))
     rem     x@(I16# x#) y@(I16# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I16# (narrow16Int# (x# `remInt#` y#))
     div     x@(I16# x#) y@(I16# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I16# (narrow16Int# (x# `divInt#` y#))
     mod     x@(I16# x#) y@(I16# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I16# (narrow16Int# (x# `modInt#` y#))
     quotRem x@(I16# x#) y@(I16# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I16# (narrow16Int# (x# `quotInt#` y#)),
                                         I16# (narrow16Int# (x# `remInt#` y#)))
     divMod  x@(I16# x#) y@(I16# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I16# (narrow16Int# (x# `divInt#` y#)),
                                         I16# (narrow16Int# (x# `modInt#` y#)))
     toInteger (I16# x#)              = smallInteger x#
@@ -384,28 +384,28 @@ instance Enum Int32 where
 instance Integral Int32 where
     quot    x@(I32# x#) y@(I32# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I32# (x# `quotInt32#` y#)
     rem     x@(I32# x#) y@(I32# y#)
         | y == 0                  = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise               = I32# (x# `remInt32#` y#)
     div     x@(I32# x#) y@(I32# y#)
         | y == 0                  = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise               = I32# (x# `divInt32#` y#)
     mod     x@(I32# x#) y@(I32# y#)
         | y == 0                  = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise               = I32# (x# `modInt32#` y#)
     quotRem x@(I32# x#) y@(I32# y#)
         | y == 0                  = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise               = (I32# (x# `quotInt32#` y#),
                                      I32# (x# `remInt32#` y#))
     divMod  x@(I32# x#) y@(I32# y#)
         | y == 0                  = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise               = (I32# (x# `divInt32#` y#),
                                      I32# (x# `modInt32#` y#))
     toInteger x@(I32# x#)
@@ -513,28 +513,28 @@ instance Enum Int32 where
 instance Integral Int32 where
     quot    x@(I32# x#) y@(I32# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I32# (narrow32Int# (x# `quotInt#` y#))
     rem     x@(I32# x#) y@(I32# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I32# (narrow32Int# (x# `remInt#` y#))
     div     x@(I32# x#) y@(I32# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I32# (narrow32Int# (x# `divInt#` y#))
     mod     x@(I32# x#) y@(I32# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I32# (narrow32Int# (x# `modInt#` y#))
     quotRem x@(I32# x#) y@(I32# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I32# (narrow32Int# (x# `quotInt#` y#)),
                                      I32# (narrow32Int# (x# `remInt#` y#)))
     divMod  x@(I32# x#) y@(I32# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I32# (narrow32Int# (x# `divInt#` y#)),
                                      I32# (narrow32Int# (x# `modInt#` y#)))
     toInteger (I32# x#)              = smallInteger x#
@@ -672,28 +672,28 @@ instance Enum Int64 where
 instance Integral Int64 where
     quot    x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I64# (x# `quotInt64#` y#)
     rem     x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I64# (x# `remInt64#` y#)
     div     x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I64# (x# `divInt64#` y#)
     mod     x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I64# (x# `modInt64#` y#)
     quotRem x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I64# (x# `quotInt64#` y#),
                                         I64# (x# `remInt64#` y#))
     divMod  x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I64# (x# `divInt64#` y#),
                                         I64# (x# `modInt64#` y#))
     toInteger (I64# x)               = int64ToInteger x
@@ -805,27 +805,27 @@ instance Enum Int64 where
 instance Integral Int64 where
     quot    x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I64# (x# `quotInt#` y#)
     rem     x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I64# (x# `remInt#` y#)
     div     x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I64# (x# `divInt#` y#)
     mod     x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = I64# (x# `modInt#` y#)
     quotRem x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#))
     divMod  x@(I64# x#) y@(I64# y#)
         | y == 0                     = divZeroError
-        | x == minBound && y == (-1) = overflowError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
         | otherwise                  = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#))
     toInteger (I64# x#)              = smallInteger x#
 
@@ -907,3 +907,128 @@ instance Ix Int64 where
     range (m,n)         = [m..n]
     unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
     inRange (m,n) i     = m <= i && i <= n
+
+{-
+Note [Order of tests]
+
+Suppose we had a definition like:
+
+    quot x y
+     | y == 0                     = divZeroError
+     | x == minBound && y == (-1) = overflowError
+     | otherwise                  = x `primQuot` y
+
+Note in particular that the
+    x == minBound
+test comes before the
+    y == (-1)
+test.
+
+this expands to something like:
+
+    case y of
+    0 -> divZeroError
+    _ -> case x of
+         -9223372036854775808 ->
+             case y of
+             -1 -> overflowError
+             _ -> x `primQuot` y
+         _ -> x `primQuot` y
+
+Now if we have the call (x `quot` 2), and quot gets inlined, then we get:
+
+    case 2 of
+    0 -> divZeroError
+    _ -> case x of
+         -9223372036854775808 ->
+             case 2 of
+             -1 -> overflowError
+             _ -> x `primQuot` 2
+         _ -> x `primQuot` 2
+
+which simplifies to:
+
+    case x of
+    -9223372036854775808 -> x `primQuot` 2
+    _                    -> x `primQuot` 2
+
+Now we have a case with two identical branches, which would be
+eliminated (assuming it doesn't affect strictness, which it doesn't in
+this case), leaving the desired:
+
+    x `primQuot` 2
+
+except in the minBound branch we know what x is, and GHC cleverly does
+the division at compile time, giving:
+
+    case x of
+    -9223372036854775808 -> -4611686018427387904
+    _                    -> x `primQuot` 2
+
+So instead we use a definition like:
+
+    quot x y
+     | y == 0                     = divZeroError
+     | y == (-1) && x == minBound = overflowError
+     | otherwise                  = x `primQuot` y
+
+which gives us:
+
+    case y of
+    0 -> divZeroError
+    -1 ->
+        case x of
+        -9223372036854775808 -> overflowError
+        _ -> x `primQuot` y
+    _ -> x `primQuot` y
+
+for which our call (x `quot` 2) expands to:
+
+    case 2 of
+    0 -> divZeroError
+    -1 ->
+        case x of
+        -9223372036854775808 -> overflowError
+        _ -> x `primQuot` 2
+    _ -> x `primQuot` 2
+
+which simplifies to:
+
+    x `primQuot` 2
+
+as required.
+
+
+
+But we now have the same problem with a constant numerator: the call
+(2 `quot` y) expands to
+
+    case y of
+    0 -> divZeroError
+    -1 ->
+        case 2 of
+        -9223372036854775808 -> overflowError
+        _ -> 2 `primQuot` y
+    _ -> 2 `primQuot` y
+
+which simplifies to:
+
+    case y of
+    0 -> divZeroError
+    -1 -> 2 `primQuot` y
+    _ -> 2 `primQuot` y
+
+which simplifies to:
+
+    case y of
+    0 -> divZeroError
+    -1 -> -2
+    _ -> 2 `primQuot` y
+
+
+However, constant denominators are more common than constant numerators,
+so the
+    y == (-1) && x == minBound
+order gives us better code in the common case.
+-}
+

diff --git a/GHC/Real.lhs b/GHC/Real.lhs
index be2a296..17d0452 100644 (file)
--- a/GHC/Real.lhs
+++ b/GHC/Real.lhs
@@ -245,32 +245,38 @@ instance  Integral Int  where
 
     a `quot` b
      | b == 0                     = divZeroError
-     | a == minBound && b == (-1) = overflowError
+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
+                                                  -- in GHC.Int
      | otherwise                  =  a `quotInt` b
 
     a `rem` b
      | b == 0                     = divZeroError
-     | a == minBound && b == (-1) = overflowError
+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
+                                                  -- in GHC.Int
      | otherwise                  =  a `remInt` b
 
     a `div` b
      | b == 0                     = divZeroError
-     | a == minBound && b == (-1) = overflowError
+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
+                                                  -- in GHC.Int
      | otherwise                  =  a `divInt` b
 
     a `mod` b
      | b == 0                     = divZeroError
-     | a == minBound && b == (-1) = overflowError
+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
+                                                  -- in GHC.Int
      | otherwise                  =  a `modInt` b
 
     a `quotRem` b
      | b == 0                     = divZeroError
-     | a == minBound && b == (-1) = overflowError
+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
+                                                  -- in GHC.Int
      | otherwise                  =  a `quotRemInt` b
 
     a `divMod` b
      | b == 0                     = divZeroError
-     | a == minBound && b == (-1) = overflowError
+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
+                                                  -- in GHC.Int
      | otherwise                  =  a `divModInt` b
 \end{code}