[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