[MLton] cvs commit: Added Word<N> structures

Stephen Weeks sweeks@mlton.org
Thu, 4 Mar 2004 19:50:55 -0800


sweeks      04/03/04 19:50:55

  Modified:    basis-library/libs build
               basis-library/libs/basis-2002/top-level basis.sig basis.sml
                        overloads.sml
               basis-library/misc primitive.sml
               lib/mlton/basic int-inf.sml
               mlton    mlton-stubs.cm
               mlton/ast ast-atoms.fun int-size.fun prim-tycons.fun
                        real-size.fun real-size.sig word-size.fun
                        word-size.sig
               mlton/atoms c-function.fun c-type.fun const.fun prim.fun
                        prim.sig type-ops.fun word-x.fun word-x.sig
               mlton/backend backend.fun limit-check.fun machine-atoms.fun
                        machine.fun profile.fun representation.fun rssa.fun
                        ssa-to-rssa.fun
               mlton/codegen/c-codegen c-codegen.fun
               mlton/codegen/x86-codegen x86-mlton.fun x86-translate.fun
                        x86.fun
               mlton/defunctorize defunctorize.fun
               mlton/elaborate elaborate-core.fun type-env.fun
               mlton/main lookup-constant.fun
               mlton/match-compile match-compile.fun
               mlton/ssa ssa-tree.fun type-check.fun
  Added:       basis-library/integer embed-int.sml embed-word.sml
               basis-library/libs/basis-2002/top-level .cvsignore Makefile
                        generate-overloads.sml
  Removed:     basis-library/integer embed.sml
               lib/mlton-stubs int-inf.sml
  Log:
  MAIL Added Word<N> structures
  
  We now have Word{2,3,...,32,64}.  These were implemented similarly to
  Int{2,3,...,32,64}, by converting words to the next larger size
  Word{8,16,32,64} and doing the operation there.
  
  Reimplemented WordX to use IntInf istead of LargeWord.  This cleaned
  things up, and removed any use of LargeWord from the compiler.  It
  also meant that I had to remove the stubs for IntInf bitop functions
  (andb, <<, etc) when compiling with old versions of MLton, since these
  functions are now used.  That's no big deal, since it only rules out
  older releases of MLton.
  
  Added a script (skit?) that automatically generates the overloads.sml
  file, which is getting quite huge with all the new integer and word
  types.

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

Index: embed-int.sml
===================================================================
signature EMBED_INT =
   sig
      eqtype int
      type big
	 
      val precision': Int.int
      val fromBigUnsafe: big -> int
      val toBig: int -> big
   end

