[project @ 1998-08-14 12:05:17 by sof]

Warn if folded Int primops cause overflows

ghc/compiler/simplCore/ConFold.lhs

@@ -23,6 +23,7 @@ import SimplUtils	( newId )
 import TysWiredIn	( trueDataCon, falseDataCon )
 
 import Char		( ord, chr )
+import Outputable
 \end{code}
 
 \begin{code}
@@ -164,9 +165,9 @@ completePrim env op args
 --  oneWordLit NotOp	    w = ??? ToDo: sort-of a pain
     oneWordLit _            _ = {-trace "oneIntLit: giving up"-} give_up
 
-    twoIntLits IntAddOp	 i1 i2		 = return_int (i1+i2)
-    twoIntLits IntSubOp	 i1 i2		 = return_int (i1-i2)
-    twoIntLits IntMulOp	 i1 i2		 = return_int (i1*i2)
+    twoIntLits IntAddOp	 i1 i2		 = checkRange (i1+i2)
+    twoIntLits IntSubOp	 i1 i2		 = checkRange (i1-i2)
+    twoIntLits IntMulOp	 i1 i2		 = checkRange (i1*i2)
     twoIntLits IntQuotOp i1 i2 | i2 /= 0 = return_int (i1 `quot` i2)
     twoIntLits IntRemOp  i1 i2 | i2 /= 0 = return_int (i1 `rem` i2)
     twoIntLits IntGtOp	 i1 i2		 = return_bool (i1 >  i2)
@@ -236,7 +237,7 @@ completePrim env op args
     twoCharLits _        _  _  = give_up
 
 	---------   Miscellaneous --------------
-    oneLit Addr2IntOp (MachAddr i) = return_int i
+    oneLit Addr2IntOp (MachAddr i) = return_int (fromInteger i)
     oneLit op         lit          = give_up
 
 	---------   Equality and inequality for Int/Char --------------
@@ -266,6 +267,17 @@ completePrim env op args
     litVar other_op lit var = give_up
 
 
+    checkRange :: Integer -> SmplM OutExpr
+    checkRange val
+     | (val > fromInt maxInt) || (val < fromInt minInt)  = 
+	-- Better tell the user that we've overflowed...
+       pprTrace "Warning:" (text "Integer overflow in expression: " <> 
+	                   ppr ((Prim op args)::CoreExpr)) $
+	-- ..not that it stops us from actually folding!
+	-- ToDo: a SrcLoc would be nice.
+       return_int val
+     | otherwise = return_int val
+
 trueVal  = Con trueDataCon  []
 falseVal = Con falseDataCon []
 \end{code}