X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprelude%2FPrelRules.lhs;h=4ca4462e50230ca9c18ad236f89be3594d10a468;hb=635952097df211953c4bd0456b37eba64c485f60;hp=bc8c9b81bc48e7a04abdf59ca6c6adb0833cd6bb;hpb=c86161c5cf11de77e911fcb9e1e2bd1f8bd80b42;p=ghc-hetmet.git

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index bc8c9b8..4ca4462 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -293,7 +293,9 @@ floatOp2 _ _ _ = Nothing
 floatOp2Z :: (Rational -> Rational -> Rational) -> Literal -> Literal
           -> Maybe (Expr CoreBndr)
 floatOp2Z op (MachFloat f1) (MachFloat f2)
-  | f2 /= 0   = Just (mkFloatVal (f1 `op` f2))
+  | (f1 /= 0 || f2 > 0)  -- see Note [negative zero]
+  && f2 /= 0             -- avoid NaN and Infinity/-Infinity
+  = Just (mkFloatVal (f1 `op` f2))
 floatOp2Z _ _ _ = Nothing
 
 --------------------------
@@ -306,7 +308,13 @@ doubleOp2 _ _ _ = Nothing
 doubleOp2Z :: (Rational -> Rational -> Rational) -> Literal -> Literal
            -> Maybe (Expr CoreBndr)
 doubleOp2Z op (MachDouble f1) (MachDouble f2)
-  | f2 /= 0   = Just (mkDoubleVal (f1 `op` f2))
+  | (f1 /= 0 || f2 > 0)  -- see Note [negative zero]
+  && f2 /= 0             -- avoid NaN and Infinity/-Infinity
+  = Just (mkDoubleVal (f1 `op` f2))
+  -- Note [negative zero] Avoid (0 / -d), otherwise 0/(-1) reduces to
+  -- zero, but we might want to preserve the negative zero here which
+  -- is representable in Float/Double but not in (normalised)
+  -- Rational. (#3676) Perhaps we should generate (0 :% (-1)) instead?
 doubleOp2Z _ _ _ = Nothing