From bd9eee136c2362fec5acc048bc29d1157a20d7b2 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Fri, 14 Aug 1998 12:05:17 +0000
Subject: [PATCH] [project @ 1998-08-14 12:05:17 by sof] Warn if folded Int
 primops cause overflows

---
 ghc/compiler/simplCore/ConFold.lhs |   20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/simplCore/ConFold.lhs b/ghc/compiler/simplCore/ConFold.lhs
index 7c09ad1..6665911 100644
--- a/ghc/compiler/simplCore/ConFold.lhs
+++ b/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}
-- 
1.7.10.4