[MLton] cvs commit: filled in missing Int<N> structures
Stephen Weeks
sweeks@mlton.org
Wed, 3 Mar 2004 09:54:43 -0800
sweeks 04/03/03 09:54:43
Modified: basis-library/integer embed.sml
basis-library/libs/basis-2002/top-level basis.sig basis.sml
basis-library/misc primitive.sml
doc changelog
doc/user-guide basis.tex
mlton/ast int-size.fun int-size.sig
mlton/atoms prim.fun prim.sig
mlton/backend representation.fun ssa-to-rssa.fun
mlton/ssa redundant-tests.fun
regression fixed-integer.ok fixed-integer.sml
Log:
MAIL filled in missing Int<N> structures
So we now have Int2, Int3, ..., Int31, Int32, Int64.
Revision Changes Path
1.2 +51 -10 mlton/basis-library/integer/embed.sml
Index: embed.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/embed.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- embed.sml 3 Mar 2004 02:08:58 -0000 1.1
+++ embed.sml 3 Mar 2004 17:54:41 -0000 1.2
@@ -1,12 +1,15 @@
+signature EMBED =
+ sig
+ eqtype int
+ type big
+
+ val precision': Int.int
+ val fromBigUnsafe: big -> int
+ val toBig: int -> big
+ end
+
functor EmbedInt (structure Big: INTEGER
- structure Small:
- sig
- eqtype int
-
- val precision': Int.int
- val fromBigUnsafe: Big.int -> int
- val toBig: int -> Big.int
- end): INTEGER =
+ structure Small: EMBED where type big = Big.int): INTEGER =
struct
open Small
@@ -90,5 +93,43 @@
val toString = Big.toString o toBig
end
-structure Int31 = EmbedInt (structure Big = Int32
- structure Small = Primitive.Int31)
+functor Embed8 (Small: EMBED where type big = Int8.int): INTEGER =
+ EmbedInt (structure Big = Int8
+ structure Small = Small)
+
+functor Embed16 (Small: EMBED where type big = Int16.int): INTEGER =
+ EmbedInt (structure Big = Int16
+ structure Small = Small)
+
+functor Embed32 (Small: EMBED where type big = Int32.int): INTEGER =
+ EmbedInt (structure Big = Int32
+ structure Small = Small)
+
+structure Int2 = Embed8 (Primitive.Int2)
+structure Int3 = Embed8 (Primitive.Int3)
+structure Int4 = Embed8 (Primitive.Int4)
+structure Int5 = Embed8 (Primitive.Int5)
+structure Int6 = Embed8 (Primitive.Int6)
+structure Int7 = Embed8 (Primitive.Int7)
+structure Int9 = Embed16 (Primitive.Int9)
+structure Int10 = Embed16 (Primitive.Int10)
+structure Int11 = Embed16 (Primitive.Int11)
+structure Int12 = Embed16 (Primitive.Int12)
+structure Int13 = Embed16 (Primitive.Int13)
+structure Int14 = Embed16 (Primitive.Int14)
+structure Int15 = Embed16 (Primitive.Int15)
+structure Int17 = Embed32 (Primitive.Int17)
+structure Int18 = Embed32 (Primitive.Int18)
+structure Int19 = Embed32 (Primitive.Int19)
+structure Int20 = Embed32 (Primitive.Int20)
+structure Int21 = Embed32 (Primitive.Int21)
+structure Int22 = Embed32 (Primitive.Int22)
+structure Int23 = Embed32 (Primitive.Int23)
+structure Int24 = Embed32 (Primitive.Int24)
+structure Int25 = Embed32 (Primitive.Int25)
+structure Int26 = Embed32 (Primitive.Int26)
+structure Int27 = Embed32 (Primitive.Int27)
+structure Int28 = Embed32 (Primitive.Int28)
+structure Int29 = Embed32 (Primitive.Int29)
+structure Int30 = Embed32 (Primitive.Int30)
+structure Int31 = Embed32 (Primitive.Int31)
1.45 +66 -12 mlton/basis-library/libs/basis-2002/top-level/basis.sig
Index: basis.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sig,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- basis.sig 3 Mar 2004 02:08:58 -0000 1.44
+++ basis.sig 3 Mar 2004 17:54:41 -0000 1.45
@@ -135,37 +135,64 @@
structure FixedInt : INTEGER
structure GenericSock : GENERIC_SOCK
structure INetSock : INET_SOCK
- structure Int16 : INTEGER
+ structure Int2: INTEGER
+ structure Int3: INTEGER
+ structure Int4: INTEGER
+ structure Int5: INTEGER
+ structure Int6: INTEGER
+ structure Int7: INTEGER
+ structure Int8: INTEGER
+ structure Int9: INTEGER
+ structure Int10: INTEGER
+ structure Int11: INTEGER
+ structure Int12: INTEGER
+ structure Int13: INTEGER
+ structure Int14: INTEGER
+ structure Int15: INTEGER
+ structure Int16: INTEGER
+ structure Int17: INTEGER
+ structure Int18: INTEGER
+ structure Int19: INTEGER
+ structure Int20: INTEGER
+ structure Int21: INTEGER
+ structure Int22: INTEGER
+ structure Int23: INTEGER
+ structure Int24: INTEGER
+ structure Int25: INTEGER
+ structure Int26: INTEGER
+ structure Int27: INTEGER
+ structure Int28: INTEGER
+ structure Int29: INTEGER
+ structure Int30: INTEGER
+ structure Int31: INTEGER
+ structure Int32: INTEGER
+ structure Int64: INTEGER
+ structure Int8Array : MONO_ARRAY
+ structure Int8Array2 : MONO_ARRAY2
+ structure Int8ArraySlice : MONO_ARRAY_SLICE
+ structure Int8Vector : MONO_VECTOR
+ structure Int8VectorSlice : MONO_VECTOR_SLICE
structure Int16Array : MONO_ARRAY
structure Int16Array2 : MONO_ARRAY2
structure Int16ArraySlice : MONO_ARRAY_SLICE
structure Int16Vector : MONO_VECTOR
structure Int16VectorSlice : MONO_VECTOR_SLICE
- structure Int31 : INTEGER
- structure Int32 : INTEGER
structure Int32Array : MONO_ARRAY
structure Int32Array2 : MONO_ARRAY2
structure Int32ArraySlice : MONO_ARRAY_SLICE
structure Int32Vector : MONO_VECTOR
structure Int32VectorSlice : MONO_VECTOR_SLICE
- structure Int64 : INTEGER
structure Int64Array : MONO_ARRAY
structure Int64Array2 : MONO_ARRAY2
structure Int64ArraySlice : MONO_ARRAY_SLICE
structure Int64Vector : MONO_VECTOR
structure Int64VectorSlice : MONO_VECTOR_SLICE
- structure Int8 : INTEGER
- structure Int8Array : MONO_ARRAY
- structure Int8Array2 : MONO_ARRAY2
- structure Int8ArraySlice : MONO_ARRAY_SLICE
- structure Int8Vector : MONO_VECTOR
- structure Int8VectorSlice : MONO_VECTOR_SLICE
structure IntArray : MONO_ARRAY
structure IntArray2 : MONO_ARRAY2
structure IntArraySlice : MONO_ARRAY_SLICE
- structure IntInf : INT_INF
structure IntVector : MONO_VECTOR
structure IntVectorSlice : MONO_VECTOR_SLICE
+ structure IntInf : INT_INF
structure LargeIntArray : MONO_ARRAY
structure LargeIntArray2 : MONO_ARRAY2
structure LargeIntArraySlice : MONO_ARRAY_SLICE
@@ -572,7 +599,6 @@
where type 'a vector = 'a vector
where type char = char
where type exn = exn
- where type int = int
where type order = order
where type real = real
where type string = string
@@ -630,9 +656,37 @@
where type Word8Vector.vector = Word8Vector.vector
(* Types that must be exposed because constants denote them. *)
+ where type Int2.int = Int2.int
+ where type Int3.int = Int3.int
+ where type Int4.int = Int4.int
+ where type Int5.int = Int5.int
+ where type Int6.int = Int6.int
+ where type Int7.int = Int7.int
where type Int8.int = Int8.int
+ where type Int9.int = Int9.int
+ where type Int10.int = Int10.int
+ where type Int11.int = Int11.int
+ where type Int12.int = Int12.int
+ where type Int13.int = Int13.int
+ where type Int14.int = Int14.int
+ where type Int15.int = Int15.int
where type Int16.int = Int16.int
+ where type Int17.int = Int17.int
+ where type Int18.int = Int18.int
+ where type Int19.int = Int19.int
+ where type Int20.int = Int20.int
+ where type Int21.int = Int21.int
+ where type Int22.int = Int22.int
+ where type Int23.int = Int23.int
+ where type Int24.int = Int24.int
+ where type Int25.int = Int25.int
+ where type Int26.int = Int26.int
+ where type Int27.int = Int27.int
+ where type Int28.int = Int28.int
+ where type Int29.int = Int29.int
+ where type Int30.int = Int30.int
where type Int31.int = Int31.int
+ where type Int32.int = Int32.int
where type Int64.int = Int64.int
where type IntInf.int = IntInf.int
where type Real32.real = Real32.real
1.21 +29 -0 mlton/basis-library/libs/basis-2002/top-level/basis.sml
Index: basis.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sml,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- basis.sml 3 Mar 2004 02:08:58 -0000 1.20
+++ basis.sml 3 Mar 2004 17:54:41 -0000 1.21
@@ -62,6 +62,35 @@
structure Int16ArraySlice = Int16ArraySlice
structure Int16Vector = Int16Vector
structure Int16VectorSlice = Int16VectorSlice
+ structure Int2 = Int2
+ structure Int3 = Int3
+ structure Int4 = Int4
+ structure Int5 = Int5
+ structure Int6 = Int6
+ structure Int7 = Int7
+ structure Int8 = Int8
+ structure Int9 = Int9
+ structure Int10 = Int10
+ structure Int11 = Int11
+ structure Int12 = Int12
+ structure Int13 = Int13
+ structure Int14 = Int14
+ structure Int15 = Int15
+ structure Int16 = Int16
+ structure Int17 = Int17
+ structure Int18 = Int18
+ structure Int19 = Int19
+ structure Int20 = Int20
+ structure Int21 = Int21
+ structure Int22 = Int22
+ structure Int23 = Int23
+ structure Int24 = Int24
+ structure Int25 = Int25
+ structure Int26 = Int26
+ structure Int27 = Int27
+ structure Int28 = Int28
+ structure Int29 = Int29
+ structure Int30 = Int30
structure Int31 = Int31
structure Int32 = Int32
structure Int32Array = Int32Array
1.102 +219 -6 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.101
retrieving revision 1.102
diff -u -r1.101 -r1.102
--- primitive.sml 3 Mar 2004 02:08:59 -0000 1.101
+++ primitive.sml 3 Mar 2004 17:54:41 -0000 1.102
@@ -385,13 +385,229 @@
val fromInt = _prim "Int32_toInt16": Int.int -> int;
val toInt = _prim "Int16_toInt32": int -> Int.int;
end
+ structure Int2 =
+ struct
+ type big = Int8.int
+ type int = int2
+ val fromBigUnsafe = _prim "Int8_toInt2": big -> int;
+ val precision' = 2
+ val toBig = _prim "Int2_toInt8": int -> big;
+ end
+ structure Int3 =
+ struct
+ type big = Int8.int
+ type int = int3
+ val fromBigUnsafe = _prim "Int8_toInt3": big -> int;
+ val precision' = 3
+ val toBig = _prim "Int3_toInt8": int -> big;
+ end
+ structure Int4 =
+ struct
+ type big = Int8.int
+ type int = int4
+ val fromBigUnsafe = _prim "Int8_toInt4": big -> int;
+ val precision' = 4
+ val toBig = _prim "Int4_toInt8": int -> big;
+ end
+ structure Int5 =
+ struct
+ type big = Int8.int
+ type int = int5
+ val fromBigUnsafe = _prim "Int8_toInt5": big -> int;
+ val precision' = 5
+ val toBig = _prim "Int5_toInt8": int -> big;
+ end
+ structure Int6 =
+ struct
+ type big = Int8.int
+ type int = int6
+ val fromBigUnsafe = _prim "Int8_toInt6": big -> int;
+ val precision' = 6
+ val toBig = _prim "Int6_toInt8": int -> big;
+ end
+ structure Int7 =
+ struct
+ type big = Int8.int
+ type int = int7
+ val fromBigUnsafe = _prim "Int8_toInt7": big -> int;
+ val precision' = 7
+ val toBig = _prim "Int7_toInt8": int -> big;
+ end
+ structure Int9 =
+ struct
+ type big = Int16.int
+ type int = int9
+ val fromBigUnsafe = _prim "Int16_toInt9": big -> int;
+ val precision' = 9
+ val toBig = _prim "Int9_toInt16": int -> big;
+ end
+ structure Int10 =
+ struct
+ type big = Int16.int
+ type int = int10
+ val fromBigUnsafe = _prim "Int16_toInt10": big -> int;
+ val precision' = 10
+ val toBig = _prim "Int10_toInt16": int -> big;
+ end
+ structure Int11 =
+ struct
+ type big = Int16.int
+ type int = int11
+ val fromBigUnsafe = _prim "Int16_toInt11": big -> int;
+ val precision' = 11
+ val toBig = _prim "Int11_toInt16": int -> big;
+ end
+ structure Int12 =
+ struct
+ type big = Int16.int
+ type int = int12
+ val fromBigUnsafe = _prim "Int16_toInt12": big -> int;
+ val precision' = 12
+ val toBig = _prim "Int12_toInt16": int -> big;
+ end
+ structure Int13 =
+ struct
+ type big = Int16.int
+ type int = int13
+ val fromBigUnsafe = _prim "Int16_toInt13": big -> int;
+ val precision' = 13
+ val toBig = _prim "Int13_toInt16": int -> big;
+ end
+ structure Int14 =
+ struct
+ type big = Int16.int
+ type int = int14
+ val fromBigUnsafe = _prim "Int16_toInt14": big -> int;
+ val precision' = 14
+ val toBig = _prim "Int14_toInt16": int -> big;
+ end
+ structure Int15 =
+ struct
+ type big = Int16.int
+ type int = int15
+ val fromBigUnsafe = _prim "Int16_toInt15": big -> int;
+ val precision' = 15
+ val toBig = _prim "Int15_toInt16": int -> big;
+ end
+ structure Int17 =
+ struct
+ type big = Int32.int
+ type int = int17
+ val fromBigUnsafe = _prim "Int32_toInt17": big -> int;
+ val precision' = 17
+ val toBig = _prim "Int17_toInt32": int -> big;
+ end
+ structure Int18 =
+ struct
+ type big = Int32.int
+ type int = int18
+ val fromBigUnsafe = _prim "Int32_toInt18": big -> int;
+ val precision' = 18
+ val toBig = _prim "Int18_toInt32": int -> big;
+ end
+ structure Int19 =
+ struct
+ type big = Int32.int
+ type int = int19
+ val fromBigUnsafe = _prim "Int32_toInt19": big -> int;
+ val precision' = 19
+ val toBig = _prim "Int19_toInt32": int -> big;
+ end
+ structure Int20 =
+ struct
+ type big = Int32.int
+ type int = int20
+ val fromBigUnsafe = _prim "Int32_toInt20": big -> int;
+ val precision' = 20
+ val toBig = _prim "Int20_toInt32": int -> big;
+ end
+ structure Int21 =
+ struct
+ type big = Int32.int
+ type int = int21
+ val fromBigUnsafe = _prim "Int32_toInt21": big -> int;
+ val precision' = 21
+ val toBig = _prim "Int21_toInt32": int -> big;
+ end
+ structure Int22 =
+ struct
+ type big = Int32.int
+ type int = int22
+ val fromBigUnsafe = _prim "Int32_toInt22": big -> int;
+ val precision' = 22
+ val toBig = _prim "Int22_toInt32": int -> big;
+ end
+ structure Int23 =
+ struct
+ type big = Int32.int
+ type int = int23
+ val fromBigUnsafe = _prim "Int32_toInt23": big -> int;
+ val precision' = 23
+ val toBig = _prim "Int23_toInt32": int -> big;
+ end
+ structure Int24 =
+ struct
+ type big = Int32.int
+ type int = int24
+ val fromBigUnsafe = _prim "Int32_toInt24": big -> int;
+ val precision' = 24
+ val toBig = _prim "Int24_toInt32": int -> big;
+ end
+ structure Int25 =
+ struct
+ type big = Int32.int
+ type int = int25
+ val fromBigUnsafe = _prim "Int32_toInt25": big -> int;
+ val precision' = 25
+ val toBig = _prim "Int25_toInt32": int -> big;
+ end
+ structure Int26 =
+ struct
+ type big = Int32.int
+ type int = int26
+ val fromBigUnsafe = _prim "Int32_toInt26": big -> int;
+ val precision' = 26
+ val toBig = _prim "Int26_toInt32": int -> big;
+ end
+ structure Int27 =
+ struct
+ type big = Int32.int
+ type int = int27
+ val fromBigUnsafe = _prim "Int32_toInt27": big -> int;
+ val precision' = 27
+ val toBig = _prim "Int27_toInt32": int -> big;
+ end
+ structure Int28 =
+ struct
+ type big = Int32.int
+ type int = int28
+ val fromBigUnsafe = _prim "Int32_toInt28": big -> int;
+ val precision' = 28
+ val toBig = _prim "Int28_toInt32": int -> big;
+ end
+ structure Int29 =
+ struct
+ type big = Int32.int
+ type int = int29
+ val fromBigUnsafe = _prim "Int32_toInt29": big -> int;
+ val precision' = 29
+ val toBig = _prim "Int29_toInt32": int -> big;
+ end
+ structure Int30 =
+ struct
+ type big = Int32.int
+ type int = int30
+ val fromBigUnsafe = _prim "Int32_toInt30": big -> int;
+ val precision' = 30
+ val toBig = _prim "Int30_toInt32": int -> big;
+ end
structure Int31 =
struct
+ type big = Int32.int
type int = int31
-
- val fromBigUnsafe = _prim "Int32_toInt31": Int32.int -> int;
+ val fromBigUnsafe = _prim "Int32_toInt31": big -> int;
val precision' = 31
- val toBig = _prim "Int31_toInt32": int -> Int32.int;
+ val toBig = _prim "Int31_toInt32": int -> big;
end
structure Int32 =
struct
@@ -429,9 +645,6 @@
else ~?
val fromInt : int -> int = fn x => x
val toInt : int -> int = fn x => x
-
-(* val fromInt31 = _prim "Int31_toInt32": Int31.int -> int; *)
-(* val toInt31 = _prim "Int32_toInt31": int -> Int31.int; *)
end
structure Int = Int32
1.107 +6 -0 mlton/doc/changelog
Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.106
retrieving revision 1.107
diff -u -r1.106 -r1.107
--- changelog 28 Feb 2004 03:17:44 -0000 1.106
+++ changelog 3 Mar 2004 17:54:41 -0000 1.107
@@ -1,3 +1,9 @@
+Here are the changes since version 20040227.
+
+* 2004-03-03
+ - Added structures Int2, Int3, ..., Int31.
+
+--------------------------------------------------------------------------------
Here are the changes from version 20030716 to 20040227.
Summary:
1.41 +7 -1 mlton/doc/user-guide/basis.tex
Index: basis.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/basis.tex,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- basis.tex 28 Feb 2004 02:55:55 -0000 1.40
+++ basis.tex 3 Mar 2004 17:54:42 -0000 1.41
@@ -202,6 +202,13 @@
\fullmodule{INetSock}{INET\_SOCK}
\fullmodule{IO}{IO}
\fullmodule{Int}{INTEGER}
+\fullmodule{Int2}{INTEGER}
+\fullmodule{Int3}{INTEGER}
+\fullmodule{Int4}{INTEGER}
+\ldots\\
+\fullmodule{Int31}{INTEGER}
+\fullmodule{Int32}{INTEGER}
+\fullmodule{Int64}{INTEGER}
\fullmodule{IntArray}{MONO\_ARRAY}
\fullmodule{IntArray2}{MONO\_ARRAY2}
\fullmodule{IntArraySlice}{MONO\_ARRAY\_SLICE}
@@ -225,7 +232,6 @@
\fullmodule{Int32ArraySlice}{MONO\_ARRAY\_SLICE}
\fullmodule{Int32Vector}{MONO\_VECTOR}
\fullmodule{Int32VectorSlice}{MONO\_VECTOR\_SLICE}
-\fullmodule{Int64}{INTEGER}
\fullmodule{Int64Array}{MONO\_ARRAY}
\fullmodule{Int64Array2}{MONO\_ARRAY2}
\fullmodule{Int64ArraySlice}{MONO\_ARRAY\_SLICE}
1.6 +22 -2 mlton/mlton/ast/int-size.fun
Index: int-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/int-size.fun,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- int-size.fun 3 Mar 2004 02:08:59 -0000 1.5
+++ int-size.fun 3 Mar 2004 17:54:42 -0000 1.6
@@ -9,9 +9,12 @@
val equals: t * t -> bool = op =
-val sizes: int list = [8, 16, 31, 32, 64]
+val sizes: int list =
+ List.tabulate (31, fn i => i + 2)
+ @ [64]
-fun isValidSize i = List.exists (sizes, fn i' => i = i')
+fun isValidSize (i: int) =
+ (2 <= i andalso i <= 32) orelse i = 64
fun make i = T {precision = i}
@@ -87,5 +90,22 @@
case primOpt s of
NONE => Error.bug "IntSize.prim"
| SOME p => p
+
+fun roundUpToPrim s =
+ let
+ val bits = bits s
+ val bits =
+ if bits <= 8
+ then 8
+ else if bits <= 16
+ then 16
+ else if bits <= 32
+ then 32
+ else if bits = 64
+ then 64
+ else Error.bug "IntSize.roundUpToPrim"
+ in
+ I bits
+ end
end
1.4 +1 -0 mlton/mlton/ast/int-size.sig
Index: int-size.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/int-size.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- int-size.sig 3 Mar 2004 02:08:59 -0000 1.3
+++ int-size.sig 3 Mar 2004 17:54:42 -0000 1.4
@@ -26,5 +26,6 @@
val prim: t -> prim
val prims: t list
val range: t -> IntInf.t * IntInf.t
+ val roundUpToPrim: t -> t
val toString: t -> string
end
1.71 +1 -0 mlton/mlton/atoms/prim.fun
Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -r1.70 -r1.71
--- prim.fun 3 Mar 2004 02:08:59 -0000 1.70
+++ prim.fun 3 Mar 2004 17:54:42 -0000 1.71
@@ -574,6 +574,7 @@
val int = IntSize.memoize
val word = WordSize.memoize
in
+ val intToInt = make (Name.Int_toInt, int, int)
val intToWord = make (Name.Int_toWord, int, word)
val wordToInt = make (Name.Word_toInt, word, int)
val wordToIntX = make (Name.Word_toIntX, word, int)
1.53 +1 -0 mlton/mlton/atoms/prim.sig
Index: prim.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.sig,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- prim.sig 17 Feb 2004 00:33:20 -0000 1.52
+++ prim.sig 3 Mar 2004 17:54:42 -0000 1.53
@@ -261,6 +261,7 @@
val intMulCheck: IntSize.t -> t
val intSub: IntSize.t -> t
val intSubCheck: IntSize.t -> t
+ val intToInt: IntSize.t * IntSize.t -> t
val intToWord: IntSize.t * WordSize.t -> t
val isCommutative: t -> bool
(*
1.23 +1 -13 mlton/mlton/backend/representation.fun
Index: representation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/representation.fun,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- representation.fun 3 Mar 2004 02:09:01 -0000 1.22
+++ representation.fun 3 Mar 2004 17:54:42 -0000 1.23
@@ -540,19 +540,7 @@
case S.Type.dest t of
Array t => SOME (array {mutable = true, ty = t})
| Datatype tycon => convertDatatype tycon
- | Int s =>
- let
- val bits =
- case IntSize.bits s of
- 8 => 8
- | 16 => 16
- | 31 => 32
- | 32 => 32
- | 64 => 64
- | _ => Error.bug "strange size int"
- in
- SOME (R.Type.int (IntSize.I bits))
- end
+ | Int s => SOME (R.Type.int (IntSize.roundUpToPrim s))
| IntInf => SOME R.Type.intInf
| PreThread => SOME R.Type.thread
| Real s => SOME (R.Type.real s)
1.57 +17 -15 mlton/mlton/backend/ssa-to-rssa.fun
Index: ssa-to-rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/ssa-to-rssa.fun,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -r1.56 -r1.57
--- ssa-to-rssa.fun 3 Mar 2004 02:09:01 -0000 1.56
+++ ssa-to-rssa.fun 3 Mar 2004 17:54:42 -0000 1.57
@@ -1176,15 +1176,14 @@
ccall {args = Vector.new1 Operand.GCState,
func = CFunction.unpack}
| Int_equal s =>
- (case IntSize.bits s of
- 31 => primApp (Prim.intEqual
- (IntSize.I 32))
- | 64 =>
- if !Control.Native.native
- then
- simpleCCall CFunction.int64Equal
- else normal ()
- | _ => normal ())
+ let
+ val s = IntSize.roundUpToPrim s
+ in
+ if 64 = IntSize.bits s
+ andalso !Control.Native.native
+ then simpleCCall CFunction.int64Equal
+ else primApp (Prim.intEqual s)
+ end
| Int_ge s => int (s, CFunction.intGe s)
| Int_gt s => int (s, CFunction.intGt s)
| Int_le s => int (s, CFunction.intLe s)
@@ -1201,13 +1200,16 @@
(CFunction.intToInt (s1, s2))
else normal ()
val id = cast
+ val s1 = IntSize.roundUpToPrim s1
+ val s2 = IntSize.roundUpToPrim s2
+ val b1 = IntSize.bits s1
+ val b2 = IntSize.bits s2
in
- case (IntSize.bits s1, IntSize.bits s2) of
- (32, 64) => call ()
- | (64, 32) => call ()
- | (31, 32) => id ()
- | (32, 31) => id ()
- | _ => normal ()
+ if b1 = 64 orelse b2 = 64
+ then call ()
+ else if b1 = b2
+ then id ()
+ else primApp (Prim.intToInt (s1, s2))
end
| Int_toWord (s1, s2) =>
let
1.17 +5 -0 mlton/mlton/ssa/redundant-tests.fun
Index: redundant-tests.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/redundant-tests.fun,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- redundant-tests.fun 3 Mar 2004 02:09:08 -0000 1.16
+++ redundant-tests.fun 3 Mar 2004 17:54:42 -0000 1.17
@@ -95,6 +95,11 @@
| Or of Fact.t * Fact.t
val {get = varInfo: Var.t -> varInfo, set = setVarInfo, ...} =
Property.getSetOnce (Var.plist, Property.initConst None)
+ val setVarInfo =
+ Trace.trace ("RedundantTests.setVarInfo",
+ Var.layout o #1,
+ Unit.layout)
+ setVarInfo
datatype z = datatype Fact.result
datatype z = datatype Rel.t
fun makeVarInfo {args, prim, targs = _}: varInfo =
1.5 +29 -0 mlton/regression/fixed-integer.ok
Index: fixed-integer.ok
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/fixed-integer.ok,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- fixed-integer.ok 1 Aug 2003 14:55:56 -0000 1.4
+++ fixed-integer.ok 3 Mar 2004 17:54:42 -0000 1.5
@@ -1,4 +1,33 @@
+Testing Int2
+Testing Int3
+Testing Int4
+Testing Int5
+Testing Int6
+Testing Int7
Testing Int8
+Testing Int9
+Testing Int10
+Testing Int11
+Testing Int12
+Testing Int13
+Testing Int14
+Testing Int15
Testing Int16
+Testing Int17
+Testing Int17
+Testing Int18
+Testing Int19
+Testing Int20
+Testing Int21
+Testing Int22
+Testing Int23
+Testing Int24
+Testing Int25
+Testing Int26
+Testing Int27
+Testing Int28
+Testing Int29
+Testing Int30
+Testing Int31
Testing Int32
Testing Int64
1.6 +35 -7 mlton/regression/fixed-integer.sml
Index: fixed-integer.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/fixed-integer.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- fixed-integer.sml 3 Mar 2004 02:09:08 -0000 1.5
+++ fixed-integer.sml 3 Mar 2004 17:54:42 -0000 1.6
@@ -1,9 +1,3 @@
-(* This code tests every value in a module matching the INTEGER signature
- * by comparing its behaviour with LargeInt.
- *
- * It assumes that the module is for fixed integers, i.e. isSome precision.
- *)
-
functor Test (I: INTEGER) =
struct
fun foreach (l, f) = List.app f l
@@ -15,7 +9,13 @@
val nums =
[valOf I.maxInt,
I.- (valOf I.maxInt, I.fromInt 1)]
- @ (List.map I.fromInt [100, 10, 5, 2, 1, 0, ~1, ~2, 5, 10, 100])
+ @ (List.foldl
+ (fn (i, ac) =>
+ case SOME (I.fromInt i) handle Overflow => NONE of
+ NONE => ac
+ | SOME i => i :: ac)
+ []
+ [100, 10, 5, 2, 1, 0, ~1, ~2, 5, 10, 100])
@ [I.+ (I.fromInt 1, valOf I.minInt),
valOf I.minInt]
@@ -210,8 +210,36 @@
end
+structure S = Test (Int2)
+structure S = Test (Int3)
+structure S = Test (Int4)
+structure S = Test (Int5)
+structure S = Test (Int6)
+structure S = Test (Int7)
structure S = Test (Int8)
+structure S = Test (Int9)
+structure S = Test (Int10)
+structure S = Test (Int11)
+structure S = Test (Int12)
+structure S = Test (Int13)
+structure S = Test (Int14)
+structure S = Test (Int15)
structure S = Test (Int16)
+structure S = Test (Int17)
+structure S = Test (Int17)
+structure S = Test (Int18)
+structure S = Test (Int19)
+structure S = Test (Int20)
+structure S = Test (Int21)
+structure S = Test (Int22)
+structure S = Test (Int23)
+structure S = Test (Int24)
+structure S = Test (Int25)
+structure S = Test (Int26)
+structure S = Test (Int27)
+structure S = Test (Int28)
+structure S = Test (Int29)
+structure S = Test (Int30)
structure S = Test (Int31)
structure S = Test (Int32)
structure S = Test (Int64)