Commit bd9eee13 authored by sof's avatar sof
Browse files

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

Warn if folded Int primops cause overflows
parent ad6863b9
......@@ -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}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment