[MLton-devel] cvs commit: Word64 is there

Stephen Weeks sweeks@users.sourceforge.net
Wed, 10 Sep 2003 17:51:08 -0700


sweeks      03/09/10 17:51:08

  Modified:    basis-library/arrays-and-vectors mono.sml
               basis-library/integer patch.sml
               basis-library/libs build
               basis-library/libs/basis-2002/top-level basis.sig basis.sml
                        overloads.sml
               basis-library/misc primitive.sml
               bin      check-basis
               doc      changelog
               doc/user-guide basis.tex
               include  c-chunk.h
               mlton/ast prim-tycons.fun
               mlton/backend ssa-to-rssa.fun
               runtime  Makefile
  Added:       basis-library/integer word.sml
               regression word-all.ok word-all.sml
               runtime/basis/Int Word64.c
  Removed:     basis-library/integer word.fun word16.sml word32.sml
                        word8.sml
               regression word.sub.ok word.sub.sml word2.ok word2.sml
                        word8.ok word8.sml
  Log:
  Word64 is implemented, much as Int64 is, with _import for all the
  primitives.  This is especially bad for coercions that bounce through
  LargeWord (which is now Word64), since they will involve a couple of C
  calls and cannot be simplified away.
  
  Hopefully the Word64 primitives can be added to the x86 codegen at the
  same time as the Int64 ones.  As the primitives are added, they should
  be propagated to basis-library/misc/primitive.sml, eliminated from
  runtime/basis/Int/Word64.c, and uncommented in include/c-chunk.h.
  
  Added a new regression, word-all.sml, that tests all of the functions
  in all of the Word modules.

Revision  Changes    Path
1.3       +15 -5     mlton/basis-library/arrays-and-vectors/mono.sml

Index: mono.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mono.sml	5 Sep 2003 23:01:00 -0000	1.2
+++ mono.sml	11 Sep 2003 00:51:06 -0000	1.3
@@ -148,6 +148,16 @@
    structure Word32ArraySlice = ArraySlice
    structure Word32Array2 = Array2
 end
+local
+   structure S = EqMono (type elem = Word64.word)
+   open S
+in
+   structure Word64Vector = Vector
+   structure Word64VectorSlice = VectorSlice
+   structure Word64Array = Array
+   structure Word64ArraySlice = ArraySlice
+   structure Word64Array2 = Array2
+end
 
 structure IntVector = Int32Vector
 structure IntVectorSlice = Int32VectorSlice
@@ -179,8 +189,8 @@
 structure WordArraySlice = Word32ArraySlice
 structure WordArray2 = Word32Array2
 
-structure LargeWordVector = Word32Vector
-structure LargeWordVectorSlice = Word32VectorSlice
-structure LargeWordArray = Word32Array
-structure LargeWordArraySlice = Word32ArraySlice
-structure LargeWordArray2 = Word32Array2
+structure LargeWordVector = Word64Vector
+structure LargeWordVectorSlice = Word64VectorSlice
+structure LargeWordArray = Word64Array
+structure LargeWordArraySlice = Word64ArraySlice
+structure LargeWordArray2 = Word64Array2



1.9       +29 -1     mlton/basis-library/integer/patch.sml

Index: patch.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/patch.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- patch.sml	5 Sep 2003 23:01:01 -0000	1.8
+++ patch.sml	11 Sep 2003 00:51:06 -0000	1.9
@@ -121,6 +121,34 @@
       end
    end
 
+structure Word64: WORD =
+   struct
+      open Word64
+
+      structure W = Word64
+
+      val t32 = IntInf.pow (2, 32)
+      val t64 = IntInf.pow (2, 64)
+	 
+      fun toLargeInt w =
+	 IntInf.+ (Word32.toLargeInt (Word32.fromLarge w),
+		   IntInf.<< (Word32.toLargeInt (Word32.fromLarge (>> (w, 0w32))),
+			      0w32))
+
+      fun toLargeIntX w =
+	 if 0w0 = andb (w, << (0w1, 0w63))
+	    then toLargeInt w
+	 else IntInf.- (toLargeInt w, t64)
+
+      fun fromLargeInt (i: IntInf.int): word =
+	 let
+	    val (d, m) = IntInf.divMod (i, t32)
+	 in
+	    W.orb (W.<< (Word32.toLarge (Word32.fromLargeInt d), 0w32),
+		   Word32.toLarge (Word32.fromLargeInt m))
+	 end
+   end
+
 structure Word = Word32
-structure LargeWord = Word32
+structure LargeWord = Word64
 structure SysWord = Word32



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

Index: word.sml
===================================================================
(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
 *    Jagannathan, and Stephen Weeks.
 * Copyright (C) 1997-1999 NEC Research Institute.
 *
 * MLton is released under the GNU General Public License (GPL).
 * Please see the file MLton-LICENSE for license information.
 *)
functor Word (W: PRE_WORD_EXTRA): WORD_EXTRA =
struct

open W
structure PW = Primitive.Word

val detectOverflow = Primitive.detectOverflow

(* These are overriden in patch.sml after int-inf.sml has been defined. *)
val toLargeInt: word -> LargeInt.int = fn _ => raise Fail "toLargeInt"
val toLargeIntX: word -> LargeInt.int = fn _ => raise Fail "toLargeIntX"
val fromLargeInt: LargeInt.int -> word = fn _ => raise Fail "fromLargeInt"

