[MLton] cvs commit: eliminated the distinction between integers and words

Stephen Weeks sweeks@mlton.org
Fri, 30 Apr 2004 17:49:50 -0700


sweeks      04/04/30 17:49:49

  Modified:    basis-library/integer embed-int.sml int.sml integer.sig
               basis-library/misc primitive.sml
               include  c-chunk.h
               mlton/ast int-size.fun int-size.sig word-size.fun
                        word-size.sig
               mlton/atoms atoms.fun atoms.sig const.fun const.sig
                        hash-type.fun hash-type.sig prim.fun prim.sig
                        sources.cm type-ops.fun type-ops.sig word-x.fun
                        word-x.sig
               mlton/backend backend.fun backend.sig limit-check.fun
                        machine.fun machine.sig packed-representation.fun
                        rep-type.fun rep-type.sig representation.fun
                        representation.sig rssa.fun rssa.sig
                        ssa-to-rssa.fun ssa-to-rssa.sig switch.fun
               mlton/closure-convert closure-convert.fun
               mlton/codegen/c-codegen c-codegen.fun c-codegen.sig
               mlton/codegen/x86-codegen x86-codegen.fun x86-codegen.sig
                        x86-mlton.fun x86-mlton.sig x86-translate.fun
               mlton/defunctorize defunctorize.fun
               mlton/elaborate const-type.sig elaborate-core.fun
                        elaborate.fun type-env.fun type-env.sig
               mlton/main compile.fun lookup-constant.fun main.sml
               mlton/match-compile match-compile.fun match-compile.sig
               mlton/ssa analyze.fun analyze.sig common-subexp.fun
                        constant-propagation.fun direct-exp.fun
                        direct-exp.sig poly-equal.fun redundant-tests.fun
                        remove-unused.fun shrink.fun ssa-tree.fun
                        ssa-tree.sig type-check.fun useless.fun
               mlton/xml monomorphise.fun polyvariance.fun shrink.fun
                        simplify-types.fun type-check.fun xml-tree.fun
                        xml-tree.sig
               runtime  Makefile types.h
               runtime/basis/Int Word64.c quot.c
  Removed:     runtime/basis/Int Int64.c addOverflow.c mulOverflow.c
                        subOverflow.c
  Log:
  MAIL eliminated the distinction between integers and words
  
  Eliminated the distinction between integers and words from all ILs.
  Now, there are only words.  Integers are replaced by words immediately
  after front end type checking.  There are no longer any integer
  primitives; instead, there are signed and unsigned versions of word
  primitives (when a distinction needs to be made).  This simplified
  constant folding, as well as makes all the ILs and optimizer passes
  slightly simpler because there's one less thing to worry about.  It
  also makes the codegens simpler, because they have one less kind of
  constant to worry about (there was some pretty messy code in the
  x86-codegen for integer constants that is now gone).
  
  The names of many word and integer primitives in the basis library
  primitive.sml has changed.  Likewise, so have the names of these
  primitives in the C codegen and runtime.
  
  Moved the code that checks whether a codegen implements a primitive
  from SsaToRssa into each of the codegens.  The backend (and SsaToRssa)
  now takes "cogegenImplementsPrim" as a parameter.  This let me clean
  up x86-mlton.fun in the x86 codegen, because the code for testing
  whether a prim is implemented is separated from the code for
  implementing the prim.
  
  Fixed a bug in the SSA shrinker that could cause a label to be called
  with the wrong number of arguments.  The problem was in the code that
  tried to simplify a case expression if all branches went to the same
  label.  It forgot to check that the label took no arguments.
  
  Improved the implementation of weird-size integers, implementing the
  coercion from big to small using a single comparison.

Revision  Changes    Path
1.3       +16 -21    mlton/basis-library/integer/embed-int.sml

Index: embed-int.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/embed-int.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- embed-int.sml	25 Apr 2004 06:55:43 -0000	1.2
+++ embed-int.sml	1 May 2004 00:49:32 -0000	1.3
@@ -16,35 +16,30 @@
 
       open Small
 
-      val shift = Word.fromInt (Int.- (valOf Big.precision, Small.precision'))
-	 
-      val toBig: Small.int -> Big.int =
-	 fn s => Big.~>> (Big.<< (Small.toBig s, shift), shift)
+      val shift = Word.fromInt (Int.- (valOf Big.precision, precision'))
+
+      val extend: Big.int -> Big.int =
+	 fn i => Big.~>> (Big.<< (i, shift), shift)
+
+      val toBig: Small.int -> Big.int = extend o Small.toBig
 	 
       val precision = SOME precision'
 
-      val maxIntBig =
-	 Big.fromLarge
-	 (IntInf.- (LargeInt.<< (1, Word.fromInt (Int.- (precision', 1))),
-		    1))
+      val maxIntBig = Big.>> (Big.fromInt ~1, Word.+ (shift, 0w1))
 
       val minIntBig = Big.- (Big.~ maxIntBig, Big.fromInt 1)
 
+      val mask = Big.>> (Big.fromInt ~1, shift)
+
       fun fromBig (i: Big.int): int =
-	 if Big.< (i, Big.fromInt 0)
-	    then
-	       if Big.<= (minIntBig, i)
-		  then
-		     fromBigUnsafe
-		     (Big.- (i,
-			     Big.<< (Big.fromInt ~1,
-				     Word.fromInt Small.precision')))
-	       else raise Overflow
-	 else
-	    if Big.<= (i, maxIntBig)
-	       then fromBigUnsafe i
+	 let
+	    val i' = Big.andb (i, mask)
+	 in
+	    if i = extend i'
+	       then fromBigUnsafe i'
 	    else raise Overflow
-
+	 end
+	       
       val maxInt = SOME (fromBig maxIntBig)
 
       val minInt = SOME (fromBig minIntBig)



1.3       +1 -1      mlton/basis-library/integer/int.sml

Index: int.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- int.sml	16 Feb 2004 22:43:19 -0000	1.2
+++ int.sml	1 May 2004 00:49:32 -0000	1.3
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *



1.8       +5 -2      mlton/basis-library/integer/integer.sig

Index: integer.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/integer.sig,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- integer.sig	25 Apr 2004 06:55:43 -0000	1.7
+++ integer.sig	1 May 2004 00:49:32 -0000	1.8
@@ -36,10 +36,12 @@
       include PRE_INTEGER
 
       val << : int * Word.word -> int
+      val >> : int * Word.word -> int
       val ~>> : int * Word.word -> int
       val *? : int * int -> int
       val +? : int * int -> int
       val -? : int * int -> int
+      val andb : int * int -> int
       val maxInt' : int
       val minInt' : int
       val precision' : Int.int
@@ -76,14 +78,15 @@
       include INTEGER
 
       val << : int * Word.word -> int
+      val >> : int * Word.word -> int
       val ~>> : int * Word.word -> int
       val *? : int * int -> int
       val +? : int * int -> int
       val -? : int * int -> int
       val ~? : int -> int
-      val precision' : Int.int
+      val andb : int * int -> int
       val maxInt' : int
       val minInt' : int
-
       val power: {base: int, exp: int} -> int
+      val precision' : Int.int
    end



1.111     +287 -271  mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.110
retrieving revision 1.111
diff -u -r1.110 -r1.111
--- primitive.sml	28 Apr 2004 00:48:52 -0000	1.110
+++ primitive.sml	1 May 2004 00:49:33 -0000	1.111
@@ -183,20 +183,21 @@
 
       structure Char =
 	 struct
-	    val op < = _prim "Word8_lt": char * char -> bool;
-	    val op <= = _prim "Word8_le": char * char -> bool;
-	    val op > = _prim "Word8_gt": char * char -> bool;
-	    val op >= = _prim "Word8_ge": char * char -> bool;
-	    val chr = _prim "Int32_toWord8": int -> char;
-	    val ord = _prim "Word8_toInt32": char -> int;
-	    val toWord8 = _prim "Char_toWord8": char -> Word8.word;
+	    val op < = _prim "WordU8_lt": char * char -> bool;
+	    val op <= = _prim "WordU8_le": char * char -> bool;
+	    val op > = _prim "WordU8_gt": char * char -> bool;
+	    val op >= = _prim "WordU8_ge": char * char -> bool;
+	    val chr = _prim "WordS32_toWord8": int -> char;
+	    val ord = _prim "WordU8_toWord32": char -> int;
+	    val toWord8 = _prim "WordU8_toWord8": char -> Word8.word;
 	 end
 
       structure CommandLine =
 	 struct
 	    val argc = fn () => _import "CommandLine_argc": int;
 	    val argv = fn () => _import "CommandLine_argv": cstringArray;
-	    val commandName = fn () => _import "CommandLine_commandName": cstring;
+	    val commandName =
+	       fn () => _import "CommandLine_commandName": cstring;
 	 end
 
       structure Date =
@@ -287,8 +288,10 @@
       
       structure IEEEReal =
 	 struct
-	    val getRoundingMode = _import "IEEEReal_getRoundingMode": unit -> int;
-	    val setRoundingMode = _import "IEEEReal_setRoundingMode": int -> unit;
+	    val getRoundingMode =
+	       _import "IEEEReal_getRoundingMode": unit -> int;
+	    val setRoundingMode =
+	       _import "IEEEReal_setRoundingMode": int -> unit;
 	 end
 
       structure Int8 =
@@ -299,36 +302,38 @@
 	    val maxInt' : int = 0x7f
 	    val minInt' : int = ~0x80
 
-	    val *? = _prim "Int8_mul": int * int -> int;
+	    val *? = _prim "WordS8_mul": int * int -> int;
 	    val * =
 	       if detectOverflow
-		  then _prim "Int8_mulCheck": int * int -> int;
+		  then _prim "WordS8_mulCheck": int * int -> int;
 	       else *?
-	    val +? = _prim "Int8_add": int * int -> int;
+	    val +? = _prim "Word8_add": int * int -> int;
 	    val + =
 	       if detectOverflow
-		  then _prim "Int8_addCheck": int * int -> int;
+		  then _prim "WordS8_addCheck": int * int -> int;
 	       else +?
-	    val -? = _prim "Int8_sub": int * int -> int;
+	    val -? = _prim "Word8_sub": int * int -> int;
 	    val - =
 	       if detectOverflow
-		  then _prim "Int8_subCheck": int * int -> int;
+		  then _prim "WordS8_subCheck": int * int -> int;
 	       else -?
-	    val op < = _prim "Int8_lt": int * int -> bool;
-	    val op <= = _prim "Int8_le": int * int -> bool;
-	    val op > = _prim "Int8_gt": int * int -> bool;
-	    val op >= = _prim "Int8_ge": int * int -> bool;
-	    val quot = _prim "Int8_quot": int * int -> int;
-	    val rem = _prim "Int8_rem": int * int -> int;
-	    val << = _prim "Int8_lshift": int * Word.word -> int;
-	    val ~>> = _prim "Int8_arshift": int * Word.word -> int;
-	    val ~? = _prim "Int8_neg": int -> int; 
+	    val op < = _prim "WordS8_lt": int * int -> bool;
+	    val op <= = _prim "WordS8_le": int * int -> bool;
+	    val op > = _prim "WordS8_gt": int * int -> bool;
+	    val op >= = _prim "WordS8_ge": int * int -> bool;
+	    val quot = _prim "WordS8_quot": int * int -> int;
+	    val rem = _prim "WordS8_rem": int * int -> int;
+	    val << = _prim "Word8_lshift": int * Word.word -> int;
+	    val >> = _prim "WordU8_rshift": int * Word.word -> int;
+	    val ~>> = _prim "WordS8_rshift": int * Word.word -> int;
+	    val ~? = _prim "Word8_neg": int -> int; 
 	    val ~ =
 	       if detectOverflow
-		  then _prim "Int8_negCheck": int -> int;
+		  then _prim "Word8_negCheck": int -> int;
 	       else ~?
-	    val fromInt = _prim "Int32_toInt8": Int.int -> int;
-	    val toInt = _prim "Int8_toInt32": int -> Int.int;
+	    val andb = _prim "Word8_andb": int * int -> int;
+	    val fromInt = _prim "WordS32_toWord8": Int.int -> int;
+	    val toInt = _prim "WordS8_toWord32": int -> Int.int;
 	 end
       
       structure Int16 =
@@ -339,260 +344,262 @@
 	    val maxInt' : int = 0x7fff
 	    val minInt' : int = ~0x8000
 
-	    val *? = _prim "Int16_mul": int * int -> int;
+	    val *? = _prim "WordS16_mul": int * int -> int;
 	    val * =
 	       if detectOverflow
-		  then _prim "Int16_mulCheck": int * int -> int;
+		  then _prim "WordS16_mulCheck": int * int -> int;
 	       else *?
-	    val +? = _prim "Int16_add": int * int -> int;
+	    val +? = _prim "Word16_add": int * int -> int;
 	    val + =
 	       if detectOverflow
-		  then _prim "Int16_addCheck": int * int -> int;
+		  then _prim "WordS16_addCheck": int * int -> int;
 	       else +?
-	    val -? = _prim "Int16_sub": int * int -> int;
+	    val -? = _prim "Word16_sub": int * int -> int;
 	    val - =
 	       if detectOverflow
-		  then _prim "Int16_subCheck": int * int -> int;
+		  then _prim "WordS16_subCheck": int * int -> int;
 	       else -?
-	    val op < = _prim "Int16_lt": int * int -> bool;
-	    val op <= = _prim "Int16_le": int * int -> bool;
-	    val op > = _prim "Int16_gt": int * int -> bool;
-	    val op >= = _prim "Int16_ge": int * int -> bool;
-	    val quot = _prim "Int16_quot": int * int -> int;
-	    val rem = _prim "Int16_rem": int * int -> int;
-	    val << = _prim "Int16_lshift": int * Word.word -> int;
-	    val ~>> = _prim "Int16_arshift": int * Word.word -> int;
-	    val ~? = _prim "Int16_neg": int -> int; 
+	    val op < = _prim "WordS16_lt": int * int -> bool;
+	    val op <= = _prim "WordS16_le": int * int -> bool;
+	    val op > = _prim "WordS16_gt": int * int -> bool;
+	    val op >= = _prim "WordS16_ge": int * int -> bool;
+	    val quot = _prim "WordS16_quot": int * int -> int;
+	    val rem = _prim "WordS16_rem": int * int -> int;
+	    val << = _prim "Word16_lshift": int * Word.word -> int;
+	    val >> = _prim "WordU16_rshift": int * Word.word -> int;
+	    val ~>> = _prim "WordS16_rshift": int * Word.word -> int;
+	    val ~? = _prim "Word16_neg": int -> int; 
 	    val ~ =
 	       if detectOverflow
-		  then _prim "Int16_negCheck": int -> int;
+		  then _prim "Word16_negCheck": int -> int;
 	       else ~?
-	    val fromInt = _prim "Int32_toInt16": Int.int -> int;
-	    val toInt = _prim "Int16_toInt32": int -> Int.int;
+	    val andb = _prim "Word16_andb": int * int -> int;
+	    val fromInt = _prim "WordS32_toWord16": Int.int -> int;
+	    val toInt = _prim "WordS16_toWord32": int -> Int.int;
 	 end
       structure Int2 =
 	 struct
 	    type big = Int8.int
 	    type int = int2
-	    val fromBigUnsafe = _prim "Int8_toInt2": big -> int;
+	    val fromBigUnsafe = _prim "WordU8_toWord2": big -> int;
 	    val precision' = 2
-	    val toBig = _prim "Int2_toInt8": int -> big;
+	    val toBig = _prim "WordU2_toWord8": int -> big;
 	 end
       structure Int3 =
 	 struct
 	    type big = Int8.int
 	    type int = int3
-	    val fromBigUnsafe = _prim "Int8_toInt3": big -> int;
+	    val fromBigUnsafe = _prim "WordU8_toWord3": big -> int;
 	    val precision' = 3
-	    val toBig = _prim "Int3_toInt8": int -> big;
+	    val toBig = _prim "WordU3_toWord8": int -> big;
 	 end
       structure Int4 =
 	 struct
 	    type big = Int8.int
 	    type int = int4
-	    val fromBigUnsafe = _prim "Int8_toInt4": big -> int;
+	    val fromBigUnsafe = _prim "WordU8_toWord4": big -> int;
 	    val precision' = 4
-	    val toBig = _prim "Int4_toInt8": int -> big;
+	    val toBig = _prim "WordU4_toWord8": int -> big;
 	 end
       structure Int5 =
 	 struct
 	    type big = Int8.int
 	    type int = int5
-	    val fromBigUnsafe = _prim "Int8_toInt5": big -> int;
+	    val fromBigUnsafe = _prim "WordU8_toWord5": big -> int;
 	    val precision' = 5
-	    val toBig = _prim "Int5_toInt8": int -> big;
+	    val toBig = _prim "WordU5_toWord8": int -> big;
 	 end
       structure Int6 =
 	 struct
 	    type big = Int8.int
 	    type int = int6
-	    val fromBigUnsafe = _prim "Int8_toInt6": big -> int;
+	    val fromBigUnsafe = _prim "WordU8_toWord6": big -> int;
 	    val precision' = 6
-	    val toBig = _prim "Int6_toInt8": int -> big;
+	    val toBig = _prim "WordU6_toWord8": int -> big;
 	 end
       structure Int7 =
 	 struct
 	    type big = Int8.int
 	    type int = int7
-	    val fromBigUnsafe = _prim "Int8_toInt7": big -> int;
+	    val fromBigUnsafe = _prim "WordU8_toWord7": big -> int;
 	    val precision' = 7
-	    val toBig = _prim "Int7_toInt8": int -> big;
+	    val toBig = _prim "WordU7_toWord8": int -> big;
 	 end
       structure Int9 =
 	 struct
 	    type big = Int16.int
 	    type int = int9
-	    val fromBigUnsafe = _prim "Int16_toInt9": big -> int;
+	    val fromBigUnsafe = _prim "WordU16_toWord9": big -> int;
 	    val precision' = 9
-	    val toBig = _prim "Int9_toInt16": int -> big;
+	    val toBig = _prim "WordU9_toWord16": int -> big;
 	 end
       structure Int10 =
 	 struct
 	    type big = Int16.int
 	    type int = int10
-	    val fromBigUnsafe = _prim "Int16_toInt10": big -> int;
+	    val fromBigUnsafe = _prim "WordU16_toWord10": big -> int;
 	    val precision' = 10
-	    val toBig = _prim "Int10_toInt16": int -> big;
+	    val toBig = _prim "WordU10_toWord16": int -> big;
 	 end
       structure Int11 =
 	 struct
 	    type big = Int16.int
 	    type int = int11
-	    val fromBigUnsafe = _prim "Int16_toInt11": big -> int;
+	    val fromBigUnsafe = _prim "WordU16_toWord11": big -> int;
 	    val precision' = 11
-	    val toBig = _prim "Int11_toInt16": int -> big;
+	    val toBig = _prim "WordU11_toWord16": int -> big;
 	 end
       structure Int12 =
 	 struct
 	    type big = Int16.int
 	    type int = int12
-	    val fromBigUnsafe = _prim "Int16_toInt12": big -> int;
+	    val fromBigUnsafe = _prim "WordU16_toWord12": big -> int;
 	    val precision' = 12
-	    val toBig = _prim "Int12_toInt16": int -> big;
+	    val toBig = _prim "WordU12_toWord16": int -> big;
 	 end
       structure Int13 =
 	 struct
 	    type big = Int16.int
 	    type int = int13
-	    val fromBigUnsafe = _prim "Int16_toInt13": big -> int;
+	    val fromBigUnsafe = _prim "WordU16_toWord13": big -> int;
 	    val precision' = 13
-	    val toBig = _prim "Int13_toInt16": int -> big;
+	    val toBig = _prim "WordU13_toWord16": int -> big;
 	 end
       structure Int14 =
 	 struct
 	    type big = Int16.int
 	    type int = int14
-	    val fromBigUnsafe = _prim "Int16_toInt14": big -> int;
+	    val fromBigUnsafe = _prim "WordU16_toWord14": big -> int;
 	    val precision' = 14
-	    val toBig = _prim "Int14_toInt16": int -> big;
+	    val toBig = _prim "WordU14_toWord16": int -> big;
 	 end
       structure Int15 =
 	 struct
 	    type big = Int16.int
 	    type int = int15
-	    val fromBigUnsafe = _prim "Int16_toInt15": big -> int;
+	    val fromBigUnsafe = _prim "WordU16_toWord15": big -> int;
 	    val precision' = 15
-	    val toBig = _prim "Int15_toInt16": int -> big;
+	    val toBig = _prim "WordU15_toWord16": int -> big;
 	 end
       structure Int17 =
 	 struct
 	    type big = Int32.int
 	    type int = int17
-	    val fromBigUnsafe = _prim "Int32_toInt17": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord17": big -> int;
 	    val precision' = 17
-	    val toBig = _prim "Int17_toInt32": int -> big;
+	    val toBig = _prim "WordU17_toWord32": int -> big;
 	 end
       structure Int18 =
 	 struct
 	    type big = Int32.int
 	    type int = int18
-	    val fromBigUnsafe = _prim "Int32_toInt18": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord18": big -> int;
 	    val precision' = 18
-	    val toBig = _prim "Int18_toInt32": int -> big;
+	    val toBig = _prim "WordU18_toWord32": int -> big;
 	 end
       structure Int19 =
 	 struct
 	    type big = Int32.int
 	    type int = int19
-	    val fromBigUnsafe = _prim "Int32_toInt19": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord19": big -> int;
 	    val precision' = 19
-	    val toBig = _prim "Int19_toInt32": int -> big;
+	    val toBig = _prim "WordU19_toWord32": int -> big;
 	 end
       structure Int20 =
 	 struct
 	    type big = Int32.int
 	    type int = int20
-	    val fromBigUnsafe = _prim "Int32_toInt20": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord20": big -> int;
 	    val precision' = 20
-	    val toBig = _prim "Int20_toInt32": int -> big;
+	    val toBig = _prim "WordU20_toWord32": int -> big;
 	 end
       structure Int21 =
 	 struct
 	    type big = Int32.int
 	    type int = int21
-	    val fromBigUnsafe = _prim "Int32_toInt21": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord21": big -> int;
 	    val precision' = 21
-	    val toBig = _prim "Int21_toInt32": int -> big;
+	    val toBig = _prim "WordU21_toWord32": int -> big;
 	 end
       structure Int22 =
 	 struct
 	    type big = Int32.int
 	    type int = int22
-	    val fromBigUnsafe = _prim "Int32_toInt22": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord22": big -> int;
 	    val precision' = 22
-	    val toBig = _prim "Int22_toInt32": int -> big;
+	    val toBig = _prim "WordU22_toWord32": int -> big;
 	 end
       structure Int23 =
 	 struct
 	    type big = Int32.int
 	    type int = int23
-	    val fromBigUnsafe = _prim "Int32_toInt23": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord23": big -> int;
 	    val precision' = 23
-	    val toBig = _prim "Int23_toInt32": int -> big;
+	    val toBig = _prim "WordU23_toWord32": int -> big;
 	 end
       structure Int24 =
 	 struct
 	    type big = Int32.int
 	    type int = int24
-	    val fromBigUnsafe = _prim "Int32_toInt24": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord24": big -> int;
 	    val precision' = 24
-	    val toBig = _prim "Int24_toInt32": int -> big;
+	    val toBig = _prim "WordU24_toWord32": int -> big;
 	 end
       structure Int25 =
 	 struct
 	    type big = Int32.int
 	    type int = int25
-	    val fromBigUnsafe = _prim "Int32_toInt25": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord25": big -> int;
 	    val precision' = 25
-	    val toBig = _prim "Int25_toInt32": int -> big;
+	    val toBig = _prim "WordU25_toWord32": int -> big;
 	 end
       structure Int26 =
 	 struct
 	    type big = Int32.int
 	    type int = int26
-	    val fromBigUnsafe = _prim "Int32_toInt26": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord26": big -> int;
 	    val precision' = 26
-	    val toBig = _prim "Int26_toInt32": int -> big;
+	    val toBig = _prim "WordU26_toWord32": int -> big;
 	 end
       structure Int27 =
 	 struct
 	    type big = Int32.int
 	    type int = int27
-	    val fromBigUnsafe = _prim "Int32_toInt27": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord27": big -> int;
 	    val precision' = 27
-	    val toBig = _prim "Int27_toInt32": int -> big;
+	    val toBig = _prim "WordU27_toWord32": int -> big;
 	 end
       structure Int28 =
 	 struct
 	    type big = Int32.int
 	    type int = int28
-	    val fromBigUnsafe = _prim "Int32_toInt28": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord28": big -> int;
 	    val precision' = 28
-	    val toBig = _prim "Int28_toInt32": int -> big;
+	    val toBig = _prim "WordU28_toWord32": int -> big;
 	 end
       structure Int29 =
 	 struct
 	    type big = Int32.int
 	    type int = int29
-	    val fromBigUnsafe = _prim "Int32_toInt29": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord29": big -> int;
 	    val precision' = 29
-	    val toBig = _prim "Int29_toInt32": int -> big;
+	    val toBig = _prim "WordU29_toWord32": int -> big;
 	 end
       structure Int30 =
 	 struct
 	    type big = Int32.int
 	    type int = int30
-	    val fromBigUnsafe = _prim "Int32_toInt30": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord30": big -> int;
 	    val precision' = 30
-	    val toBig = _prim "Int30_toInt32": int -> big;
+	    val toBig = _prim "WordU30_toWord32": int -> big;
 	 end
       structure Int31 =
 	 struct
 	    type big = Int32.int
 	    type int = int31
-	    val fromBigUnsafe = _prim "Int32_toInt31": big -> int;
+	    val fromBigUnsafe = _prim "WordU32_toWord31": big -> int;
 	    val precision' = 31
-	    val toBig = _prim "Int31_toInt32": int -> big;
+	    val toBig = _prim "WordU31_toWord32": int -> big;
 	 end
       structure Int32 =
 	 struct
@@ -602,34 +609,36 @@
 	    val maxInt' : int = 0x7fffffff
 	    val minInt' : int = ~0x80000000
 
-	    val *? = _prim "Int32_mul": int * int -> int;
+	    val *? = _prim "WordS32_mul": int * int -> int;
 	    val * =
 	       if detectOverflow
-		  then _prim "Int32_mulCheck": int * int -> int;
+		  then _prim "WordS32_mulCheck": int * int -> int;
 	       else *?
-	    val +? = _prim "Int32_add": int * int -> int;
+	    val +? = _prim "Word32_add": int * int -> int;
 	    val + =
 	       if detectOverflow
-		  then _prim "Int32_addCheck": int * int -> int;
+		  then _prim "WordS32_addCheck": int * int -> int;
 	       else +?
-	    val -? = _prim "Int32_sub": int * int -> int;
+	    val -? = _prim "Word32_sub": int * int -> int;
 	    val - =
 	       if detectOverflow
-		  then _prim "Int32_subCheck": int * int -> int;
+		  then _prim "WordS32_subCheck": int * int -> int;
 	       else -?
-	    val op < = _prim "Int32_lt": int * int -> bool;
-	    val op <= = _prim "Int32_le": int * int -> bool;
-	    val op > = _prim "Int32_gt": int * int -> bool;
-	    val op >= = _prim "Int32_ge": int * int -> bool;
-	    val quot = _prim "Int32_quot": int * int -> int;
-	    val rem = _prim "Int32_rem": int * int -> int;
-	    val << = _prim "Int32_lshift": int * Word.word -> int;
-	    val ~>> = _prim "Int32_arshift": int * Word.word -> int;
-	    val ~? = _prim "Int32_neg": int -> int; 
+	    val op < = _prim "WordS32_lt": int * int -> bool;
+	    val op <= = _prim "WordS32_le": int * int -> bool;
+	    val op > = _prim "WordS32_gt": int * int -> bool;
+	    val op >= = _prim "WordS32_ge": int * int -> bool;
+	    val quot = _prim "WordS32_quot": int * int -> int;
+	    val rem = _prim "WordS32_rem": int * int -> int;
+	    val << = _prim "Word32_lshift": int * Word.word -> int;
+	    val >> = _prim "WordU32_rshift": int * Word.word -> int;
+	    val ~>> = _prim "WordS32_rshift": int * Word.word -> int;
+	    val ~? = _prim "Word32_neg": int -> int; 
 	    val ~ =
 	       if detectOverflow
-		  then _prim "Int32_negCheck": int -> int;
+		  then _prim "Word32_negCheck": int -> int;
 	       else ~?
+	    val andb = _prim "Word32_andb": int * int -> int;
 	    val fromInt : int -> int = fn x => x
 	    val toInt : int -> int = fn x => x
 	 end
@@ -644,38 +653,47 @@
 	    val maxInt' : int = 0x7FFFFFFFFFFFFFFF
 	    val minInt' : int = ~0x8000000000000000
 
-	    val *? = _prim "Int64_mul": int * int -> int;
-	    val +? = _prim "Int64_add": int * int -> int;
+	    val *? = _prim "WordS64_mul": int * int -> int;
+	    val +? = _prim "Word64_add": int * int -> int;
 	    val + =
 	       if detectOverflow
-		  then _prim "Int64_addCheck": int * int -> int;
+		  then _prim "WordS64_addCheck": int * int -> int;
 	       else +?
-	    val -? = _prim "Int64_sub": int * int -> int;
+	    val -? = _prim "Word64_sub": int * int -> int;
 	    val - =
 	       if detectOverflow
-		  then _prim "Int64_subCheck": int * int -> int;
+		  then _prim "WordS64_subCheck": int * int -> int;
 	       else -?
-	    val op < = _prim "Int64_lt": int * int -> bool;
-	    val op <= = _prim "Int64_le": int * int -> bool;
-	    val op > = _prim "Int64_gt": int * int -> bool;
-	    val op >= = _prim "Int64_ge": int * int -> bool;
-	    val << = _prim "Int64_lshift": int * Word.word -> int;
-	    val _ = << (* quell unused warning *)
-	    val ~>> = _prim "Int64_arshift": int * Word.word -> int;
-	    val _ = ~>> (* quell unused warning *)
-	    val quot = _prim "Int64_quot": int * int -> int;
-	    val rem = _prim "Int64_rem": int * int -> int;
-	    val ~? = _prim "Int64_neg": int -> int; 
+	    val op < = _prim "WordS64_lt": int * int -> bool;
+	    val op <= = _prim "WordS64_le": int * int -> bool;
+	    val op > = _prim "WordS64_gt": int * int -> bool;
+	    val op >= = _prim "WordS64_ge": int * int -> bool;
+	    val << = _prim "Word64_lshift": int * Word.word -> int;
+	    val >> = _prim "WordU64_rshift": int * Word.word -> int;
+	    val ~>> = _prim "WordS64_rshift": int * Word.word -> int;
+	    val quot = _prim "WordS64_quot": int * int -> int;
+	    val rem = _prim "WordS64_rem": int * int -> int;
+	    val ~? = _prim "Word64_neg": int -> int; 
 	    val ~ =
 	       if detectOverflow
-		  then _prim "Int64_negCheck": int -> int;
+		  then _prim "Word64_negCheck": int -> int;
 	       else ~?
-	    val fromInt = _prim "Int32_toInt64": Int.int -> int;
-	    val fromWord = _prim "Word32_toInt64": word -> int;
-	    val toInt = _prim "Int64_toInt32": int -> Int.int;
-	    val toWord = _prim "Int64_toWord32": int -> word;
-
+	    val andb = _prim "Word64_andb": int * int -> int;
+	    val fromInt = _prim "WordS32_toWord64": Int.int -> int;
+	    val fromWord = _prim "WordU32_toWord64": word -> int;
+	    val toInt = _prim "WordU64_toWord32": int -> Int.int;
+	    val toWord = _prim "WordU64_toWord32": int -> word;
 	    val * = fn _ => raise Fail "Int64.* unimplemented"
+	    (* quell unused warnings *)
+	    val () =
+	       let
+		  val _ = << 
+		  val _ = >>
+		  val _ = ~>>
+		  val _ = andb
+	       in
+		  ()
+	       end
 	 end
 
       structure Array =
@@ -947,9 +965,6 @@
 	 struct
 	    open Pointer
 
-(*	    val fromWord = _prim "Word_toPointer": word -> t; *)
-(*	    val toWord = _prim "Pointer_toWord": t -> word; *)
-
 	    val fromWord = fn w => w
 	    val toWord = fn w => w
 	       
@@ -957,10 +972,10 @@
 
 	    fun isNull p = p = null
 
-	    val getInt8 = _prim "Pointer_getInt8": t * int -> Int8.int;
-	    val getInt16 = _prim "Pointer_getInt16": t * int -> Int16.int;
-	    val getInt32 = _prim "Pointer_getInt32": t * int -> Int32.int;
-	    val getInt64 = _prim "Pointer_getInt64": t * int -> Int64.int;
+	    val getInt8 = _prim "Pointer_getWord8": t * int -> Int8.int;
+	    val getInt16 = _prim "Pointer_getWord16": t * int -> Int16.int;
+	    val getInt32 = _prim "Pointer_getWord32": t * int -> Int32.int;
+	    val getInt64 = _prim "Pointer_getWord64": t * int -> Int64.int;
 	    val getPointer = _prim "Pointer_getPointer": t * int -> 'a;
 	    val getReal32 = _prim "Pointer_getReal32": t * int -> Real32.real;
 	    val getReal64 = _prim "Pointer_getReal64": t * int -> Real64.real;
@@ -968,10 +983,13 @@
 	    val getWord16 = _prim "Pointer_getWord16": t * int -> Word16.word;
 	    val getWord32 = _prim "Pointer_getWord32": t * int -> Word32.word;
 	    val getWord64 = _prim "Pointer_getWord64": t * int -> Word64.word;
-	    val setInt8 = _prim "Pointer_setInt8": t * int * Int8.int -> unit;
-	    val setInt16 = _prim "Pointer_setInt16": t * int * Int16.int -> unit;
-	    val setInt32 = _prim "Pointer_setInt32": t * int * Int32.int -> unit;
-	    val setInt64 = _prim "Pointer_setInt64": t * int * Int64.int -> unit;
+	    val setInt8 = _prim "Pointer_setWord8": t * int * Int8.int -> unit;
+	    val setInt16 =
+	       _prim "Pointer_setWord16": t * int * Int16.int -> unit;
+	    val setInt32 =
+	       _prim "Pointer_setWord32": t * int * Int32.int -> unit;
+	    val setInt64 =
+	       _prim "Pointer_setWord64": t * int * Int64.int -> unit;
 	    val setPointer = _prim "Pointer_setPointer": t * int * 'a -> unit;
 	    val setReal32 =
 	       _prim "Pointer_setReal32": t * int * Real32.real -> unit;
@@ -1031,7 +1049,7 @@
 	    val frexp = _import "Real64_frexp": real * int ref -> real;
 	    val gdtoa =
 	       _import "Real64_gdtoa": real * int * int * int ref -> cstring;
-	    val fromInt = _prim "Int32_toReal64": int -> real;
+	    val fromInt = _prim "WordS32_toReal64": int -> real;
 	    val ldexp = _prim "Real64_ldexp": real * int -> real;
 	    val maxFinite = _import "Real64_maxFinite": real;
 	    val minNormalPos = _import "Real64_minNormalPos": real;
@@ -1041,7 +1059,7 @@
 	    val round = _prim "Real64_round": real -> real;
 	    val signBit = _import "Real64_signBit": real -> bool;
 	    val strto = _import "Real64_strto": NullString.t -> real;
-	    val toInt = _prim "Real64_toInt32": real -> int;
+	    val toInt = _prim "Real64_toWordS32": real -> int;
 	    val ~ = _prim "Real64_neg": real -> real;
 
 	    val fromLarge : real -> real = fn x => x
@@ -1108,7 +1126,7 @@
 	       fromLarge (Real64.frexp (toLarge r, ir))
 	    val gdtoa =
 	       _import "Real32_gdtoa": real * int * int * int ref -> cstring;
-	    val fromInt = _prim "Int32_toReal32": int -> real;
+	    val fromInt = _prim "WordS32_toReal32": int -> real;
 	    val ldexp = _prim "Real32_ldexp": real * int -> real;
 	    val maxFinite = _import "Real32_maxFinite": real;
 	    val minNormalPos = _import "Real32_minNormalPos": real;
@@ -1116,7 +1134,7 @@
 	    val modf = _import "Real32_modf": real * real ref -> real;
 	    val signBit = _import "Real32_signBit": real -> bool;
 	    val strto = _import "Real32_strto": NullString.t -> real;
-	    val toInt = _prim "Real32_toInt32": real -> int;
+	    val toInt = _prim "Real32_toWordS32": real -> int;
 	    val ~ = _prim "Real32_neg": real -> real;
 	 end
 
@@ -1380,29 +1398,29 @@
 
 	    val + = _prim "Word8_add": word * word -> word;
 	    val andb = _prim "Word8_andb": word * word -> word;
-	    val ~>> = _prim "Word8_arshift": word * Word.word -> word;
-	    val div = _prim "Word8_div": word * word -> word;
-	    val fromInt = _prim "Int32_toWord8": int -> word;
-	    val fromLarge = _prim "Word64_toWord8": LargeWord.word -> word;
-	    val op >= = _prim "Word8_ge": word * word -> bool;
-	    val op > = _prim "Word8_gt" : word * word -> bool;
-	    val op <= = _prim "Word8_le": word * word -> bool;
+	    val ~>> = _prim "WordS8_rshift": word * Word.word -> word;
+	    val div = _prim "WordU8_quot": word * word -> word;
+	    val fromInt = _prim "WordU32_toWord8": int -> word;
+	    val fromLarge = _prim "WordU64_toWord8": LargeWord.word -> word;
+	    val op >= = _prim "WordU8_ge": word * word -> bool;
+	    val op > = _prim "WordU8_gt" : word * word -> bool;
+	    val op <= = _prim "WordU8_le": word * word -> bool;
 	    val << = _prim "Word8_lshift": word * Word.word -> word;
-	    val op < = _prim "Word8_lt" : word * word -> bool;
-	    val mod = _prim "Word8_mod": word * word -> word;
-	    val * = _prim "Word8_mul": word * word -> word;
+	    val op < = _prim "WordU8_lt" : word * word -> bool;
+	    val mod = _prim "WordU8_rem": word * word -> word;
+	    val * = _prim "WordU8_mul": word * word -> word;
 	    val ~ = _prim "Word8_neg": word -> word;
 	    val notb = _prim "Word8_notb": word -> word;
 	    val orb = _prim "Word8_orb": word * word -> word;
 	    val rol = _prim "Word8_rol": word * Word.word -> word;
 	    val ror = _prim "Word8_ror": word * Word.word -> word;
-	    val >> = _prim "Word8_rshift": word * Word.word -> word;
+	    val >> = _prim "WordU8_rshift": word * Word.word -> word;
 	    val - = _prim "Word8_sub": word * word -> word;
-	    val toChar = _prim "Word8_toChar": word -> char;
-	    val toInt = _prim "Word8_toInt32": word -> int;
-	    val toIntX = _prim "Word8_toInt32X": word -> int;
-	    val toLarge = _prim "Word8_toWord64": word -> LargeWord.word;
-	    val toLargeX = _prim "Word8_toWord64X": word -> LargeWord.word;
+	    val toChar = _prim "WordU8_toWord8": word -> char;
+	    val toInt = _prim "WordU8_toWord32": word -> int;
+	    val toIntX = _prim "WordS8_toWord32": word -> int;
+	    val toLarge = _prim "WordU8_toWord64": word -> LargeWord.word;
+	    val toLargeX = _prim "WordS8_toWord64": word -> LargeWord.word;
 	    val xorb = _prim "Word8_xorb": word * word -> word;
 	 end
 
@@ -1434,26 +1452,26 @@
 
 	    val + = _prim "Word16_add": word * word -> word;
 	    val andb = _prim "Word16_andb": word * word -> word;
-	    val ~>> = _prim "Word16_arshift": word * Word.word -> word;
-	    val div = _prim "Word16_div": word * word -> word;
-	    val fromInt = _prim "Int32_toWord16": int -> word;
-	    val fromLarge = _prim "Word64_toWord16": LargeWord.word -> word;
-	    val op >= = _prim "Word16_ge": word * word -> bool;
-	    val op > = _prim "Word16_gt" : word * word -> bool;
-	    val op <= = _prim "Word16_le": word * word -> bool;
+	    val ~>> = _prim "WordS16_rshift": word * Word.word -> word;
+	    val div = _prim "WordU16_quot": word * word -> word;
+	    val fromInt = _prim "WordU32_toWord16": int -> word;
+	    val fromLarge = _prim "WordU64_toWord16": LargeWord.word -> word;
+	    val op >= = _prim "WordU16_ge": word * word -> bool;
+	    val op > = _prim "WordU16_gt" : word * word -> bool;
+	    val op <= = _prim "WordU16_le": word * word -> bool;
 	    val << = _prim "Word16_lshift": word * Word.word -> word;
-	    val op < = _prim "Word16_lt" : word * word -> bool;
-	    val mod = _prim "Word16_mod": word * word -> word;
-	    val * = _prim "Word16_mul": word * word -> word;
+	    val op < = _prim "WordU16_lt" : word * word -> bool;
+	    val mod = _prim "WordU16_rem": word * word -> word;
+	    val * = _prim "WordU16_mul": word * word -> word;
 	    val ~ = _prim "Word16_neg": word -> word;
 	    val notb = _prim "Word16_notb": word -> word;
 	    val orb = _prim "Word16_orb": word * word -> word;
-	    val >> = _prim "Word16_rshift": word * Word.word -> word;
+	    val >> = _prim "WordU16_rshift": word * Word.word -> word;
 	    val - = _prim "Word16_sub": word * word -> word;
-	    val toInt = _prim "Word16_toInt32": word -> int;
-	    val toIntX = _prim "Word16_toInt32X": word -> int;
-	    val toLarge = _prim "Word16_toWord64": word -> LargeWord.word;
-	    val toLargeX = _prim "Word16_toWord64X": word -> LargeWord.word;
+	    val toInt = _prim "WordU16_toWord32": word -> int;
+	    val toIntX = _prim "WordS16_toWord32": word -> int;
+	    val toLarge = _prim "WordU16_toWord64": word -> LargeWord.word;
+	    val toLargeX = _prim "WordS16_toWord64": word -> LargeWord.word;
 	    val xorb = _prim "Word16_xorb": word * word -> word;
 	 end
 
@@ -1463,31 +1481,29 @@
 	    val wordSize: int = 32
 
 	    val + = _prim "Word32_add": word * word -> word;
-(*	    val addCheck = _prim "Word32_addCheck": word * word -> word; *)
 	    val andb = _prim "Word32_andb": word * word -> word;
-	    val ~>> = _prim "Word32_arshift": word * word -> word;
-	    val div = _prim "Word32_div": word * word -> word;
-	    val fromInt = _prim "Int32_toWord32": int -> word;
-	    val fromLarge = _prim "Word64_toWord32": LargeWord.word -> word;
-	    val op >= = _prim "Word32_ge": word * word -> bool;
-	    val op > = _prim "Word32_gt" : word * word -> bool;
-	    val op <= = _prim "Word32_le": word * word -> bool;
+	    val ~>> = _prim "WordS32_rshift": word * word -> word;
+	    val div = _prim "WordU32_quot": word * word -> word;
+	    val fromInt = _prim "WordU32_toWord32": int -> word;
+	    val fromLarge = _prim "WordU64_toWord32": LargeWord.word -> word;
+	    val op >= = _prim "WordU32_ge": word * word -> bool;
+	    val op > = _prim "WordU32_gt" : word * word -> bool;
+	    val op <= = _prim "WordU32_le": word * word -> bool;
 	    val << = _prim "Word32_lshift": word * word -> word;
-	    val op < = _prim "Word32_lt" : word * word -> bool;
-	    val mod = _prim "Word32_mod": word * word -> word;
-	    val * = _prim "Word32_mul": word * word -> word;
-(*	    val mulCheck = _prim "Word32_mulCheck": word * word -> word; *)
+	    val op < = _prim "WordU32_lt" : word * word -> bool;
+	    val mod = _prim "WordU32_rem": word * word -> word;
+	    val * = _prim "WordU32_mul": word * word -> word;
 	    val ~ = _prim "Word32_neg": word -> word;
 	    val notb = _prim "Word32_notb": word -> word;
 	    val orb = _prim "Word32_orb": word * word -> word;
 	    val rol = _prim "Word32_rol": word * word -> word;
 	    val ror = _prim "Word32_ror": word * word -> word;
-	    val >> = _prim "Word32_rshift": word * word -> word;
+	    val >> = _prim "WordU32_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 toLarge = _prim "Word32_toWord64": word -> LargeWord.word;
-	    val toLargeX = _prim "Word32_toWord64X": word -> LargeWord.word;
+	    val toInt = _prim "WordU32_toWord32": word -> int;
+	    val toIntX = _prim "WordS32_toWord32": word -> int;
+	    val toLarge = _prim "WordU32_toWord64": word -> LargeWord.word;
+	    val toLargeX = _prim "WordS32_toWord64": word -> LargeWord.word;
 	    val xorb = _prim "Word32_xorb": word * word -> word;
 	 end
       structure Word = Word32
@@ -1499,24 +1515,24 @@
 
 	    val + = _prim "Word64_add": word * word -> word;
 	    val andb = _prim "Word64_andb": word * word -> word;
-	    val ~>> = _prim "Word64_arshift": word * Word.word -> word;
-	    val div = _prim "Word64_div": word * word -> word;
-	    val fromInt = _prim "Int32_toWord64": int -> word;
+	    val ~>> = _prim "WordS64_rshift": word * Word.word -> word;
+	    val div = _prim "WordU64_quot": word * word -> word;
+	    val fromInt = _prim "WordS32_toWord64": int -> word;
 	    val fromLarge: LargeWord.word -> word = fn x => x
-	    val op >= = _prim "Word64_ge": word * word -> bool;
-	    val op > = _prim "Word64_gt" : word * word -> bool;
-	    val op <= = _prim "Word64_le": word * word -> bool;
+	    val op >= = _prim "WordU64_ge": word * word -> bool;
+	    val op > = _prim "WordU64_gt" : word * word -> bool;
+	    val op <= = _prim "WordU64_le": word * word -> bool;
 	    val << = _prim "Word64_lshift": word * Word.word -> word;
-	    val op < = _prim "Word64_lt" : word * word -> bool;
-	    val mod = _prim "Word64_mod": word * word -> word;
-	    val * = _prim "Word64_mul": word * word -> word;
+	    val op < = _prim "WordU64_lt" : word * word -> bool;
+	    val mod = _prim "WordU64_rem": word * word -> word;
+	    val * = _prim "WordU64_mul": word * word -> word;
 	    val ~ = _prim "Word64_neg": word -> word;
 	    val notb = _prim "Word64_notb": word -> word;
 	    val orb = _prim "Word64_orb": word * word -> word;
-	    val >> = _prim "Word64_rshift": word * Word.word -> word;
+	    val >> = _prim "WordU64_rshift": word * Word.word -> word;
 	    val - = _prim "Word64_sub": word * word -> word;
-	    val toInt = _prim "Word64_toInt32": word -> int;
-	    val toIntX = _prim "Word64_toInt32X": word -> int;
+	    val toInt = _prim "WordU64_toWord32": word -> int;
+	    val toIntX = _prim "WordU64_toWord32": word -> int;
 	    val toLarge: word -> LargeWord.word = fn x => x
 	    val toLargeX: word -> LargeWord.word = fn x => x
 	    val xorb = _prim "Word64_xorb": word * word -> word;
@@ -1526,224 +1542,224 @@
 	 struct
 	    type big = Word8.word
 	    type word = word2
-	    val fromBigUnsafe = _prim "Word8_toWord2": big -> word;
-	    val toBig = _prim "Word2_toWord8": word -> big;
+	    val fromBigUnsafe = _prim "WordU8_toWord2": big -> word;
+	    val toBig = _prim "WordU2_toWord8": word -> big;
 	    val wordSize = 2
 	 end
       structure Word3 =
 	 struct
 	    type big = Word8.word
 	    type word = word3
-	    val fromBigUnsafe = _prim "Word8_toWord3": big -> word;
-	    val toBig = _prim "Word3_toWord8": word -> big;
+	    val fromBigUnsafe = _prim "WordU8_toWord3": big -> word;
+	    val toBig = _prim "WordU3_toWord8": word -> big;
 	    val wordSize = 3
 	 end
       structure Word4 =
 	 struct
 	    type big = Word8.word
 	    type word = word4
-	    val fromBigUnsafe = _prim "Word8_toWord4": big -> word;
-	    val toBig = _prim "Word4_toWord8": word -> big;
+	    val fromBigUnsafe = _prim "WordU8_toWord4": big -> word;
+	    val toBig = _prim "WordU4_toWord8": word -> big;
 	    val wordSize = 4
 	 end
       structure Word5 =
 	 struct
 	    type big = Word8.word
 	    type word = word5
-	    val fromBigUnsafe = _prim "Word8_toWord5": big -> word;
-	    val toBig = _prim "Word5_toWord8": word -> big;
+	    val fromBigUnsafe = _prim "WordU8_toWord5": big -> word;
+	    val toBig = _prim "WordU5_toWord8": word -> big;
 	    val wordSize = 5
 	 end
       structure Word6 =
 	 struct
 	    type big = Word8.word
 	    type word = word6
-	    val fromBigUnsafe = _prim "Word8_toWord6": big -> word;
-	    val toBig = _prim "Word6_toWord8": word -> big;
+	    val fromBigUnsafe = _prim "WordU8_toWord6": big -> word;
+	    val toBig = _prim "WordU6_toWord8": word -> big;
 	    val wordSize = 6
 	 end
       structure Word7 =
 	 struct
 	    type big = Word8.word
 	    type word = word7
-	    val fromBigUnsafe = _prim "Word8_toWord7": big -> word;
-	    val toBig = _prim "Word7_toWord8": word -> big;
+	    val fromBigUnsafe = _prim "WordU8_toWord7": big -> word;
+	    val toBig = _prim "WordU7_toWord8": word -> big;
 	    val wordSize = 7
 	 end
       structure Word9 =
 	 struct
 	    type big = Word16.word
 	    type word = word9
-	    val fromBigUnsafe = _prim "Word16_toWord9": big -> word;
-	    val toBig = _prim "Word9_toWord16": word -> big;
+	    val fromBigUnsafe = _prim "WordU16_toWord9": big -> word;
+	    val toBig = _prim "WordU9_toWord16": word -> big;
 	    val wordSize = 9
 	 end
       structure Word10 =
 	 struct
 	    type big = Word16.word
 	    type word = word10
-	    val fromBigUnsafe = _prim "Word16_toWord10": big -> word;
-	    val toBig = _prim "Word10_toWord16": word -> big;
+	    val fromBigUnsafe = _prim "WordU16_toWord10": big -> word;
+	    val toBig = _prim "WordU10_toWord16": word -> big;
 	    val wordSize = 10
 	 end
       structure Word11 =
 	 struct
 	    type big = Word16.word
 	    type word = word11
-	    val fromBigUnsafe = _prim "Word16_toWord11": big -> word;
-	    val toBig = _prim "Word11_toWord16": word -> big;
+	    val fromBigUnsafe = _prim "WordU16_toWord11": big -> word;
+	    val toBig = _prim "WordU11_toWord16": word -> big;
 	    val wordSize = 11
 	 end
       structure Word12 =
 	 struct
 	    type big = Word16.word
 	    type word = word12
-	    val fromBigUnsafe = _prim "Word16_toWord12": big -> word;
-	    val toBig = _prim "Word12_toWord16": word -> big;
+	    val fromBigUnsafe = _prim "WordU16_toWord12": big -> word;
+	    val toBig = _prim "WordU12_toWord16": word -> big;
 	    val wordSize = 12
 	 end
       structure Word13 =
 	 struct
 	    type big = Word16.word
 	    type word = word13
-	    val fromBigUnsafe = _prim "Word16_toWord13": big -> word;
-	    val toBig = _prim "Word13_toWord16": word -> big;
+	    val fromBigUnsafe = _prim "WordU16_toWord13": big -> word;
+	    val toBig = _prim "WordU13_toWord16": word -> big;
 	    val wordSize = 13
 	 end
       structure Word14 =
 	 struct
 	    type big = Word16.word
 	    type word = word14
-	    val fromBigUnsafe = _prim "Word16_toWord14": big -> word;
-	    val toBig = _prim "Word14_toWord16": word -> big;
+	    val fromBigUnsafe = _prim "WordU16_toWord14": big -> word;
+	    val toBig = _prim "WordU14_toWord16": word -> big;
 	    val wordSize = 14
 	 end
       structure Word15 =
 	 struct
 	    type big = Word16.word
 	    type word = word15
-	    val fromBigUnsafe = _prim "Word16_toWord15": big -> word;
-	    val toBig = _prim "Word15_toWord16": word -> big;
+	    val fromBigUnsafe = _prim "WordU16_toWord15": big -> word;
+	    val toBig = _prim "WordU15_toWord16": word -> big;
 	    val wordSize = 15
 	 end
       structure Word17 =
 	 struct
 	    type big = Word32.word
 	    type word = word17
-	    val fromBigUnsafe = _prim "Word32_toWord17": big -> word;
-	    val toBig = _prim "Word17_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord17": big -> word;
+	    val toBig = _prim "WordU17_toWord32": word -> big;
 	    val wordSize = 17
 	 end
       structure Word18 =
 	 struct
 	    type big = Word32.word
 	    type word = word18
-	    val fromBigUnsafe = _prim "Word32_toWord18": big -> word;
-	    val toBig = _prim "Word18_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord18": big -> word;
+	    val toBig = _prim "WordU18_toWord32": word -> big;
 	    val wordSize = 18
 	 end
       structure Word19 =
 	 struct
 	    type big = Word32.word
 	    type word = word19
-	    val fromBigUnsafe = _prim "Word32_toWord19": big -> word;
-	    val toBig = _prim "Word19_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord19": big -> word;
+	    val toBig = _prim "WordU19_toWord32": word -> big;
 	    val wordSize = 19
 	 end
       structure Word20 =
 	 struct
 	    type big = Word32.word
 	    type word = word20
-	    val fromBigUnsafe = _prim "Word32_toWord20": big -> word;
-	    val toBig = _prim "Word20_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord20": big -> word;
+	    val toBig = _prim "WordU20_toWord32": word -> big;
 	    val wordSize = 20
 	 end
       structure Word21 =
 	 struct
 	    type big = Word32.word
 	    type word = word21
-	    val fromBigUnsafe = _prim "Word32_toWord21": big -> word;
-	    val toBig = _prim "Word21_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord21": big -> word;
+	    val toBig = _prim "WordU21_toWord32": word -> big;
 	    val wordSize = 21
 	 end
       structure Word22 =
 	 struct
 	    type big = Word32.word
 	    type word = word22
-	    val fromBigUnsafe = _prim "Word32_toWord22": big -> word;
-	    val toBig = _prim "Word22_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord22": big -> word;
+	    val toBig = _prim "WordU22_toWord32": word -> big;
 	    val wordSize = 22
 	 end
       structure Word23 =
 	 struct
 	    type big = Word32.word
 	    type word = word23
-	    val fromBigUnsafe = _prim "Word32_toWord23": big -> word;
-	    val toBig = _prim "Word23_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord23": big -> word;
+	    val toBig = _prim "WordU23_toWord32": word -> big;
 	    val wordSize = 23
 	 end
       structure Word24 =
 	 struct
 	    type big = Word32.word
 	    type word = word24
-	    val fromBigUnsafe = _prim "Word32_toWord24": big -> word;
-	    val toBig = _prim "Word24_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord24": big -> word;
+	    val toBig = _prim "WordU24_toWord32": word -> big;
 	    val wordSize = 24
 	 end
       structure Word25 =
 	 struct
 	    type big = Word32.word
 	    type word = word25
-	    val fromBigUnsafe = _prim "Word32_toWord25": big -> word;
-	    val toBig = _prim "Word25_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord25": big -> word;
+	    val toBig = _prim "WordU25_toWord32": word -> big;
 	    val wordSize = 25
 	 end
       structure Word26 =
 	 struct
 	    type big = Word32.word
 	    type word = word26
-	    val fromBigUnsafe = _prim "Word32_toWord26": big -> word;
-	    val toBig = _prim "Word26_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord26": big -> word;
+	    val toBig = _prim "WordU26_toWord32": word -> big;
 	    val wordSize = 26
 	 end
       structure Word27 =
 	 struct
 	    type big = Word32.word
 	    type word = word27
-	    val fromBigUnsafe = _prim "Word32_toWord27": big -> word;
-	    val toBig = _prim "Word27_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord27": big -> word;
+	    val toBig = _prim "WordU27_toWord32": word -> big;
 	    val wordSize = 27
 	 end
       structure Word28 =
 	 struct
 	    type big = Word32.word
 	    type word = word28
-	    val fromBigUnsafe = _prim "Word32_toWord28": big -> word;
-	    val toBig = _prim "Word28_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord28": big -> word;
+	    val toBig = _prim "WordU28_toWord32": word -> big;
 	    val wordSize = 28
 	 end
       structure Word29 =
 	 struct
 	    type big = Word32.word
 	    type word = word29
-	    val fromBigUnsafe = _prim "Word32_toWord29": big -> word;
-	    val toBig = _prim "Word29_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord29": big -> word;
+	    val toBig = _prim "WordU29_toWord32": word -> big;
 	    val wordSize = 29
 	 end
       structure Word30 =
 	 struct
 	    type big = Word32.word
 	    type word = word30
-	    val fromBigUnsafe = _prim "Word32_toWord30": big -> word;
-	    val toBig = _prim "Word30_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord30": big -> word;
+	    val toBig = _prim "WordU30_toWord32": word -> big;
 	    val wordSize = 30
 	 end
       structure Word31 =
 	 struct
 	    type big = Word32.word
 	    type word = word31
-	    val fromBigUnsafe = _prim "Word32_toWord31": big -> word;
-	    val toBig = _prim "Word31_toWord32": word -> big;
+	    val fromBigUnsafe = _prim "WordU32_toWord31": big -> word;
+	    val toBig = _prim "WordU31_toWord32": word -> big;
 	    val wordSize = 31
 	 end
 



1.25      +206 -275  mlton/include/c-chunk.h

Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- c-chunk.h	25 Apr 2004 22:02:48 -0000	1.24
+++ c-chunk.h	1 May 2004 00:49:33 -0000	1.25
@@ -195,229 +195,6 @@
 	} while (0)
 
 /* ------------------------------------------------- */
-/*                        Int                        */
-/* ------------------------------------------------- */
-
-/* The default is to use INT_TEST. */
-#if (! defined (INT_NO_CHECK) && ! defined (INT_TEST))
-#define INT_TEST
-#endif
-
-#if (defined (INT_NO_CHECK))
-
-#define Int_addCheck(dst, n1, n2, l) dst = n1 + n2
-#define Int_mulCheck(dst, n1, n2, l) dst = n1 * n2
-#define Int_negCheck(dst, n, l) dst = -n
-#define Int_subCheck(dst, n1, n2, l) dst = n1 - n2
-#define Word32_addCheck(dst, n1, n2, l) dst = n1 + n2
-#define Word32_mulCheck(dst, n1, n2, l) dst = n1 * n2
-#define Int_addCheckCX Int_addCheck
-#define Int_addCheckXC Int_addCheck
-#define Int_subCheckCX Int_subCheck
-#define Int_subCheckXC Int_subCheck
-#define Word32_addCheckCX Word32_addCheck
-#define Word32_addCheckXC Word32_addCheck
-
-#endif
-
-#if (defined (INT_TEST))
-
-#define Int8_max (Int8)0x7F
-#define	Int8_min (Int8)0x80
-#define Int16_max (Int16)0x7FFF
-#define Int16_min (Int16)0x8000
-#define Int32_max (Int32)0x7FFFFFFF
-#define Int32_min (Int32)0x80000000
-#define Int64_max (Int64)0x7FFFFFFFFFFFFFFF
-#define Int64_min (Int64)0x8000000000000000
-#define Word8_max (Word8)0xFF
-#define Word16_max (Word16)0xFFFF
-#define Word32_max (Word32)0xFFFFFFFF
-#define Word64_max (Word64)0xFFFFFFFFFFFFFFFF
-
-#define Int_addCheckXC(size, dst, xW, cW, l)		\
-	do {						\
-		Int##size x = xW;			\
-		Int##size c = cW;			\
-		if (c >= 0) {				\
-			if (x > Int##size##_max - c)	\
-				goto l;			\
-		} else if (x < Int##size##_min - c)	\
-				goto l;			\
-		dst = x + c;				\
-	} while (0)
-#define Int8_addCheckXC(dst, x, c, l) Int_addCheckXC(8, dst, x, c, l)
-#define Int16_addCheckXC(dst, x, c, l) Int_addCheckXC(16, dst, x, c, l)
-#define Int32_addCheckXC(dst, x, c, l) Int_addCheckXC(32, dst, x, c, l)
-#define Int64_addCheckXC(dst, x, c, l) Int_addCheckXC(64, dst, x, c, l)
-
-#define Int8_addCheckCX(dst, c, x, l) Int8_addCheckXC(dst, x, c, l)
-#define Int16_addCheckCX(dst, c, x, l) Int16_addCheckXC(dst, x, c, l)
-#define Int32_addCheckCX(dst, c, x, l) Int32_addCheckXC(dst, x, c, l)
-#define Int64_addCheckCX(dst, c, x, l) Int64_addCheckXC(dst, x, c, l)
-
-#define Int8_addCheck Int8_addCheckXC
-#define Int16_addCheck Int16_addCheckXC
-#define Int32_addCheck Int32_addCheckXC
-#define Int64_addCheck Int64_addCheckXC
-
-#define Int_negCheck(size, dst, nW, l)		\
-	do {					\
-		Int##size n = nW;		\
-		if (n == Int##size##_min)	\
-			goto l;			\
-		dst = -n;			\
-	} while (0)
-
-#define Int8_negCheck(dst, n, l) Int_negCheck(8, dst, n, l)
-#define Int16_negCheck(dst, n, l) Int_negCheck(16, dst, n, l)
-#define Int32_negCheck(dst, n, l) Int_negCheck(32, dst, n, l)
-#define Int64_negCheck(dst, n, l) Int_negCheck(64, dst, n, l)
-
-#define Int_subCheckCX(size, dst, cW, xW, l)		\
-	do {						\
-		Int##size c = cW;			\
-		Int##size x = xW;			\
- 		if (c >= 0) {				\
-			if (x < c - Int##size##_max)	\
-				goto l;			\
-		} else if (x > c - Int##size##_min)	\
-			goto l;				\
-		dst = c - x;				\
-	} while (0)
-#define Int8_subCheckCX(dst, c, x, l) Int_subCheckCX(8, dst, c, x, l)
-#define Int16_subCheckCX(dst, c, x, l) Int_subCheckCX(16, dst, c, x, l)
-#define Int32_subCheckCX(dst, c, x, l) Int_subCheckCX(32, dst, c, x, l)
-#define Int64_subCheckCX(dst, c, x, l) Int_subCheckCX(64, dst, c, x, l)
-
-#define Int_subCheckXC(size, dst, xW, cW, l)		\
-	do {						\
-		Int##size c = cW;			\
-		Int##size x = xW;			\
-		if (c <= 0) {				\
-			if (x > Int##size##_max + c)	\
-				goto l;			\
-		} else if (x < Int##size##_min + c)	\
-			goto l;				\
-		dst = x - c;				\
- 	} while (0)
-#define Int8_subCheckXC(dst, c, x, l) Int_subCheckXC(8, dst, c, x, l)
-#define Int16_subCheckXC(dst, c, x, l) Int_subCheckXC(16, dst, c, x, l)
-#define Int32_subCheckXC(dst, c, x, l) Int_subCheckXC(32, dst, c, x, l)
-#define Int64_subCheckXC(dst, c, x, l) Int_subCheckXC(64, dst, c, x, l)
-
-#define Int8_subCheck Int8_subCheckXC
-#define Int16_subCheck Int16_subCheckXC
-#define Int32_subCheck Int32_subCheckXC
-#define Int64_subCheck Int64_subCheckXC
-
-#define Word_addCheckXC(size, dst, x, c, l)	\
-	do {					\
-		if (x > Word##size##_max - c)	\
-			goto l;			\
-		dst = x + c;			\
-	} while (0)
-#define Word8_addCheckXC(dst, x, c, l) Word_addCheckXC(8, dst, x, c, l)
-#define Word16_addCheckXC(dst, x, c, l) Word_addCheckXC(16, dst, x, c, l)
-#define Word32_addCheckXC(dst, x, c, l) Word_addCheckXC(32, dst, x, c, l)
-#define Word64_addCheckXC(dst, x, c, l) Word_addCheckXC(64, dst, x, c, l)
-#define Word8_addCheckCX(dst, c, x, l) Word_addCheckXC(8, dst, x, c, l)
-#define Word16_addCheckCX(dst, c, x, l) Word_addCheckXC(16, dst, x, c, l)
-#define Word32_addCheckCX(dst, c, x, l) Word_addCheckXC(32, dst, x, c, l)
-#define Word64_addCheckCX(dst, c, x, l) Word_addCheckXC(64, dst, x, c, l)
-
-#define Word8_addCheck Word8_addCheckXC
-#define Word16_addCheck Word16_addCheckXC
-#define Word32_addCheck Word32_addCheckXC
-#define Word64_addCheck Word64_addCheckXC
-
-#define mulOverflow(kind, small, large)						\
-	static inline kind##small kind##small##_##mulOverflow			\
-			(kind##small x1, kind##small x2, Bool *overflow) {	\
-		kind##large tmp;						\
-		kind##small res;						\
-										\
-		tmp = (kind##large)x1 * x2;					\
-		res = tmp;							\
-		*overflow = (tmp != res);					\
-		return res;							\
-	}
-mulOverflow(Int, 8, 16)
-mulOverflow(Int, 16, 32)
-mulOverflow(Int, 32, 64)
-mulOverflow(Word, 8, 16)
-mulOverflow(Word, 16, 32)
-mulOverflow(Word, 32, 64)
-#undef mulOverflow
-
-#define check(dst, n1, n2, l, f);						\
-	do {									\
-		int overflow;							\
-		dst = f (n1, n2, &overflow);					\
-		if (DEBUG_CCODEGEN)						\
-			fprintf (stderr, "%s:%d: " #f "(%d, %d) = %d\n",	\
-					__FILE__, __LINE__, n1, n2, dst);	\
-		if (overflow) {							\
-			if (DEBUG_CCODEGEN)					\
-				fprintf (stderr, "%s:%d: overflow\n",		\
-						__FILE__, __LINE__);		\
-			goto l;							\
-		}								\
-	} while (0)
-
-#define Int8_mulCheck(dst, n1, n2, l)			\
-	check (dst, n1, n2, l, Int8_mulOverflow)
-#define Int16_mulCheck(dst, n1, n2, l)			\
-	check (dst, n1, n2, l, Int16_mulOverflow)
-#define Int32_mulCheck(dst, n1, n2, l)			\
-	check (dst, n1, n2, l, Int32_mulOverflow)
-//#define Int64_mulCheck(dst, n1, n2, l)			\
-//	fprintf (stderr, "FIXME: Int64_mulCheck\n");
-
-#define Word8_mulCheck(dst, n1, n2, l)			\
-	check (dst, n1, n2, l, Word8_mulOverflow)
-#define Word16_mulCheck(dst, n1, n2, l)			\
-	check (dst, n1, n2, l, Word16_mulOverflow)
-#define Word32_mulCheck(dst, n1, n2, l)			\
-	check (dst, n1, n2, l, Word32_mulOverflow)
-//#define Word64_mulCheck(dst, n1, n2, l)			\
-//	fprintf (stderr, "FIXME: Word64_mulCheck\n");
-
-#endif /* INT_TEST */
-
-#define intBinary(name, op, size)			\
-	static inline Int##size Int##size##_##name 	\
-			(Int##size i1, Int##size i2) {	\
-		return i1 op i2;			\
-	}
-#define intAllBinary(name, op)			\
-	intBinary(name,op,8)			\
-	intBinary(name,op,16)			\
-	intBinary(name,op,32)			\
-	intBinary(name,op,64)
-intAllBinary (mul, *)
-#undef intBinary
-#undef intAllBinary
-
-#define intBinaryCompare(name, op, size) 		\
-	static inline Bool Int##size##_##name 		\
-			(Int##size i1, Int##size i2) {	\
-		return i1 op i2;			\
-	}
-#define intAllBinaryCompare(name, op)		\
-	intBinaryCompare(name,op,8)		\
-	intBinaryCompare(name,op,16)		\
-	intBinaryCompare(name,op,32)		\
-	intBinaryCompare(name,op,64)
-intAllBinaryCompare (ge, >=)
-intAllBinaryCompare (gt, >)
-intAllBinaryCompare (le, <=)
-intAllBinaryCompare (lt, <)
-#undef intBinaryCompare
-#undef intAllBinaryCompare
-
-
-/* ------------------------------------------------- */
 /*                       Real                        */
 /* ------------------------------------------------- */
 
@@ -551,10 +328,15 @@
 			(Word##size w1, Word##size w2) {	\
 		return w1 op w2;				\
 	}
-#define wordCmp(size, name, op)					\
-	static inline Bool Word##size##_##name 			\
-			(Word##size w1, Word##size w2) {	\
-		return w1 op w2;				\
+#define wordCmp(size, name, op)							\
+	static inline Bool Word##size##_##name					\
+			(Word##size w1, Word##size w2) {			\
+		Bool res = w1 op w2;						\
+		if (DEBUG_CCODEGEN)						\
+			fprintf (stderr, "%s = 0x%08x " #op " 0x%08x\n",	\
+					res ? "true": "false",			\
+					w1, w2);				\
+		return w1 op w2;						\
 	}
 #define wordShift(size, name, op)			\
 	static inline Word##size Word##size##_##name 	\
@@ -568,26 +350,31 @@
 #define wordOps(size)								\
 	wordBinary (size, add, +)						\
 	wordBinary (size, andb, &)						\
-	wordBinary (size, div, /)						\
-	wordBinary (size, mod, %)						\
-	wordBinary (size, mul, *)						\
+	wordBinary (S##size, mul, *)						\
+	wordBinary (U##size, mul, *)						\
 	wordBinary (size, orb, |)						\
+	wordBinary (U##size, quot, /)						\
+	wordBinary (U##size, rem, %)						\
 	wordBinary (size, sub, -)						\
 	wordBinary (size, xorb, ^)						\
 	wordCmp (size, equal, ==)						\
-	wordCmp (size, ge, >=)							\
-	wordCmp (size, gt, >)							\
-	wordCmp (size, le, <=)							\
-	wordCmp (size, lt, <)							\
+	wordCmp (S##size, ge, >=)						\
+	wordCmp (U##size, ge, >=)						\
+	wordCmp (S##size, gt, >)						\
+	wordCmp (U##size, gt, >)						\
+	wordCmp (S##size, le, <=)						\
+	wordCmp (U##size, le, <=)						\
+	wordCmp (S##size, lt, <)						\
+	wordCmp (U##size, lt, <)						\
 	wordShift (size, lshift, <<)						\
-	wordShift (size, rshift, >>)						\
+	wordShift (U##size, rshift, >>)						\
 	wordUnary (size, neg, -)						\
 	wordUnary (size, notb, ~)						\
-	/* Word_arshift isn't ANSI C, because ANSI doesn't guarantee sign	\
+	/* WordS_rshift isn't ANSI C, because ANSI doesn't guarantee sign	\
          * extension.  We use it anyway cause it always seems to work.		\
 	 */									\
-	static inline Word##size Word##size##_arshift (Word##size w, Word s) {	\
-		return (Int##size)w >> s;					\
+	static inline Word##size WordS##size##_rshift (WordS##size w, Word s) {	\
+		return w >> s;							\
 	}									\
 	static inline Word##size Word##size##_rol (Word##size w1, Word w2) {	\
 		return (w1 >> (size - w2)) | (w1 << w2);			\
@@ -605,46 +392,190 @@
 	static inline t f##_to##t (f x) {	\
 		return (t)x;			\
 	}
-coerce (Int16, Real32)
-coerce (Int16, Real64)
-coerce (Int32, Real32)
-coerce (Int32, Real64)
-coerce (Int8, Real32)
-coerce (Int8, Real64)
-coerce (Real32, Int16)
-coerce (Real32, Int32)
-coerce (Real32, Int8)
-coerce (Real32, Real32)
 coerce (Real32, Real64)
-coerce (Real64, Int16)
-coerce (Real64, Int32)
-coerce (Real64, Int8)
+coerce (Real32, WordS32)
 coerce (Real64, Real32)
-coerce (Real64, Real64)
-coerce (Word16, Word32)
-coerce (Word16, Word64)
-coerce (Word16, Word8)
-coerce (Word32, Word16)
-coerce (Word32, Word64)
-coerce (Word32, Word8)
-coerce (Word64, Word16)
-coerce (Word64, Word32)
-coerce (Word64, Word8)
-coerce (Word8, Word16)
-coerce (Word8, Word32)
-coerce (Word8, Word64)
+coerce (Real64, WordS32)
+coerce (WordS16, Real32)
+coerce (WordS16, Real64)
+coerce (WordS16, Word32)
+coerce (WordS16, Word64)
+coerce (WordS32, Real32)
+coerce (WordS32, Real64)
+coerce (WordS32, Word64)
+coerce (WordS8, Real32)
+coerce (WordS8, Real64)
+coerce (WordS8, Word16)
+coerce (WordS8, Word32)
+coerce (WordS8, Word64)
+coerce (WordU16, Word32)
+coerce (WordU16, Word64)
+coerce (WordU16, Word8)
+coerce (WordU32, Word16)
+coerce (WordU32, Word64)
+coerce (WordU32, Word8)
+coerce (WordU64, Word16)
+coerce (WordU64, Word32)
+coerce (WordU64, Word8)
+coerce (WordU8, Word16)
+coerce (WordU8, Word32)
+coerce (WordU8, Word64)
 #undef coerce
 
-#define coerceX(size, t)					\
-	static inline t Word##size##_to##t##X (Word##size x) {	\
-		return (t)(Int##size)x;				\
-	}
-coerceX (32, Word64)
-coerceX (16, Word64)
-coerceX (16, Word32)
-coerceX (8, Word64)
-coerceX (8, Word32)
-coerceX (8, Word16)
-#undef coerceX
+#define WordS8_max (WordS8)0x7F
+#define	WordS8_min (WordS8)0x80
+#define WordS16_max (WordS16)0x7FFF
+#define WordS16_min (WordS16)0x8000
+#define WordS32_max (WordS32)0x7FFFFFFF
+#define WordS32_min (WordS32)0x80000000
+#define WordS64_max (WordS64)0x7FFFFFFFFFFFFFFF
+#define WordS64_min (WordS64)0x8000000000000000
+#define Word8_max (Word8)0xFF
+#define Word16_max (Word16)0xFFFF
+#define Word32_max (Word32)0xFFFFFFFF
+#define Word64_max (Word64)0xFFFFFFFFFFFFFFFF
+
+#define WordS_addCheckXC(size, dst, xW, cW, l)		\
+	do {						\
+		WordS##size x = xW;			\
+		WordS##size c = cW;			\
+		if (c >= 0) {				\
+			if (x > WordS##size##_max - c)	\
+				goto l;			\
+		} else if (x < WordS##size##_min - c)	\
+				goto l;			\
+		dst = x + c;				\
+	} while (0)
+#define WordS8_addCheckXC(dst, x, c, l) WordS_addCheckXC(8, dst, x, c, l)
+#define WordS16_addCheckXC(dst, x, c, l) WordS_addCheckXC(16, dst, x, c, l)
+#define WordS32_addCheckXC(dst, x, c, l) WordS_addCheckXC(32, dst, x, c, l)
+#define WordS64_addCheckXC(dst, x, c, l) WordS_addCheckXC(64, dst, x, c, l)
+
+#define WordS8_addCheckCX(dst, c, x, l) WordS8_addCheckXC(dst, x, c, l)
+#define WordS16_addCheckCX(dst, c, x, l) WordS16_addCheckXC(dst, x, c, l)
+#define WordS32_addCheckCX(dst, c, x, l) WordS32_addCheckXC(dst, x, c, l)
+#define WordS64_addCheckCX(dst, c, x, l) WordS64_addCheckXC(dst, x, c, l)
+
+#define WordS8_addCheck WordS8_addCheckXC
+#define WordS16_addCheck WordS16_addCheckXC
+#define WordS32_addCheck WordS32_addCheckXC
+#define WordS64_addCheck WordS64_addCheckXC
+
+#define WordS_negCheck(size, dst, nW, l)	\
+	do {					\
+		WordS##size n = nW;		\
+		if (n == WordS##size##_min)	\
+			goto l;			\
+		dst = -n;			\
+	} while (0)
+
+#define Word8_negCheck(dst, n, l) WordS_negCheck(8, dst, n, l)
+#define Word16_negCheck(dst, n, l) WordS_negCheck(16, dst, n, l)
+#define Word32_negCheck(dst, n, l) WordS_negCheck(32, dst, n, l)
+#define Word64_negCheck(dst, n, l) WordS_negCheck(64, dst, n, l)
+
+#define WordS_subCheckCX(size, dst, cW, xW, l)		\
+	do {						\
+		WordS##size c = cW;			\
+		WordS##size x = xW;			\
+ 		if (c >= 0) {				\
+			if (x < c - WordS##size##_max)	\
+				goto l;			\
+		} else if (x > c - WordS##size##_min)	\
+			goto l;				\
+		dst = c - x;				\
+	} while (0)
+#define WordS8_subCheckCX(dst, c, x, l) WordS_subCheckCX(8, dst, c, x, l)
+#define WordS16_subCheckCX(dst, c, x, l) WordS_subCheckCX(16, dst, c, x, l)
+#define WordS32_subCheckCX(dst, c, x, l) WordS_subCheckCX(32, dst, c, x, l)
+#define WordS64_subCheckCX(dst, c, x, l) WordS_subCheckCX(64, dst, c, x, l)
+
+#define WordS_subCheckXC(size, dst, xW, cW, l)		\
+	do {						\
+		WordS##size c = cW;			\
+		WordS##size x = xW;			\
+		if (c <= 0) {				\
+			if (x > WordS##size##_max + c)	\
+				goto l;			\
+		} else if (x < WordS##size##_min + c)	\
+			goto l;				\
+		dst = x - c;				\
+ 	} while (0)
+#define WordS8_subCheckXC(dst, c, x, l) WordS_subCheckXC(8, dst, c, x, l)
+#define WordS16_subCheckXC(dst, c, x, l) WordS_subCheckXC(16, dst, c, x, l)
+#define WordS32_subCheckXC(dst, c, x, l) WordS_subCheckXC(32, dst, c, x, l)
+#define WordS64_subCheckXC(dst, c, x, l) WordS_subCheckXC(64, dst, c, x, l)
+
+#define WordS8_subCheck WordS8_subCheckXC
+#define WordS16_subCheck WordS16_subCheckXC
+#define WordS32_subCheck WordS32_subCheckXC
+#define WordS64_subCheck WordS64_subCheckXC
+
+#define Word_addCheckXC(size, dst, x, c, l)	\
+	do {					\
+		if (x > Word##size##_max - c)	\
+			goto l;			\
+		dst = x + c;			\
+	} while (0)
+#define WordU8_addCheckXC(dst, x, c, l) Word_addCheckXC(8, dst, x, c, l)
+#define WordU16_addCheckXC(dst, x, c, l) Word_addCheckXC(16, dst, x, c, l)
+#define WordU32_addCheckXC(dst, x, c, l) Word_addCheckXC(32, dst, x, c, l)
+#define WordU64_addCheckXC(dst, x, c, l) Word_addCheckXC(64, dst, x, c, l)
+#define WordU8_addCheckCX(dst, c, x, l) Word_addCheckXC(8, dst, x, c, l)
+#define WordU16_addCheckCX(dst, c, x, l) Word_addCheckXC(16, dst, x, c, l)
+#define WordU32_addCheckCX(dst, c, x, l) Word_addCheckXC(32, dst, x, c, l)
+#define WordU64_addCheckCX(dst, c, x, l) Word_addCheckXC(64, dst, x, c, l)
+
+#define WordU8_addCheck WordU8_addCheckXC
+#define WordU16_addCheck WordU16_addCheckXC
+#define WordU32_addCheck WordU32_addCheckXC
+#define WordU64_addCheck WordU64_addCheckXC
+
+#define mulOverflow(small, large)						\
+	static inline Word##small Word##small##_##mulOverflow			\
+			(Word##small x1, Word##small x2, Bool *overflow) {	\
+		Word##large tmp;						\
+		Word##small res;						\
+										\
+		tmp = (Word##large)x1 * x2;					\
+		res = tmp;							\
+		*overflow = (tmp != res);					\
+		return res;							\
+	}
+mulOverflow(S8, S16)
+mulOverflow(S16, S32)
+mulOverflow(S32, S64)
+mulOverflow(U8, U16)
+mulOverflow(U16, U32)
+mulOverflow(U32, U64)
+#undef mulOverflow
+
+#define check(dst, n1, n2, l, f);						\
+	do {									\
+		int overflow;							\
+		dst = f (n1, n2, &overflow);					\
+		if (DEBUG_CCODEGEN)						\
+			fprintf (stderr, "%s:%d: " #f "(%d, %d) = %d\n",	\
+					__FILE__, __LINE__, n1, n2, dst);	\
+		if (overflow) {							\
+			if (DEBUG_CCODEGEN)					\
+				fprintf (stderr, "%s:%d: overflow\n",		\
+						__FILE__, __LINE__);		\
+			goto l;							\
+		}								\
+	} while (0)
+
+#define WordS8_mulCheck(dst, n1, n2, l)			\
+	check (dst, n1, n2, l, WordS8_mulOverflow)
+#define WordS16_mulCheck(dst, n1, n2, l)		\
+	check (dst, n1, n2, l, WordS16_mulOverflow)
+#define WordS32_mulCheck(dst, n1, n2, l)		\
+	check (dst, n1, n2, l, WordS32_mulOverflow)
+#define WordU8_mulCheck(dst, n1, n2, l)			\
+	check (dst, n1, n2, l, WordU8_mulOverflow)
+#define WordU16_mulCheck(dst, n1, n2, l)		\
+	check (dst, n1, n2, l, WordU16_mulOverflow)
+#define WordU32_mulCheck(dst, n1, n2, l)		\
+	check (dst, n1, n2, l, WordU32_mulOverflow)
 
 #endif /* #ifndef _C_CHUNK_H_ */



1.11      +0 -20     mlton/mlton/ast/int-size.fun

Index: int-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/int-size.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- int-size.fun	28 Apr 2004 03:17:04 -0000	1.10
+++ int-size.fun	1 May 2004 00:49:34 -0000	1.11
@@ -93,24 +93,4 @@
       NONE => Error.bug "IntSize.prim"
     | SOME p => p
 
-val range =
-   memoize
-   (fn s =>
-    let
-       val pow = IntInf.pow (2, Bits.toInt (bits s) - 1)
-    in
-       (~ pow, pow - 1)
-    end)
-
-fun isInRange (s, i) =
-   let
-      val (min, max) = range s
-   in
-      min <= i andalso i <= max
-   end
-
-val min = #1 o range
-
-val max = #2 o range
-
 end



1.7       +0 -4      mlton/mlton/ast/int-size.sig

Index: int-size.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/int-size.sig,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- int-size.sig	28 Apr 2004 03:17:04 -0000	1.6
+++ int-size.sig	1 May 2004 00:49:34 -0000	1.7
@@ -25,15 +25,11 @@
       val default: t
       val equals: t * t -> bool
       val I : Bits.t -> t
-      val isInRange: t * IntInf.t -> bool
       val layout: t -> Layout.t
-      val max: t -> IntInf.t
       val memoize: (t -> 'a) -> t -> 'a
-      val min: t -> IntInf.t
       datatype prim = I8 | I16 | I32 | I64
       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.11      +19 -1     mlton/mlton/ast/word-size.fun

Index: word-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- word-size.fun	28 Apr 2004 03:17:04 -0000	1.10
+++ word-size.fun	1 May 2004 00:49:34 -0000	1.11
@@ -82,7 +82,25 @@
 
 fun cardinality s = IntInf.<< (1, Bits.toWord (bits s))
 
-fun max s = cardinality s - 1
+fun range (s, {signed}) =
+   if signed
+      then
+	 let
+	    val pow = IntInf.pow (2, Bits.toInt (bits s) - 1)
+	 in
+	    (~ pow, pow - 1)
+	 end
+   else (0, cardinality s - 1)
+
+val min = #1 o range
+val max = #2 o range
+
+fun isInRange (s, i, sg) =
+   let
+      val (min, max) = range (s, sg)
+   in
+      min <= i andalso i <= max
+   end
    
 datatype prim = W8 | W16 | W32 | W64
 



1.10      +3 -1      mlton/mlton/ast/word-size.sig

Index: word-size.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.sig,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- word-size.sig	28 Apr 2004 03:17:04 -0000	1.9
+++ word-size.sig	1 May 2004 00:49:34 -0000	1.10
@@ -27,8 +27,10 @@
       val default: t
       val equals: t * t -> bool
       val fromBits: Bits.t -> t
+      val isInRange: t * IntInf.t * {signed: bool} -> bool
       val layout: t -> Layout.t
-      val max: t -> IntInf.t
+      val max: t * {signed: bool} -> IntInf.t
+      val min: t * {signed: bool} -> IntInf.t
       val memoize: (t -> 'a) -> t -> 'a
       val one: t
       val pointer: unit -> t



1.18      +1 -4      mlton/mlton/atoms/atoms.fun

Index: atoms.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/atoms.fun,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- atoms.fun	25 Apr 2004 06:55:43 -0000	1.17
+++ atoms.fun	1 May 2004 00:49:34 -0000	1.18
@@ -22,7 +22,6 @@
 			       structure WordSize = WordSize)
       structure Con = Con ()
       structure CType = CType ()
-      structure IntX = IntX (structure IntSize = IntSize)
       structure RealX = RealX (structure RealSize = RealSize)
       structure WordX = WordX (structure WordSize = WordSize)
       structure Func =
@@ -35,15 +34,13 @@
 	    open Func
 	    fun newNoname () = newString "L"
 	 end
-      structure Const = Const (structure IntX = IntX
-			       structure RealX = RealX
+      structure Const = Const (structure RealX = RealX
 			       structure WordX = WordX)
       structure CFunction = CFunction ()
       structure Prim = Prim (structure CFunction = CFunction
 			     structure CType = CType
 			     structure Con = Con
 			     structure Const = Const
-			     structure IntSize = IntSize
 			     structure RealSize = RealSize
 			     structure WordSize = WordSize)
       structure Ffi = Ffi (structure CFunction = CFunction



1.18      +1 -5      mlton/mlton/atoms/atoms.sig

Index: atoms.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/atoms.sig,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- atoms.sig	25 Apr 2004 06:55:44 -0000	1.17
+++ atoms.sig	1 May 2004 00:49:34 -0000	1.18
@@ -28,7 +28,6 @@
       structure Const: CONST
       structure Ffi: FFI
       structure Func: FUNC
-      structure IntX: INT_X
       structure Label: LABEL
       structure Prim: PRIM
       structure ProfileLabel: PROFILE_LABEL
@@ -46,8 +45,7 @@
       sharing CType = Ffi.CType = Prim.CType 
       sharing Con = Prim.Con
       sharing Const = Prim.Const
-      sharing IntSize = IntX.IntSize = Prim.IntSize = Tycon.IntSize
-      sharing IntX = Const.IntX
+      sharing IntSize = Tycon.IntSize
       sharing RealSize = Prim.RealSize = RealX.RealSize = Tycon.RealSize
       sharing RealX = Const.RealX
       sharing SourceInfo = ProfileExp.SourceInfo
@@ -77,8 +75,6 @@
       sharing Ffi = Atoms.Ffi
       sharing Field = Atoms.Field
       sharing Func = Atoms.Func
-      sharing IntSize = Atoms.IntSize
-      sharing IntX = Atoms.IntX
       sharing Label = Atoms.Label
       sharing Prim = Atoms.Prim
       sharing ProfileLabel = Atoms.ProfileLabel



1.18      +5 -10     mlton/mlton/atoms/const.fun

Index: const.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.fun,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- const.fun	18 Mar 2004 03:22:22 -0000	1.17
+++ const.fun	1 May 2004 00:49:34 -0000	1.18
@@ -32,13 +32,11 @@
    end
 
 datatype t =
-   Int of IntX.t
- | IntInf of IntInf.t
+   IntInf of IntInf.t
  | Real of RealX.t
  | Word of WordX.t
  | Word8Vector of Word8.t vector
 
-val int = Int
 val real = Real
 val intInf = IntInf
 val word = Word
@@ -52,10 +50,9 @@
    fun wrap (pre, post, s) = seq [str pre, String.layout s, str post]
 in
    val layout =
-      fn Int i => IntX.layout i
-       | IntInf i => IntInf.layout i
+      fn IntInf i => IntInf.layout i
        | Real r => RealX.layout r
-       | Word w => seq [str "0wx", WordX.layout w]
+       | Word w => WordX.layout w
        | Word8Vector v => wrap ("\"", "\"", Word8.vectorToString v)
 end	 
 
@@ -63,16 +60,14 @@
 
 fun hash (c: t): word =
    case c of
-      Int i => String.hash (IntX.toString i)
-    | IntInf i => String.hash (IntInf.toString i)
+      IntInf i => String.hash (IntInf.toString i)
     | Real r => RealX.hash r
     | Word w => Word.fromIntInf (WordX.toIntInf w)
     | Word8Vector v => String.hash (Word8.vectorToString v)
    
 fun equals (c, c') =
    case (c, c') of
-      (Int i, Int i') => IntX.equals (i, i')
-    | (IntInf i, IntInf i') => IntInf.equals (i, i')
+      (IntInf i, IntInf i') => IntInf.equals (i, i')
     | (Real r, Real r') => RealX.equals (r, r')
     | (Word w, Word w') => WordX.equals (w, w')
     | (Word8Vector v, Word8Vector v') => v = v'



1.12      +1 -4      mlton/mlton/atoms/const.sig

Index: const.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.sig,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- const.sig	4 Apr 2004 06:50:14 -0000	1.11
+++ const.sig	1 May 2004 00:49:34 -0000	1.12
@@ -9,7 +9,6 @@
    
 signature CONST_STRUCTS = 
    sig
-      structure IntX: INT_X
       structure RealX: REAL_X
       structure WordX: WORD_X
    end
@@ -26,14 +25,12 @@
 	 end
 
       datatype t =
-	 Int of IntX.t
-       | IntInf of IntInf.t
+	 IntInf of IntInf.t
        | Real of RealX.t
        | Word of WordX.t
        | Word8Vector of Word8.t vector
 
       val equals: t * t -> bool
-      val int: IntX.t -> t
       val intInf: IntInf.t -> t
       val hash: t -> word
       val layout: t -> Layout.t



1.14      +37 -64    mlton/mlton/atoms/hash-type.fun

Index: hash-type.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/hash-type.fun,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- hash-type.fun	25 Apr 2004 06:55:44 -0000	1.13
+++ hash-type.fun	1 May 2004 00:49:34 -0000	1.14
@@ -141,8 +141,7 @@
       datatype z = datatype Const.t
    in
       case c of
-	 Int i => int (IntX.size i)
-       | IntInf _ => intInf
+	 IntInf _ => intInf
        | Real r => real (RealX.size r)
        | Word w => word (WordX.size w)
        | Word8Vector _ => word8Vector
@@ -218,21 +217,18 @@
       local
 	 fun make f s = let val t = f s in done ([t], t) end
       in
-	 val intUnary = make int
 	 val realUnary = make real
 	 val wordUnary = make word
       end
       local
 	 fun make f s = let val t = f s in done ([t, t], t) end
       in
-	 val intBinary = make int
 	 val realBinary = make real
 	 val wordBinary = make word
       end
       local
 	 fun make f s = let val t = f s in done ([t, t], bool) end
       in
-	 val intCompare = make int
 	 val realCompare = make real
 	 val wordCompare = make word
       end
@@ -246,12 +242,12 @@
       fun wordShift s = done ([word s, defaultWord], word s)
    in
       case Prim.name prim of
-	 Array_array => oneTarg (fn targ => ([defaultInt], array targ))
+	 Array_array => oneTarg (fn targ => ([defaultWord], array targ))
        | Array_array0Const => oneTarg (fn targ => ([], array targ))
-       | Array_length => oneTarg (fn t => ([array t], defaultInt))
-       | Array_sub => oneTarg (fn t => ([array t, defaultInt], t))
+       | Array_length => oneTarg (fn t => ([array t], defaultWord))
+       | Array_sub => oneTarg (fn t => ([array t, defaultWord], t))
        | Array_toVector => oneTarg (fn t => ([array t], vector t))
-       | Array_update => oneTarg (fn t => ([array t, defaultInt, t], unit))
+       | Array_update => oneTarg (fn t => ([array t, defaultWord, t], unit))
        | Exn_extra => oneTarg (fn t => ([exn], t))
        | Exn_name => done ([exn], string)
        | Exn_setExtendExtra =>
@@ -267,7 +263,7 @@
        | IntInf_add => intInfBinary ()
        | IntInf_andb => intInfBinary ()
        | IntInf_arshift => intInfShift ()
-       | IntInf_compare => done ([intInf, intInf], defaultInt)
+       | IntInf_compare => done ([intInf, intInf], defaultWord)
        | IntInf_equal => done ([intInf, intInf], bool)
        | IntInf_gcd => intInfBinary ()
        | IntInf_lshift => intInfShift ()
@@ -278,47 +274,25 @@
        | IntInf_quot => intInfBinary ()
        | IntInf_rem => intInfBinary ()
        | IntInf_sub => intInfBinary ()
-       | IntInf_toString => done ([intInf, defaultInt, defaultWord], string)
+       | IntInf_toString => done ([intInf, defaultWord, defaultWord], string)
        | IntInf_toVector => done ([intInf], vector defaultWord)
        | IntInf_toWord => done ([intInf], defaultWord)
        | IntInf_xorb => intInfBinary ()
-       | Int_add s => intBinary s
-       | Int_addCheck s => intBinary s
-       | Int_arshift s => done ([int s, defaultWord], int s)
-       | Int_equal s => intCompare s
-       | Int_ge s => intCompare s
-       | Int_gt s => intCompare s
-       | Int_le s => intCompare s
-       | Int_lshift s => done ([int s, defaultWord], int s)
-       | Int_lt s => intCompare s
-       | Int_mul s => intBinary s
-       | Int_mulCheck s => intBinary s
-       | Int_neg s => intUnary s
-       | Int_negCheck s => intUnary s
-       | Int_quot s => intBinary s
-       | Int_rem s => intBinary s
-       | Int_sub s => intBinary s
-       | Int_subCheck s => intBinary s
-       | Int_toInt (s, s') => done ([int s], int s')
-       | Int_toReal (s, s') => done ([int s], real s')
-       | Int_toWord (s, s') => done ([int s], word s')
        | MLton_bogus => oneTarg (fn t => ([], t))
        | MLton_bug => done ([string], unit)
        | MLton_eq => oneTarg (fn t => ([t, t], bool))
        | MLton_equal => oneTarg (fn t => ([t, t], bool))
-       | MLton_halt => done ([defaultInt], unit)
+       | MLton_halt => done ([defaultWord], unit)
        | MLton_handlesSignals => done ([], bool)
        | MLton_installSignalHandler => done ([], unit)
-       | MLton_size => oneTarg (fn t => ([reff t], defaultInt))
+       | MLton_size => oneTarg (fn t => ([reff t], defaultWord))
        | MLton_touch => oneTarg (fn t => ([t], unit))
-       | Pointer_getInt s => done ([pointer, defaultInt], int s)
-       | Pointer_getPointer => oneTarg (fn t => ([pointer, defaultInt], t))
-       | Pointer_getReal s => done ([pointer, defaultInt], real s)
-       | Pointer_getWord s => done ([pointer, defaultInt], word s)
-       | Pointer_setInt s => done ([pointer, defaultInt, int s], unit)
-       | Pointer_setPointer => oneTarg (fn t => ([pointer, defaultInt, t], unit))
-       | Pointer_setReal s => done ([pointer, defaultInt, real s], unit)
-       | Pointer_setWord s => done ([pointer, defaultInt, word s], unit)
+       | Pointer_getPointer => oneTarg (fn t => ([pointer, defaultWord], t))
+       | Pointer_getReal s => done ([pointer, defaultWord], real s)
+       | Pointer_getWord s => done ([pointer, defaultWord], word s)
+       | Pointer_setPointer => oneTarg (fn t => ([pointer, defaultWord, t], unit))
+       | Pointer_setReal s => done ([pointer, defaultWord, real s], unit)
+       | Pointer_setWord s => done ([pointer, defaultWord, word s], unit)
        | Real_Math_acos s => realUnary s
        | Real_Math_asin s => realUnary s
        | Real_Math_atan s => realUnary s
@@ -336,7 +310,7 @@
        | Real_equal s => realCompare s
        | Real_ge s => realCompare s
        | Real_gt s => realCompare s
-       | Real_ldexp s => done ([real s, defaultInt], real s)
+       | Real_ldexp s => done ([real s, defaultWord], real s)
        | Real_le s => realCompare s
        | Real_lt s => realCompare s
        | Real_mul s => realBinary s
@@ -346,54 +320,53 @@
        | Real_qequal s => realCompare s
        | Real_round s => realUnary s
        | Real_sub s => realBinary s
-       | Real_toInt (s, s') => done ([real s], int s')
        | Real_toReal (s, s') => done ([real s], real s')
+       | Real_toWord (s, s', _) => done ([real s], word s')
        | Ref_assign => oneTarg (fn t => ([reff t, t], unit))
        | Ref_deref => oneTarg (fn t => ([reff t], t))
        | Ref_ref => oneTarg (fn t => ([t], reff t))
        | Thread_atomicBegin => done ([], unit)
        | Thread_atomicEnd => done ([], unit)
-       | Thread_canHandle => done ([], defaultInt)
+       | Thread_canHandle => done ([], defaultWord)
        | Thread_copy => done ([thread], thread)
        | Thread_copyCurrent => done ([], unit)
        | Thread_returnToC => done ([], unit)
        | Thread_switchTo => done ([thread], unit)
-       | Vector_length => oneTarg (fn t => ([vector t], defaultInt))
-       | Vector_sub => oneTarg (fn t => ([vector t, defaultInt], t))
+       | Vector_length => oneTarg (fn t => ([vector t], defaultWord))
+       | Vector_sub => oneTarg (fn t => ([vector t, defaultWord], t))
        | Weak_canGet => oneTarg (fn t => ([weak t], bool))
        | Weak_get => oneTarg (fn t => ([weak t], t))
        | Weak_new => oneTarg (fn t => ([t], weak t))
-       | Word8Array_subWord => done ([word8Array, defaultInt], defaultWord)
+       | Word8Array_subWord => done ([word8Array, defaultWord], defaultWord)
        | Word8Array_updateWord =>
-	    done ([word8Array, defaultInt, defaultWord], unit)
-       | Word8Vector_subWord => done ([word8Vector, defaultInt], defaultWord)
+	    done ([word8Array, defaultWord, defaultWord], unit)
+       | Word8Vector_subWord => done ([word8Vector, defaultWord], defaultWord)
        | WordVector_toIntInf => done ([wordVector], intInf)
        | Word_add s => wordBinary s
-       | Word_addCheck s => wordBinary s
+       | Word_addCheck (s, _) => wordBinary s
        | Word_andb s => wordBinary s
-       | Word_arshift s => wordShift s
-       | Word_div s => wordBinary s
        | Word_equal s => wordCompare s
-       | Word_ge s => wordCompare s
-       | Word_gt s => wordCompare s
-       | Word_le s => wordCompare s
+       | Word_ge (s, _) => wordCompare s
+       | Word_gt (s, _) => wordCompare s
+       | Word_le (s, _) => wordCompare s
        | Word_lshift s => wordShift s
-       | Word_lt s => wordCompare s
-       | Word_mod s => wordBinary s
-       | Word_mul s => wordBinary s
-       | Word_mulCheck s => wordBinary s
+       | Word_lt (s, _) => wordCompare s
+       | Word_mul (s, _) => wordBinary s
+       | Word_mulCheck (s, _) => wordBinary s
        | Word_neg s => wordUnary s
+       | Word_negCheck s => wordUnary s
        | Word_notb s => wordUnary s
        | Word_orb s => wordBinary s
+       | Word_quot (s, _) => wordBinary s
+       | Word_rem (s, _) => wordBinary s
        | Word_rol s => wordShift s
        | Word_ror s => wordShift s
-       | Word_rshift s => wordShift s
+       | Word_rshift (s, _) => wordShift s
        | Word_sub s => wordBinary s
-       | Word_toInt (s, s') => done ([word s], int s')
+       | Word_subCheck (s, _) => wordBinary s
        | Word_toIntInf => done ([defaultWord], intInf)
-       | Word_toIntX (s, s') => done ([word s], int s')
-       | Word_toWord (s, s') => done ([word s], word s')
-       | Word_toWordX (s, s') => done ([word s], word s')
+       | Word_toReal (s, s', _) => done ([word s], real s')
+       | Word_toWord (s, s', _) => done ([word s], word s')
        | Word_xorb s => wordBinary s
        | World_save => done ([defaultWord], unit)
        | _ => Error.bug (concat ["Type.checkPrimApp got strange prim: ",



1.8       +1 -1      mlton/mlton/atoms/hash-type.sig

Index: hash-type.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/hash-type.sig,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- hash-type.sig	12 Apr 2004 17:52:48 -0000	1.7
+++ hash-type.sig	1 May 2004 00:49:34 -0000	1.8
@@ -14,7 +14,7 @@
    sig
       include HASH_TYPE_STRUCTS
       include TYPE_OPS
-      sharing type intSize = IntSize.t
+(*      sharing type intSize = IntSize.t *)
       sharing type realSize = RealSize.t
       sharing type tycon = Tycon.t
       sharing type wordSize = WordSize.t



1.82      +251 -464  mlton/mlton/atoms/prim.fun

Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -r1.81 -r1.82
--- prim.fun	28 Apr 2004 03:17:05 -0000	1.81
+++ prim.fun	1 May 2004 00:49:34 -0000	1.82
@@ -20,7 +20,6 @@
 local
    open Const
 in
-   structure IntX = IntX
    structure WordX = WordX
 end
 
@@ -40,7 +39,6 @@
  | Array_sub (* backend *)
  | Array_toVector (* backend *)
  | Array_update (* backend *)
- | Char_toWord8 (* type inference *)
  | Exn_extra (* implement exceptions *)
  | Exn_keepHistory (* a compile-time boolean *)
  | Exn_name (* implement exceptions *)
@@ -53,26 +51,6 @@
  | GC_collect (* ssa to rssa *)
  | GC_pack (* ssa to rssa *)
  | GC_unpack (* ssa to rssa *)
- | Int_add of IntSize.t (* codegen *)
- | Int_addCheck of IntSize.t (* codegen *)
- | Int_arshift of IntSize.t (* codegen *)
- | Int_equal of IntSize.t (* ssa to rssa / codegen *)
- | Int_ge of IntSize.t (* codegen *)
- | Int_gt of IntSize.t (* codegen *)
- | Int_le of IntSize.t (* codegen *)
- | Int_lshift of IntSize.t (* codegen *)
- | Int_lt of IntSize.t (* codegen *)
- | Int_mul of IntSize.t (* codegen *)
- | Int_mulCheck of IntSize.t (* codegen *)
- | Int_neg of IntSize.t (* codegen *)
- | Int_negCheck of IntSize.t (* codegen *)
- | Int_quot of IntSize.t (* codegen *)
- | Int_rem of IntSize.t (* codegen *)
- | Int_sub of IntSize.t (* codegen *)
- | Int_subCheck of IntSize.t (* codegen *)
- | Int_toInt of IntSize.t * IntSize.t (* codegen *)
- | Int_toReal of IntSize.t * RealSize.t (* codegen *)
- | Int_toWord of IntSize.t * WordSize.t (* codegen *)
  | IntInf_add (* ssa to rssa *)
  | IntInf_andb (* ssa to rssa *)
  | IntInf_arshift (* ssa to rssa *)
@@ -117,11 +95,9 @@
  | MLton_serialize (* unused *)
  | MLton_size (* ssa to rssa *)
  | MLton_touch (* backend *)
- | Pointer_getInt of IntSize.t (* ssa to rssa *)
  | Pointer_getPointer (* ssa to rssa *)
  | Pointer_getReal of RealSize.t (* ssa to rssa *)
  | Pointer_getWord of WordSize.t (* ssa to rssa *)
- | Pointer_setInt of IntSize.t (* ssa to rssa *)
  | Pointer_setPointer (* ssa to rssa *)
  | Pointer_setReal of RealSize.t (* ssa to rssa *)
  | Pointer_setWord of WordSize.t (* ssa to rssa *)
@@ -152,8 +128,8 @@
  | Real_qequal of RealSize.t (* codegen *)
  | Real_round of RealSize.t (* codegen *)
  | Real_sub of RealSize.t (* codegen *)
- | Real_toInt of RealSize.t * IntSize.t (* codegen *)
  | Real_toReal of RealSize.t * RealSize.t (* codegen *)
+ | Real_toWord of RealSize.t * WordSize.t * {signed: bool} (* codegen *)
  | Ref_assign (* backend *)
  | Ref_deref (* backend *)
  | Ref_ref (* backend *)
@@ -175,34 +151,32 @@
  | Weak_get (* ssa to rssa *)
  | Weak_new (* ssa to rssa *)
  | Word_add of WordSize.t (* codegen *)
- | Word_addCheck of WordSize.t (* codegen *)
+ | Word_addCheck of WordSize.t * {signed: bool} (* codegen *)
  | Word_andb of WordSize.t (* codegen *)
- | Word_arshift of WordSize.t (* codegen *)
- | Word_div of WordSize.t (* codegen *)
  | Word_equal of WordSize.t (* codegen *)
- | Word_ge of WordSize.t (* codegen *)
- | Word_gt of WordSize.t (* codegen *)
- | Word_le of WordSize.t (* codegen *)
+ | Word_ge of WordSize.t * {signed: bool} (* codegen *)
+ | Word_gt of WordSize.t * {signed: bool} (* codegen *)
+ | Word_le of WordSize.t * {signed: bool} (* codegen *)
  | Word_lshift of WordSize.t (* codegen *)
- | Word_lt of WordSize.t (* codegen *)
- | Word_mod of WordSize.t (* codegen *)
- | Word_mul of WordSize.t (* codegen *)
- | Word_mulCheck of WordSize.t (* codegen *)
+ | Word_lt of WordSize.t * {signed: bool} (* codegen *)
+ | Word_mul of WordSize.t * {signed: bool} (* codegen *)
+ | Word_mulCheck of WordSize.t * {signed: bool} (* codegen *)
  | Word_neg of WordSize.t (* codegen *)
+ | Word_negCheck of WordSize.t (* codegen *)
  | Word_notb of WordSize.t (* codegen *)
  | Word_orb of WordSize.t (* codegen *)
+ | Word_quot of WordSize.t * {signed: bool} (* codegen *)
+ | Word_rem of WordSize.t * {signed: bool} (* codegen *)
  | Word_rol of WordSize.t (* codegen *)
  | Word_ror of WordSize.t (* codegen *)
- | Word_rshift of WordSize.t (* codegen *)
+ | Word_rshift of WordSize.t * {signed: bool} (* codegen *)
  | Word_sub of WordSize.t (* codegen *)
- | Word_toInt of WordSize.t * IntSize.t (* codegen *)
+ | Word_subCheck of WordSize.t* {signed: bool} (* codegen *)
  | Word_toIntInf (* ssa to rssa *)
- | Word_toIntX of WordSize.t * IntSize.t (* codegen *)
- | Word_toWord of WordSize.t * WordSize.t (* codegen *)
- | Word_toWordX of WordSize.t * WordSize.t (* codegen *)
+ | Word_toReal of WordSize.t * RealSize.t * {signed: bool} (* codegen *)
+ | Word_toWord of WordSize.t * WordSize.t * {signed: bool} (* codegen *)
  | Word_xorb of WordSize.t (* codegen *)
  | WordVector_toIntInf (* ssa to rssa *)
- | Word8_toChar (* type inference *)
  | Word8Array_subWord (* ssa to rssa *)
  | Word8Array_updateWord (* ssa to rssa *)
  | Word8Vector_subWord (* ssa to rssa *)
@@ -216,23 +190,18 @@
  *)
 fun toString (n: 'a t): string =
    let
-      fun int (s: IntSize.t, str: string): string =
-	 concat ["Int", IntSize.toString s, "_", str]
       fun real (s: RealSize.t, str: string): string =
 	 concat ["Real", RealSize.toString s, "_", str]
+      fun sign {signed} = if signed then "WordS" else "WordU"
       fun word (s: WordSize.t, str: string): string =
 	 concat ["Word", WordSize.toString s, "_", str]
-      val intC = ("Int", IntSize.toString)
+      fun wordS (s: WordSize.t, sg, str: string): string =
+	 concat [sign sg, WordSize.toString s, "_", str]
       val realC = ("Real", RealSize.toString)
       val wordC = ("Word", WordSize.toString)
-      local
-	 fun make (suf, ((n, sizeToString), (n', sizeToString'),
-			 s, s')): string =
-	    concat [n, sizeToString s, "_to", n', sizeToString' s', suf]
-      in
-	 fun coerce z = make ("", z)
-	 fun coerceX z = make ("X", z)
-      end
+      fun wordCS sg = (sign sg, WordSize.toString)
+      fun coerce ((n, sizeToString), (n', sizeToString'), s, s'): string =
+	 concat [n, sizeToString s, "_to", n', sizeToString' s']
       fun pointerGet (ty, s) = concat ["Pointer_get", ty, s]
       fun pointerSet (ty, s) = concat ["Pointer_set", ty, s]
    in
@@ -243,7 +212,6 @@
        | Array_sub => "Array_sub"
        | Array_toVector => "Array_toVector"
        | Array_update => "Array_update"
-       | Char_toWord8 => "Char_toWord8"
        | Exn_extra => "Exn_extra"
        | Exn_keepHistory => "Exn_keepHistory"
        | Exn_name => "Exn_name"
@@ -273,26 +241,6 @@
        | IntInf_toVector => "IntInf_toVector"
        | IntInf_toWord => "IntInf_toWord"
        | IntInf_xorb => "IntInf_xorb"
-       | Int_add s => int (s, "add")
-       | Int_addCheck s => int (s, "addCheck")
-       | Int_arshift s => int (s, "arshift")
-       | Int_equal s => int (s, "equal")
-       | Int_ge s => int (s, "ge")
-       | Int_gt s => int (s, "gt")
-       | Int_le s => int (s, "le")
-       | Int_lshift s => int (s, "lshift")
-       | Int_lt s => int (s, "lt")
-       | Int_mul s => int (s, "mul")
-       | Int_mulCheck s => int (s, "mulCheck")
-       | Int_neg s => int (s, "neg")
-       | Int_negCheck s => int (s, "negCheck")
-       | Int_quot s => int (s, "quot")
-       | Int_rem s => int (s, "rem")
-       | Int_sub s => int (s, "sub")
-       | Int_subCheck s => int (s, "subCheck")
-       | Int_toInt (s1, s2) => coerce (intC, intC, s1, s2)
-       | Int_toReal (s1, s2) => coerce (intC, realC, s1, s2)
-       | Int_toWord (s1, s2) => coerce (intC, wordC, s1, s2)
        | MLton_bogus => "MLton_bogus"
        | MLton_bug => "MLton_bug"
        | MLton_deserialize => "MLton_deserialize"
@@ -304,11 +252,9 @@
        | MLton_serialize => "MLton_serialize"
        | MLton_size => "MLton_size"
        | MLton_touch => "MLton_touch"
-       | Pointer_getInt s => pointerGet ("Int", IntSize.toString s)
        | Pointer_getPointer => "Pointer_getPointer"
        | Pointer_getReal s => pointerGet ("Real", RealSize.toString s)
        | Pointer_getWord s => pointerGet ("Word", WordSize.toString s)
-       | Pointer_setInt s => pointerSet ("Int", IntSize.toString s)
        | Pointer_setPointer => "Pointer_setPointer"
        | Pointer_setReal s => pointerSet ("Real", RealSize.toString s)
        | Pointer_setWord s => pointerSet ("Word", WordSize.toString s)
@@ -339,7 +285,7 @@
        | Real_qequal s => real (s, "qequal")
        | Real_round s => real (s, "round")
        | Real_sub s => real (s, "sub")
-       | Real_toInt (s1, s2) => coerce (realC, intC, s1, s2)
+       | Real_toWord (s1, s2, sg) => coerce (realC, wordCS sg, s1, s2)
        | Real_toReal (s1, s2) => coerce (realC, realC, s1, s2)
        | Ref_assign => "Ref_assign"
        | Ref_deref => "Ref_deref"
@@ -361,34 +307,32 @@
        | Word8Array_updateWord => "Word8Array_updateWord"
        | Word8Vector_subWord => "Word8Vector_subWord"
        | Word8Vector_toString => "Word8Vector_toString"
-       | Word8_toChar => "Word8_toChar"
        | WordVector_toIntInf => "WordVector_toIntInf"
        | Word_add s => word (s, "add")
-       | Word_addCheck s => word (s, "addCheck")
+       | Word_addCheck (s, sg) => wordS (s, sg, "addCheck")
        | Word_andb s => word (s, "andb")
-       | Word_arshift s => word (s, "arshift")
-       | Word_div s => word (s, "div")
        | Word_equal s => word (s, "equal")
-       | Word_ge s => word (s, "ge")
-       | Word_gt s => word (s, "gt")
-       | Word_le s => word (s, "le")
+       | Word_ge (s, sg) => wordS (s, sg, "ge")
+       | Word_gt (s, sg) => wordS (s, sg, "gt")
+       | Word_le (s, sg) => wordS (s, sg, "le")
        | Word_lshift s => word (s, "lshift")
-       | Word_lt s => word (s, "lt")
-       | Word_mod s => word (s, "mod")
-       | Word_mul s => word (s, "mul")
-       | Word_mulCheck s => word (s, "mulCheck")
+       | Word_lt (s, sg) => wordS (s, sg, "lt")
+       | Word_mul (s, sg) => wordS (s, sg, "mul")
+       | Word_mulCheck (s, sg) => wordS (s, sg, "mulCheck")
        | Word_neg s => word (s, "neg")
+       | Word_negCheck s => word (s, "negCheck")
        | Word_notb s => word (s, "notb")
        | Word_orb s => word (s, "orb")
+       | Word_quot (s, sg) => wordS (s, sg, "quot")
+       | Word_rem (s, sg) => wordS (s, sg, "rem")
        | Word_rol s => word (s, "rol")
        | Word_ror s => word (s, "ror")
-       | Word_rshift s => word (s, "rshift")
+       | Word_rshift (s, sg) => wordS (s, sg, "rshift")
        | Word_sub s => word (s, "sub")
-       | Word_toInt (s1, s2) => coerce (wordC, intC, s1, s2)
+       | Word_subCheck (s, sg) => wordS (s, sg, "subCheck")
        | Word_toIntInf => "Word_toIntInf"
-       | Word_toIntX (s1, s2) => coerceX (wordC, intC, s1, s2)
-       | Word_toWord (s1, s2) => coerce (wordC, wordC, s1, s2)
-       | Word_toWordX (s1, s2) => coerceX (wordC, wordC, s1, s2)
+       | Word_toReal (s1, s2, sg) => coerce (wordCS sg, realC, s1, s2)
+       | Word_toWord (s1, s2, sg) => coerce (wordCS sg, wordC, s1, s2)
        | Word_xorb s => word (s, "xorb")
        | World_save => "World_save"
    end
@@ -402,7 +346,6 @@
     | (Array_sub, Array_sub) => true
     | (Array_toVector, Array_toVector) => true
     | (Array_update, Array_update) => true
-    | (Char_toWord8, Char_toWord8) => true
     | (Exn_extra, Exn_extra) => true
     | (Exn_keepHistory, Exn_keepHistory) => true
     | (Exn_name, Exn_name) => true
@@ -414,29 +357,6 @@
     | (GC_collect, GC_collect) => true
     | (GC_pack, GC_pack) => true
     | (GC_unpack, GC_unpack) => true
-    | (Int_add s, Int_add s') => IntSize.equals (s, s')
-    | (Int_addCheck s, Int_addCheck s') => IntSize.equals (s, s')
-    | (Int_arshift s, Int_arshift s') => IntSize.equals (s, s')
-    | (Int_equal s, Int_equal s') => IntSize.equals (s, s')
-    | (Int_ge s, Int_ge s') => IntSize.equals (s, s')
-    | (Int_gt s, Int_gt s') => IntSize.equals (s, s')
-    | (Int_le s, Int_le s') => IntSize.equals (s, s')
-    | (Int_lshift s, Int_lshift s') => IntSize.equals (s, s')
-    | (Int_lt s, Int_lt s') => IntSize.equals (s, s')
-    | (Int_mul s, Int_mul s') => IntSize.equals (s, s')
-    | (Int_mulCheck s, Int_mulCheck s') => IntSize.equals (s, s')
-    | (Int_neg s, Int_neg s') => IntSize.equals (s, s')
-    | (Int_negCheck s, Int_negCheck s') => IntSize.equals (s, s')
-    | (Int_quot s, Int_quot s') => IntSize.equals (s, s')
-    | (Int_rem s, Int_rem s') => IntSize.equals (s, s')
-    | (Int_sub s, Int_sub s') => IntSize.equals (s, s')
-    | (Int_subCheck s, Int_subCheck s') => IntSize.equals (s, s')
-    | (Int_toInt (s1, s2), Int_toInt (s1', s2')) =>
-	 IntSize.equals (s1, s1') andalso IntSize.equals (s2, s2')
-    | (Int_toReal (s1, s2), Int_toReal (s1', s2')) =>
-	 IntSize.equals (s1, s1') andalso RealSize.equals (s2, s2')
-    | (Int_toWord (s1, s2), Int_toWord (s1', s2')) =>
-	 IntSize.equals (s1, s1') andalso WordSize.equals (s2, s2')
     | (IntInf_add, IntInf_add) => true
     | (IntInf_andb, IntInf_andb) => true
     | (IntInf_arshift, IntInf_arshift) => true
@@ -466,11 +386,9 @@
     | (MLton_serialize, MLton_serialize) => true
     | (MLton_size, MLton_size) => true
     | (MLton_touch, MLton_touch) => true
-    | (Pointer_getInt s, Pointer_getInt s') => IntSize.equals (s, s')
     | (Pointer_getPointer, Pointer_getPointer) => true
     | (Pointer_getReal s, Pointer_getReal s') => RealSize.equals (s, s')
     | (Pointer_getWord s, Pointer_getWord s') => WordSize.equals (s, s')
-    | (Pointer_setInt s, Pointer_setInt s') => IntSize.equals (s, s')
     | (Pointer_setPointer, Pointer_setPointer) => true
     | (Pointer_setReal s, Pointer_setReal s') => RealSize.equals (s, s')
     | (Pointer_setWord s, Pointer_setWord s') => WordSize.equals (s, s')
@@ -501,10 +419,12 @@
     | (Real_qequal s, Real_qequal s') => RealSize.equals (s, s')
     | (Real_round s, Real_round s') => RealSize.equals (s, s')
     | (Real_sub s, Real_sub s') => RealSize.equals (s, s')
-    | (Real_toInt (s1, s2), Real_toInt (s1', s2')) =>
-	 RealSize.equals (s1, s1') andalso IntSize.equals (s2, s2')
     | (Real_toReal (s1, s2), Real_toReal (s1', s2')) =>
 	 RealSize.equals (s1, s1') andalso RealSize.equals (s2, s2')
+    | (Real_toWord (s1, s2, sg), Real_toWord (s1', s2', sg')) =>
+	 RealSize.equals (s1, s1')
+	 andalso WordSize.equals (s2, s2')
+	 andalso sg = sg'
     | (Ref_assign, Ref_assign) => true
     | (Ref_deref, Ref_deref) => true
     | (Ref_ref, Ref_ref) => true
@@ -522,38 +442,49 @@
     | (Weak_get, Weak_get) => true
     | (Weak_new, Weak_new) => true
     | (Word_add s, Word_add s') => WordSize.equals (s, s')
-    | (Word_addCheck s, Word_addCheck s') => WordSize.equals (s, s')
+    | (Word_addCheck (s, sg), Word_addCheck (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
     | (Word_andb s, Word_andb s') => WordSize.equals (s, s')
-    | (Word_arshift s, Word_arshift s') => WordSize.equals (s, s')
-    | (Word_div s, Word_div s') => WordSize.equals (s, s')
     | (Word_equal s, Word_equal s') => WordSize.equals (s, s')
-    | (Word_ge s, Word_ge s') => WordSize.equals (s, s')
-    | (Word_gt s, Word_gt s') => WordSize.equals (s, s')
-    | (Word_le s, Word_le s') => WordSize.equals (s, s')
+    | (Word_ge (s, sg), Word_ge (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
+    | (Word_gt (s, sg), Word_gt (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
+    | (Word_le (s, sg), Word_le (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
     | (Word_lshift s, Word_lshift s') => WordSize.equals (s, s')
-    | (Word_lt s, Word_lt s') => WordSize.equals (s, s')
-    | (Word_mod s, Word_mod s') => WordSize.equals (s, s')
-    | (Word_mul s, Word_mul s') => WordSize.equals (s, s')
-    | (Word_mulCheck s, Word_mulCheck s') => WordSize.equals (s, s')
+    | (Word_lt (s, sg), Word_lt (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
+    | (Word_mul (s, sg), Word_mul (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
+    | (Word_mulCheck (s, sg), Word_mulCheck (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
     | (Word_neg s, Word_neg s') => WordSize.equals (s, s')
+    | (Word_negCheck s, Word_negCheck s') => WordSize.equals (s, s')
     | (Word_notb s, Word_notb s') => WordSize.equals (s, s')
     | (Word_orb s, Word_orb s') => WordSize.equals (s, s')
+    | (Word_quot (s, sg), Word_quot (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
+    | (Word_rem (s, sg), Word_rem (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
     | (Word_rol s, Word_rol s') => WordSize.equals (s, s')
     | (Word_ror s, Word_ror s') => WordSize.equals (s, s')
-    | (Word_rshift s, Word_rshift s') => WordSize.equals (s, s')
+    | (Word_rshift (s, sg), Word_rshift (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
     | (Word_sub s, Word_sub s') => WordSize.equals (s, s')
-    | (Word_toInt (s1, s2), Word_toInt (s1', s2')) =>
-	 WordSize.equals (s1, s1') andalso IntSize.equals (s2, s2')
+    | (Word_subCheck (s, sg), Word_subCheck (s', sg')) =>
+	 WordSize.equals (s, s') andalso sg = sg'
     | (Word_toIntInf, Word_toIntInf) => true
-    | (Word_toIntX (s1, s2), Word_toIntX (s1', s2')) =>
-	 WordSize.equals (s1, s1') andalso IntSize.equals (s2, s2')
-    | (Word_toWord (s1, s2), Word_toWord (s1', s2')) =>
-	 WordSize.equals (s1, s1') andalso WordSize.equals (s2, s2')
-    | (Word_toWordX (s1, s2), Word_toWordX (s1', s2')) =>
-	 WordSize.equals (s1, s1') andalso WordSize.equals (s2, s2')
+    | (Word_toReal (s1, s2, sg), Word_toReal (s1', s2', sg')) =>
+	 WordSize.equals (s1, s1')
+	 andalso RealSize.equals (s2, s2')
+	 andalso sg = sg'
+    | (Word_toWord (s1, s2, sg), Word_toWord (s1', s2', sg')) =>
+	 WordSize.equals (s1, s1')
+	 andalso WordSize.equals (s2, s2')
+	 andalso sg = sg'
     | (Word_xorb s, Word_xorb s') => WordSize.equals (s, s')
     | (WordVector_toIntInf, WordVector_toIntInf) => true
-    | (Word8_toChar, Word8_toChar) => true
     | (Word8Array_subWord, Word8Array_subWord) => true
     | (Word8Array_updateWord, Word8Array_updateWord) => true
     | (Word8Vector_subWord, Word8Vector_subWord) => true
@@ -570,7 +501,6 @@
     | Array_sub => Array_sub
     | Array_toVector => Array_toVector
     | Array_update => Array_update
-    | Char_toWord8 => Char_toWord8
     | Exn_extra => Exn_extra
     | Exn_keepHistory => Exn_keepHistory
     | Exn_name => Exn_name
@@ -582,26 +512,6 @@
     | GC_collect => GC_collect
     | GC_pack => GC_pack
     | GC_unpack => GC_unpack
-    | Int_add z => Int_add z
-    | Int_addCheck z => Int_addCheck z
-    | Int_arshift z => Int_arshift z
-    | Int_equal z => Int_equal z
-    | Int_ge z => Int_ge z
-    | Int_gt z => Int_gt z
-    | Int_le z => Int_le z
-    | Int_lshift z => Int_lshift z
-    | Int_lt z => Int_lt z
-    | Int_mul z => Int_mul z
-    | Int_mulCheck z => Int_mulCheck z
-    | Int_neg z => Int_neg z
-    | Int_negCheck z => Int_negCheck z
-    | Int_quot z => Int_quot z
-    | Int_rem z => Int_rem z
-    | Int_sub z => Int_sub z
-    | Int_subCheck z => Int_subCheck z
-    | Int_toInt z => Int_toInt z
-    | Int_toReal z => Int_toReal z
-    | Int_toWord z => Int_toWord z
     | IntInf_add => IntInf_add
     | IntInf_andb => IntInf_andb
     | IntInf_arshift => IntInf_arshift
@@ -631,11 +541,9 @@
     | MLton_serialize => MLton_serialize
     | MLton_size => MLton_size
     | MLton_touch => MLton_touch
-    | Pointer_getInt z => Pointer_getInt z
     | Pointer_getPointer => Pointer_getPointer
     | Pointer_getReal z => Pointer_getReal z
     | Pointer_getWord z => Pointer_getWord z
-    | Pointer_setInt z => Pointer_setInt z
     | Pointer_setPointer => Pointer_setPointer
     | Pointer_setReal z => Pointer_setReal z
     | Pointer_setWord z => Pointer_setWord z
@@ -666,8 +574,8 @@
     | Real_qequal z => Real_qequal z
     | Real_round z => Real_round z
     | Real_sub z => Real_sub z
-    | Real_toInt z => Real_toInt z
     | Real_toReal z => Real_toReal z
+    | Real_toWord z => Real_toWord z
     | Ref_assign => Ref_assign
     | Ref_deref => Ref_deref
     | Ref_ref => Ref_ref
@@ -687,32 +595,30 @@
     | Word_add z => Word_add z
     | Word_addCheck z => Word_addCheck z
     | Word_andb z => Word_andb z
-    | Word_arshift z => Word_arshift z
-    | Word_div z => Word_div z
     | Word_equal z => Word_equal z
     | Word_ge z => Word_ge z
     | Word_gt z => Word_gt z
     | Word_le z => Word_le z
     | Word_lshift z => Word_lshift z
     | Word_lt z => Word_lt z
-    | Word_mod z => Word_mod z
     | Word_mul z => Word_mul z
     | Word_mulCheck z => Word_mulCheck z
     | Word_neg z => Word_neg z
+    | Word_negCheck z => Word_negCheck z
     | Word_notb z => Word_notb z
     | Word_orb z => Word_orb z
     | Word_rol z => Word_rol z
+    | Word_quot z => Word_quot z
+    | Word_rem z => Word_rem z
     | Word_ror z => Word_ror z
     | Word_rshift z => Word_rshift z
     | Word_sub z => Word_sub z
-    | Word_toInt z => Word_toInt z
+    | Word_subCheck z => Word_subCheck z
     | Word_toIntInf => Word_toIntInf
-    | Word_toIntX z => Word_toIntX z
+    | Word_toReal z => Word_toReal z
     | Word_toWord z => Word_toWord z
-    | Word_toWordX z => Word_toWordX z
     | Word_xorb z => Word_xorb z
     | WordVector_toIntInf => WordVector_toIntInf
-    | Word8_toChar => Word8_toChar
     | Word8Array_subWord => Word8Array_subWord
     | Word8Array_updateWord => Word8Array_updateWord
     | Word8Vector_subWord => Word8Vector_subWord
@@ -732,18 +638,9 @@
 val ffi = FFI
 val ffiSymbol = FFI_Symbol
 val gcCollect = GC_collect
-val intAdd = Int_add
-val intAddCheck = Int_addCheck
-val intEqual = Int_equal
 val intInfEqual = IntInf_equal
 val intInfNeg = IntInf_neg
 val intInfNotb = IntInf_notb
-val intMul = Int_mul
-val intMulCheck = Int_mulCheck
-val intNeg = Int_neg
-val intNegCheck = Int_negCheck
-val intSub = Int_sub
-val intSubCheck = Int_subCheck
 val reff = Ref_ref
 val serialize = MLton_serialize
 val vectorLength = Vector_length
@@ -751,7 +648,6 @@
 val wordAdd = Word_add
 val wordAddCheck = Word_addCheck
 val wordAndb = Word_andb
-val wordArshift = Word_arshift
 val wordEqual = Word_equal
 val wordGe = Word_ge
 val wordGt = Word_gt
@@ -761,20 +657,16 @@
 val wordMul = Word_mul
 val wordMulCheck = Word_mulCheck
 val wordNeg = Word_neg
+val wordNegCheck = Word_negCheck
 val wordNotb = Word_notb
 val wordOrb = Word_orb
 val wordRshift = Word_rshift
 val wordSub = Word_sub
+val wordSubCheck = Word_subCheck
 val wordToWord = Word_toWord
-val wordToWordX = Word_toWordX
 
 val isCommutative =
-   fn Int_add _ => true
-    | Int_addCheck _ => true
-    | Int_equal _ => true
-    | Int_mul _ => true
-    | Int_mulCheck _ => true
-    | IntInf_equal => true
+   fn IntInf_equal => true
     | MLton_eq => true
     | MLton_equal => true
     | Real_add _ => true
@@ -791,12 +683,10 @@
     | _ => false
 
 val mayOverflow =
-   fn Int_addCheck _ => true
-    | Int_mulCheck _ => true
-    | Int_negCheck _ => true
-    | Int_subCheck _ => true
-    | Word_addCheck _ => true
+   fn Word_addCheck _ => true
     | Word_mulCheck _ => true
+    | Word_negCheck _ => true
+    | Word_subCheck _ => true
     | _ => false
 
 val mayRaise = mayOverflow
@@ -813,7 +703,6 @@
        | Array_sub => DependsOnState
        | Array_toVector => DependsOnState
        | Array_update => SideEffect
-       | Char_toWord8 => Functional
        | Exn_extra => Functional
        | Exn_keepHistory => Functional
        | Exn_name => Functional
@@ -843,26 +732,6 @@
        | IntInf_toVector => Functional
        | IntInf_toWord => Functional
        | IntInf_xorb => Functional
-       | Int_add _ => Functional
-       | Int_addCheck _ => SideEffect
-       | Int_arshift _ => Functional
-       | Int_equal _ => Functional
-       | Int_ge _ => Functional
-       | Int_gt _ => Functional
-       | Int_le _ => Functional
-       | Int_lshift _ => Functional
-       | Int_lt _ => Functional
-       | Int_mul _ => Functional
-       | Int_mulCheck _ => SideEffect
-       | Int_neg _ => Functional
-       | Int_negCheck _ => SideEffect
-       | Int_quot _ => Functional
-       | Int_rem _ => Functional
-       | Int_sub _ => Functional
-       | Int_subCheck _ => SideEffect
-       | Int_toInt _ => Functional
-       | Int_toReal _ => Functional
-       | Int_toWord _ => Functional
        | MLton_bogus => Functional
        | MLton_bug => SideEffect
        | MLton_deserialize => Moveable
@@ -874,11 +743,9 @@
        | MLton_serialize => DependsOnState
        | MLton_size => DependsOnState
        | MLton_touch => SideEffect
-       | Pointer_getInt _ => DependsOnState
        | Pointer_getPointer => DependsOnState
        | Pointer_getReal _ => DependsOnState
        | Pointer_getWord _ => DependsOnState
-       | Pointer_setInt _ => SideEffect
        | Pointer_setPointer => SideEffect
        | Pointer_setReal _ => SideEffect
        | Pointer_setWord _ => SideEffect
@@ -909,8 +776,8 @@
        | Real_qequal _ => Functional
        | Real_round _ => DependsOnState  (* depends on rounding mode *)
        | Real_sub _ => Functional
-       | Real_toInt _ => Functional
        | Real_toReal _ => Functional
+       | Real_toWord _ => Functional
        | Ref_assign => SideEffect
        | Ref_deref => DependsOnState
        | Ref_ref => Moveable
@@ -931,34 +798,32 @@
        | Word8Array_updateWord => SideEffect
        | Word8Vector_subWord => Functional
        | Word8Vector_toString => Functional
-       | Word8_toChar => Functional
        | WordVector_toIntInf => Functional
        | Word_add _ => Functional
        | Word_addCheck _ => SideEffect
        | Word_andb _ => Functional
-       | Word_arshift _ => Functional
-       | Word_div _ => Functional
        | Word_equal _ => Functional
        | Word_ge _ => Functional
        | Word_gt _ => Functional
        | Word_le _ => Functional
        | Word_lshift _ => Functional
        | Word_lt _ => Functional
-       | Word_mod _ => Functional
        | Word_mul _ => Functional
        | Word_mulCheck _ => SideEffect
        | Word_neg _ => Functional
+       | Word_negCheck _ => SideEffect
        | Word_notb _ => Functional
        | Word_orb _ => Functional
+       | Word_quot _ => Functional
+       | Word_rem _ => Functional
        | Word_rol _ => Functional
        | Word_ror _ => Functional
        | Word_rshift _ => Functional
        | Word_sub _ => Functional
-       | Word_toInt _ => Functional
+       | Word_subCheck _ => SideEffect
        | Word_toIntInf => Functional
-       | Word_toIntX _ => Functional
+       | Word_toReal _ => Functional
        | Word_toWord _ => Functional
-       | Word_toWordX _ => Functional
        | Word_xorb _ => Functional
        | World_save => SideEffect
    end
@@ -968,25 +833,6 @@
 fun maySideEffect p = Kind.SideEffect = kind p
 
 local
-   fun ints (s: IntSize.t) =
-      [(Int_add s),
-       (Int_addCheck s),
-       (Int_arshift s),
-       (Int_equal s),
-       (Int_ge s),
-       (Int_gt s),
-       (Int_le s),
-       (Int_lshift s),
-       (Int_lt s),
-       (Int_mul s),
-       (Int_mulCheck s),
-       (Int_neg s),
-       (Int_negCheck s),
-       (Int_quot s),
-       (Int_rem s),
-       (Int_sub s),
-       (Int_subCheck s)]
- 
    fun reals (s: RealSize.t) =
       [(Real_Math_acos s),
        (Real_Math_asin s),
@@ -1016,29 +862,39 @@
        (Real_round s),
        (Real_sub s)]
 
+   fun wordSigns (s: WordSize.t, signed: bool) =
+      let
+	 val sg = {signed = signed}
+      in
+	 List.map ([Word_addCheck,
+		    Word_ge,
+		    Word_gt,
+		    Word_le,
+		    Word_lt,
+		    Word_mul,
+		    Word_mulCheck,
+		    Word_quot,
+		    Word_rem,
+		    Word_rshift,
+		    Word_subCheck],
+		   fn p => p (s, sg))
+      end
+
    fun words (s: WordSize.t) =
       [(Word_add s),
-       (Word_addCheck s),
        (Word_andb s),
-       (Word_arshift s),
-       (Word_div s),
        (Word_equal s),
-       (Word_ge s),
-       (Word_gt s),
-       (Word_le s),
        (Word_lshift s),
-       (Word_lt s),
-       (Word_mod s),
-       (Word_mul s),
-       (Word_mulCheck s),
        (Word_neg s),
+       (Word_negCheck s),
        (Word_notb s),
        (Word_orb s),
        (Word_rol s),
        (Word_ror s),
-       (Word_rshift s),
        (Word_sub s),
        (Word_xorb s)]
+      @ wordSigns (s, true)
+      @ wordSigns (s, false)
 in
    val all: unit t list =
       [Array_array,
@@ -1047,7 +903,6 @@
        Array_sub,
        Array_toVector,
        Array_update,
-       Char_toWord8,
        Exn_extra,
        Exn_name,
        Exn_setExtendExtra,
@@ -1106,40 +961,38 @@
        Weak_new,
        Word_toIntInf,
        WordVector_toIntInf,
-       Word8_toChar,
        Word8Array_subWord,
        Word8Array_updateWord,
        Word8Vector_subWord,
        Word8Vector_toString,
        World_save]
-      @ List.concat [List.concatMap (IntSize.prims, ints),
-		     List.concatMap (RealSize.all, reals),
+      @ List.concat [List.concatMap (RealSize.all, reals),
 		     List.concatMap (WordSize.prims, words)]
       @ let
-	   val int = IntSize.all
 	   val real = RealSize.all
 	   val word = WordSize.all
-	   fun coerces (name, sizes, sizes') =
+	   fun coerces (name, sizes, sizes', ac) =
 	      List.fold
-	      (sizes, [], fn (s, ac) =>
-	       List.fold (sizes', ac, fn (s', ac) => name (s, s') :: ac))
+	      ([false, true], ac, fn (signed, ac) =>
+	       List.fold
+	       (sizes, ac, fn (s, ac) =>
+		List.fold (sizes', ac, fn (s', ac) =>
+			   name (s, s', {signed = signed}) :: ac)))
 	in
-	   List.concat [coerces (Int_toInt, int, int),
-			coerces (Int_toReal, int, real),
-			coerces (Int_toWord, int, word),
-			coerces (Real_toInt, real, int),
-			coerces (Real_toReal, real, real),
-			coerces (Word_toInt, word, int),
-			coerces (Word_toIntX, word, int),
-			coerces (Word_toWord, word, word),
-			coerces (Word_toWordX, word, word)]
+	   coerces (Real_toWord, real, word,
+		    coerces (Word_toReal, word, real,
+			     coerces (Word_toWord, word, word,
+				      List.fold
+				      (real, [], fn (s, ac) =>
+				       List.fold
+				       (real, ac, fn (s', ac) =>
+					Real_toReal (s, s') :: ac)))))
 	end
      @ let
 	  fun doit (all, get, set) =
 	     List.concatMap (all, fn s => [get s, set s])
        in
-	  List.concat [doit (IntSize.prims, Pointer_getInt, Pointer_setInt),
-		       doit (RealSize.all, Pointer_getReal, Pointer_setReal),
+	  List.concat [doit (RealSize.all, Pointer_getReal, Pointer_setReal),
 		       doit (WordSize.prims, Pointer_getWord, Pointer_setWord)]
        end
 end
@@ -1303,7 +1156,6 @@
       datatype z = datatype t
       datatype z = datatype Const.t
       val bool = ApplyResult.Bool
-      val int = ApplyResult.Const o Const.int
       val intInf = ApplyResult.Const o Const.intInf
       val intInfConst = intInf o IntInf.fromInt
       fun word (w: WordX.t): ('a, 'b) ApplyResult.t =
@@ -1312,59 +1164,48 @@
       val t = ApplyResult.truee
       val f = ApplyResult.falsee
       fun iio (f, c1, c2) = intInf (f (c1, c2))
-      fun io (f: IntX.t * IntX.t -> IntX.t, i, i') =
-	 int (f (i, i'))
+      fun wordS (f: WordX.t * WordX.t * {signed: bool} -> WordX.t,
+		 (_: WordSize.t, sg),
+		 w: WordX.t,
+		 w': WordX.t) =
+	 word (f (w, w', sg))
+      fun wordCmp (f: WordX.t * WordX.t * {signed: bool} -> bool,
+		   (_: WordSize.t, sg),
+		   w: WordX.t,
+		   w': WordX.t) =
+	 bool (f (w, w', sg))
+      fun wordOrOverflow (s, sg, w) =
+	 if WordSize.isInRange (s, w, sg)
+	    then word (WordX.fromIntInf (w, s))
+	 else ApplyResult.Overflow
       fun wcheck (f: IntInf.t * IntInf.t -> IntInf.t,
+		  (s: WordSize.t, sg as {signed}),
 		  w: WordX.t,
-		  w': WordX.t,
-		  s: WordSize.t) =
+		  w': WordX.t) =
 	 let
-	    val x = f (WordX.toIntInf w, WordX.toIntInf w')
+	    val conv = if signed then WordX.toIntInfX else WordX.toIntInf
 	 in
-	    if x <= WordX.toIntInf (WordX.max s)
-	       then word (WordX.fromIntInf (x, s))
-	    else ApplyResult.Overflow
+	    wordOrOverflow (s, sg, f (conv w, conv w'))
 	 end
       val eq =
- 	 fn (Int i1, Int i2) => bool (IntX.equals (i1, i2))
- 	  | (Word w1, Word w2) => bool (WordX.equals (w1, w2))
+ 	 fn (Word w1, Word w2) => bool (WordX.equals (w1, w2))
  	  | _ => ApplyResult.Unknown
       val equal =
-	 fn (Int i1, Int i2) => bool (IntX.equals (i1, i2))
-	  | (Word w1, Word w2) => bool (WordX.equals (w1, w2))
+	 fn (Word w1, Word w2) => bool (WordX.equals (w1, w2))
 	  | (Word8Vector v1, Word8Vector v2) => bool (v1 = v2)
 	  | _ => ApplyResult.Unknown
       fun allConsts (cs: Const.t list) =
 	 (case (p, cs) of
-	     (Int_add _, [Int i1, Int i2]) => io (IntX.+, i1, i2)
-	   | (Int_addCheck _, [Int i1, Int i2]) => io (IntX.+, i1, i2)
-	   | (Int_arshift _, [Int i, Word w]) =>
-		int (IntX.~>> (i, WordX.toIntInf w))
-           | (Int_equal _, [Int i1, Int i2]) => bool (IntX.equals (i1, i2))
-	   | (Int_ge _, [Int i1, Int i2]) => bool (IntX.>= (i1, i2))
-	   | (Int_gt _, [Int i1, Int i2]) => bool (IntX.> (i1, i2))
-	   | (Int_le _, [Int i1, Int i2]) => bool (IntX.<= (i1, i2))
-	   | (Int_lshift _, [Int i, Word w]) =>
-		int (IntX.<< (i, WordX.toIntInf w))
-	   | (Int_lt _, [Int i1, Int i2]) => bool (IntX.< (i1, i2))
-	   | (Int_mul _, [Int i1, Int i2]) => io (IntX.*, i1, i2)
-	   | (Int_mulCheck _, [Int i1, Int i2]) => io (IntX.*, i1, i2)
-	   | (Int_neg _, [Int i]) => int (IntX.~ i)
-	   | (Int_negCheck _, [Int i]) => int (IntX.~ i)
-	   | (Int_quot _, [Int i1, Int i2]) => io (IntX.quot, i1, i2)
-	   | (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.fromIntInf (IntX.toIntInf i, s))
-	   | (IntInf_compare, [IntInf i1, IntInf i2]) =>
-		int (IntX.make (IntInf.fromInt (case IntInf.compare (i1, i2) of
-						   Relation.LESS => ~1
-						 | Relation.EQUAL => 0
-						 | Relation.GREATER => 1),
-				IntSize.default))
+	     (IntInf_compare, [IntInf i1, IntInf i2]) =>
+		let
+		   val i =
+		      case IntInf.compare (i1, i2) of
+			 Relation.LESS => ~1
+		       | Relation.EQUAL => 0
+		       | Relation.GREATER => 1
+		in
+		   word (WordX.fromIntInf (i, WordSize.default))
+		end
 	   | (IntInf_equal, [IntInf i1, IntInf i2]) => bool (i1 = i2)
 	   | (IntInf_toWord, [IntInf i]) =>
 		(case SmallIntInf.toWord i of
@@ -1373,37 +1214,42 @@
 						      WordSize.default)))
 	   | (MLton_eq, [c1, c2]) => eq (c1, c2)
 	   | (MLton_equal, [c1, c2]) => equal (c1, c2)
-	   | (Word_add _, [Word w1, Word w2]) => word (WordX.+ (w1, w2))
-	   | (Word_addCheck s, [Word w1, Word w2]) =>
-		wcheck (IntInf.+, w1, w2, s)
+	   | (Word_add _, [Word w1, Word w2]) => word (WordX.add (w1, w2))
+	   | (Word_addCheck s, [Word w1, Word w2]) => wcheck (op +, s, w1, w2)
 	   | (Word_andb _, [Word w1, Word w2]) => word (WordX.andb (w1, w2))
-	   | (Word_arshift _, [Word w1, Word w2]) => word (WordX.~>> (w1, w2))
-	   | (Word_div _, [Word w1, Word w2]) => word (WordX.div (w1, w2))
            | (Word_equal _, [Word w1, Word w2]) => bool (WordX.equals (w1, w2))
-	   | (Word_ge _, [Word w1, Word w2]) => bool (WordX.>= (w1, w2))
-	   | (Word_gt _, [Word w1, Word w2]) => bool (WordX.> (w1, w2))
-	   | (Word_le _, [Word w1, Word w2]) => bool (WordX.<= (w1, w2))
+	   | (Word_ge s, [Word w1, Word w2]) => wordCmp (WordX.ge, s, w1, w2)
+	   | (Word_gt s, [Word w1, Word w2]) => wordCmp (WordX.gt, s, w1, w2)
+	   | (Word_le s, [Word w1, Word w2]) => wordCmp (WordX.le, s, w1, w2)
 	   | (Word_lshift _, [Word w1, Word w2]) => word (WordX.<< (w1, w2))
-	   | (Word_lt _, [Word w1, Word w2]) => bool (WordX.< (w1, w2))
-	   | (Word_mod _, [Word w1, Word w2]) => word (WordX.mod (w1, w2))
-	   | (Word_mul _, [Word w1, Word w2]) => word (WordX.* (w1, w2))
-	   | (Word_mulCheck s, [Word w1, Word w2]) =>
-		wcheck (IntInf.*, w1, w2, s)
+	   | (Word_lt s, [Word w1, Word w2]) => wordCmp (WordX.lt, s, w1, w2)
+	   | (Word_mul s, [Word w1, Word w2]) => wordS (WordX.mul, s, w1, w2)
+	   | (Word_mulCheck s, [Word w1, Word w2]) => wcheck (op *, s, w1, w2)
+	   | (Word_neg s, [Word w]) => word (WordX.neg w)
+	   | (Word_negCheck s, [Word w]) =>
+		wordOrOverflow (s, {signed = true}, ~ (WordX.toIntInfX w))
 	   | (Word_notb _, [Word w]) => word (WordX.notb w)
 	   | (Word_orb _, [Word w1, Word w2]) => word (WordX.orb (w1, w2))
+	   | (Word_quot s, [Word w1, Word w2]) =>
+		if WordX.isZero w2
+		   then ApplyResult.Unknown
+		else wordS (WordX.quot, s, w1, w2)
+	   | (Word_rem s, [Word w1, Word w2]) =>
+		if WordX.isZero w2
+		   then ApplyResult.Unknown
+		else wordS (WordX.rem, s, w1, w2)
 	   | (Word_rol _, [Word w1, Word w2]) => word (WordX.rol (w1, w2))
 	   | (Word_ror _, [Word w1, Word w2]) => word (WordX.ror (w1, w2))
-	   | (Word_rshift _, [Word w1, Word w2]) => word (WordX.>> (w1, w2))
-	   | (Word_sub _, [Word w1, Word w2]) => word (WordX.- (w1, w2))
-	   | (Word_toInt (_, s), [Word w]) =>
-		int (IntX.make (WordX.toIntInf w, s))
+	   | (Word_rshift s, [Word w1, Word w2]) =>
+		wordS (WordX.rshift, s, w1, w2)
+	   | (Word_sub _, [Word w1, Word w2]) => word (WordX.sub (w1, w2))
+	   | (Word_subCheck s, [Word w1, Word w2]) => wcheck (op -, s, w1, w2)
 	   | (Word_toIntInf, [Word w]) =>
 		intInf (SmallIntInf.fromWord
 			(Word.fromIntInf (WordX.toIntInf w)))
-	   | (Word_toIntX (_, s), [Word w]) =>
-		int (IntX.make (WordX.toIntInfX w, s))
-	   | (Word_toWord (_, s), [Word w]) => word (WordX.resize (w, s))
-	   | (Word_toWordX (_, s), [Word w]) => word (WordX.resizeX (w, s))
+	   | (Word_toWord (_, s, {signed}), [Word w]) =>
+		word (if signed then WordX.resizeX (w, s)
+		      else WordX.resize (w, s))
 	   | (Word_xorb _, [Word w1, Word w2]) => word (WordX.xorb (w1, w2))
 	   | _ => ApplyResult.Unknown)
 	     handle Chr => ApplyResult.Unknown
@@ -1413,14 +1259,6 @@
       fun someVars () =
 	 let
 	    datatype z = datatype ApplyResult.t
-	    fun add (x: 'b, i: IntX.t): ('a, 'b) ApplyResult.t =
-	       if IntX.isZero i then Var x else Unknown
-	    fun mul (x: 'b, i: IntX.t, s: IntSize.t, neg) =
-	       (case IntX.toInt i of
-		   0 => int (IntX.zero s)
-		 | 1 => Var x
-		 | ~1 => Apply (neg s, [x])
-		 | _ => Unknown) handle Exn.Overflow => Unknown
 	    fun varIntInf (x, i: IntInf.t, space, inOrder) =
 	       let
 		  fun neg () = Apply (intInfNeg, [x, space])
@@ -1473,12 +1311,20 @@
 	       let
 		  val zero = word o WordX.zero
 		  fun add () = if WordX.isZero w then Var x else Unknown
-		  fun mul () =
+		  fun mul ((s, {signed}), neg) =
 		     if WordX.isZero w
 			then word w
 		     else if WordX.isOne w
 			     then Var x
-			  else Unknown
+			  else if signed andalso WordX.isNegOne w
+				  then Apply (neg s, [x])
+			       else Unknown
+		  fun sub (s, neg) =
+		     if WordX.isZero w
+			then if inOrder
+				then Var x
+			     else Apply (neg s, [x])
+		     else Unknown
 		  fun ro () =
 		     if inOrder
 			then
@@ -1486,12 +1332,13 @@
 			      val s = WordX.size w
 			   in
 			      if WordX.isZero
-				 (WordX.mod
+				 (WordX.rem
 				  (w,
 				   WordX.fromIntInf
 				   (IntInf.fromInt
 				    (Bits.toInt (WordSize.bits s)),
-				    s)))
+				    s),
+				   {signed = false}))
 				 then Var x
 			      else Unknown
 			   end
@@ -1503,11 +1350,12 @@
 		     if inOrder
 			then if WordX.isZero w
 				then Var x
-			     else if (WordX.>=
+			     else if (WordX.ge
 				      (w,
 				       WordX.fromIntInf (Bits.toIntInf
 							 (WordSize.bits s),
-							 WordSize.default)))
+							 WordSize.default),
+				       {signed = false}))
 				     then zero s
 				  else Unknown
 		     else if WordX.isZero w
@@ -1523,53 +1371,60 @@
 			else if WordX.isAllOnes w
 				then Var x
 			     else Unknown
-		   | Word_arshift s =>
-			if WordX.isZero w
-			   then if inOrder then Var x else zero s
-			else if WordX.isAllOnes w
-				then if inOrder then Unknown else word w
-			     else Unknown
-		   | Word_div _ =>
-			if inOrder andalso WordX.isOne w then Var x else Unknown
-		   | Word_ge _ =>
+		   | Word_ge (_, sg) =>
 			if inOrder
-			   then if WordX.isZero w then t else Unknown
-			else if WordX.isMax w then t else Unknown
-		   | Word_gt _ =>
+			   then if WordX.isMin (w, sg) then t else Unknown
+			else if WordX.isMax (w, sg) then t else Unknown
+		   | Word_gt (_, sg) =>
 			if inOrder
-			   then if WordX.isMax w then f else Unknown
-			else if WordX.isZero w then f else Unknown
-		   | Word_le _ =>
+			   then if WordX.isMax (w, sg) then f else Unknown
+			else if WordX.isMin (w, sg) then f else Unknown
+		   | Word_le (_, sg) =>
 			if inOrder
-			   then if WordX.isMax w then t else Unknown
-			else if WordX.isZero w then t else Unknown
+			   then if WordX.isMax (w, sg) then t else Unknown
+			else if WordX.isMin (w, sg) then t else Unknown
 		   | Word_lshift s => shift s
-		   | Word_lt _ =>
+		   | Word_lt (_, sg) =>
 			if inOrder
-			   then if WordX.isZero w then f else Unknown
-			else if WordX.isMax w then f else Unknown
-		   | Word_mod s =>
-			if inOrder andalso WordX.isOne w
-			   then zero s
-			else Unknown
-		   | Word_mul _ => mul ()
-		   | Word_mulCheck _ => mul ()
+			   then if WordX.isMin (w, sg) then f else Unknown
+			else if WordX.isMax (w, sg) then f else Unknown
+		   | Word_mul s => mul (s, wordNeg)
+		   | Word_mulCheck s => mul (s, wordNegCheck)
 		   | Word_orb _ =>
 			if WordX.isZero w
 			   then Var x
 			else if WordX.isAllOnes w
 				then word w
 			     else Unknown
-		   | Word_rol _ => ro ()
-		   | Word_ror _ => ro ()
-		   | Word_rshift s => shift s
-		   | Word_sub s =>
-			if WordX.isZero w
+		   | Word_quot (s, {signed}) =>
+			if inOrder
 			   then
-			      if inOrder
+			      if WordX.isOne w
 				 then Var x
-			      else Apply (wordNeg s, [x])
+			      else if signed andalso WordX.isNegOne w
+				      then Apply (wordNeg s, [x])
+				   else Unknown
 			else Unknown
+		   | Word_rem (s, {signed}) =>
+			if inOrder
+			   andalso (WordX.isOne w
+				    orelse signed andalso WordX.isNegOne w)
+			   then zero s
+			else Unknown
+		   | Word_rol _ => ro ()
+		   | Word_ror _ => ro ()
+		   | Word_rshift (s, {signed}) =>
+			if signed
+			   then
+			      if WordX.isZero w
+				 then if inOrder then Var x else zero s
+			      else if WordX.isAllOnes w andalso not inOrder
+				      then word w
+				   else Unknown
+			else
+			   shift s
+		   | Word_sub s => sub (s, wordNeg)
+		   | Word_subCheck s => sub (s, wordNegCheck o #1)
 		   | Word_xorb s =>
 			if WordX.isZero w
 			   then Var x
@@ -1581,10 +1436,10 @@
 	    datatype z = datatype ApplyArg.t
 	 in
 	    case (p, args) of
-	       (IntInf_toString, [Const (IntInf i), Const (Int base), _]) =>
+	       (IntInf_toString, [Const (IntInf i), Const (Word base), _]) =>
 		  let
 		     val base =
-			case IntX.toInt base of
+			case WordX.toInt base of
 			   2 => StringCvt.BIN
 			 | 8 => StringCvt.OCT 
 			 | 10 => StringCvt.DEC
@@ -1606,54 +1461,6 @@
 		  else Unknown
 	     | (_, [Var x, Const (Word i)]) => varWord (x, i, true)
 	     | (_, [Const (Word i), Var x]) => varWord (x, i, false)
-	     | (_, [Var x, Const (Int i)]) =>
-		  (case p of
-		      Int_add _ => add (x, i)
-		    | Int_addCheck _ => add (x, i)
-		    | Int_ge _ => if IntX.isMin i then t else Unknown
-		    | Int_gt _ => if IntX.isMax i then f else Unknown
-		    | Int_le _ => if IntX.isMax i then t else Unknown
-		    | Int_lt _ => if IntX.isMin i then f else Unknown
-		    | Int_mul s => mul (x, i, s, intNeg)
-		    | Int_mulCheck s => mul (x, i, s, intNegCheck)
-		    | Int_quot s =>
-			 if IntX.isNegOne i
-			    then Apply (intNeg s, [x])
-			 else if IntX.isOne i
-				 then ApplyResult.Var x
-			      else Unknown
-		    | Int_rem s =>
-			 if IntX.isNegOne i orelse IntX.isOne i
-			    then int (IntX.zero s)
-			 else Unknown
-		    | Int_sub _ =>
-			 if IntX.isZero i
-			    then ApplyResult.Var x
-			 else Unknown
-		    | Int_subCheck _ =>
-			 if IntX.isZero i
-			    then ApplyResult.Var x
-			 else Unknown
-		    | _ => Unknown)
-	     | (_, [Const (Int i), Var x]) =>
-		  (case p of 
-		      Int_add _ => add (x, i)
-		    | Int_addCheck _ => add (x, i)
-		    | Int_ge _ => if IntX.isMax i then t else Unknown
-		    | Int_gt _ => if IntX.isMin i then f else Unknown
-		    | Int_le _ => if IntX.isMin i then t else Unknown
-		    | Int_lt _ => if IntX.isMax i then f else Unknown
-		    | Int_mul s => mul (x, i, s, intNeg)
-		    | Int_mulCheck s => mul (x, i, s, intNegCheck)
-		    | Int_sub s =>
-			 if IntX.isZero i
-			    then Apply (intNeg s, [x])
-			 else Unknown
-		    | Int_subCheck s =>
-			 if IntX.isZero i
-			    then Apply (intNegCheck s, [x])
-			 else Unknown
-		    | _ => Unknown)
 	     | (_, [Const (IntInf i1), Const (IntInf i2), _]) =>
 		  (case p of
 		      IntInf_add => iio (IntInf.+, i1, i2)
@@ -1718,16 +1525,8 @@
 			     datatype z = datatype ApplyResult.t
 			  in
 			     case p of
-                                Int_equal _ => t
-			      | Int_ge _ => t
-			      | Int_gt _ => f
-			      | Int_le _ => t
-			      | Int_lt _ => f
-			      | Int_quot s => int (IntX.one s)
-			      | Int_rem s => int (IntX.zero s)
-			      | Int_sub s => int (IntX.zero s)
-			      | IntInf_compare =>
-				   int (IntX.zero IntSize.default)
+				IntInf_compare =>
+				   word (WordX.zero WordSize.default)
 			      | IntInf_equal => t
 			      | MLton_eq => t
 			      | MLton_equal => t
@@ -1738,14 +1537,14 @@
 			      | Real_ge _ => t
 			      | Real_qequal _ => t
 			      | Word_andb _ => Var x
-			      | Word_div s => word (WordX.one s)
                               | Word_equal _ => t
 			      | Word_ge _ => t
 			      | Word_gt _ => f
 			      | Word_le _ => t
 			      | Word_lt _ => f
-			      | Word_mod s => word (WordX.zero s)
 			      | Word_orb _ => Var x
+			      | Word_quot (s, _) => word (WordX.one s)
+			      | Word_rem (s, _) => word (WordX.zero s)
 			      | Word_sub s => word (WordX.zero s)
 			      | Word_xorb s => word (WordX.zero s)
 			      | _ => Unknown
@@ -1772,20 +1571,7 @@
       fun two name = seq [arg 0, str " ", str name, str " ", arg 1]
    in
       case p of
-	 Int_mul _ => two "*?"
-       | Int_mulCheck _ => two "*"
-       | Int_add _ => two "+?"
-       | Int_addCheck _ => two "+"
-       | Int_sub _ => two "-?"
-       | Int_subCheck _ => two "-"
-       | Int_equal _ => two "="
-       | Int_lt _ => two "<"
-       | Int_le _ => two "<="
-       | Int_gt _ => two ">"
-       | Int_ge _ => two ">="
-       | Int_neg _ => one "-?"
-       | Int_negCheck _ => one "-"
-       | IntInf_equal => two "="
+	 IntInf_equal => two "="
        | MLton_eq => two "="
        | Real_Math_acos _ => one "acos"
        | Real_Math_asin _ => one "asin"
@@ -1813,23 +1599,24 @@
        | Ref_ref => one "ref"
        | Vector_length => one "length"
        | Word_add _ => two "+"
-       | Word_addCheck _ => two "+c"
+       | Word_addCheck _ => two "+"
        | Word_andb _ => two "&"
-       | Word_arshift _ => two "~>>"
        | Word_equal _ => two "="
        | Word_ge _ => two ">="
        | Word_gt _ => two ">"
        | Word_le _ => two "<="
        | Word_lshift _ => two "<<"
        | Word_lt _ => two "<"
-       | Word_mul _ => two "*"
-       | Word_mulCheck _ => two "*c"
+       | Word_mul (_, {signed}) => two "*"
+       | Word_mulCheck _ => two "*"
        | Word_neg _ => one "-"
+       | Word_negCheck _ => one "-"
        | Word_orb _ => two "|"
        | Word_rol _ => two "rol"
        | Word_ror _ => two "ror"
-       | Word_rshift _ => two ">>"
+       | Word_rshift (_, {signed}) => two (if signed then "~>>" else ">>")
        | Word_sub _ => two "-"
+       | Word_subCheck (_, {signed}) => two "-"
        | Word_xorb _ => two "^"
        | _ => seq [layout p, str " ", Vector.layout layoutArg args]
    end



1.62      +25 -60    mlton/mlton/atoms/prim.sig

Index: prim.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.sig,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- prim.sig	25 Apr 2004 22:02:49 -0000	1.61
+++ prim.sig	1 May 2004 00:49:34 -0000	1.62
@@ -11,10 +11,8 @@
       structure CType: C_TYPE
       structure Con: CON
       structure Const: CONST
-      structure IntSize: INT_SIZE
       structure RealSize: REAL_SIZE
       structure WordSize: WORD_SIZE
-      sharing IntSize = Const.IntX.IntSize
       sharing RealSize = Const.RealX.RealSize
       sharing WordSize = Const.WordX.WordSize
    end
@@ -32,7 +30,6 @@
 	     | Array_sub (* backend *)
 	     | Array_toVector (* backend *)
 	     | Array_update (* backend *)
-	     | Char_toWord8 (* type inference *)
 	     | Exn_extra (* implement exceptions *)
 	     | Exn_keepHistory (* a compile-time boolean *)
 	     | Exn_name (* implement exceptions *)
@@ -45,26 +42,6 @@
 	     | GC_collect (* ssa to rssa *)
 	     | GC_pack (* ssa to rssa *)
 	     | GC_unpack (* ssa to rssa *)
-	     | Int_add of IntSize.t (* codegen *)
-	     | Int_addCheck of IntSize.t (* codegen *)
-	     | Int_arshift of IntSize.t (* codegen *)
-	     | Int_equal of IntSize.t (* ssa to rssa / codegen *)
-	     | Int_ge of IntSize.t (* codegen *)
-	     | Int_gt of IntSize.t (* codegen *)
-	     | Int_le of IntSize.t (* codegen *)
-	     | Int_lt of IntSize.t (* codegen *)
-	     | Int_lshift of IntSize.t (* codegen *)
-	     | Int_mul of IntSize.t (* codegen *)
-	     | Int_mulCheck of IntSize.t (* codegen *)
-	     | Int_neg of IntSize.t (* codegen *)
-	     | Int_negCheck of IntSize.t (* codegen *)
-	     | Int_quot of IntSize.t (* codegen *)
-	     | Int_rem of IntSize.t (* codegen *)
-	     | Int_sub of IntSize.t (* codegen *)
-	     | Int_subCheck of IntSize.t (* codegen *)
-	     | Int_toInt of IntSize.t * IntSize.t (* codegen *)
-	     | Int_toReal of IntSize.t * RealSize.t (* codegen *)
-	     | Int_toWord of IntSize.t * WordSize.t (* codegen *)
 	     | IntInf_add (* ssa to rssa *)
 	     | IntInf_andb (* ssa to rssa *)
 	     | IntInf_arshift (* ssa to rssa *)
@@ -109,11 +86,9 @@
 	     | MLton_serialize (* unused *)
 	     | MLton_size (* ssa to rssa *)
 	     | MLton_touch (* backend *)
-	     | Pointer_getInt of IntSize.t (* ssa to rssa *)
 	     | Pointer_getPointer (* ssa to rssa *)
 	     | Pointer_getReal of RealSize.t (* ssa to rssa *)
 	     | Pointer_getWord of WordSize.t (* ssa to rssa *)
-	     | Pointer_setInt of IntSize.t (* ssa to rssa *)
 	     | Pointer_setPointer (* ssa to rssa *)
 	     | Pointer_setReal of RealSize.t (* ssa to rssa *)
 	     | Pointer_setWord of WordSize.t (* ssa to rssa *)
@@ -144,7 +119,7 @@
 	     | Real_qequal of RealSize.t (* codegen *)
 	     | Real_round of RealSize.t (* codegen *)
 	     | Real_sub of RealSize.t (* codegen *)
-	     | Real_toInt of RealSize.t * IntSize.t (* codegen *)
+	     | Real_toWord of RealSize.t * WordSize.t * {signed: bool} (* codegen *)
 	     | Real_toReal of RealSize.t * RealSize.t (* codegen *)
 	     | Ref_assign (* backend *)
 	     | Ref_deref (* backend *)
@@ -167,34 +142,32 @@
 	     | Weak_get (* ssa to rssa *)
 	     | Weak_new (* ssa to rssa *)
 	     | Word_add of WordSize.t (* codegen *)
-	     | Word_addCheck of WordSize.t (* codegen *)
+	     | Word_addCheck of WordSize.t * {signed: bool} (* codegen *)
 	     | Word_andb of WordSize.t (* codegen *)
-	     | Word_arshift of WordSize.t (* codegen *)
-	     | Word_div of WordSize.t (* codegen *)
 	     | Word_equal of WordSize.t (* codegen *)
-	     | Word_ge of WordSize.t (* codegen *)
-	     | Word_gt of WordSize.t (* codegen *)
-	     | Word_le of WordSize.t (* codegen *)
+	     | Word_ge of WordSize.t * {signed: bool} (* codegen *)
+	     | Word_gt of WordSize.t * {signed: bool} (* codegen *)
+	     | Word_le of WordSize.t * {signed: bool} (* codegen *)
 	     | Word_lshift of WordSize.t (* codegen *)
-	     | Word_lt of WordSize.t (* codegen *)
-	     | Word_mod of WordSize.t (* codegen *)
-	     | Word_mul of WordSize.t (* codegen *)
-	     | Word_mulCheck of WordSize.t (* codegen *)
+	     | Word_lt of WordSize.t * {signed: bool} (* codegen *)
+	     | Word_mul of WordSize.t * {signed: bool} (* codegen *)
+	     | Word_mulCheck of WordSize.t * {signed: bool} (* codegen *)
 	     | Word_neg of WordSize.t (* codegen *)
+	     | Word_negCheck of WordSize.t (* codegen *)
 	     | Word_notb of WordSize.t (* codegen *)
 	     | Word_orb of WordSize.t (* codegen *)
+	     | Word_quot of WordSize.t * {signed: bool} (* codegen *)
+	     | Word_rem of WordSize.t * {signed: bool} (* codegen *)
 	     | Word_rol of WordSize.t (* codegen *)
 	     | Word_ror of WordSize.t (* codegen *)
-	     | Word_rshift of WordSize.t (* codegen *)
+	     | Word_rshift of WordSize.t * {signed: bool} (* codegen *)
 	     | Word_sub of WordSize.t (* codegen *)
-	     | Word_toInt of WordSize.t * IntSize.t (* codegen *)
+	     | Word_subCheck of WordSize.t* {signed: bool} (* codegen *)
 	     | Word_toIntInf (* ssa to rssa *)
-	     | Word_toIntX of WordSize.t * IntSize.t (* codegen *)
-	     | Word_toWord of WordSize.t * WordSize.t (* codegen *)
-	     | Word_toWordX of WordSize.t * WordSize.t (* codegen *)
+	     | Word_toReal of WordSize.t * RealSize.t * {signed: bool} (* codegen *)
+	     | Word_toWord of WordSize.t * WordSize.t * {signed: bool} (* codegen *)
 	     | Word_xorb of WordSize.t (* codegen *)
 	     | WordVector_toIntInf (* ssa to rssa *)
-	     | Word8_toChar (* type inference *)
 	     | Word8Array_subWord (* ssa to rssa *)
 	     | Word8Array_updateWord (* ssa to rssa *)
 	     | Word8Vector_subWord (* ssa to rssa *)
@@ -254,13 +227,6 @@
       val fromString: string -> 'a t
       val gcCollect: 'a t
       val intInfEqual: 'a t
-      val intAdd: IntSize.t -> 'a t
-      val intAddCheck: IntSize.t -> 'a t
-      val intEqual: IntSize.t -> 'a t
-      val intMul: IntSize.t -> 'a t
-      val intMulCheck: IntSize.t -> 'a t
-      val intSub: IntSize.t -> 'a t
-      val intSubCheck: IntSize.t -> 'a t
       val isCommutative: 'a t -> bool
       (*
        * isFunctional p = true iff p always returns same result when given
@@ -287,21 +253,20 @@
       val vectorLength: 'a t
       val vectorSub: 'a t
       val wordAdd: WordSize.t -> 'a t
-      val wordAddCheck: WordSize.t -> 'a t
+      val wordAddCheck: WordSize.t * {signed: bool} -> 'a t
       val wordAndb: WordSize.t -> 'a t
-      val wordArshift: WordSize.t -> 'a t
       val wordEqual: WordSize.t -> 'a t
-      val wordGe: WordSize.t -> 'a t
-      val wordGt: WordSize.t -> 'a t
-      val wordLe: WordSize.t -> 'a t
-      val wordLt: WordSize.t -> 'a t
+      val wordGe: WordSize.t * {signed: bool} -> 'a t
+      val wordGt: WordSize.t * {signed: bool} -> 'a t
+      val wordLe: WordSize.t * {signed: bool} -> 'a t
+      val wordLt: WordSize.t * {signed: bool} -> 'a t
       val wordLshift: WordSize.t -> 'a t
-      val wordMul: WordSize.t -> 'a t
-      val wordMulCheck: WordSize.t -> 'a t
+      val wordMul: WordSize.t * {signed: bool} -> 'a t
+      val wordMulCheck: WordSize.t * {signed: bool} -> 'a t
       val wordNeg: WordSize.t -> 'a t
       val wordOrb: WordSize.t -> 'a t
-      val wordRshift: WordSize.t -> 'a t
+      val wordRshift: WordSize.t * {signed: bool} -> 'a t
       val wordSub: WordSize.t -> 'a t
-      val wordToWord: WordSize.t * WordSize.t -> 'a t
-      val wordToWordX: WordSize.t * WordSize.t -> 'a t
+      val wordSubCheck: WordSize.t * {signed: bool} -> 'a t
+      val wordToWord: WordSize.t * WordSize.t * {signed: bool} -> 'a t
    end



1.23      +0 -3      mlton/mlton/atoms/sources.cm

Index: sources.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/sources.cm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- sources.cm	25 Apr 2004 06:55:44 -0000	1.22
+++ sources.cm	1 May 2004 00:49:34 -0000	1.23
@@ -10,7 +10,6 @@
 signature AST
 signature ATOMS
 signature ID
-signature INT_X
 signature C_FUNCTION
 signature C_TYPE
 signature CON
@@ -50,8 +49,6 @@
 (* Windows doesn't like files named con, so use con- instead. *)
 con-.sig
 con-.fun
-int-x.sig
-int-x.fun
 real-x.sig
 real-x.fun
 word-x.sig



1.13      +0 -2      mlton/mlton/atoms/type-ops.fun

Index: type-ops.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/type-ops.fun,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- type-ops.fun	12 Apr 2004 17:52:56 -0000	1.12
+++ type-ops.fun	1 May 2004 00:49:34 -0000	1.13
@@ -27,7 +27,6 @@
 in
    val bool = nullary Tycon.bool
    val exn = nullary Tycon.exn
-   val int = IntSize.memoize (fn s => nullary (Tycon.int s))
    val intInf = nullary Tycon.intInf
    val preThread = nullary Tycon.preThread
    val real = RealSize.memoize (fn s => nullary (Tycon.real s))
@@ -35,7 +34,6 @@
    val word = WordSize.memoize (fn s => nullary (Tycon.word s))
 end
 
-val defaultInt = int IntSize.default
 val defaultReal = real RealSize.default
 val defaultWord = word WordSize.default
 



1.10      +0 -3      mlton/mlton/atoms/type-ops.sig

Index: type-ops.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/type-ops.sig,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- type-ops.sig	12 Apr 2004 17:52:56 -0000	1.9
+++ type-ops.sig	1 May 2004 00:49:34 -0000	1.10
@@ -25,7 +25,6 @@
        * the Tycon structure, which will cause duplicate specifications later
        * on.
        *)
-      type intSize
       type realSize
       type tycon
       type wordSize
@@ -51,11 +50,9 @@
       val deVector: t -> t
       val deWeak: t -> t
       val deWeakOpt: t -> t option
-      val defaultInt: t
       val defaultReal: t
       val defaultWord: t
       val exn: t
-      val int: intSize -> t
       val intInf: t
       val isTuple: t -> bool
       val list: t -> t



1.9       +72 -30    mlton/mlton/atoms/word-x.fun

Index: word-x.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/word-x.fun,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- word-x.fun	4 Apr 2004 06:50:14 -0000	1.8
+++ word-x.fun	1 May 2004 00:49:34 -0000	1.9
@@ -1,3 +1,10 @@
+(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under the GNU General Public License (GPL).
+ * Please see the file MLton-LICENSE for license information.
+ *)
+
 functor WordX (S: WORD_X_STRUCTS): WORD_X = 
 struct
 
@@ -27,9 +34,23 @@
    val value = make #value
 end
 
-fun toString w = IntInf.format (value w, StringCvt.HEX)
+val toIntInf = value
+   
+fun toIntInfX w =
+   let
+      val v = value w
+	    val m = modulus (size w)
+   in
+      if v >= m div 2
+	 then v - m
+      else v
+   end
+
+val toInt = IntInf.toInt o toIntInf
 
-val layout = Layout.str o toString
+fun toString w = IntInf.format (toIntInf w, StringCvt.HEX)
+
+fun layout w = Layout.str (concat ["0x", toString w])
 
 fun zero s = make (0, s)
 
@@ -59,36 +80,39 @@
 
 fun isAllOnes w = value w = modulus (size w) - 1
 
-val isMax = isAllOnes
-
 fun isOne w = 1 = value w
 
 fun isZero w = 0 = value w
 
-fun max s = make (modulus s - 1, s)
+fun isNegOne w = ~1 = toIntInfX w
+
+local
+   fun make f (s, sg) = fromIntInf (f (s, sg), s)
+in
+   val max = make WordSize.max
+   val min = make WordSize.min
+end
+
+local
+   fun make f (w, sg) = equals (w, f (size w, sg))
+in
+   val isMax = make max
+   val isMin = make min
+end
 
 fun notb w = make (IntInf.notb (value w), size w)
 
 fun one s = make (1, s)
 
-fun resize (w, s) = make (value w, s)
-
-fun toIntInfX w =
-   let
-      val v = value w
-      val m = modulus (size w)
-   in
-      if v >= m div 2
-	 then v - m
-      else v
-   end
+fun toIntInfSg (w, {signed}) =
+   if signed then toIntInfX w else toIntInf w
    
+fun resize (w, s) = make (toIntInf w, s)
+
 fun resizeX (w, s) = make (toIntInfX w, s)
 
 fun toChar (w: t): char = Char.fromInt (Int.fromIntInf (value w))
 
-val toIntInf = value
-
 fun ~>> (w, w') =
    let
       val shift = value w'
@@ -101,6 +125,9 @@
       make (IntInf.~>> (toIntInfX w, shift), s)
    end
 
+fun rshift (w, w', {signed}) =
+   if signed then ~>> (w, w') else >> (w, w')
+
 fun swap (i: IntInf.t, {hi: word, lo: word}) =
    let
       open IntInf
@@ -150,27 +177,42 @@
 	 then make (f (value w, value w'), size w)
       else raise Fail "WordX binary"
 in
-   val op + = make IntInf.+
-   val op - = make IntInf.-
-   val op * = make IntInf.*
+   val add = make IntInf.+
+   val sub = make IntInf.-
    val andb = make IntInf.andb
-   val op div = make IntInf.div
-   val op mod = make IntInf.mod
    val orb = make IntInf.orb
    val xorb = make IntInf.xorb
 end
 
+fun neg w = make (~ (toIntInfX w), size w)
+
 local
-   val make: (IntInf.t * IntInf.t -> 'a) -> t * t -> 'a =
-      fn f => fn (w, w') =>
+   val make: (IntInf.t * IntInf.t -> IntInf.t) -> t * t * {signed: bool}-> t =
+      fn f => fn (w, w', s) =>
       if WordSize.equals (size w, size w')
-	 then f (value w, value w')
+	 then make (f (toIntInfSg (w, s), toIntInfSg (w', s)), size w)
+      else raise Fail "WordX binary"
+in
+   val mul = make IntInf.*
+   val quot = make IntInf.quot
+   val rem = make IntInf.rem
+end
+
+local
+   val make: (IntInf.t * IntInf.t -> 'a) -> t * t * {signed: bool} -> 'a =
+      fn f => fn (w, w', sg) =>
+      if WordSize.equals (size w, size w')
+	 then f (toIntInfSg (w, sg), toIntInfSg (w', sg))
       else Error.bug "WordX compare"
 in
-   val op < = make IntInf.<
-   val op <= = make IntInf.<=
-   val op > = make IntInf.>
-   val op >= = make IntInf.>=
+   val lt = make IntInf.<
+   val le = make IntInf.<=
+   val gt = make IntInf.>
+   val ge = make IntInf.>=
 end
+
+fun layoutSg {signed} = Layout.record [("signed", Bool.layout signed)]
+
+val lt = Trace.trace3 ("WordX.lt", layout, layout, layoutSg, Bool.layout) lt
 
 end



1.6       +26 -13    mlton/mlton/atoms/word-x.sig

Index: word-x.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/word-x.sig,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- word-x.sig	4 Apr 2004 06:50:14 -0000	1.5
+++ word-x.sig	1 May 2004 00:49:34 -0000	1.6
@@ -1,3 +1,12 @@
+(* Copyright (C) 2004 Henry Cejtin, Matthew Fluet, Suresh
+ *    Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under the GNU General Public License (GPL).
+ * Please see the file MLton-LICENSE for license information.
+ *)
+
+type int = Int.t
+
 signature WORD_X_STRUCTS = 
    sig
       structure WordSize: WORD_SIZE
@@ -11,40 +20,44 @@
       type t
 
       val << : t * t -> t
-      val >> : t * t -> t
-      val ~>> : t * t -> t
-      val + : t * t -> t 
-      val - : t * t -> t 
-      val * : t * t -> t 
-      val > : t * t -> bool 
-      val < : t * t -> bool 
-      val >= : t * t -> bool 
-      val <= : t * t -> bool 
+      val add: t * t -> t
       val andb: t * t -> t
       val bitIsSet: t * Int.t -> bool
-      val div: t * t -> t
       val equals: t * t -> bool
+      val ge: t * t * {signed: bool} -> bool
+      val gt: t * t * {signed: bool} -> bool
       val fromChar: char -> t (* returns a word of size 8 *)
       val fromIntInf: IntInf.t * WordSize.t -> t
       val fromWord8: Word8.t -> t
       val isAllOnes: t -> bool
       val isOne: t -> bool
-      val isMax: t -> bool
+      val isMax: t * {signed: bool} -> bool
+      val isMin: t * {signed: bool} -> bool
+      val isNegOne: t -> bool
       val isZero: t -> bool
       val layout: t -> Layout.t
-      val max: WordSize.t -> t
-      val mod: t * t -> t
+      val le: t * t * {signed: bool} -> bool
+      val lt: t * t * {signed: bool} -> bool
+      val max: WordSize.t * {signed: bool} -> t
+      val min: WordSize.t * {signed: bool} -> t
+      val mul: t * t * {signed: bool} -> t
+      val neg: t -> t
       val notb: t -> t
       val one: WordSize.t -> t
       val orb: t * t -> t
+      val quot: t * t * {signed: bool} -> t
+      val rem: t * t * {signed: bool} -> t
       val resize: t * WordSize.t -> t
       val resizeX: t * WordSize.t -> t
       val rol: t * t -> t
       val ror: t * t -> t
+      val rshift : t * t * {signed: bool} -> t
       val size: t -> WordSize.t
       val splice: {hi: t, lo: t} -> t
       val split: t * {lo: Bits.t} -> {hi: t, lo: t}
+      val sub: t * t -> t
       val toChar: t -> char
+      val toInt: t -> int
       val toIntInf: t -> IntInf.t
       val toIntInfX: t -> IntInf.t
       val toString: t -> string



1.70      +9 -9      mlton/mlton/backend/backend.fun

Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -r1.69 -r1.70
--- backend.fun	27 Apr 2004 08:10:49 -0000	1.69
+++ backend.fun	1 May 2004 00:49:35 -0000	1.70
@@ -15,7 +15,6 @@
    open Machine
 in
    structure Global = Global
-   structure IntX = IntX
    structure Label = Label
    structure PointerTycon = PointerTycon
    structure RealX = RealX
@@ -133,7 +132,7 @@
 		      start = start}
    end
 
-fun toMachine (program: Ssa.Program.t) =
+fun toMachine (program: Ssa.Program.t, codegen) =
    let
       fun pass (name, doit, program) =
 	 Control.passTypeCheck {display = Control.Layouts Rssa.Program.layouts,
@@ -142,7 +141,7 @@
 				suffix = "rssa",
 				thunk = fn () => doit program,
 				typeCheck = R.Program.typeCheck}
-      val program = pass ("ssaToRssa", SsaToRssa.convert, program)
+      val program = pass ("ssaToRssa", SsaToRssa.convert, (program, codegen))
       val program = pass ("insertLimitChecks", LimitCheck.insert, program)
       val program = pass ("insertSignalChecks", SignalCheck.insert, program)
       val program = pass ("implementHandlers", ImplementHandlers.doit, program)
@@ -372,8 +371,7 @@
 	       datatype z = datatype Const.t
 	    in
 	       case c of
-		  Int i => M.Operand.Int i
-		| IntInf i =>
+		  IntInf i =>
 		     (case Const.SmallIntInf.toWord i of
 			 NONE => globalIntInf i
 		       | SOME w =>
@@ -498,10 +496,12 @@
 		     (M.Statement.PrimApp
 		      {args = (Vector.new2
 			       (stackTopOp,
-				M.Operand.Int
-				(IntX.defaultInt
-				 (Bytes.toInt
-				  (Bytes.+ (handlerOffset (), Bytes.inWord)))))),
+				M.Operand.Word
+				(WordX.fromIntInf
+				 (Int.toIntInf
+				  (Bytes.toInt
+				   (Bytes.+ (handlerOffset (), Bytes.inWord))),
+				  WordSize.default)))),
 		       dst = SOME tmp,
 		       prim = Prim.wordAdd WordSize.default},
 		      M.Statement.PrimApp



1.12      +4 -1      mlton/mlton/backend/backend.sig

Index: backend.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.sig,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- backend.sig	4 Apr 2004 06:50:16 -0000	1.11
+++ backend.sig	1 May 2004 00:49:35 -0000	1.12
@@ -21,5 +21,8 @@
    sig
       include BACKEND_STRUCTS
       
-      val toMachine: Ssa.Program.t -> Machine.Program.t
+      val toMachine:
+	 Ssa.Program.t
+	 * {codegenImplementsPrim: Machine.Type.t Machine.Prim.t -> bool}
+	 -> Machine.Program.t
    end



1.51      +6 -4      mlton/mlton/backend/limit-check.fun

Index: limit-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/limit-check.fun,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- limit-check.fun	27 Apr 2004 08:10:49 -0000	1.50
+++ limit-check.fun	1 May 2004 00:49:35 -0000	1.51
@@ -123,6 +123,7 @@
 		    ensureFree: Label.t -> Bytes.t) =
    let
       val {args, blocks, name, raises, returns, start} = Function.dest f
+      val greaterThan = Prim.wordGt (WordSize.default, {signed = false})
       val newBlocks = ref []
       local
 	 val r: Label.t option ref = ref NONE
@@ -291,7 +292,7 @@
 	     fun stackCheck (maybeFirst, z): Label.t =
 		let
 		   val (statements, transfer) =
-		      primApp (Prim.wordGt WordSize.default,
+		      primApp (greaterThan,
 			       Operand.Runtime StackTop,
 			       Operand.Runtime StackLimit,
 			       z)
@@ -340,7 +341,7 @@
 		       dst = SOME (res, Type.defaultWord),
 		       prim = Prim.wordSub WordSize.default}
 		   val (statements, transfer) =
-		      primApp (Prim.wordGt WordSize.default,
+		      primApp (greaterThan,
 			       amount,
 			       Operand.Var {var = res, ty = Type.defaultWord},
 			       z)
@@ -369,7 +370,7 @@
 	     fun heapCheckNonZero (bytes: Bytes.t): Label.t =
 		if Bytes.<= (bytes, Runtime.limitSlop)
 		   then frontierCheck (true,
-				       Prim.wordGt WordSize.default,
+				       greaterThan,
 				       Operand.Runtime Frontier,
 				       Operand.Runtime Limit,
 				       insert (Operand.word
@@ -419,7 +420,8 @@
 						  bytesNeeded),
 			      dst = bytes,
 			      overflow = allocTooLarge (),
-			      prim = Prim.wordAddCheck WordSize.default,
+			      prim = Prim.wordAddCheck (WordSize.default,
+							{signed = false}),
 			      success = (heapCheck
 					 (false, 
 					  Operand.Var {var = bytes,



1.65      +2 -11     mlton/mlton/backend/machine.fun

Index: machine.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.fun,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- machine.fun	25 Apr 2004 06:55:44 -0000	1.64
+++ machine.fun	1 May 2004 00:49:35 -0000	1.65
@@ -16,7 +16,6 @@
 structure RepType = RepType (structure CFunction = CFunction
 			     structure CType = CType
 			     structure IntSize = IntSize
-			     structure IntX = IntX
 			     structure Label = Label
 			     structure PointerTycon = PointerTycon
 			     structure Prim = Prim
@@ -175,7 +174,6 @@
        | Frontier
        | GCState
        | Global of Global.t
-       | Int of IntX.t
        | Label of Label.t
        | Line
        | Offset of {base: t,
@@ -205,9 +203,8 @@
 	| Frontier => Type.defaultWord
 	| GCState => Type.gcState
 	| Global g => Global.ty g
-	| Int i => Type.int (IntX.size i)
 	| Label l => Type.label l
-	| Line => Type.defaultInt
+	| Line => Type.defaultWord
 	| Offset {ty, ...} => ty
 	| Real r => Type.real (RealX.size r)
 	| Register r => Register.ty r
@@ -237,7 +234,6 @@
 	     | Frontier => str "<Frontier>"
 	     | GCState => str "<GCState>"
 	     | Global g => Global.layout g
-	     | Int i => IntX.layout i
 	     | Label l => Label.layout l
 	     | Line => str "<Line>"
 	     | Offset {base, offset, ty} =>
@@ -248,7 +244,7 @@
 	     | Register r => Register.layout r
 	     | StackOffset so => StackOffset.layout so
 	     | StackTop => str "<StackTop>"
-	     | Word w => seq [str "0x", WordX.layout w]
+	     | Word w => WordX.layout w
 	 end
 
     val toString = Layout.toString o layout
@@ -264,7 +260,6 @@
 	   | (File, File) => true
 	   | (GCState, GCState) => true
 	   | (Global g, Global g') => Global.equals (g, g')
-	   | (Int i, Int i') => IntX.equals (i, i')
 	   | (Label l, Label l') => Label.equals (l, l')
 	   | (Line, Line) => true
 	   | (Offset {base = b, offset = i, ...},
@@ -938,9 +933,6 @@
 			   (checkOperand (z, alloc)
 			    ; (Type.castIsOk
 			       {from = Operand.ty z,
-				fromInt = (case z of
-					      Int i => SOME i
-					    | _ => NONE),
 				to = t,
 				tyconTy = tyconTy}))
 		      | Contents {oper, ...} =>
@@ -956,7 +948,6 @@
 			    *)
 			   true
 			   orelse Alloc.doesDefine (alloc, x)
-		      | Int _ => true
 		      | Label l => 
 			   (let val _ = labelBlock l
 			    in true



1.46      +0 -1      mlton/mlton/backend/machine.sig

Index: machine.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.sig,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- machine.sig	25 Apr 2004 06:55:44 -0000	1.45
+++ machine.sig	1 May 2004 00:49:35 -0000	1.46
@@ -73,7 +73,6 @@
 	     | Frontier
 	     | GCState
 	     | Global of Global.t
-	     | Int of IntX.t
 	     | Label of Label.t
 	     | Line (* expand by codegen into int constant *)
 	     | Offset of {base: t,



1.12      +18 -14    mlton/mlton/backend/packed-representation.fun

Index: packed-representation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/packed-representation.fun,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- packed-representation.fun	28 Apr 2004 03:17:05 -0000	1.11
+++ packed-representation.fun	1 May 2004 00:49:35 -0000	1.12
@@ -167,7 +167,8 @@
 	 val andb = make (valOf o Type.andb, Prim.wordAndb)
 	 val lshift = make (Type.lshift, Prim.wordLshift)
 	 val orb = make (valOf o Type.orb, Prim.wordOrb)
-	 val rshift = make (Type.rshift, Prim.wordRshift)
+	 val rshift = make (Type.rshift, fn s =>
+			    Prim.wordRshift (s, {signed = false}))
       end
    end
 
@@ -395,7 +396,10 @@
 		  let
 		     val (s, src) =
 			Statement.andb
-			(src, Operand.word (WordX.resize (WordX.max s, s')))
+			(src,
+			 Operand.word (WordX.resize
+				       (WordX.max (s, {signed = false}), s')))
+					    
 		  in
 		     (src, [s])
 		  end
@@ -994,10 +998,10 @@
 		  seq [str "ShiftAndTag ",
 		       record [("component", Component.layout component),
 			       ("selects", Selects.layout selects),
-			       ("tag", seq [str "0x", WordX.layout tag]),
+			       ("tag", WordX.layout tag),
 			       ("ty", Type.layout ty)]]
 	     | Tag {tag} =>
-		  seq [str "Tag 0x", WordX.layout tag]
+		  seq [str "Tag ", WordX.layout tag]
 	     | Transparent => str "Transparent"
 	     | Unit => str "Unit"
 	 end
@@ -1165,7 +1169,8 @@
 	       else default
 	    val cases =
 	       QuickSort.sortVector 
-	       (cases, fn ((w, _), (w', _)) => WordX.<= (w, w'))
+	       (cases, fn ((w, _), (w', _)) =>
+		WordX.le (w, w', {signed = false}))
 	    val headerTy = headerTy ()
 	    val (s, tag) =
 	       Statement.rshift (Offset {base = test,
@@ -1231,10 +1236,11 @@
 			       Block.new {statements = statements,
 					  transfer = transfer})
 		      end
-		 | ConRep.Tag {tag} => SOME (WordX.resize (tag, wordSize), l)
+		 | ConRep.Tag {tag} =>
+		      SOME (WordX.resize (tag, wordSize), l)
 		 | _ => NONE)
 	    val cases = QuickSort.sortVector (cases, fn ((w, _), (w', _)) =>
-					      WordX.<= (w, w'))
+					      WordX.le (w, w', {signed = false}))
 	    val (tagOp, ss) =
 	       if isEnum
 		  then (test, [])
@@ -1244,7 +1250,8 @@
 			Statement.andb
 			(test,
 			 Operand.word (WordX.resize
-				       (WordX.max (WordSize.fromBits tagBits),
+				       (WordX.max (WordSize.fromBits tagBits,
+						   {signed = false}),
 					wordSize)))
 		  in
 		     (tag, [s])
@@ -1416,7 +1423,9 @@
 			   con: Con.t,
 			   pointerTycon: PointerTycon.t} vector)
 	 : t * {con: Con.t, rep: ConRep.t} vector =
-	 if 1 = Vector.length variants
+	 if 0 = Vector.length variants
+	    then (Unit, Vector.new0 ())
+	 else if 1 = Vector.length variants
 	    then
 	       let
 		  val {args, con, pointerTycon} = Vector.sub (variants, 0)
@@ -2094,7 +2103,6 @@
 		    in
 		       r'
 		    end
-	       | Int s => nonPointer (Type.int s)
 	       | IntInf =>
 		    constant (Rep.T {rep = Rep.Pointer {endsIn00 = false},
 				     ty = Type.intInf})
@@ -2252,10 +2260,6 @@
 		  if Tycon.equals (c, Tycon.bool)
 		     then SOME Type.bool
 		  else normal ()
-	     | Int s =>
-		  if true
-		     then normal ()
-		  else SOME (Type.int (IntSize.roundUpToPrim s))
 	     | _ => normal ()
 	 end
       fun makeSrc (v, oper) {index} = oper (Vector.sub (v, index))



1.6       +32 -54    mlton/mlton/backend/rep-type.fun

Index: rep-type.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rep-type.fun,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- rep-type.fun	28 Apr 2004 03:17:05 -0000	1.5
+++ rep-type.fun	1 May 2004 00:49:35 -0000	1.6
@@ -38,7 +38,7 @@
 	 in
 	    case dest t of
 	       Address t => seq [str "Address ", layout t]
-	     | Constant w => seq [str "0x", WordX.layout w, str ":",
+	     | Constant w => seq [WordX.layout w, str ":",
 				  WordSize.layout (WordX.size w)]
 	     | ExnStack => str "ExnStack"
 	     | GCState => str "GCState"
@@ -123,8 +123,6 @@
       val real = T o Real
       val word = T o Word
 
-      val int = word o IntSize.bits
-
       val char = word Bits.inByte
 
       fun zero b = constant (WordX.zero (WordSize.fromBits b))
@@ -201,7 +199,6 @@
 	    Word b => Bits.equals (b, Bits.inPointer)
 	  | _ => false
 	 
-      val defaultInt = int IntSize.default
       val defaultWord = word Bits.inWord
       val word8 = word Bits.inByte
 
@@ -217,7 +214,7 @@
 	       seq (Vector.new2
 		    (constant (WordX.fromIntInf
 			       (1, WordSize.fromBits (Bits.fromInt 1))),
-		     int (IntSize.I (Bits.fromInt 31))))))
+		     word (Bits.fromInt 31)))))
 
       local
 	 fun make is t =
@@ -495,7 +492,7 @@
 
       fun mulConstant (t: t, w: WordX.t): t =
 	 case dest t of
-	    Constant w' => constant (WordX.* (w, w'))
+	    Constant w' => constant (WordX.mul (w, w', {signed = false}))
 	  | _ =>
 	       let
 		  val n = width t
@@ -865,7 +862,7 @@
 	      WordSize.default))
 
 fun arrayOffsetIsOk {base: t, index: t, pointerTy, result: t}: bool =
-   isSubtype (index, defaultInt)
+   isSubtype (index, defaultWord)
    andalso
    case dest base of
       Pointer p =>
@@ -893,7 +890,7 @@
 		  (case pointerTy p of
 		      ObjectType.Array _ =>
 			 if Bytes.equals (offset, Runtime.arrayLengthOffset)
-			    then SOME defaultInt
+			    then SOME defaultWord
 			 else NONE
 		    | ObjectType.Normal t => SOME (frag t)
 		    | _ => NONE)
@@ -947,7 +944,7 @@
        | StackTop => cPointer ()
    end
 
-fun castIsOk {from, fromInt = _, to, tyconTy = _} =
+fun castIsOk {from, to, tyconTy = _} =
    Bits.equals (width from, width to)
 
 fun checkPrimApp {args: t vector, prim: t Prim.t, result: t option}: bool =
@@ -985,30 +982,25 @@
       local
 	 open Type
       in
-	 val defaultInt = defaultInt
 	 val defaultWord = defaultWord
-	 val int = int
 	 val real = real
 	 val word = word o WordSize.bits
       end
       local
 	 fun make f s = let val t = f s in unary (t, t) end
       in
-	 val intUnary = make int
 	 val realUnary = make real
 	 val wordUnary = make word
       end
       local
 	 fun make f s = let val t = f s in binary (t, t, t) end
       in
-	 val intBinary = make int
 	 val realBinary = make real
 	 val wordBinary = make word
       end
       local
 	 fun make f s = let val t = f s in binary (t, t, bool) end
       in
-	 val intCompare = make int
 	 val realCompare = make real
 	 val wordCompare = make word
       end
@@ -1030,24 +1022,6 @@
 	       Vector.equals (args, expects, isSubtype) andalso done return
 	    end
        | FFI_Symbol {ty, ...} => nullary ty
-       | Int_add s => intBinary s
-       | Int_addCheck s => intBinary s
-       | Int_equal s => intCompare s
-       | Int_ge s => intCompare s
-       | Int_gt s => intCompare s
-       | Int_le s => intCompare s
-       | Int_lt s => intCompare s
-       | Int_mul s => intBinary s
-       | Int_mulCheck s => intBinary s
-       | Int_neg s => intUnary s
-       | Int_negCheck s => intUnary s
-       | Int_quot s => intBinary s
-       | Int_rem s => intBinary s
-       | Int_sub s => intBinary s
-       | Int_subCheck s => intBinary s
-       | Int_toInt (s, s') => unary (int s, int s')
-       | Int_toReal (s, s') => unary (int s, real s')
-       | Int_toWord (s, s') => unary (int s, word s')
        | MLton_eq =>
 	    two (fn (t1, t2) =>
 		 (isSubtype (t1, t2) orelse isSubtype (t2, t1))
@@ -1069,7 +1043,7 @@
        | Real_equal s => realCompare s
        | Real_ge s => realCompare s
        | Real_gt s => realCompare s
-       | Real_ldexp s => binary (real s, defaultInt, real s)
+       | Real_ldexp s => binary (real s, defaultWord, real s)
        | Real_le s => realCompare s
        | Real_lt s => realCompare s
        | Real_mul s => realBinary s
@@ -1079,37 +1053,42 @@
        | Real_qequal s => realCompare s
        | Real_round s => realUnary s
        | Real_sub s => realBinary s
-       | Real_toInt (s, s') => unary (real s, int s')
        | Real_toReal (s, s') => unary (real s, real s')
+       | Real_toWord (s, s', _) => unary (real s, word s')
        | Thread_returnToC => nullary unit
        | Word_add _ => twoWord add
-       | Word_addCheck s => wordBinary s
+       | Word_addCheck (s, _) => wordBinary s
        | Word_andb _ => twoOpt andb
-       | Word_arshift _ => wordShift' arshift
-       | Word_div s => wordBinary s
        | Word_equal s => wordCompare s
-       | Word_ge s => wordCompare s
-       | Word_gt s => wordCompare s
-       | Word_le s => wordCompare s
+       | Word_ge (s, _) => wordCompare s
+       | Word_gt (s, _) => wordCompare s
+       | Word_le (s, _) => wordCompare s
        | Word_lshift _ => wordShift' lshift
-       | Word_lt s => wordCompare s
-       | Word_mod s => wordBinary s
-       | Word_mul _ => twoWord mul
-       | Word_mulCheck s => wordBinary s
+       | Word_lt (s, _) => wordCompare s
+       | Word_mul (s, {signed}) =>
+	    if signed
+	       then wordBinary s
+	    else twoWord mul
+       | Word_mulCheck (s, _) => wordBinary s
        | Word_neg s => wordUnary s
+       | Word_negCheck s => wordUnary s
        | Word_notb s => wordUnary s
        | Word_orb _ => twoOpt orb
+       | Word_quot (s, _) => wordBinary s
+       | Word_rem (s, _) => wordBinary s
        | Word_rol s => wordShift s
        | Word_ror s => wordShift s
-       | Word_rshift _ => wordShift' rshift
+       | Word_rshift (_, {signed}) =>
+	    wordShift' (if signed then arshift else rshift)
        | Word_sub s => wordBinary s
-       | Word_toInt (s, s') => unary (word s, int s')
-       | Word_toIntX (s, s') => unary (word s, int s')
-       | Word_toWord (s, s') =>
-	    one (fn t =>
-		 isSubtype (t, word s)
-		 andalso done (resize (t, (WordSize.bits s'))))
-       | Word_toWordX (s, s') => unary (word s, word s')
+       | Word_subCheck (s, _) => wordBinary s
+       | Word_toReal (s, s', _) => unary (word s, real s')
+       | Word_toWord (s, s', {signed}) =>
+	    if signed
+	       then unary (word s, word s')
+	    else one (fn t =>
+		      isSubtype (t, word s)
+		      andalso done (resize (t, (WordSize.bits s'))))
        | Word_xorb s => wordBinary s
        | _ => Error.bug (concat ["strange primitive to Prim.typeCheck: ",
 				 Prim.toString prim])
@@ -1137,7 +1116,6 @@
       local
 	 open Type
       in
-	 val Int32 = int (IntSize.I (Bits.fromInt 32))
 	 val Word32 = word (Bits.fromInt 32)
 	 val unit = unit
       end
@@ -1147,7 +1125,7 @@
 	    T {args = let
 			 open Type
 		      in
-			 Vector.new5 (gcState, Word32, bool, cPointer (), Int32)
+			 Vector.new5 (gcState, Word32, bool, cPointer (), Word32)
 		      end,
 		   bytesNeeded = NONE,
 		   convention = Cdecl,



1.5       +0 -6      mlton/mlton/backend/rep-type.sig

Index: rep-type.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rep-type.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- rep-type.sig	27 Apr 2004 08:10:49 -0000	1.4
+++ rep-type.sig	1 May 2004 00:49:35 -0000	1.5
@@ -9,8 +9,6 @@
    sig
       structure CFunction: C_FUNCTION
       structure CType: C_TYPE
-      structure IntSize: INT_SIZE
-      structure IntX: INT_X
       structure Label: LABEL
       structure PointerTycon: POINTER_TYCON
       structure Prim: PRIM
@@ -19,7 +17,6 @@
       structure WordSize: WORD_SIZE
       structure WordX: WORD_X
       sharing CFunction = Prim.CFunction
-      sharing IntSize = IntX.IntSize = Prim.IntSize
       sharing RealSize = Prim.RealSize
       sharing WordSize = Prim.WordSize = WordX.WordSize
    end
@@ -66,7 +63,6 @@
       val bool: t
       val bytes: t -> Bytes.t
       val castIsOk: {from: t,
-		     fromInt: IntX.t option,
 		     to: t,
 		     tyconTy: PointerTycon.t -> ObjectType.t} -> bool
       val checkPrimApp: {args: t vector,
@@ -75,7 +71,6 @@
       val char: t
       val cPointer: unit -> t
       val constant: WordX.t -> t
-      val defaultInt: t
       val defaultWord: t
       val dest: t -> dest
       val dropPrefix: t * Bits.t -> t
@@ -85,7 +80,6 @@
       val fragment: t * {start: Bits.t, width: Bits.t} -> t
       val fromCType: CType.t -> t
       val gcState: t
-      val int: IntSize.t -> t
       val intInf: t
       val isBool: t -> bool
       val isCPointer: t -> bool



1.32      +6 -5      mlton/mlton/backend/representation.fun

Index: representation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/representation.fun,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- representation.fun	28 Apr 2004 03:17:05 -0000	1.31
+++ representation.fun	1 May 2004 00:49:35 -0000	1.32
@@ -427,7 +427,7 @@
 		       if isTagged
 			  then {mutable = false,
 				offset = Bytes.zero,
-				ty = Type.int IntSize.default} :: components
+				ty = Type.defaultWord} :: components
 		       else components
 		    val components =
 		       QuickSort.sortArray
@@ -678,7 +678,6 @@
 	      case S.Type.dest t of
 		 Array t => SOME (array {mutable = true, ty = t})
 	       | Datatype tycon => convertDatatype tycon
-	       | Int s => SOME (Type.int (IntSize.roundUpToPrim s))
 	       | IntInf => SOME Type.intInf
 	       | Real s => SOME (Type.real s)
 	       | Ref t =>
@@ -842,7 +841,7 @@
 			      val cases =
 				 QuickSort.sortVector
 				 (cases, fn ((w, _), (w', _)) =>
-				  WordX.<= (w, w'))
+				  WordX.le (w, w', {signed = false}))
 			   in
 			      Switch (Switch.T {cases = cases,
 						default = default,
@@ -971,7 +970,8 @@
 		     else default
 		  val cases =
 		     QuickSort.sortVector
-		     (cases, fn ((w, _), (w', _)) => WordX.<= (w, w'))
+		     (cases, fn ((w, _), (w', _)) =>
+		      WordX.le (w, w', {signed = false}))
 		  val headerOffset = Bytes.fromInt ~4
 		  val tagVar = Var.newNoname ()
 		  val tagTy =
@@ -992,7 +992,8 @@
 						       Type.pointerHeader))},
 			       Operand.word (WordX.one WordSize.default))),
 		      dst = SOME (tagVar, tagTy),
-		      prim = Prim.wordRshift WordSize.default}
+		      prim = Prim.wordRshift (WordSize.default,
+					      {signed = false})}
 	       in
 		  ([s],
 		   Transfer.Switch



1.12      +0 -1      mlton/mlton/backend/representation.sig

Index: representation.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/representation.sig,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- representation.sig	19 Apr 2004 02:38:02 -0000	1.11
+++ representation.sig	1 May 2004 00:49:35 -0000	1.12
@@ -11,7 +11,6 @@
    sig
       structure Rssa: RSSA
       structure Ssa: SSA
-      sharing Rssa.IntSize = Ssa.IntSize
       sharing Rssa.RealSize = Ssa.RealSize
       sharing Rssa.WordSize = Ssa.WordSize
    end



1.58      +13 -17    mlton/mlton/backend/rssa.fun

Index: rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.fun,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- rssa.fun	28 Apr 2004 03:17:05 -0000	1.57
+++ rssa.fun	1 May 2004 00:49:35 -0000	1.58
@@ -66,8 +66,9 @@
        | Var of {var: Var.t,
 		 ty: Type.t}
 
-      val int = Const o Const.int
       val word = Const o Const.word
+
+      fun zero s = word (WordX.fromIntInf (0, s))
 	 
       fun bool b =
 	 word (WordX.fromIntInf (if b then 1 else 0, WordSize.default))
@@ -80,8 +81,7 @@
 		  datatype z = datatype Const.t
 	       in
 		  case c of
-		     Int i => Type.int (IntX.size i)
-		   | IntInf _ => Type.intInf
+		     IntInf _ => Type.intInf
 		   | Real r => Type.real (RealX.size r)
 		   | Word w => Type.constant w
 		   | Word8Vector _ => Type.word8Vector
@@ -89,7 +89,7 @@
 	  | EnsuresBytesFree => Type.defaultWord
 	  | File => Type.cPointer ()
 	  | GCState => Type.gcState
-	  | Line => Type.int IntSize.default
+	  | Line => Type.defaultWord
 	  | Offset {ty, ...} => ty
 	  | PointerTycon _ => Type.defaultWord
 	  | Runtime z => Type.ofGCField z
@@ -121,7 +121,7 @@
 	 end
 
       fun cast (z, t) =
-	 if Type.isSubtype (t, ty z)
+	 if Type.isSubtype (ty z, t)
 	    then z
 	 else Cast (z, t)
 
@@ -294,7 +294,8 @@
 		   [PrimApp {args = Vector.new1 z,
 			     dst = SOME (tmp, tmpTy),
 			     prim = Prim.wordToWord (WordSize.fromBits w,
-						     WordSize.fromBits b)}])
+						     WordSize.fromBits b,
+						     {signed = false})}])
 	       end
 	 end
    end
@@ -1045,16 +1046,9 @@
 						     result = ty})
 		       | Cast (z, ty) =>
 			    (checkOperand z
-			    ; (Type.castIsOk
-			       {from = Operand.ty z,
-				fromInt = (case z of
-					      Const c =>
-						 (case c of
-						     Const.Int n => SOME n
-						   | _ => NONE)
-					    | _ => NONE),
-				to = ty,
-				tyconTy = tyconTy}))
+			    ; Type.castIsOk {from = Operand.ty z,
+					     to = ty,
+					     tyconTy = tyconTy})
 		       | Const _ => true
 		       | EnsuresBytesFree => true
 		       | File => true
@@ -1083,7 +1077,9 @@
 		  datatype z = datatype Statement.t
 	       in
 		  case s of
-		     Bind {src, ...} => (checkOperand src; true)
+		     Bind {src, dst = (_, dstTy), ...} =>
+			(checkOperand src
+			 ; Type.isSubtype (Operand.ty src, dstTy))
 		   | Move {dst, src} =>
 			(checkOperand dst
 			 ; checkOperand src



1.38      +1 -1      mlton/mlton/backend/rssa.sig

Index: rssa.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.sig,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- rssa.sig	28 Apr 2004 03:17:05 -0000	1.37
+++ rssa.sig	1 May 2004 00:49:35 -0000	1.38
@@ -66,11 +66,11 @@
 	    val caseBytes: t * {big: t -> 'a,
 				small: Bytes.t -> 'a} -> 'a
 	    val cast: t * Type.t -> t
-	    val int: IntX.t -> t
 	    val layout: t -> Layout.t
 	    val foreachVar: t * (Var.t -> unit) -> unit
 	    val ty: t -> Type.t
 	    val word: WordX.t -> t
+	    val zero: WordSize.t -> t
 	 end
       sharing Operand = Switch.Use
     



1.77      +133 -426  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.76
retrieving revision 1.77
diff -u -r1.76 -r1.77
--- ssa-to-rssa.fun	27 Apr 2004 08:10:50 -0000	1.76
+++ ssa-to-rssa.fun	1 May 2004 00:49:35 -0000	1.77
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -39,7 +39,6 @@
 	 open Type
       in
 	 val gcState = gcState
-	 val Int32 = int (IntSize.I (Bits.fromInt 32))
 	 val Word32 = word (Bits.fromInt 32)
 	 val unit = unit
       end
@@ -71,7 +70,7 @@
 	    return = Type.thread}
 
       val exit =
-	 T {args = Vector.new1 Int32,
+	 T {args = Vector.new1 Word32,
 	    bytesNeeded = NONE,
 	    convention = Cdecl,
 	    ensuresBytesFree = false,
@@ -83,7 +82,7 @@
 	    return = unit}
 
       fun gcArrayAllocate {return} =
-	 T {args = Vector.new4 (gcState, Word32, Int32, Word32),
+	 T {args = Vector.new4 (gcState, Word32, Word32, Word32),
 	    bytesNeeded = NONE,
 	    convention = Cdecl,
 	    ensuresBytesFree = true,
@@ -172,7 +171,7 @@
       fun size t =
 	 vanilla {args = Vector.new1 t,
 		  name = "MLton_size",
-		  return = Int32}
+		  return = Word32}
    end
 
 structure Name =
@@ -184,36 +183,17 @@
       fun cFunctionRaise (n: t): CFunction.t =
 	 let
 	    datatype z = datatype CFunction.Convention.t
+	    val name = toString n
 	    val word = Type.word o WordSize.bits
 	    val vanilla = CFunction.vanilla
-	    val intC = ("Int", Type.int, IntSize.toString)
+	    val intC = ("Int", Type.word, IntSize.toString)
 	    val realC = ("Real", Type.real, RealSize.toString)
 	    val wordC = ("Word", word, WordSize.toString)
-	    fun coerce (s1, (fromName, fromType, fromString),
-			s2, (toName, toType, toString)) =
-	       vanilla {args = Vector.new1 (fromType s1),
-			name = concat [fromName, fromString s1,
-				       "_to", toName, toString s2],
-			return = toType s2}
-	    fun coerceX (s1, (fromName, fromType, fromString),
-			 s2, (toName, toType, toString)) =
-	       vanilla {args = Vector.new1 (fromType s1),
-			name = concat [fromName, fromString s1,
-				       "_to", toName, toString s2, "X"],
-			return = toType s2}
-	    fun intBinary (s, name) =
-	       let
-		  val t = Type.int s
-	       in
-		  vanilla {args = Vector.new2 (t, t),
-			   name = concat ["Int", IntSize.toString s, "_", name],
-			   return = t}
-	       end
-	    fun intCompare (s, name) =
-	       vanilla {args = Vector.new2 (Type.int s, Type.int s),
-			name = concat ["Int", IntSize.toString s, "_", name],
-			return = Type.bool}
-	    fun intInfBinary name =
+	    fun coerce (t1, t2) =
+	       vanilla {args = Vector.new1 t1,
+			name = name,
+			return = t2}
+	    fun intInfBinary () =
 	       CFunction.T {args = Vector.new3 (Type.intInf, Type.intInf,
 						Type.defaultWord),
 			    bytesNeeded = SOME 2,
@@ -223,9 +203,9 @@
 			    maySwitchThreads = false,
 			    modifiesFrontier = true,
 			    modifiesStackTop = false,
-			    name = concat ["IntInf_", name],
+			    name = name,
 			    return = Type.intInf}
-	    fun intInfShift name =
+	    fun intInfShift () =
 	       CFunction.T {args = Vector.new3 (Type.intInf,
 						Type.defaultWord,
 						Type.defaultWord),
@@ -236,11 +216,11 @@
 			    maySwitchThreads = false,
 			    modifiesFrontier = true,
 			    modifiesStackTop = false,
-			    name = concat ["IntInf_", name],
+			    name = name,
 			    return = Type.intInf}
-	    val intInfToString =
+	    fun intInfToString () =
 	       CFunction.T {args = Vector.new3 (Type.intInf,
-						Type.defaultInt,
+						Type.defaultWord,
 						Type.defaultWord),
 			    bytesNeeded = SOME 2,
 			    convention = Cdecl,
@@ -249,9 +229,9 @@
 			    maySwitchThreads = false,
 			    modifiesFrontier = true,
 			    modifiesStackTop = false,
-			    name = "IntInf_toString",
+			    name = name,
 			    return = Type.string}
-	    fun intInfUnary name =
+	    fun intInfUnary () =
 	       CFunction.T {args = Vector.new2 (Type.intInf, Type.defaultWord),
 			    bytesNeeded = SOME 1,
 			    convention = Cdecl,
@@ -260,284 +240,82 @@
 			    maySwitchThreads = false,
 			    modifiesFrontier = true,
 			    modifiesStackTop = false,
-			    name = concat ["IntInf_", name],
+			    name = name,
 			    return = Type.intInf}
-	    fun wordBinary (s, name) =
+	    fun wordBinary s =
 	       let
 		  val t = word s
 	       in
 		  vanilla {args = Vector.new2 (t, t),
-			   name = concat ["Word", WordSize.toString s,
-					  "_", name],
+			   name = name,
 			   return = t}
 	       end
-	    fun wordCompare (s, name) =
+	    fun wordCompare s =
 	       vanilla {args = Vector.new2 (word s, word s),
-			name = concat ["Word", WordSize.toString s, "_", name],
+			name = name,
 			return = Type.bool}
-	    fun wordShift (s, name) =
+	    fun wordShift s =
 	       vanilla {args = Vector.new2 (word s, Type.defaultWord),
-			name = concat ["Word", WordSize.toString s, "_", name],
+			name = name,
 			return = word s}
-	    fun wordUnary (s, name) =
+	    fun wordUnary s =
 	       vanilla {args = Vector.new1 (word s),
-			name = concat ["Word", WordSize.toString s, "_", name],
+			name = name,
 			return = word s}
 	 in
 	    case n of
-	       Int_ge s => intCompare (s, "ge")
-	     | Int_gt s => intCompare (s, "gt")
-	     | Int_le s => intCompare (s, "le")
-	     | Int_lt s => intCompare (s, "lt")
-	     | Int_mul s => intBinary (s, "mul")
-	     | Int_quot s => intBinary (s, "quot")
-	     | Int_rem s => intBinary (s, "rem")
-	     | Int_toReal (s1, s2) => coerce (s1, intC, s2, realC)
-	     | IntInf_add => intInfBinary "add"
-	     | IntInf_andb => intInfBinary "andb"
-	     | IntInf_arshift => intInfShift "arshift"
+	       IntInf_add => intInfBinary ()
+	     | IntInf_andb => intInfBinary ()
+	     | IntInf_arshift => intInfShift ()
 	     | IntInf_compare => 
 		  vanilla {args = Vector.new2 (Type.intInf, Type.intInf),
-			   name = "IntInf_compare",
-			   return = Type.defaultInt}
+			   name = name,
+			   return = Type.defaultWord}
 	     | IntInf_equal =>
 		  vanilla {args = Vector.new2 (Type.intInf, Type.intInf),
-			   name = "IntInf_equal",
+			   name = name,
 			   return = Type.bool}
-	     | IntInf_gcd => intInfBinary "gcd"
-	     | IntInf_lshift => intInfShift "lshift"
-	     | IntInf_mul => intInfBinary "mul"
-	     | IntInf_neg => intInfUnary "neg"
-	     | IntInf_notb => intInfUnary "notb"
-	     | IntInf_orb => intInfBinary "orb"
-	     | IntInf_quot => intInfBinary "quot"
-	     | IntInf_rem => intInfBinary "rem"
-	     | IntInf_sub => intInfBinary "sub"
-	     | IntInf_toString => intInfToString
-	     | IntInf_xorb => intInfBinary "xorb"
+	     | IntInf_gcd => intInfBinary ()
+	     | IntInf_lshift => intInfShift ()
+	     | IntInf_mul => intInfBinary ()
+	     | IntInf_neg => intInfUnary ()
+	     | IntInf_notb => intInfUnary ()
+	     | IntInf_orb => intInfBinary ()
+	     | IntInf_quot => intInfBinary ()
+	     | IntInf_rem => intInfBinary ()
+	     | IntInf_sub => intInfBinary ()
+	     | IntInf_toString => intInfToString ()
+	     | IntInf_xorb => intInfBinary ()
 	     | MLton_bug => CFunction.bug
 	     | Thread_returnToC => CFunction.returnToC
-	     | Word_add s => wordBinary (s, "add")
-	     | Word_andb s => wordBinary (s, "andb")
-	     | Word_arshift s => wordShift (s, "arshift")
-	     | Word_div s => wordBinary (s, "div")
-	     | Word_equal s => wordCompare (s, "equal")
-	     | Word_ge s => wordCompare (s, "ge")
-	     | Word_gt s => wordCompare (s, "gt")
-	     | Word_le s => wordCompare (s, "le")
-	     | Word_lshift s => wordShift (s, "lshift")
-	     | Word_lt s => wordCompare (s, "lt")
-	     | Word_mod s => wordBinary (s, "mod")
-	     | Word_mul s => wordBinary (s, "mul")
-	     | Word_neg s => wordUnary (s, "neg")
-	     | Word_notb s => wordUnary (s, "notb")
-	     | Word_orb s => wordBinary (s, "orb")
-	     | Word_rol s => wordShift (s, "rol")
-	     | Word_ror s => wordShift (s, "ror")
-	     | Word_rshift s => wordShift (s, "rshift")
-	     | Word_sub s => wordBinary (s, "sub")
-	     | Word_toWord (s1, s2) => coerce (s1, wordC, s2, wordC)
-	     | Word_toWordX (s1, s2) => coerceX (s1, wordC, s2, wordC)
-	     | Word_xorb s => wordBinary (s, "xorb")
+	     | Word_add s => wordBinary s
+	     | Word_andb s => wordBinary s
+	     | Word_equal s => wordCompare s
+	     | Word_ge (s, _) => wordCompare s
+	     | Word_gt (s, _) => wordCompare s
+	     | Word_le (s, _) => wordCompare s
+	     | Word_lshift s => wordShift s
+	     | Word_lt (s, _) => wordCompare s
+	     | Word_mul (s, _) => wordBinary s
+	     | Word_neg s => wordUnary s
+	     | Word_notb s => wordUnary s
+	     | Word_orb s => wordBinary s
+	     | Word_quot (s, _) => wordBinary s
+	     | Word_rem (s, _) => wordBinary s
+	     | Word_rol s => wordShift s
+	     | Word_ror s => wordShift s
+	     | Word_rshift (s, _) => wordShift s
+	     | Word_sub s => wordBinary s
+	     | Word_toReal (s1, s2, _) =>
+		  coerce (Type.word (WordSize.bits s1), Type.real s2)
+	     | Word_toWord (s1, s2, _) =>
+		  coerce (Type.word (WordSize.bits s1),
+			  Type.word (WordSize.bits s2))
+	     | Word_xorb s => wordBinary s
 	     | _ => raise Fail "cFunctionRaise"
 	 end
 
       fun cFunction n = SOME (cFunctionRaise n) handle _ => NONE
-
-      fun cCodegenImplements n =
-	 let
-	    datatype z = datatype RealSize.t
-	 in
-	    case n of
-	       FFI_Symbol _ => true
-	     | Int_ge _ => true
-	     | Int_gt _ => true
-	     | Int_le _ => true
-	     | Int_lt _ => true
-	     | Int_mul _ => true
-	     | Int_toReal _ => true
-	     | Real_Math_acos _ => true
-	     | Real_Math_asin _ => true
-	     | Real_Math_atan _ => true
-	     | Real_Math_atan2 _ => true
-	     | Real_Math_cos _ => true
-	     | Real_Math_exp _ => true
-	     | Real_Math_ln _ => true
-	     | Real_Math_log10 _ => true
-	     | Real_Math_sin _ => true
-	     | Real_Math_sqrt _ => true
-	     | Real_Math_tan _ => true
-	     | Real_add _ => true
-	     | Real_div _ => true
-	     | Real_equal _ => true
-	     | Real_ge _ => true
-	     | Real_gt _ => true
-	     | Real_ldexp _ => true
-	     | Real_le _ => true
-	     | Real_lt _ => true
-	     | Real_mul _ => true
-	     | Real_muladd _ => true
-	     | Real_mulsub _ => true
-	     | Real_neg _ => true
-	     | Real_round _ => true
-	     | Real_sub _ => true
-	     | Real_toInt _ => true
-	     | Real_toReal _ => true
-	     | Thread_returnToC => true
-	     | Word_add _ => true
-	     | Word_andb _ => true
-	     | Word_arshift _ => true
-	     | Word_div _ => true
-	     | Word_equal _ => true
-	     | Word_ge _ => true
-	     | Word_gt _ => true
-	     | Word_le _ => true
-	     | Word_lshift _ => true
-	     | Word_lt _ => true
-	     | Word_mod _ => true
-	     | Word_mul _ => true
-	     | Word_neg _ => true
-	     | Word_notb _ => true
-	     | Word_orb _ => true
-	     | Word_rol _ => true
-	     | Word_ror _ => true
-	     | Word_rshift _ => true
-	     | Word_sub _ => true
-	     | Word_toWord _ => true
-	     | Word_toWordX _ => true
-	     | Word_xorb _ => true
-	     | _ => false
-	 end
-
-      fun x86CodegenImplements n =
-	 let
-	    datatype z = datatype IntSize.prim
-	    datatype z = datatype RealSize.t
-	    datatype z = datatype WordSize.prim
-	    fun i32168 s =
-	       case IntSize.prim s of
-		  I8 => true
-		| I16 => true
-		| I32 => true
-		| I64 => false
-	    fun w32168 s =
-	       case WordSize.prim s of
-		  W8 => true
-		| W16 => true
-		| W32 => true
-		| W64 => false
-	 in
-	    case n of
-	       FFI_Symbol _ => true
-	     | Int_addCheck _ => true
-	     | Int_ge s => i32168 s
-	     | Int_gt s => i32168 s
-	     | Int_le s => i32168 s
-	     | Int_lt s => i32168 s
-	     | Int_mul s => i32168 s
-	     | Int_mulCheck s => i32168 s
-	     | Int_negCheck _ => true
-	     | Int_quot s => i32168 s
-	     | Int_rem s => i32168 s
-	     | Int_subCheck _ => true
-	     | Int_toReal (s1, s2) =>
-		  (case (IntSize.prim s1, s2) of
-		      (I32, R64) => true
-		    | (I32, R32) => true
-		    | (I16, R64) => true
-		    | (I16, R32) => true
-		    | (I8, R64) => true
-		    | (I8, R32) => true
-		    | _ => false)
-	      | Real_Math_acos _ => true
-	      | Real_Math_asin _ => true
-	      | Real_Math_atan _ => true
-	      | Real_Math_atan2 _ => true
-	      | Real_Math_cos _ => true
-	      | Real_Math_exp _ => true
-	      | Real_Math_ln _ => true
-	      | Real_Math_log10 _ => true
-	      | Real_Math_sin _ => true
-	      | Real_Math_sqrt _ => true
-	      | Real_Math_tan _ => true
-	      | Real_abs _ => true
-	      | Real_add _ => true
-	      | Real_div _ => true
-	      | Real_equal _ => true
-	      | Real_ge _ => true
-	      | Real_gt _ => true
-	      | Real_ldexp _ => true
-	      | Real_le _ => true
-	      | Real_lt _ => true
-	      | Real_mul _ => true
-	      | Real_muladd _ => true
-	      | Real_mulsub _ => true
-	      | Real_neg _ => true
-	      | Real_qequal _ => true
-	      | Real_round _ => true
-	      | Real_sub _ => true
-	      | Real_toInt (s1, s2) =>
-		   (case (s1, IntSize.prim s2) of
-		       (R64, I32) => true
-		     | (R64, I16) => true
-		     | (R64, I8) => true
-		     | (R32, I32) => true
-		     | (R32, I16) => true
-		     | (R32, I8) => true
-		     | _ => false)
-	      | Real_toReal _ => true
-	      | Word_add _ => true
-	      | Word_addCheck _ => true
-	      | Word_andb _ => true
-	      | Word_arshift s => w32168 s
-	      | Word_div s => w32168 s
-	      | Word_equal s => w32168 s
-	      | Word_ge s => w32168 s
-	      | Word_gt s => w32168 s
-	      | Word_le s => w32168 s
-	      | Word_lshift s => w32168 s
-	      | Word_lt s => w32168 s
-	      | Word_mod s => w32168 s
-	      | Word_mul s => w32168 s
-	      | Word_mulCheck s => w32168 s
-	      | Word_neg _ => true
-	      | Word_notb _ => true
-	      | Word_orb _ => true
-	      | Word_rol s => w32168 s
-	      | Word_ror s => w32168 s
-	      | Word_rshift s => w32168 s
-	      | Word_sub _ => true
-	      | Word_toWord (s1, s2) =>
-		   (case (WordSize.prim s1, WordSize.prim s2) of
-		       (W32, W32) => true
-		     | (W32, W16) => true
-		     | (W32, W8) => true
-		     | (W16, W32) => true
-		     | (W16, W16) => true
-		     | (W16, W8) => true
-		     | (W8, W32) => true
-		     | (W8, W16) => true
-		     | (W8, W8) => true
-		     | _ => false)
-	      | Word_toWordX (s1, s2) =>
-		   (case (WordSize.prim s1, WordSize.prim s2) of
-		       (W32, W32) => true
-		     | (W32, W16) => true
-		     | (W32, W8) => true
-		     | (W16, W32) => true
-		     | (W16, W16) => true
-		     | (W16, W8) => true
-		     | (W8, W32) => true
-		     | (W8, W16) => true
-		     | (W8, W8) => true
-		     | _ => false)
-	      | Word_xorb _ => true
-	      | _ => false
-	 end
-
-      val x86CodegenImplements: t -> bool =
-	 Trace.trace ("x86CodegenImplements", layout, Bool.layout)
-	 x86CodegenImplements
    end
 
 datatype z = datatype Operand.t
@@ -564,7 +342,8 @@
 					    (!Control.cardSizeLog2),
 					    WordSize.default)))),
 		dst = SOME (index, indexTy),
-		prim = Prim.wordRshift WordSize.default},
+		prim = Prim.wordRshift (WordSize.default,
+					{signed = false})},
        Move {dst = (ArrayOffset
 		    {base = Runtime GCField.CardMap,
 		     index = Var {ty = indexTy, var = index},
@@ -619,40 +398,14 @@
       datatype z = datatype Const.t
    in
       case c of
-	 Int i =>
-	    let
-	       val s = IntX.size i
-	       val s' = IntSize.roundUpToPrim s
-	       val i =
-		  if IntSize.equals (s, s')
-		     then i
-		  else
-		     (* Represent a twos-complement s-bit integer in a
-		      * twos-complement s'-bit integer.  If the integer is
-		      * negative, to get the right bits, we need to make it
-		      * positive.
-		      *)
-		     let
-			val i' = IntX.toIntInf i
-			val i' =
-			   if i' >= 0
-			      then i'
-			   else
-			      i' - IntInf.<< (~1, Bits.toWord (IntSize.bits s))
-		     in
-			IntX.make (i', s')
-		     end
-	    in
-	       Int i
-	    end
-       | Word w => Word (WordX.resize (w, WordSize.roundUpToPrim (WordX.size w)))
+	 Word w => Word (WordX.resize (w, WordSize.roundUpToPrim (WordX.size w)))
        | _ => c
    end
 
 val word = Type.word o WordSize.bits
 
-fun convert (program as S.Program.T {functions, globals, main, ...})
-   : Rssa.Program.t =
+fun convert (program as S.Program.T {functions, globals, main, ...},
+	     {codegenImplementsPrim}): Rssa.Program.t =
    let
       val {conApp, diagnostic, genCase, objectTypes, reff, select, toRtype,
 	   tuple} =
@@ -705,52 +458,40 @@
 			  cases: S.Cases.t,
 			  default: Label.t option})
 	 : Statement.t list * Transfer.t =
-	 let
-	    fun simple (s, cs) =
+	 case cases of
+	    S.Cases.Con cases =>
+	       (case (Vector.length cases, default) of
+		   (0, NONE) => ([], Transfer.bug)
+		 | _ => 
+		      let
+			 val (tycon, tys) = S.Type.tyconArgs (varType test)
+		      in
+			 if Vector.isEmpty tys
+			    then
+			       let
+				  val test = fn () => varOp test
+				  val (ss, t, blocks) =
+				     genCase {cases = cases,
+					      default = default,
+					      test = test,
+					      tycon = tycon}
+				  val () =
+				     extraBlocks := blocks @ !extraBlocks
+			       in
+				  (ss, t)
+			       end
+			 else Error.bug "strange type in case"
+		      end)
+	  | S.Cases.Word (s, cs) =>
 	       ([],
 		Switch
 		(Switch.T
 		 {cases = (QuickSort.sortVector
-			   (cs, fn ((w, _), (w', _)) => WordX.<= (w, w'))),
+			   (cs, fn ((w, _), (w', _)) =>
+			    WordX.le (w, w', {signed = false}))),
 		  default = default,
 		  size = s,
 		  test = varOp test}))
-	 in
-	    case cases of
-	       S.Cases.Con cases =>
-		  (case (Vector.length cases, default) of
-		      (0, NONE) => ([], Transfer.bug)
-		    | _ => 
-			 let
-			    val (tycon, tys) = S.Type.tyconArgs (varType test)
-			 in
-			    if Vector.isEmpty tys
-			       then
-				  let
-				     val test = fn () => varOp test
-				     val (ss, t, blocks) =
-					genCase {cases = cases,
-						 default = default,
-						 test = test,
-						 tycon = tycon}
-				     val () =
-					extraBlocks := blocks @ !extraBlocks
-				  in
-				     (ss, t)
-				  end
-			    else Error.bug "strange type in case"
-			 end)
-	     | S.Cases.Int (s, cs) =>
-		  let
-		     val s = WordSize.fromBits (IntSize.bits s)
-		     val cs = Vector.map (cs, fn (i, l) =>
-					  (WordX.fromIntInf (IntX.toIntInf i, s),
-					   l))
-		  in
-		     simple (s, cs)
-		  end
-	     | S.Cases.Word (s, cs) => simple (s, cs)
-	 end
       val {get = labelInfo: (Label.t ->
 			     {args: (Var.t * S.Type.t) vector,
 			      cont: (Handler.t * Label.t) list ref,
@@ -916,7 +657,8 @@
 	 in
 	    case Type.dest t of
 	       Constant w => c (Const.word w)
-	     | Pointer _ => Cast (Operand.int (IntX.one IntSize.default), t)
+	     | Pointer _ =>
+		  Cast (Operand.word (WordX.one (WordSize.pointer ())), t)
 	     | Real s => c (Const.real (RealX.zero s))
 	     | Sum ts => bogus (Vector.sub (ts, 0))
 	     | Word s => c (Const.word (WordX.zero (WordSize.fromBits s)))
@@ -936,7 +678,7 @@
 		  then (Vector.fromList ss, t)
 	       else
 		  let
-		     val S.Statement.T {exp, ty, var} =
+		     val s as S.Statement.T {exp, ty, var} =
 			Vector.sub (statements, i)
 		     fun none () = loop (i - 1, ss, t)
 		     fun add s = loop (i - 1, s :: ss, t)
@@ -985,7 +727,7 @@
 				 move (Offset
 				       {base = a 0,
 					offset = Runtime.arrayLengthOffset,
-					ty = Type.defaultInt})
+					ty = Type.defaultWord})
 			      fun sub (ty: Type.t) =
 				 let
 				    val base = a 0
@@ -1137,13 +879,11 @@
 			in
 			   loop (i - 1, ss, t)
 			end
-		     fun nativeOrC (p: Prim.t) =
+		     fun codegenOrC (p: Prim.t) =
 			let
 			   val n = Prim.name p
 			in
-			   if if !Control.Native.native
-				 then Name.x86CodegenImplements n
-			      else Name.cCodegenImplements n
+			   if codegenImplementsPrim p
 			      then primApp p
 			   else (case Name.cFunction n of
 				    NONE =>
@@ -1151,22 +891,6 @@
 							  Name.toString n])
 				  | SOME f => simpleCCall f)
 			end
-		     fun wordToWord (s1: WordSize.t, s2: WordSize.t) =
-			if WordSize.equals (s1, s2)
-			   then move (a 0)
-			else nativeOrC (Prim.wordToWord (s1, s2))
-		     fun wordToWordX (s1: WordSize.t, s2: WordSize.t) =
-			if WordSize.equals (s1, s2)
-			   then move (a 0)
-			else
-			   let
-			      val p = 
-				 if Bits.< (WordSize.bits s1, WordSize.bits s2)
-				    then Prim.wordToWordX
-				 else Prim.wordToWord
-			   in
-			      nativeOrC (p (s1, s2))
-			   end
 		     datatype z = datatype Prim.Name.t
 			   in
 			      case Prim.name prim of
@@ -1219,8 +943,7 @@
 				    ccall
 				    {args = (Vector.new5
 					     (GCState,
-					      Operand.int (IntX.zero
-							   IntSize.default),
+					      Operand.zero WordSize.default,
 					      Operand.bool true,
 					      File,
 					      Line)),
@@ -1232,33 +955,6 @@
 			       | GC_unpack =>
 				    ccall {args = Vector.new1 GCState,
 					   func = CFunction.unpack}
-			       | Int_add s =>
-				    nativeOrC (Prim.wordAdd
-					       (intSizeToWordSize s))
-			       | Int_arshift s =>
-				    nativeOrC (Prim.wordArshift
-					       (intSizeToWordSize s))
-			       | Int_equal s =>
-				    nativeOrC (Prim.wordEqual
-					       (intSizeToWordSize
-						(IntSize.roundUpToPrim s)))
-			       | Int_lshift s =>
-				    nativeOrC (Prim.wordLshift
-					       (intSizeToWordSize s))
-			       | Int_neg s =>
-				    nativeOrC (Prim.wordNeg
-					       (intSizeToWordSize s))
-			       | Int_sub s =>
-				    nativeOrC (Prim.wordSub
-					       (intSizeToWordSize s))
-			       | Int_toInt (s1, s2) =>
-				    wordToWordX
-				    (intSizeToWordSize
-				     (IntSize.roundUpToPrim s1),
-				     intSizeToWordSize
-				     (IntSize.roundUpToPrim s2))
-			       | Int_toWord (s1, s2) =>
-				    wordToWordX (intSizeToWordSize s1, s2)
 			       | IntInf_toVector => cast ()
 			       | IntInf_toWord => cast ()
 			       | MLton_bogus =>
@@ -1269,7 +965,7 @@
 				    (case targ () of
 					NONE => move (Operand.bool true)
 				      | SOME t =>
-					   nativeOrC
+					   codegenOrC
 					   (Prim.wordEqual
 					    (WordSize.fromBits (Type.width t))))
 			       | MLton_installSignalHandler => none ()
@@ -1277,14 +973,12 @@
 				    simpleCCall
 				    (CFunction.size (Operand.ty (a 0)))
 			       | MLton_touch => none ()
-			       | Pointer_getInt s => pointerGet (Type.int s)
 			       | Pointer_getPointer =>
 				    (case targ () of
 					NONE => Error.bug "getPointer"
 				      | SOME t => pointerGet t)
 			       | Pointer_getReal s => pointerGet (Type.real s)
 			       | Pointer_getWord s => pointerGet (word s)
-			       | Pointer_setInt s => pointerSet (Type.int s)
 			       | Pointer_setPointer =>
 				    (case targ () of
 					NONE => Error.bug "setPointer"
@@ -1385,8 +1079,7 @@
 					val args = 
 					   Vector.new5
 					   (GCState,
-					    Operand.int (IntX.zero
-							 IntSize.default),
+					    Operand.zero WordSize.default,
 					    Operand.bool false,
 					    File,
 					    Line)
@@ -1472,16 +1165,30 @@
 				     end,
 				     none)
 			       | Word_equal s =>
-				    nativeOrC (Prim.wordEqual
+				    codegenOrC (Prim.wordEqual
 					       (WordSize.roundUpToPrim s))
-			       | Word_toInt (s1, s2) =>
-				    wordToWord (s1, intSizeToWordSize s2)
-			       | Word_toIntX (s1, s2) =>
-				    wordToWordX (s1, intSizeToWordSize s2)
-			       | Word_toIntInf => move (a 0)
-			       | Word_toWord (s1, s2) =>
-				    wordToWord (WordSize.roundUpToPrim s1,
-						WordSize.roundUpToPrim s2)
+			       | Word_toIntInf => cast ()
+			       | Word_toWord (s1, s2, {signed}) =>
+				    if WordSize.equals (s1, s2)
+				       then move (a 0)
+				    else
+				       let
+					  val signed =
+					     signed
+					     andalso Bits.< (WordSize.bits s1,
+							     WordSize.bits s2)
+					  val b1 = WordSize.bits s1
+					  val b2 = WordSize.bits s2
+					  val s1 = WordSize.roundUpToPrim s1
+					  val s2 = WordSize.roundUpToPrim s2
+				       in
+					  if WordSize.equals (s1, s2)
+					     then cast ()
+					  else
+					     codegenOrC
+					     (Prim.wordToWord
+					      (s1, s2, {signed = signed}))
+				       end
 			       | WordVector_toIntInf => move (a 0)
 			       | Word8Array_subWord => subWord ()
 			       | Word8Array_updateWord =>
@@ -1496,7 +1203,7 @@
 						   (GCState,
 						    Vector.sub (vos args, 0))),
 					   func = CFunction.worldSave}
-			       | _ => nativeOrC prim
+			       | _ => codegenOrC prim
 			   end
 		      | S.Exp.Profile e => add (Statement.Profile e)
 		      | S.Exp.Select {tuple, offset} =>



1.11      +4 -1      mlton/mlton/backend/ssa-to-rssa.sig

Index: ssa-to-rssa.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/ssa-to-rssa.sig,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- ssa-to-rssa.sig	28 Apr 2004 03:17:05 -0000	1.10
+++ ssa-to-rssa.sig	1 May 2004 00:49:35 -0000	1.11
@@ -24,5 +24,8 @@
    sig
       include SSA_TO_RSSA_STRUCTS
 	 
-      val convert: Ssa.Program.t -> Rssa.Program.t
+      val convert:
+	 Ssa.Program.t
+	 * {codegenImplementsPrim: Rssa.Type.t Rssa.Prim.t -> bool}
+	 -> Rssa.Program.t
    end



1.8       +2 -1      mlton/mlton/backend/switch.fun

Index: switch.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/switch.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- switch.fun	23 Apr 2004 06:15:56 -0000	1.7
+++ switch.fun	1 May 2004 00:49:35 -0000	1.8
@@ -59,7 +59,8 @@
       andalso (case default of
 		  NONE => true
 		| SOME l => labelIsOk l)
-      andalso Vector.isSorted (cases, fn ((w, _), (w', _)) => WordX.<= (w, w'))
+      andalso Vector.isSorted (cases, fn ((w, _), (w', _)) =>
+			       WordX.le (w, w', {signed = false}))
       andalso not (isRedundant
 		   {cases = cases,
 		    equals = fn ((w, _), (w', _)) => WordX.equals (w, w')})



1.35      +2 -4      mlton/mlton/closure-convert/closure-convert.fun

Index: closure-convert.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/closure-convert/closure-convert.fun,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- closure-convert.fun	12 Apr 2004 17:52:59 -0000	1.34
+++ closure-convert.fun	1 May 2004 00:49:36 -0000	1.35
@@ -798,7 +798,6 @@
 			       end)
 			in (finish cases, ac)
 			end
-		     fun doit (l, f) = doCases (l, f, fn i => fn e => (i, e))
 		     val (cases, ac) =
 			case cases of
 			   Scases.Con cases =>
@@ -817,10 +816,9 @@
 					      body = body,
 					      con = con}
 			       end)
-			 | Scases.Int (s, cs) =>
-			      doit (cs, fn cs => Dexp.Int (s, cs))
 			 | Scases.Word (s, cs) =>
-			      doit (cs, fn cs => Dexp.Word (s, cs))
+			      doCases (cs, fn cs => Dexp.Word (s, cs),
+				       fn i => fn e => (i, e))
 		  in (Dexp.casee
 		      {test = convertVarExp test,
 		       ty = ty, cases = cases, default = default},



1.79      +66 -44    mlton/mlton/codegen/c-codegen/c-codegen.fun

Index: c-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/c-codegen/c-codegen.fun,v
retrieving revision 1.78
retrieving revision 1.79
diff -u -r1.78 -r1.79
--- c-codegen.fun	13 Apr 2004 15:40:19 -0000	1.78
+++ c-codegen.fun	1 May 2004 00:49:36 -0000	1.79
@@ -23,7 +23,6 @@
    structure FrameInfo = FrameInfo
    structure Global = Global
    structure IntSize = IntSize
-   structure IntX = IntX
    structure Kind = Kind
    structure Label = Label
    structure ObjectType = ObjectType
@@ -93,34 +92,6 @@
 
 val traceGotoLabel = Trace.trace ("gotoLabel", Label.layout, Unit.layout) 
 
-structure IntX =
-   struct
-      open IntX
-	 
-      fun toC (i: t): string =
-	 let
-	    fun isPos () = i >= zero (size i)
-	    fun neg () = concat ["-", String.dropPrefix (toString i, 1)]
-	    fun simple s =
-	       concat ["(Int", s, ")",
-		       if isPos () then toString i else neg ()]
-	    (* tricky writes min as a word to avoid a gcc warning. *)
-	    fun tricky min =
-	       if isPos ()
-		  then toString i
-	       else if IntX.isMin i
-		       then min
-		    else neg ()
-	    datatype z = datatype IntSize.prim
-	 in
-	    case IntSize.prim (size i) of
-	       I8 => simple "8"
-	     | I16 => simple "16"
-	     | I32 => tricky ("0x80000000")
-	     | I64 => concat [tricky "0x8000000000000000", "ll"]
-	 end
-   end
-
 structure RealX =
    struct
       open RealX
@@ -182,7 +153,9 @@
 	  ; print ";\n")
 
       fun int (i: int) =
-	 IntX.toC (IntX.make (IntInf.fromInt i, IntSize.default))
+	 if i >= 0
+	    then Int.toString i
+	 else concat ["-", Int.toString (~ i)]
 
       val bytes = int o Bytes.toInt
 
@@ -211,6 +184,64 @@
 	  | _ => false
    end
 
+fun implementsPrim (p: 'a Prim.t): bool =
+   let
+      datatype z = datatype Prim.Name.t
+   in
+      case Prim.name p of
+	 FFI_Symbol _ => true
+       | Real_Math_acos _ => true
+       | Real_Math_asin _ => true
+       | Real_Math_atan _ => true
+       | Real_Math_atan2 _ => true
+       | Real_Math_cos _ => true
+       | Real_Math_exp _ => true
+       | Real_Math_ln _ => true
+       | Real_Math_log10 _ => true
+       | Real_Math_sin _ => true
+       | Real_Math_sqrt _ => true
+       | Real_Math_tan _ => true
+       | Real_add _ => true
+       | Real_div _ => true
+       | Real_equal _ => true
+       | Real_ge _ => true
+       | Real_gt _ => true
+       | Real_ldexp _ => true
+       | Real_le _ => true
+       | Real_lt _ => true
+       | Real_mul _ => true
+       | Real_muladd _ => true
+       | Real_mulsub _ => true
+       | Real_neg _ => true
+       | Real_round _ => true
+       | Real_sub _ => true
+       | Real_toReal _ => true
+       | Real_toWord _ => true
+       | Thread_returnToC => true
+       | Word_add _ => true
+       | Word_andb _ => true
+       | Word_equal _ => true
+       | Word_ge _ => true
+       | Word_gt _ => true
+       | Word_le _ => true
+       | Word_lshift _ => true
+       | Word_lt _ => true
+       | Word_mul _ => true
+       | Word_neg _ => true
+       | Word_notb _ => true
+       | Word_orb _ => true
+       | Word_quot (_, {signed}) => not signed
+       | Word_rem (_, {signed}) => not signed
+       | Word_rol _ => true
+       | Word_ror _ => true
+       | Word_rshift _ => true
+       | Word_sub _ => true
+       | Word_toReal _ => true
+       | Word_toWord _ => true
+       | Word_xorb _ => true
+       | _ => false
+   end
+
 fun creturn (t: Type.t): string =
    concat ["CReturn", CType.name (Type.toCType t)]
 
@@ -551,7 +582,6 @@
 				  C.args [Type.toC (Global.ty g),
 					  Int.toString (Global.index g)]]
 		  else concat ["GPNR", C.args [Int.toString (Global.index g)]]
-	     | Int i => IntX.toC i
 	     | Label l => labelToStringIndex l
 	     | Line => "__LINE__"
 	     | Offset {base, offset, ty} =>
@@ -918,36 +948,28 @@
 				 datatype z = datatype Prim.Name.t
 				 fun const i =
 				    case Vector.sub (args, i) of
-				       Operand.Int _ => true
+				       Operand.Word _ => true
 				     | _ => false
 				 fun const0 () = const 0
 				 fun const1 () = const 1
 			      in
 				 case Prim.name prim of
-				    Int_addCheck _ =>
-				       concat [Prim.toString prim,
-					       if const0 ()
-						  then "CX"
-					       else if const1 ()
-						       then "XC"
-						    else ""]
-				  | Int_mulCheck _ => Prim.toString prim
-				  | Int_negCheck _ => Prim.toString prim
-				  | Int_subCheck _ =>
+				    Word_addCheck _ =>
 				       concat [Prim.toString prim,
 					       if const0 ()
 						  then "CX"
 					       else if const1 ()
 						       then "XC"
 						    else ""]
-				  | Word_addCheck _ =>
+				  | Word_mulCheck _ => Prim.toString prim
+				  | Word_negCheck _ => Prim.toString prim
+				  | Word_subCheck _ =>
 				       concat [Prim.toString prim,
 					       if const0 ()
 						  then "CX"
 					       else if const1 ()
 						       then "XC"
 						    else ""]
-				  | Word_mulCheck _ => Prim.toString prim
 				  | _ => Error.bug "strange overflow prim"
 			      end
 			   val _ = force overflow



1.12      +1 -0      mlton/mlton/codegen/c-codegen/c-codegen.sig

Index: c-codegen.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/c-codegen/c-codegen.sig,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- c-codegen.sig	4 Apr 2004 06:50:18 -0000	1.11
+++ c-codegen.sig	1 May 2004 00:49:36 -0000	1.12
@@ -16,6 +16,7 @@
    sig
       include C_CODEGEN_STRUCTS
 
+      val implementsPrim: 'a Machine.Prim.t -> bool
       val output: {program: Machine.Program.t,
 		   outputC: unit -> {file: File.t,
 				     print: string -> unit,



1.55      +2 -0      mlton/mlton/codegen/x86-codegen/x86-codegen.fun

Index: x86-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-codegen.fun,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -r1.54 -r1.55
--- x86-codegen.fun	25 Apr 2004 06:55:45 -0000	1.54
+++ x86-codegen.fun	1 May 2004 00:49:38 -0000	1.55
@@ -33,6 +33,8 @@
     = x86MLton (structure x86MLtonBasic = x86MLtonBasic
 		structure x86Liveness = x86Liveness)
 
+  val implementsPrim = x86MLton.implementsPrim
+    
   structure x86Translate 
     = x86Translate (structure x86 = x86
 		    structure x86MLton = x86MLton



1.11      +11 -11    mlton/mlton/codegen/x86-codegen/x86-codegen.sig

Index: x86-codegen.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-codegen.sig,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- x86-codegen.sig	4 Apr 2004 06:50:19 -0000	1.10
+++ x86-codegen.sig	1 May 2004 00:49:38 -0000	1.11
@@ -13,16 +13,16 @@
    end
 
 signature X86_CODEGEN =
-  sig
-    include X86_CODEGEN_STRUCTS
+   sig
+      include X86_CODEGEN_STRUCTS
 
-    val output: {program: Machine.Program.t,
-                 outputC: unit -> {file: File.t,
-				   print: string -> unit,
-				   done: unit -> unit},
-                 outputS: unit -> {file: File.t,
-				   print: string -> unit,
-				   done: unit -> unit}}
-                -> unit
-  end
+      val implementsPrim: Machine.Type.t Machine.Prim.t -> bool
+      val output: {program: Machine.Program.t,
+		   outputC: unit -> {file: File.t,
+				     print: string -> unit,
+				     done: unit -> unit},
+		   outputS: unit -> {file: File.t,
+				     print: string -> unit,
+				     done: unit -> unit}} -> unit
+   end
 



1.60      +312 -313  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.59
retrieving revision 1.60
diff -u -r1.59 -r1.60
--- x86-mlton.fun	25 Apr 2004 22:02:50 -0000	1.59
+++ x86-mlton.fun	1 May 2004 00:49:39 -0000	1.60
@@ -1,11 +1,12 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 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.
  *)
-functor x86MLton(S: X86_MLTON_STRUCTS): X86_MLTON =
+
+functor x86MLton (S: X86_MLTON_STRUCTS): X86_MLTON =
 struct
 
   open S
@@ -16,9 +17,9 @@
   in
      structure CFunction = CFunction
      structure IntSize = IntSize
+     structure RealSize = RealSize
      structure Prim = Prim
      structure WordSize = WordSize
-     datatype z = datatype IntSize.prim
      datatype z = datatype RealSize.t
      datatype z = datatype WordSize.prim
   end
@@ -29,6 +30,108 @@
 		    live: x86.Label.t -> x86.Operand.t list,
 		    liveInfo: x86Liveness.LiveInfo.t}
 
+  fun implementsPrim (p: 'a Prim.t) =
+     let
+	datatype z = datatype IntSize.prim
+	datatype z = datatype RealSize.t
+	datatype z = datatype WordSize.prim
+	fun w32168 s =
+	   case WordSize.prim s of
+	      W8 => true
+	    | W16 => true
+	    | W32 => true
+	    | W64 => false
+	datatype z = datatype Prim.Name.t
+     in
+	case Prim.name p of
+	   FFI_Symbol _ => true
+	 | Real_Math_acos _ => true
+	 | Real_Math_asin _ => true
+	 | Real_Math_atan _ => true
+	 | Real_Math_atan2 _ => true
+	 | Real_Math_cos _ => true
+	 | Real_Math_exp _ => true
+	 | Real_Math_ln _ => true
+	 | Real_Math_log10 _ => true
+	 | Real_Math_sin _ => true
+	 | Real_Math_sqrt _ => true
+	 | Real_Math_tan _ => true
+	 | Real_abs _ => true
+	 | Real_add _ => true
+	 | Real_div _ => true
+	 | Real_equal _ => true
+	 | Real_ge _ => true
+	 | Real_gt _ => true
+	 | Real_ldexp _ => true
+	 | Real_le _ => true
+	 | Real_lt _ => true
+	 | Real_mul _ => true
+	 | Real_muladd _ => true
+	 | Real_mulsub _ => true
+	 | Real_neg _ => true
+	 | Real_qequal _ => true
+	 | Real_round _ => true
+	 | Real_sub _ => true
+	 | Real_toReal _ => true
+	 | Real_toWord (s1, s2, {signed}) =>
+	      signed
+	      andalso (case (s1, WordSize.prim s2) of
+			  (R64, W32) => true
+			| (R64, W16) => true
+			| (R64, W8) => true
+			| (R32, W32) => true
+			| (R32, W16) => true
+			| (R32, W8) => true
+			| _ => false)
+	 | Word_add _ => true
+	 | Word_addCheck _ => true
+	 | Word_andb _ => true
+	 | Word_equal s => w32168 s
+	 | Word_ge (s, _) => w32168 s
+	 | Word_gt (s, _) => w32168 s
+	 | Word_le (s, _) => w32168 s
+	 | Word_lshift s => w32168 s
+	 | Word_lt (s, _) => w32168 s
+	 | Word_mul (s, _) => w32168 s
+	 | Word_mulCheck (s, _) => w32168 s
+	 | Word_neg _ => true
+	 | Word_notb _ => true
+	 | Word_orb _ => true
+	 | Word_quot (s, _) => w32168 s
+	 | Word_rem (s, _) => w32168 s
+	 | Word_rol s => w32168 s
+	 | Word_ror s => w32168 s
+	 | Word_rshift (s, _) => w32168 s
+	 | Word_sub _ => true
+	 | Word_toReal (s1, s2, {signed}) =>
+	      signed
+	      andalso (case (WordSize.prim s1, s2) of
+			  (W32, R64) => true
+			| (W32, R32) => true
+			| (W16, R64) => true
+			| (W16, R32) => true
+			| (W8, R64) => true
+			| (W8, R32) => true
+			| _ => false)
+	 | Word_toWord (s1, s2, _) =>
+	      (case (WordSize.prim s1, WordSize.prim s2) of
+		  (W32, W32) => true
+		| (W32, W16) => true
+		| (W32, W8) => true
+		| (W16, W32) => true
+		| (W16, W16) => true
+		| (W16, W8) => true
+		| (W8, W32) => true
+		| (W8, W16) => true
+		| (W8, W8) => true
+		| _ => false)
+	 | Word_xorb _ => true
+	 | _ => false
+     end
+
+  val implementsPrim: Machine.Type.t Prim.t -> bool =
+     Trace.trace ("implementsPrim", Prim.layout, Bool.layout) implementsPrim
+
   fun prim {prim : RepType.t Prim.t,
 	    args : (Operand.t * Size.t) vector,
 	    dsts : (Operand.t * Size.t) vector,
@@ -575,6 +678,28 @@
 			transfer = NONE}))
 		   end
 	      else (AppendList.empty,AppendList.empty)
+	fun bitop (size, i) =
+	   case WordSize.prim size of
+	      W8 => binal i
+	    | W16 => binal i
+	    | W32 => binal i
+	    | W64 => binal64 (i, i)
+	fun compare (size, {signed}, s, u) =
+	   let
+	      val f = if signed then s else u
+	   in
+	      case WordSize.prim size of
+		 W8 => cmp f
+	       | W16 => cmp f
+	       | W32 => cmp f
+	       | W64 => Error.bug "FIXME"
+	   end
+	fun shift (size, i) =
+	   case WordSize.prim size of
+	      W8 => sral i
+	    | W16 => sral i
+	    | W32 => sral i
+	    | W64 => Error.bug "FIXME"
       in
 	AppendList.appends
 	[comment_begin,
@@ -606,101 +731,6 @@
 			    | _ => Error.bug "prim: FFI"],
 		     transfer = NONE}]
 		end
-	     | Int_ge s => 	
-		(case IntSize.prim s of
-		    I8 => cmp Instruction.GE
-		  | I16 => cmp Instruction.GE
-		  | I32 => cmp Instruction.GE
-		  | I64 => Error.bug "FIXME")
-	     | Int_gt s => 
-		(case IntSize.prim s of
-		    I8 => cmp Instruction.G
-		  | I16 => cmp Instruction.G
-		  | I32 => cmp Instruction.G
-		  | I64 => Error.bug "FIXME")
-	     | Int_le s => 
-		(case IntSize.prim s of
-		    I8 => cmp Instruction.LE
-		  | I16 => cmp Instruction.LE
-		  | I32 => cmp Instruction.LE
-		  | I64 => Error.bug "FIXME")
-	     | Int_lt s =>
-		(case IntSize.prim s of
-		    I8 => cmp Instruction.L
-		  | I16 => cmp Instruction.L
-		  | I32 => cmp Instruction.L
-		  | I64 => Error.bug "FIXME")
-	     | Int_mul s =>
-		(case IntSize.prim s of
-		    I8 => pmd Instruction.IMUL
-		  | I16 => imul2 () 
-		  | I32 => imul2 ()
-		  | I64 => Error.bug "FIXME")
-	     | Int_quot s => 
-		(case IntSize.prim s of
-		    I8 => pmd Instruction.IDIV
-		  | I16 => pmd Instruction.IDIV
-		  | I32 => pmd Instruction.IDIV
-		  | I64 => Error.bug "FIXME")
-	     | Int_rem s => 
-		(case IntSize.prim s of
-		    I8 => pmd Instruction.IMOD
-		  | I16 => pmd Instruction.IMOD
-		  | I32 => pmd Instruction.IMOD
-		  | I64 => Error.bug "FIXME")
-	     | Int_toReal (s, s')
-	     => let
-		  fun default () =
-		    let
-		      val (dst,dstsize) = getDst1 ()
-		      val (src,srcsize) = getSrc1 ()
-		    in
-		      AppendList.fromList
-		      [Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [Assembly.instruction_pfmovfi
-			   {src = src,
-			    dst = dst,
-			    srcsize = srcsize,
-			    dstsize = dstsize}],
-			transfer = NONE}]
-		    end 
-		  fun default' () =
-		    let
-		      val (dst,dstsize) = getDst1 ()
-		      val (src,srcsize) = getSrc1 ()
-		      val (tmp,tmpsize) =
-			 (fildTempContentsOperand, Size.WORD)
-		    in
-		      AppendList.fromList
-		      [Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [Assembly.instruction_movx
-			   {oper = Instruction.MOVSX,
-			    src = src,
-			    dst = tmp,
-			    dstsize = tmpsize,
-			    srcsize = srcsize},
-			   Assembly.instruction_pfmovfi
-			   {src = tmp,
-			    dst = dst,
-			    srcsize = tmpsize,
-			    dstsize = dstsize}],
-			transfer = NONE}]
-		    end 
-		in
-		   case (IntSize.prim s, s') of
-		      (I64, R64) => Error.bug "FIXME"
-		    | (I64, R32) => Error.bug "FIXME"
-		    | (I32, R64) => default ()
-		    | (I32, R32) => default ()
-		    | (I16, R64) => default ()
-		    | (I16, R32) => default ()
-		    | (I8, R64) => default' ()
-		    | (I8, R32) => default' ()
-		end
 	     | Real_Math_acos _
 	     => let
 		  val (dst,dstsize) = getDst1 ()
@@ -1139,58 +1169,6 @@
 		    transfer = NONE}]
 		end
 	     | Real_abs _ => funa Instruction.FABS
-	     | Real_toInt (s, s')
-	     => let
-		  fun default () =
-		    let
-		      val (dst,dstsize) = getDst1 ()
-		      val (src,srcsize) = getSrc1 ()
-		    in
-		      AppendList.fromList
-		      [Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [Assembly.instruction_pfmovti
-			   {dst = dst,
-			    src = src,
-			    srcsize = srcsize,
-			    dstsize = dstsize}],
-			transfer = NONE}]
-		    end 
-		  fun default' () =
-		    let
-		      val (dst,dstsize) = getDst1 ()
-		      val (src,srcsize) = getSrc1 ()
-		      val (tmp,tmpsize) =
-			 (fildTempContentsOperand, Size.WORD)
-		    in
-		      AppendList.fromList
-		      [Block.mkBlock'
-		       {entry = NONE,
-			statements 
-			= [Assembly.instruction_pfmovti
-			   {dst = dst,
-			    src = src,
-			    srcsize = srcsize,
-			    dstsize = dstsize},
-			   Assembly.instruction_xvom
-			   {src = tmp,
-			    dst = dst,
-			    dstsize = dstsize,
-			    srcsize = tmpsize}],
-			transfer = NONE}]
-		    end 
-		in
-		   case (s, IntSize.prim s') of
-		      (R64, I64) => Error.bug "FIXME"
-		    | (R64, I32) => default ()
-		    | (R64, I16) => default ()
-		    | (R64, I8) => default' ()
-		    | (R32, I64) => Error.bug "FIXME"
-		    | (R32, I32) => default ()
-		    | (R32, I16) => default ()
-		    | (R32, I8) => default' ()
-		end
              | Real_toReal (s, s')
 	     => let
 		  val (dst,dstsize) = getDst1 ()
@@ -1234,6 +1212,58 @@
 		    | (R32, R64) => movx ()
 		    | (R32, R32) => mov ()
 		end 
+	     | Real_toWord (s, s', _)
+	     => let
+		  fun default () =
+		    let
+		      val (dst,dstsize) = getDst1 ()
+		      val (src,srcsize) = getSrc1 ()
+		    in
+		      AppendList.fromList
+		      [Block.mkBlock'
+		       {entry = NONE,
+			statements 
+			= [Assembly.instruction_pfmovti
+			   {dst = dst,
+			    src = src,
+			    srcsize = srcsize,
+			    dstsize = dstsize}],
+			transfer = NONE}]
+		    end 
+		  fun default' () =
+		    let
+		      val (dst,dstsize) = getDst1 ()
+		      val (src,srcsize) = getSrc1 ()
+		      val (tmp,tmpsize) =
+			 (fildTempContentsOperand, Size.WORD)
+		    in
+		      AppendList.fromList
+		      [Block.mkBlock'
+		       {entry = NONE,
+			statements 
+			= [Assembly.instruction_pfmovti
+			   {dst = dst,
+			    src = src,
+			    srcsize = srcsize,
+			    dstsize = dstsize},
+			   Assembly.instruction_xvom
+			   {src = tmp,
+			    dst = dst,
+			    dstsize = dstsize,
+			    srcsize = tmpsize}],
+			transfer = NONE}]
+		    end 
+		in
+		   case (s, WordSize.prim s') of
+		      (R64, W64) => Error.bug "FIXME"
+		    | (R64, W32) => default ()
+		    | (R64, W16) => default ()
+		    | (R64, W8) => default' ()
+		    | (R32, W64) => Error.bug "FIXME"
+		    | (R32, W32) => default ()
+		    | (R32, W16) => default ()
+		    | (R32, W8) => default' ()
+		end
 	     | Real_ldexp _ 
 	     => let
 		  val (dst,dstsize) = getDst1 ()
@@ -1277,69 +1307,18 @@
 		  | W16 => binal Instruction.ADD
 		  | W32 => binal Instruction.ADD
 		  | W64 => binal64 (Instruction.ADD, Instruction.ADC))
-	     | Word_andb s => 
-		(case WordSize.prim s of
-		    W8 => binal Instruction.AND
-		  | W16 => binal Instruction.AND
-		  | W32 => binal Instruction.AND
-		  | W64 => binal64 (Instruction.AND, Instruction.AND))
-	     | Word_arshift s => 
-		(case WordSize.prim s of
-		    W8 => sral Instruction.SAR
-		  | W16 => sral Instruction.SAR
-		  | W32 => sral Instruction.SAR
-		  | W64 => Error.bug "FIXME")
-	     | Word_div s => 
-		(case WordSize.prim s of
-		    W8 => pmd Instruction.DIV
-		  | W16 => pmd Instruction.DIV
-		  | W32 => pmd Instruction.DIV
-		  | W64 => Error.bug "FIXME")
-	     | Word_equal s => 
-		(case WordSize.prim s of
-		    W8 => cmp Instruction.E
-		  | W16 => cmp Instruction.E
-		  | W32 => cmp Instruction.E
-		  | W64 => Error.bug "FIXME")
-	     | Word_ge s => 
-		(case WordSize.prim s of
-		    W8 => cmp Instruction.AE
-		  | W16 => cmp Instruction.AE
-		  | W32 => cmp Instruction.AE
-		  | W64 => Error.bug "FIXME")
-	     | Word_gt s => 
-		(case WordSize.prim s of
-		    W8 => cmp Instruction.A
-		  | W16 => cmp Instruction.A
-		  | W32 => cmp Instruction.A
-		  | W64 => Error.bug "FIXME")
-	     | Word_le s => 
-		(case WordSize.prim s of
-		    W8 => cmp Instruction.BE
-		  | W16 => cmp Instruction.BE
-		  | W32 => cmp Instruction.BE
-		  | W64 => Error.bug "FIXME")
-	     | Word_lshift s => 
-		(case WordSize.prim s of
-		    W8 => sral Instruction.SHL
-		  | W16 => sral Instruction.SHL
-		  | W32 => sral Instruction.SHL
-		  | W64 => Error.bug "FIXME")
-	     | Word_lt s => 
-		(case WordSize.prim s of
-		    W8 => cmp Instruction.B
-		  | W16 => cmp Instruction.B
-		  | W32 => cmp Instruction.B
-		  | W64 => Error.bug "FIXME")
-	     | Word_mod s => 
-		(case WordSize.prim s of
-		    W8 => pmd Instruction.MOD
-		  | W16 => pmd Instruction.MOD
-		  | W32 => pmd Instruction.MOD
-		  | W64 => Error.bug "FIXME")
-	     | Word_mul s =>
+	     | Word_andb s => bitop (s, Instruction.AND)
+	     | Word_equal s => cmp Instruction.E
+	     | Word_ge (s, sg) => compare (s, sg, Instruction.GE, Instruction.AE)
+	     | Word_gt (s, sg) => compare (s, sg, Instruction.G, Instruction.A)
+	     | Word_le (s, sg) => compare (s, sg, Instruction.LE, Instruction.BE)
+	     | Word_lshift s => shift (s, Instruction.SHL)
+	     | Word_lt (s, sg) => compare (s, sg, Instruction.L, Instruction.B)
+	     | Word_mul (s, {signed}) =>
 		(case WordSize.prim s of
-		    W8 => pmd Instruction.MUL
+		    W8 => pmd (if signed
+				  then Instruction.IMUL
+			       else Instruction.MUL)
 		  | W16 => imul2 ()
 		  | W32 => imul2 ()
 		  | W64 => Error.bug "FIXME")
@@ -1360,78 +1339,87 @@
 		  | W16 => unal Instruction.NOT
 		  | W32 => unal Instruction.NOT
 		  | W64 => unal64 (Instruction.NOT, fn _ => []))
-	     | Word_orb s => 
-		(case WordSize.prim s of
-		    W8 => binal Instruction.OR
-		  | W16 => binal Instruction.OR
-		  | W32 => binal Instruction.OR
-		  | W64 => binal64 (Instruction.OR, Instruction.OR))
-	     | Word_rol s => 
-		(case WordSize.prim s of
-		    W8 => sral Instruction.ROL
-		  | W16 => sral Instruction.ROL
-		  | W32 => sral Instruction.ROL
-		  | W64 => Error.bug "FIXME")
-	     | Word_ror s => 
-		(case WordSize.prim s of
-		    W8 => sral Instruction.ROR
-		  | W16 => sral Instruction.ROR
-		  | W32 => sral Instruction.ROR
-		  | W64 => Error.bug "FIXME")
-	     | Word_rshift s => 
-		(case WordSize.prim s of
-		    W8 => sral Instruction.SHR
-		  | W16 => sral Instruction.SHR
-		  | W32 => sral Instruction.SHR
-		  | W64 => Error.bug "FIXME")
+	     | Word_orb s => bitop (s, Instruction.OR)
+	     | Word_quot (s, {signed}) =>
+		  pmd (if signed then Instruction.IDIV else Instruction.DIV)
+	     | Word_rem (s, {signed}) =>
+		  pmd (if signed then Instruction.IMOD else Instruction.MOD)
+	     | Word_rol s => shift (s, Instruction.ROL)
+	     | Word_ror s => shift (s, Instruction.ROR)
+	     | Word_rshift (s, {signed}) =>
+		  shift (s, if signed then Instruction.SAR else Instruction.SHR)
 	     | Word_sub s => 
 		(case WordSize.prim s of
 		    W8 => binal Instruction.SUB
 		  | W16 => binal Instruction.SUB
 		  | W32 => binal Instruction.SUB
 		  | W64 => binal64 (Instruction.SUB, Instruction.SBB))
-	     | Word_toWord (s, s') =>
-	        (case (WordSize.prim s, WordSize.prim s') of
-		    (W64, W64) => Error.bug "FIXME"
-		  | (W64, W32) => Error.bug "FIXME"
-		  | (W64, W16) => Error.bug "FIXME"
-		  | (W64, W8) => Error.bug "FIXME"
-		  | (W32, W64) => Error.bug "FIXME"
-		  | (W32, W32) => mov ()
-		  | (W32, W16) => xvom ()
-		  | (W32, W8) => xvom ()
-		  | (W16, W64) => Error.bug "FIXME"
-		  | (W16, W32) => movx Instruction.MOVZX
-		  | (W16, W16) => mov ()
-		  | (W16, W8) => xvom ()
-		  | (W8, W64) => Error.bug "FIXME"
-		  | (W8, W32) => movx Instruction.MOVZX
-		  | (W8, W16) => movx Instruction.MOVZX
-		  | (W8, W8) => mov ())
-	     | Word_toWordX (s, s') =>
-		(case (WordSize.prim s, WordSize.prim s') of
-		    (W64, W64) => Error.bug "FIXME"
-		  | (W64, W32) => Error.bug "FIXME"
-		  | (W64, W16) => Error.bug "FIXME"
-		  | (W64, W8) => Error.bug "FIXME"
-		  | (W32, W64) => Error.bug "FIXME"
-		  | (W32, W32) => mov ()
-		  | (W32, W16) => xvom ()
-		  | (W32, W8) => xvom ()
-		  | (W16, W64) => Error.bug "FIXME"
-		  | (W16, W32) => movx Instruction.MOVSX
-		  | (W16, W16) => mov ()
-		  | (W16, W8) => xvom ()
-		  | (W8, W64) => Error.bug "FIXME"
-		  | (W8, W32) => movx Instruction.MOVSX
-		  | (W8, W16) => movx Instruction.MOVSX
-		  | (W8, W8) => mov ())
-	     | Word_xorb s => 
-		(case WordSize.prim s of
-		    W8 => binal Instruction.XOR
-		  | W16 => binal Instruction.XOR
-		  | W32 => binal Instruction.XOR
-		  | W64 => binal64 (Instruction.XOR, Instruction.XOR))
+	     | Word_toReal (s, s', {signed})
+	     => let
+		  fun default () =
+		    let
+		      val (dst,dstsize) = getDst1 ()
+		      val (src,srcsize) = getSrc1 ()
+		    in
+		      AppendList.fromList
+		      [Block.mkBlock'
+		       {entry = NONE,
+			statements 
+			= [Assembly.instruction_pfmovfi
+			   {src = src,
+			    dst = dst,
+			    srcsize = srcsize,
+			    dstsize = dstsize}],
+			transfer = NONE}]
+		    end 
+		  fun default' () =
+		    let
+		      val (dst,dstsize) = getDst1 ()
+		      val (src,srcsize) = getSrc1 ()
+		      val (tmp,tmpsize) =
+			 (fildTempContentsOperand, Size.WORD)
+		    in
+		      AppendList.fromList
+		      [Block.mkBlock'
+		       {entry = NONE,
+			statements 
+			= [Assembly.instruction_movx
+			   {oper = Instruction.MOVSX,
+			    src = src,
+			    dst = tmp,
+			    dstsize = tmpsize,
+			    srcsize = srcsize},
+			   Assembly.instruction_pfmovfi
+			   {src = tmp,
+			    dst = dst,
+			    srcsize = tmpsize,
+			    dstsize = dstsize}],
+			transfer = NONE}]
+		    end 
+		in
+		   case (WordSize.prim s, s') of
+		      (W32, R64) => default ()
+		    | (W32, R32) => default ()
+		    | (W16, R64) => default ()
+		    | (W16, R32) => default ()
+		    | (W8, R64) => default' ()
+		    | (W8, R32) => default' ()
+		    | _ => Error.bug "FIXME"
+		end
+	     | Word_toWord (s, s', {signed}) =>
+		  let
+		     val b = WordSize.bits s
+		     val b' = WordSize.bits s'
+		  in
+		     if Bits.< (b, b')
+			then movx (if signed
+				      then Instruction.MOVSX
+				   else Instruction.MOVZX)
+		     else if Bits.equals (b, b')
+			     then mov ()
+			  else xvom ()
+		  end
+	     | Word_xorb s => bitop (s, Instruction.XOR)
 	     | _ => Error.bug ("prim: strange Prim.Name.t: " ^ primName)),
 	 comment_end]
       end
@@ -1778,46 +1766,57 @@
 			transfer = NONE}))
 		   end
 	      else (AppendList.empty,AppendList.empty)
+	fun flag {signed} =
+	   if signed then x86.Instruction.O else x86.Instruction.C
       in
 	AppendList.appends
 	[comment_begin,
 	 (case Prim.name prim of
-	     Int_addCheck s => 
-	       (case IntSize.prim s of
-		  I8 => binal (x86.Instruction.ADD, x86.Instruction.O)
-		| I16 => binal (x86.Instruction.ADD, x86.Instruction.O)
-		| I32 => binal (x86.Instruction.ADD, x86.Instruction.O)
-		| I64 => binal64 (x86.Instruction.ADD, x86.Instruction.ADC, x86.Instruction.O))
-	   | Int_subCheck s => 
-	       (case IntSize.prim s of
-		  I8 => binal (x86.Instruction.SUB, x86.Instruction.O)
-		| I16 => binal (x86.Instruction.SUB, x86.Instruction.O)
-		| I32 => binal (x86.Instruction.SUB, x86.Instruction.O)
-		| I64 => binal64 (x86.Instruction.SUB, x86.Instruction.SBB, x86.Instruction.O))
-	   | Int_mulCheck s => 	
-	       (case IntSize.prim s of
-		  I8 => pmd (x86.Instruction.IMUL, x86.Instruction.O)
-		| I16 => imul2 x86.Instruction.O
-		| I32 => imul2 x86.Instruction.O
-		| I64 => Error.bug "FIXME")
-	   | Int_negCheck s => 
-	       (case IntSize.prim s of
-		  I8 => unal (x86.Instruction.NEG, x86.Instruction.O)
-		| I16 => unal (x86.Instruction.NEG, x86.Instruction.O)
-		| I32 => unal (x86.Instruction.NEG, x86.Instruction.O)
-		| I64 => neg64 ())
-	   | Word_addCheck s => 
-	       (case WordSize.prim s of
-		   W8 => binal (x86.Instruction.ADD, x86.Instruction.C)
-		 | W16 => binal (x86.Instruction.ADD, x86.Instruction.C)
-		 | W32 => binal (x86.Instruction.ADD, x86.Instruction.C)
-		 | W64 => binal64 (x86.Instruction.ADD, x86.Instruction.ADC, x86.Instruction.C))
-	   | Word_mulCheck s => 
+	     Word_addCheck (s, sg) =>
+		let
+		   val flag = flag sg
+		in
+		   case WordSize.prim s of
+		      W8 => binal (x86.Instruction.ADD, flag)
+		    | W16 => binal (x86.Instruction.ADD, flag)
+		    | W32 => binal (x86.Instruction.ADD, flag)
+		    | W64 =>
+			 binal64 (x86.Instruction.ADD, x86.Instruction.ADC, flag)
+		end
+	   | Word_mulCheck (s, {signed}) =>
+		let
+		in
+		   if signed
+		      then
+			 (case WordSize.prim s of
+			     W8 => pmd (x86.Instruction.IMUL, x86.Instruction.O)
+			   | W16 => imul2 x86.Instruction.O
+			   | W32 => imul2 x86.Instruction.O
+			   | W64 => Error.bug "FIXME")
+		   else
+		      (case WordSize.prim 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)
+			| W64 => Error.bug "FIXME")
+		end
+	   | Word_negCheck s => 
 	       (case WordSize.prim 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)
-		| W64 => Error.bug "FIXME")
+		  W8 => unal (x86.Instruction.NEG, x86.Instruction.O)
+		| W16 => unal (x86.Instruction.NEG, x86.Instruction.O)
+		| W32 => unal (x86.Instruction.NEG, x86.Instruction.O)
+		| W64 => neg64 ())
+	   | Word_subCheck (s, {signed}) =>
+		let
+		   val flag =
+		      if signed then x86.Instruction.O else x86.Instruction.C
+		in
+		   case WordSize.prim s of
+		      W8 => binal (x86.Instruction.SUB, flag)
+		    | W16 => binal (x86.Instruction.SUB, flag)
+		    | W32 => binal (x86.Instruction.SUB, flag)
+		    | W64 => binal64 (x86.Instruction.SUB, x86.Instruction.SBB, flag)
+		end
 	   | _ => Error.bug ("arith: strange Prim.Name.t: " ^ primName))]
       end
 



1.18      +2 -1      mlton/mlton/codegen/x86-codegen/x86-mlton.sig

Index: x86-mlton.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton.sig,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- x86-mlton.sig	12 Apr 2004 17:53:01 -0000	1.17
+++ x86-mlton.sig	1 May 2004 00:49:39 -0000	1.18
@@ -44,7 +44,8 @@
 		  func: RepType.t Machine.CFunction.t,
 		  label: x86.Label.t, 
 		  transInfo: transInfo} -> x86.Block.t' AppendList.t
-    val prim: {prim: RepType.t Machine.Prim.t,
+  val implementsPrim: RepType.t Machine.Prim.t -> bool
+  val prim: {prim: RepType.t Machine.Prim.t,
 	       args: (x86.Operand.t * x86.Size.t) vector,
 	       dsts: (x86.Operand.t * x86.Size.t) vector,
 	       transInfo: transInfo} -> x86.Block.t' AppendList.t



1.58      +0 -81     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.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- x86-translate.fun	13 Apr 2004 15:40:19 -0000	1.57
+++ x86-translate.fun	1 May 2004 00:49:39 -0000	1.58
@@ -22,8 +22,6 @@
   local
      open Machine
   in
-     structure IntSize = IntSize
-     structure IntX = IntX
      structure Label = Label
      structure Register = Register
      structure Type = Type
@@ -163,85 +161,6 @@
 	       Vector.new1 (x86.Operand.label x86MLton.gcState_label,
 			    x86MLton.pointerSize)
 	  | Global g => Global.toX86Operand g
-	  | Int i =>
-	       let
-		  val i'' = fn () => x86.Operand.immediate_const_int (IntX.toInt i)
-		  datatype z = datatype IntSize.prim
-	       in
-		  case IntSize.prim (IntX.size i) of
-		     I8 => Vector.new1 (i'' (), x86.Size.BYTE)
-		   | I16 => Vector.new1 (i'' (), x86.Size.WORD)
-		   | I32 => Vector.new1 (i'' (), x86.Size.LONG)
-		   | I64 => let
-			       fun convert1 (ii: IntInf.t): Word.t * Word.t =
-				  let
-				     val lo = Word.fromIntInf ii
-				     val ii = IntInf.~>> (ii, 0w32)
-				     val hi = Word.fromIntInf ii
-				  in
-				     (lo, hi)
-				  end
-			       fun convert2 (ii: IntInf.t): Word.t * Word.t =
-				  let
-				     fun finish (iis: String.t, c: Char.t) =
-					let
-					   val s =
-					      String.concat
-					      [String.tabulate
-					       (16 - String.size iis, fn _ => c),
-					       iis]
-					   fun cvt s = valOf (Word.fromString s)
-					   val lo = cvt(String.extract(s, 8, SOME 8))
-					   val hi = cvt(String.extract(s, 0, SOME 8))
-					in
-					   (lo, hi)
-					end
-				  in
-				     if ii < 0
-					then let
-						val ii = ~ ii - 1
-						val iis =
-						   String.translate
-						   (IntInf.format (ii, StringCvt.HEX),
-						    fn #"0" => "F"
-						     | #"1" => "E"
-						     | #"2" => "D"
-						     | #"3" => "C"
-						     | #"4" => "B"
-						     | #"5" => "A"
-						     | #"6" => "9"
-						     | #"7" => "8"
-						     | #"8" => "7"
-						     | #"9" => "6"
-						     | #"A" => "5"
-						     | #"B" => "4"
-						     | #"C" => "3"
-						     | #"D" => "2"
-						     | #"E" => "1"
-						     | #"F" => "0"
-						     | #"a" => "5"
-						     | #"b" => "4"
-						     | #"c" => "3"
-						     | #"d" => "2"
-						     | #"e" => "1"
-						     | #"f" => "0"
-						     | _ => "")
-					     in
-						finish (iis, #"F")
-					     end
-					else finish (IntInf.format (ii, StringCvt.HEX), #"0")
-				  end
-			       val ii = IntX.toIntInf i
-			       val (lo, hi) = 
-				 if MLton.isMLton 
-				   then convert1 ii
-				   else convert2 ii
-			    in
-			       Vector.new2
-			       ((x86.Operand.immediate_const_word lo, x86.Size.LONG),
-				(x86.Operand.immediate_const_word hi, x86.Size.LONG))
-			    end
-	       end
 	  | Label l => 
 	       Vector.new1 (x86.Operand.immediate_label l, x86MLton.pointerSize)
 	  | Line => 



1.17      +7 -7      mlton/mlton/defunctorize/defunctorize.fun

Index: defunctorize.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/defunctorize/defunctorize.fun,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- defunctorize.fun	12 Apr 2004 17:53:04 -0000	1.16
+++ defunctorize.fun	1 May 2004 00:49:41 -0000	1.17
@@ -14,9 +14,10 @@
    structure Prim = Prim
    structure Record = Record
    structure Ctype = Type
+   structure WordSize = WordSize
+   structure WordX = WordX
 end
 
-structure IntX = Const.IntX
 structure Field = Record.Field
 
 local
@@ -55,7 +56,6 @@
 
 		       open Xcases
 		       type t = exp t
-		       val int = Int
 		       val word = Word
 		       fun con v =
 			  Con (Vector.map
@@ -761,8 +761,8 @@
 			if Xtype.equals (ty, Xtype.bool)
 			   then
 			      (case c of
-				  Const.Int i =>
-				     if 0 = IntX.toInt i
+				  Const.Word w =>
+				     if WordX.isZero w
 					then Xexp.falsee ()
 				     else Xexp.truee ()
 				| _ => Error.bug "strange boolean constant")
@@ -809,10 +809,10 @@
 			datatype z = datatype Prim.Name.t
 		     in
 			if (case Prim.name prim of
-			       Char_toWord8 => true
-			     | String_toWord8Vector => true
-			     | Word8_toChar => true
+			       String_toWord8Vector => true
 			     | Word8Vector_toString => true
+			     | Word_toWord (s1, s2, _) =>
+				  WordSize.equals (s1, s2)
 			     | _ => false)
 			   then Vector.sub (args, 0)
 			else



1.2       +1 -1      mlton/mlton/elaborate/const-type.sig

Index: const-type.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/const-type.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- const-type.sig	9 Oct 2003 18:17:33 -0000	1.1
+++ const-type.sig	1 May 2004 00:49:45 -0000	1.2
@@ -1,6 +1,6 @@
 signature CONST_TYPE =
    sig
-      datatype t = Bool | Int | Real | String | Word
+      datatype t = Bool | Real | String | Word
 
       val toString: t -> string
    end



1.101     +10 -7     mlton/mlton/elaborate/elaborate-core.fun

Index: elaborate-core.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-core.fun,v
retrieving revision 1.100
retrieving revision 1.101
diff -u -r1.100 -r1.101
--- elaborate-core.fun	13 Apr 2004 03:36:40 -0000	1.100
+++ elaborate-core.fun	1 May 2004 00:49:45 -0000	1.101
@@ -70,7 +70,6 @@
    structure Cexp = Exp
    structure Ffi = Ffi
    structure IntSize = IntSize
-   structure IntX = IntX
    structure Lambda = Lambda
    structure Cpat = Pat
    structure Prim = Prim
@@ -187,6 +186,9 @@
 		 expandOpaque = false,
 		 var = fn _ => NONE}
 
+val typeTycon =
+   Trace.trace ("typeTycon", Type.layout, Option.layout Tycon.layout) typeTycon
+
 fun 'a elabConst (c: Aconst.t,
 		  make: (unit -> Const.t) * Type.t -> 'a,
 		  {false = f: 'a, true = t: 'a}): 'a =
@@ -238,10 +240,11 @@
 		if Tycon.equals (tycon, Tycon.intInf)
 		   then Const.IntInf i
 		else
-		   choose (tycon, IntSize.all, Tycon.int, fn s =>
-			   Const.Int
-			   (IntX.make (i, s)
-			    handle Overflow => (error ty; IntX.zero s))))
+		   choose (tycon, WordSize.all, Tycon.word, fn s =>
+			   Const.Word
+			   (if WordSize.isInRange (s, i, {signed = true})
+			       then WordX.fromIntInf (i, s)
+			    else (error ty; WordX.zero s))))
 	    end
        | Aconst.Real r =>
 	    let
@@ -263,7 +266,7 @@
 	       (ty, fn tycon =>
 		choose (tycon, WordSize.all, Tycon.word, fn s =>
 			Const.Word
-			(if w <= WordSize.max s
+			(if WordSize.isInRange (s, w, {signed = false})
 			    then WordX.fromIntInf (w, s)
 			 else (error ty
 			       ; WordX.zero s))))
@@ -2089,7 +2092,7 @@
 					if Tycon.equals (c, Tycon.bool)
 					   then ConstType.Bool
 					else if Tycon.isIntX c
-						then ConstType.Int
+						then ConstType.Word
 					else if Tycon.isRealX c
 						then ConstType.Real
 					else if Tycon.isWordX c



1.26      +1 -2      mlton/mlton/elaborate/elaborate.fun

Index: elaborate.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate.fun,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- elaborate.fun	18 Mar 2004 03:22:25 -0000	1.25
+++ elaborate.fun	1 May 2004 00:49:46 -0000	1.26
@@ -42,11 +42,10 @@
 
 structure ConstType =
    struct
-      datatype t = Bool | Int | Real | String | Word
+      datatype t = Bool | Real | String | Word
 
       val toString =
 	 fn Bool => "Bool"
-	  | Int => "Int"
 	  | Real => "Real"
 	  | String => "String"
 	  | Word => "Word"



1.39      +35 -15    mlton/mlton/elaborate/type-env.fun

Index: type-env.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/type-env.fun,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- type-env.fun	13 Apr 2004 03:36:42 -0000	1.38
+++ type-env.fun	1 May 2004 00:49:46 -0000	1.39
@@ -1217,12 +1217,28 @@
 
       val word8 = word WordSize.byte
 
-      val synonyms =
-	 List.map
+      local
+	 val {get: Tycon.t -> (t * Tycon.t) option, set, ...} =
+	    Property.getSetOnce (Tycon.plist, Property.initConst NONE)
+      in
+	 fun setSynonym (c, c') = set (c, SOME (con (c, Vector.new0 ()), c'))
+	 val synonym = get
+      end
+
+      val () =
+	 List.foreach
 	 ([(Tycon.char, Tycon.word WordSize.byte),
 	   (Tycon.preThread, Tycon.thread)],
-	  fn (c, c') => (c, c', con (c, Vector.new0 ())))
+	  setSynonym)
+
+      val () =
+	 List.foreach
+	 (IntSize.all, fn s =>
+	  setSynonym (Tycon.int s,
+		      Tycon.word (WordSize.fromBits (IntSize.bits s))))
 
+      val defaultInt = con (Tycon.int IntSize.default, Vector.new0 ())
+	 
       fun 'a simpleHom {con: t * Tycon.t * 'a vector -> 'a,
 			expandOpaque: bool,
 			record: t * (Field.t * 'a) vector -> 'a,
@@ -1255,6 +1271,19 @@
 			      (spine, fields, fields, fn (f, ac) =>
 			       (f, unit) :: ac))
 	    fun recursive _ = Error.bug "Type.hom recursive"
+	    val con =
+	       if not replaceSynonyms
+		  then con
+	       else
+		  fn (t, c, ts) =>
+		  let
+		     val (t, c) =
+			case synonym c of
+			   NONE => (t, c)
+			 | SOME (t, c) => (t, c)
+		  in
+		     con (t, c, ts)
+		  end
 	    fun default (t, tycon) =
 	       fn t' =>
 	       let
@@ -1263,18 +1292,9 @@
 	       in
 		  con (t, tycon, Vector.new0 ())
 	       end
-	    val int = default (int IntSize.default, Tycon.defaultInt)
-	    val real = default (real RealSize.default, Tycon.defaultReal)
-	    val word = default (word WordSize.default, Tycon.defaultWord)
-	    val con =
-	       if not replaceSynonyms
-		  then con
-	       else
-		  fn (t, c, ts) =>
-		  case List.peek (synonyms, fn (c', _, _) =>
-				  Tycon.equals (c, c')) of
-		     NONE => con (t, c, ts)
-		   | SOME (_, c, t) => con (t, c, Vector.new0 ())
+	    val int = default (defaultInt, Tycon.defaultInt)
+	    val real = default (defaultReal, Tycon.defaultReal)
+	    val word = default (defaultWord, Tycon.defaultWord)
 	 in
 	    makeHom {con = con,
 		     expandOpaque = expandOpaque,



1.21      +1 -1      mlton/mlton/elaborate/type-env.sig

Index: type-env.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/type-env.sig,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- type-env.sig	12 Apr 2004 22:01:36 -0000	1.20
+++ type-env.sig	1 May 2004 00:49:46 -0000	1.21
@@ -55,7 +55,7 @@
 	    val unresolvedWord: unit -> t
 	    val var: Tyvar.t -> t
 	 end
-      sharing type Type.intSize = IntSize.t
+(*      sharing type Type.intSize = IntSize.t *)
       sharing type Type.realSize = RealSize.t
       sharing type Type.wordSize = WordSize.t
       sharing type Type.tycon = Tycon.t



1.30      +11 -5     mlton/mlton/main/compile.fun

Index: compile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/compile.fun,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- compile.fun	4 Apr 2004 06:50:21 -0000	1.29
+++ compile.fun	1 May 2004 00:49:47 -0000	1.30
@@ -45,7 +45,7 @@
 in
    structure Const = Const
    structure Ffi = Ffi
-   structure IntX = IntX
+   structure WordX = WordX
 end
 structure TypeEnv = TypeEnv (Atoms)
 structure CoreML = CoreML (open Atoms
@@ -292,7 +292,7 @@
    
 val lookupConstant =
    let
-      val zero = Const.int (IntX.make (0, IntSize.default))
+      val zero = Const.word (WordX.fromIntInf (0, WordSize.default))
       val f =
 	 Promise.lazy
 	 (fn () =>
@@ -506,8 +506,8 @@
       val _ =
 	 let
 	    fun get (s: string): Bytes.t =
-	       case lookupConstant (s, ConstType.Int) of
-		  Const.Int i => Bytes.fromInt (IntX.toInt i)
+	       case lookupConstant (s, ConstType.Word) of
+		  Const.Word w => Bytes.fromInt (WordX.toInt w)
 		| _ => Error.bug "GC_state offset must be an int"
 	 in
 	    Runtime.GCField.setOffsets
@@ -580,12 +580,18 @@
 				 Layouts Ssa.Program.layouts)
 	    else ()
 	 end
+      val codegenImplementsPrim =
+	 if !Control.Native.native
+	    then x86Codegen.implementsPrim
+	 else CCodegen.implementsPrim
       val machine =
 	 Control.pass
 	 {name = "backend",
 	  suffix = "machine",
 	  style = Control.No,
-	  thunk = fn () => Backend.toMachine ssa,
+	  thunk = fn () => (Backend.toMachine
+			    (ssa,
+			     {codegenImplementsPrim = codegenImplementsPrim})),
 	  display = Control.Layouts Machine.Program.layouts}
       val _ =
 	 let



1.5       +5 -11     mlton/mlton/main/lookup-constant.fun

Index: lookup-constant.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/lookup-constant.fun,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- lookup-constant.fun	5 Mar 2004 03:50:55 -0000	1.4
+++ lookup-constant.fun	1 May 2004 00:49:47 -0000	1.5
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -12,11 +12,9 @@
 local
    open Const
 in
-   structure IntX = IntX
    structure RealX = RealX
    structure WordX = WordX
 end
-structure IntSize = IntX.IntSize
 structure RealSize = RealX.RealSize
 structure WordSize = WordX.WordSize
 
@@ -84,7 +82,7 @@
    List.map (gcFields, fn s =>
 	     {name = s,
 	      value = concat ["offsetof (struct GC_state, ", s, ")"],
-	      ty = ConstType.Int})
+	      ty = ConstType.Word})
 
 fun build (constants, out) =
    let
@@ -109,7 +107,6 @@
 	    val (format, value) =
 	       case ty of
 		  Bool => ("%s", concat [value, "? \"true\" : \"false\""])
-		| Int => ("%d", value)
 		| Real => ("%.20f", value)
 		| String => ("%s", concat ["\"", escape value, "\""])
 		| Word => ("%u", value)
@@ -152,17 +149,14 @@
  	       (table, String.hash name,
  		fn {name = name', ...} => name = name',
  		fn () => Error.bug (concat ["constant not found: ", name]))
-	    fun int i = Const.int (IntX.make (i, IntSize.default))
 	 in
 	    case ty of
 	       Bool =>
 		  (case Bool.fromString value of
 		      NONE => Error.bug "strange Bool constant"
-		    | SOME b => int (if b then 1 else 0))
-	     | Int => 
-		  (case IntInf.fromString value of
-		      NONE => Error.bug "strange Int constant"
-		    | SOME i => int i)
+		    | SOME b =>
+			 Const.Word (WordX.fromIntInf
+				     (if b then 1 else 0, WordSize.default)))
 	     | Real =>
 		  (case RealX.make (value, RealSize.default) of
 		      NONE => Error.bug "strange Real constant"



1.160     +1 -0      mlton/mlton/main/main.sml

Index: main.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.sml,v
retrieving revision 1.159
retrieving revision 1.160
diff -u -r1.159 -r1.160
--- main.sml	7 Nov 2003 23:02:33 -0000	1.159
+++ main.sml	1 May 2004 00:49:47 -0000	1.160
@@ -6,4 +6,5 @@
    in
       debug := Out Out.error
       ; flagged ()
+      ; on []
    end



1.11      +13 -32    mlton/mlton/match-compile/match-compile.fun

Index: match-compile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/match-compile/match-compile.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- match-compile.fun	4 Apr 2004 06:50:21 -0000	1.10
+++ match-compile.fun	1 May 2004 00:49:47 -0000	1.11
@@ -142,18 +142,13 @@
 		       (get const, finish (Const.layout const,
 					   Vector.fromList infos))))))
 in
-   val directCases = 
-      make (List.remove (IntSize.all, fn s =>
-			 IntSize.equals (s, IntSize.I (Bits.fromInt 64))),
-	    IntSize.cardinality, Type.int, Cases.int,
-	    fn Const.Int i => i
-	     | _ => Error.bug "caseInt type error")
-      @ make (List.remove (WordSize.all, fn s =>
-			   WordSize.equals
-			   (s, WordSize.fromBits (Bits.fromInt 64))),
-	      WordSize.cardinality, Type.word, Cases.word,
-	      fn Const.Word w => w
-	       | _ => Error.bug "caseWord type error")
+   val directCases =
+      make (List.remove (WordSize.all, fn s =>
+			 WordSize.equals
+			 (s, WordSize.fromBits (Bits.fromInt 64))),
+	    WordSize.cardinality, Type.word, Cases.word,
+	    fn Const.Word w => w
+	     | _ => Error.bug "caseWord type error")
 end
 
 (* unhandledConst cs returns a constant (of the appropriate type) not in cs. *)
@@ -187,25 +182,7 @@
       datatype z = datatype Const.t
    in
       case c of
-	 Int i =>
-	    let
-	       val s = IntX.size i
-	       val min = IntX.toIntInf (IntX.min s)
-	       fun extract c =
-		  case c of
-		     Int i => IntX.toIntInf i
-		   | _ => Error.bug "expected Int"
-	    in
-	       search {<= = op <=,
-		       equals = op =,
-		       extract = extract,
-		       isMin = fn i => i = min,
-		       make = fn i => Const.int (IntX.make (i, s)),
-		       next = fn i => i + 1,
-		       prev = fn i => i - 1}
-
-	    end
-       | IntInf _ =>
+	 IntInf _ =>
 	    let
 	       fun extract c =
 		  case c of
@@ -678,7 +655,11 @@
 val matchCompile =
    Trace.trace
    ("matchCompile",
-    fn {cases, ...} => Vector.layout (NestedPat.layout o #1) cases,
+    fn {caseType, cases, test, testType, ...} =>
+    Layout.record [("caseType", Type.layout caseType),
+		   ("cases", Vector.layout (NestedPat.layout o #1) cases),
+		   ("test", Var.layout test),
+		   ("testType", Type.layout testType)],
     Exp.layout o #1)
    matchCompile
    



1.6       +0 -2      mlton/mlton/match-compile/match-compile.sig

Index: match-compile.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/match-compile/match-compile.sig,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- match-compile.sig	28 Apr 2004 03:17:06 -0000	1.5
+++ match-compile.sig	1 May 2004 00:49:47 -0000	1.6
@@ -17,7 +17,6 @@
 
 	    val deTuple: t -> t vector
 	    val equals: t * t -> bool
-	    val int: IntSize.t -> t
 	    val layout: t -> Layout.t
 	    val unit: t
 	    val word: WordSize.t -> t
@@ -31,7 +30,6 @@
 		      targs: Type.t vector,
 		      arg: (Var.t * Type.t) option,
 		      rhs: exp} vector -> t
-	    val int: IntSize.t * (IntX.t * exp) vector -> t
 	    val word: WordSize.t * (WordX.t * exp) vector -> t
 	 end
       structure Exp:



1.24      +2 -3      mlton/mlton/ssa/analyze.fun

Index: analyze.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/analyze.fun,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- analyze.fun	20 Feb 2004 02:11:15 -0000	1.23
+++ analyze.fun	1 May 2004 00:49:47 -0000	1.24
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -14,7 +14,7 @@
    
 fun 'a analyze
    {coerce, conApp, const,
-    filter, filterInt, filterWord,
+    filter, filterWord,
     fromType, layout, primApp,
     program = Program.T {main, globals, functions, ...},
     select, tuple, useFromTypeOnBinds} =
@@ -140,7 +140,6 @@
 			Con cases =>
 			   Vector.foreach (cases, fn (c, j) =>
 					   filter (test, c, labelValues j))
-		      | Int (s, cs) => doit (s, cs, filterInt)
 		      | Word (s, cs) => doit (s, cs, filterWord)
 		  val _ = Option.app (default, ensureNullary)
 	       in ()



1.13      +0 -1      mlton/mlton/ssa/analyze.sig

Index: analyze.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/analyze.sig,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- analyze.sig	12 Apr 2004 17:53:05 -0000	1.12
+++ analyze.sig	1 May 2004 00:49:47 -0000	1.13
@@ -23,7 +23,6 @@
 		   con: Con.t} -> 'a,
 	  const: Const.t -> 'a,
 	  filter: 'a * Con.t * 'a vector -> unit,
-	  filterInt: 'a * IntSize.t -> unit,
 	  filterWord: 'a * WordSize.t -> unit,
 	  fromType: Type.t -> 'a,
 	  layout: 'a -> Layout.t,



1.25      +1 -3      mlton/mlton/ssa/common-subexp.fun

Index: common-subexp.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/common-subexp.fun,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- common-subexp.fun	18 Feb 2004 04:24:10 -0000	1.24
+++ common-subexp.fun	1 May 2004 00:49:47 -0000	1.25
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -206,9 +206,7 @@
 					      Array_array => knownLength (arg ())
 					    | Array_length => length ()
 					    | Array_toVector => conv ()
-					    | String_toWord8Vector => conv ()
 					    | Vector_length => length ()
-					    | Word8Vector_toString => conv ()
 					    | _ => if Prim.isFunctional prim
 						      then doit ()
 						   else keep ()



1.19      +13 -12    mlton/mlton/ssa/constant-propagation.fun

Index: constant-propagation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/constant-propagation.fun,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- constant-propagation.fun	18 Feb 2004 04:24:10 -0000	1.18
+++ constant-propagation.fun	1 May 2004 00:49:47 -0000	1.19
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -384,7 +384,7 @@
 		    in new (Const c', Type.ofConst c)
 		    end
 
-      val zero = IntSize.memoize (fn s => const (S.Const.int (IntX.zero s)))
+      val zero = WordSize.memoize (fn s => const (S.Const.word (WordX.zero s)))
 
       fun constToEltLength (c, err) =
 	 let
@@ -402,8 +402,8 @@
 			    else const' (Const.unknown (), Type.word8)
 			 end
 	    val n =
-	       const (Sconst.Int (IntX.make
-				  (IntInf.fromInt n, IntSize.default)))
+	       const (Sconst.Word (WordX.fromIntInf (IntInf.fromInt n,
+						     WordSize.default)))
 	 in
 	    {elt = x, length = n}
 	 end
@@ -480,13 +480,13 @@
 		  (case Type.dest t of
 		      Type.Array t => Array {birth = arrayBirth (),
 					     elt = loop t,
-					     length = loop Type.defaultInt}
+					     length = loop Type.defaultWord}
 		    | Type.Datatype _ => Datatype (data ())
 		    | Type.Ref t => Ref {arg = loop t,
 					 birth = refBirth ()}
 		    | Type.Tuple ts => Tuple (Vector.map (ts, loop))
 		    | Type.Vector t => Vector {elt = loop t,
-					       length = loop Type.defaultInt}
+					       length = loop Type.defaultWord}
 		    | Type.Weak t => Weak (loop t)
 		    | _ => Const (const ()), 
 		   t)
@@ -622,12 +622,14 @@
 	     else
 	        let 
 		   fun error () = 
-		      Error.bug ("strange coerce:" ^
-				 " from: " ^ (Layout.toString (Value.layout from)) ^
-				 " to: " ^ (Layout.toString (Value.layout to)))
+		      Error.bug
+		      (concat ["strange coerce: from: ",
+			       Layout.toString (Value.layout from),
+			       " to: ", Layout.toString (Value.layout to)])
 		in
 		  case (value from, value to) of
-		     (Const from, Const to) => Const.coerce {from = from, to = to}
+		     (Const from, Const to) =>
+			Const.coerce {from = from, to = to}
 		   | (Datatype from, Datatype to) =>
 		        coerceData {from = from, to = to}
 		   | (Ref {birth, arg}, Ref {birth = b', arg = a'}) =>
@@ -754,7 +756,7 @@
 	       case Prim.name prim of
 		  Array_array => array (arg 0, bear ())
 		| Array_array0Const =>
-		     array (zero IntSize.default, Birth.here ())
+		     array (zero WordSize.default, Birth.here ())
 		| Array_length => arrayLength (arg 0)
 		| Array_sub => dearray (arg 0)
 		| Array_toVector => vectorFromArray (arg 0)
@@ -815,7 +817,6 @@
 		  conApp = conApp,
 		  const = Value.const,
 		  filter = filter,
-		  filterInt = filterIgnore,
 		  filterWord = filterIgnore,
 		  fromType = Value.fromType,
 		  layout = Value.layout,



1.18      +2 -6      mlton/mlton/ssa/direct-exp.fun

Index: direct-exp.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/direct-exp.fun,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- direct-exp.fun	12 Apr 2004 17:53:05 -0000	1.17
+++ direct-exp.fun	1 May 2004 00:49:47 -0000	1.18
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -63,7 +63,6 @@
    Con of {con: Con.t,
 	   args: (Var.t * Type.t) vector,
 	   body: t} vector
- | Int of IntSize.t * (IntX.t * t) vector
  | Word of WordSize.t * (WordX.t * t) vector
 
 val arith = Arith
@@ -80,6 +79,7 @@
 val raisee = Raise
 val select = Select
 val seq = Seq
+val word = Const o Const.word
 
 fun tuple (r as {exps, ...}) =
    if 1 = Vector.length exps
@@ -111,8 +111,6 @@
    val falsee = make Con.falsee
 end
 
-val int = const o Const.int
-   
 fun eq (e1, e2, ty) =
    primApp {prim = Prim.eq,
 	    targs = Vector.new1 ty,
@@ -157,7 +155,6 @@
 				    (seq [Con.layout con,
 					  Vector.layout (Var.layout o #1) args],
 				     body))
-			 | Int (_, v) => simple (v, IntX.layout)
 			 | Word (_, v) => simple (v, WordX.layout)
 		     end,
 			case default of
@@ -433,7 +430,6 @@
 				     (v, fn {con, args, body} =>
 				      (con,
 				       newLabel (args, body, h, k))))
-			       | Int (s, v) => Cases.Int (s, doit v)
 			       | Word (s, v) => Cases.Word (s, doit v)
 			   end}})
 	       end



1.15      +2 -3      mlton/mlton/ssa/direct-exp.sig

Index: direct-exp.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/direct-exp.sig,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- direct-exp.sig	12 Apr 2004 17:53:05 -0000	1.14
+++ direct-exp.sig	1 May 2004 00:49:47 -0000	1.15
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -24,7 +24,6 @@
 	      Con of {con: Con.t,
 		      args: (Var.t * Type.t) vector,
 		      body: t} vector
-	    | Int of IntSize.t * (IntX.t * t) vector
 	    | Word of WordSize.t * (WordX.t * t) vector
 
 	   val arith: {prim: Type.t Prim.t,
@@ -56,7 +55,6 @@
 			 ty: Type.t,
 			 catch: Var.t * Type.t,
 			 handler: t} -> t
-	   val int: IntX.t -> t
 	   val layout: t -> Layout.t
 	   val lett: {decs: {var: Var.t, exp: t} list,
 		      body: t} -> t
@@ -78,5 +76,6 @@
 	   val truee: t
 	   val tuple: {exps: t vector, ty: Type.t} -> t
 	   val var: Var.t * Type.t -> t
+	   val word: WordX.t -> t
 	end
   end



1.21      +11 -12    mlton/mlton/ssa/poly-equal.fun

Index: poly-equal.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/poly-equal.fun,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- poly-equal.fun	18 Mar 2004 03:22:25 -0000	1.20
+++ poly-equal.fun	1 May 2004 00:49:47 -0000	1.21
@@ -43,10 +43,10 @@
       open DirectExp
 
       fun add (e1: t, e2: t): t =
-	 primApp {prim = Prim.intAdd IntSize.default,
+	 primApp {prim = Prim.wordAdd WordSize.default,
 		  targs = Vector.new0 (),
 		  args = Vector.new2 (e1, e2),
-		  ty = Type.defaultInt}
+		  ty = Type.defaultWord}
 
       fun conjoin (e1: t, e2: t): t =
 	 casee {test = e1,
@@ -201,16 +201,16 @@
 			     Dexp.primApp {prim = Prim.vectorLength,
 					   targs = Vector.new1 ty,
 					   args = Vector.new1 x,
-					   ty = Type.defaultInt}
+					   ty = Type.defaultWord}
 			in
 			   Dexp.disjoin
 			   (Dexp.eq (Dexp.var v1, Dexp.var v2, vty),
 			    Dexp.conjoin
-			    (Dexp.eq (length dv1, length dv2, Type.defaultInt),
+			    (Dexp.eq (length dv1, length dv2, Type.defaultWord),
 			     Dexp.call
 			     {func = loop,
 			      args = (Vector.new4 
-				      (Dexp.int (IntX.zero IntSize.default),
+				      (Dexp.word (WordX.zero WordSize.default),
 				       length dv1, dv1, dv2)),
 			      ty = Type.bool}))
 			end
@@ -226,8 +226,8 @@
 				     start = start}
 		  end
 		  local
-		     val i = (Var.newNoname (), Type.defaultInt)
-		     val len = (Var.newNoname (), Type.defaultInt)
+		     val i = (Var.newNoname (), Type.defaultWord)
+		     val len = (Var.newNoname (), Type.defaultWord)
 		     val v1 = (Var.newNoname (), vty)
 		     val v2 = (Var.newNoname (), vty)
 		     val args = Vector.new4 (i, len, v1, v2)
@@ -245,11 +245,11 @@
 			   val args =
 			      Vector.new4 
 			      (Dexp.add
-			       (di, Dexp.int (IntX.one IntSize.default)),
+			       (di, Dexp.word (WordX.one WordSize.default)),
 			       dlen, dv1, dv2)
 			in
 			   Dexp.disjoin 
-			   (Dexp.eq (di, dlen, Type.defaultInt),
+			   (Dexp.eq (di, dlen, Type.defaultWord),
 			    Dexp.conjoin
 			    (equalExp (sub (dv1, di), sub (dv2, di), ty),
 			     Dexp.call {args = args,
@@ -292,7 +292,6 @@
 		  else Dexp.call {func = equalFunc tycon,
 				  args = Vector.new2 (dx1, dx2),
 				  ty = Type.bool}
-	     | Type.Int s => prim (Prim.intEqual s, Vector.new0 ())
 	     | Type.IntInf => if hasConstArg ()
 				 then eq ()
 			      else prim (Prim.intInfEqual, Vector.new0 ())
@@ -332,11 +331,11 @@
 	    case exp of
 	       Const c =>
 		  (case c of
-		      Const.Int _ => const ()
-		    | Const.IntInf i =>
+		      Const.IntInf i =>
 			 if Const.SmallIntInf.isSmall i
 			    then const ()
 			 else ()
+		    | Const.Word _ => const ()
 		    | _ => ())
 	     | ConApp {args, ...} =>
 		  if Vector.isEmpty args then const () else ()



1.20      +56 -48    mlton/mlton/ssa/redundant-tests.fun

Index: redundant-tests.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/redundant-tests.fun,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- redundant-tests.fun	12 Apr 2004 17:53:05 -0000	1.19
+++ redundant-tests.fun	1 May 2004 00:49:47 -0000	1.20
@@ -14,14 +14,18 @@
 
 structure Rel =
    struct
-      datatype t = EQ | LT | LE | NE
+      datatype t =
+	 EQ
+       | LT of {signed: bool}
+       | LE of {signed: bool}
+       | NE
 
       val equals: t * t -> bool = op =
 
       val toString =
 	 fn EQ => "="
-	  | LT => "<"
-	  | LE => "<="
+	  | LT _ => "<"
+	  | LE _ => "<="
 	  | NE => "<>"
 
       val layout = Layout.str o toString
@@ -67,14 +71,15 @@
 	    val rel =
 	       case rel of
 		  EQ => NE
-		| LT => LE
-		| LE => LT
+		| LT s => LE s
+		| LE s => LT s
 		| NE => EQ
 	 in
 	    T {rel = rel, lhs = rhs, rhs = lhs}
 	 end
 
       datatype result = False | True | Unknown
+	 
       fun determine (facts: t list, f: t): result =
 	 if List.contains (facts, f, equals)
 	    then True
@@ -120,17 +125,12 @@
 	    datatype z = datatype Prim.Name.t
 	 in
 	    case Prim.name prim of
-	       Int_equal _ => doit EQ
-	     | Int_ge _ => doit' LE
-	     | Int_gt _ => doit' LT
-	     | Int_le _ => doit LE
-	     | Int_lt _ => doit LT
-	     | MLton_eq => doit EQ
+	       MLton_eq => doit EQ
 	     | Word_equal _ => doit EQ
-	     | Word_ge _ => doit' LE
-	     | Word_gt _ => doit' LT
-	     | Word_le _ => doit LE
-	     | Word_lt _ => doit LT
+	     | Word_ge (_, sg) => doit' (LE sg)
+	     | Word_gt (_, sg) => doit' (LT sg)
+	     | Word_le (_, sg) => doit (LE sg)
+	     | Word_lt (_, sg) => doit (LT sg)
 	     | _ => None
 	 end
       fun setConst (x, c) = setVarInfo (x, Const c)
@@ -158,15 +158,15 @@
 	 val statements = ref []
       in
 	 val one =
-	    IntSize.memoize
+	    WordSize.memoize
 	    (fn s =>
 	     let
 		val one = Var.newNoname ()
 		val () =
 		   List.push
 		   (statements,
-		    Statement.T {exp = Exp.Const (Const.int (IntX.one s)),
-				 ty = Type.int s,
+		    Statement.T {exp = Exp.Const (Const.word (WordX.one s)),
+				 ty = Type.word s,
 				 var = SOME one})
 	     in
 		one
@@ -373,7 +373,7 @@
 		       let
 			  fun simplify (prim: Type.t Prim.t,
 					x: Var.t,
-					s: IntSize.t) =
+					s: WordSize.t) =
 			     let
 				val res = Var.newNoname ()
 			     in
@@ -384,56 +384,62 @@
 				   {exp = PrimApp {args = Vector.new2 (x, one s),
 						   prim = prim,
 						   targs = Vector.new0 ()},
-				    ty = Type.int s,
+				    ty = Type.word s,
 				    var = SOME res})],
 				 Goto {args = Vector.new1 res,
 				       dst = success})
 			     end
-			  fun add1 (x: Var.t, s: IntSize.t) =
+			  fun add1 (x: Var.t, s: WordSize.t, sg) =
 			     if isFact (label, fn Fact.T {lhs, rel, rhs} =>
 					case (lhs, rel, rhs) of
-					   (Oper.Var x', Rel.LT, _) =>
+					   (Oper.Var x', Rel.LT sg', _) =>
 					      Var.equals (x, x')
-					 | (Oper.Var x', Rel.LE, Oper.Const c) =>
+					      andalso sg = sg'
+					 | (Oper.Var x', Rel.LE sg',
+					    Oper.Const c) =>
 					      Var.equals (x, x')
+					      andalso sg = sg'
 					      andalso
 					      (case c of
-						  Const.Int i =>
-						     IntX.<
-						     (i, IntX.max (IntX.size i))
+						  Const.Word w =>
+						     WordX.lt
+						     (w, WordX.max (s, sg), sg)
 						| _ => Error.bug "strange fact")
 					 | _ => false)
-				then simplify (Prim.intAdd s, x, s)
+				then simplify (Prim.wordAdd s, x, s)
 			     else noChange
-			  fun sub1 (x: Var.t, s: IntSize.t) =
+			  fun sub1 (x: Var.t, s: WordSize.t, sg) =
 			     if isFact (label, fn Fact.T {lhs, rel, rhs} =>
 					case (lhs, rel, rhs) of
-					   (_, Rel.LT, Oper.Var x') =>
+					   (_, Rel.LT sg', Oper.Var x') =>
 					      Var.equals (x, x')
-					 | (Oper.Const c, Rel.LE, Oper.Var x') =>
+					      andalso sg = sg'
+					 | (Oper.Const c, Rel.LE sg',
+					    Oper.Var x') =>
 					      Var.equals (x, x')
+					      andalso sg = sg'
 					      andalso
 					      (case c of
-						  Const.Int i =>
-						     IntX.>
-						     (i, IntX.min (IntX.size i))
+						  Const.Word w =>
+						     WordX.gt
+						     (w, WordX.min (s, sg), sg)
 						| _ => Error.bug "strange fact")
 					 | _ => false)
-				then simplify (Prim.intSub s, x, s)
+				then simplify (Prim.wordSub s, x, s)
 			     else noChange
-			  fun add (c: Const.t, x: Var.t, s: IntSize.t) =
+			  fun add (c: Const.t, x: Var.t, (s, sg as {signed})) =
 			     case c of
-				Const.Int i =>
-				   if IntX.isOne i
-				      then add1 (x, s)
-				   else if IntX.isNegOne i
-					   then sub1 (x, s)
+				Const.Word i =>
+				   if WordX.isOne i
+				      then add1 (x, s, sg)
+				   else if signed andalso WordX.isNegOne i
+					   then sub1 (x, s, sg)
 					else noChange
 			      | _ => Error.bug "add of strange const"
 			  datatype z = datatype Prim.Name.t
 		       in
 			  case Prim.name prim of
-			     Int_addCheck s =>
+			     Word_addCheck s =>
 				let
 				   val x1 = Vector.sub (args, 0)
 				   val x2 = Vector.sub (args, 1)
@@ -444,7 +450,7 @@
 					       Const c => add (c, x1, s)
 					     | _ => noChange)
 				end
-			   | Int_subCheck s =>
+			   | Word_subCheck (s, sg as {signed}) =>
 				let
 				   val x1 = Vector.sub (args, 0)
 				   val x2 = Vector.sub (args, 1)
@@ -452,12 +458,14 @@
 				   case varInfo x2 of
 				      Const c =>
 					 (case c of
-					     Const.Int i =>
-						if IntX.isNegOne i
-						   then add1 (x1, s)
-						else if IntX.isOne i
-							then sub1 (x1, s)
-						     else noChange
+					     Const.Word w =>
+						if WordX.isOne w
+						   then sub1 (x1, s, sg)
+						else
+						   if (signed
+						       andalso WordX.isNegOne w)
+						      then add1 (x1, s, sg)
+						   else noChange
 					   | _ =>
 						Error.bug "sub of strage const")
 				    | _ => noChange



1.27      +3 -4      mlton/mlton/ssa/remove-unused.fun

Index: remove-unused.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/remove-unused.fun,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- remove-unused.fun	15 Mar 2004 02:06:26 -0000	1.26
+++ remove-unused.fun	1 May 2004 00:49:47 -0000	1.27
@@ -468,12 +468,11 @@
 	     | Case {test, cases, default}
 	     => let
 		  val _ = visitVar test
-		  fun doit l = (Vector.foreach (l, fn (_, l) => visitLabel l);
-				Option.app (default, visitLabel))
 		in
 		  case cases of
-		     Cases.Int (_, cs) => doit cs
-		   | Cases.Word (_, cs) => doit cs
+		     Cases.Word (_, cs) =>
+			(Vector.foreach (cs, visitLabel o #2)
+			 ; Option.app (default, visitLabel))
 		   | Cases.Con cases
 		     => if Vector.length cases = 0
 			  then Option.app (default, visitLabel)



1.40      +18 -54    mlton/mlton/ssa/shrink.fun

Index: shrink.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/shrink.fun,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- shrink.fun	12 Apr 2004 17:53:05 -0000	1.39
+++ shrink.fun	1 May 2004 00:49:47 -0000	1.40
@@ -918,50 +918,18 @@
 			 | SOME l => tryToEliminate (labelMeaning l))
 	       else
 		  let
-		     val m = labelMeaning (Cases.hd cases)
-		     local
-			open LabelMeaning
-		     in
-			fun usesFormal (T {aux, blockIndex = i, ...}): bool =
-			   case aux of
-			      Block =>
-				 0 < Vector.length (Block.args
-						    (Vector.sub (blocks, i)))
-			    | Bug => false
-			    | Goto {args, ...} => Positions.usesFormal args
-			    | Raise {args, ...} => Positions.usesFormal args
-			    | Return {args, ...} => Positions.usesFormal args
-			    | _ => true
-			fun rr ({args = a, canMove = c},
-				{args = a', canMove = c'}) =
-			   Positions.equals (a, a')
-			   andalso List.equals (c, c', Statement.equals)
-			fun equals (m: t, m': t): bool =
-			   case (aux m, aux m') of
-			      (Block, Block) => blockIndex m = blockIndex m'
-			    | (Bug, Bug) => true
-			    | (Goto {dst, args},
-			       Goto {dst = dst', args = args'}) =>
-				 equals (dst, dst')
-				 andalso Positions.equals (args, args')
-			    | (Raise z, Raise z') => rr (z, z')
-			    | (Return z, Return z') => rr (z, z')
-			    | _ => false
-		     end
-		     fun isOk (l: Label.t): bool =
-			let
-			   val m' = labelMeaning l
-			in
-			   not (usesFormal m') andalso equals (m, m')
-			end
+		     val l = Cases.hd cases
+		     fun isOk (l': Label.t): bool = Label.equals (l, l')
 		  in
-		     if Cases.forall (cases, isOk)
+		     if 0 = Vector.length (Block.args
+					   (Vector.sub (blocks, labelIndex l)))
+			andalso Cases.forall (cases, isOk)
 			andalso (case default of
 				    NONE => true
 				  | SOME l => isOk l)
 			then
 			   (* All cases the same -- eliminate the case. *)
-			   tryToEliminate m
+			   tryToEliminate (labelMeaning l)
 		     else
 			let
 			   fun findCase (cases, is, args) =
@@ -989,27 +957,23 @@
 					     then doit (j, args)
 					  else loop (k + 1)
 				       end
-			      in loop 0
+			      in
+				 loop 0
 			      end
 			in
 			   case (VarInfo.value test, cases) of
 			      (SOME (Value.Const c), _) =>
-				 let
-				    fun doit (l, z, eq) =
-				       findCase (l, fn z' => eq (z, z'),
-						 Vector.new0 ())
-				 in
-				    case (cases, c) of
-				       (Cases.Int (_, cs), Const.Int i) =>
-					  doit (cs, i, IntX.equals)
-				     | (Cases.Word (_, cs), Const.Word w) =>
-					  doit (cs, w, WordX.equals)
-				     | _ =>
-					  Error.bug "strange constant for cases"
-				 end
+				 (case (cases, c) of
+				     (Cases.Word (_, cs), Const.Word w) =>
+					findCase (cs,
+						  fn w' => WordX.equals (w, w'),
+						  Vector.new0 ())
+				   | _ =>
+					Error.bug "strange constant for cases")
 			    | (SOME (Value.Con {con, args}), Cases.Con cases) =>
-				 findCase (cases, fn c =>
-					   Con.equals (con, c), args)
+				 findCase (cases,
+					   fn c => Con.equals (con, c),
+					   args)
 			    | _ => cantSimplify ()
 (*
 			    | (NONE, _) => cantSimplify ()



1.70      +8 -21     mlton/mlton/ssa/ssa-tree.fun

Index: ssa-tree.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ssa-tree.fun,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -r1.69 -r1.70
--- ssa-tree.fun	12 Apr 2004 17:53:06 -0000	1.69
+++ ssa-tree.fun	1 May 2004 00:49:47 -0000	1.70
@@ -26,7 +26,6 @@
       datatype dest =
 	  Array of t
 	| Datatype of Tycon.t
-	| Int of IntSize.t
 	| IntInf
 	| Real of RealSize.t
 	| Ref of t
@@ -52,7 +51,6 @@
 
 	 val tycons =
 	    [(Tycon.array, unary Array)]
-	    @ Vector.toListMap (Tycon.ints, fn (t, s) => (t, nullary (Int s)))
 	    @ [(Tycon.intInf, nullary IntInf)]
 	    @ Vector.toListMap (Tycon.reals, fn (t, s) => (t, nullary (Real s)))
 	    @ [(Tycon.reff, unary Ref),
@@ -84,7 +82,6 @@
 	      case dest t of
 		 Array t => seq [layout t, str " array"]
 	       | Datatype t => Tycon.layout t
-	       | Int s => str (concat ["int", IntSize.toString s])
 	       | IntInf => str "IntInf.int"
 	       | Real s => str (concat ["real", RealSize.toString s])
 	       | Ref t => seq [layout t, str " ref"]
@@ -104,7 +101,6 @@
    struct
       datatype t =
 	 Con of (Con.t * Label.t) vector
-       | Int of IntSize.t * (IntX.t * Label.t) vector
        | Word of WordSize.t * (WordX.t * Label.t) vector
 
       fun equals (c1: t, c2: t): bool =
@@ -116,7 +112,6 @@
 	 in
 	    case (c1, c2) of
 	       (Con l1, Con l2) => doit (l1, l2, Con.equals)
-	     | (Int (_, l1), Int (_, l2)) => doit (l1, l2, IntX.equals)
 	     | (Word (_, l1), Word (_, l2)) => doit (l1, l2, WordX.equals)
 	     | _ => false
 	 end
@@ -132,7 +127,6 @@
 	 in
 	    case c of
 	       Con cs => doit cs
-	     | Int (_, cs) => doit cs
 	     | Word (_, cs) => doit cs
 	 end
 
@@ -142,7 +136,6 @@
 	 in
 	    case c of
 	       Con cs => doit cs
-	     | Int (_, cs) => doit cs
 	     | Word (_, cs) => doit cs
 	 end
 
@@ -152,7 +145,6 @@
 	 in
 	    case c of
 	       Con l => doit l
-	     | Int (_, l) => doit l
 	     | Word (_, l) => doit l
 	 end
 
@@ -162,7 +154,6 @@
 	 in
 	    case c of
 	       Con l => Con (doit l)
-	     | Int (s, l) => Int (s, doit l)
 	     | Word (s, l) => Word (s, doit l)
 	 end
       
@@ -172,7 +163,6 @@
 	 in
 	    case c of
 	       Con l => doit l
-	     | Int (_, l) => doit l
 	     | Word (_, l) => doit l
 	 end
 
@@ -595,13 +585,12 @@
 
       fun iff (test: Var.t, {truee, falsee}) =
 	 let
-	    val s = IntSize.I (Bits.fromInt 32)
+	    val s = WordSize.fromBits (Bits.fromInt 32)
 	 in
-	    Case
-	    {cases = Cases.Int (s, Vector.new2 ((IntX.zero s, falsee),
-						(IntX.one s, truee))),
-	     default = NONE,
-	     test = test}
+	    Case {cases = Cases.Word (s, Vector.new2 ((WordX.zero s, falsee),
+						      (WordX.one s, truee))),
+		  default = NONE,
+		  test = test}
 	 end
 	 
       fun foreachFuncLabelVar (t, func, label: Label.t -> unit, var) =
@@ -685,20 +674,20 @@
 	       val cases =
 		  case cases of
 		     Con l => doit (l, Con.layout)
-		   | Int (_, l) => doit (l, IntX.layout)
 		   | Word (_, l) => doit (l, WordX.layout)
 	       val cases =
 		  case default of
 		     NONE => cases
 		   | SOME j =>
 			cases @ [seq [str "_ => ", Label.layout j]]
-	    in align [seq [str "case ", Var.layout test, str " of"],
+	    in
+	       align [seq [str "case ", Var.layout test, str " of"],
 		      indent (alignPrefix (cases, "| "), 2)]
 	    end
 
 	 val layout =
 	    fn Arith {prim, args, overflow, success, ...} =>
-		  seq [Label.layout success,
+		  seq [Label.layout success, str " ",
 		       tuple [Prim.layoutApp (prim, args, Var.layout)],
 		       str " Overflow => ",
 		       Label.layout overflow, str " ()"]
@@ -1117,8 +1106,6 @@
 				  val _ =
 				     case cases of
 					Cases.Con v => doit (v, Con.toString)
-				      | Cases.Int (_, v) =>
-					   doit (v, IntX.toString)
 				      | Cases.Word (_, v) =>
 					   doit (v, WordX.toString)
 				  val _ = 



1.57      +0 -2      mlton/mlton/ssa/ssa-tree.sig

Index: ssa-tree.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ssa-tree.sig,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -r1.56 -r1.57
--- ssa-tree.sig	12 Apr 2004 17:53:07 -0000	1.56
+++ ssa-tree.sig	1 May 2004 00:49:47 -0000	1.57
@@ -60,7 +60,6 @@
 	    datatype dest =
 	       Array of t
 	     | Datatype of Tycon.t
-	     | Int of IntSize.t
 	     | IntInf
 	     | Real of RealSize.t
 	     | Ref of t
@@ -120,7 +119,6 @@
 	 sig
 	    datatype t =
 	       Con of (Con.t * Label.t) vector
-	     | Int of IntSize.t * (IntX.t * Label.t) vector
 	     | Word of WordSize.t * (WordX.t * Label.t) vector
 
 	    val forall: t * (Label.t -> bool) -> bool



1.33      +0 -3      mlton/mlton/ssa/type-check.fun

Index: type-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/type-check.fun,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- type-check.fun	13 Apr 2004 03:36:42 -0000	1.32
+++ type-check.fun	1 May 2004 00:49:47 -0000	1.33
@@ -128,7 +128,6 @@
 	       in
 		  case cases of
 		     Cases.Con cs => doitCon cs 
-		   | Cases.Int (_, cs) => doit (cs, IntX.equals, IntX.hash)
 		   | Cases.Word (_, cs) =>
 			doit (cs, WordX.equals, Word.fromIntInf o WordX.toIntInf)
 	       end
@@ -400,8 +399,6 @@
 		  conApp = conApp,
 		  const = Type.ofConst,
 		  filter = filter,
-		  filterInt = fn (from, s) => coerce {from = from,
-						      to = Type.int s},
 		  filterWord = fn (from, s) => coerce {from = from,
 						       to = Type.word s},
 		  fromType = fn x => x,



1.24      +9 -12     mlton/mlton/ssa/useless.fun

Index: useless.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/useless.fun,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- useless.fun	18 Mar 2004 10:31:48 -0000	1.23
+++ useless.fun	1 May 2004 00:49:47 -0000	1.24
@@ -246,7 +246,7 @@
 		     case Type.dest t of
 			Type.Array t =>
 			   let val elt as (_, e) = slot t
-			       val length = loop Type.defaultInt
+			       val length = loop Type.defaultWord
 			   in Exists.addHandler
 			      (e, fn () => Useful.makeUseful (deground length))
 			      ; Array {useful = useful (),
@@ -256,7 +256,7 @@
 		      | Type.Ref t => Ref {arg = slot t,
 					   useful = useful ()}
 		      | Type.Tuple ts => Tuple (Vector.map (ts, slot))
-		      | Type.Vector t => Vector {length = loop Type.defaultInt,
+		      | Type.Vector t => Vector {length = loop Type.defaultWord,
 						 elt = slot t}
 		      | Type.Weak t => Weak {arg = slot t,
 					     useful = useful ()}
@@ -565,7 +565,6 @@
 		  conApp = conApp,
 		  const = Value.const,
 		  filter = filter,
-		  filterInt = filterGround o #1,
 		  filterWord = filterGround o #1,
 		  fromType = Value.fromType,
 		  layout = Value.layout,
@@ -926,13 +925,6 @@
 	       end
 	  | Case {test, cases, default} => 
 	       let
-		  (* The test may be useless if there are no cases or default,
-		   * thus we must eliminate the case.
-		   *)
-		  fun doit v =
-		     case (Vector.length v, default) of
-			(0, NONE) => ([], Bug)
-		      | _ => ([], t)
 		  datatype z = datatype Cases.t
 	       in
 		  case cases of
@@ -962,8 +954,13 @@
 					 cases = Cases.Con cases,
 					 default = default})
 			       end)
-		   | Int (_, cs) => doit cs
-		   | Word (_, cs) => doit cs
+		   | Word (_, cs) =>
+			(* The test may be useless if there are no cases or
+			 * default, thus we must eliminate the case.
+			 *)
+			case (Vector.length cs, default) of
+			   (0, NONE) => ([], Bug)
+			 | _ => ([], t)
 	       end
 	  | Goto {dst, args} =>
 	       ([], Goto {dst = dst, args = keepUseful (args, label dst)})



1.17      +4 -4      mlton/mlton/xml/monomorphise.fun

Index: monomorphise.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/monomorphise.fun,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- monomorphise.fun	12 Apr 2004 17:53:08 -0000	1.16
+++ monomorphise.fun	1 May 2004 00:49:48 -0000	1.17
@@ -278,15 +278,15 @@
 	       SprimExp.App {func = monoVarExp func, arg = monoVarExp arg}
 	  | XprimExp.Case {test, cases, default} =>
 	       let
-		  fun doit cases =
-		     Vector.map (cases, fn (c, e) => (c, monoExp e))
 		  val cases =
 		     case cases of
 			Xcases.Con cases => 
 			   Scases.Con (Vector.map (cases, fn (pat, exp) =>
 						   (monoPat pat, monoExp exp)))
-		      | Xcases.Int (s, l) => Scases.Int (s, doit l)
-		      | Xcases.Word (s, l) => Scases.Word (s, doit l)
+		      | Xcases.Word (s, v) =>
+			   Scases.Word
+			   (s, Vector.map (v, fn (c, e) => (c, monoExp e)))
+
 	       in
 		  SprimExp.Case
 		  {test = monoVarExp test,



1.15      +6 -6      mlton/mlton/xml/polyvariance.fun

Index: polyvariance.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/polyvariance.fun,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- polyvariance.fun	20 Feb 2004 02:11:15 -0000	1.14
+++ polyvariance.fun	1 May 2004 00:49:48 -0000	1.15
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -313,9 +313,6 @@
 				   | Case {test, cases, default} =>
 					let
 					   datatype z = datatype Cases.t
-					   fun doit cases =
-					      Vector.map (cases, fn (z, e) =>
-							  (z, loopExp e))
 					   val cases =
 					      case cases of
 						 Con cases =>
@@ -323,8 +320,11 @@
 						    (Vector.map
 						     (cases, fn (p, e) =>
 						      (bindPat p, loopExp e)))
-					       | Int (s, v) => Int (s, doit v)
-					       | Word (s, v) => Word (s, doit v)
+					       | Word (s, v) =>
+						    Word
+						    (s, (Vector.map
+							 (v, fn (z, e) =>
+							  (z, loopExp e))))
 					in
 					   Case {test = loopVar test,
 						 cases = cases,



1.6       +5 -13     mlton/mlton/xml/shrink.fun

Index: shrink.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/shrink.fun,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- shrink.fun	18 Mar 2004 03:22:26 -0000	1.5
+++ shrink.fun	1 May 2004 00:49:48 -0000	1.6
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -397,18 +397,10 @@
 				  | _ => false)
 			      end
 			     | (_, SOME (Value.Const c)) =>
-				  let
-				     fun doit (l, z, equals) =
-					match (l, fn z' => equals (z, z'))
-				     datatype z = datatype Const.t
-				  in
-				     case (cases, c) of
-					(Cases.Int (_, l), Int i) =>
-					   doit (l, i, IntX.equals)
-				      | (Cases.Word (_, l), Word w) =>
-					   doit (l, w, WordX.equals)
-				   | _ => Error.bug "strange case"
-				  end
+				  (case (cases, c) of
+				      (Cases.Word (_, l), Const.Word w) =>
+					 match (l, fn w' => WordX.equals (w, w'))
+				    | _ => Error.bug "strange case")
 			     | (_, NONE) => normal varExp
 			     | _ => Error.bug "shrinkMonoVal"
 		  end



1.11      +4 -4      mlton/mlton/xml/simplify-types.fun

Index: simplify-types.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/simplify-types.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- simplify-types.fun	12 Apr 2004 17:53:08 -0000	1.10
+++ simplify-types.fun	1 May 2004 00:49:48 -0000	1.11
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -246,14 +246,14 @@
 							func = fixVarExp func}
 	  | I.PrimExp.Case {cases, default, test} =>
 	       let
-		  fun doit v = Vector.map (v, fn (c, e) => (c, fixExp e))
 		  val cases =
 		     case cases of
 			I.Cases.Con v =>
 			   O.Cases.Con (Vector.map (v, fn (p, e) =>
 						    (fixPat p, fixExp e)))
-		      | I.Cases.Int (s, v) => O.Cases.Int (s, doit v)
-		      | I.Cases.Word (s, v) => O.Cases.Word (s, doit v)
+		      | I.Cases.Word (s, v) =>
+			   O.Cases.Word
+			   (s, Vector.map (v, fn (c, e) => (c, fixExp e)))
 	       in
 		  O.PrimExp.Case {cases = cases,
 				  default = Option.map (default, fn (e, r) =>



1.18      +3 -5      mlton/mlton/xml/type-check.fun

Index: type-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/type-check.fun,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- type-check.fun	12 Apr 2004 17:53:08 -0000	1.17
+++ type-check.fun	1 May 2004 00:49:48 -0000	1.18
@@ -186,9 +186,6 @@
 					     then ety
 					  else error "default of wrong type"
 			      else error "test and patterns of different types"
-		     fun doit (l, t) =
-			finish (Vector.new1 t,
-				Vector.map (l, fn (_, e) => checkExp e))
 		     datatype z = datatype Cases.t
 		  in
 		     case cases of
@@ -196,8 +193,9 @@
 			   finish (Vector.unzip
 				   (Vector.map (cases, fn (p, e) =>
 						(checkPat p, checkExp e))))
-		      | Int (s, cs) => doit (cs, Type.int s)
-		      | Word (s, cs) => doit (cs, Type.word s)
+		      | Word (s, cs) =>
+			   finish (Vector.new1 (Type.word s),
+				   Vector.map (cs, fn (_, e) => checkExp e))
 		  end
 	     | ConApp {con, targs, arg} =>
 		  let



1.21      +1 -6      mlton/mlton/xml/xml-tree.fun

Index: xml-tree.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/xml-tree.fun,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- xml-tree.fun	12 Apr 2004 17:53:08 -0000	1.20
+++ xml-tree.fun	1 May 2004 00:49:48 -0000	1.21
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -76,7 +76,6 @@
    struct
       datatype 'a t = 
 	 Con of (Pat.t * 'a) vector
-       | Int of IntSize.t * (IntX.t * 'a) vector
        | Word of WordSize.t * (WordX.t * 'a) vector
 
       fun layout (cs, layout) =
@@ -89,7 +88,6 @@
 	 in
 	    case cs of
 	       Con v => doit (v, Pat.layout)
-	     | Int (_, v) => doit (v, IntX.layout)
 	     | Word (_, v) => doit (v, WordX.layout)
 	 end
 
@@ -99,7 +97,6 @@
 	 in
 	    case c of
 	       Con l => doit l
-	     | Int (_, l) => doit l
 	     | Word (_, l) => doit l
 	 end
 
@@ -109,7 +106,6 @@
 	 in
 	    case c of
 	       Con l => Con (doit l)
-	     | Int (s, l) => Int (s, doit l)
 	     | Word (s, l) => Word (s, doit l)
 	 end
       
@@ -121,7 +117,6 @@
 	 in
 	    case c of
 	       Con l => Vector.foreach (l, fn (c, a) => (fc c; f a))
-	     | Int (_, l) => doit l
 	     | Word (_, l) => doit l
 	 end
    end



1.15      +1 -2      mlton/mlton/xml/xml-tree.sig

Index: xml-tree.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/xml-tree.sig,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- xml-tree.sig	12 Apr 2004 17:53:08 -0000	1.14
+++ xml-tree.sig	1 May 2004 00:49:48 -0000	1.15
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-1999 NEC Research Institute.
  *
@@ -44,7 +44,6 @@
 	 sig
 	    datatype 'a t =
 	       Con of (Pat.t * 'a) vector
-	     | Int of IntSize.t * (IntX.t * 'a) vector
 	     | Word of WordSize.t * (WordX.t * 'a) vector
 
 	    val fold: 'a t * 'b * ('a * 'b -> 'b) -> 'b



1.81      +0 -8      mlton/runtime/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -r1.80 -r1.81
--- Makefile	29 Apr 2004 02:58:58 -0000	1.80
+++ Makefile	1 May 2004 00:49:48 -0000	1.81
@@ -37,13 +37,9 @@
 	basis/GC/setSummary.o			\
 	basis/IEEEReal.o			\
 	basis/IntInf.o				\
-	basis/Int/Int64.o			\
 	basis/Int/Word8Array.o			\
 	basis/Int/Word8Vector.o			\
 	basis/Int/Word64.o			\
-	basis/Int/addOverflow.o			\
-	basis/Int/mulOverflow.o			\
-	basis/Int/negOverflow.o			\
 	basis/Int/quot.o			\
 	basis/Int/subOverflow.o			\
 	basis/Itimer/set.o			\
@@ -203,13 +199,9 @@
 	basis/GC/setSummary-gdb.o		\
 	basis/IEEEReal-gdb.o			\
 	basis/IntInf-gdb.o			\
-	basis/Int/Int64-gdb.o			\
 	basis/Int/Word8Array-gdb.o		\
 	basis/Int/Word8Vector-gdb.o		\
 	basis/Int/Word64-gdb.o			\
-	basis/Int/addOverflow-gdb.o		\
-	basis/Int/mulOverflow-gdb.o		\
-	basis/Int/negOverflow-gdb.o		\
 	basis/Int/quot-gdb.o			\
 	basis/Int/subOverflow-gdb.o		\
 	basis/Itimer/set-gdb.o			\



1.6       +10 -0     mlton/runtime/types.h

Index: types.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/types.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- types.h	4 Apr 2004 18:21:43 -0000	1.5
+++ types.h	1 May 2004 00:49:48 -0000	1.6
@@ -19,6 +19,16 @@
 typedef unsigned long Word32;
 typedef unsigned long long Word64;
 
+typedef Int8 WordS8;
+typedef Int16 WordS16;
+typedef Int32 WordS32;
+typedef Int64 WordS64;
+
+typedef Word8 WordU8;
+typedef Word16 WordU16;
+typedef Word32 WordU32;
+typedef Word64 WordU64;
+
 typedef Int32 Int;
 typedef Real64 Real;
 typedef Word8 Char;



1.2       +53 -41    mlton/runtime/basis/Int/Word64.c

Index: Word64.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Int/Word64.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Word64.c	11 Sep 2003 00:51:08 -0000	1.1
+++ Word64.c	1 May 2004 00:49:49 -0000	1.2
@@ -11,40 +11,44 @@
 	t f##_to##t (f x) {			\
 		return (t)x;			\
 	}
-coerce(Int32,Word64)
-coerce(Word8,Word64)
-coerce(Word16,Word64)
-coerce(Word32,Word64)
-coerce(Word64,Int32)
-coerce(Word64,Word8)
-coerce(Word64,Word16)
-coerce(Word64,Word32)
+coerce (WordS16, Word64)
+coerce (WordS32, Word64)
+coerce (WordS8, Word64)
+coerce (WordU16, Word64)
+coerce (WordU32, Word64)
+coerce (WordU64, Word16)
+coerce (WordU64, Word32)
+coerce (WordU64, Word8)
+coerce (WordU8, Word64)
 #undef coerce
 
-#define coerceX(size, t)				\
-	t Word##size##_to##t##X (Word##size w) {	\
-		return (t)(Int##size)w;			\
-	}
-coerceX(8,Word64)
-coerceX(16,Word64)
-coerceX(32,Word64)
-coerceX(64,Int32)
-#undef coerceX
-
 #define binary(name, op)				\
 	Word64 Word64_##name (Word64 w1, Word64 w2) {	\
 		return w1 op w2;			\
 	}
 binary (add, +)
 binary (andb, &)
-binary (div, /)
-binary (mod, %)
-binary (mul, *)
 binary (orb, |)
 binary (sub, -)
 binary (xorb, ^)
 #undef binary
 
+#define binary(kind, name, op)							\
+	Word64 Word##kind##64_##name (Word##kind##64 w1, Word##kind##64 w2) {	\
+		Word##kind##64 res = w1 op w2;					\
+		if (DEBUG)							\
+			fprintf (stderr, "%lld = " #name " (%lld, %lld)\n",	\
+					res, w1, w2);				\
+		return res;							\
+	}
+binary (S, mul, *)
+binary (U, mul, *)
+binary (S, quot, /)
+binary (U, quot, /)
+binary (S, rem, %)
+binary (U, rem, %)
+#undef binary
+
 #define unary(name, op)				\
 	Word64 Word64_##name (Word64 w) {	\
 		return op w;			\
@@ -53,28 +57,36 @@
 unary (notb, ~)
 #undef unary
 
-#define compare(name, op)				\
-	Bool Word64_##name (Word64 w1, Word64 w2) {	\
-		return w1 op w2;			\
-	}
-compare (equal, ==)
-compare (ge, >=)
-compare (gt, >)
-compare (le, <=)
-compare (lt, <)
-#undef binary
+Bool Word64_equal (Word64 w1, Word64 w2) {
+	Bool res = w1 == w2;
+	if (DEBUG)
+		fprintf (stderr, "%s = %llu == %llu\n", 
+			res ? "true" : "false", w1, w2);
+	return res;
+}
 
-#define shift(name, op)					\
-	Word64 Word64_##name (Word64 w1, Word w2) {	\
-		return w1 op w2;			\
+#define compare(s, name, op)						\
+	Bool Word##s##64_##name (Word##s##64 w1, Word##s##64 w2) {	\
+		return w1 op w2;					\
 	}
-shift (lshift, <<)
-shift (rshift, >>)
-#undef binary
-
-Word64 Word64_arshift (Word64 w, Word s) {
-	return (Int64)w >> s;
-}
+compare (S, ge, >=)
+compare (U, ge, >=)
+compare (S, gt, >)
+compare (U, gt, >)
+compare (S, le, <=)
+compare (U, le, <=)
+compare (S, lt, <)
+compare (U, lt, <)
+#undef compare
+
+#define shift(size,name, op)					\
+	Word64 Word##size##_##name (Word##size w1, Word w2) {	\
+		return w1 op w2;				\
+	}
+shift (64, lshift, <<)
+shift (S64, rshift, >>)
+shift (U64, rshift, >>)
+#undef shift
 
 Word64 Word64_rol (Word64 w1, Word w2) {
 	return (w1 >> (64 - w2)) | (w1 << w2);



1.8       +20 -5     mlton/runtime/basis/Int/quot.c

Index: quot.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Int/quot.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- quot.c	29 Nov 2003 09:33:25 -0000	1.7
+++ quot.c	1 May 2004 00:49:49 -0000	1.8
@@ -2,6 +2,10 @@
 
 #include "mlton-basis.h"
 
+enum {
+	DEBUG = 0,
+};
+
 /*
  * We have to be very careful implementing Int_quot and Int_rem using / and %
  * because C allows
@@ -27,16 +31,27 @@
  */
 
 #if ! (defined (__i386__) || defined (__sparc__))
-#error check that C / correctly implements quot from the basis library
+#error check that C {/,%} correctly implement {quot,rem} from the basis library
 #endif
 
+#define WordS8_format "%c"
+#define WordS16_format "%d"
+#define WordS32_format "%d"
+#define WordS64_format "%lld"
+
 #define binary(size, name, op)							\
-	Int##size Int##size##_##name (Int##size i, Int##size j) {		\
-		return i op j;							\
+	WordS##size WordS##size##_##name (WordS##size i, WordS##size j) {	\
+		WordS##size res = i op j;					\
+		if (DEBUG)							\
+			fprintf (stderr, WordS##size##_format			\
+					" = " WordS##size##_format " "		\
+					#op " " WordS##size##_format "\n",	\
+				        res, i, j);				\
+		return res;							\
 	}
 
-#define both(size)								\
-	binary(size, quot, /)							\
+#define both(size)				\
+	binary(size, quot, /)			\
 	binary(size, rem, %)
 
 both(8)