functor EmbedInt (structure Big: INTEGER
		  structure Small: EMBED_INT where type big = Big.int): INTEGER =
   struct
      val () = if Int.< (Small.precision', valOf Big.precision) then ()
	       else raise Fail "EmbedWord"

      open Small
	 
      val precision = SOME precision'

      val maxIntBig =
	 Big.fromLarge
	 (IntInf.- (LargeInt.<< (1, 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

functor Embed8 (Small: EMBED_INT where type big = Int8.int): INTEGER =
   EmbedInt (structure Big = Int8
	     structure Small = Small)

functor Embed16 (Small: EMBED_INT where type big = Int16.int): INTEGER =
   EmbedInt (structure Big = Int16
	     structure Small = Small)

functor Embed32 (Small: EMBED_INT where type big = Int32.int): INTEGER =
   EmbedInt (structure Big = Int32
	     structure Small = Small)

structure Int2 = Embed8 (Primitive.Int2)
structure Int3 = Embed8 (Primitive.Int3)
structure Int4 = Embed8 (Primitive.Int4)
structure Int5 = Embed8 (Primitive.Int5)
structure Int6 = Embed8 (Primitive.Int6)
structure Int7 = Embed8 (Primitive.Int7)
structure Int9 = Embed16 (Primitive.Int9)
structure Int10 = Embed16 (Primitive.Int10)
structure Int11 = Embed16 (Primitive.Int11)
structure Int12 = Embed16 (Primitive.Int12)
structure Int13 = Embed16 (Primitive.Int13)
structure Int14 = Embed16 (Primitive.Int14)
structure Int15 = Embed16 (Primitive.Int15)
structure Int17 = Embed32 (Primitive.Int17)
structure Int18 = Embed32 (Primitive.Int18)
structure Int19 = Embed32 (Primitive.Int19)
structure Int20 = Embed32 (Primitive.Int20)
structure Int21 = Embed32 (Primitive.Int21)
structure Int22 = Embed32 (Primitive.Int22)
structure Int23 = Embed32 (Primitive.Int23)
structure Int24 = Embed32 (Primitive.Int24)
structure Int25 = Embed32 (Primitive.Int25)
structure Int26 = Embed32 (Primitive.Int26)
structure Int27 = Embed32 (Primitive.Int27)
structure Int28 = Embed32 (Primitive.Int28)
structure Int29 = Embed32 (Primitive.Int29)
structure Int30 = Embed32 (Primitive.Int30)
structure Int31 = Embed32 (Primitive.Int31)



1.1                  mlton/basis-library/integer/embed-word.sml

Index: embed-word.sml
===================================================================
signature EMBED_WORD =
   sig
      eqtype word
      type big
	 
      val fromBigUnsafe: big -> word
      val toBig: word -> big
      val wordSize: Int.int
   end

functor EmbedWord (structure Big: WORD
		   structure Small: EMBED_WORD where type big = Big.word): WORD =
   struct
      val () = if Int.< (Small.wordSize, Big.wordSize) then ()
	       else raise Fail "EmbedWord"
		  
      open Small

      fun ones size =
	 Big.fromLargeInt (IntInf.- (IntInf.<< (1, Word.fromInt size), 1))
	 
      val maxWord = ones wordSize

      fun fromBig (w: Big.word): word =
	 fromBigUnsafe (Big.andb (w, maxWord))

      fun fromBigOverflow (w: Big.word): word =
	 if Big.<= (w, maxWord)
	    then fromBigUnsafe w
	 else raise Overflow

      fun highBitIsSet (w: Big.word): bool =
	 Big.> (w, ones (Int.- (wordSize, 1)))
	 
      fun toBigX (w: word): Big.word =
	 let
	    val w = toBig w
	 in
	    if highBitIsSet w
	       then Big.orb (w, Big.notb maxWord)
	    else w
	 end

      local
	 val make: (Big.word * Big.word -> Big.word) -> (word * word -> word) =
	    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 andb = make Big.andb
	 val op div = make Big.div
	 val op mod = make Big.mod
	 val orb  = make Big.orb
	 val xorb  = make Big.xorb
      end

      local
	 val make: ((Big.word * Word.word -> Big.word)
		    -> word * Word.word -> word) =
	    fn f => fn (w, w') => fromBig (f (toBig w, w'))
      in
	 val >> = make Big.>>
	 val << = make Big.<<
      end

      fun ~>> (w, w') = fromBig (Big.~>> (toBigX w, w'))

      local
	 val make: (Big.word * Big.word -> 'a) -> (word * word -> '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

      local
	 val make: (Big.word -> Big.word) -> word -> word =
	    fn f => fn w => fromBig (f (toBig w))
      in
	 val notb = make Big.notb
      end

      local
	 val make: ('a -> Big.word) -> 'a -> word =
	    fn f => fn a => fromBig (f a)
      in
	 val fromInt = make Big.fromInt
	 val fromLarge = make Big.fromLarge
	 val fromLargeInt = make Big.fromLargeInt
      end

      local
	 val make: (Big.word -> 'a) -> word -> 'a =
	    fn f => fn w => f (toBig w)
      in
	 val toInt = make Big.toInt
	 val toLarge = make Big.toLarge
	 val toLargeInt = make Big.toLargeInt
	 val toString = make Big.toString
      end

      local
	 val make: (Big.word -> 'a) -> word -> 'a =
	    fn f => fn w => f (toBigX w)
      in
	 val toIntX = make Big.toIntX
	 val toLargeIntX = make Big.toLargeIntX
	 val toLargeX = make Big.toLargeX
      end

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

      val fromLargeWord = fromLarge

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

      fun max (w, w') = if w >= w' then w else w'

      fun min (w, w') = if w <= w' then w else w'

      fun scan r reader state =
	 Option.map
	 (fn (w, state) => (fromBigOverflow w, state))
	 (Big.scan r reader state)

      val toLargeWord = toLarge

      val toLargeWordX = toLargeX
	 
      fun ~ w = fromInt 0 - w
   end

functor EmbedWord8 (Small: EMBED_WORD where type big = Word8.word): WORD =
   EmbedWord (structure Big = Word8
	      structure Small = Small)

functor EmbedWord16 (Small: EMBED_WORD where type big = Word16.word): WORD =
   EmbedWord (structure Big = Word16
	      structure Small = Small)

functor EmbedWord32 (Small: EMBED_WORD where type big = Word32.word): WORD =
   EmbedWord (structure Big = Word32
	      structure Small = Small)

structure Word2 = EmbedWord8 (Primitive.Word2)
structure Word3 = EmbedWord8 (Primitive.Word3)
structure Word4 = EmbedWord8 (Primitive.Word4)
structure Word5 = EmbedWord8 (Primitive.Word5)
structure Word6 = EmbedWord8 (Primitive.Word6)
structure Word7 = EmbedWord8 (Primitive.Word7)
structure Word9 = EmbedWord16 (Primitive.Word9)
structure Word10 = EmbedWord16 (Primitive.Word10)
structure Word11 = EmbedWord16 (Primitive.Word11)
structure Word12 = EmbedWord16 (Primitive.Word12)
structure Word13 = EmbedWord16 (Primitive.Word13)
structure Word14 = EmbedWord16 (Primitive.Word14)
structure Word15 = EmbedWord16 (Primitive.Word15)
structure Word17 = EmbedWord32 (Primitive.Word17)
structure Word18 = EmbedWord32 (Primitive.Word18)
structure Word19 = EmbedWord32 (Primitive.Word19)
structure Word20 = EmbedWord32 (Primitive.Word20)
structure Word21 = EmbedWord32 (Primitive.Word21)
structure Word22 = EmbedWord32 (Primitive.Word22)
structure Word23 = EmbedWord32 (Primitive.Word23)
structure Word24 = EmbedWord32 (Primitive.Word24)
structure Word25 = EmbedWord32 (Primitive.Word25)
structure Word26 = EmbedWord32 (Primitive.Word26)
structure Word27 = EmbedWord32 (Primitive.Word27)
structure Word28 = EmbedWord32 (Primitive.Word28)
structure Word29 = EmbedWord32 (Primitive.Word29)
structure Word30 = EmbedWord32 (Primitive.Word30)
structure Word31 = EmbedWord32 (Primitive.Word31)



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

Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- build	3 Mar 2004 02:08:58 -0000	1.32
+++ build	5 Mar 2004 03:50:50 -0000	1.33
@@ -74,7 +74,8 @@
 real/real32.sml
 real/real64.sml
 integer/patch.sml
-integer/embed.sml
+integer/embed-int.sml
+integer/embed-word.sml
 
 top-level/arithmetic.sml
 



1.46      +61 -5     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.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- basis.sig	3 Mar 2004 17:54:41 -0000	1.45
+++ basis.sig	5 Mar 2004 03:50:50 -0000	1.46
@@ -117,7 +117,6 @@
       structure VectorSlice : VECTOR_SLICE	
       structure Vector : VECTOR	
       structure Word : WORD	
-      structure Word8 : WORD	
       structure Word8Array : MONO_ARRAY	
       structure Word8Array2 : MONO_ARRAY2	
       structure Word8ArraySlice : MONO_ARRAY_SLICE	
@@ -256,24 +255,53 @@
 (*
       structure Windows : WINDOWS
 *)
+      structure Word2: WORD
+      structure Word3: WORD
+      structure Word4: WORD
+      structure Word5: WORD
+      structure Word6: WORD
+      structure Word7: WORD
+      structure Word8: WORD
+      structure Word9: WORD
+      structure Word10: WORD
+      structure Word11: WORD
+      structure Word12: WORD
+      structure Word13: WORD
+      structure Word14: WORD
+      structure Word15: WORD
+      structure Word16: WORD
+      structure Word17: WORD
+      structure Word18: WORD
+      structure Word19: WORD
+      structure Word20: WORD
+      structure Word21: WORD
+      structure Word22: WORD
+      structure Word23: WORD
+      structure Word24: WORD
+      structure Word25: WORD
+      structure Word26: WORD
+      structure Word27: WORD
+      structure Word28: WORD
+      structure Word29: WORD
+      structure Word30: WORD
+      structure Word31: WORD
+      structure Word32: WORD
+      structure Word64: WORD
       structure WordArray : MONO_ARRAY
       structure WordArray2 : MONO_ARRAY2
       structure WordArraySlice : MONO_ARRAY_SLICE
       structure WordVector : MONO_VECTOR
       structure WordVectorSlice : MONO_VECTOR_SLICE
-      structure Word16 : WORD
       structure Word16Array : MONO_ARRAY
       structure Word16Array2 : MONO_ARRAY2
       structure Word16ArraySlice : MONO_ARRAY_SLICE
       structure Word16Vector : MONO_VECTOR
       structure Word16VectorSlice : MONO_VECTOR_SLICE
-      structure Word32 : WORD
       structure Word32Array : MONO_ARRAY
       structure Word32Array2 : MONO_ARRAY2
       structure Word32ArraySlice : MONO_ARRAY_SLICE
       structure Word32Vector : MONO_VECTOR
       structure Word32VectorSlice : MONO_VECTOR_SLICE
-      structure Word64 : WORD
       structure Word64Array : MONO_ARRAY
       structure Word64Array2 : MONO_ARRAY2
       structure Word64ArraySlice : MONO_ARRAY_SLICE
@@ -604,7 +632,6 @@
    where type string = string
    where type substring = substring
    where type unit = unit
-   where type word = word
 
    (* Types referenced in signatures by structure name *)
 (*
@@ -690,8 +717,37 @@
    where type Int64.int = Int64.int
    where type IntInf.int = IntInf.int
    where type Real32.real = Real32.real
+   where type Word2.word = Word2.word
+   where type Word3.word = Word3.word
+   where type Word4.word = Word4.word
+   where type Word5.word = Word5.word
+   where type Word6.word = Word6.word
+   where type Word7.word = Word7.word
    where type Word8.word = Word8.word
+   where type Word9.word = Word9.word
+   where type Word10.word = Word10.word
+   where type Word11.word = Word11.word
+   where type Word12.word = Word12.word
+   where type Word13.word = Word13.word
+   where type Word14.word = Word14.word
+   where type Word15.word = Word15.word
    where type Word16.word = Word16.word
+   where type Word17.word = Word17.word
+   where type Word18.word = Word18.word
+   where type Word19.word = Word19.word
+   where type Word20.word = Word20.word
+   where type Word21.word = Word21.word
+   where type Word22.word = Word22.word
+   where type Word23.word = Word23.word
+   where type Word24.word = Word24.word
+   where type Word25.word = Word25.word
+   where type Word26.word = Word26.word
+   where type Word27.word = Word27.word
+   where type Word28.word = Word28.word
+   where type Word29.word = Word29.word
+   where type Word30.word = Word30.word
+   where type Word31.word = Word31.word
+   where type Word32.word = Word32.word
    where type Word64.word = Word64.word
 
    where type 'a MLton.Thread.t = 'a MLton.Thread.t



1.22      +32 -2     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.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- basis.sml	3 Mar 2004 17:54:41 -0000	1.21
+++ basis.sml	5 Mar 2004 03:50:50 -0000	1.22
@@ -179,6 +179,38 @@
 (*
       structure Windows = Windows
 *)
+      structure Word2 = Word2
+      structure Word3 = Word3
+      structure Word4 = Word4
+      structure Word5 = Word5
+      structure Word6 = Word6
+      structure Word7 = Word7
+      structure Word8 = Word8
+      structure Word9 = Word9
+      structure Word10 = Word10
+      structure Word11 = Word11
+      structure Word12 = Word12
+      structure Word13 = Word13
+      structure Word14 = Word14
+      structure Word15 = Word15
+      structure Word16 = Word16
+      structure Word17 = Word17
+      structure Word18 = Word18
+      structure Word19 = Word19
+      structure Word20 = Word20
+      structure Word21 = Word21
+      structure Word22 = Word22
+      structure Word23 = Word23
+      structure Word24 = Word24
+      structure Word25 = Word25
+      structure Word26 = Word26
+      structure Word27 = Word27
+      structure Word28 = Word28
+      structure Word29 = Word29
+      structure Word30 = Word30
+      structure Word31 = Word31
+      structure Word32 = Word32
+      structure Word64 = Word64
       structure WordArray = WordArray
       structure WordArray2 = WordArray2
       structure WordArraySlice = WordArraySlice
@@ -190,13 +222,11 @@
       structure Word16ArraySlice = Word16ArraySlice
       structure Word16Vector = Word16Vector
       structure Word16VectorSlice = Word16VectorSlice
-      structure Word32 = Word32
       structure Word32Array = Word32Array
       structure Word32Array2 = Word32Array2
       structure Word32ArraySlice = Word32ArraySlice
       structure Word32Vector = Word32Vector
       structure Word32VectorSlice = Word32VectorSlice
-      structure Word64 = Word64
       structure Word64Array = Word64Array
       structure Word64Array2 = Word64Array2
       structure Word64ArraySlice = Word64ArraySlice



1.11      +714 -250  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.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- overloads.sml	3 Mar 2004 02:08:58 -0000	1.10
+++ overloads.sml	5 Mar 2004 03:50:50 -0000	1.11
@@ -1,356 +1,820 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
- *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
- *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
- *)
-
-(*
- *     * int  = {Int.int, Int8.int, Int16.int, Int32.int, Int64.int, 
- *               IntInf.int, LargeInt.int, FixedInt.int, Position.int}
- *     * word = {Word.word, Word8.word, Word16.word, Word32.word, Word64.word,
- *               LargeWord.word, SysWord.word}
- *     * real = {Real.real, Real32.real, Real.64.real,
- *               LargeReal.real}
- *     * text = {String.string, Char.char}
- *     * wordint = word union int
- *     * realint = real union int
- *     * num = word union int union real
- *     * numtext = num union text 
- * 
- * num ===
- * _overload f : ?
- * as  Int.f
- * and Int8.f
- * and Int16.f
- * and Int32.f
- * and Int64.f
- * and IntInf.f
- * and LargeInt.f
- * and FixedInt.f
- * and Position.f
- * and Word.f
- * and Word8.f
- * and Word16.f
- * and Word32.f
- * and Word64.f
- * and LargeWord.f
- * and SysWord.f
- * and Real.f
- * and Real32.f
- * and Real64.f
- * and LargeReal.f
- * 
- * wordint ===
- * _overload f : ?
- * as  Int.f
- * and Int8.f
- * and Int16.f
- * and Int32.f
- * and Int64.f
- * and IntInf.f
- * and LargeInt.f
- * and FixedInt.f
- * and Position.f
- * and Word.f
- * and Word8.f
- * and Word16.f
- * and Word32.f
- * and Word64.f
- * and LargeWord.f
- * and SysWord.f
- * 
- * realint ===
- * _overload f : ?
- * as  Int.f
- * and Int8.f
- * and Int16.f
- * and Int32.f
- * and Int64.f
- * and IntInf.f
- * and LargeInt.f
- * and FixedInt.f
- * and Position.f
- * and Real.f
- * and Real32.f
- * and Real64.f
- * and LargeReal.f
- * 
- * numtext ===
- * _overload f : ?
- * as  Int.f
- * and Int8.f
- * and Int16.f
- * and Int32.f
- * and Int64.f
- * and IntInf.f
- * and LargeInt.f
- * and FixedInt.f
- * and Position.f
- * and Word.f
- * and Word8.f
- * and Word16.f
- * and Word32.f
- * and Word64.f
- * and LargeWord.f
- * and SysWord.f
- * and Real.f
- * and Real32.f
- * and Real64.f
- * and LargeReal.f
- * and String.f
- * and Char.f
- *)
+(* This file is automatically generated.  Do not edit. *)
 
-_overload 2 ~ :   ('a -> 'a) (* num -> num *)
-as  Int.~
+_overload 2 ~ : 'a -> 'a
+as  Word.~
+and LargeWord.~
+and SysWord.~
+and Word2.~
+and Word3.~
+and Word4.~
+and Word5.~
+and Word6.~
+and Word7.~
+and Word8.~
+and Word9.~
+and Word10.~
+and Word11.~
+and Word12.~
+and Word13.~
+and Word14.~
+and Word15.~
+and Word16.~
+and Word17.~
+and Word18.~
+and Word19.~
+and Word20.~
+and Word21.~
+and Word22.~
+and Word23.~
+and Word24.~
+and Word25.~
+and Word26.~
+and Word27.~
+and Word28.~
+and Word29.~
+and Word30.~
+and Word31.~
+and Word64.~
+and Int.~
+and IntInf.~
+and LargeInt.~
+and FixedInt.~
+and Position.~
+and Int2.~
+and Int3.~
+and Int4.~
+and Int5.~
+and Int6.~
+and Int7.~
 and Int8.~
+and Int9.~
+and Int10.~
+and Int11.~
+and Int12.~
+and Int13.~
+and Int14.~
+and Int15.~
 and Int16.~
+and Int17.~
+and Int18.~
+and Int19.~
+and Int20.~
+and Int21.~
+and Int22.~
+and Int23.~
+and Int24.~
+and Int25.~
+and Int26.~
+and Int27.~
+and Int28.~
+and Int29.~
+and Int30.~
 and Int31.~
 and Int32.~
 and Int64.~
-and IntInf.~
-and LargeInt.~
-and FixedInt.~
-and Position.~
-and Word.~
-and Word8.~
-and Word16.~
-and Word32.~
-and Word64.~
-and LargeWord.~
-and SysWord.~
 and Real.~
 and Real32.~
 and Real64.~
 and LargeReal.~
 
-_overload 2 + :   ('a * 'a -> 'a) (* num * num -> num *)
-as  Int.+
+_overload 2 + : 'a * 'a -> 'a
+as  Word.+
+and LargeWord.+
+and SysWord.+
+and Word2.+
+and Word3.+
+and Word4.+
+and Word5.+
+and Word6.+
+and Word7.+
+and Word8.+
+and Word9.+
+and Word10.+
+and Word11.+
+and Word12.+
+and Word13.+
+and Word14.+
+and Word15.+
+and Word16.+
+and Word17.+
+and Word18.+
+and Word19.+
+and Word20.+
+and Word21.+
+and Word22.+
+and Word23.+
+and Word24.+
+and Word25.+
+and Word26.+
+and Word27.+
+and Word28.+
+and Word29.+
+and Word30.+
+and Word31.+
+and Word64.+
+and Int.+
+and IntInf.+
+and LargeInt.+
+and FixedInt.+
+and Position.+
+and Int2.+
+and Int3.+
+and Int4.+
+and Int5.+
+and Int6.+
+and Int7.+
 and Int8.+
+and Int9.+
+and Int10.+
+and Int11.+
+and Int12.+
+and Int13.+
+and Int14.+
+and Int15.+
 and Int16.+
+and Int17.+
+and Int18.+
+and Int19.+
+and Int20.+
+and Int21.+
+and Int22.+
+and Int23.+
+and Int24.+
+and Int25.+
+and Int26.+
+and Int27.+
+and Int28.+
+and Int29.+
+and Int30.+
 and Int31.+
 and Int32.+
 and Int64.+
-and IntInf.+
-and LargeInt.+
-and FixedInt.+
-and Position.+
-and Word.+
-and Word8.+
-and Word16.+
-and Word32.+
-and Word64.+
-and LargeWord.+
-and SysWord.+
 and Real.+
 and Real32.+
 and Real64.+
 and LargeReal.+
 
-_overload 2 - :   ('a * 'a -> 'a) (* num * num -> num *)
-as  Int.-
+_overload 2 - : 'a * 'a -> 'a
+as  Word.-
+and LargeWord.-
+and SysWord.-
+and Word2.-
+and Word3.-
+and Word4.-
+and Word5.-
+and Word6.-
+and Word7.-
+and Word8.-
+and Word9.-
+and Word10.-
+and Word11.-
+and Word12.-
+and Word13.-
+and Word14.-
+and Word15.-
+and Word16.-
+and Word17.-
+and Word18.-
+and Word19.-
+and Word20.-
+and Word21.-
+and Word22.-
+and Word23.-
+and Word24.-
+and Word25.-
+and Word26.-
+and Word27.-
+and Word28.-
+and Word29.-
+and Word30.-
+and Word31.-
+and Word64.-
+and Int.-
+and IntInf.-
+and LargeInt.-
+and FixedInt.-
+and Position.-
+and Int2.-
+and Int3.-
+and Int4.-
+and Int5.-
+and Int6.-
+and Int7.-
 and Int8.-
+and Int9.-
+and Int10.-
+and Int11.-
+and Int12.-
+and Int13.-
+and Int14.-
+and Int15.-
 and Int16.-
+and Int17.-
+and Int18.-
+and Int19.-
+and Int20.-
+and Int21.-
+and Int22.-
+and Int23.-
+and Int24.-
+and Int25.-
+and Int26.-
+and Int27.-
+and Int28.-
+and Int29.-
+and Int30.-
 and Int31.-
 and Int32.-
 and Int64.-
-and IntInf.-
-and LargeInt.-
-and FixedInt.-
-and Position.-
-and Word.-
-and Word8.-
-and Word16.-
-and Word32.-
-and Word64.-
-and LargeWord.-
-and SysWord.-
 and Real.-
 and Real32.-
 and Real64.-
 and LargeReal.-
 
-_overload 2 * :   ('a * 'a -> 'a) (* num * num -> num *)
-as  Int.*
+_overload 2 * : 'a * 'a -> 'a
+as  Word.*
+and LargeWord.*
+and SysWord.*
+and Word2.*
+and Word3.*
+and Word4.*
+and Word5.*
+and Word6.*
+and Word7.*
+and Word8.*
+and Word9.*
+and Word10.*
+and Word11.*
+and Word12.*
+and Word13.*
+and Word14.*
+and Word15.*
+and Word16.*
+and Word17.*
+and Word18.*
+and Word19.*
+and Word20.*
+and Word21.*
+and Word22.*
+and Word23.*
+and Word24.*
+and Word25.*
+and Word26.*
+and Word27.*
+and Word28.*
+and Word29.*
+and Word30.*
+and Word31.*
+and Word64.*
+and Int.*
+and IntInf.*
+and LargeInt.*
+and FixedInt.*
+and Position.*
+and Int2.*
+and Int3.*
+and Int4.*
+and Int5.*
+and Int6.*
+and Int7.*
 and Int8.*
+and Int9.*
+and Int10.*
+and Int11.*
+and Int12.*
+and Int13.*
+and Int14.*
+and Int15.*
 and Int16.*
+and Int17.*
+and Int18.*
+and Int19.*
+and Int20.*
+and Int21.*
+and Int22.*
+and Int23.*
+and Int24.*
+and Int25.*
+and Int26.*
+and Int27.*
+and Int28.*
+and Int29.*
+and Int30.*
 and Int31.*
 and Int32.*
 and Int64.*
-and IntInf.*
-and LargeInt.*
-and FixedInt.*
-and Position.*
-and Word.*
-and Word8.*
-and Word16.*
-and Word32.*
-and Word64.*
-and LargeWord.*
-and SysWord.*
 and Real.*
 and Real32.*
 and Real64.*
 and LargeReal.*
 
-_overload 4 / : ('a * 'a -> 'a) (* real * real -> real *)
-as Real./
+_overload 4 / : 'a * 'a -> 'a
+as  Real./
 and Real32./
 and Real64./
 and LargeReal./
 
-_overload 3 div:   ('a * 'a -> 'a) (* wordint * wordint -> wordint *)
-as  Int.div
+_overload 3 div : 'a * 'a -> 'a
+as  Word.div
+and LargeWord.div
+and SysWord.div
+and Word2.div
+and Word3.div
+and Word4.div
+and Word5.div
+and Word6.div
+and Word7.div
+and Word8.div
+and Word9.div
+and Word10.div
+and Word11.div
+and Word12.div
+and Word13.div
+and Word14.div
+and Word15.div
+and Word16.div
+and Word17.div
+and Word18.div
+and Word19.div
+and Word20.div
+and Word21.div
+and Word22.div
+and Word23.div
+and Word24.div
+and Word25.div
+and Word26.div
+and Word27.div
+and Word28.div
+and Word29.div
+and Word30.div
+and Word31.div
+and Word64.div
+and Int.div
+and IntInf.div
+and LargeInt.div
+and FixedInt.div
+and Position.div
+and Int2.div
+and Int3.div
+and Int4.div
+and Int5.div
+and Int6.div
+and Int7.div
 and Int8.div
+and Int9.div
+and Int10.div
+and Int11.div
+and Int12.div
+and Int13.div
+and Int14.div
+and Int15.div
 and Int16.div
+and Int17.div
+and Int18.div
+and Int19.div
+and Int20.div
+and Int21.div
+and Int22.div
+and Int23.div
+and Int24.div
+and Int25.div
+and Int26.div
+and Int27.div
+and Int28.div
+and Int29.div
+and Int30.div
 and Int31.div
 and Int32.div
 and Int64.div
-and IntInf.div
-and LargeInt.div
-and FixedInt.div
-and Position.div
-and Word.div
-and Word8.div
-and Word16.div
-and Word32.div
-and Word64.div
-and LargeWord.div
-and SysWord.div
 
-_overload 3 mod:   ('a * 'a -> 'a) (* wordint * wordint -> wordint *)
-as  Int.mod
+_overload 3 mod : 'a * 'a -> 'a
+as  Word.mod
+and LargeWord.mod
+and SysWord.mod
+and Word2.mod
+and Word3.mod
+and Word4.mod
+and Word5.mod
+and Word6.mod
+and Word7.mod
+and Word8.mod
+and Word9.mod
+and Word10.mod
+and Word11.mod
+and Word12.mod
+and Word13.mod
+and Word14.mod
+and Word15.mod
+and Word16.mod
+and Word17.mod
+and Word18.mod
+and Word19.mod
+and Word20.mod
+and Word21.mod
+and Word22.mod
+and Word23.mod
+and Word24.mod
+and Word25.mod
+and Word26.mod
+and Word27.mod
+and Word28.mod
+and Word29.mod
+and Word30.mod
+and Word31.mod
+and Word64.mod
+and Int.mod
+and IntInf.mod
+and LargeInt.mod
+and FixedInt.mod
+and Position.mod
+and Int2.mod
+and Int3.mod
+and Int4.mod
+and Int5.mod
+and Int6.mod
+and Int7.mod
 and Int8.mod
+and Int9.mod
+and Int10.mod
+and Int11.mod
+and Int12.mod
+and Int13.mod
+and Int14.mod
+and Int15.mod
 and Int16.mod
+and Int17.mod
+and Int18.mod
+and Int19.mod
+and Int20.mod
+and Int21.mod
+and Int22.mod
+and Int23.mod
+and Int24.mod
+and Int25.mod
+and Int26.mod
+and Int27.mod
+and Int28.mod
+and Int29.mod
+and Int30.mod
 and Int31.mod
 and Int32.mod
 and Int64.mod
-and IntInf.mod
-and LargeInt.mod
-and FixedInt.mod
-and Position.mod
-and Word.mod
-and Word8.mod
-and Word16.mod
-and Word32.mod
-and Word64.mod
-and LargeWord.mod
-and SysWord.mod
 
-_overload 3 abs:   ('a -> 'a) (* realint * realint -> realint *)
-as  Int.abs
+_overload 3 abs : 'a * 'a -> bool
+as  Real.abs
+and Real32.abs
+and Real64.abs
+and LargeReal.abs
+and Int.abs
+and IntInf.abs
+and LargeInt.abs
+and FixedInt.abs
+and Position.abs
+and Int2.abs
+and Int3.abs
+and Int4.abs
+and Int5.abs
+and Int6.abs
+and Int7.abs
 and Int8.abs
+and Int9.abs
+and Int10.abs
+and Int11.abs
+and Int12.abs
+and Int13.abs
+and Int14.abs
+and Int15.abs
 and Int16.abs
+and Int17.abs
+and Int18.abs
+and Int19.abs
+and Int20.abs
+and Int21.abs
+and Int22.abs
+and Int23.abs
+and Int24.abs
+and Int25.abs
+and Int26.abs
+and Int27.abs
+and Int28.abs
+and Int29.abs
+and Int30.abs
 and Int31.abs
 and Int32.abs
 and Int64.abs
-and IntInf.abs
-and LargeInt.abs
-and FixedInt.abs
-and Position.abs
-and Real.abs
-and Real32.abs
-and Real64.abs
-and LargeReal.abs
 
-_overload 1 < :   ('a * 'a -> bool) (* numtext * numtext -> bool *)
-as  Int.<
+_overload 1 < : 'a * 'a -> bool
+as  Word.<
+and LargeWord.<
+and SysWord.<
+and Word2.<
+and Word3.<
+and Word4.<
+and Word5.<
+and Word6.<
+and Word7.<
+and Word8.<
+and Word9.<
+and Word10.<
+and Word11.<
+and Word12.<
+and Word13.<
+and Word14.<
+and Word15.<
+and Word16.<
+and Word17.<
+and Word18.<
+and Word19.<
+and Word20.<
+and Word21.<
+and Word22.<
+and Word23.<
+and Word24.<
+and Word25.<
+and Word26.<
+and Word27.<
+and Word28.<
+and Word29.<
+and Word30.<
+and Word31.<
+and Word64.<
+and Int.<
+and IntInf.<
+and LargeInt.<
+and FixedInt.<
+and Position.<
+and Int2.<
+and Int3.<
+and Int4.<
+and Int5.<
+and Int6.<
+and Int7.<
 and Int8.<
+and Int9.<
+and Int10.<
+and Int11.<
+and Int12.<
+and Int13.<
+and Int14.<
+and Int15.<
 and Int16.<
+and Int17.<
+and Int18.<
+and Int19.<
+and Int20.<
+and Int21.<
+and Int22.<
+and Int23.<
+and Int24.<
+and Int25.<
+and Int26.<
+and Int27.<
+and Int28.<
+and Int29.<
+and Int30.<
 and Int31.<
 and Int32.<
 and Int64.<
-and IntInf.<
-and LargeInt.<
-and FixedInt.<
-and Position.<
-and Word.<
-and Word8.<
-and Word16.<
-and Word32.<
-and Word64.<
-and LargeWord.<
-and SysWord.<
 and Real.<
 and Real32.<
 and Real64.<
 and LargeReal.<
-and String.<
 and Char.<
+and String.<
 
-_overload 1 <= :   ('a * 'a -> bool) (* numtext * numtext -> bool *)
-as  Int.<=
+_overload 1 <= : 'a * 'a -> bool
+as  Word.<=
+and LargeWord.<=
+and SysWord.<=
+and Word2.<=
+and Word3.<=
+and Word4.<=
+and Word5.<=
+and Word6.<=
+and Word7.<=
+and Word8.<=
+and Word9.<=
+and Word10.<=
+and Word11.<=
+and Word12.<=
+and Word13.<=
+and Word14.<=
+and Word15.<=
+and Word16.<=
+and Word17.<=
+and Word18.<=
+and Word19.<=
+and Word20.<=
+and Word21.<=
+and Word22.<=
+and Word23.<=
+and Word24.<=
+and Word25.<=
+and Word26.<=
+and Word27.<=
+and Word28.<=
+and Word29.<=
+and Word30.<=
+and Word31.<=
+and Word64.<=
+and Int.<=
+and IntInf.<=
+and LargeInt.<=
+and FixedInt.<=
+and Position.<=
+and Int2.<=
+and Int3.<=
+and Int4.<=
+and Int5.<=
+and Int6.<=
+and Int7.<=
 and Int8.<=
+and Int9.<=
+and Int10.<=
+and Int11.<=
+and Int12.<=
+and Int13.<=
+and Int14.<=
+and Int15.<=
 and Int16.<=
+and Int17.<=
+and Int18.<=
+and Int19.<=
+and Int20.<=
+and Int21.<=
+and Int22.<=
+and Int23.<=
+and Int24.<=
+and Int25.<=
+and Int26.<=
+and Int27.<=
+and Int28.<=
+and Int29.<=
+and Int30.<=
 and Int31.<=
 and Int32.<=
 and Int64.<=
-and IntInf.<=
-and LargeInt.<=
-and FixedInt.<=
-and Position.<=
-and Word.<=
-and Word8.<=
-and Word16.<=
-and Word32.<=
-and Word64.<=
-and LargeWord.<=
-and SysWord.<=
 and Real.<=
 and Real32.<=
 and Real64.<=
 and LargeReal.<=
-and String.<=
 and Char.<=
+and String.<=
 
-_overload 1 > :   ('a * 'a -> bool) (* numtext * numtext -> bool *)
-as  Int.>
+_overload 1 > : 'a * 'a -> bool
+as  Word.>
+and LargeWord.>
+and SysWord.>
+and Word2.>
+and Word3.>
+and Word4.>
+and Word5.>
+and Word6.>
+and Word7.>
+and Word8.>
+and Word9.>
+and Word10.>
+and Word11.>
+and Word12.>
+and Word13.>
+and Word14.>
+and Word15.>
+and Word16.>
+and Word17.>
+and Word18.>
+and Word19.>
+and Word20.>
+and Word21.>
+and Word22.>
+and Word23.>
+and Word24.>
+and Word25.>
+and Word26.>
+and Word27.>
+and Word28.>
+and Word29.>
+and Word30.>
+and Word31.>
+and Word64.>
+and Int.>
+and IntInf.>
+and LargeInt.>
+and FixedInt.>
+and Position.>
+and Int2.>
+and Int3.>
+and Int4.>
+and Int5.>
+and Int6.>
+and Int7.>
 and Int8.>
+and Int9.>
+and Int10.>
+and Int11.>
+and Int12.>
+and Int13.>
+and Int14.>
+and Int15.>
 and Int16.>
+and Int17.>
+and Int18.>
+and Int19.>
+and Int20.>
+and Int21.>
+and Int22.>
+and Int23.>
+and Int24.>
+and Int25.>
+and Int26.>
+and Int27.>
+and Int28.>
+and Int29.>
+and Int30.>
 and Int31.>
 and Int32.>
 and Int64.>
-and IntInf.>
-and LargeInt.>
-and FixedInt.>
-and Position.>
-and Word.>
-and Word8.>
-and Word16.>
-and Word32.>
-and Word64.>
-and LargeWord.>
-and SysWord.>
 and Real.>
 and Real32.>
 and Real64.>
 and LargeReal.>
-and String.>
 and Char.>
+and String.>
 
-_overload 1 >= :   ('a * 'a -> bool) (* numtext * numtext -> bool *)
-as  Int.>=
+_overload 1 >= : 'a * 'a -> bool
+as  Word.>=
+and LargeWord.>=
+and SysWord.>=
+and Word2.>=
+and Word3.>=
+and Word4.>=
+and Word5.>=
+and Word6.>=
+and Word7.>=
+and Word8.>=
+and Word9.>=
+and Word10.>=
+and Word11.>=
+and Word12.>=
+and Word13.>=
+and Word14.>=
+and Word15.>=
+and Word16.>=
+and Word17.>=
+and Word18.>=
+and Word19.>=
+and Word20.>=
+and Word21.>=
+and Word22.>=
+and Word23.>=
+and Word24.>=
+and Word25.>=
+and Word26.>=
+and Word27.>=
+and Word28.>=
+and Word29.>=
+and Word30.>=
+and Word31.>=
+and Word64.>=
+and Int.>=
+and IntInf.>=
+and LargeInt.>=
+and FixedInt.>=
+and Position.>=
+and Int2.>=
+and Int3.>=
+and Int4.>=
+and Int5.>=
+and Int6.>=
+and Int7.>=
 and Int8.>=
+and Int9.>=
+and Int10.>=
+and Int11.>=
+and Int12.>=
+and Int13.>=
+and Int14.>=
+and Int15.>=
 and Int16.>=
+and Int17.>=
+and Int18.>=
+and Int19.>=
+and Int20.>=
+and Int21.>=
+and Int22.>=
+and Int23.>=
+and Int24.>=
+and Int25.>=
+and Int26.>=
+and Int27.>=
+and Int28.>=
+and Int29.>=
+and Int30.>=
 and Int31.>=
 and Int32.>=
 and Int64.>=
-and IntInf.>=
-and LargeInt.>=
-and FixedInt.>=
-and Position.>=
-and Word.>=
-and Word8.>=
-and Word16.>=
-and Word32.>=
-and Word64.>=
-and LargeWord.>=
-and SysWord.>=
 and Real.>=
 and Real32.>=
 and Real64.>=
 and LargeReal.>=
-and String.>=
 and Char.>=
+and String.>=



1.1                  mlton/basis-library/libs/basis-2002/top-level/.cvsignore

Index: .cvsignore
===================================================================
generate-overloads



1.1                  mlton/basis-library/libs/basis-2002/top-level/Makefile

Index: Makefile
===================================================================
GEN = generate-overloads

overloads.sml: $(GEN).sml
	mlton $(GEN).sml
	$(GEN) >overloads.sml

.PHONY: clean
clean:
	../../../../bin/clean



1.1                  mlton/basis-library/libs/basis-2002/top-level/generate-overloads.sml

Index: generate-overloads.sml
===================================================================
structure List =
   struct
      fun foreach (l, f) = List.app f l
      fun map (l, f) = List.map f l
      val tabulate = List.tabulate
   end

val int =
   ["Int", "IntInf", "LargeInt", "FixedInt", "Position"]
   @ List.map (List.tabulate (31, fn i => i + 2) @ [64],
	       fn i => concat ["Int", Int.toString i])

val real = ["Real", "Real32", "Real64", "LargeReal"]

val word =
   ["Word", "LargeWord", "SysWord"]
   @ List.map (List.tabulate (30, fn i => i + 2) @ [64],
	       fn i => concat ["Word", Int.toString i])

val text = ["Char", "String"]
   
val num = word @ int @ real
val numtext = num @ text
val realint = real @ int
val wordint = word @ int

val binary = "'a * 'a -> 'a"
val compare = "'a * 'a -> bool"
val unary = "'a -> 'a"

val () = print "(* This file is automatically generated.  Do not edit. *)\n"
   
val () =
   List.foreach
   ([(2, "~", unary, num),
    (2, "+", binary, num),
    (2, "-", binary, num),
    (2, "*", binary, num),
    (4, "/", binary, real),
    (3, "div", binary, wordint),
    (3, "mod", binary, wordint),
    (3, "abs", compare, realint),
    (1, "<", compare, numtext),
    (1, "<=", compare, numtext),
    (1, ">", compare, numtext),
    (1, ">=", compare, numtext)],
    fn (prec, f, ty, class) =>
    (print (concat ["\n_overload ", Int.toString prec, " ", f, " : ", ty, "\n"])
     ; (case class of
	   [] => ()
	 | c :: class =>
	      (print (concat ["as  ", c, ".", f, "\n"])
	       ; List.foreach (class, fn c =>
			       print (concat ["and ", c, ".", f, "\n"]))))))
   



1.103     +226 -1    mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -r1.102 -r1.103
--- primitive.sml	3 Mar 2004 17:54:41 -0000	1.102
+++ primitive.sml	5 Mar 2004 03:50:51 -0000	1.103
@@ -1569,7 +1569,232 @@
 	    val toLargeX: word -> LargeWord.word = fn x => x
 	    val xorb = _prim "Word64_xorb": word * word -> word;
 	 end
-	 
+
+      structure Word2 =
+	 struct
+	    type big = Word8.word
+	    type word = word2
+	    val fromBigUnsafe = _prim "Word8_toWord2": big -> word;
+	    val toBig = _prim "Word2_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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 wordSize = 31
+	 end
+
       structure World =
 	 struct
 	    val isOriginal = _import "World_isOriginal": unit -> bool;



1.6       +2 -2      mlton/lib/mlton/basic/int-inf.sml

Index: int-inf.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/int-inf.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- int-inf.sml	4 Mar 2004 21:53:11 -0000	1.5
+++ int-inf.sml	5 Mar 2004 03:50:51 -0000	1.6
@@ -4,8 +4,8 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure IntInf: INTEGER = Integer(open Pervasive.IntInf
-				    fun toIntInf x = x)
+structure IntInf: INTEGER = Integer (open Pervasive.IntInf
+				     fun toIntInf x = x)
 
 structure IntInf: INT_INF =
    struct



1.44      +0 -1      mlton/mlton/mlton-stubs.cm

Index: mlton-stubs.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/mlton-stubs.cm,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- mlton-stubs.cm	2 Mar 2004 03:24:33 -0000	1.43
+++ mlton-stubs.cm	5 Mar 2004 03:50:51 -0000	1.44
@@ -5,7 +5,6 @@
 ../lib/mlyacc/parser2.sml
 ../lib/mlyacc/join.sml
 upgrade-basis.sml
-../lib/mlton-stubs/int-inf.sml
 ../lib/mlton-stubs/thread.sig
 ../lib/mlton-stubs/thread.sml
 ../lib/mlton-stubs/world.sig



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

Index: ast-atoms.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/ast-atoms.fun,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- ast-atoms.fun	21 Feb 2004 02:10:01 -0000	1.13
+++ ast-atoms.fun	5 Mar 2004 03:50:51 -0000	1.14
@@ -13,6 +13,7 @@
 
 structure AdmitsEquality = AdmitsEquality ()
 structure Const = AstConst ()
+
 structure IntSize = IntSize ()
 structure Kind = TyconKind ()
 structure RealSize = RealSize ()



1.7       +2 -11     mlton/mlton/ast/int-size.fun

Index: int-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/int-size.fun,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- int-size.fun	3 Mar 2004 17:54:42 -0000	1.6
+++ int-size.fun	5 Mar 2004 03:50:51 -0000	1.7
@@ -42,17 +42,6 @@
       fn T {precision = i, ...} => valOf (Vector.sub (v, i))
    end
 
-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
@@ -107,5 +96,7 @@
    in
       I bits
    end
+
+val bytes: t -> int = memoize (fn s => bits (roundUpToPrim s) div 8)
 
 end



1.19      +0 -1      mlton/mlton/ast/prim-tycons.fun

Index: prim-tycons.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/prim-tycons.fun,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- prim-tycons.fun	3 Mar 2004 02:08:59 -0000	1.18
+++ prim-tycons.fun	5 Mar 2004 03:50:51 -0000	1.19
@@ -11,7 +11,6 @@
 open S
 
 datatype z = datatype RealSize.t
-datatype z = datatype WordSize.t
 
 type tycon = t
 



1.3       +2 -0      mlton/mlton/ast/real-size.fun

Index: real-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/real-size.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- real-size.fun	3 Mar 2004 02:08:59 -0000	1.2
+++ real-size.fun	5 Mar 2004 03:50:51 -0000	1.3
@@ -25,6 +25,8 @@
    fn R32 => "32"
     | R64 => "64"
 
+val layout = Layout.str o toString
+
 val bytes: t -> int =
    fn R32 => 4
     | R64 => 8



1.3       +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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- real-size.sig	3 Mar 2004 02:08:59 -0000	1.2
+++ real-size.sig	5 Mar 2004 03:50:51 -0000	1.3
@@ -16,6 +16,7 @@
       val bytes: t -> int
       val default: t
       val equals: t * t -> bool
+      val layout: t -> Layout.t
       val memoize: (t -> 'a) -> t -> 'a
       val toString: t -> string
    end



1.7       +65 -41    mlton/mlton/ast/word-size.fun

Index: word-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.fun,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- word-size.fun	3 Mar 2004 02:08:59 -0000	1.6
+++ word-size.fun	5 Mar 2004 03:50:51 -0000	1.7
@@ -3,61 +3,85 @@
 
 open S
 
-datatype t = W8 | W16 | W32 | W64
+datatype t = T of {bits: int}
+
+fun bits (T {bits, ...}) = bits
+
+val toString = Int.toString o bits
+
+val layout = Layout.str o toString
 
 val equals: t * t -> bool = op =
 
-val all = [W8, W16, W32, W64]
+val sizes: int list =
+   List.tabulate (31, fn i => i + 2)
+   @ [64]
 
-val default = W32
+fun isValidSize (i: int) =
+   (2 <= i andalso i <= 32) orelse i = 64
 
-fun pointer () = W32
+fun make i = T {bits = i}
 
-val max: t -> LargeWord.t =
-   fn W8 => Word.toLarge 0wxFF
-    | W16 => Word.toLarge 0wxFFFF
-    | W32 => Word.toLarge 0wxFFFFFFFF
-    | W64 =>
-	 (* Would like to write 0wxFFFFFFFFFFFFFFFF, but can't because SML/NJ
-	  * doesn't have 64 bit words.
-	  *)
-	 let
-	    open LargeWord
-	 in
-	    orb (<< (fromWord 0wxFFFFFFFF, 0w32),
-		 fromWord 0wxFFFFFFFF)
-	 end
-
-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
+val allVector = Vector.tabulate (65, fn i =>
+				  if isValidSize i
+				     then SOME (make i)
+				  else NONE)
 
-val toString = Int.toString o bits
+fun W i =
+   case Vector.sub (allVector, i) handle Subscript => NONE of
+      NONE => Error.bug (concat ["strange word size: ", Int.toString i])
+    | SOME s => s
+
+val all = List.map (sizes, W)
+
+val prims = [W 8, W 16, W 32, W 64]
+
+val default = W 32
+
+fun pointer () = W 32
 
 val memoize: (t -> 'a) -> t -> 'a =
    fn f =>
    let
-      val a8 = f W8
-      val a16 = f W16
-      val a32 = f W32
-      val a64 = f W64
+      val v = Vector.map (allVector, fn opt => Option.map (opt, f))
    in
-      fn W8 => a8
-       | W16 => a16
-       | W32 => a32
-       | W64 => a64
+      fn T {bits = i, ...} => valOf (Vector.sub (v, i))
    end
+
+fun roundUpToPrim s =
+   let
+      val bits = bits s
+      val bits =
+	 if bits <= 8
+	    then 8
+	 else if bits <= 16
+		 then 16
+	      else if bits <= 32
+		      then 32
+		   else if bits = 64
+			   then 64
+			else Error.bug "IntSize.roundUpToPrim"
+   in
+      W bits
+   end
+
+val bytes: t -> int = memoize (fn s => bits (roundUpToPrim s) div 8)
+
+val max: t -> IntInf.t =
+   memoize (fn s => IntInf.<< (1, Word.fromInt (bits s)) - 1)
    
 val cardinality = memoize (fn s => IntInf.pow (2, bits s))
+
+datatype prim = W8 | W16 | W32 | W64
+
+val primOpt = memoize (fn T {bits, ...} =>
+		       List.peekMap ([(8, W8), (16, W16), (32, W32), (64, W64)],
+				     fn (b, p) =>
+				     if b = bits then SOME p else NONE))
+
+fun prim s =
+   case primOpt s of
+      NONE => Error.bug "IntSize.prim"
+    | SOME p => p
 
 end



1.6       +10 -5     mlton/mlton/ast/word-size.sig

Index: word-size.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.sig,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- word-size.sig	3 Mar 2004 02:08:59 -0000	1.5
+++ word-size.sig	5 Mar 2004 03:50:51 -0000	1.6
@@ -8,18 +8,23 @@
 signature WORD_SIZE =
    sig
       include WORD_SIZE_STRUCTS
-	 
-      datatype t = W8 | W16 | W32 | W64
 
+      eqtype t
+	 
       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
-      val equals: t * t -> bool
-      val max: t -> LargeWord.t
+      val equals: t * t -> bool 
+      val layout: t -> Layout.t
+      val max: t -> IntInf.t
       val memoize: (t -> 'a) -> t -> 'a
       val pointer: unit -> t
+      datatype prim = W8 | W16 | W32 | W64
+      val prim: t -> prim
+      val prims: t list
+      val roundUpToPrim: t -> t
       val toString: t -> string
+      val W: int -> t
    end



1.4       +1 -2      mlton/mlton/atoms/c-function.fun

Index: c-function.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/c-function.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- c-function.fun	3 Mar 2004 02:08:59 -0000	1.3
+++ c-function.fun	5 Mar 2004 03:50:52 -0000	1.4
@@ -82,9 +82,8 @@
 local
    open CType
 in
-   datatype z = datatype WordSize.t
    val Int32 = Int (IntSize.I 32)
-   val Word32 = Word W32
+   val Word32 = Word (WordSize.W 32)
 end
 	 
 local



1.3       +2 -4      mlton/mlton/atoms/c-type.fun

Index: c-type.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/c-type.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- c-type.fun	3 Mar 2004 02:08:59 -0000	1.2
+++ c-type.fun	5 Mar 2004 03:50:52 -0000	1.3
@@ -3,8 +3,6 @@
 
 open S
 
-datatype z = datatype WordSize.t
-
 datatype t =
    Int of IntSize.t
  | Pointer
@@ -12,7 +10,7 @@
  | Word of WordSize.t
 
 val bool = Int (IntSize.I 32)
-val char = Word W8
+val char = Word (WordSize.W 8)
 val defaultInt = Int IntSize.default
 val defaultReal = Real RealSize.default
 val defaultWord = Word WordSize.default
@@ -22,7 +20,7 @@
    List.map (IntSize.prims, Int)
    @ [Pointer]
    @ List.map (RealSize.all, Real)
-   @ List.map (WordSize.all, Word)
+   @ List.map (WordSize.prims, Word)
 
 val equals: t * t -> bool =
    fn (Int s, Int s') => IntSize.equals (s, s')



1.15      +1 -3      mlton/mlton/atoms/const.fun

Index: const.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.fun,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- const.fun	3 Mar 2004 02:08:59 -0000	1.14
+++ const.fun	5 Mar 2004 03:50:52 -0000	1.15
@@ -21,8 +21,6 @@
    structure WordSize = WordSize
 end
 
-datatype z = datatype WordSize.t
-
 structure SmallIntInf =
    struct
       structure Word = Pervasive.Word
@@ -79,7 +77,7 @@
       Int i => String.hash (IntX.toString i)
     | IntInf i => String.hash (IntInf.toString i)
     | Real r => RealX.hash r
-    | Word w => LargeWord.toWord (WordX.toLargeWord w)
+    | Word w => Word.fromIntInf (WordX.toIntInf w)
     | Word8Vector v => String.hash (Word8.vectorToString v)
    
 fun equals (c, c') =



1.72      +14 -13    mlton/mlton/atoms/prim.fun

Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -r1.71 -r1.72
--- prim.fun	3 Mar 2004 17:54:42 -0000	1.71
+++ prim.fun	5 Mar 2004 03:50:52 -0000	1.72
@@ -16,7 +16,6 @@
 open S
 
 datatype z = datatype RealSize.t
-datatype z = datatype WordSize.t	       
 
 local
    open Const
@@ -578,6 +577,7 @@
    val intToWord = make (Name.Int_toWord, int, word)
    val wordToInt = make (Name.Word_toInt, word, int)
    val wordToIntX = make (Name.Word_toIntX, word, int)
+   val wordToWord = make (Name.Word_toWord, word, word)
 end
       
 val ffi = new o Name.FFI
@@ -743,7 +743,7 @@
 	    val x' = x mod (Int.toIntInf (WordSize.bits s))
 	 in
 	    if x = x'
-	       then word (WordX.fromLargeInt (x, s))
+	       then word (WordX.fromIntInf (x, s))
 	    else ApplyResult.Overflow
 	 end
       val eq =
@@ -775,7 +775,7 @@
 	   | (Int_toInt (_, s), [Int i]) =>
 	        int (IntX.make (IntX.toIntInf i, s))
 	   | (Int_toWord (_, s), [Int i]) =>
-		word (WordX.fromLargeInt (IntX.toIntInf i, s))
+		word (WordX.fromIntInf (IntX.toIntInf i, s))
 	   | (IntInf_compare, [IntInf i1, IntInf i2]) =>
 		int (IntX.make
 		     (IntInf.fromInt (case IntInf.compare (i1, i2) of
@@ -787,8 +787,8 @@
 	   | (IntInf_toWord, [IntInf i]) =>
 		(case SmallIntInf.toWord i of
 		    NONE => ApplyResult.Unknown
-		  | SOME w => word (WordX.make (LargeWord.fromWord w,
-						WordSize.default)))
+		  | SOME w => word (WordX.fromIntInf (Word.toIntInf w,
+						      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))
@@ -817,7 +817,7 @@
 		int (IntX.make (WordX.toIntInf w, s))
 	   | (Word_toIntInf, [Word w]) =>
 		intInf (SmallIntInf.fromWord
-			(LargeWord.toWord (WordX.toLargeWord w)))
+			(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))
@@ -907,8 +907,8 @@
 			      if WordX.isZero
 				 (WordX.mod
 				  (w,
-				   WordX.make
-				   (LargeWord.fromInt (WordSize.bits s), s)))
+				   WordX.fromIntInf
+				   (IntInf.fromInt (WordSize.bits s), s)))
 				 then Var x
 			      else Unknown
 			   end
@@ -921,9 +921,10 @@
 			then if WordX.isZero w
 				then Var x
 			     else if (WordX.>=
-				      (w, WordX.make (LargeWord.fromInt
-						      (WordSize.bits s),
-						      WordSize.default)))
+				      (w,
+				       WordX.fromIntInf (IntInf.fromInt
+							 (WordSize.bits s),
+							 WordSize.default)))
 				     then zero s
 				  else Unknown
 		     else if WordX.isZero w
@@ -1083,10 +1084,10 @@
 		  (case name of
 		      IntInf_arshift =>
 			 intInf (IntInf.~>>
-				 (i1, LargeWord.toWord (WordX.toLargeWord w2)))
+				 (i1, Word.fromIntInf (WordX.toIntInf w2)))
 		    | IntInf_lshift =>
 			 intInf (IntInf.<<
-				 (i1, LargeWord.toWord (WordX.toLargeWord w2)))
+				 (i1, Word.fromIntInf (WordX.toIntInf w2)))
 		    | _ => Unknown)
 	     | (_, [Const (IntInf i1), _]) =>
 		  (case name of



1.54      +1 -0      mlton/mlton/atoms/prim.sig

Index: prim.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.sig,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -r1.53 -r1.54
--- prim.sig	3 Mar 2004 17:54:42 -0000	1.53
+++ prim.sig	5 Mar 2004 03:50:52 -0000	1.54
@@ -303,4 +303,5 @@
       val wordSub: WordSize.t -> t
       val wordToInt: WordSize.t * IntSize.t -> t
       val wordToIntX: WordSize.t * IntSize.t -> t
+      val wordToWord: WordSize.t * WordSize.t -> t
    end



1.10      +2 -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.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- type-ops.fun	3 Mar 2004 02:08:59 -0000	1.9
+++ type-ops.fun	5 Mar 2004 03:50:52 -0000	1.10
@@ -20,7 +20,7 @@
 type intSize = IntSize.t
 datatype realSize = datatype RealSize.t
 type tycon = Tycon.t
-datatype wordSize = datatype WordSize.t
+type wordSize = WordSize.t
    
 local
    fun nullary tycon = con (tycon, Vector.new0 ())
@@ -50,7 +50,7 @@
    val weak = unary Tycon.weak
 end
 
-val word8 = word W8
+val word8 = word (WordSize.W 8)
 val word8Vector = vector word8
    
 local



1.5       +102 -123  mlton/mlton/atoms/word-x.fun

Index: word-x.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/word-x.fun,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- word-x.fun	3 Mar 2004 02:08:59 -0000	1.4
+++ word-x.fun	5 Mar 2004 03:50:52 -0000	1.5
@@ -3,20 +3,17 @@
 
 open S
 
-structure PWord = Word
-structure Word = LargeWord
-   
-datatype z = datatype WordSize.t
-   
-(* Words are stored with all zeros for the unused bits. *)
+val modulus: WordSize.t -> IntInf.t =
+   fn s => IntInf.<< (1, Word.fromInt (WordSize.bits s))
+
 local
    datatype t = T of {size: WordSize.t,
-		      word: Word.t}
+		      value: IntInf.t}
 in
    type t = t
-   fun make (w, s) =
+   fun make (i: IntInf.t, s: WordSize.t) =
       T {size = s,
-	 word = Word.andb (w, WordSize.max s)}
+	 value = i mod modulus s}
    fun dest (T r) = r
 end
 
@@ -24,154 +21,136 @@
    fun make f = f o dest
 in
    val size = make #size
-   val word = make #word
+   val value = make #value
 end
 
-val toLargeWord = word
+fun toString w = concat ["0wx", IntInf.format (value w, StringCvt.HEX)]
 
-fun fromWord8 w = make (Word8.toLarge w, W8)
+val layout = Layout.str o toString
 
-fun equals (w, w') = dest w = dest w'
+fun zero s = make (0, s)
 
-fun toString w =
-   let
-      val {word, ...} = dest w
-   in
-      concat ["0wx", Word.toString word]
-   end
+local
+   val make: (IntInf.t * Word.t -> IntInf.t) -> t * t -> t =
+      fn f => fn (w, w') =>
+      let
+	 val s = size w
+	 val v' = value w'
+      in
+	 if v' >= IntInf.fromInt (WordSize.bits s)
+	    then zero s
+	 else make (f (value w, Word.fromIntInf v'), s)
+      end
+in
+   val << = make IntInf.<<
+   val >> = make IntInf.~>> (* OK because we know the value is positive. *)
+end
 
-val layout = Layout.str o toString
+fun equals (w, w') = WordSize.equals (size w, size w') andalso value w = value w'
 
-fun fromChar (c: Char.t) =
-   make (Word8.toLarge (Word8.fromChar c), WordSize.W8)
+fun fromChar (c: Char.t) = make (Int.toIntInf (Char.toInt c), WordSize.W 8)
 
-fun signExtend (w: t): Word.t =
-   let
-      val {size = s, word = w} = dest w
-      fun check (w', w'') =
-	 if Word.fromWord 0w0 = Word.andb (w, Word.fromWord w')
-	    then w
-	 else Word.orb (w, Word.xorb (Word.~ (Word.fromWord 0w1),
-				      Word.fromWord w''))
-   in
-      case s of
-	 W8 => check (0wx80, 0wxFF)
-       | W16 => check (0wx8000, 0wxFFFF)
-       | W32 => check (0wx80000000, 0wxFFFFFFFF)
-       | W64 => w
-   end
+val fromIntInf = make
 
-fun ~>> (w, w') =
-   make (Word.~>> (signExtend w,
-		   Word.toWord (word w')),
-	 size w)
+fun fromWord8 w = make (Word8.toIntInf w, WordSize.W 8)
 
-fun rol (w, w') =
-   let
-      val {size = s, word = w} = dest w
-      val {word = w', ...} = dest w'
-      val n = Word.fromInt (WordSize.bits s)
-      val w' = Word.mod (w', n)
-   in
-      make (Word.orb (Word.>> (w, Word.toWord (Word.- (n, w'))),
-		      Word.<< (w, Word.toWord w')),
-	    s)
-   end
+fun isAllOnes w = value w = modulus (size w) - 1
 
-fun ror (w, w') =
-   let
-      val {size = s, word = w} = dest w
-      val {word = w', ...} = dest w'
-      val n = Word.fromInt (WordSize.bits s)
-      val w' = Word.mod (w', n)
-   in
-      make (Word.orb (Word.>> (w, Word.toWord w'),
-		      Word.<< (w, Word.toWord (Word.- (n, w')))),
-	    s)
-   end
+val isMax = isAllOnes
 
-fun resize (w, s) = make (word w, s)
+fun isOne w = 1 = value w
 
-fun resizeX (w, s) = make (signExtend w, s)
+fun isZero w = 0 = value w
 
-fun fromLargeInt (i: IntInf.t, s) = make (Word.fromIntInf i, s)
+fun max s = make (modulus s - 1, s)
 
-val toIntInf = Word.toIntInf o word
+fun notb w = make (IntInf.notb (value w), size w)
 
-fun toIntInfX w = Word.toIntInfX (signExtend w)
+fun one s = make (1, s)
 
-local
-   val make: (Word.t * Word.t -> Word.t) -> t * t -> t =
-      fn f => fn (w, w') =>
-      let
-	 val {size = s, word = w} = dest w
-	 val {word = w', ...} = dest w'
-      in
-	 make (f (w, w'), s)
-      end
-in
-   val op + = make Word.+
-   val op - = make Word.-
-   val op * = make Word.*
-   val andb = make Word.andb
-   val op div = make Word.div
-   val op mod = make Word.mod
-   val orb = make Word.orb
-   val xorb = make Word.xorb
-end
-
-fun notb w = make (Word.notb (word w), size w)
+fun resize (w, s) = make (value w, s)
 
-fun isOne w = Word.fromWord 0w1 = word w
-	 
-fun isZero w = Word.fromWord 0w0 = word w
+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 resizeX (w, s) = make (toIntInfX w, s)
 
-fun isAllOnes w = word w = WordSize.allOnes (size w)
+fun toChar (w: t): char = Char.fromInt (Int.fromIntInf (value w))
 
-fun isMax w = word w = WordSize.max (size w)
+val toIntInf = value
 
-fun one s = make (Word.fromWord 0w1, s)
-   
-fun zero s = make (Word.fromWord 0w0, s)
+fun ~>> (w, w') =
+   let
+      val shift = value w'
+      val s = size w
+      val b = WordSize.bits s
+      val shift = if shift > IntInf.fromInt b
+		     then Word.fromInt b
+		  else Word.fromIntInf shift
+   in
+      make (IntInf.~>> (toIntInfX w, shift), s)
+   end
 
-fun max s = make (WordSize.max s, s)
+fun swap (i: IntInf.t, {hi: word, lo: word}) =
+   let
+      open IntInf
+   in
+      orb (~>> (i, lo), << (i mod << (1, lo), hi))
+   end
 
-fun toChar (w: t): char =
+fun rol (w, w') =
    let
-      val {word = w, ...} = dest w
+      val s = size w
+      val b = WordSize.bits s
+      val shift = Word.fromIntInf (value w' mod IntInf.fromInt b)
    in
-      Word.toChar w
+      make (swap (value w, {hi = shift, lo = Word.fromInt b - shift}), s)
    end
 
-val toString = Word.toString o word
+fun ror (w, w') =
+   let
+      val s = size w
+      val b = WordSize.bits s
+      val shift = Word.fromIntInf (value w' mod IntInf.fromInt b)
+   in
+      make (swap (value w, {hi = Word.fromInt b - shift, lo = shift}), s)
+   end
 
 local
-   fun wrap (f: Word.t * PWord.t -> Word.t) (w: t, w': t): t =
-      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)
+   val make: (IntInf.t * IntInf.t -> IntInf.t) -> t * t -> t =
+      fn f => fn (w, w') =>
+      if WordSize.equals (size w, size w')
+	 then make (f (value w, value w'), size w)
+      else raise Fail "WordX binary"
 in
-   val << = wrap Word.<<
-   val >> = wrap Word.>>
+   val op + = make IntInf.+
+   val op - = make IntInf.-
+   val op * = 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
 
 local
-   fun make (f: Word.t * Word.t -> 'a): t * t -> 'a =
-      fn (w, w') =>
-      let
-	 val {size = s, word = w} = dest w
-	 val {size = s', word = w'} = dest w'
-      in
-	 if WordSize.equals (s, s')
-	    then f (w, w')
-	 else Error.bug "WordX binary failure"
-      end
+   val make: (IntInf.t * IntInf.t -> 'a) -> t * t -> 'a =
+      fn f => fn (w, w') =>
+      if WordSize.equals (size w, size w')
+	 then f (value w, value w')
+      else Error.bug "WordX compare"
 in
-   val op < = make Word.<
-   val op <= = make Word.<=
-   val op > = make Word.>
-   val op >= = make Word.>=
+   val op < = make IntInf.<
+   val op <= = make IntInf.<=
+   val op > = make IntInf.>
+   val op >= = make IntInf.>=
 end
 
 end



1.3       +1 -3      mlton/mlton/atoms/word-x.sig

Index: word-x.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/word-x.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- word-x.sig	10 Sep 2003 01:00:09 -0000	1.2
+++ word-x.sig	5 Mar 2004 03:50:52 -0000	1.3
@@ -27,14 +27,13 @@
       val div: t * t -> t
       val equals: t * t -> bool
       val fromChar: char -> t (* returns a word of size 8 *)
-      val fromLargeInt: IntInf.t * WordSize.t -> t
+      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 isZero: t -> bool
       val layout: t -> Layout.t
-      val make: LargeWord.t * WordSize.t -> t
       val max: WordSize.t -> t
       val mod: t * t -> t
       val notb: t -> t
@@ -48,7 +47,6 @@
       val toChar: t -> char
       val toIntInf: t -> IntInf.t
       val toIntInfX: t -> IntInf.t
-      val toLargeWord: t -> LargeWord.t
       val toString: t -> string
       val xorb: t * t -> t
       val zero: WordSize.t -> t



1.60      +13 -5     mlton/mlton/backend/backend.fun

Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -r1.59 -r1.60
--- backend.fun	19 Feb 2004 22:42:09 -0000	1.59
+++ backend.fun	5 Mar 2004 03:50:52 -0000	1.60
@@ -15,6 +15,7 @@
    open Machine
 in
    structure Global = Global
+   structure IntSize = IntSize
    structure IntX = IntX
    structure Label = Label
    structure PointerTycon = PointerTycon
@@ -371,7 +372,10 @@
 	       datatype z = datatype Const.t
 	    in
 	       case c of
-		  Int i => M.Operand.Int i
+		  Int i =>
+		     M.Operand.Int
+		     (IntX.make (IntX.toIntInf i,
+				 IntSize.roundUpToPrim (IntX.size i)))
 		| IntInf i =>
 		     (case Const.SmallIntInf.toWord i of
 			 NONE => globalIntInf i
@@ -380,7 +384,10 @@
 		     if !Control.Native.native
 			then globalReal r
 		     else M.Operand.Real r
-		| Word w => M.Operand.Word w
+		| Word w =>
+		     M.Operand.Word
+		     (WordX.fromIntInf (WordX.toIntInf w,
+					WordSize.roundUpToPrim (WordX.size w)))
 		| Word8Vector v => globalString (Word8.vectorToString v)
 	    end
       end
@@ -436,9 +443,10 @@
 				    ty = ty}
 	     | PointerTycon pt =>
 		  M.Operand.Word
-		  (WordX.make (Word.toLarge (Runtime.typeIndexToHeader
-					     (PointerTycon.index pt)),
-			       WordSize.default))
+		  (WordX.fromIntInf
+		   (Word.toIntInf (Runtime.typeIndexToHeader
+				   (PointerTycon.index pt)),
+		    WordSize.default))
 	     | Runtime f =>
 		  runtimeOp (f, R.Operand.ty oper)
 	     | SmallIntInf w => M.Operand.SmallIntInf w



1.44      +8 -7      mlton/mlton/backend/limit-check.fun

Index: limit-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/limit-check.fun,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- limit-check.fun	28 Feb 2004 01:54:15 -0000	1.43
+++ limit-check.fun	5 Mar 2004 03:50:52 -0000	1.44
@@ -169,8 +169,8 @@
 				       case z of
 					  Operand.EnsuresBytesFree =>
 					     Operand.word
-					     (WordX.make
-					      (Word.toLarge
+					     (WordX.fromIntInf
+					      (Word.toIntInf
 					       (ensureBytesFree (valOf return)),
 					       WordSize.default))
 					| _ => z)),
@@ -368,8 +368,9 @@
 				       insert (Operand.word
 					       (WordX.zero WordSize.default)))
 		else heapCheck (true,
-				Operand.word (WordX.make (Word.toLarge bytes,
-							  WordSize.default)))
+				Operand.word (WordX.fromIntInf
+					      (Word.toIntInf bytes,
+					       WordSize.default)))
 	     fun smallAllocation _ =
 		let
 		   val w = blockCheckAmount {blockIndex = i}
@@ -390,7 +391,7 @@
 			     Const.Word w =>
 				heapCheckNonZero
 				(Word.addCheck
-				 (Word.fromLarge (WordX.toLargeWord w),
+				 (Word.fromIntInf (WordX.toIntInf w),
 				  extraBytes)
 				 handle Overflow => Runtime.allocTooLarge)
 			   | _ => Error.bug "strange primitive bytes needed")
@@ -403,8 +404,8 @@
 			     Vector.new0 (),
 			     Transfer.Arith
 			     {args = Vector.new2 (Operand.word
-						  (WordX.make
-						   (Word.toLarge extraBytes,
+						  (WordX.fromIntInf
+						   (Word.toIntInf extraBytes,
 						    WordSize.default)),
 						  bytesNeeded),
 			      dst = bytes,



1.14      +4 -4      mlton/mlton/backend/machine-atoms.fun

Index: machine-atoms.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine-atoms.fun,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- machine-atoms.fun	3 Mar 2004 02:09:01 -0000	1.13
+++ machine-atoms.fun	5 Mar 2004 03:50:52 -0000	1.14
@@ -9,7 +9,6 @@
 struct
 
 open S
-datatype z = datatype WordSize.t
 
 structure ProfileLabel = ProfileLabel ()
 
@@ -352,9 +351,10 @@
       val stack = Stack
 
       val word8Vector =
-	 Array (MemChunk.T {components = Vector.new1 {mutable = false,
-						      offset = 0,
-						      ty = Type.word W8},
+	 Array (MemChunk.T {components = (Vector.new1
+					  {mutable = false,
+					   offset = 0,
+					   ty = Type.word (WordSize.W 8)}),
 			    size = 1})
 
       val thread =



1.58      +27 -25    mlton/mlton/backend/machine.fun

Index: machine.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/machine.fun,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- machine.fun	20 Feb 2004 02:11:13 -0000	1.57
+++ machine.fun	5 Mar 2004 03:50:52 -0000	1.58
@@ -193,7 +193,26 @@
 	  | StackOffset _ => true
 	  | _ => false
 
-      fun layout (z: t): Layout.t =
+    val ty =
+       fn ArrayOffset {ty, ...} => ty
+	| Cast (_, ty) => ty
+	| Contents {ty, ...} => ty
+	| File => Type.cPointer ()
+	| Frontier => Type.defaultWord
+	| GCState => Type.cPointer ()
+	| Global g => Global.ty g
+	| Int i => Type.int (IntX.size i)
+	| Label l => Type.label l
+	| Line => Type.defaultInt
+	| Offset {ty, ...} => ty
+	| Real r => Type.real (RealX.size r)
+	| Register r => Register.ty r
+	| SmallIntInf _ => Type.intInf
+	| StackOffset {ty, ...} => ty
+	| StackTop => Type.defaultWord
+	| Word w => Type.word (WordX.size w)
+
+    fun layout (z: t): Layout.t =
 	 let
 	    open Layout 
 	    fun constrain (ty: Type.t): Layout.t =
@@ -227,31 +246,12 @@
 	     | SmallIntInf w => seq [str "SmallIntInf ", paren (Word.layout w)]
 	     | StackOffset so => StackOffset.layout so
 	     | StackTop => str "<StackTop>"
-	     | Word w => WordX.layout w
+	     | Word w => seq [WordX.layout w, str ": ", Type.layout (ty z)]
 	 end
 
     val toString = Layout.toString o layout
-
-    val ty =
-       fn ArrayOffset {ty, ...} => ty
-	| Cast (_, ty) => ty
-	| Contents {ty, ...} => ty
-	| File => Type.cPointer ()
-	| Frontier => Type.defaultWord
-	| GCState => Type.cPointer ()
-	| Global g => Global.ty g
-	| Int i => Type.int (IntX.size i)
-	| Label l => Type.label l
-	| Line => Type.defaultInt
-	| Offset {ty, ...} => ty
-	| Real r => Type.real (RealX.size r)
-	| Register r => Register.ty r
-	| SmallIntInf _ => Type.intInf
-	| StackOffset {ty, ...} => ty
-	| StackTop => Type.defaultWord
-	| Word w => Type.word (WordX.size w)
-	 
-      val rec equals =
+			      
+    val rec equals =
 	 fn (ArrayOffset {base = b, index = i, ...},
 	     ArrayOffset {base = b', index = i', ...}) =>
 	        equals (b, b') andalso equals (i, i') 
@@ -1020,9 +1020,11 @@
 			       andalso (Type.equals (ty, ty')
 					orelse
 					(* Get a word from a word8 array.*)
-					(Type.equals (ty, Type.word WordSize.W32)
+					(Type.equals
+					 (ty, Type.word (WordSize.W 32))
 					 andalso
-					 Type.equals (ty', Type.word WordSize.W8)))
+					 Type.equals
+					 (ty', Type.word (WordSize.W 8))))
 			    end
 		       | _ => false)
 		| t => Type.isCPointer t



1.31      +2 -3      mlton/mlton/backend/profile.fun

Index: profile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/profile.fun,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- profile.fun	19 Feb 2004 22:42:09 -0000	1.30
+++ profile.fun	5 Mar 2004 03:50:52 -0000	1.31
@@ -509,9 +509,8 @@
 				       {args = (Vector.new2
 						(Operand.GCState,
 						 Operand.word
-						 (WordX.make
-						  (LargeWord.fromInt
-						   bytesAllocated,
+						 (WordX.fromIntInf
+						  (IntInf.fromInt bytesAllocated,
 						   WordSize.default)))),
 					func = func,
 					return = SOME newLabel}



1.24      +8 -5      mlton/mlton/backend/representation.fun

Index: representation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/representation.fun,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- representation.fun	3 Mar 2004 17:54:42 -0000	1.23
+++ representation.fun	5 Mar 2004 03:50:52 -0000	1.24
@@ -31,8 +31,8 @@
    structure Tycon = Tycon
 end
 
-datatype z = datatype WordSize.t
-   
+datatype z = datatype WordSize.prim
+
 structure TyconRep =
    struct
       datatype t =
@@ -531,8 +531,11 @@
 		       then new ()
 		    else
 		       case S.Type.dest ty of
-			  Word W8 => R.Type.word8Vector
-			| Word W32 => R.Type.wordVector
+			  Word s =>
+			     (case WordSize.prim s of
+				 W8 => R.Type.word8Vector
+			       | W32 => R.Type.wordVector
+			       | _ => new ())
 			| _ => new ()
 		 end
 	      datatype z = datatype S.Type.dest
@@ -575,7 +578,7 @@
 				     SOME (R.Type.pointer pt)
 				  end
 			   else NONE)
-	       | Word s => SOME (R.Type.word s)
+	       | Word s => SOME (R.Type.word (WordSize.roundUpToPrim s))
 	   end))
       val toRtype =
 	 Trace.trace



1.42      +11 -8     mlton/mlton/backend/rssa.fun

Index: rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.fun,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- rssa.fun	3 Mar 2004 02:09:01 -0000	1.41
+++ rssa.fun	5 Mar 2004 03:50:52 -0000	1.42
@@ -16,8 +16,6 @@
    structure GCField = GCField
 end
 
-datatype z = datatype WordSize.t
-
 structure Operand =
    struct
       datatype t =
@@ -132,10 +130,13 @@
 	    Const c =>
 	       (case c of
 		   Const.Word w =>
-		      (* 512 is pretty arbitrary *)
-		      if WordX.<= (w, WordX.fromLargeInt (512, WordX.size w))
-			 then small (LargeWord.toWord (WordX.toLargeWord w))
-		      else big z
+		      let
+			 val w = WordX.toIntInf w
+		      in
+			 if w <= 512 (* 512 is pretty arbitrary *)
+			    then small (Word.fromIntInf w)
+			 else big z
+		      end
 		 | _ => Error.bug "strange numBytes")
 	  | _ => big z
    end
@@ -1065,9 +1066,11 @@
 				  andalso (Type.equals (ty, ty')
 					   orelse
 					   (* Get a word from a word8 array.*)
-					   (Type.equals (ty, Type.word W32)
+					   (Type.equals
+					    (ty, Type.word (WordSize.W 32))
 					    andalso
-					    Type.equals (ty', Type.word W8)))
+					    Type.equals
+					    (ty', Type.word (WordSize.W 8))))
 			       end
 			  | _ => false)
 		   | t => Type.isCPointer t



1.58      +42 -35    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.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- ssa-to-rssa.fun	3 Mar 2004 17:54:42 -0000	1.57
+++ ssa-to-rssa.fun	5 Mar 2004 03:50:52 -0000	1.58
@@ -11,6 +11,9 @@
 open S
 open Rssa
 
+datatype z = datatype IntSize.prim
+datatype z = datatype WordSize.prim
+
 structure S = Ssa
 local
    open Ssa
@@ -23,8 +26,6 @@
    structure GCField = GCField
 end
 
-datatype z = datatype WordSize.t
-
 structure CFunction =
    struct
       open CFunction 
@@ -34,8 +35,8 @@
       in
 	 val Int32 = Int (IntSize.I 32)
 	 val Int64 = Int (IntSize.I 64)
-	 val Word32 = Word W32
-	 val Word64 = Word W64
+	 val Word32 = Word (WordSize.W 32)
+	 val Word64 = Word (WordSize.W 64)
       end
 
       datatype z = datatype CType.t
@@ -1021,8 +1022,8 @@
 			       {args = (Vector.new2
 					(Operand.Cast (addr, Type.defaultWord),
 					 Operand.word
-					 (WordX.make
-					  (LargeWord.fromInt
+					 (WordX.fromIntInf
+					  (IntInf.fromInt
 					   (!Control.cardSizeLog2),
 					   WordSize.default)))),
 				dst = SOME (index, Type.defaultInt),
@@ -1034,8 +1035,8 @@
 					   index = (Operand.Var
 						    {ty = Type.defaultInt,
 						     var = index}),
-					   ty = Type.word W8}),
-				   src = Operand.word (WordX.one W8)})
+					   ty = Type.word (WordSize.W 8)}),
+				   src = Operand.word (WordX.one (WordSize.W 8))})
 			      :: assign
 			      :: ss
 			in
@@ -1066,9 +1067,8 @@
 					       (Operand.Cast (varOp (a 1),
 							      Type.defaultWord),
 					        Operand.word
-						(WordX.make
-						 (LargeWord.fromInt
-						  (Type.size ty),
+						(WordX.fromIntInf
+						 (IntInf.fromInt (Type.size ty),
 						  WordSize.default))),
 				        dst = SOME (temp, Type.defaultWord),
 				        prim = Prim.wordMul WordSize.default})
@@ -1212,17 +1212,13 @@
 					    else primApp (Prim.intToInt (s1, s2))
 				    end
 			       | Int_toWord (s1, s2) =>
-				    let
-				       datatype z = datatype IntSize.prim
-				       datatype z = datatype WordSize.t
-				    in
-				       if (case (IntSize.prim s1, s2) of
-					      (I64, W32) => true
-					    | _ => false)
-					  andalso !Control.Native.native
-					  then simpleCCall (CFunction.intToWord (s1, s2))
-				       else normal ()
-				    end
+				    if (case (IntSize.prim s1,
+					      WordSize.prim s2) of
+					   (I64, W32) => true
+					 | _ => false)
+				       andalso !Control.Native.native
+				       then simpleCCall (CFunction.intToWord (s1, s2))
+				    else normal ()
 			       | IntInf_add => simpleCCall CFunction.intInfAdd
 			       | IntInf_andb => simpleCCall CFunction.intInfAndb
 			       | IntInf_arshift =>
@@ -1305,8 +1301,8 @@
 					    {args = (Vector.new2
 						     (Operand.Runtime LimitPlusSlop,
 						      Operand.word
-						      (WordX.make
-						       (LargeWord.fromInt
+						      (WordX.fromIntInf
+						       (IntInf.fromInt
 							Runtime.limitSlop,
 							size)))),
 					     dst = SOME (tmp, ty),
@@ -1421,22 +1417,33 @@
 				     end,
 				     none)
 			       | Word_equal s =>
-				    if s = WordSize.W64
-				       then simpleCCall CFunction.word64Equal
-				    else normal ()
-			       | Word_toInt (s1, s2) =>
 				    let
-				       datatype z = datatype IntSize.prim
-				       datatype z = datatype WordSize.t
+				       val s = WordSize.roundUpToPrim s
 				    in
-				       if (case (s1, IntSize.prim s2) of
-					      (W32, I64) => true
-					    | _ => false)
+				       if 64 = WordSize.bits s
 					  andalso !Control.Native.native
-					  then simpleCCall (CFunction.wordToInt (s1, s2))
-				       else normal ()
+					  then simpleCCall CFunction.word64Equal
+				       else primApp (Prim.wordEqual s)
 				    end
+			       | Word_toInt (s1, s2) =>
+				    if (case (WordSize.prim s1, IntSize.prim s2) of
+					   (W32, I64) => true
+					 | _ => false)
+				       andalso !Control.Native.native
+				       then simpleCCall (CFunction.wordToInt (s1, s2))
+				    else normal ()
 			       | Word_toIntInf => cast ()
+			       | Word_toWord (s1, s2) =>
+				    let
+				       val s1 = WordSize.roundUpToPrim s1
+				       val s2 = WordSize.roundUpToPrim s2
+				       val b1 = WordSize.bits s1
+				       val b2 = WordSize.bits s2
+				    in
+				       if b1 = b2
+					  then cast ()
+				       else primApp (Prim.wordToWord (s1, s2))
+				    end
 			       | WordVector_toIntInf => cast ()
 			       | Word8Array_subWord => sub Type.defaultWord
 			       | Word8Array_updateWord =>



1.74      +4 -4      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.73
retrieving revision 1.74
diff -u -r1.73 -r1.74
--- c-codegen.fun	3 Mar 2004 02:09:03 -0000	1.73
+++ c-codegen.fun	5 Mar 2004 03:50:53 -0000	1.74
@@ -43,7 +43,7 @@
 end
 
 datatype z = datatype RealSize.t
-datatype z = datatype WordSize.t
+datatype z = datatype WordSize.prim
 
 local
    open Runtime
@@ -122,7 +122,7 @@
 	    fun simple s =
 	       concat ["(Word", s, ")0x", toString w]
 	 in
-	    case size w of
+	    case WordSize.prim (size w) of
 	       W8 => simple "8"
 	     | W16 => simple "16"
 	     | W32 => concat ["0x", toString w]
@@ -413,10 +413,10 @@
 		  if 0 = Vector.length pointers
 		     then int (IntSize.I 32)
 		  else pointer
-	     | ExnStack => word W32
+	     | ExnStack => word WordSize.default
 	     | Int s => int s
 	     | IntInf => pointer
-	     | Label _ => word W32
+	     | Label _ => word WordSize.default
 	     | Real s => real s
 	     | Word s => word s
 	     | _ => Error.bug (concat ["Type.toC strange type: ", toString t])



1.57      +29 -28    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.56
retrieving revision 1.57
diff -u -r1.56 -r1.57
--- x86-mlton.fun	3 Mar 2004 02:09:05 -0000	1.56
+++ x86-mlton.fun	5 Mar 2004 03:50:53 -0000	1.57
@@ -17,9 +17,10 @@
      structure CFunction = CFunction
      structure IntSize = IntSize
      structure Prim = Prim
+     structure WordSize = WordSize
      datatype z = datatype IntSize.prim
      datatype z = datatype RealSize.t
-     datatype z = datatype WordSize.t
+     datatype z = datatype WordSize.prim
   end
 
   type transInfo = {addData : x86.Assembly.t list -> unit,
@@ -748,7 +749,7 @@
 		    | (I8, R32) => default' ()
 		end
 	     | Int_toWord (s, s') =>
-		(case (IntSize.prim s, s') of
+		(case (IntSize.prim s, WordSize.prim s') of
 		    (I64, W64) => Error.bug "FIXME"
 		  | (I64, W32) => Error.bug "FIXME"
 		  | (I64, W16) => Error.bug "FIXME"
@@ -1337,79 +1338,79 @@
 	     | Real_neg _ => funa Instruction.FCHS
 	     | Real_round _ => funa Instruction.FRNDINT
 	     | Word_add s => 
-		(case s of
+		(case WordSize.prim s of
 		    W8 => binal Instruction.ADD
 		  | W16 => binal Instruction.ADD
 		  | W32 => binal Instruction.ADD
 		  | W64 => binal64 (Instruction.ADD, Instruction.ADC))
 	     | Word_andb s => 
-		(case s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(case WordSize.prim s of
 		    W8 => pmd Instruction.MOD
 		  | W16 => pmd Instruction.MOD
 		  | W32 => pmd Instruction.MOD
 		  | W64 => Error.bug "FIXME")
 	     | Word_mul s =>
-		(case s of
+		(case WordSize.prim s of
 		    W8 => pmd Instruction.MUL
 		  | W16 => imul2 ()
 		  | W32 => imul2 ()
 		  | W64 => Error.bug "FIXME")
 	     | Word_neg s => 
-		(case s of
+		(case WordSize.prim s of
 		    W8 => unal Instruction.NEG
 		  | W16 => unal Instruction.NEG
 		  | W32 => unal Instruction.NEG
@@ -1420,43 +1421,43 @@
 							 src = Operand.immediate_const_int 0,
 							 size = dstsize}]))
 	     | Word_notb s => 
-		(case s of
+		(case WordSize.prim s of
 		    W8 => unal Instruction.NOT
 		  | W16 => unal Instruction.NOT
 		  | W32 => unal Instruction.NOT
 		  | W64 => unal64 (Instruction.NOT, fn _ => []))
 	     | Word_orb s => 
-		(case s of
+		(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 s of
+		(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 s of
+		(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 s of
+		(case WordSize.prim s of
 		    W8 => sral Instruction.SHR
 		  | W16 => sral Instruction.SHR
 		  | W32 => sral Instruction.SHR
 		  | W64 => Error.bug "FIXME")
 	     | Word_sub s => 
-		(case s of
+		(case WordSize.prim s of
 		    W8 => binal Instruction.SUB
 		  | W16 => binal Instruction.SUB
 		  | W32 => binal Instruction.SUB
 		  | W64 => binal64 (Instruction.SUB, Instruction.SBB))
 	     | Word_toInt (s, s') =>
-		(case (s, IntSize.prim s') of
+		(case (WordSize.prim s, IntSize.prim s') of
 		   (W64, I64) => Error.bug "FIXME"
 		 | (W64, I32) => Error.bug "FIXME"
 		 | (W64, I16) => Error.bug "FIXME"
@@ -1474,7 +1475,7 @@
 		 | (W8, I16) => movx Instruction.MOVZX
 		 | (W8, I8) => mov ())
 	     | Word_toIntX (s, s') =>
-		(case (s, IntSize.prim s') of
+		(case (WordSize.prim s, IntSize.prim s') of
 		   (W64, I64) => Error.bug "FIXME"
 		 | (W64, I32) => Error.bug "FIXME"
 		 | (W64, I16) => Error.bug "FIXME"
@@ -1492,7 +1493,7 @@
 		 | (W8, I16) => movx Instruction.MOVSX
 		 | (W8, I8) => mov ())
 	     | Word_toWord (s, s') =>
-	        (case (s, s') of
+	        (case (WordSize.prim s, WordSize.prim s') of
 		    (W64, W64) => Error.bug "FIXME"
 		  | (W64, W32) => Error.bug "FIXME"
 		  | (W64, W16) => Error.bug "FIXME"
@@ -1510,7 +1511,7 @@
 		  | (W8, W16) => movx Instruction.MOVZX
 		  | (W8, W8) => mov ())
 	     | Word_toWordX (s, s') =>
-		(case (s, s') of
+		(case (WordSize.prim s, WordSize.prim s') of
 		    (W64, W64) => Error.bug "FIXME"
 		  | (W64, W32) => Error.bug "FIXME"
 		  | (W64, W16) => Error.bug "FIXME"
@@ -1528,7 +1529,7 @@
 		  | (W8, W16) => movx Instruction.MOVSX
 		  | (W8, W8) => mov ())
 	     | Word_xorb s => 
-		(case s of
+		(case WordSize.prim s of
 		    W8 => binal Instruction.XOR
 		  | W16 => binal Instruction.XOR
 		  | W32 => binal Instruction.XOR
@@ -1908,13 +1909,13 @@
 		| I32 => unal (x86.Instruction.NEG, x86.Instruction.O)
 		| I64 => neg64 ())
 	   | Word_addCheck s => 
-	       (case s of
+	       (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 => 
-	       (case s of
+	       (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)



1.53      +9 -10     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.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- x86-translate.fun	3 Mar 2004 02:09:06 -0000	1.52
+++ x86-translate.fun	5 Mar 2004 03:50:54 -0000	1.53
@@ -32,9 +32,8 @@
      structure WordX = WordX
   end
 
-  datatype z = datatype RealSize.t
-  datatype z = datatype WordSize.t
-  
+  datatype z = datatype WordSize.prim
+
   structure Global =
      struct
 	open Machine.Global
@@ -340,18 +339,18 @@
 		  fun single size =
 		     Vector.new1
 		     (x86.Operand.immediate_const_word
-		      (Word.fromLarge (WordX.toLargeWord w)),
+		      (Word.fromIntInf (WordX.toIntInf w)),
 		      size)
 	       in
-		  case WordX.size w of
+		  case WordSize.prim (WordX.size w) of
 		     W8 => single x86.Size.BYTE
 		   | W16 => single x86.Size.WORD
 		   | W32 => single x86.Size.LONG
 		   | W64 =>
 			let
-			   val w = WordX.toLargeWord w
-			   val lo = Word.fromLarge w
-			   val hi = Word.fromLarge (LargeWord.>> (w, 0w32))
+			   val w = WordX.toIntInf w
+			   val lo = Word.fromIntInf w
+			   val hi = Word.fromIntInf (IntInf.~>> (w, 0w32))
 			in
 			   Vector.new2
 			   ((x86.Operand.immediate_const_word lo, x86.Size.LONG),
@@ -883,8 +882,8 @@
 		     | Word {cases, default, test, ...} =>
 			  simple ({cases = (Vector.map
 					    (cases, fn (w, l) =>
-					     (Word.fromLarge
-					      (WordX.toLargeWord w),
+					     (Word.fromIntInf
+					      (WordX.toIntInf w),
 					      l))),
 				   default = default,
 				   test = test},



1.50      +16 -10    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.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- x86.fun	3 Mar 2004 02:09:06 -0000	1.49
+++ x86.fun	5 Mar 2004 03:50:54 -0000	1.50
@@ -158,8 +158,10 @@
 		     | R64 => Vector.new1 DBLE
 		  end
 	     | Word s =>
-		  let datatype z = datatype WordSize.t
-		  in case s of
+		  let
+		     datatype z = datatype WordSize.prim
+		  in
+		     case WordSize.prim s of
 		       W8 => Vector.new1 BYTE
 		     | W16 => Vector.new1 WORD 
 		     | W32 => Vector.new1 LONG
@@ -717,12 +719,14 @@
 		     | R64 => Eight
 		  end
 	     | Word s =>
-		  let datatype z = datatype WordSize.t
-		  in case s of
-		       W8 => One
-		     | W16 => Two
-		     | W32 => Four
-		     | W64 => Eight
+		  let
+		     datatype z = datatype WordSize.prim
+		  in
+		     case WordSize.prim s of
+			W8 => One
+		      | W16 => Two
+		      | W32 => Four
+		      | W64 => Eight
 		  end
       end
 
@@ -1466,8 +1470,10 @@
 			    | R64 => [{src = fltregister FltRegister.top,
 				       dst = cReturnTempContent (0, DBLE)}]
 			 end
-	     | Word s => let datatype z = datatype WordSize.t
-			 in case s of
+	     | Word s => let
+			    datatype z = datatype WordSize.prim
+			 in
+			    case WordSize.prim s of
 			      W8 => [{src = register Register.al,
 				      dst = cReturnTempContent (0, BYTE)}]
 			    | W16 => [{src = register Register.ax,



1.14      +0 -1      mlton/mlton/defunctorize/defunctorize.fun

Index: defunctorize.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/defunctorize/defunctorize.fun,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- defunctorize.fun	19 Feb 2004 22:42:13 -0000	1.13
+++ defunctorize.fun	5 Mar 2004 03:50:54 -0000	1.14
@@ -815,7 +815,6 @@
 					 ty = ty}
 			fun id () = Vector.sub (args, 0)
 			datatype z = datatype Prim.Name.t
-			datatype z = datatype WordSize.t
 		     in
 			case Prim.name prim of
 			   Char_toWord8 => id ()



1.94      +4 -3      mlton/mlton/elaborate/elaborate-core.fun

Index: elaborate-core.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-core.fun,v
retrieving revision 1.93
retrieving revision 1.94
diff -u -r1.93 -r1.94
--- elaborate-core.fun	21 Feb 2004 04:21:54 -0000	1.93
+++ elaborate-core.fun	5 Mar 2004 03:50:54 -0000	1.94
@@ -225,7 +225,8 @@
       case Aconst.node c of
 	 Aconst.Bool b => if b then t else f
        | Aconst.Char c =>
-	    now (Const.Word (WordX.make (LargeWord.fromChar c, WordSize.W8)),
+	    now (Const.Word (WordX.fromIntInf (IntInf.fromInt (Char.toInt c),
+					       WordSize.W 8)),
 		 Type.char)
        | Aconst.Int i =>
 	    let
@@ -261,8 +262,8 @@
 	       (ty, fn tycon =>
 		choose (tycon, WordSize.all, Tycon.word, fn s =>
 			Const.Word
-			(if w <= LargeWord.toIntInf (WordSize.max s)
-			    then WordX.fromLargeInt (w, s)
+			(if w <= WordSize.max s
+			    then WordX.fromIntInf (w, s)
 			 else (error ty
 			       ; WordX.zero s))))
 	    end	       



1.30      +4 -2      mlton/mlton/elaborate/type-env.fun

Index: type-env.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/type-env.fun,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- type-env.fun	20 Feb 2004 18:43:12 -0000	1.29
+++ type-env.fun	5 Mar 2004 03:50:54 -0000	1.30
@@ -1169,7 +1169,7 @@
 	    UnifyResult.NotUnifiable ((l, _), (l', _)) => NotUnifiable (l, l')
 	  | UnifyResult.Unified => Unified
 
-      val word8 = word WordSize.W8
+      val word8 = word (WordSize.W 8)
 	 
       fun 'a simpleHom {con: t * Tycon.t * 'a vector -> 'a,
 			expandOpaque: bool,
@@ -1217,7 +1217,9 @@
 	    val con =
 	       fn (t, c, ts) =>
 	       if replaceCharWithWord8 andalso Tycon.equals (c, Tycon.char)
-		  then con (word8, Tycon.word WordSize.W8, Vector.new0 ())
+		  then con (word8,
+			    Tycon.word (WordSize.W 8),
+			    Vector.new0 ())
 	       else con (t, c, ts)
 	 in
 	    makeHom {con = con,



1.4       +1 -2      mlton/mlton/main/lookup-constant.fun

Index: lookup-constant.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/lookup-constant.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- lookup-constant.fun	19 Feb 2004 22:42:14 -0000	1.3
+++ lookup-constant.fun	5 Mar 2004 03:50:55 -0000	1.4
@@ -172,8 +172,7 @@
 		  (case IntInf.fromString value of
 		      NONE => Error.bug "strange Word constant"
 		    | SOME i =>
-			 Const.Word (WordX.make (LargeWord.fromIntInf i,
-						 WordSize.default)))
+			 Const.Word (WordX.fromIntInf (i, WordSize.default)))
 	 end
    in
       lookupConstant



1.9       +7 -6      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.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- match-compile.fun	3 Mar 2004 02:09:06 -0000	1.8
+++ match-compile.fun	5 Mar 2004 03:50:55 -0000	1.9
@@ -147,7 +147,8 @@
 	    IntSize.cardinality, Type.int, Cases.int,
 	    fn Const.Int i => i
 	     | _ => Error.bug "caseInt type error")
-      @ make (List.remove (WordSize.all, fn s => WordSize.W64 = s),
+      @ make (List.remove (WordSize.all, fn s =>
+			   WordSize.equals (s, WordSize.W 64)),
 	      WordSize.cardinality, Type.word, Cases.word,
 	      fn Const.Word w => w
 	       | _ => Error.bug "caseWord type error")
@@ -223,16 +224,16 @@
 	       val s = WordX.size w
 	       fun extract c =
 		  case c of
-		     Word w => WordX.toLargeWord w
+		     Word w => WordX.toIntInf w
 		   | _ => Error.bug "expected Word"
 	    in
 	       search {<= = op <=,
 		       equals = op =,
 		       extract = extract,
-		       isMin = fn w => w = 0w0,
-		       make = fn w => Const.word (WordX.make (w, s)),
-		       next = fn w => w + 0w1,
-		       prev = fn w => w - 0w1}
+		       isMin = fn w => w = 0,
+		       make = fn w => Const.word (WordX.fromIntInf (w, s)),
+		       next = fn w => w + 1,
+		       prev = fn w => w - 1}
 	    end
        | Word8Vector _ =>
 	    let



1.66      +0 -2      mlton/mlton/ssa/ssa-tree.fun

Index: ssa-tree.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ssa-tree.fun,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- ssa-tree.fun	3 Mar 2004 02:09:08 -0000	1.65
+++ ssa-tree.fun	5 Mar 2004 03:50:55 -0000	1.66
@@ -9,8 +9,6 @@
 struct
 
 open S
-datatype z = datatype RealSize.t
-datatype z = datatype WordSize.t
 
 structure Type =
    struct



1.28      +1 -2      mlton/mlton/ssa/type-check.fun

Index: type-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/type-check.fun,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- type-check.fun	20 Feb 2004 02:11:15 -0000	1.27
+++ type-check.fun	5 Mar 2004 03:50:55 -0000	1.28
@@ -126,8 +126,7 @@
 		     Cases.Con cs => doitCon cs 
 		   | Cases.Int (_, cs) => doit (cs, IntX.equals, IntX.hash)
 		   | Cases.Word (_, cs) =>
-			doit (cs, WordX.equals,
-			      LargeWord.toWord o WordX.toLargeWord)
+			doit (cs, WordX.equals, Word.fromIntInf o WordX.toIntInf)
 	       end
 	  | Goto {args, ...} => getVars args
 	  | Raise xs => getVars xs