val wordSizeWord: Word.word = PW.fromInt wordSize
val wordSizeMinusOneWord: Word.word = PW.fromInt (Int.-? (wordSize, 1))
val zero: word = fromInt 0
val one: word = fromInt 1
val allOnes: word = notb zero

val toLargeWord = toLarge
val toLargeWordX = toLargeX
val fromLargeWord = fromLarge

fun toInt w =
   if detectOverflow
      andalso Int.>= (wordSize, Int.precision')
      andalso w > fromInt Int.maxInt'
      then raise Overflow
   else W.toInt w
		      
fun toIntX w =
  if detectOverflow
     andalso Int.> (wordSize, Int.precision')
     andalso fromInt Int.maxInt' < w
     andalso w < fromInt Int.minInt'
     then raise Overflow
  else W.toIntX w

local
   fun make f (w, w') =
      if Primitive.safe andalso w' = zero
	 then raise Div
      else f (w, w')
in
   val op div = make (op div)
   val op mod = make (op mod)
end

fun << (i, n) 
  = if PW.>=(n ,wordSizeWord)
      then zero
      else W.<<(i, n)

fun >> (i, n) 
  = if PW.>=(n, wordSizeWord)
      then zero
      else W.>>(i, n)

fun ~>> (i, n) 
  = if PW.<(n, wordSizeWord)
      then W.~>>(i, n)
      else W.~>>(i, wordSizeMinusOneWord)

val {compare, min, max} = Util.makeCompare(op <)

fun fmt radix (w: word): string =
   let val radix = fromInt (StringCvt.radixToInt radix)
      fun loop (q, chars) =
	 let val chars = StringCvt.digitToChar (toInt (q mod radix)) :: chars
	    val q = q div radix
	 in if q = zero
	       then String0.implode chars
	    else loop (q, chars)
	 end
   in loop (w, [])
   end

val toString = fmt StringCvt.HEX

fun scan radix reader state =
   let
      val state = StringCvt.skipWS reader state
      val charToDigit = StringCvt.charToDigit radix
      val radixWord = fromInt (StringCvt.radixToInt radix)
      fun finishNum (state, n) =
	 case reader state of
	    NONE => SOME (n, state)
	  | SOME (c, state') =>
	       case charToDigit c of
		  NONE => SOME (n, state)
		| SOME n' =>
		     let val n'' = n * radixWord
		     in if n'' div radixWord = n
			   then let val n' = fromInt n'
				   val n''' = n'' + n'
				in if n''' >= n''
				      then finishNum (state', n''')
				   else raise Overflow
				end
			else raise Overflow
		     end
      fun num state = finishNum (state, zero)
   in
      case reader state of
	 NONE => NONE
       | SOME (c, state) =>
	    case c of
	       #"0" =>
	       (case reader state of
		   NONE => SOME (zero, state)
		 | SOME (c, state') =>
		      case c of
			 #"w" => (case radix of
				     StringCvt.HEX =>
					(case reader state' of
					    NONE =>
					       (* the #"w" was not followed by
						* an #"X" or #"x", therefore we
						* return 0 *)
					       SOME (zero, state)
					  | SOME (c, state) =>
					       (case c of
						   #"x" => num state
						 | #"X" => num state
						 | _ =>
						 (* the #"w" was not followed by
						  * an #"X" or #"x", therefore we
						  * return 0 *)
						      SOME (zero, state)))
				   | _ => num state')
		       | #"x" => (case radix of
				     StringCvt.HEX => num state'
				   | _ => NONE)
		       | #"X" => (case radix of
				     StringCvt.HEX => num state'
				   | _ => NONE)
		       | _ => num state)
	     | _ => (case charToDigit c of
			NONE => NONE
		      | SOME n => finishNum (state, fromInt n))
   end

val fromString = StringCvt.scanString (scan StringCvt.HEX)

end

structure Word8 = Word (Primitive.Word8)
structure Word16 = Word (Primitive.Word16)
structure Word32 = Word (Primitive.Word32)
structure Word64 = Word (Primitive.Word64)
structure Word = Word32
structure WordGlobal: WORD_GLOBAL = Word
open WordGlobal



1.23      +1 -4      mlton/basis-library/libs/build

Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- build	9 Sep 2003 14:48:57 -0000	1.22
+++ build	11 Sep 2003 00:51:06 -0000	1.23
@@ -59,10 +59,7 @@
 misc/C.sig
 misc/C.sml
 integer/word.sig
-integer/word.fun
-integer/word8.sml
-integer/word16.sml
-integer/word32.sml
+integer/word.sml
 integer/int-inf.sig
 integer/int-inf.sml
 real/IEEE-real.sig



1.19      +11 -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.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- basis.sig	9 Sep 2003 23:38:22 -0000	1.18
+++ basis.sig	11 Sep 2003 00:51:06 -0000	1.19
@@ -231,6 +231,11 @@
 (*
       structure Windows : WINDOWS
 *)
+      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
@@ -243,11 +248,12 @@
       structure Word32ArraySlice : MONO_ARRAY_SLICE
       structure Word32Vector : MONO_VECTOR
       structure Word32VectorSlice : MONO_VECTOR_SLICE
-      structure WordArray : MONO_ARRAY
-      structure WordArray2 : MONO_ARRAY2
-      structure WordArraySlice : MONO_ARRAY_SLICE
-      structure WordVector : MONO_VECTOR
-      structure WordVectorSlice : MONO_VECTOR_SLICE
+      structure Word64 : WORD
+      structure Word64Array : MONO_ARRAY
+      structure Word64Array2 : MONO_ARRAY2
+      structure Word64ArraySlice : MONO_ARRAY_SLICE
+      structure Word64Vector : MONO_VECTOR
+      structure Word64VectorSlice : MONO_VECTOR_SLICE
 
       (* ************************************************** *)
       (* ************************************************** *)



1.17      +11 -5     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.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- basis.sml	9 Sep 2003 23:38:22 -0000	1.16
+++ basis.sml	11 Sep 2003 00:51:06 -0000	1.17
@@ -150,6 +150,11 @@
 (*
       structure Windows = Windows
 *)
+      structure WordArray = WordArray
+      structure WordArray2 = WordArray2
+      structure WordArraySlice = WordArraySlice
+      structure WordVector = WordVector
+      structure WordVectorSlice = WordVectorSlice
       structure Word16 = Word16
       structure Word16Array = Word16Array
       structure Word16Array2 = Word16Array2
@@ -162,11 +167,12 @@
       structure Word32ArraySlice = Word32ArraySlice
       structure Word32Vector = Word32Vector
       structure Word32VectorSlice = Word32VectorSlice
-      structure WordArray = WordArray
-      structure WordArray2 = WordArray2
-      structure WordArraySlice = WordArraySlice
-      structure WordVector = WordVector
-      structure WordVectorSlice = WordVectorSlice
+      structure Word64 = Word64
+      structure Word64Array = Word64Array
+      structure Word64Array2 = Word64Array2
+      structure Word64ArraySlice = Word64ArraySlice
+      structure Word64Vector = Word64Vector
+      structure Word64VectorSlice = Word64VectorSlice
 
       open ArrayGlobal
 	   BoolGlobal



1.7       +14 -1     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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- overloads.sml	6 Sep 2003 18:41:26 -0000	1.6
+++ overloads.sml	11 Sep 2003 00:51:06 -0000	1.7
@@ -9,7 +9,7 @@
 (*
  *     * 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, 
+ *     * 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}
@@ -34,6 +34,7 @@
  * and Word8.f
  * and Word16.f
  * and Word32.f
+ * and Word64.f
  * and LargeWord.f
  * and SysWord.f
  * and Real.f
@@ -56,6 +57,7 @@
  * and Word8.f
  * and Word16.f
  * and Word32.f
+ * and Word64.f
  * and LargeWord.f
  * and SysWord.f
  * 
@@ -90,6 +92,7 @@
  * and Word8.f
  * and Word16.f
  * and Word32.f
+ * and Word64.f
  * and LargeWord.f
  * and SysWord.f
  * and Real.f
@@ -114,6 +117,7 @@
 and Word8.~
 and Word16.~
 and Word32.~
+and Word64.~
 and LargeWord.~
 and SysWord.~
 and Real.~
@@ -135,6 +139,7 @@
 and Word8.+
 and Word16.+
 and Word32.+
+and Word64.+
 and LargeWord.+
 and SysWord.+
 and Real.+
@@ -156,6 +161,7 @@
 and Word8.-
 and Word16.-
 and Word32.-
+and Word64.-
 and LargeWord.-
 and SysWord.-
 and Real.-
@@ -177,6 +183,7 @@
 and Word8.*
 and Word16.*
 and Word32.*
+and Word64.*
 and LargeWord.*
 and SysWord.*
 and Real.*
@@ -213,6 +220,7 @@
 and Word8.div
 and Word16.div
 and Word32.div
+and Word64.div
 and LargeWord.div
 and SysWord.div
 
@@ -230,6 +238,7 @@
 and Word8.mod
 and Word16.mod
 and Word32.mod
+and Word64.mod
 and LargeWord.mod
 and SysWord.mod
 
@@ -262,6 +271,7 @@
 and Word8.<
 and Word16.<
 and Word32.<
+and Word64.<
 and LargeWord.<
 and SysWord.<
 and Real.<
@@ -285,6 +295,7 @@
 and Word8.<=
 and Word16.<=
 and Word32.<=
+and Word64.<=
 and LargeWord.<=
 and SysWord.<=
 and Real.<=
@@ -308,6 +319,7 @@
 and Word8.>
 and Word16.>
 and Word32.>
+and Word64.>
 and LargeWord.>
 and SysWord.>
 and Real.>
@@ -331,6 +343,7 @@
 and Word8.>=
 and Word16.>=
 and Word32.>=
+and Word64.>=
 and LargeWord.>=
 and SysWord.>=
 and Real.>=



1.78      +71 -24    mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- primitive.sml	5 Sep 2003 23:01:03 -0000	1.77
+++ primitive.sml	11 Sep 2003 00:51:06 -0000	1.78
@@ -37,6 +37,7 @@
    struct
       type int = int32
    end
+structure Int = Int32
 structure Int64 =
    struct
       type int = int64
@@ -45,8 +46,10 @@
    struct
       type int = intInf
    end
+structure LargeInt = IntInf
 datatype list = datatype list
 type pointer = pointer (* C integer, not SML heap pointer *)
+
 structure Real32 =
    struct
       type real = real32
@@ -55,9 +58,12 @@
    struct
       type real = real64
    end
+structure Real = Real64
+
 datatype ref = datatype ref
 type preThread = preThread
 type thread = thread
+
 structure Word8 =
    struct
       type word = word8
@@ -70,16 +76,20 @@
    struct
       type word = word32
    end
+structure Word = Word32
+structure Word64 =
+   struct
+      type word = word64
+   end
+structure LargeWord = Word64
+
 type 'a vector = 'a vector
 type 'a weak = 'a weak
 type string = char vector
 type nullString = string
 
-structure Int = Int32
 type int = Int.int
-structure Real = Real64
 type real = Real.real
-structure Word = Word32
 type word = Word.word
 
 exception Bind = Bind
@@ -1155,20 +1165,21 @@
 
       structure Word8 =
 	 struct
-	    type word = word8
+	    open Word8
+	       
 	    val wordSize: int = 8
 
 	    val + = _prim "Word8_add": word * word -> word;
 	    val addCheck = _prim "Word8_addCheck": word * word -> word;
 	    val andb = _prim "Word8_andb": word * word -> word;
-	    val ~>> = _prim "Word8_arshift": word * word32 -> word;
+	    val ~>> = _prim "Word8_arshift": word * Word.word -> word;
 	    val div = _prim "Word8_div": word * word -> word;
 	    val fromInt = _prim "Int32_toWord8": int -> word;
-	    val fromLarge = _prim "Word32_toWord8": word32 -> word;
+	    val fromLarge = _import "Word64_toWord8": LargeWord.word -> word;
 	    val >= = _prim "Word8_ge": word * word -> bool;
 	    val > = _prim "Word8_gt" : word * word -> bool;
 	    val <= = _prim "Word8_le": word * word -> bool;
-	    val << = _prim "Word8_lshift": word * word32 -> word;
+	    val << = _prim "Word8_lshift": word * Word.word -> word;
 	    val < = _prim "Word8_lt" : word * word -> bool;
 	    val mod = _prim "Word8_mod": word * word -> word;
 	    val * = _prim "Word8_mul": word * word -> word;
@@ -1176,15 +1187,15 @@
 	    val ~ = _prim "Word8_neg": word -> word;
 	    val notb = _prim "Word8_notb": word -> word;
 	    val orb = _prim "Word8_orb": word * word -> word;
-	    val rol = _prim "Word8_rol": word * word32 -> word;
-	    val ror = _prim "Word8_ror": word * word32 -> word;
-	    val >> = _prim "Word8_rshift": word * word32 -> word;
+	    val rol = _prim "Word8_rol": word * Word.word -> word;
+	    val ror = _prim "Word8_ror": word * Word.word -> word;
+	    val >> = _prim "Word8_rshift": word * Word.word -> word;
 	    val - = _prim "Word8_sub": word * word -> word;
 	    val toChar = _prim "Word8_toChar": word -> char;
 	    val toInt = _prim "Word8_toInt32": word -> int;
 	    val toIntX = _prim "Word8_toInt32X": word -> int;
-	    val toLarge = _prim "Word8_toWord32": word -> word32;
-	    val toLargeX = _prim "Word8_toWord32X": word -> word32;
+	    val toLarge = _import "Word8_toWord64": word -> LargeWord.word;
+	    val toLargeX = _import "Word8_toWord64X": word -> LargeWord.word;
 	    val xorb = _prim "Word8_xorb": word * word -> word;
 	 end
 
@@ -1210,20 +1221,21 @@
 
       structure Word16 =
 	 struct
-	    type word = word16
+	    open Word16
+	       
 	    val wordSize: int = 16
 
 	    val + = _prim "Word16_add": word * word -> word;
 	    val addCheck = _prim "Word16_addCheck": word * word -> word;
 	    val andb = _prim "Word16_andb": word * word -> word;
-	    val ~>> = _prim "Word16_arshift": word * word32 -> word;
+	    val ~>> = _prim "Word16_arshift": word * Word.word -> word;
 	    val div = _prim "Word16_div": word * word -> word;
 	    val fromInt = _prim "Int32_toWord16": int -> word;
-	    val fromLarge = _prim "Word32_toWord16": word32 -> word;
+	    val fromLarge = _import "Word64_toWord16": LargeWord.word -> word;
 	    val >= = _prim "Word16_ge": word * word -> bool;
 	    val > = _prim "Word16_gt" : word * word -> bool;
 	    val <= = _prim "Word16_le": word * word -> bool;
-	    val << = _prim "Word16_lshift": word * word32 -> word;
+	    val << = _prim "Word16_lshift": word * Word.word -> word;
 	    val < = _prim "Word16_lt" : word * word -> bool;
 	    val mod = _prim "Word16_mod": word * word -> word;
 	    val * = _prim "Word16_mul": word * word -> word;
@@ -1231,14 +1243,14 @@
 	    val ~ = _prim "Word16_neg": word -> word;
 	    val notb = _prim "Word16_notb": word -> word;
 	    val orb = _prim "Word16_orb": word * word -> word;
-	    val rol = _prim "Word16_rol": word * word32 -> word;
-	    val ror = _prim "Word16_ror": word * word32 -> word;
-	    val >> = _prim "Word16_rshift": word * word32 -> word;
+	    val rol = _prim "Word16_rol": word * Word.word -> word;
+	    val ror = _prim "Word16_ror": word * Word.word -> word;
+	    val >> = _prim "Word16_rshift": word * Word.word -> word;
 	    val - = _prim "Word16_sub": word * word -> word;
 	    val toInt = _prim "Word16_toInt32": word -> int;
 	    val toIntX = _prim "Word16_toInt32X": word -> int;
-	    val toLarge = _prim "Word16_toWord32": word -> word32;
-	    val toLargeX = _prim "Word16_toWord32X": word -> word32;
+	    val toLarge = _import "Word16_toWord64": word -> LargeWord.word;
+	    val toLargeX = _import "Word16_toWord64X": word -> LargeWord.word;
 	    val xorb = _prim "Word16_xorb": word * word -> word;
 	 end
 
@@ -1253,7 +1265,7 @@
 	    val ~>> = _prim "Word32_arshift": word * word -> word;
 	    val div = _prim "Word32_div": word * word -> word;
 	    val fromInt = _prim "Int32_toWord32": int -> word;
-	    val fromLarge : word -> word = fn x => x
+	    val fromLarge = _import "Word64_toWord32": LargeWord.word -> word;
 	    val >= = _prim "Word32_ge": word * word -> bool;
 	    val > = _prim "Word32_gt" : word * word -> bool;
 	    val <= = _prim "Word32_le": word * word -> bool;
@@ -1271,12 +1283,47 @@
 	    val - = _prim "Word32_sub": word * word -> word;
 	    val toInt = _prim "Word32_toInt32": word -> int;
 	    val toIntX = _prim "Word32_toInt32X": word -> int;
-	    val toLarge : word -> word = fn x => x
-	    val toLargeX : word -> word = fn x => x
+	    val toLarge = _import "Word32_toWord64": word -> LargeWord.word;
+	    val toLargeX = _import "Word32_toWord64X": word -> LargeWord.word;
 	    val xorb = _prim "Word32_xorb": word * word -> word;
 	 end
       structure Word = Word32
+      structure Word64 =
+	 struct
+	    open Word64
+	       
+	    val wordSize: int = 64
 
+	    val + = _import "Word64_add": word * word -> word;
+(*	    val addCheck = _import "Word64_addCheck": word * word -> word; *)
+	    val andb = _import "Word64_andb": word * word -> word;
+	    val ~>> = _import "Word64_arshift": word * Word.word -> word;
+	    val div = _import "Word64_div": word * word -> word;
+	    val fromInt = _import "Int32_toWord64": int -> word;
+	    val fromLarge: LargeWord.word -> word = fn x => x
+	    val >= = _import "Word64_ge": word * word -> bool;
+	    val > = _import "Word64_gt" : word * word -> bool;
+	    val <= = _import "Word64_le": word * word -> bool;
+	    val << = _import "Word64_lshift": word * Word.word -> word;
+	    val < = _import "Word64_lt" : word * word -> bool;
+	    val mod = _import "Word64_mod": word * word -> word;
+	    val * = _import "Word64_mul": word * word -> word;
+(*	    val mulCheck = _import "Word64_mulCheck": word * word -> word; *)
+	    val ~ = _import "Word64_neg": word -> word;
+	    val notb = _import "Word64_notb": word -> word;
+	    val orb = _import "Word64_orb": word * word -> word;
+	    val rol = _import "Word64_rol": word * Word.word -> word;
+	    val ror = _import "Word64_ror": word * Word.word -> word;
+	    val >> = _import "Word64_rshift": word * Word.word -> word;
+	    val - = _import "Word64_sub": word * word -> word;
+	    val toInt = _import "Word64_toInt32": word -> int;
+	    val toIntX = _import "Word64_toInt32X": word -> int;
+	    val toLarge: word -> LargeWord.word = fn x => x
+	    val toLargeX: word -> LargeWord.word = fn x => x
+	    val xorb = _import "Word64_xorb": word * word -> word;
+	 end
+      structure LargeWord = Word64
+	 
       structure World =
 	 struct
 	    val isOriginal = _import "World_isOriginal": unit -> bool;



1.18      +1 -0      mlton/bin/check-basis

Index: check-basis
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/check-basis,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- check-basis	19 Jul 2003 01:23:25 -0000	1.17
+++ check-basis	11 Sep 2003 00:51:07 -0000	1.18
@@ -130,6 +130,7 @@
           type word8 = Word8.word
 	  type word16 = Word32.word
           type word32 = Word32.word
+	  type word64 = Word32.word
           type 'a vector = 'a vector
           
           datatype 'a option = T



1.75      +3 -0      mlton/doc/changelog

Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -r1.74 -r1.75
--- changelog	10 Sep 2003 00:16:02 -0000	1.74
+++ changelog	11 Sep 2003 00:51:07 -0000	1.75
@@ -1,5 +1,8 @@
 Here are the changes since version 20030716.
 
+* 2003-09-10
+  - Word64 is now there.
+
 * 2003-09-09
   - Replaced Pack32{Big,Little} with PackWord32{Big,Little}.
   - Fixed bug in OS.FileSys.fullPath, which mistakenly stopped as soon



1.31      +6 -0      mlton/doc/user-guide/basis.tex

Index: basis.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/basis.tex,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- basis.tex	9 Sep 2003 23:38:22 -0000	1.30
+++ basis.tex	11 Sep 2003 00:51:07 -0000	1.31
@@ -328,6 +328,12 @@
 \fullmodule{Word32ArraySlice}{MONO\_ARRAY\_SLICE}
 \fullmodule{Word32Vector}{MONO\_VECTOR}
 \fullmodule{Word32VectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{Word64}{WORD}
+\fullmodule{Word64Array}{MONO\_ARRAY}
+\fullmodule{Word64Array2}{MONO\_ARRAY2}
+\fullmodule{Word64ArraySlice}{MONO\_ARRAY\_SLICE}
+\fullmodule{Word64Vector}{MONO\_VECTOR}
+\fullmodule{Word64VectorSlice}{MONO\_VECTOR\_SLICE}
 
 The following structures equivalences hold.\\
 \begin{tabular}{l}



1.14      +7 -7      mlton/include/c-chunk.h

Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- c-chunk.h	5 Sep 2003 18:47:33 -0000	1.13
+++ c-chunk.h	11 Sep 2003 00:51:07 -0000	1.14
@@ -239,7 +239,7 @@
 #define Word8_max (Word8)0xFF
 #define Word16_max (Word16)0xFFFF
 #define Word32_max (Word32)0xFFFFFFFF
-#define Word64_max (Word64)0xFFFFFFFFFFFFFFFF
+//#define Word64_max (Word64)0xFFFFFFFFFFFFFFFF
 
 #define Int_addCheckXC(size, dst, x, c, l)		\
 	do {						\
@@ -319,16 +319,16 @@
 #define Word8_addCheckXC(dst, x, c, l) Word_addCheckXC(8, dst, x, c, l)
 #define Word16_addCheckXC(dst, x, c, l) Word_addCheckXC(16, dst, x, c, l)
 #define Word32_addCheckXC(dst, x, c, l) Word_addCheckXC(32, dst, x, c, l)
-#define Word64_addCheckXC(dst, x, c, l) Word_addCheckXC(64, dst, x, c, l)
+//#define Word64_addCheckXC(dst, x, c, l) Word_addCheckXC(64, dst, x, c, l)
 #define Word8_addCheckCX(dst, c, x, l) Word_addCheckXC(8, dst, x, c, l)
 #define Word16_addCheckCX(dst, c, x, l) Word_addCheckXC(16, dst, x, c, l)
 #define Word32_addCheckCX(dst, c, x, l) Word_addCheckXC(32, dst, x, c, l)
-#define Word64_addCheckCX(dst, c, x, l) Word_addCheckXC(64, dst, x, c, l)
+//#define Word64_addCheckCX(dst, c, x, l) Word_addCheckXC(64, dst, x, c, l)
 
 #define Word8_addCheck Word8_addCheckXC
 #define Word16_addCheck Word16_addCheckXC
 #define Word32_addCheck Word32_addCheckXC
-#define Word64_addCheck Word64_addCheckXC
+//#define Word64_addCheck Word64_addCheckXC
 
 #define mulOverflow(kind, small, large)						\
 	static inline kind##small kind##small##_##mulOverflow			\
@@ -379,8 +379,8 @@
 	check (dst, n1, n2, l, Word16_mulOverflow)
 #define Word32_mulCheck(dst, n1, n2, l)			\
 	check (dst, n1, n2, l, Word32_mulOverflow)
-#define Word64_mulCheck(dst, n1, n2, l)			\
-	fprintf (stderr, "FIXME: Word64_mulCheck\n");
+//#define Word64_mulCheck(dst, n1, n2, l)			\
+//	fprintf (stderr, "FIXME: Word64_mulCheck\n");
 
 #endif /* INT_TEST */
 
@@ -595,7 +595,7 @@
 wordOps(8)
 wordOps(16)
 wordOps(32)
-wordOps(64)
+//wordOps(64)
 #undef wordBinary wordCmp wordShift wordUnary
 
 #define coerce(f, t)				\



1.8       +2 -2      mlton/mlton/ast/prim-tycons.fun

Index: prim-tycons.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/prim-tycons.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- prim-tycons.fun	10 Sep 2003 01:00:08 -0000	1.7
+++ prim-tycons.fun	11 Sep 2003 00:51:07 -0000	1.8
@@ -88,9 +88,9 @@
 local
    fun is l t = List.exists (l, fn t' => equals (t, t'))
 in
-   val isIntX = is [int8, int16, int32, int64, int8, intInf]
+   val isIntX = is [int8, int16, int32, int64, intInf]
    val isRealX = is [real32, real64]
-   val isWordX = is [word8, word16, word32]
+   val isWordX = is [word8, word16, word32, word64]
 end
 
 end



1.48      +9 -0      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.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- ssa-to-rssa.fun	10 Sep 2003 01:00:10 -0000	1.47
+++ ssa-to-rssa.fun	11 Sep 2003 00:51:07 -0000	1.48
@@ -36,6 +36,7 @@
 	 val Int32 = Int I32
 	 val Int64 = Int I64
 	 val Word32 = Word W32
+	 val Word64 = Word W64
       end
 
       datatype z = datatype CType.t
@@ -128,6 +129,10 @@
 	 val int64Equal = make "Int64_equal"
       end
 
+      val word64Equal = vanilla {args = Vector.new2 (Word64, Word64),
+				 name = "Word64_equal",
+				 return = SOME CType.defaultInt}
+
       val getPointer =
 	 vanilla {args = Vector.new1 Int32,
 		  name = "MLton_FFI_getPointer",
@@ -1365,6 +1370,10 @@
 					       func = CFunction.weakNew}
 				     end,
 				     none)
+			       | Word_equal s =>
+				    if s = WordSize.W64
+				       then simpleCCall CFunction.word64Equal
+				    else normal ()
 			       | Word_toIntInf => cast ()
 			       | WordVector_toIntInf => cast ()
 			       | Word8Array_subWord => sub Type.defaultWord



1.1                  mlton/regression/word-all.ok

Index: word-all.ok
===================================================================
Testing Word8
FF
	11111111
	377
	255
	FF
FE
	11111110
	376
	254
	FE
7F
	1111111
	177
	127
	7F
F
	1111
	17
	15
	F
2
	10
	2
	2
	2
1
	1
	1
	1
	1
0
	0
	0
	0
	0
Testing Word16
FFFF
	1111111111111111
	177777
	65535
	FFFF
FFFE
	1111111111111110
	177776
	65534
	FFFE
7FFF
	111111111111111
	77777
	32767
	7FFF
F
	1111
	17
	15
	F
2
	10
	2
	2
	2
1
	1
	1
	1
	1
0
	0
	0
	0
	0
Testing Word32
FFFFFFFF
	11111111111111111111111111111111
	37777777777
	4294967295
	FFFFFFFF
FFFFFFFE
	11111111111111111111111111111110
	37777777776
	4294967294
	FFFFFFFE
7FFFFFFF
	1111111111111111111111111111111
	17777777777
	2147483647
	7FFFFFFF
F
	1111
	17
	15
	F
2
	10
	2
	2
	2
1
	1
	1
	1
	1
0
	0
	0
	0
	0
Testing Word64
FFFFFFFFFFFFFFFF
	1111111111111111111111111111111111111111111111111111111111111111
	1777777777777777777777
	18446744073709551615
	FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFE
	1111111111111111111111111111111111111111111111111111111111111110
	1777777777777777777776
	18446744073709551614
	FFFFFFFFFFFFFFFE
7FFFFFFFFFFFFFFF
	111111111111111111111111111111111111111111111111111111111111111
	777777777777777777777
	9223372036854775807
	7FFFFFFFFFFFFFFF
F
	1111
	17
	15
	F
2
	10
	2
	2
	2
1
	1
	1
	1
	1
0
	0
	0
	0
	0



1.1                  mlton/regression/word-all.sml

Index: word-all.sml
===================================================================
functor Test (W: WORD) =
struct

structure LW = LargeWord
   
val zero = W.fromInt 0
val one = W.fromInt 1
val two = W.fromInt 2
val max = W.~ one
   
val words =
   [max,
    W.- (max, one),
    W.div (max, two),
    W.fromInt 0xF,
    two,
    one,
    zero]

fun foreach (l, f) = List.app f l
   
fun for (f: W.word -> unit) = foreach (words, f)

structure Answer =
   struct
      datatype t =
	 Div
       | Overflow
       | Word of W.word

      val toString =
	 fn Div => "Div"
	  | Overflow => "Overflow"
	  | Word w => W.toString w

      fun run (f: unit -> W.word): t =
	 Word (f ())
	 handle General.Div => Div
	      | General.Overflow => Overflow

      val equals: t * t -> bool = op =
   end

val m = concat ["Word", Int.toString W.wordSize]
   
val _ = print (concat ["Testing ", m, "\n"])

fun err msg = print (concat [m, ": ", concat msg, "\n"])

val _ = for (fn w =>
	     print (concat [W.toString w, "\n",
			    "\t", W.fmt StringCvt.BIN w, "\n",
			    "\t", W.fmt StringCvt.OCT w, "\n",
			    "\t", W.fmt StringCvt.DEC w, "\n",
			    "\t", W.fmt StringCvt.HEX w, "\n"]))

val _ =
   foreach
   ([("+", W.+, LW.+),
     ("-", W.-, LW.-),
     ("*", W.*, LW.* ),
     ("andb", W.andb, LW.andb),
     ("div", W.div, LW.div),
     ("max", W.max, LW.max),
     ("min", W.min, LW.min),
     ("mod", W.mod, LW.mod),
     ("orb", W.orb, LW.orb),
     ("xorb", W.xorb, LW.xorb)],
    fn (name, f, f') =>
    for
    (fn w =>
     for
     (fn w' =>
      let
	 val a = Answer.run (fn () => f (w, w'))
	 val a' = Answer.run (fn () =>
			      W.fromLarge (f' (W.toLarge w, W.toLarge w')))

      in
	 if Answer.equals (a, a')
	    then ()
	 else err [W.toString w, " ", name, " ", W.toString w',
		   " = ", Answer.toString a, " <> ", Answer.toString a']
      end)))

val _ =
   for (fn w =>
	if w = valOf (W.fromString (W.toString w))
	   then ()
	else err ["{from,to}String"])
   
val _ =
   foreach
   ([("<<", W.<<, LW.<<),
     (">>", W.>>, LW.>>)],
    fn (name, f, f') =>
    for
    (fn w =>
     foreach
     ([0w0, 0w1, 0w2, 0w4, 0w8, 0w15, 0w30, 0wxFF],
      fn w' =>
      let
	 val a = f (w, w')
	 val a' = W.fromLarge (f' (W.toLarge w, w'))
      in
	 if a = a'
	    then ()
	 else err [W.toString w, " ", name, " ", Word.toString w',
		   " = ", W.toString a, " <> ", W.toString a']
      end)))

val _ =
   foreach
   ([("~>>", W.~>>, LW.~>>)],
    fn (name, f, f') =>
    for
    (fn w =>
     foreach
     ([0w0, 0w1, 0w2, 0w4, 0w8, 0w15, 0w30, 0wxFF],
      fn w' =>
      let
	 val a = f (w, w')
	 val a' = W.fromLarge (f' (W.toLargeX w, w'))
      in
	 if a = a'
	    then ()
	 else err [W.toString w, " ", name, " ", Word.toString w',
		   " = ", W.toString a, " <> ", W.toString a']
      end)))

val _ =
   foreach
   ([("<", W.<, LW.<),
     ("<=", W.<=, LW.<=),
     (">", W.>, LW.>),
     (">=", W.>=, LW.>=)],
    fn (name, f, f') =>
    for
    (fn w =>
     for
     (fn w' =>
      let
	 val b = f (w, w')
	 val b' = f' (W.toLarge w, W.toLarge w')
      in
	 if b = b'
	    then ()
	 else err [W.toString w, " ", name, " ", W.toString w',
		   " = ", Bool.toString b, " <> ", Bool.toString b']
      end)))

val _ =
   foreach
   ([("compare", W.compare, LW.compare)],
    fn (name, f, f') =>
    for
    (fn w =>
     for
     (fn w' =>
      let
	 val or = f (w, w')
	 val or' = f' (W.toLarge w, W.toLarge w')
      in
	 if or = or'
	    then ()
	 else err [W.toString w, " ", name, " ", W.toString w']
      end)))

val _ =
   for
   (fn w =>
    if w = W.fromLargeInt (W.toLargeInt w)
       andalso w = W.fromLargeInt (W.toLargeIntX w)
       andalso (case SOME (W.toInt w) handle Overflow => NONE of
		   NONE => true
		 | SOME i => w = W.fromInt i)
       andalso (case SOME (W.toIntX w) handle Overflow => NONE of
		   NONE => true
		 | SOME i => w = W.fromInt i)
       then ()
    else err ["{from,to}Large"])

val _ =
   for (fn w =>
	let
	   val a = W.notb w
	   val a' = W.fromLarge (LW.notb (W.toLarge w))
	in
	   if a = a'
	      then ()
	   else err ["notb ", W.toString w, " = ", W.toString a, " <> ",
		     W.toString a']
	end)

val _ =
   for (fn w =>
	if W.~ w = W.- (0w0, w)
	   then ()
	else err ["~"])

end

structure Z = Test (Word8)
structure Z = Test (Word16)
structure Z = Test (Word32)
structure Z = Test (Word64)




1.74      +2 -0      mlton/runtime/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -r1.73 -r1.74
--- Makefile	29 Aug 2003 00:25:21 -0000	1.73
+++ Makefile	11 Sep 2003 00:51:08 -0000	1.74
@@ -34,6 +34,7 @@
 	basis/Int/Int64.o			\
 	basis/Int/Word8Array.o			\
 	basis/Int/Word8Vector.o			\
+	basis/Int/Word64.o			\
 	basis/Int/addOverflow.o			\
 	basis/Int/mulOverflow.o			\
 	basis/Int/negOverflow.o			\
@@ -201,6 +202,7 @@
 	basis/Int/Int64-gdb.o			\
 	basis/Int/Word8Array-gdb.o		\
 	basis/Int/Word8Vector-gdb.o		\
+	basis/Int/Word64-gdb.o			\
 	basis/Int/addOverflow-gdb.o		\
 	basis/Int/mulOverflow-gdb.o		\
 	basis/Int/negOverflow-gdb.o		\



1.1                  mlton/runtime/basis/Int/Word64.c

Index: Word64.c
===================================================================
#include "libmlton.h"

enum {
	DEBUG = FALSE,
};

#define Word64_max (Word64)0x7FFFFFFFFFFFFFFF
#define Word64_min (Word64)0x8000000000000000

#define coerce(f, t)				\
	t f##_to##t (f x) {			\
		return (t)x;			\
	}
coerce(Int32,Word64)
coerce(Word8,Word64)
coerce(Word16,Word64)
coerce(Word32,Word64)
coerce(Word64,Int32)
coerce(Word64,Word8)
coerce(Word64,Word16)
coerce(Word64,Word32)
#undef coerce

#define coerceX(size, t)				\
	t Word##size##_to##t##X (Word##size w) {	\
		return (t)(Int##size)w;			\
	}
coerceX(8,Word64)
coerceX(16,Word64)
coerceX(32,Word64)
coerceX(64,Int32)
#undef coerceX

#define binary(name, op)				\
	Word64 Word64_##name (Word64 w1, Word64 w2) {	\
		return w1 op w2;			\
	}
binary (add, +)
binary (andb, &)
binary (div, /)
binary (mod, %)
binary (mul, *)
binary (orb, |)
binary (sub, -)
binary (xorb, ^)
#undef binary

#define unary(name, op)				\
	Word64 Word64_##name (Word64 w) {	\
		return op w;			\
	}
unary (neg, -)
unary (notb, ~)
#undef unary

#define compare(name, op)				\
	Bool Word64_##name (Word64 w1, Word64 w2) {	\
		return w1 op w2;			\
	}
compare (equal, ==)
compare (ge, >=)
compare (gt, >)
compare (le, <=)
compare (lt, <)
#undef binary

#define shift(name, op)					\
	Word64 Word64_##name (Word64 w1, Word w2) {	\
		return w1 op w2;			\
	}
shift (lshift, <<)
shift (rshift, >>)
#undef binary

Word64 Word64_arshift (Word64 w, Word s) {
	return (Int64)w >> s;
}

Word64 Word64_rol (Word64 w1, Word w2) {
	return (w1 >> (64 - w2)) | (w1 << w2);
}

Word64 Word64_ror (Word64 w1, Word w2) {
	return (w1 >> w2) | (w1 << (64 - w2));
}




-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel