Optimise handling of infinities

src/System/Random/Internal.hs

@@ -855,16 +855,15 @@ instance UniformRange Bool where
 instance UniformRange Double where
   uniformRM (l, h) g
     | l == h = return l
-    | isInfiniteL && isInfiniteH = return (0/0) -- NaN
-    | isInfiniteL = return l
-    | isInfiniteH = return h
+    | isInfinite l || isInfinite h =
+      -- Optimisation exploiting absorption:
+      --   (-Infinity) + (anything but +Infinity) = -Infinity
+      --   (anything but -Infinity) + (+Infinity) = +Infinity
+      --                (-Infinity) + (+Infinity) = NaN
+      return $! h + l
     | otherwise = do
       x <- uniformDouble01M g
       return $ x * l + (1 -x) * h
-    where
-      -- Optimisations
-      isInfiniteL = isInfinite l
-      isInfiniteH = isInfinite h
 
 -- | Generates uniformly distributed 'Double' in the range \([0, 1]\).
 --   Numbers are generated by generating uniform 'Word64' and dividing
@@ -896,16 +895,15 @@ uniformDoublePositive01M g = (+ d) <$> uniformDouble01M g
 instance UniformRange Float where
   uniformRM (l, h) g
     | l == h = return l
-    | isInfiniteL && isInfiniteH = return (0/0) -- NaN
-    | isInfiniteL = return l
-    | isInfiniteH = return h
+    | isInfinite l || isInfinite h =
+      -- Optimisation exploiting absorption:
+      --   (-Infinity) + (anything but +Infinity) = -Infinity
+      --   (anything but -Infinity) + (+Infinity) = +Infinity
+      --                (-Infinity) + (+Infinity) = NaN
+      return $! h + l
     | otherwise = do
       x <- uniformFloat01M g
       return $ x * l + (1 - x) * h
-    where
-      -- Optimisations
-      isInfiniteL = isInfinite l
-      isInfiniteH = isInfinite h
 
 -- | Generates uniformly distributed 'Float' in the range \([0, 1]\).
 --   Numbers are generated by generating uniform 'Word32' and dividing