[MLton-devel] cvs commit: Basis Library and x86 support for Int{8,16,32}, Word{8,16,32}.

Matthew Fluet fluet@users.sourceforge.net
Wed, 25 Jun 2003 16:15:33 -0700


fluet       03/06/25 16:15:33

  Modified:    mlton/atoms prim.fun
               mlton/codegen/x86-codegen x86-allocate-registers.fun
                        x86-mlton.fun x86-translate.fun
               basis-library/arrays-and-vectors mono-array.sml
                        mono-array2.sml mono-vector.sml
               basis-library/integer int16.sml int32.sml int8.sml
                        integer.fun patch.sml word.fun word.sig word32.sml
                        word8.sml
               basis-library/libs build
               basis-library/libs/basis-2002/top-level basis.sig basis.sml
               basis-library/misc primitive.sml
               include  c-chunk.h
  Added:       basis-library/integer word16.sml
  Log:
  Basis library support for Int{8,16,32} and Word{8,16,32}, including
  mono-array and mono-vector structures.

Revision  Changes    Path
1.53      +2 -0      mlton/mlton/atoms/prim.fun

Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- prim.fun	24 Jun 2003 20:14:22 -0000	1.52
+++ prim.fun	25 Jun 2003 23:15:31 -0000	1.53
@@ -886,6 +886,8 @@
 	   | (Int_rem _, [Int i1, Int i2]) => io (IntX.rem, i1, i2)
 	   | (Int_sub _, [Int i1, Int i2]) => io (IntX.-, i1, i2)
 	   | (Int_subCheck _, [Int i1, Int i2]) => io (IntX.-, i1, i2)
+	   | (Int_toInt (_, s), [Int i]) =>
+	        int (IntX.make (IntX.toIntInf i, s))
 	   | (Int_toWord (_, s), [Int i]) =>
 		word (WordX.fromLargeInt (IntX.toIntInf i, s))
 	   | (IntInf_compare, [IntInf i1, IntInf i2]) =>



1.29      +1 -1      mlton/mlton/codegen/x86-codegen/x86-allocate-registers.fun

Index: x86-allocate-registers.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-allocate-registers.fun,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- x86-allocate-registers.fun	3 Feb 2003 19:48:33 -0000	1.28
+++ x86-allocate-registers.fun	25 Jun 2003 23:15:31 -0000	1.29
@@ -8498,7 +8498,7 @@
 		  val temp_reg
 		    = case final_src
 			of Operand.Register r 
-			 => Register.lowPartOf (r, Size.BYTE)
+			 => Register.lowPartOf (r, dstsize)
 			 | _ 
 			 => Error.bug "allocateRegisters: XVOM, temp_reg"
 



1.45      +83 -22    mlton/mlton/codegen/x86-codegen/x86-mlton.fun

Index: x86-mlton.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton.fun,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- x86-mlton.fun	23 Jun 2003 04:58:58 -0000	1.44
+++ x86-mlton.fun	25 Jun 2003 23:15:31 -0000	1.45
@@ -603,12 +603,29 @@
 	     | Int_gt _ => cmp Instruction.G
 	     | Int_le _ => cmp Instruction.LE
 	     | Int_lt _ => cmp Instruction.L
-	     | Int_mul _ => imul2 () 
+	     | Int_mul s =>
+		  (case s of
+		      I8 => pmd Instruction.IMUL
+		    | I16 => imul2 () 
+		    | I32 => imul2 ()
+		    | I64 => Error.bug "FIXME")
 	     | Int_neg _ => unal Instruction.NEG 
 	     | Int_quot _ => pmd Instruction.IDIV
 	     | Int_rem _ => pmd Instruction.IMOD
 	     | Int_sub _ => binal Instruction.SUB
              | Int_add _ => binal Instruction.ADD
+	     | Int_toInt (s, s') =>
+		(case (s, s') of
+		   (I32, I32) => mov ()
+		 | (I32, I16) => xvom ()
+		 | (I32, I8) => xvom ()
+		 | (I16, I32) => movx Instruction.MOVSX
+		 | (I16, I16) => mov ()
+		 | (I16, I8) => xvom ()
+		 | (I8, I32) => movx Instruction.MOVSX
+		 | (I8, I16) => movx Instruction.MOVSX
+		 | (I8, I8) => mov ()
+		 | _ => Error.bug (Prim.toString prim))
 	     | Int_toReal _
 	     => let
 		  val (dst,dstsize) = getDst ()
@@ -626,10 +643,17 @@
 		    transfer = NONE}]
 		end 
 	     | Int_toWord (s, s') =>
-		  (case (s, s') of
-		      (I32, W8) => xvom ()
-		    | (I32, W32) => mov ()
-		    | _ => Error.bug (Prim.toString prim))
+		(case (s, s') of
+		   (I32, W32) => mov ()
+		 | (I32, W16) => xvom ()
+		 | (I32, W8) => xvom ()
+		 | (I16, W32) => movx Instruction.MOVSX
+		 | (I16, W16) => mov ()
+		 | (I16, W8) => xvom ()
+		 | (I8, W32) => movx Instruction.MOVSX
+		 | (I8, W16) => movx Instruction.MOVSX
+		 | (I8, W8) => mov ()
+		 | _ => Error.bug (Prim.toString prim))
 	     | MLton_eq => cmp Instruction.E
 	     | Real_Math_acos _
 	     => let
@@ -1126,7 +1150,7 @@
 	     | Word_mul s =>
 		  (case s of
 		      W8 => pmd Instruction.MUL
-		    | W16 => Error.bug "FIXME"
+		    | W16 => imul2 ()
 		    | W32 => imul2 ())
 	     | Word_neg _ => unal Instruction.NEG
 	     | Word_notb _ => unal Instruction.NOT
@@ -1136,23 +1160,51 @@
 	     | Word_rshift _ => sral Instruction.SHR
 	     | Word_sub _ => binal Instruction.SUB
 	     | Word_toInt (s, s') =>
-		  (case (s, s') of
-		      (W8, I32) => movx Instruction.MOVZX
-		    | _ => Error.bug (Prim.toString prim))
+		(case (s, s') of
+		   (W32, I32) => mov ()
+		 | (W32, I16) => xvom ()
+		 | (W32, I8) => xvom ()
+		 | (W16, I32) => movx Instruction.MOVZX
+		 | (W16, I16) => mov ()
+		 | (W16, I8) => xvom ()
+		 | (W8, I32) => movx Instruction.MOVZX
+		 | (W8, I16) => movx Instruction.MOVZX
+		 | (W8, I8) => mov ()
+		 | _ => Error.bug (Prim.toString prim))
 	     | Word_toIntX (s, s') =>
-		  (case (s, s') of
-		      (W8, I32) => movx Instruction.MOVSX
-		    | (W32, I32) => mov ()
-		    | _ => Error.bug (Prim.toString prim))
+		(case (s, s') of
+		   (W32, I32) => mov ()
+		 | (W32, I16) => xvom ()
+		 | (W32, I8) => xvom ()
+		 | (W16, I32) => movx Instruction.MOVSX
+		 | (W16, I16) => mov ()
+		 | (W16, I8) => xvom ()
+		 | (W8, I32) => movx Instruction.MOVSX
+		 | (W8, I16) => movx Instruction.MOVSX
+		 | (W8, I8) => mov ()
+		 | _ => Error.bug (Prim.toString prim))
 	     | Word_toWord (s, s') =>
-		  (case (s, s') of
-		      (W8, W32) => movx Instruction.MOVZX
-		    | (W32, W8) => xvom ()
-		    | _ => Error.bug (Prim.toString prim))
+	        (case (s, s') of
+		   (W32, W32) => mov ()
+		 | (W32, W16) => xvom ()
+		 | (W32, W8) => xvom ()
+		 | (W16, W32) => movx Instruction.MOVZX
+		 | (W16, W16) => mov ()
+		 | (W16, W8) => xvom ()
+		 | (W8, W32) => movx Instruction.MOVZX
+		 | (W8, W16) => movx Instruction.MOVZX
+		 | (W8, W8) => mov ())
 	     | Word_toWordX (s, s') =>
-		  (case (s, s') of
-		      (W8, W32) => movx Instruction.MOVSX
-		    | _ => Error.bug (Prim.toString prim))
+		(case (s, s') of
+		   (W32, W32) => mov ()
+		 | (W32, W16) => xvom ()
+		 | (W32, W8) => xvom ()
+		 | (W16, W32) => movx Instruction.MOVSX
+		 | (W16, W16) => mov ()
+		 | (W16, W8) => xvom ()
+		 | (W8, W32) => movx Instruction.MOVSX
+		 | (W8, W16) => movx Instruction.MOVSX
+		 | (W8, W8) => mov ())
 	     | Word_xorb _ => binal Instruction.XOR
 	     | _ => Error.bug ("prim: strange Prim.Name.t: " ^ primName)),
 	 comment_end]
@@ -1384,10 +1436,19 @@
 	 (case Prim.name prim of
 	     Int_addCheck _ => binal (x86.Instruction.ADD, x86.Instruction.O)
 	   | Int_subCheck _ => binal (x86.Instruction.SUB, x86.Instruction.O)
-	   | Int_mulCheck _ => imul2_check x86.Instruction.O
+	   | Int_mulCheck s => 
+	       (case s of
+		  I8 => pmd (x86.Instruction.IMUL, x86.Instruction.O)
+		| I16 => imul2_check x86.Instruction.O
+		| I32 => imul2_check x86.Instruction.O
+		| I64 => Error.bug "FIXME")
 	   | Int_negCheck _ => unal (x86.Instruction.NEG, x86.Instruction.O)
 	   | Word_addCheck _ => binal (x86.Instruction.ADD, x86.Instruction.C)
-	   | Word_mulCheck _ => pmd (x86.Instruction.MUL, x86.Instruction.C)
+	   | Word_mulCheck s => 
+	       (case s of
+		  W8 => pmd (x86.Instruction.MUL, x86.Instruction.C)
+		| W16 => pmd (x86.Instruction.MUL, x86.Instruction.C)
+		| W32 => pmd (x86.Instruction.MUL, x86.Instruction.C))
 	   | _ => Error.bug ("arith: strange Prim.Name.t: " ^ primName))]
       end
 



1.44      +14 -37    mlton/mlton/codegen/x86-codegen/x86-translate.fun

Index: x86-translate.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-translate.fun,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- x86-translate.fun	23 Jun 2003 04:58:58 -0000	1.43
+++ x86-translate.fun	25 Jun 2003 23:15:31 -0000	1.44
@@ -141,9 +141,7 @@
 	       let
 		  val i' = IntX.toIntInf i
 	       in
-		  case IntX.size i of
-		     I32 => x86.Operand.immediate_const_int (IntInf.toInt i')
-		   | _ => Error.bug "FIXME"
+		  x86.Operand.immediate_const_int (IntInf.toInt i')
 	       end
 	  | Label l => x86.Operand.immediate_label l
 	  | Line => x86MLton.fileLine ()
@@ -205,12 +203,7 @@
 	       let
 		  val w' = WordX.toWord w
 	       in
-		  case WordX.size w of
-		     W8 =>
-			x86.Operand.immediate_const_char
-			(Word8.toChar (Word8.fromWord w'))
-		   | W16 => Error.bug "FIXME"
-		   | W32 => x86.Operand.immediate_const_word w'
+		  x86.Operand.immediate_const_word w'
 	       end
 	       
       val toX86Operand =
@@ -732,15 +725,12 @@
 					 falsee = pointers})}))
 			  end
 		     | Int {cases, default, size, test} =>
-			  (case size of
-			      I32 =>
-				 simple ({cases = (Vector.map
-						   (cases, fn (i, l) =>
-						    (IntX.toInt i, l))),
-					  default = default,
-					  test = test},
-					 doSwitchInt)
-			    | _ => Error.bug "FIXME")
+			  simple ({cases = (Vector.map
+					    (cases, fn (i, l) =>
+					     (IntX.toInt i, l))),
+				   default = default,
+				   test = test},
+				  doSwitchInt)
 		     | Pointer {cases, default, tag, ...} =>
 			  simple ({cases = (Vector.map
 					    (cases, fn {dst, tag, ...} =>
@@ -749,25 +739,12 @@
 				   test = tag},
 				  doSwitchInt)
 		     | Word {cases, default, size, test} =>
-			  (case size of
-			      W8 =>
-				 simple ({cases = (Vector.map
-						   (cases, fn (w, l) =>
-						    (Word8.toChar
-						     (Word8.fromWord
-						      (WordX.toWord w)),
-						     l))),
-					  default = default,
-					  test = test},
-					 doSwitchChar)
-			    | W32 =>
-				 simple ({cases = (Vector.map
-						   (cases, fn (w, l) =>
-						    (WordX.toWord w, l))),
-					  default = default,
-					  test = test},
-					 doSwitchWord)
-			    | _ => Error.bug "FIXME")
+			  simple ({cases = (Vector.map
+					    (cases, fn (w, l) =>
+					     (WordX.toWord w, l))),
+				   default = default,
+				   test = test},
+				  doSwitchWord)
 		 end
 	      | Goto label
 	      => (AppendList.append



1.4       +22 -4     mlton/basis-library/arrays-and-vectors/mono-array.sml

Index: mono-array.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-array.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mono-array.sml	24 Nov 2002 01:19:35 -0000	1.3
+++ mono-array.sml	25 Jun 2003 23:15:32 -0000	1.4
@@ -5,28 +5,46 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure Word8Array = MonoArray (type elem = Word8.word
-				  structure V = Word8Vector)
-structure Word8ArraySlice = Word8Array.MonoArraySlice
+
+(* Char *)
 structure CharArray = MonoArray(type elem = char
 				structure V = CharVector)
 structure CharArraySlice = CharArray.MonoArraySlice
 
+(* Bool *)
 structure BoolArray = MonoArray (type elem = bool
 				 structure V = BoolVector)
 structure BoolArraySlice = BoolArray.MonoArraySlice
+
+(* Int *)
 structure IntArray = MonoArray (type elem = int
 				structure V = IntVector)
 structure IntArraySlice = IntArray.MonoArraySlice
 structure Int32Array = IntArray
-structure Int32ArraySlice = Int32Array.MonoArraySlice
+structure Int32ArraySlice = IntArraySlice
+structure Int16Array = MonoArray (type elem = Int16.int
+				structure V = Int16Vector)
+structure Int16ArraySlice = Int16Array.MonoArraySlice
+structure Int8Array = MonoArray (type elem = Int8.int
+				 structure V = Int8Vector)
+structure Int8ArraySlice = Int8Array.MonoArraySlice
+
+(* Real *)
 structure RealArray = MonoArray (type elem = real
 				 structure V = RealVector)
 structure RealArraySlice = RealArray.MonoArraySlice
 structure Real64Array = RealArray
 structure Real64ArraySlice = Real64Array.MonoArraySlice
+
+(* Word *)
 structure WordArray = MonoArray (type elem = word
 				 structure V = WordVector)
 structure WordArraySlice = WordArray.MonoArraySlice
 structure Word32Array = WordArray
 structure Word32ArraySlice = Word32Array.MonoArraySlice
+structure Word16Array = MonoArray (type elem = Word16.word
+				   structure V = Word16Vector)
+structure Word16ArraySlice = Word16Array.MonoArraySlice
+structure Word8Array = MonoArray (type elem = Word8.word
+				  structure V = Word8Vector)
+structure Word8ArraySlice = Word8Array.MonoArraySlice



1.4       +19 -3     mlton/basis-library/arrays-and-vectors/mono-array2.sml

Index: mono-array2.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-array2.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mono-array2.sml	24 Nov 2002 01:19:35 -0000	1.3
+++ mono-array2.sml	25 Jun 2003 23:15:32 -0000	1.4
@@ -5,18 +5,34 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure BoolArray2 = MonoArray2 (type elem = bool
-				   structure V = BoolVector)
+
+(* Char *)
 structure CharArray2 = MonoArray2 (type elem = char
 				   structure V = CharVector)
+
+(* Bool *)
+structure BoolArray2 = MonoArray2 (type elem = bool
+				   structure V = BoolVector)
+
+(* Int *)
 structure IntArray2 = MonoArray2 (type elem = int
 				  structure V = IntVector)
 structure Int32Array2 = IntArray2
+structure Int16Array2 = MonoArray2 (type elem = Int16.int
+				    structure V = IntVector)
+structure Int8Array2 = MonoArray2 (type elem = Int8.int
+				   structure V = IntVector)
+
+(* Real *)
 structure RealArray2 = MonoArray2 (type elem = real
 				   structure V = RealVector)
 structure Real64Array2 = RealArray2
+
+(* Word *)
 structure WordArray2 = MonoArray2 (type elem = word
 				   structure V = WordVector)
+structure Word32Array2 = WordArray2
+structure Word16Array2 = MonoArray2 (type elem = Word16.word
+				     structure V = Word16Vector)
 structure Word8Array2 = MonoArray2 (type elem = Word8.word
 				    structure V = Word8Vector)
-structure Word32Array2 = WordArray2



1.5       +18 -4     mlton/basis-library/arrays-and-vectors/mono-vector.sml

Index: mono-vector.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-vector.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- mono-vector.sml	7 Feb 2003 22:20:49 -0000	1.4
+++ mono-vector.sml	25 Jun 2003 23:15:32 -0000	1.5
@@ -5,25 +5,39 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure Word8Vector = EqtypeMonoVector(type elem = Word8.word)
-structure Word8VectorSlice = Word8Vector.MonoVectorSlice
+
+(* Char *)
 (* Moved to text/string0.sml
 structure CharVector = MonoVector(type elem = char)
 structure CharVectorSlice = CharVector.MonoVectorSlice
 *)
-structure CharVector = EqtypeMonoVector(type elem = char)
-structure CharVectorSlice = CharVector.MonoVectorSlice
+
+(* Bool *)
 structure BoolVector = EqtypeMonoVector(type elem = bool)
 structure BoolVectorSlice = BoolVector.MonoVectorSlice
+
+(* Int *)
 structure IntVector = EqtypeMonoVector(type elem = int)
 structure IntVectorSlice = IntVector.MonoVectorSlice
 structure Int32Vector = IntVector
 structure Int32VectorSlice = Int32Vector.MonoVectorSlice
+structure Int16Vector = EqtypeMonoVector(type elem = Int16.int)
+structure Int16VectorSlice = Int16Vector.MonoVectorSlice
+structure Int8Vector = EqtypeMonoVector(type elem = Int8.int)
+structure Int8VectorSlice = Int8Vector.MonoVectorSlice
+
+(* Real *)
 structure RealVector = MonoVector(type elem = real)
 structure RealVectorSlice = RealVector.MonoVectorSlice
 structure Real64Vector = RealVector
 structure Real64VectorSlice = Real64Vector.MonoVectorSlice
+
+(* Word *)
 structure WordVector = EqtypeMonoVector(type elem = word)
 structure WordVectorSlice = WordVector.MonoVectorSlice
 structure Word32Vector = WordVector
 structure Word32VectorSlice = Word32Vector.MonoVectorSlice
+structure Word16Vector = EqtypeMonoVector(type elem = Word16.word)
+structure Word16VectorSlice = Word16Vector.MonoVectorSlice
+structure Word8Vector = EqtypeMonoVector(type elem = Word8.word)
+structure Word8VectorSlice = Word8Vector.MonoVectorSlice



1.2       +0 -3      mlton/basis-library/integer/int16.sml

Index: int16.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int16.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- int16.sml	24 Jun 2003 17:35:52 -0000	1.1
+++ int16.sml	25 Jun 2003 23:15:32 -0000	1.2
@@ -9,9 +9,6 @@
    Integer
    (structure P = Primitive.Int16
     open P
-    val precision' : Int.int = 16
-    val maxInt' : int = 0x7fff
-    val minInt' : int = ~0x8000
    )
       
 



1.6       +2 -174    mlton/basis-library/integer/int32.sml

Index: int32.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int32.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- int32.sml	24 Jun 2003 17:35:52 -0000	1.5
+++ int32.sml	25 Jun 2003 23:15:32 -0000	1.6
@@ -5,182 +5,10 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-(*
-structure Int32: INTEGER_EXTRA =
-   struct
-      structure Int = Primitive.Int
-      open Int
-
-      val precision: int option = SOME 32
-
-      val maxInt: int option = SOME 0x7fffffff
-      val minInt: int option = SOME ~0x80000000
-      local fun ident x = x
-      in val toInt = ident
-	 val fromInt = ident
-      end
-      (* These are overriden in patch.sml after int-inf.sml has been defined. *)
-      val toLarge: int -> LargeInt.int = fn _ => raise Fail "toLarge"
-      val fromLarge: LargeInt.int -> int = fn _ => raise Fail "fromLarge"
-
-      val maxInt' = valOf maxInt
-      val minInt' = valOf minInt
-
-      val detectOverflow = Primitive.detectOverflow
-	 
-      fun quot (x, y) =
-	 if y = 0
-	    then raise Div
-	 else if detectOverflow andalso x = minInt' andalso y = ~1
-		 then raise Overflow
-	      else Int.quot (x, y)
-		 
-      fun rem (x, y) =
-	 if y = 0
-	    then raise Div
-	 else if x = minInt' andalso y = ~1
-		 then 0
-	      else Int.rem (x, y)
-   
-      fun x div y =
-	 if x >= 0
-	    then if y > 0
-		    then Int.quot (x, y)
-		 else if y < 0
-			 then if x = 0
-				 then 0
-			      else Int.quot (x - 1, y) -? 1
-		      else raise Div
-	 else if y < 0
-		 then if detectOverflow andalso x = minInt' andalso y = ~1
-			 then raise Overflow
-		      else Int.quot (x, y)
-	      else if y > 0
-		      then Int.quot (x + 1, y) -? 1
-		   else raise Div
-
-      fun x mod y =
-	 if x >= 0
-	    then if y > 0
-		    then Int.rem (x, y)
-		 else if y < 0
-			 then if x = 0
-				 then 0
-			      else Int.rem (x - 1, y) +? (y + 1)
-		      else raise Div
-	 else if y < 0
-		 then if x = minInt' andalso y = ~1
-			 then 0
-		      else Int.rem (x, y)
-	      else if y > 0
-		      then Int.rem (x + 1, y) +? (y - 1)
-		   else raise Div
-
-      val sign: int -> int =
-	 fn 0 => 0
-	  | i => if i < 0 then ~1 else 1
-	       
-      fun sameSign (x, y) = sign x = sign y
-
-      fun abs (x: int) = if x < 0 then ~ x else x
-
-      val {compare, min, max} = Util.makeCompare (op <)
-
-      fun fmt radix (n: int): string =
-	 let
-	    val radix = fromInt (StringCvt.radixToInt radix)
-	    fun loop (q, chars) =
-	       let
-		  val chars =
-		     StringCvt.digitToChar (toInt (~? (rem (q, radix)))) :: chars
-		  val q = quot (q, radix)
-	       in if q = 0
-		     then String0.implode (if n < 0 then #"~" :: chars
-					   else chars)
-		  else loop (q, chars)
-	       end
-	 in loop (if n < 0 then n else ~? n, [])
-	 end
-      
-      val toString = fmt StringCvt.DEC
-	 
-      fun scan radix reader state =
-	 let
-	    (* Works with the negative of the number so that minInt can
-	     * be scanned.
-	     *)
-	    val state = StringCvt.skipWS reader state
-	    val charToDigit = fromInt (StringCvt.charToDigit radix)
-	    val radixInt = fromInt (StringCvt.radixToInt radix)
-	    fun finishNum (state, n) =
-	       case reader state of
-		  NONE => SOME (n, state)
-		| SOME (c, state') =>
-		     case charToDigit c of
-			NONE => SOME (n, state)
-		      | SOME n' => finishNum (state', n * radixInt - n')
-	    fun num state =
-	       case (reader state, radix) of
-		  (NONE, _) => NONE
-		| (SOME (#"0", state), StringCvt.HEX) =>
-		     (case reader state of
-			 NONE => SOME (0, state)
-		       | SOME (c, state') =>
-			    let
-			       fun rest () =
-				  case reader state' of
-				     NONE => SOME (0, state)
-				   | SOME (c, state') =>
-					case charToDigit c of
-					   NONE => SOME (0, state)
-					 | SOME n => finishNum (state', ~? n)
-			    in case c of
-			       #"x" => rest ()
-			     | #"X" => rest ()
-			     | _ => (case charToDigit c of
-					NONE => SOME (0, state)
-				      | SOME n => finishNum (state', ~? n))
-			    end)
-		| (SOME (c, state), _) =>
-		     (case charToDigit c of
-			 NONE => NONE
-		       | SOME n => finishNum (state, ~? n))
-	    fun negate state =
-	       case num state of
-		  NONE => NONE
-		| SOME (n, s) => SOME (~ n, s)
-	 in case reader state of
-	    NONE => NONE
-	  | SOME (c, state') =>
-	       case c of
-		  #"~" => num state'
-		| #"-" => num state'
-		| #"+" => negate state'
-		| _ => negate state
-	 end
-      
-      val fromString = fromInt o (StringCvt.scanString (scan StringCvt.DEC))
-
-      fun power {base, exp} =
-	 if Primitive.safe andalso exp < 0
-	    then raise Fail "Int.power"
-	 else let
-		 fun loop (exp, accum) =
-		    if exp <= 0
-		       then accum
-		    else loop (exp - 1, base * accum)
-	      in loop (exp, 1)
-	      end
-   end
-*)
-
 structure Int32 : INTEGER_EXTRA =
-  Integer
-  (structure P = Primitive.Int32
+   Integer
+   (structure P = Primitive.Int32
     open P
-    val precision' : Int.int = 32
-    val maxInt' : int = 0x7fffffff
-    val minInt' : int = ~0x80000000
    )
 structure Int = Int32
 structure IntGlobal: INTEGER_GLOBAL = Int



1.2       +0 -3      mlton/basis-library/integer/int8.sml

Index: int8.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int8.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- int8.sml	24 Jun 2003 17:35:52 -0000	1.1
+++ int8.sml	25 Jun 2003 23:15:32 -0000	1.2
@@ -9,9 +9,6 @@
    Integer
    (structure P = Primitive.Int8
     open P
-    val precision' : Int.int = 8
-    val maxInt' : int = 0x7f
-    val minInt' : int = ~0x80
    )
       
 



1.3       +21 -9     mlton/basis-library/integer/integer.fun

Index: integer.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/integer.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- integer.fun	25 Jun 2003 21:22:53 -0000	1.2
+++ integer.fun	25 Jun 2003 23:15:32 -0000	1.3
@@ -11,28 +11,40 @@
 struct
 
 open I
+structure PI = Primitive.Int
 
 val detectOverflow = Primitive.detectOverflow
 
-fun fromInt (i: Int.int): int =
-   if not detectOverflow
-      orelse (Primitive.Int.<= (toInt minInt', i)
-	      andalso Primitive.Int.<= (i, toInt maxInt'))
-      then I.fromInt i
-   else raise Overflow
+val (toInt, fromInt) =
+   if detectOverflow andalso
+      precision' <> PI.precision'
+      then if PI.<(precision', PI.precision')
+	     then (I.toInt, 
+		   fn i =>
+		   if (PI.<= (I.toInt minInt', i)
+		       andalso PI.<= (i, I.toInt maxInt'))
+		      then I.fromInt i
+		   else raise Overflow)
+	     else (fn i => 
+		   if (I.<= (I.fromInt PI.minInt', i)
+		       andalso I.<= (i, I.fromInt PI.maxInt'))
+		      then I.toInt i
+		   else raise Overflow,
+		   I.fromInt)
+   else (I.toInt, I.fromInt)
 
 val precision: Int.int option = SOME precision'
 
 val maxInt: int option = SOME maxInt'
 val minInt: int option = SOME minInt'
 
+val one: int = fromInt 1
+val zero: int = fromInt 0
+
 (* These are overriden in patch.sml after int-inf.sml has been defined. *)
 val toLarge: int -> LargeInt.int = fn _ => raise Fail "toLarge"
 val fromLarge: LargeInt.int -> int = fn _ => raise Fail "fromLarge"
 
-val zero: int = fromInt 0
-val one: int = fromInt 1
-	 
 fun quot (x, y) =
   if y = zero
     then raise Div



1.5       +22 -9     mlton/basis-library/integer/patch.sml

Index: patch.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/patch.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- patch.sml	24 Jun 2003 17:35:52 -0000	1.4
+++ patch.sml	25 Jun 2003 23:15:32 -0000	1.5
@@ -15,24 +15,26 @@
       val fromLarge = IntInf.toInt
       val toLarge = IntInf.fromInt
    end
-structure Int = Int32
-structure Position = Int
-structure FixedInt = Int
 structure Int16: INTEGER_EXTRA =
    struct
       open Int16
        
-      val fromLarge = fromInt o Int.fromLarge
-      val toLarge = Int.toLarge o toInt
+      val fromLarge = fromInt o Int32fromLarge
+      val toLarge = Int32toLarge o toInt
    end
 structure Int8: INTEGER_EXTRA =
    struct
       open Int8
        
-      val fromLarge = fromInt o Int.fromLarge
-      val toLarge = Int.toLarge o toInt
+      val fromLarge = fromInt o Int32fromLarge
+      val toLarge = Int32toLarge o toInt
    end
 
+structure Int = Int32
+structure Position = Int
+structure FixedInt = Int
+
+
 structure Word8: WORD_EXTRA =
    struct
       open Word8
@@ -40,8 +42,19 @@
       val toLargeIntX = IntInf.fromInt o toIntX
       val toLargeInt = IntInf.fromInt o toInt
 
-     fun fromLargeInt (i: IntInf.int): word =
-	fromInt (IntInf.toInt (IntInf.mod (i, 256)))
+      fun fromLargeInt (i: IntInf.int): word =
+	 fromInt (IntInf.toInt (IntInf.mod (i, 256)))
+   end
+
+structure Word16: WORD_EXTRA =
+   struct
+      open Word16
+
+      val toLargeIntX = IntInf.fromInt o toIntX
+      val toLargeInt = IntInf.fromInt o toInt
+
+      fun fromLargeInt (i: IntInf.int): word =
+	 fromInt (IntInf.toInt (IntInf.mod (i, 65536)))
    end
 
 structure Word32: WORD32_EXTRA =



1.4       +54 -3     mlton/basis-library/integer/word.fun

Index: word.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word.fun	25 Apr 2002 19:28:18 -0000	1.3
+++ word.fun	25 Jun 2003 23:15:32 -0000	1.4
@@ -6,12 +6,46 @@
  * Please see the file MLton-LICENSE for license information.
  *)
 functor Word (W: sig
-		   include PRE_WORD
-		   val zero: word
-		end) =
+		   include PRE_WORD_EXTRA
+		end) : WORD_EXTRA =
 struct
 
 open W
+structure PW = Primitive.Word
+
+val detectOverflow = Primitive.detectOverflow
+
+(* These are overriden in patch.sml after int-inf.sml has been defined. *)
+val toLargeInt: word -> LargeInt.int = fn _ => raise Fail "toLargeInt"
+val toLargeIntX: word -> LargeInt.int = fn _ => raise Fail "toLargeIntX"
+val fromLargeInt: LargeInt.int -> word = fn _ => raise Fail "fromLargeInt"
+
+val wordSizeWord: Word.word = PW.fromInt wordSize
+val wordSizeMinusOneWord: Word.word = PW.fromInt (Int.-?(wordSize, 1))
+val zero: word = fromInt 0
+val one: word = fromInt 1
+val highBit: word = <<(one, wordSizeMinusOneWord)
+val allOnes: word = ~>>(highBit, wordSizeMinusOneWord)
+
+val (toInt,toIntX) =
+  if detectOverflow andalso
+     Int.>=(wordSize, Int.precision')
+    then let
+           val max: word = fromInt (Int.maxInt')
+	   val shift: Word.word = PW.fromInt (Int.-?(Int.precision', 1))
+	 in
+	   (fn w => if w > max 
+		      then raise Overflow 
+		      else W.toInt w,
+	    fn w => let
+		      val w' = ~>>(w, shift)
+		    in
+		      if (w' = zero) orelse (w' = allOnes)
+			then W.toIntX w
+			else raise Overflow
+		    end)
+	 end
+    else (W.toInt, W.toIntX)
 
 local
    fun make f (w, w') =
@@ -21,6 +55,23 @@
 in val op div = make (op div)
    val op mod = make (op mod)
 end
+
+fun << (i, n) 
+  = if PW.>=(n ,wordSizeWord)
+      then zero
+      else W.<<(i, n)
+
+fun >> (i, n) 
+  = if PW.>=(n, wordSizeWord)
+      then zero
+      else W.>>(i, n)
+
+fun ~>> (i, n) 
+  = if PW.<(n, wordSizeWord)
+      then W.~>>(i, n)
+      else W.~>>(i, wordSizeMinusOneWord)
+
+val {compare, min, max} = Util.makeCompare(op <)
 
 fun fmt radix (w: word): string =
    let val radix = fromInt (StringCvt.radixToInt radix)



1.5       +8 -3      mlton/basis-library/integer/word.sig

Index: word.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- word.sig	24 Nov 2002 01:19:35 -0000	1.4
+++ word.sig	25 Jun 2003 23:15:32 -0000	1.5
@@ -37,19 +37,23 @@
       val div: word * word -> word 
       val mod: word * word -> word
       val ~ : word -> word
-      val compare: word * word -> order 
       val < : word * word -> bool 
       val > : word * word -> bool 
       val >= : word * word -> bool 
       val <= : word * word -> bool 
-      val min: word * word -> word 
-      val max: word * word -> word
+   end
+signature PRE_WORD_EXTRA =
+   sig
+      include PRE_WORD
    end
 
 signature WORD =
    sig
       include PRE_WORD
 	 
+      val compare: word * word -> order 
+      val min: word * word -> word 
+      val max: word * word -> word
       val toLargeInt: word -> LargeInt.int 
       val toLargeIntX: word -> LargeInt.int 
       val fromLargeInt: LargeInt.int -> word
@@ -64,6 +68,7 @@
 signature WORD_EXTRA =
    sig
       include WORD
+      (* include PRE_WORD_EXTRA *)
    end
 
 signature WORD32_EXTRA =



1.4       +2 -45     mlton/basis-library/integer/word32.sml

Index: word32.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word32.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word32.sml	25 Apr 2002 19:28:18 -0000	1.3
+++ word32.sml	25 Jun 2003 23:15:32 -0000	1.4
@@ -9,50 +9,7 @@
    Word
    (structure P = Primitive.Word32
     open P
-       
-    val wordSize: int = 32
-    val wordSizeWord: word = 0w32
-    val zero: word = 0w0
-
-    local
-       fun id x = x
-    in
-       val toLargeWord = id
-       val toLargeWordX = id
-       val fromLargeWord = id
-    end
-
-    fun highBitSet w = Int.<(toIntX w, 0)
-
-    (* This assumes that Words and Ints have the same number of bits.
-     * toInt w is supposed to treat w as unsigned.  Thus, if the high bit is
-     * set in w, it will be unrepresentable as a twos-complement integer with
-     * the same number of bits.
-     *)
-    fun toInt w =
-       if Primitive.safe andalso highBitSet w
-	  then raise Overflow
-       else toIntX w
-
-    val {compare, min, max} = Util.makeCompare(op <)
-
-    fun << (i, n) 
-      = if n >= wordSizeWord
-	  then zero
-	  else P.<<(i, n)
-
-    fun >> (i, n) 
-      = if n >= wordSizeWord
-	  then zero
-	  else P.>>(i, n)
-
-    fun ~>> (i, n) 
-      = if n < wordSizeWord
-	  then P.~>>(i, n)
-	  else P.~>>(i, wordSizeWord - 0w1)
-       )
-
+   )
+structure Word = Word32
 structure WordGlobal: WORD_GLOBAL = Word
 open WordGlobal
-
-



1.4       +1 -25     mlton/basis-library/integer/word8.sml

Index: word8.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word8.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word8.sml	25 Apr 2002 19:28:18 -0000	1.3
+++ word8.sml	25 Jun 2003 23:15:32 -0000	1.4
@@ -9,30 +9,6 @@
    Word
    (structure P = Primitive.Word8
     open P
-       
-    val wordSize: int = 8
-    val wordSizeWord : Primitive.Word32.word = 0w8
-
-    val highBit: word = 0wx80
-    val allOnes: word = 0wxFF
-    val zero: word = 0w0
-
-    val {compare, min, max} = Util.makeCompare(op <)
-
-    fun << (i, n) 
-      = if Primitive.Word32.>=(n ,wordSizeWord)
-	  then zero
-	  else P.<<(i, n)
-
-    fun >> (i, n) 
-      = if Primitive.Word32.>=(n, wordSizeWord)
-	  then zero
-	  else P.>>(i, n)
-
-    fun ~>> (i, n) 
-      = if Primitive.Word32.<(n, wordSizeWord)
-	  then P.~>>(i, n)
-	  else P.~>>(i, Primitive.Word32.-(wordSizeWord, 0w1))
-       )
+   )
 
 



1.1                  mlton/basis-library/integer/word16.sml

Index: word16.sml
===================================================================
(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
 *    Jagannathan, and Stephen Weeks.
 * Copyright (C) 1997-1999 NEC Research Institute.
 *
 * MLton is released under the GNU General Public License (GPL).
 * Please see the file MLton-LICENSE for license information.
 *)
structure Word16 =
   Word
   (structure P = Primitive.Word16
    open P
   )



1.18      +2 -1      mlton/basis-library/libs/build

Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- build	24 Jun 2003 20:48:01 -0000	1.17
+++ build	25 Jun 2003 23:15:32 -0000	1.18
@@ -58,8 +58,9 @@
 misc/C.sml
 integer/word.sig
 integer/word.fun
-integer/word32.sml
 integer/word8.sml
+integer/word16.sml
+integer/word32.sml
 integer/int-inf.sig
 integer/int-inf.sml
 real/IEEE-real.sig



1.7       +66 -1     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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- basis.sig	24 Jun 2003 17:35:52 -0000	1.6
+++ basis.sig	25 Jun 2003 23:15:32 -0000	1.7
@@ -119,13 +119,13 @@
       structure Timer : TIMER	
       structure VectorSlice : VECTOR_SLICE	
       structure Vector : VECTOR	
+      structure Word : WORD	
       structure Word8 : WORD	
       structure Word8Array : MONO_ARRAY	
       structure Word8ArraySlice : MONO_ARRAY_SLICE	
       structure Word8Vector : MONO_VECTOR	
       structure Word8VectorSlice : MONO_VECTOR_SLICE	
       structure Word8Array2 : MONO_ARRAY2	
-      structure Word : WORD	
 
       (* Optional structures *)
       structure Array2 : ARRAY2
@@ -144,7 +144,17 @@
       structure IntVectorSlice : MONO_VECTOR_SLICE
       structure IntArray2 : MONO_ARRAY2
       structure Int8 : INTEGER
+      structure Int8Array : MONO_ARRAY
+      structure Int8ArraySlice : MONO_ARRAY_SLICE
+      structure Int8Vector : MONO_VECTOR
+      structure Int8VectorSlice : MONO_VECTOR_SLICE
+      structure Int8Array2 : MONO_ARRAY2
       structure Int16 : INTEGER
+      structure Int16Array : MONO_ARRAY
+      structure Int16ArraySlice : MONO_ARRAY_SLICE
+      structure Int16Vector : MONO_VECTOR
+      structure Int16VectorSlice : MONO_VECTOR_SLICE
+      structure Int16Array2 : MONO_ARRAY2
       structure Int32 : INTEGER
       structure Int32Array : MONO_ARRAY
       structure Int32ArraySlice : MONO_ARRAY_SLICE
@@ -196,6 +206,17 @@
 (*
       structure Windows : WINDOWS
 *)
+      structure WordArray : MONO_ARRAY	
+      structure WordArraySlice : MONO_ARRAY_SLICE	
+      structure WordVector : MONO_VECTOR	
+      structure WordVectorSlice : MONO_VECTOR_SLICE	
+      structure WordArray2 : MONO_ARRAY2	
+      structure Word16 : WORD
+      structure Word16Array : MONO_ARRAY
+      structure Word16ArraySlice : MONO_ARRAY_SLICE
+      structure Word16Vector : MONO_VECTOR
+      structure Word16VectorSlice : MONO_VECTOR_SLICE
+      structure Word16Array2 : MONO_ARRAY2
       structure Word32 : WORD
       structure Word32Array : MONO_ARRAY
       structure Word32ArraySlice : MONO_ARRAY_SLICE
@@ -299,6 +320,28 @@
       sharing type IntVectorSlice.vector = IntVector.vector
       sharing type IntArray2.elem = int
       sharing type IntArray2.vector = IntVector.vector
+      sharing type Int8Array.elem = Int8.int
+      sharing type Int8Array.vector = Int8Vector.vector
+      sharing type Int8ArraySlice.elem = Int8.int
+      sharing type Int8ArraySlice.array = Int8Array.array
+      sharing type Int8ArraySlice.vector = Int8Vector.vector
+      sharing type Int8ArraySlice.vector_slice = Int8VectorSlice.slice
+      sharing type Int8Vector.elem = Int8.int
+      sharing type Int8VectorSlice.elem = Int8.int
+      sharing type Int8VectorSlice.vector = Int8Vector.vector
+      sharing type Int8Array2.elem = Int8.int
+      sharing type Int8Array2.vector = Int8Vector.vector
+      sharing type Int16Array.elem = Int16.int
+      sharing type Int16Array.vector = Int16Vector.vector
+      sharing type Int16ArraySlice.elem = Int16.int
+      sharing type Int16ArraySlice.array = Int16Array.array
+      sharing type Int16ArraySlice.vector = Int16Vector.vector
+      sharing type Int16ArraySlice.vector_slice = Int16VectorSlice.slice
+      sharing type Int16Vector.elem = Int16.int
+      sharing type Int16VectorSlice.elem = Int16.int
+      sharing type Int16VectorSlice.vector = Int16Vector.vector
+      sharing type Int16Array2.elem = Int16.int
+      sharing type Int16Array2.vector = Int16Vector.vector
       sharing type Int32Array.elem = Int32.int
       sharing type Int32Array.vector = Int32Vector.vector
       sharing type Int32ArraySlice.elem = Int32.int
@@ -345,6 +388,28 @@
       sharing type Real64Array2.elem = Real64.real
       sharing type Real64Array2.vector = Real64Vector.vector
       sharing type Unix.exit_status = Posix.Process.exit_status
+      sharing type WordArray.elem = Word.word
+      sharing type WordArray.vector = WordVector.vector
+      sharing type WordArraySlice.elem = Word.word
+      sharing type WordArraySlice.array = WordArray.array
+      sharing type WordArraySlice.vector = WordVector.vector
+      sharing type WordArraySlice.vector_slice = WordVectorSlice.slice
+      sharing type WordVector.elem = Word.word
+      sharing type WordVectorSlice.elem = Word.word
+      sharing type WordVectorSlice.vector = WordVector.vector
+      sharing type WordArray2.elem = Word.word
+      sharing type WordArray2.vector = WordVector.vector
+      sharing type Word16Array.elem = Word16.word
+      sharing type Word16Array.vector = Word16Vector.vector
+      sharing type Word16ArraySlice.elem = Word16.word
+      sharing type Word16ArraySlice.array = Word16Array.array
+      sharing type Word16ArraySlice.vector = Word16Vector.vector
+      sharing type Word16ArraySlice.vector_slice = Word16VectorSlice.slice
+      sharing type Word16Vector.elem = Word16.word
+      sharing type Word16VectorSlice.elem = Word16.word
+      sharing type Word16VectorSlice.vector = Word16Vector.vector
+      sharing type Word16Array2.elem = Word16.word
+      sharing type Word16Array2.vector = Word16Vector.vector
       sharing type Word32Array.elem = Word32.word
       sharing type Word32Array.vector = Word32Vector.vector
       sharing type Word32ArraySlice.elem = Word32.word



1.7       +22 -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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- basis.sml	24 Jun 2003 17:35:52 -0000	1.6
+++ basis.sml	25 Jun 2003 23:15:32 -0000	1.7
@@ -63,7 +63,17 @@
       structure IntVectorSlice = IntVectorSlice
       structure IntArray2 = IntArray2
       structure Int8 = Int8
+      structure Int8Array = Int8Array
+      structure Int8ArraySlice = Int8ArraySlice
+      structure Int8Vector = Int8Vector
+      structure Int8VectorSlice = Int8VectorSlice
+      structure Int8Array2 = Int8Array2
       structure Int16 = Int16
+      structure Int16Array = Int16Array
+      structure Int16ArraySlice = Int16ArraySlice
+      structure Int16Vector = Int16Vector
+      structure Int16VectorSlice = Int16VectorSlice
+      structure Int16Array2 = Int16Array2
       structure Int32 = Int32
       structure Int32Array = Int32Array
       structure Int32ArraySlice = Int32ArraySlice
@@ -115,6 +125,18 @@
 (*
       structure Windows = Windows
 *)
+      structure Word = Word
+      structure WordArray = WordArray
+      structure WordArraySlice = WordArraySlice
+      structure WordVector = WordVector
+      structure WordVectorSlice = WordVectorSlice
+      structure WordArray2 = WordArray2
+      structure Word16 = Word16
+      structure Word16Array = Word16Array
+      structure Word16ArraySlice = Word16ArraySlice
+      structure Word16Vector = Word16Vector
+      structure Word16VectorSlice = Word16VectorSlice
+      structure Word16Array2 = Word16Array2
       structure Word32 = Word32
       structure Word32Array = Word32Array
       structure Word32ArraySlice = Word32ArraySlice



1.60      +20 -0     mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -r1.59 -r1.60
--- primitive.sml	24 Jun 2003 20:48:01 -0000	1.59
+++ primitive.sml	25 Jun 2003 23:15:32 -0000	1.60
@@ -278,6 +278,9 @@
       structure Int8 =
 	 struct
 	    type int = int8
+	    val precision' : Int.int = 8
+	    val maxInt' : int = 0x7f
+	    val minInt' : int = ~0x80
 
 	    val *? = _prim "Int8_mul": int * int -> int;
 	    val * =
@@ -311,6 +314,9 @@
       structure Int16 =
 	 struct
 	    type int = int16
+	    val precision' : Int.int = 16
+	    val maxInt' : int = 0x7fff
+	    val minInt' : int = ~0x8000
 
 	    val *? = _prim "Int16_mul": int * int -> int;
 	    val * =
@@ -344,6 +350,9 @@
       structure Int32 =
 	 struct
 	    type int = int32
+	    val precision' : Int.int = 32
+	    val maxInt' : int = 0x7fffffff
+	    val minInt' : int = ~0x80000000
 
 	    val *? = _prim "Int32_mul": int * int -> int;
 	    val * =
@@ -964,8 +973,10 @@
       structure Word8 =
 	 struct
 	    type word = word8
+	    val wordSize: int = 8
 
 	    val + = _prim "Word8_add": word * word -> word;
+	    val addCheck = _prim "Word8_addCheck": word * word -> word;
 	    val andb = _prim "Word8_andb": word * word -> word;
 	    val ~>> = _prim "Word8_arshift": word * word32 -> word;
 	    val div = _prim "Word8_div": word * word -> word;
@@ -978,6 +989,7 @@
 	    val < = _prim "Word8_lt" : word * word -> bool;
 	    val mod = _prim "Word8_mod": word * word -> word;
 	    val * = _prim "Word8_mul": word * word -> word;
+	    val mulCheck = _prim "Word8_mulCheck": word * word -> word;
 	    val ~ = _prim "Word8_neg": word -> word;
 	    val notb = _prim "Word8_notb": word -> word;
 	    val orb = _prim "Word8_orb": word * word -> word;
@@ -1009,8 +1021,10 @@
       structure Word16 =
 	 struct
 	    type word = word16
+	    val wordSize: int = 16
 
 	    val + = _prim "Word16_add": word * word -> word;
+	    val addCheck = _prim "Word16_addCheck": word * word -> word;
 	    val andb = _prim "Word16_andb": word * word -> word;
 	    val ~>> = _prim "Word16_arshift": word * word32 -> word;
 	    val div = _prim "Word16_div": word * word -> word;
@@ -1023,6 +1037,7 @@
 	    val < = _prim "Word16_lt" : word * word -> bool;
 	    val mod = _prim "Word16_mod": word * word -> word;
 	    val * = _prim "Word16_mul": word * word -> word;
+	    val mulCheck = _prim "Word16_mulCheck": word * word -> word;
 	    val ~ = _prim "Word16_neg": word -> word;
 	    val notb = _prim "Word16_notb": word -> word;
 	    val orb = _prim "Word16_orb": word * word -> word;
@@ -1040,6 +1055,7 @@
       structure Word32 =
 	 struct
 	    type word = word32
+	    val wordSize: int = 32
 
 	    val + = _prim "Word32_add": word * word -> word;
 	    val addCheck = _prim "Word32_addCheck": word * word -> word;
@@ -1047,6 +1063,7 @@
 	    val ~>> = _prim "Word32_arshift": word * word -> word;
 	    val div = _prim "Word32_div": word * word -> word;
 	    val fromInt = _prim "Int32_toWord32": int -> word;
+	    val fromLargeWord : word -> word = fn x => x
 	    val >= = _prim "Word32_ge": word * word -> bool;
 	    val > = _prim "Word32_gt" : word * word -> bool;
 	    val <= = _prim "Word32_le": word * word -> bool;
@@ -1062,7 +1079,10 @@
 	    val ror = _prim "Word32_ror": word * word -> word;
 	    val >> = _prim "Word32_rshift": word * word -> word;
 	    val - = _prim "Word32_sub": word * word -> word;
+	    val toInt = _prim "Word32_toInt32": word -> int;
 	    val toIntX = _prim "Word32_toInt32X": word -> int;
+	    val toLargeWord : word -> word = fn x => x
+	    val toLargeWordX : word -> word = fn x => x
 	    val xorb = _prim "Word32_xorb": word * word -> word;
 	 end
       structure Word = Word32



1.8       +48 -6     mlton/include/c-chunk.h

Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- c-chunk.h	25 Jun 2003 21:22:53 -0000	1.7
+++ c-chunk.h	25 Jun 2003 23:15:33 -0000	1.8
@@ -617,25 +617,67 @@
 	static inline t f##_to##t (f x) {	\
 		return (t)x;			\
 	}
-coerce (Int8, Int32)
+coerce (Int32, Int32)
+coerce (Int32, Int16)
 coerce (Int32, Int8)
 coerce (Int16, Int32)
-coerce (Int32, Int16)
-coerce (Int32, Real64)
-coerce (Int32, Word8)
+coerce (Int16, Int16)
+coerce (Int16, Int8)
+coerce (Int8, Int32)
+coerce (Int8, Int16)
+coerce (Int8, Int8)
 coerce (Int32, Word32)
+coerce (Int32, Word16)
+coerce (Int32, Word8)
+coerce (Int16, Word32)
+coerce (Int16, Word16)
+coerce (Int16, Word8)
+coerce (Int8, Word32)
+coerce (Int8, Word16)
+coerce (Int8, Word8)
+coerce (Int32, Real64)
+coerce (Word32, Int32)
+coerce (Word32, Int16)
+coerce (Word32, Int8)
+coerce (Word16, Int32)
+coerce (Word16, Int16)
+coerce (Word16, Int8)
 coerce (Word8, Int32)
-coerce (Word8, Word32)
+coerce (Word8, Int16)
+coerce (Word8, Int8)
+coerce (Word32, Word32)
+coerce (Word32, Word16)
 coerce (Word32, Word8)
+coerce (Word16, Word32)
+coerce (Word16, Word16)
+coerce (Word16, Word8)
+coerce (Word8, Word32)
+coerce (Word8, Word16)
+coerce (Word8, Word8)
 #undef coerce
 
 #define coerceX(size, t)					\
 	static inline t Word##size##_to##t##X (Word##size x) {	\
 		return (t)(Int##size)x;				\
 	}
-coerceX (8, Int32)
 coerceX (32, Int32)
+coerceX (32, Int16)
+coerceX (32, Int8)
+coerceX (32, Word32)
+coerceX (32, Word16)
+coerceX (32, Word8)
+coerceX (16, Int32)
+coerceX (16, Int16)
+coerceX (16, Int8)
+coerceX (16, Word32)
+coerceX (16, Word16)
+coerceX (16, Word8)
+coerceX (8, Int32)
+coerceX (8, Int16)
+coerceX (8, Int8)
 coerceX (8, Word32)
+coerceX (8, Word16)
+coerceX (8, Word8)
 #undef coerceX
 
 #endif /* #ifndef _C_CHUNK_H_ */





-------------------------------------------------------
This SF.Net email is sponsored by: INetU
Attention Web Developers & Consultants: Become An INetU Hosting Partner.
Refer Dedicated Servers. We Manage Them. You Get 10% Monthly Commission!
INetU Dedicated Managed Hosting http://www.inetu.net/partner/index.php
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel