[MLton] cvs commit: Added Int31 structure

Stephen Weeks sweeks@mlton.org
Tue, 2 Mar 2004 18:09:08 -0800


sweeks      04/03/02 18:09:08

  Modified:    basis-library/libs build
               basis-library/libs/basis-2002/top-level basis.sig basis.sml
                        overloads.sml
               basis-library/misc primitive.sml
               mlton/ast int-size.fun int-size.sig prim-tycons.fun
                        prim-tycons.sig real-size.fun real-size.sig
                        word-size.fun word-size.sig
               mlton/atoms c-function.fun c-type.fun const.fun int-x.fun
                        prim.fun type-ops.fun word-x.fun
               mlton/backend machine-atoms.fun representation.fun rssa.fun
                        ssa-to-rssa.fun
               mlton/closure-convert closure-convert.fun globalize.fun
               mlton/codegen/c-codegen c-codegen.fun
               mlton/codegen/x86-codegen x86-mlton-basic.fun x86-mlton.fun
                        x86-translate.fun x86.fun
               mlton/match-compile match-compile.fun
               mlton/ssa local-ref.fun multi.fun redundant-tests.fun
                        ssa-tree.fun
               mlton/xml implement-exceptions.fun
               regression fixed-integer.sml
  Added:       basis-library/integer embed.sml
  Log:
  MAIL Added Int31 structure
  
  Most operations are implemented by converting to Int32.int and using
  the corresponding operation there.
  
  Added a new primitive "int31" tycon to the compiler, and cleaned up
  the compiler internals a bit so that adding more int types should be
  very easy.  The only int31 primitives that the compiler knows about
  are the conversions to and from int32.  These conversions are replaced
  by no-ops in ssa-to-rssa, which also replaces the int31 type with
  int32, so that the codegens don't see anything new.
  
  The reason for propagating the int31 type so far back is that soon the
  representation pass will take advantage of the int31 type and will use
  only 31 bits to represent it, which will allow sum types like "A of
  Int31.int | B of Int31.int" to be represented more efficiently.
  
  I also plan to add all the other int sizes between 1 and 64 soon.

Revision  Changes    Path
1.1                  mlton/basis-library/integer/embed.sml

Index: embed.sml
===================================================================
functor EmbedInt (structure Big: INTEGER
		  structure Small:
		     sig
			eqtype int

			val precision': Int.int
			val fromBigUnsafe: Big.int -> int
			val toBig: int -> Big.int
		     end): INTEGER =
   struct
      open Small
	 
      val precision = SOME precision'

      val maxIntBig =
	 Big.fromLarge
	 (LargeInt.- (Word.toLargeInt (Word.<<
				       (0w1,
					Word.fromInt (Int.- (precision', 1)))),
		      1))

      val maxInt = SOME (fromBigUnsafe maxIntBig)

      val minIntBig = Big.- (Big.~ maxIntBig, Big.fromInt 1)

      val minInt = SOME (fromBigUnsafe minIntBig)

      fun fromBig (i: Big.int): int = 
	 if Big.<= (minIntBig, i) andalso Big.<= (i, maxIntBig)
	    then fromBigUnsafe i
	 else raise Overflow

      local
	 val make: (Big.int * Big.int -> Big.int) -> (int * int -> int) =
	    fn f => fn (x, y) => fromBig (f (toBig x, toBig y))
      in
	 val op * = make Big.*
	 val op + = make Big.+
	 val op - = make Big.-
	 val op div = make Big.div
	 val op mod = make Big.mod
	 val quot = make Big.quot
	 val rem = make Big.rem
      end

      local
	 val make: (Big.int * Big.int -> 'a) -> (int * int -> 'a) =
	    fn f => fn (x, y) => f (toBig x, toBig y)
      in
	 val op < = make Big.<
	 val op <= = make Big.<=
	 val op > = make Big.>
	 val op >= = make Big.>=
	 val compare = make Big.compare
      end

      val fromInt = fromBig o Big.fromInt

      val toInt = Big.toInt o toBig

      local
	 val make: (Big.int -> Big.int) -> (int -> int) =
	    fn f => fn x => fromBig (f (toBig x))
      in
	 val ~ = make Big.~
	 val abs = make Big.abs
      end

      fun fmt r i = Big.fmt r (toBig i)

      val fromLarge = fromBig o Big.fromLarge

      fun fromString s = Option.map fromBig (Big.fromString s)

      fun max (i, j) = if i >= j then i else j

      fun min (i, j) = if i <= j then i else j

      fun scan r reader state =
	 Option.map
	 (fn (i, state) => (fromBig i, state))
	 (Big.scan r reader state)
	 
      val sign = Big.sign o toBig

      fun sameSign (x, y) = sign x = sign y

      val toLarge = Big.toLarge o toBig

      val toString = Big.toString o toBig
   end

structure Int31 = EmbedInt (structure Big = Int32
			    structure Small = Primitive.Int31)



1.32      +1 -0      mlton/basis-library/libs/build

Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- build	16 Feb 2004 22:43:19 -0000	1.31
+++ build	3 Mar 2004 02:08:58 -0000	1.32
@@ -74,6 +74,7 @@
 real/real32.sml
 real/real64.sml
 integer/patch.sml
+integer/embed.sml
 
 top-level/arithmetic.sml
 



1.44      +12 -8     mlton/basis-library/libs/basis-2002/top-level/basis.sig

Index: basis.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sig,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- basis.sig	1 Mar 2004 23:23:41 -0000	1.43
+++ basis.sig	3 Mar 2004 02:08:58 -0000	1.44
@@ -141,6 +141,7 @@
       structure Int16ArraySlice : MONO_ARRAY_SLICE
       structure Int16Vector : MONO_VECTOR
       structure Int16VectorSlice : MONO_VECTOR_SLICE
+      structure Int31 : INTEGER
       structure Int32 : INTEGER
       structure Int32Array : MONO_ARRAY
       structure Int32Array2 : MONO_ARRAY2
@@ -589,10 +590,6 @@
    where type BinPrimIO.reader = BinPrimIO.reader
    where type BinPrimIO.writer = BinPrimIO.writer
    where type FixedInt.int = FixedInt.int
-   where type Int8.int = Int8.int
-   where type Int16.int = Int16.int
-   where type Int64.int = Int64.int
-   where type IntInf.int = IntInf.int
    where type IO.buffer_mode = IO.buffer_mode
    where type LargeInt.int = LargeInt.int
    where type LargeReal.real = LargeReal.real
@@ -607,7 +604,6 @@
    where type Position.int = Position.int
    where type Posix.IO.file_desc = Posix.IO.file_desc
    where type Posix.Signal.signal = Posix.Signal.signal
-   where type Real32.real = Real32.real
    where type Socket.dgram = Socket.dgram
    where type ('a, 'b) Socket.sock = ('a, 'b) Socket.sock
    where type 'a Socket.sock_addr = 'a Socket.sock_addr
@@ -628,12 +624,20 @@
    where type 'a Vector.vector = 'a Vector.vector
 *)
    where type 'a VectorSlice.slice = 'a VectorSlice.slice
-   where type Word8.word = Word8.word
-   where type Word16.word = Word16.word
-   where type Word64.word = Word64.word
    where type Word8Array.array = Word8Array.array
    where type Word8ArraySlice.slice = Word8ArraySlice.slice
    where type Word8ArraySlice.vector_slice = Word8ArraySlice.vector_slice
    where type Word8Vector.vector = Word8Vector.vector
+
+   (* Types that must be exposed because constants denote them. *)
+   where type Int8.int = Int8.int
+   where type Int16.int = Int16.int
+   where type Int31.int = Int31.int
+   where type Int64.int = Int64.int
+   where type IntInf.int = IntInf.int
+   where type Real32.real = Real32.real
+   where type Word8.word = Word8.word
+   where type Word16.word = Word16.word
+   where type Word64.word = Word64.word
 
    where type 'a MLton.Thread.t = 'a MLton.Thread.t



1.20      +1 -0      mlton/basis-library/libs/basis-2002/top-level/basis.sml

Index: basis.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sml,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- basis.sml	16 Feb 2004 22:43:20 -0000	1.19
+++ basis.sml	3 Mar 2004 02:08:58 -0000	1.20
@@ -62,6 +62,7 @@
       structure Int16ArraySlice = Int16ArraySlice
       structure Int16Vector = Int16Vector
       structure Int16VectorSlice = Int16VectorSlice
+      structure Int31 = Int31
       structure Int32 = Int32
       structure Int32Array = Int32Array
       structure Int32Array2 = Int32Array2



1.10      +11 -0     mlton/basis-library/libs/basis-2002/top-level/overloads.sml

Index: overloads.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/overloads.sml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- overloads.sml	23 Jan 2004 02:30:23 -0000	1.9
+++ overloads.sml	3 Mar 2004 02:08:58 -0000	1.10
@@ -107,6 +107,7 @@
 as  Int.~
 and Int8.~
 and Int16.~
+and Int31.~
 and Int32.~
 and Int64.~
 and IntInf.~
@@ -129,6 +130,7 @@
 as  Int.+
 and Int8.+
 and Int16.+
+and Int31.+
 and Int32.+
 and Int64.+
 and IntInf.+
@@ -151,6 +153,7 @@
 as  Int.-
 and Int8.-
 and Int16.-
+and Int31.-
 and Int32.-
 and Int64.-
 and IntInf.-
@@ -173,6 +176,7 @@
 as  Int.*
 and Int8.*
 and Int16.*
+and Int31.*
 and Int32.*
 and Int64.*
 and IntInf.*
@@ -201,6 +205,7 @@
 as  Int.div
 and Int8.div
 and Int16.div
+and Int31.div
 and Int32.div
 and Int64.div
 and IntInf.div
@@ -219,6 +224,7 @@
 as  Int.mod
 and Int8.mod
 and Int16.mod
+and Int31.mod
 and Int32.mod
 and Int64.mod
 and IntInf.mod
@@ -237,6 +243,7 @@
 as  Int.abs
 and Int8.abs
 and Int16.abs
+and Int31.abs
 and Int32.abs
 and Int64.abs
 and IntInf.abs
@@ -252,6 +259,7 @@
 as  Int.<
 and Int8.<
 and Int16.<
+and Int31.<
 and Int32.<
 and Int64.<
 and IntInf.<
@@ -276,6 +284,7 @@
 as  Int.<=
 and Int8.<=
 and Int16.<=
+and Int31.<=
 and Int32.<=
 and Int64.<=
 and IntInf.<=
@@ -300,6 +309,7 @@
 as  Int.>
 and Int8.>
 and Int16.>
+and Int31.>
 and Int32.>
 and Int64.>
 and IntInf.>
@@ -324,6 +334,7 @@
 as  Int.>=
 and Int8.>=
 and Int16.>=
+and Int31.>=
 and Int32.>=
 and Int64.>=
 and IntInf.>=



1.101     +24 -5     mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.100
retrieving revision 1.101
diff -u -r1.100 -r1.101
--- primitive.sml	28 Feb 2004 01:54:55 -0000	1.100
+++ primitive.sml	3 Mar 2004 02:08:59 -0000	1.101
@@ -16,53 +16,61 @@
    struct
       type 'a array = 'a array
    end
+
 type 'a array = 'a Array.array
+
 structure Bool =
    struct
       datatype bool = datatype bool
    end
-(* datatype bool = datatype Bool.bool *)
+
 structure Char =
    struct
       type char = char
    end
+
 type char = Char.char
+
 type exn = exn
+
 structure Int8 =
    struct
       type int = int8
    end
+
 structure Int16 =
    struct
       type int = int16
    end
+
 structure Int32 =
    struct
       type int = int32
    end
+
 structure Int = Int32
+
 structure Int64 =
    struct
       type int = int64
    end
+
 structure IntInf =
    struct
       type int = intInf
    end
 
-(* datatype list = datatype list *)
-
 structure Real32 =
    struct
       type real = real32
    end
+
 structure Real64 =
    struct
       type real = real64
    end
-structure Real = Real64
 
-(* datatype ref = datatype ref *)
+structure Real = Real64
 
 structure String =
    struct
@@ -377,6 +385,14 @@
 	    val fromInt = _prim "Int32_toInt16": Int.int -> int;
 	    val toInt = _prim "Int16_toInt32": int -> Int.int;
 	 end
+      structure Int31 =
+	 struct
+	    type int = int31
+
+	    val fromBigUnsafe = _prim "Int32_toInt31": Int32.int -> int;
+	    val precision' = 31
+	    val toBig = _prim "Int31_toInt32": int -> Int32.int;
+	 end
       structure Int32 =
 	 struct
 	    type int = Int32.int
@@ -413,6 +429,9 @@
 	       else ~?
 	    val fromInt : int -> int = fn x => x
 	    val toInt : int -> int = fn x => x
+
+(*	    val fromInt31 = _prim "Int31_toInt32": Int31.int -> int; *)
+(* 	    val toInt31 = _prim "Int32_toInt31": int -> Int31.int; *)
 	 end
 
       structure Int = Int32



1.5       +51 -22    mlton/mlton/ast/int-size.fun

Index: int-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/int-size.fun,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- int-size.fun	19 Feb 2004 22:42:08 -0000	1.4
+++ int-size.fun	3 Mar 2004 02:08:59 -0000	1.5
@@ -3,47 +3,64 @@
 
 open S
 
-datatype t = I8 | I16 | I32 | I64
+datatype t = T of {precision: int}
+
+fun bits (T {precision = p, ...}) = p
 
 val equals: t * t -> bool = op =
 
-val all = [I8, I16, I32, I64]
+val sizes: int list = [8, 16, 31, 32, 64]
 
-val default = I32
+fun isValidSize i = List.exists (sizes, fn i' => i = i')
 
-val bytes: t -> int =
-   fn I8 => 1
-    | I16 => 2
-    | I32 => 4
-    | I64 => 8
+fun make i = T {precision = i}
+
+val allVector = Vector.tabulate (65, fn i =>
+				  if isValidSize i
+				     then SOME (make i)
+				  else NONE)
+				
+fun I i =
+   case Vector.sub (allVector, i) handle Subscript => NONE of
+      NONE => Error.bug (concat ["strange int size: ", Int.toString i])
+    | SOME s => s
    
-fun size s = 8 * bytes s
+val all = List.map (sizes, I)
 
-val toString = Int.toString o size
+val prims = [I 8, I 16, I 32, I 64]
 
-val layout = Layout.str o toString
-   
+val default = I 32
+ 
 val memoize: (t -> 'a) -> t -> 'a =
    fn f =>
    let
-      val a8 = f I8
-      val a16 = f I16
-      val a32 = f I32
-      val a64 = f I64
+      val v = Vector.map (allVector, fn opt => Option.map (opt, f))
    in
-      fn I8 => a8
-       | I16 => a16
-       | I32 => a32
-       | I64 => a64
+      fn T {precision = i, ...} => valOf (Vector.sub (v, i))
    end
 
-val cardinality = memoize (fn s => IntInf.pow (2, size s))
+val bytes: t -> int =
+   memoize
+   (fn T {precision, ...} =>
+    if precision <= 8
+       then 1
+    else if precision <= 16
+	    then 2
+	 else if precision <= 32
+		 then 4
+	      else 8)
+
+val toString = Int.toString o bits
+
+val layout = Layout.str o toString
+
+val cardinality = memoize (fn s => IntInf.pow (2, bits s))
 
 val range =
    memoize
    (fn s =>
     let
-       val pow = IntInf.pow (2, size s - 1)
+       val pow = IntInf.pow (2, bits s - 1)
     in
        (~ pow, pow - 1)
     end)
@@ -58,5 +75,17 @@
 val min = #1 o range
 
 val max = #2 o range
+
+datatype prim = I8 | I16 | I32 | I64
+
+val primOpt = memoize (fn T {precision = i, ...} =>
+		       List.peekMap ([(8, I8), (16, I16), (32, I32), (64, I64)],
+				     fn (i', p) =>
+				     if i = i' then SOME p else NONE))
+
+fun prim s =
+   case primOpt s of
+      NONE => Error.bug "IntSize.prim"
+    | SOME p => p
 
 end



1.3       +6 -2      mlton/mlton/ast/int-size.sig

Index: int-size.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/int-size.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- int-size.sig	13 Oct 2003 18:48:36 -0000	1.2
+++ int-size.sig	3 Mar 2004 02:08:59 -0000	1.3
@@ -8,19 +8,23 @@
    sig
       include INT_SIZE_STRUCTS
 	 
-      datatype t = I8 | I16 | I32 | I64
+      eqtype t
 
       val all: t list
+      val bits: t -> int
       val bytes: t -> int
       val cardinality: t -> IntInf.t
       val default: t
       val equals: t * t -> bool
+      val I : int -> 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 size: t -> int
       val toString: t -> string
    end



1.18      +52 -67    mlton/mlton/ast/prim-tycons.fun

Index: prim-tycons.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/prim-tycons.fun,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- prim-tycons.fun	19 Feb 2004 22:42:08 -0000	1.17
+++ prim-tycons.fun	3 Mar 2004 02:08:59 -0000	1.18
@@ -10,7 +10,6 @@
 
 open S
 
-datatype z = datatype IntSize.t
 datatype z = datatype RealSize.t
 datatype z = datatype WordSize.t
 
@@ -21,98 +20,84 @@
 val bool = fromString "bool"
 val char = fromString "char"
 val exn = fromString "exn"
-val int8 = fromString "int8"
-val int16 = fromString "int16"
-val int32 = fromString "int32"
-val int64 = fromString "int64"
 val intInf = fromString "intInf"
 val list = fromString "list"
 val pointer = fromString "pointer"
 val preThread = fromString "preThread"
-val real32 = fromString "real32"
-val real64 = fromString "real64"
 val reff = fromString "ref"
 val thread = fromString "thread"
 val tuple = fromString "*"
 val vector = fromString "vector"
 val weak = fromString "weak"
-val word8 = fromString "word8"
-val word16 = fromString "word16"
-val word32 = fromString "word32"
-val word64 = fromString "word64"
-
-val ints =
-   [(int8, I8),
-    (int16, I16),
-    (int32, I32),
-    (int64, I64)]
-
-val reals =
-   [(real32, R32),
-    (real64, R64)]
-
-val words =
-   [(word8, W8),
-    (word16, W16),
-    (word32, W32),
-    (word64, W64)]
 
 datatype z = datatype Kind.t
 datatype z = datatype AdmitsEquality.t
-   
+
+local
+   fun 'a make (prefix: string,
+		all: 'a list,
+		bits: 'a -> int,
+		default: 'a,
+		equalsA: 'a * 'a -> bool,
+		memo: ('a -> t) -> ('a -> t),
+		admitsEquality: AdmitsEquality.t) =
+      let
+	 val all =
+	    Vector.fromListMap
+	    (all, fn s =>
+	     (fromString (concat [prefix, Int.toString (bits s)]), s))
+	 val fromSize =
+	    memo
+	    (fn s =>
+	     case Vector.peek (all, fn (_, s') => equalsA (s, s')) of
+		NONE => Error.bug "missing size"
+	      | SOME (tycon, _) => tycon)
+	 fun is t = Vector.exists (all, fn (t', _) => equals (t, t'))
+	 val prims =
+	    Vector.toListMap (all, fn (tycon, _) =>
+			      (tycon, Arity 0, admitsEquality))
+      in
+	 (fromSize default, fromSize, all, is, prims)
+      end
+in
+   val (defaultInt, int, ints, isIntX, primInts) =
+      let
+	 open IntSize
+      in
+	 make ("int", all, bits, default, equals, memoize, Always)
+      end
+   val (defaultReal, real, reals, isRealX, primReals) =
+      let
+	 open RealSize
+      in
+	 make ("real", all, bits, default, equals, memoize, Never)
+      end
+   val (defaultWord, word, words, isWordX, primWords) =
+      let
+	 open WordSize
+      in
+	 make ("word", all, bits, default, equals, memoize, Always)
+      end
+end
+
+val isIntX = fn c => equals (c, intInf) orelse isIntX c
+
 val prims =
    [(array, Arity 1, Always),
     (arrow, Arity 2, Never),
     (bool, Arity 0, Always),
     (char, Arity 0, Always),
     (exn, Arity 0, Never),
-    (int8, Arity 0, Always),
-    (int16, Arity 0, Always),
-    (int32, Arity 0, Always),
-    (int64, Arity 0, Always),
     (intInf, Arity 0, Always),
     (list, Arity 1, Sometimes),
     (pointer, Arity 0, Always),
     (preThread, Arity 0, Never),
-    (real32, Arity 0, Never),
-    (real64, Arity 0, Never),
     (reff, Arity 1, Always),
     (thread, Arity 0, Never),
     (tuple, Nary, Sometimes),
     (vector, Arity 1, Sometimes),
-    (weak, Arity 1, Never),
-    (word8, Arity 0, Always),
-    (word16, Arity 0, Always),
-    (word32, Arity 0, Always),
-    (word64, Arity 0, Always)]
-   
-val int =
-   fn I8 => int8
-    | I16 => int16
-    | I32 => int32
-    | I64 => int64
-
-val real =
-   fn R32 => real32
-    | R64 => real64
-	
-val word =
-   fn W8 => word8
-    | W16 => word16
-    | W32 => word32
-    | W64 => word64
-	 
-val defaultInt = int IntSize.default
-val defaultReal = real RealSize.default
-val defaultWord = word WordSize.default
-   
-local
-   fun is l t = List.exists (l, fn t' => equals (t, t'))
-in
-   val isIntX = is [int8, int16, int32, int64, intInf]
-   val isRealX = is [real32, real64]
-   val isWordX = is [word8, word16, word32, word64]
-end
+    (weak, Arity 1, Never)]
+   @ primInts @ primReals @ primWords
 
 fun layoutApp (c: t,
 	       args: (Layout.t * {isChar: bool, needsParen: bool}) vector) =



1.10      +5 -3      mlton/mlton/ast/prim-tycons.sig

Index: prim-tycons.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/prim-tycons.sig,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- prim-tycons.sig	16 Oct 2003 22:37:12 -0000	1.9
+++ prim-tycons.sig	3 Mar 2004 02:08:59 -0000	1.10
@@ -5,6 +5,8 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
+type int = Int.t
+   
 signature PRIM_TYCONS_STRUCTS =
    sig
       structure AdmitsEquality: ADMITS_EQUALITY
@@ -39,7 +41,7 @@
       val defaultWord: tycon
       val exn: tycon
       val int: IntSize.t -> tycon
-      val ints: (tycon * IntSize.t) list
+      val ints: (tycon * IntSize.t) vector
       val intInf: tycon
       val isIntX: tycon -> bool
       val isRealX: tycon -> bool
@@ -52,12 +54,12 @@
       val preThread: tycon
       val prims: (tycon * Kind.t * AdmitsEquality.t) list
       val real: RealSize.t -> tycon
-      val reals: (tycon * RealSize.t) list
+      val reals: (tycon * RealSize.t) vector
       val reff: tycon
       val thread: tycon
       val tuple: tycon
       val vector: tycon
       val weak: tycon
       val word: WordSize.t -> tycon
-      val words: (tycon * WordSize.t) list
+      val words: (tycon * WordSize.t) vector
    end



1.2       +6 -2      mlton/mlton/ast/real-size.fun

Index: real-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/real-size.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- real-size.fun	23 Jun 2003 04:58:55 -0000	1.1
+++ real-size.fun	3 Mar 2004 02:08:59 -0000	1.2
@@ -6,7 +6,7 @@
 datatype t = R32 | R64
 
 val all = [R32, R64]
-   
+
 val default = R64
 
 val equals: t * t -> bool = op =
@@ -28,5 +28,9 @@
 val bytes: t -> int =
    fn R32 => 4
     | R64 => 8
-	 
+
+val bits: t -> int =
+   fn R32 => 32
+    | R64 => 64
+
 end



1.2       +1 -0      mlton/mlton/ast/real-size.sig

Index: real-size.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/real-size.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- real-size.sig	23 Jun 2003 04:58:55 -0000	1.1
+++ real-size.sig	3 Mar 2004 02:08:59 -0000	1.2
@@ -12,6 +12,7 @@
       datatype t = R32 | R64
 
       val all: t list
+      val bits: t -> int
       val bytes: t -> int
       val default: t
       val equals: t * t -> bool



1.6       +8 -4      mlton/mlton/ast/word-size.fun

Index: word-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.fun,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- word-size.fun	19 Feb 2004 22:42:08 -0000	1.5
+++ word-size.fun	3 Mar 2004 02:08:59 -0000	1.6
@@ -30,15 +30,19 @@
 
 val allOnes = max
 
+val bits: t -> int =
+   fn W8 => 8
+    | W16 => 16
+    | W32 => 32
+    | W64 => 64
+
 val bytes: t -> int = 
    fn W8 => 1
     | W16 => 2
     | W32 => 4
     | W64 => 8
 
-fun size s = 8 * bytes s
-
-fun toString w = Int.toString (size w)
+val toString = Int.toString o bits
 
 val memoize: (t -> 'a) -> t -> 'a =
    fn f =>
@@ -54,6 +58,6 @@
        | W64 => a64
    end
    
-val cardinality = memoize (fn s => IntInf.pow (2, size s))
+val cardinality = memoize (fn s => IntInf.pow (2, bits s))
 
 end



1.5       +1 -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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- word-size.sig	1 Dec 2003 18:22:18 -0000	1.4
+++ word-size.sig	3 Mar 2004 02:08:59 -0000	1.5
@@ -13,6 +13,7 @@
 
       val all: t list
       val allOnes: t -> LargeWord.t
+      val bits: t -> int
       val bytes: t -> int
       val cardinality: t -> IntInf.t
       val default: t
@@ -20,6 +21,5 @@
       val max: t -> LargeWord.t
       val memoize: (t -> 'a) -> t -> 'a
       val pointer: unit -> t
-      val size: t -> int
       val toString: t -> string
    end



1.3       +2 -3      mlton/mlton/atoms/c-function.fun

Index: c-function.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/c-function.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- c-function.fun	19 Feb 2004 22:42:08 -0000	1.2
+++ c-function.fun	3 Mar 2004 02:08:59 -0000	1.3
@@ -82,11 +82,10 @@
 local
    open CType
 in
-   datatype z = datatype IntSize.t
    datatype z = datatype WordSize.t
+   val Int32 = Int (IntSize.I 32)
+   val Word32 = Word W32
 end
-val Int32 = Int I32
-val Word32 = Word W32
 	 
 local
    fun make b =



1.2       +2 -3      mlton/mlton/atoms/c-type.fun

Index: c-type.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/c-type.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- c-type.fun	19 Jul 2003 01:23:26 -0000	1.1
+++ c-type.fun	3 Mar 2004 02:08:59 -0000	1.2
@@ -3,7 +3,6 @@
 
 open S
 
-datatype z = datatype IntSize.t
 datatype z = datatype WordSize.t
 
 datatype t =
@@ -12,7 +11,7 @@
  | Real of RealSize.t
  | Word of WordSize.t
 
-val bool = Int I32
+val bool = Int (IntSize.I 32)
 val char = Word W8
 val defaultInt = Int IntSize.default
 val defaultReal = Real RealSize.default
@@ -20,7 +19,7 @@
 val pointer = Pointer
 
 val all =
-   List.map (IntSize.all, Int)
+   List.map (IntSize.prims, Int)
    @ [Pointer]
    @ List.map (RealSize.all, Real)
    @ List.map (WordSize.all, Word)



1.14      +0 -1      mlton/mlton/atoms/const.fun

Index: const.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.fun,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- const.fun	19 Feb 2004 22:42:09 -0000	1.13
+++ const.fun	3 Mar 2004 02:08:59 -0000	1.14
@@ -21,7 +21,6 @@
    structure WordSize = WordSize
 end
 
-datatype z = datatype IntSize.t
 datatype z = datatype WordSize.t
 
 structure SmallIntInf =



1.5       +0 -2      mlton/mlton/atoms/int-x.fun

Index: int-x.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/int-x.fun,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- int-x.fun	9 Oct 2003 18:17:31 -0000	1.4
+++ int-x.fun	3 Mar 2004 02:08:59 -0000	1.5
@@ -3,8 +3,6 @@
 
 open S
 
-datatype z = datatype IntSize.t
-
 datatype t = T of {int: IntInf.t,
 		   size: IntSize.t}
    



1.70      +3 -4      mlton/mlton/atoms/prim.fun

Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -r1.69 -r1.70
--- prim.fun	19 Feb 2004 22:42:09 -0000	1.69
+++ prim.fun	3 Mar 2004 02:08:59 -0000	1.70
@@ -15,7 +15,6 @@
 
 open S
 
-datatype z = datatype IntSize.t
 datatype z = datatype RealSize.t
 datatype z = datatype WordSize.t	       
 
@@ -740,7 +739,7 @@
 		  s: WordSize.t) =
 	 let
 	    val x = f (WordX.toIntInf w, WordX.toIntInf w')
-	    val x' = x mod (Int.toIntInf (WordSize.size s))
+	    val x' = x mod (Int.toIntInf (WordSize.bits s))
 	 in
 	    if x = x'
 	       then word (WordX.fromLargeInt (x, s))
@@ -908,7 +907,7 @@
 				 (WordX.mod
 				  (w,
 				   WordX.make
-				   (LargeWord.fromInt (WordSize.size s), s)))
+				   (LargeWord.fromInt (WordSize.bits s), s)))
 				 then Var x
 			      else Unknown
 			   end
@@ -922,7 +921,7 @@
 				then Var x
 			     else if (WordX.>=
 				      (w, WordX.make (LargeWord.fromInt
-						      (WordSize.size s),
+						      (WordSize.bits s),
 						      WordSize.default)))
 				     then zero s
 				  else Unknown



1.9       +1 -1      mlton/mlton/atoms/type-ops.fun

Index: type-ops.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/type-ops.fun,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- type-ops.fun	9 Oct 2003 18:17:31 -0000	1.8
+++ type-ops.fun	3 Mar 2004 02:08:59 -0000	1.9
@@ -17,7 +17,7 @@
    structure RealSize = RealSize
    structure WordSize = WordSize
 end
-datatype intSize = datatype IntSize.t
+type intSize = IntSize.t
 datatype realSize = datatype RealSize.t
 type tycon = Tycon.t
 datatype wordSize = datatype WordSize.t



1.4       +3 -3      mlton/mlton/atoms/word-x.fun

Index: word-x.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/word-x.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word-x.fun	19 Feb 2004 22:42:09 -0000	1.3
+++ word-x.fun	3 Mar 2004 02:08:59 -0000	1.4
@@ -70,7 +70,7 @@
    let
       val {size = s, word = w} = dest w
       val {word = w', ...} = dest w'
-      val n = Word.fromInt (WordSize.size s)
+      val n = Word.fromInt (WordSize.bits s)
       val w' = Word.mod (w', n)
    in
       make (Word.orb (Word.>> (w, Word.toWord (Word.- (n, w'))),
@@ -82,7 +82,7 @@
    let
       val {size = s, word = w} = dest w
       val {word = w', ...} = dest w'
-      val n = Word.fromInt (WordSize.size s)
+      val n = Word.fromInt (WordSize.bits s)
       val w' = Word.mod (w', n)
    in
       make (Word.orb (Word.>> (w, Word.toWord w'),
@@ -147,7 +147,7 @@
 
 local
    fun wrap (f: Word.t * PWord.t -> Word.t) (w: t, w': t): t =
-      if Word.> (word w', Word.fromInt (WordSize.size (size w)))
+      if Word.> (word w', Word.fromInt (WordSize.bits (size w)))
 	 then zero (size w)
       else make (f (word w, Word.toWord (word w')),
 		 size w)



1.13      +0 -1      mlton/mlton/backend/machine-atoms.fun

Index: machine-atoms.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine-atoms.fun,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- machine-atoms.fun	19 Feb 2004 22:42:09 -0000	1.12
+++ machine-atoms.fun	3 Mar 2004 02:09:01 -0000	1.13
@@ -9,7 +9,6 @@
 struct
 
 open S
-datatype z = datatype IntSize.t
 datatype z = datatype WordSize.t
 
 structure ProfileLabel = ProfileLabel ()



1.22      +13 -1     mlton/mlton/backend/representation.fun

Index: representation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/representation.fun,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- representation.fun	20 Feb 2004 02:11:13 -0000	1.21
+++ representation.fun	3 Mar 2004 02:09:01 -0000	1.22
@@ -540,7 +540,19 @@
 	      case S.Type.dest t of
 		 Array t => SOME (array {mutable = true, ty = t})
 	       | Datatype tycon => convertDatatype tycon
-	       | Int s => SOME (R.Type.int s)
+	       | Int s =>
+		    let
+		       val bits =
+			  case IntSize.bits s of
+			     8 => 8
+			   | 16 => 16
+			   | 31 => 32
+			   | 32 => 32
+			   | 64 => 64
+			   | _ => Error.bug "strange size int"
+		    in
+		       SOME (R.Type.int (IntSize.I bits))
+		    end
 	       | IntInf => SOME R.Type.intInf
 	       | PreThread => SOME R.Type.thread
 	       | Real s => SOME (R.Type.real s)



1.41      +3 -1      mlton/mlton/backend/rssa.fun

Index: rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.fun,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- rssa.fun	20 Feb 2004 02:11:13 -0000	1.40
+++ rssa.fun	3 Mar 2004 02:09:01 -0000	1.41
@@ -648,7 +648,9 @@
 
       fun handlesSignals p =
 	 hasPrim (p, fn p =>
-		  Prim.name p = Prim.Name.MLton_installSignalHandler)
+		  case Prim.name p of
+		     Prim.Name.MLton_installSignalHandler => true
+		   | _ => false)
 	 
       fun layouts (T {functions, main, objectTypes, ...},
 		   output': Layout.t -> unit): unit =



1.56      +42 -49    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.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- ssa-to-rssa.fun	19 Feb 2004 22:42:09 -0000	1.55
+++ ssa-to-rssa.fun	3 Mar 2004 02:09:01 -0000	1.56
@@ -23,7 +23,6 @@
    structure GCField = GCField
 end
 
-datatype z = datatype IntSize.t
 datatype z = datatype WordSize.t
 
 structure CFunction =
@@ -33,8 +32,8 @@
       local
 	 open CType
       in
-	 val Int32 = Int I32
-	 val Int64 = Int I64
+	 val Int32 = Int (IntSize.I 32)
+	 val Int64 = Int (IntSize.I 64)
 	 val Word32 = Word W32
 	 val Word64 = Word W64
       end
@@ -917,10 +916,11 @@
 				       Option.map (toRtype (varType x), fn t =>
 						   (x, t))
 				  | NONE => NONE
-			      fun normal () =
+			      fun primApp prim =
 				 add (PrimApp {dst = dst (),
 					       prim = prim,
 					       args = varOps args})
+			      fun normal () = primApp prim
 			      datatype z = datatype Prim.Name.t
 			      fun bumpCanHandle n =
 				 let
@@ -1113,6 +1113,11 @@
 			      then updateCard (addr, fn ss => ss, assign)
 			   else loop (i - 1, assign::ss, t)
 			end
+		     fun int (s, f) =
+			if IntSize.equals (s, IntSize.I 64)
+			   andalso !Control.Native.native 
+			   then simpleCCall f
+			else normal ()
 			      datatype z = datatype Prim.Name.t
 			   in
 			      case Prim.name prim of
@@ -1171,57 +1176,45 @@
 				    ccall {args = Vector.new1 Operand.GCState,
 					   func = CFunction.unpack}
 			       | Int_equal s =>
-				    if s = IntSize.I64 andalso !Control.Native.native 
-				       then simpleCCall CFunction.int64Equal
-				       else normal ()
-			       | Int_ge s =>
-				    if s = IntSize.I64 andalso !Control.Native.native
-				       then simpleCCall (CFunction.intGe s)
-				    else normal ()
-			       | Int_gt s =>
-				    if s = IntSize.I64 andalso !Control.Native.native
-				       then simpleCCall (CFunction.intGt s)
-				    else normal ()
-			       | Int_le s =>
-				    if s = IntSize.I64 andalso !Control.Native.native
-				       then simpleCCall (CFunction.intLe s)
-				    else normal ()
-			       | Int_lt s =>
-				    if s = IntSize.I64 andalso !Control.Native.native
-				       then simpleCCall (CFunction.intLt s)
-				    else normal ()
-			       | Int_mul s =>
-				    if s = IntSize.I64 andalso !Control.Native.native
-				       then simpleCCall (CFunction.intMul s)
-				    else normal ()
-			       | Int_quot s =>
-				    if s = IntSize.I64
-				       orelse not (!Control.Native.native)
-				       then simpleCCall (CFunction.intQuot s)
-				    else normal ()
-			       | Int_rem s =>
-				    if s = IntSize.I64
-				       orelse not (!Control.Native.native)
-				       then simpleCCall (CFunction.intRem s)
-				    else normal ()
+				    (case IntSize.bits s of
+					31 => primApp (Prim.intEqual
+						       (IntSize.I 32))
+				      | 64 =>
+					   if !Control.Native.native
+					      then
+						 simpleCCall CFunction.int64Equal
+					   else normal ()
+				      | _ => normal ())
+			       | Int_ge s => int (s, CFunction.intGe s)
+			       | Int_gt s => int (s, CFunction.intGt s)
+			       | Int_le s => int (s, CFunction.intLe s)
+			       | Int_lt s => int (s, CFunction.intLt s)
+			       | Int_mul s => int (s, CFunction.intMul s)
+			       | Int_quot s => int (s, CFunction.intQuot s)
+			       | Int_rem s => int (s, CFunction.intRem s)
 			       | Int_toInt (s1, s2) =>
 				    let
-				       datatype z = datatype IntSize.t
+				       fun call () =
+					  if !Control.Native.native
+					     then
+						simpleCCall
+						(CFunction.intToInt (s1, s2))
+					  else normal ()
+				       val id = cast
 				    in
-				       if (case (s1, s2) of
-					      (I32, I64) => true
-					    | (I64, I32) => true
-					    | _ => false)
-					  andalso !Control.Native.native
-					  then simpleCCall (CFunction.intToInt (s1, s2))
-				       else normal ()
+				       case (IntSize.bits s1, IntSize.bits s2) of
+					  (32, 64) => call ()
+					| (64, 32) => call ()
+					| (31, 32) => id ()
+					| (32, 31) => id ()
+					| _ => normal ()
 				    end
 			       | Int_toWord (s1, s2) =>
 				    let
-				       datatype z = datatype IntSize.t
+				       datatype z = datatype IntSize.prim
 				       datatype z = datatype WordSize.t
 				    in
-				       if (case (s1, s2) of
+				       if (case (IntSize.prim s1, s2) of
 					      (I64, W32) => true
 					    | _ => false)
 					  andalso !Control.Native.native
@@ -1431,10 +1424,10 @@
 				    else normal ()
 			       | Word_toInt (s1, s2) =>
 				    let
-				       datatype z = datatype IntSize.t
+				       datatype z = datatype IntSize.prim
 				       datatype z = datatype WordSize.t
 				    in
-				       if (case (s1, s2) of
+				       if (case (s1, IntSize.prim s2) of
 					      (W32, I64) => true
 					    | _ => false)
 					  andalso !Control.Native.native



1.33      +3 -1      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.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- closure-convert.fun	20 Feb 2004 02:11:13 -0000	1.32
+++ closure-convert.fun	3 Mar 2004 02:09:02 -0000	1.33
@@ -596,7 +596,9 @@
       val convertVarExp = convertVar o SvarExp.var
       val handlesSignals =
 	 Sexp.hasPrim (body, fn p =>
-		       Prim.name p = Prim.Name.MLton_installSignalHandler)
+		       case Prim.name p of
+			  Prim.Name.MLton_installSignalHandler => true
+			| _ => false)
       (*------------------------------------*)      	       
       (*               apply                *)
       (*------------------------------------*)



1.8       +8 -3      mlton/mlton/closure-convert/globalize.fun

Index: globalize.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/closure-convert/globalize.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- globalize.fun	20 Feb 2004 02:11:14 -0000	1.7
+++ globalize.fun	3 Mar 2004 02:09:03 -0000	1.8
@@ -107,15 +107,20 @@
 				      * because polymorphic equality isn't implemented
 				      * there. 
 				      *)
-				     andalso Prim.name prim <> Prim.Name.MLton_equal)
+				     andalso
+				     (case Prim.name prim of
+					 Prim.Name.MLton_equal => false
+				       | _ => true))
 				    orelse
 				    (once andalso
 				     (case Prim.name prim of
 					 Prim.Name.Ref_ref => typeIsSmall ty
 				       | _ => false)))
 				val once =
-				   once andalso
-				   Prim.name prim <> Prim.Name.Thread_copyCurrent
+				    once andalso
+				    (case Prim.name prim of
+					Prim.Name.Thread_copyCurrent => false
+				      | _ => true)
 			     in
 				(global, once)
 			     end



1.73      +3 -3      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.72
retrieving revision 1.73
diff -u -r1.72 -r1.73
--- c-codegen.fun	19 Feb 2004 22:42:11 -0000	1.72
+++ c-codegen.fun	3 Mar 2004 02:09:03 -0000	1.73
@@ -42,7 +42,6 @@
    structure WordX = WordX
 end
 
-datatype z = datatype IntSize.t
 datatype z = datatype RealSize.t
 datatype z = datatype WordSize.t
 
@@ -85,8 +84,9 @@
 	       else if IntX.isMin i
 		       then min
 		    else neg ()
+	    datatype z = datatype IntSize.prim
 	 in
-	    case size i of
+	    case IntSize.prim (size i) of
 	       I8 => simple "8"
 	     | I16 => simple "16"
 	     | I32 => tricky ("0x80000000")
@@ -411,7 +411,7 @@
 	    case t of
 	       EnumPointers {pointers, ...} =>
 		  if 0 = Vector.length pointers
-		     then int I32
+		     then int (IntSize.I 32)
 		  else pointer
 	     | ExnStack => word W32
 	     | Int s => int s



1.27      +0 -2      mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun

Index: x86-mlton-basic.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- x86-mlton-basic.fun	24 Feb 2004 02:28:04 -0000	1.26
+++ x86-mlton-basic.fun	3 Mar 2004 02:09:05 -0000	1.27
@@ -315,7 +315,6 @@
        WordSize.memoize
        (fn s => Label.fromString (concat ["localWord", WordSize.toString s]))
     datatype z = datatype CType.t
-    datatype z = datatype IntSize.t
   in
     fun local_base ty =
        case ty of
@@ -336,7 +335,6 @@
      val globalW_base =
 	make ("Word", WordSize.memoize, WordSize.toString)
     datatype z = datatype CType.t
-    datatype z = datatype IntSize.t
   in
      fun global_base ty =
 	case ty of



1.56      +23 -22    mlton/mlton/codegen/x86-codegen/x86-mlton.fun

Index: x86-mlton.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton.fun,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- x86-mlton.fun	3 Mar 2004 01:33:16 -0000	1.55
+++ x86-mlton.fun	3 Mar 2004 02:09:05 -0000	1.56
@@ -15,8 +15,9 @@
      open Machine
   in
      structure CFunction = CFunction
+     structure IntSize = IntSize
      structure Prim = Prim
-     datatype z = datatype IntSize.t
+     datatype z = datatype IntSize.prim
      datatype z = datatype RealSize.t
      datatype z = datatype WordSize.t
   end
@@ -605,49 +606,49 @@
 		     transfer = NONE}]
 		end
              | Int_add s => 
-		(case s of
+		(case IntSize.prim s of
 		    I8 => binal Instruction.ADD
 		  | I16 => binal Instruction.ADD
 		  | I32 => binal Instruction.ADD
 		  | I64 => binal64 (Instruction.ADD, Instruction.ADC))
 	     | Int_equal s => 	
-		(case s of
+		(case IntSize.prim s of
 		    I8 => cmp Instruction.E
 		  | I16 => cmp Instruction.E
 		  | I32 => cmp Instruction.E
 		  | I64 => Error.bug "FIXME")
 	     | Int_ge s => 	
-		(case s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(case IntSize.prim s of
 		    I8 => pmd Instruction.IMUL
 		  | I16 => imul2 () 
 		  | I32 => imul2 ()
 		  | I64 => Error.bug "FIXME")
 	     | Int_neg s => 
-		(case s of
+		(case IntSize.prim s of
 		    I8 => unal Instruction.NEG 
 		  | I16 => unal Instruction.NEG 
 		  | I32 => unal Instruction.NEG 
@@ -658,25 +659,25 @@
 							 src = Operand.immediate_const_int 0,
 							 size = dstsize}]))
 	     | Int_quot s => 
-		(case s of
+		(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 s of
+		(case IntSize.prim s of
 		    I8 => pmd Instruction.IMOD
 		  | I16 => pmd Instruction.IMOD
 		  | I32 => pmd Instruction.IMOD
 		  | I64 => Error.bug "FIXME")
 	     | Int_sub s => 
-		(case s of
+		(case IntSize.prim s of
 		    I8 => binal Instruction.SUB
 		  | I16 => binal Instruction.SUB
 		  | I32 => binal Instruction.SUB
 		  | I64 => binal64 (Instruction.SUB, Instruction.SBB))
 	     | Int_toInt (s, s') =>
-		(case (s, s') of
+		(case (IntSize.prim s, IntSize.prim s') of
 		    (I64, I64) => Error.bug "FIXME"
 		  | (I64, I32) => Error.bug "FIXME"
 		  | (I64, I16) => Error.bug "FIXME"
@@ -736,7 +737,7 @@
 			transfer = NONE}]
 		    end 
 		in
-		   case (s, s') of
+		   case (IntSize.prim s, s') of
 		      (I64, R64) => Error.bug "FIXME"
 		    | (I64, R32) => Error.bug "FIXME"
 		    | (I32, R64) => default ()
@@ -747,7 +748,7 @@
 		    | (I8, R32) => default' ()
 		end
 	     | Int_toWord (s, s') =>
-		(case (s, s') of
+		(case (IntSize.prim s, s') of
 		    (I64, W64) => Error.bug "FIXME"
 		  | (I64, W32) => Error.bug "FIXME"
 		  | (I64, W16) => Error.bug "FIXME"
@@ -1245,7 +1246,7 @@
 			transfer = NONE}]
 		    end 
 		in
-		   case (s, s') of
+		   case (s, IntSize.prim s') of
 		      (R64, I64) => Error.bug "FIXME"
 		    | (R64, I32) => default ()
 		    | (R64, I16) => default ()
@@ -1455,7 +1456,7 @@
 		  | W32 => binal Instruction.SUB
 		  | W64 => binal64 (Instruction.SUB, Instruction.SBB))
 	     | Word_toInt (s, s') =>
-		(case (s, s') of
+		(case (s, IntSize.prim s') of
 		   (W64, I64) => Error.bug "FIXME"
 		 | (W64, I32) => Error.bug "FIXME"
 		 | (W64, I16) => Error.bug "FIXME"
@@ -1473,7 +1474,7 @@
 		 | (W8, I16) => movx Instruction.MOVZX
 		 | (W8, I8) => mov ())
 	     | Word_toIntX (s, s') =>
-		(case (s, s') of
+		(case (s, IntSize.prim s') of
 		   (W64, I64) => Error.bug "FIXME"
 		 | (W64, I32) => Error.bug "FIXME"
 		 | (W64, I16) => Error.bug "FIXME"
@@ -1883,25 +1884,25 @@
 	[comment_begin,
 	 (case Prim.name prim of
 	     Int_addCheck s => 
-	       (case s of
+	       (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 s of
+	       (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 s of
+	       (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 s of
+	       (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)



1.52      +5 -3      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.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- x86-translate.fun	24 Feb 2004 02:28:04 -0000	1.51
+++ x86-translate.fun	3 Mar 2004 02:09:06 -0000	1.52
@@ -32,7 +32,6 @@
      structure WordX = WordX
   end
 
-  datatype z = datatype IntSize.t
   datatype z = datatype RealSize.t
   datatype z = datatype WordSize.t
   
@@ -169,8 +168,9 @@
 	  | Int i =>
 	       let
 		  val i'' = fn () => x86.Operand.immediate_const_int (IntX.toInt i)
+		  datatype z = datatype IntSize.prim
 	       in
-		  case IntX.size i of
+		  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)
@@ -864,7 +864,9 @@
 			  end
 		     | Int {cases, default, size, test} =>
 			  (Assert.assert("x86Translate.Transfer.toX86Blocks: Switch/Int", 
-					 fn () => size <> IntSize.I64)
+					 fn () =>
+					 not (IntSize.equals
+					      (size, IntSize.I 64)))
 			   ; simple ({cases = (Vector.map
 					       (cases, fn (i, l) =>
 						(IntX.toInt i, l))),



1.49      +20 -14    mlton/mlton/codegen/x86-codegen/x86.fun

Index: x86.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.fun,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- x86.fun	3 Mar 2004 01:33:16 -0000	1.48
+++ x86.fun	3 Mar 2004 02:09:06 -0000	1.49
@@ -141,12 +141,14 @@
 	 fun fromCType t =
 	    case t of
 	       Int s =>
-		  let datatype z = datatype IntSize.t
-		  in case s of
-		       I8 => Vector.new1 BYTE
-		     | I16 => Vector.new1 WORD
-		     | I32 => Vector.new1 LONG
-		     | I64 => Vector.new2 (LONG, LONG)
+		  let
+		     datatype z = datatype IntSize.prim
+		  in
+		     case IntSize.prim s of
+			I8 => Vector.new1 BYTE
+		      | I16 => Vector.new1 WORD
+		      | I32 => Vector.new1 LONG
+		      | I64 => Vector.new2 (LONG, LONG)
 		  end
 	     | Pointer => Vector.new1 LONG
 	     | Real s => 
@@ -698,12 +700,14 @@
 	 fun fromCType t =
 	    case t of
 	       Int s =>
-		  let datatype z = datatype IntSize.t
-		  in case s of
-		       I8 => One
-		     | I16 => Two
-		     | I32 => Four
-		     | I64 => Eight
+		  let
+		     datatype z = datatype IntSize.prim
+		  in
+		     case IntSize.prim s of
+			I8 => One
+		      | I16 => Two
+		      | I32 => Four
+		      | I64 => Eight
 		  end
 	     | Pointer => Four
 	     | Real s => 
@@ -1438,8 +1442,10 @@
       in
 	 fun cReturnTemps ty =
 	    case ty of
-	       Int s => let datatype z = datatype IntSize.t
-			in case s of
+	       Int s => let
+			   datatype z = datatype IntSize.prim
+			in
+			   case IntSize.prim s of
 			     I8 => [{src = register Register.al,
 				     dst = cReturnTempContent (0, BYTE)}]
 			   | I16 => [{src = register Register.ax,



1.8       +1 -1      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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- match-compile.fun	19 Feb 2004 22:42:15 -0000	1.7
+++ match-compile.fun	3 Mar 2004 02:09:06 -0000	1.8
@@ -143,7 +143,7 @@
 					   Vector.fromList infos))))))
 in
    val directCases = 
-      make (List.remove (IntSize.all, fn s => IntSize.I64 = s),
+      make (List.remove (IntSize.all, fn s => IntSize.equals (s, IntSize.I 64)),
 	    IntSize.cardinality, Type.int, Cases.int,
 	    fn Const.Int i => i
 	     | _ => Error.bug "caseInt type error")



1.21      +6 -2      mlton/mlton/ssa/local-ref.fun

Index: local-ref.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/local-ref.fun,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- local-ref.fun	18 Feb 2004 04:24:10 -0000	1.20
+++ local-ref.fun	3 Mar 2004 02:09:07 -0000	1.21
@@ -156,7 +156,9 @@
 	       Option.app (var, fn var => 
 			   case exp
 			     of PrimApp {prim, ...}
-			      => if Prim.name prim = Prim.Name.Ref_ref
+			      => if (case Prim.name prim of
+					Prim.Name.Ref_ref => true
+				      | _ => false)
 				   then setGlobalInfo(var, GlobalInfo.new true)
 				   else ()
 			      | _ => ()))
@@ -178,7 +180,9 @@
 	       in
 		 case exp
 		   of PrimApp {prim, args, ...}
-		    => if Prim.name prim = Prim.Name.Ref_ref
+		    => if (case Prim.name prim of
+			      Prim.Name.Ref_ref => true
+			    | _ => false)
 			 then ignore
 			      (FuncLattice.<=
 			       (GlobalInfo.funcUses 



1.8       +7 -2      mlton/mlton/ssa/multi.fun

Index: multi.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/multi.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- multi.fun	20 Feb 2004 02:11:15 -0000	1.7
+++ multi.fun	3 Mar 2004 02:09:08 -0000	1.8
@@ -134,7 +134,10 @@
 fun multi (p as Program.T {functions, main, ...})
   = let
       val usesThreadsOrConts 
-	= Program.hasPrim (p, fn p => Prim.name p = Prim.Name.Thread_switchTo)
+	= Program.hasPrim (p, fn p =>
+			   case Prim.name p of
+			      Prim.Name.Thread_switchTo => true
+			    | _ => false)
 
       (* funcNode *)
       val {get = funcNode: Func.t -> unit Node.t,
@@ -213,7 +216,9 @@
 		      | Runtime {prim, ...}
 		      => if usesThreadsOrConts
 			    andalso
-			    Prim.name prim = Prim.Name.Thread_copyCurrent
+			    (case Prim.name prim of
+				Prim.Name.Thread_copyCurrent => true
+			      | _ => false)
 			   then (ThreadCopyCurrent.force
 				 (LabelInfo.threadCopyCurrent li) ;
 				 ThreadCopyCurrent.force



1.16      +17 -23    mlton/mlton/ssa/redundant-tests.fun

Index: redundant-tests.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/redundant-tests.fun,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- redundant-tests.fun	18 Feb 2004 04:24:21 -0000	1.15
+++ redundant-tests.fun	3 Mar 2004 02:09:08 -0000	1.16
@@ -151,31 +151,25 @@
 	 val (falseVar, f) = make Con.falsee
       end
       local
-	 fun make s =
-	    let
-	       val one = Var.newNoname ()
-	       val oneS = 
-		  Statement.T {exp = Exp.Const (Const.int (IntX.one s)),
-			       ty = Type.int s,
-			       var = SOME one}
-	    in
-	       (one,oneS)
-	    end
-	 datatype z = datatype IntX.IntSize.t
-	 val (one8, oneS8) = make I8
-	 val (one16, oneS16) = make I16
-	 val (one32, oneS32) = make I32
-	 val (one64, oneS64) = make I64
+	 val statements = ref []
       in
-	 fun one s =
-	   case s of
-	     I8 => one8
-	   | I16 => one16
-	   | I32 => one32
-	   | I64 => one64
-	 val oneSs = Vector.new4 (oneS8, oneS16, oneS32, oneS64)
+	 val one =
+	    IntSize.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,
+				 var = SOME one})
+	     in
+		one
+	     end)
+	 val ones = Vector.fromList (!statements)
       end
-      val globals = Vector.concat [Vector.new2 (t, f), oneSs, globals]
+      val globals = Vector.concat [Vector.new2 (t, f), ones, globals]
       val shrink = shrinkFunction globals
       val numSimplified = ref 0
       fun simplifyFunction f =



1.65      +12 -13    mlton/mlton/ssa/ssa-tree.fun

Index: ssa-tree.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ssa-tree.fun,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- ssa-tree.fun	20 Feb 2004 02:11:15 -0000	1.64
+++ ssa-tree.fun	3 Mar 2004 02:09:08 -0000	1.65
@@ -9,7 +9,6 @@
 struct
 
 open S
-datatype z = datatype IntSize.t
 datatype z = datatype RealSize.t
 datatype z = datatype WordSize.t
 
@@ -54,19 +53,16 @@
 
 	 val tycons =
 	    [(Tycon.array, unary Array)]
-	    @ List.map (Tycon.ints, fn (t, s) =>
-			(t, nullary (Int s)))
+	    @ Vector.toListMap (Tycon.ints, fn (t, s) => (t, nullary (Int s)))
 	    @ [(Tycon.intInf, nullary IntInf),
 	       (Tycon.preThread, nullary PreThread)]
-	    @ List.map (Tycon.reals, fn (t, s) =>
-			(t, nullary (Real s)))
+	    @ Vector.toListMap (Tycon.reals, fn (t, s) => (t, nullary (Real s)))
 	    @ [(Tycon.reff, unary Ref),
 	       (Tycon.thread, nullary Thread),
 	       (Tycon.tuple, Tuple),
 	       (Tycon.vector, unary Vector),
 	       (Tycon.weak, unary Weak)]
-	    @ List.map (Tycon.words, fn (t, s) =>
-			(t, nullary (Word s)))
+	    @ Vector.toListMap (Tycon.words, fn (t, s) => (t, nullary (Word s)))
       in
 	 val _ = List.foreach (tycons, fn (tycon, f) => set (tycon, SOME f))
 
@@ -614,12 +610,15 @@
 		     return: Label.t} (* Must be nullary. *)
 
       fun iff (test: Var.t, {truee, falsee}) =
-	 Case
-	 {cases = Cases.Int (I32,
-			     Vector.new2 ((IntX.zero I32, falsee),
-					  (IntX.one I32, truee))),
-	  default = NONE,
-	  test = test}
+	 let
+	    val s = IntSize.I 32
+	 in
+	    Case
+	    {cases = Cases.Int (s, Vector.new2 ((IntX.zero s, falsee),
+						(IntX.one s, truee))),
+	     default = NONE,
+	     test = test}
+	 end
 	 
       fun foreachFuncLabelVar (t, func, label: Label.t -> unit, var) =
 	 let



1.14      +8 -6      mlton/mlton/xml/implement-exceptions.fun

Index: implement-exceptions.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/implement-exceptions.fun,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- implement-exceptions.fun	18 Feb 2004 04:24:24 -0000	1.13
+++ implement-exceptions.fun	3 Mar 2004 02:09:08 -0000	1.14
@@ -54,7 +54,8 @@
 	    let
 	       val sumTycon = Tycon.newNoname ()
 	       val sumType = Type.con (sumTycon, Vector.new0 ())
-	       fun find (name: Prim.Name.t): Var.t * Type.t * PrimExp.t =
+	       fun find (nameString: string, isName: Prim.Name.t -> bool)
+		  : Var.t * Type.t * PrimExp.t =
 		  let
 		     val var =
 			DynamicWind.withEscape
@@ -65,14 +66,13 @@
 			       (body, fn (_, _, e) =>
 				case e of
 				   PrimApp {args, prim, ...} =>
-				      if Prim.name prim = name 
+				      if isName (Prim.name prim)
 					 then escape (VarExp.var
 						      (Vector.sub (args, 0)))
 				      else ()
 				 | _ => ())
 			 in
-			    Error.bug
-			    (concat ["can't find ", Prim.Name.toString name])
+			    Error.bug (concat ["can't find it", nameString])
 			 end)
 		     val (ty, exp) =
 			DynamicWind.withEscape
@@ -90,10 +90,12 @@
 		     (var, ty, exp)
 		  end
 	       val (initExtraVar, initExtraType, initExtraExp) =
-		  find Prim.Name.Exn_setInitExtra
+		  find ("Exn_setInitExtra",
+			fn Prim.Name.Exn_setInitExtra => true | _ => false)
 	       val extraType = initExtraType
 	       val (extendExtraVar, extendExtraType, extendExtraExp) =
-		  find Prim.Name.Exn_setExtendExtra
+		  find ("Exn_setExtendExtra",
+			fn Prim.Name.Exn_setExtendExtra => true | _ => false)
 	       local
 		  open Type
 	       in



1.5       +1 -0      mlton/regression/fixed-integer.sml

Index: fixed-integer.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/fixed-integer.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- fixed-integer.sml	1 Aug 2003 14:55:56 -0000	1.4
+++ fixed-integer.sml	3 Mar 2004 02:09:08 -0000	1.5
@@ -212,5 +212,6 @@
 
 structure S = Test (Int8)
 structure S = Test (Int16)
+structure S = Test (Int31)
 structure S = Test (Int32)
 structure S = Test (Int64)