[MLton-commit] r5618
Matthew Fluet
fluet at mlton.org
Wed Jun 13 14:00:35 PDT 2007
Fixes for -const 'MLton.detectOverflow false'.
In Primitive, implemented +!, *!, ~!, and -! integer operations, which
always raise Overflow; similar to +?, *?, ~?, and ~? integer
operations, which never raise Overflow.
Use +!, *!, and -! in the IntInf implementation, in order to use
"handle Overflow => ..." when an IntInf operation on 'small' integers
needs to be promoted to compute the result as a 'large' integer.
A couple of tweaks to IntInf/Int<N> conversions when overflow checking
is disabled. Now, when MLton.detectOverflow false, the conversions
simply yield the appropriate low-bits (like IntInf.toWord<N>).
Also changed Int<N>.quot (valOf Int<N>.minInt, ~1) to yield valOf
Int<N>.minInt when MLton.detectOverflow false and MLton.safe true.
Previously, this computation could have yielded a floating-point
exception on Intel hardware; and seems to have undefined C semantics.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/num0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-int.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/top-level/infixes-overflow.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb 2007-06-13 16:38:23 UTC (rev 5617)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/build/sources.mlb 2007-06-13 21:00:33 UTC (rev 5618)
@@ -13,6 +13,7 @@
in
../primitive/primitive.mlb
../top-level/infixes.sml
+ ../top-level/infixes-overflow.sml
../top-level/infixes-unsafe.sml
../util/dynamic-wind.sig
../util/dynamic-wind.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml 2007-06-13 16:38:23 UTC (rev 5617)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf0.sml 2007-06-13 21:00:33 UTC (rev 5618)
@@ -41,19 +41,23 @@
end
val abs: int -> int
+ val +! : int * int -> int
val +? : int * int -> int
val + : int * int -> int
val divMod: int * int -> int * int
val div: int * int -> int
val gcd: int * int -> int
val mod: int * int -> int
+ val *! : int * int -> int
val *? : int * int -> int
val * : int * int -> int
+ val ~! : int -> int
val ~? : int -> int
val ~ : int -> int
val quotRem: int * int -> int * int
val quot: int * int -> int
val rem: int * int -> int
+ val -! : int * int -> int
val -? : int * int -> int
val - : int * int -> int
@@ -665,6 +669,9 @@
val castToWord8 = sextdToWord8
val castToInt8 = sextdToInt8
fun schckToWord8 i =
+ if not Primitive.Controls.detectOverflow
+ then sextdToWord8 i
+ else
case chckToWord8Aux i of
Small w => ObjptrWord.schckToWord8 w
| Big (isneg, extra, ans) =>
@@ -688,6 +695,9 @@
end
fun schckToInt8 i = IntWordConv.idFromWord8ToInt8 (schckToWord8 i)
fun zchckToWord8 i =
+ if not Primitive.Controls.detectOverflow
+ then zextdToWord8 i
+ else
case chckToWord8Aux i of
Small w => ObjptrWord.schckToWord8 w
| Big (isneg, extra, ans) =>
@@ -713,6 +723,9 @@
val castToWord16 = sextdToWord16
val castToInt16 = sextdToInt16
fun schckToWord16 i =
+ if not Primitive.Controls.detectOverflow
+ then sextdToWord16 i
+ else
case chckToWord16Aux i of
Small w => ObjptrWord.schckToWord16 w
| Big (isneg, extra, ans) =>
@@ -736,6 +749,9 @@
end
fun schckToInt16 i = IntWordConv.idFromWord16ToInt16 (schckToWord16 i)
fun zchckToWord16 i =
+ if not Primitive.Controls.detectOverflow
+ then zextdToWord16 i
+ else
case chckToWord16Aux i of
Small w => ObjptrWord.schckToWord16 w
| Big (isneg, extra, ans) =>
@@ -761,6 +777,9 @@
val castToWord32 = sextdToWord32
val castToInt32 = sextdToInt32
fun schckToWord32 i =
+ if not Primitive.Controls.detectOverflow
+ then sextdToWord32 i
+ else
case chckToWord32Aux i of
Small w => ObjptrWord.schckToWord32 w
| Big (isneg, extra, ans) =>
@@ -784,6 +803,9 @@
end
fun schckToInt32 i = IntWordConv.idFromWord32ToInt32 (schckToWord32 i)
fun zchckToWord32 i =
+ if not Primitive.Controls.detectOverflow
+ then zextdToWord32 i
+ else
case chckToWord32Aux i of
Small w => ObjptrWord.schckToWord32 w
| Big (isneg, extra, ans) =>
@@ -809,6 +831,9 @@
val castToWord64 = sextdToWord64
val castToInt64 = sextdToInt64
fun schckToWord64 i =
+ if not Primitive.Controls.detectOverflow
+ then sextdToWord64 i
+ else
case chckToWord64Aux i of
Small w => ObjptrWord.schckToWord64 w
| Big (isneg, extra, ans) =>
@@ -832,6 +857,9 @@
end
fun schckToInt64 i = IntWordConv.idFromWord64ToInt64 (schckToWord64 i)
fun zchckToWord64 i =
+ if not Primitive.Controls.detectOverflow
+ then zextdToWord64 i
+ else
case chckToWord64Aux i of
Small w => ObjptrWord.schckToWord64 w
| Big (isneg, extra, ans) =>
@@ -920,9 +948,9 @@
| SOME i => i
end
in
- val bigAdd = make (I.+, Prim.+, S.max, 1)
- val bigSub = make (I.-, Prim.-, S.max, 1)
- val bigMul = make (I.*, Prim.*, S.+, 0)
+ val bigAdd = make (I.+!, Prim.+, S.max, 1)
+ val bigSub = make (I.-!, Prim.-, S.max, 1)
+ val bigMul = make (I.*!, Prim.*, S.+, 0)
end
fun bigNeg (arg: bigInt): bigInt =
@@ -1248,19 +1276,23 @@
end
val abs = bigAbs
+ val op +! = bigAdd
val op +? = bigAdd
val op + = bigAdd
val divMod = bigDivMod
val op div = bigDiv
val gcd = bigGcd
val op mod = bigMod
+ val op *! = bigMul
val op *? = bigMul
val op * = bigMul
+ val op ~! = bigNeg
val op ~? = bigNeg
val op ~ = bigNeg
val quotRem = bigQuotRem
val quot = bigQuot
val rem = bigRem
+ val op -! = bigSub
val op -? = bigSub
val op - = bigSub
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/num0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/num0.sml 2007-06-13 16:38:23 UTC (rev 5617)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/num0.sml 2007-06-13 21:00:33 UTC (rev 5618)
@@ -160,9 +160,12 @@
if Primitive.Controls.safe
andalso y = zero
then raise Div
- else if Primitive.Controls.detectOverflow
+ else if (Primitive.Controls.detectOverflow
+ orelse Primitive.Controls.safe)
andalso x = minInt' andalso y = ~one
- then raise Overflow
+ then if Primitive.Controls.detectOverflow
+ then raise Overflow
+ else minInt'
else quotUnsafe (x, y)
fun rem (x, y) =
@@ -183,9 +186,12 @@
else quotUnsafe (x -? one, y) -? one
else raise Div
else if y < zero
- then if Primitive.Controls.detectOverflow
+ then if (Primitive.Controls.detectOverflow
+ orelse Primitive.Controls.safe)
andalso x = minInt' andalso y = ~one
- then raise Overflow
+ then if Primitive.Controls.detectOverflow
+ then raise Overflow
+ else minInt'
else quotUnsafe (x, y)
else if y > zero
then quotUnsafe (x +? one, y) -? one
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-int.sml 2007-06-13 16:38:23 UTC (rev 5617)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/prim-int.sml 2007-06-13 21:00:33 UTC (rev 5618)
@@ -17,13 +17,17 @@
val sizeInBitsWord: Primitive.Word32.word
val precision: Primitive.Int32.int option
+ val +! : int * int -> int
val +? : int * int -> int
val + : int * int -> int
+ val *! : int * int -> int
val *? : int * int -> int
val * : int * int -> int
+ val ~! : int -> int
val ~? : int -> int
val ~ : int -> int
val quotUnsafe: int * int -> int
+ val -! : int * int -> int
val -? : int * int -> int
val - : int * int -> int
val remUnsafe: int * int -> int
@@ -106,26 +110,30 @@
IntWordConv.zextdFromInt32ToWord32 sizeInBits
val precision = SOME sizeInBits
+ val +! = Exn.wrapOverflow (_prim "WordS8_addCheck": int * int -> int;)
val +? = _prim "Word8_add": int * int -> int;
val + =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS8_addCheck": int * int -> int;)
+ then +!
else +?
+ val *! = Exn.wrapOverflow (_prim "WordS8_mulCheck": int * int -> int;)
val *? = _prim "WordS8_mul": int * int -> int;
val * =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS8_mulCheck": int * int -> int;)
+ then *!
else *?
+ val ~! = Exn.wrapOverflow (_prim "Word8_negCheck": int -> int;)
val ~? = _prim "Word8_neg": int -> int;
val ~ =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "Word8_negCheck": int -> int;)
+ then ~!
else ~?
val quotUnsafe = _prim "WordS8_quot": int * int -> int;
+ val -! = Exn.wrapOverflow (_prim "WordS8_subCheck": int * int -> int;)
val -? = _prim "Word8_sub": int * int -> int;
val - =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS8_subCheck": int * int -> int;)
+ then -!
else -?
val remUnsafe = _prim "WordS8_rem": int * int -> int;
@@ -205,26 +213,30 @@
IntWordConv.zextdFromInt32ToWord32 sizeInBits
val precision = SOME sizeInBits
+ val +! = Exn.wrapOverflow (_prim "WordS16_addCheck": int * int -> int;)
val +? = _prim "Word16_add": int * int -> int;
val + =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS16_addCheck": int * int -> int;)
+ then +!
else +?
+ val *! = Exn.wrapOverflow (_prim "WordS16_mulCheck": int * int -> int;)
val *? = _prim "WordS16_mul": int * int -> int;
val * =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS16_mulCheck": int * int -> int;)
+ then *!
else *?
+ val ~! = Exn.wrapOverflow (_prim "Word16_negCheck": int -> int;)
val ~? = _prim "Word16_neg": int -> int;
val ~ =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "Word16_negCheck": int -> int;)
+ then ~!
else ~?
val quotUnsafe = _prim "WordS16_quot": int * int -> int;
+ val -! = Exn.wrapOverflow (_prim "WordS16_subCheck": int * int -> int;)
val -? = _prim "Word16_sub": int * int -> int;
val - =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS16_subCheck": int * int -> int;)
+ then -!
else -?
val remUnsafe = _prim "WordS16_rem": int * int -> int;
@@ -368,26 +380,30 @@
IntWordConv.zextdFromInt32ToWord32 sizeInBits
val precision = SOME sizeInBits
+ val +! = Exn.wrapOverflow (_prim "WordS32_addCheck": int * int -> int;)
val +? = _prim "Word32_add": int * int -> int;
val + =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS32_addCheck": int * int -> int;)
+ then +!
else +?
+ val *! = Exn.wrapOverflow (_prim "WordS32_mulCheck": int * int -> int;)
val *? = _prim "WordS32_mul": int * int -> int;
val * =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS32_mulCheck": int * int -> int;)
+ then *!
else *?
+ val ~! = Exn.wrapOverflow (_prim "Word32_negCheck": int -> int;)
val ~? = _prim "Word32_neg": int -> int;
val ~ =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "Word32_negCheck": int -> int;)
+ then ~!
else ~?
val quotUnsafe = _prim "WordS32_quot": int * int -> int;
+ val -! = Exn.wrapOverflow (_prim "WordS32_subCheck": int * int -> int;)
val -? = _prim "Word32_sub": int * int -> int;
val - =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS32_subCheck": int * int -> int;)
+ then -!
else -?
val remUnsafe = _prim "WordS32_rem": int * int -> int;
@@ -411,26 +427,30 @@
IntWordConv.zextdFromInt32ToWord32 sizeInBits
val precision = SOME sizeInBits
+ val +! = Exn.wrapOverflow (_prim "WordS64_addCheck": int * int -> int;)
val +? = _prim "Word64_add": int * int -> int;
val + =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS64_addCheck": int * int -> int;)
+ then +!
else +?
+ val *! = Exn.wrapOverflow (_prim "WordS64_mulCheck": int * int -> int;)
val *? = _prim "WordS64_mul": int * int -> int;
val * =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS64_mulCheck": int * int -> int;)
+ then *!
else *?
+ val ~! = Exn.wrapOverflow (_prim "Word64_negCheck": int -> int;)
val ~? = _prim "Word64_neg": int -> int;
val ~ =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "Word64_negCheck": int -> int;)
+ then ~!
else ~?
val quotUnsafe = _prim "WordS64_quot": int * int -> int;
+ val -! = Exn.wrapOverflow (_prim "WordS64_subCheck": int * int -> int;)
val -? = _prim "Word64_sub": int * int -> int;
val - =
if Controls.detectOverflow
- then Exn.wrapOverflow (_prim "WordS64_subCheck": int * int -> int;)
+ then -!
else -?
val remUnsafe = _prim "WordS64_rem": int * int -> int;
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library/top-level/infixes-overflow.sml (from rev 5615, mlton/branches/on-20050822-x86_64-branch/basis-library/top-level/infixes-unsafe.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/top-level/infixes-unsafe.sml 2007-06-11 20:07:23 UTC (rev 5615)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/top-level/infixes-overflow.sml 2007-06-13 21:00:33 UTC (rev 5618)
@@ -0,0 +1,10 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+infix 7 *!
+infix 6 +! -!
More information about the MLton-commit
mailing list