[MLton-devel] cvs commit: Basis Library and x86 support for Int{8,16,32}, Word{8,16,32}.
Matthew Fluet
fluet@users.sourceforge.net
Wed, 25 Jun 2003 16:15:33 -0700
fluet 03/06/25 16:15:33
Modified: mlton/atoms prim.fun
mlton/codegen/x86-codegen x86-allocate-registers.fun
x86-mlton.fun x86-translate.fun
basis-library/arrays-and-vectors mono-array.sml
mono-array2.sml mono-vector.sml
basis-library/integer int16.sml int32.sml int8.sml
integer.fun patch.sml word.fun word.sig word32.sml
word8.sml
basis-library/libs build
basis-library/libs/basis-2002/top-level basis.sig basis.sml
basis-library/misc primitive.sml
include c-chunk.h
Added: basis-library/integer word16.sml
Log:
Basis library support for Int{8,16,32} and Word{8,16,32}, including
mono-array and mono-vector structures.
Revision Changes Path
1.53 +2 -0 mlton/mlton/atoms/prim.fun
Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- prim.fun 24 Jun 2003 20:14:22 -0000 1.52
+++ prim.fun 25 Jun 2003 23:15:31 -0000 1.53
@@ -886,6 +886,8 @@
| (Int_rem _, [Int i1, Int i2]) => io (IntX.rem, i1, i2)
| (Int_sub _, [Int i1, Int i2]) => io (IntX.-, i1, i2)
| (Int_subCheck _, [Int i1, Int i2]) => io (IntX.-, i1, i2)
+ | (Int_toInt (_, s), [Int i]) =>
+ int (IntX.make (IntX.toIntInf i, s))
| (Int_toWord (_, s), [Int i]) =>
word (WordX.fromLargeInt (IntX.toIntInf i, s))
| (IntInf_compare, [IntInf i1, IntInf i2]) =>
1.29 +1 -1 mlton/mlton/codegen/x86-codegen/x86-allocate-registers.fun
Index: x86-allocate-registers.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-allocate-registers.fun,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- x86-allocate-registers.fun 3 Feb 2003 19:48:33 -0000 1.28
+++ x86-allocate-registers.fun 25 Jun 2003 23:15:31 -0000 1.29
@@ -8498,7 +8498,7 @@
val temp_reg
= case final_src
of Operand.Register r
- => Register.lowPartOf (r, Size.BYTE)
+ => Register.lowPartOf (r, dstsize)
| _
=> Error.bug "allocateRegisters: XVOM, temp_reg"
1.45 +83 -22 mlton/mlton/codegen/x86-codegen/x86-mlton.fun
Index: x86-mlton.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton.fun,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- x86-mlton.fun 23 Jun 2003 04:58:58 -0000 1.44
+++ x86-mlton.fun 25 Jun 2003 23:15:31 -0000 1.45
@@ -603,12 +603,29 @@
| Int_gt _ => cmp Instruction.G
| Int_le _ => cmp Instruction.LE
| Int_lt _ => cmp Instruction.L
- | Int_mul _ => imul2 ()
+ | Int_mul s =>
+ (case s of
+ I8 => pmd Instruction.IMUL
+ | I16 => imul2 ()
+ | I32 => imul2 ()
+ | I64 => Error.bug "FIXME")
| Int_neg _ => unal Instruction.NEG
| Int_quot _ => pmd Instruction.IDIV
| Int_rem _ => pmd Instruction.IMOD
| Int_sub _ => binal Instruction.SUB
| Int_add _ => binal Instruction.ADD
+ | Int_toInt (s, s') =>
+ (case (s, s') of
+ (I32, I32) => mov ()
+ | (I32, I16) => xvom ()
+ | (I32, I8) => xvom ()
+ | (I16, I32) => movx Instruction.MOVSX
+ | (I16, I16) => mov ()
+ | (I16, I8) => xvom ()
+ | (I8, I32) => movx Instruction.MOVSX
+ | (I8, I16) => movx Instruction.MOVSX
+ | (I8, I8) => mov ()
+ | _ => Error.bug (Prim.toString prim))
| Int_toReal _
=> let
val (dst,dstsize) = getDst ()
@@ -626,10 +643,17 @@
transfer = NONE}]
end
| Int_toWord (s, s') =>
- (case (s, s') of
- (I32, W8) => xvom ()
- | (I32, W32) => mov ()
- | _ => Error.bug (Prim.toString prim))
+ (case (s, s') of
+ (I32, W32) => mov ()
+ | (I32, W16) => xvom ()
+ | (I32, W8) => xvom ()
+ | (I16, W32) => movx Instruction.MOVSX
+ | (I16, W16) => mov ()
+ | (I16, W8) => xvom ()
+ | (I8, W32) => movx Instruction.MOVSX
+ | (I8, W16) => movx Instruction.MOVSX
+ | (I8, W8) => mov ()
+ | _ => Error.bug (Prim.toString prim))
| MLton_eq => cmp Instruction.E
| Real_Math_acos _
=> let
@@ -1126,7 +1150,7 @@
| Word_mul s =>
(case s of
W8 => pmd Instruction.MUL
- | W16 => Error.bug "FIXME"
+ | W16 => imul2 ()
| W32 => imul2 ())
| Word_neg _ => unal Instruction.NEG
| Word_notb _ => unal Instruction.NOT
@@ -1136,23 +1160,51 @@
| Word_rshift _ => sral Instruction.SHR
| Word_sub _ => binal Instruction.SUB
| Word_toInt (s, s') =>
- (case (s, s') of
- (W8, I32) => movx Instruction.MOVZX
- | _ => Error.bug (Prim.toString prim))
+ (case (s, s') of
+ (W32, I32) => mov ()
+ | (W32, I16) => xvom ()
+ | (W32, I8) => xvom ()
+ | (W16, I32) => movx Instruction.MOVZX
+ | (W16, I16) => mov ()
+ | (W16, I8) => xvom ()
+ | (W8, I32) => movx Instruction.MOVZX
+ | (W8, I16) => movx Instruction.MOVZX
+ | (W8, I8) => mov ()
+ | _ => Error.bug (Prim.toString prim))
| Word_toIntX (s, s') =>
- (case (s, s') of
- (W8, I32) => movx Instruction.MOVSX
- | (W32, I32) => mov ()
- | _ => Error.bug (Prim.toString prim))
+ (case (s, s') of
+ (W32, I32) => mov ()
+ | (W32, I16) => xvom ()
+ | (W32, I8) => xvom ()
+ | (W16, I32) => movx Instruction.MOVSX
+ | (W16, I16) => mov ()
+ | (W16, I8) => xvom ()
+ | (W8, I32) => movx Instruction.MOVSX
+ | (W8, I16) => movx Instruction.MOVSX
+ | (W8, I8) => mov ()
+ | _ => Error.bug (Prim.toString prim))
| Word_toWord (s, s') =>
- (case (s, s') of
- (W8, W32) => movx Instruction.MOVZX
- | (W32, W8) => xvom ()
- | _ => Error.bug (Prim.toString prim))
+ (case (s, s') of
+ (W32, W32) => mov ()
+ | (W32, W16) => xvom ()
+ | (W32, W8) => xvom ()
+ | (W16, W32) => movx Instruction.MOVZX
+ | (W16, W16) => mov ()
+ | (W16, W8) => xvom ()
+ | (W8, W32) => movx Instruction.MOVZX
+ | (W8, W16) => movx Instruction.MOVZX
+ | (W8, W8) => mov ())
| Word_toWordX (s, s') =>
- (case (s, s') of
- (W8, W32) => movx Instruction.MOVSX
- | _ => Error.bug (Prim.toString prim))
+ (case (s, s') of
+ (W32, W32) => mov ()
+ | (W32, W16) => xvom ()
+ | (W32, W8) => xvom ()
+ | (W16, W32) => movx Instruction.MOVSX
+ | (W16, W16) => mov ()
+ | (W16, W8) => xvom ()
+ | (W8, W32) => movx Instruction.MOVSX
+ | (W8, W16) => movx Instruction.MOVSX
+ | (W8, W8) => mov ())
| Word_xorb _ => binal Instruction.XOR
| _ => Error.bug ("prim: strange Prim.Name.t: " ^ primName)),
comment_end]
@@ -1384,10 +1436,19 @@
(case Prim.name prim of
Int_addCheck _ => binal (x86.Instruction.ADD, x86.Instruction.O)
| Int_subCheck _ => binal (x86.Instruction.SUB, x86.Instruction.O)
- | Int_mulCheck _ => imul2_check x86.Instruction.O
+ | Int_mulCheck s =>
+ (case s of
+ I8 => pmd (x86.Instruction.IMUL, x86.Instruction.O)
+ | I16 => imul2_check x86.Instruction.O
+ | I32 => imul2_check x86.Instruction.O
+ | I64 => Error.bug "FIXME")
| Int_negCheck _ => unal (x86.Instruction.NEG, x86.Instruction.O)
| Word_addCheck _ => binal (x86.Instruction.ADD, x86.Instruction.C)
- | Word_mulCheck _ => pmd (x86.Instruction.MUL, x86.Instruction.C)
+ | Word_mulCheck s =>
+ (case 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))
| _ => Error.bug ("arith: strange Prim.Name.t: " ^ primName))]
end
1.44 +14 -37 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.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- x86-translate.fun 23 Jun 2003 04:58:58 -0000 1.43
+++ x86-translate.fun 25 Jun 2003 23:15:31 -0000 1.44
@@ -141,9 +141,7 @@
let
val i' = IntX.toIntInf i
in
- case IntX.size i of
- I32 => x86.Operand.immediate_const_int (IntInf.toInt i')
- | _ => Error.bug "FIXME"
+ x86.Operand.immediate_const_int (IntInf.toInt i')
end
| Label l => x86.Operand.immediate_label l
| Line => x86MLton.fileLine ()
@@ -205,12 +203,7 @@
let
val w' = WordX.toWord w
in
- case WordX.size w of
- W8 =>
- x86.Operand.immediate_const_char
- (Word8.toChar (Word8.fromWord w'))
- | W16 => Error.bug "FIXME"
- | W32 => x86.Operand.immediate_const_word w'
+ x86.Operand.immediate_const_word w'
end
val toX86Operand =
@@ -732,15 +725,12 @@
falsee = pointers})}))
end
| Int {cases, default, size, test} =>
- (case size of
- I32 =>
- simple ({cases = (Vector.map
- (cases, fn (i, l) =>
- (IntX.toInt i, l))),
- default = default,
- test = test},
- doSwitchInt)
- | _ => Error.bug "FIXME")
+ simple ({cases = (Vector.map
+ (cases, fn (i, l) =>
+ (IntX.toInt i, l))),
+ default = default,
+ test = test},
+ doSwitchInt)
| Pointer {cases, default, tag, ...} =>
simple ({cases = (Vector.map
(cases, fn {dst, tag, ...} =>
@@ -749,25 +739,12 @@
test = tag},
doSwitchInt)
| Word {cases, default, size, test} =>
- (case size of
- W8 =>
- simple ({cases = (Vector.map
- (cases, fn (w, l) =>
- (Word8.toChar
- (Word8.fromWord
- (WordX.toWord w)),
- l))),
- default = default,
- test = test},
- doSwitchChar)
- | W32 =>
- simple ({cases = (Vector.map
- (cases, fn (w, l) =>
- (WordX.toWord w, l))),
- default = default,
- test = test},
- doSwitchWord)
- | _ => Error.bug "FIXME")
+ simple ({cases = (Vector.map
+ (cases, fn (w, l) =>
+ (WordX.toWord w, l))),
+ default = default,
+ test = test},
+ doSwitchWord)
end
| Goto label
=> (AppendList.append
1.4 +22 -4 mlton/basis-library/arrays-and-vectors/mono-array.sml
Index: mono-array.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-array.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mono-array.sml 24 Nov 2002 01:19:35 -0000 1.3
+++ mono-array.sml 25 Jun 2003 23:15:32 -0000 1.4
@@ -5,28 +5,46 @@
* MLton is released under the GNU General Public License (GPL).
* Please see the file MLton-LICENSE for license information.
*)
-structure Word8Array = MonoArray (type elem = Word8.word
- structure V = Word8Vector)
-structure Word8ArraySlice = Word8Array.MonoArraySlice
+
+(* Char *)
structure CharArray = MonoArray(type elem = char
structure V = CharVector)
structure CharArraySlice = CharArray.MonoArraySlice
+(* Bool *)
structure BoolArray = MonoArray (type elem = bool
structure V = BoolVector)
structure BoolArraySlice = BoolArray.MonoArraySlice
+
+(* Int *)
structure IntArray = MonoArray (type elem = int
structure V = IntVector)
structure IntArraySlice = IntArray.MonoArraySlice
structure Int32Array = IntArray
-structure Int32ArraySlice = Int32Array.MonoArraySlice
+structure Int32ArraySlice = IntArraySlice
+structure Int16Array = MonoArray (type elem = Int16.int
+ structure V = Int16Vector)
+structure Int16ArraySlice = Int16Array.MonoArraySlice
+structure Int8Array = MonoArray (type elem = Int8.int
+ structure V = Int8Vector)
+structure Int8ArraySlice = Int8Array.MonoArraySlice
+
+(* Real *)
structure RealArray = MonoArray (type elem = real
structure V = RealVector)
structure RealArraySlice = RealArray.MonoArraySlice
structure Real64Array = RealArray
structure Real64ArraySlice = Real64Array.MonoArraySlice
+
+(* Word *)
structure WordArray = MonoArray (type elem = word
structure V = WordVector)
structure WordArraySlice = WordArray.MonoArraySlice
structure Word32Array = WordArray
structure Word32ArraySlice = Word32Array.MonoArraySlice
+structure Word16Array = MonoArray (type elem = Word16.word
+ structure V = Word16Vector)
+structure Word16ArraySlice = Word16Array.MonoArraySlice
+structure Word8Array = MonoArray (type elem = Word8.word
+ structure V = Word8Vector)
+structure Word8ArraySlice = Word8Array.MonoArraySlice
1.4 +19 -3 mlton/basis-library/arrays-and-vectors/mono-array2.sml
Index: mono-array2.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-array2.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- mono-array2.sml 24 Nov 2002 01:19:35 -0000 1.3
+++ mono-array2.sml 25 Jun 2003 23:15:32 -0000 1.4
@@ -5,18 +5,34 @@
* MLton is released under the GNU General Public License (GPL).
* Please see the file MLton-LICENSE for license information.
*)
-structure BoolArray2 = MonoArray2 (type elem = bool
- structure V = BoolVector)
+
+(* Char *)
structure CharArray2 = MonoArray2 (type elem = char
structure V = CharVector)
+
+(* Bool *)
+structure BoolArray2 = MonoArray2 (type elem = bool
+ structure V = BoolVector)
+
+(* Int *)
structure IntArray2 = MonoArray2 (type elem = int
structure V = IntVector)
structure Int32Array2 = IntArray2
+structure Int16Array2 = MonoArray2 (type elem = Int16.int
+ structure V = IntVector)
+structure Int8Array2 = MonoArray2 (type elem = Int8.int
+ structure V = IntVector)
+
+(* Real *)
structure RealArray2 = MonoArray2 (type elem = real
structure V = RealVector)
structure Real64Array2 = RealArray2
+
+(* Word *)
structure WordArray2 = MonoArray2 (type elem = word
structure V = WordVector)
+structure Word32Array2 = WordArray2
+structure Word16Array2 = MonoArray2 (type elem = Word16.word
+ structure V = Word16Vector)
structure Word8Array2 = MonoArray2 (type elem = Word8.word
structure V = Word8Vector)
-structure Word32Array2 = WordArray2
1.5 +18 -4 mlton/basis-library/arrays-and-vectors/mono-vector.sml
Index: mono-vector.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-vector.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- mono-vector.sml 7 Feb 2003 22:20:49 -0000 1.4
+++ mono-vector.sml 25 Jun 2003 23:15:32 -0000 1.5
@@ -5,25 +5,39 @@
* MLton is released under the GNU General Public License (GPL).
* Please see the file MLton-LICENSE for license information.
*)
-structure Word8Vector = EqtypeMonoVector(type elem = Word8.word)
-structure Word8VectorSlice = Word8Vector.MonoVectorSlice
+
+(* Char *)
(* Moved to text/string0.sml
structure CharVector = MonoVector(type elem = char)
structure CharVectorSlice = CharVector.MonoVectorSlice
*)
-structure CharVector = EqtypeMonoVector(type elem = char)
-structure CharVectorSlice = CharVector.MonoVectorSlice
+
+(* Bool *)
structure BoolVector = EqtypeMonoVector(type elem = bool)
structure BoolVectorSlice = BoolVector.MonoVectorSlice
+
+(* Int *)
structure IntVector = EqtypeMonoVector(type elem = int)
structure IntVectorSlice = IntVector.MonoVectorSlice
structure Int32Vector = IntVector
structure Int32VectorSlice = Int32Vector.MonoVectorSlice
+structure Int16Vector = EqtypeMonoVector(type elem = Int16.int)
+structure Int16VectorSlice = Int16Vector.MonoVectorSlice
+structure Int8Vector = EqtypeMonoVector(type elem = Int8.int)
+structure Int8VectorSlice = Int8Vector.MonoVectorSlice
+
+(* Real *)
structure RealVector = MonoVector(type elem = real)
structure RealVectorSlice = RealVector.MonoVectorSlice
structure Real64Vector = RealVector
structure Real64VectorSlice = Real64Vector.MonoVectorSlice
+
+(* Word *)
structure WordVector = EqtypeMonoVector(type elem = word)
structure WordVectorSlice = WordVector.MonoVectorSlice
structure Word32Vector = WordVector
structure Word32VectorSlice = Word32Vector.MonoVectorSlice
+structure Word16Vector = EqtypeMonoVector(type elem = Word16.word)
+structure Word16VectorSlice = Word16Vector.MonoVectorSlice
+structure Word8Vector = EqtypeMonoVector(type elem = Word8.word)
+structure Word8VectorSlice = Word8Vector.MonoVectorSlice
1.2 +0 -3 mlton/basis-library/integer/int16.sml
Index: int16.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int16.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- int16.sml 24 Jun 2003 17:35:52 -0000 1.1
+++ int16.sml 25 Jun 2003 23:15:32 -0000 1.2
@@ -9,9 +9,6 @@
Integer
(structure P = Primitive.Int16
open P
- val precision' : Int.int = 16
- val maxInt' : int = 0x7fff
- val minInt' : int = ~0x8000
)
1.6 +2 -174 mlton/basis-library/integer/int32.sml
Index: int32.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int32.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- int32.sml 24 Jun 2003 17:35:52 -0000 1.5
+++ int32.sml 25 Jun 2003 23:15:32 -0000 1.6
@@ -5,182 +5,10 @@
* MLton is released under the GNU General Public License (GPL).
* Please see the file MLton-LICENSE for license information.
*)
-(*
-structure Int32: INTEGER_EXTRA =
- struct
- structure Int = Primitive.Int
- open Int
-
- val precision: int option = SOME 32
-
- val maxInt: int option = SOME 0x7fffffff
- val minInt: int option = SOME ~0x80000000
- local fun ident x = x
- in val toInt = ident
- val fromInt = ident
- end
- (* These are overriden in patch.sml after int-inf.sml has been defined. *)
- val toLarge: int -> LargeInt.int = fn _ => raise Fail "toLarge"
- val fromLarge: LargeInt.int -> int = fn _ => raise Fail "fromLarge"
-
- val maxInt' = valOf maxInt
- val minInt' = valOf minInt
-
- val detectOverflow = Primitive.detectOverflow
-
- fun quot (x, y) =
- if y = 0
- then raise Div
- else if detectOverflow andalso x = minInt' andalso y = ~1
- then raise Overflow
- else Int.quot (x, y)
-
- fun rem (x, y) =
- if y = 0
- then raise Div
- else if x = minInt' andalso y = ~1
- then 0
- else Int.rem (x, y)
-
- fun x div y =
- if x >= 0
- then if y > 0
- then Int.quot (x, y)
- else if y < 0
- then if x = 0
- then 0
- else Int.quot (x - 1, y) -? 1
- else raise Div
- else if y < 0
- then if detectOverflow andalso x = minInt' andalso y = ~1
- then raise Overflow
- else Int.quot (x, y)
- else if y > 0
- then Int.quot (x + 1, y) -? 1
- else raise Div
-
- fun x mod y =
- if x >= 0
- then if y > 0
- then Int.rem (x, y)
- else if y < 0
- then if x = 0
- then 0
- else Int.rem (x - 1, y) +? (y + 1)
- else raise Div
- else if y < 0
- then if x = minInt' andalso y = ~1
- then 0
- else Int.rem (x, y)
- else if y > 0
- then Int.rem (x + 1, y) +? (y - 1)
- else raise Div
-
- val sign: int -> int =
- fn 0 => 0
- | i => if i < 0 then ~1 else 1
-
- fun sameSign (x, y) = sign x = sign y
-
- fun abs (x: int) = if x < 0 then ~ x else x
-
- val {compare, min, max} = Util.makeCompare (op <)
-
- fun fmt radix (n: int): string =
- let
- val radix = fromInt (StringCvt.radixToInt radix)
- fun loop (q, chars) =
- let
- val chars =
- StringCvt.digitToChar (toInt (~? (rem (q, radix)))) :: chars
- val q = quot (q, radix)
- in if q = 0
- then String0.implode (if n < 0 then #"~" :: chars
- else chars)
- else loop (q, chars)
- end
- in loop (if n < 0 then n else ~? n, [])
- end
-
- val toString = fmt StringCvt.DEC
-
- fun scan radix reader state =
- let
- (* Works with the negative of the number so that minInt can
- * be scanned.
- *)
- val state = StringCvt.skipWS reader state
- val charToDigit = fromInt (StringCvt.charToDigit radix)
- val radixInt = fromInt (StringCvt.radixToInt radix)
- fun finishNum (state, n) =
- case reader state of
- NONE => SOME (n, state)
- | SOME (c, state') =>
- case charToDigit c of
- NONE => SOME (n, state)
- | SOME n' => finishNum (state', n * radixInt - n')
- fun num state =
- case (reader state, radix) of
- (NONE, _) => NONE
- | (SOME (#"0", state), StringCvt.HEX) =>
- (case reader state of
- NONE => SOME (0, state)
- | SOME (c, state') =>
- let
- fun rest () =
- case reader state' of
- NONE => SOME (0, state)
- | SOME (c, state') =>
- case charToDigit c of
- NONE => SOME (0, state)
- | SOME n => finishNum (state', ~? n)
- in case c of
- #"x" => rest ()
- | #"X" => rest ()
- | _ => (case charToDigit c of
- NONE => SOME (0, state)
- | SOME n => finishNum (state', ~? n))
- end)
- | (SOME (c, state), _) =>
- (case charToDigit c of
- NONE => NONE
- | SOME n => finishNum (state, ~? n))
- fun negate state =
- case num state of
- NONE => NONE
- | SOME (n, s) => SOME (~ n, s)
- in case reader state of
- NONE => NONE
- | SOME (c, state') =>
- case c of
- #"~" => num state'
- | #"-" => num state'
- | #"+" => negate state'
- | _ => negate state
- end
-
- val fromString = fromInt o (StringCvt.scanString (scan StringCvt.DEC))
-
- fun power {base, exp} =
- if Primitive.safe andalso exp < 0
- then raise Fail "Int.power"
- else let
- fun loop (exp, accum) =
- if exp <= 0
- then accum
- else loop (exp - 1, base * accum)
- in loop (exp, 1)
- end
- end
-*)
-
structure Int32 : INTEGER_EXTRA =
- Integer
- (structure P = Primitive.Int32
+ Integer
+ (structure P = Primitive.Int32
open P
- val precision' : Int.int = 32
- val maxInt' : int = 0x7fffffff
- val minInt' : int = ~0x80000000
)
structure Int = Int32
structure IntGlobal: INTEGER_GLOBAL = Int
1.2 +0 -3 mlton/basis-library/integer/int8.sml
Index: int8.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int8.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- int8.sml 24 Jun 2003 17:35:52 -0000 1.1
+++ int8.sml 25 Jun 2003 23:15:32 -0000 1.2
@@ -9,9 +9,6 @@
Integer
(structure P = Primitive.Int8
open P
- val precision' : Int.int = 8
- val maxInt' : int = 0x7f
- val minInt' : int = ~0x80
)
1.3 +21 -9 mlton/basis-library/integer/integer.fun
Index: integer.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/integer.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- integer.fun 25 Jun 2003 21:22:53 -0000 1.2
+++ integer.fun 25 Jun 2003 23:15:32 -0000 1.3
@@ -11,28 +11,40 @@
struct
open I
+structure PI = Primitive.Int
val detectOverflow = Primitive.detectOverflow
-fun fromInt (i: Int.int): int =
- if not detectOverflow
- orelse (Primitive.Int.<= (toInt minInt', i)
- andalso Primitive.Int.<= (i, toInt maxInt'))
- then I.fromInt i
- else raise Overflow
+val (toInt, fromInt) =
+ if detectOverflow andalso
+ precision' <> PI.precision'
+ then if PI.<(precision', PI.precision')
+ then (I.toInt,
+ fn i =>
+ if (PI.<= (I.toInt minInt', i)
+ andalso PI.<= (i, I.toInt maxInt'))
+ then I.fromInt i
+ else raise Overflow)
+ else (fn i =>
+ if (I.<= (I.fromInt PI.minInt', i)
+ andalso I.<= (i, I.fromInt PI.maxInt'))
+ then I.toInt i
+ else raise Overflow,
+ I.fromInt)
+ else (I.toInt, I.fromInt)
val precision: Int.int option = SOME precision'
val maxInt: int option = SOME maxInt'
val minInt: int option = SOME minInt'
+val one: int = fromInt 1
+val zero: int = fromInt 0
+
(* These are overriden in patch.sml after int-inf.sml has been defined. *)
val toLarge: int -> LargeInt.int = fn _ => raise Fail "toLarge"
val fromLarge: LargeInt.int -> int = fn _ => raise Fail "fromLarge"
-val zero: int = fromInt 0
-val one: int = fromInt 1
-
fun quot (x, y) =
if y = zero
then raise Div
1.5 +22 -9 mlton/basis-library/integer/patch.sml
Index: patch.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/patch.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- patch.sml 24 Jun 2003 17:35:52 -0000 1.4
+++ patch.sml 25 Jun 2003 23:15:32 -0000 1.5
@@ -15,24 +15,26 @@
val fromLarge = IntInf.toInt
val toLarge = IntInf.fromInt
end
-structure Int = Int32
-structure Position = Int
-structure FixedInt = Int
structure Int16: INTEGER_EXTRA =
struct
open Int16
- val fromLarge = fromInt o Int.fromLarge
- val toLarge = Int.toLarge o toInt
+ val fromLarge = fromInt o Int32fromLarge
+ val toLarge = Int32toLarge o toInt
end
structure Int8: INTEGER_EXTRA =
struct
open Int8
- val fromLarge = fromInt o Int.fromLarge
- val toLarge = Int.toLarge o toInt
+ val fromLarge = fromInt o Int32fromLarge
+ val toLarge = Int32toLarge o toInt
end
+structure Int = Int32
+structure Position = Int
+structure FixedInt = Int
+
+
structure Word8: WORD_EXTRA =
struct
open Word8
@@ -40,8 +42,19 @@
val toLargeIntX = IntInf.fromInt o toIntX
val toLargeInt = IntInf.fromInt o toInt
- fun fromLargeInt (i: IntInf.int): word =
- fromInt (IntInf.toInt (IntInf.mod (i, 256)))
+ fun fromLargeInt (i: IntInf.int): word =
+ fromInt (IntInf.toInt (IntInf.mod (i, 256)))
+ end
+
+structure Word16: WORD_EXTRA =
+ struct
+ open Word16
+
+ val toLargeIntX = IntInf.fromInt o toIntX
+ val toLargeInt = IntInf.fromInt o toInt
+
+ fun fromLargeInt (i: IntInf.int): word =
+ fromInt (IntInf.toInt (IntInf.mod (i, 65536)))
end
structure Word32: WORD32_EXTRA =
1.4 +54 -3 mlton/basis-library/integer/word.fun
Index: word.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word.fun 25 Apr 2002 19:28:18 -0000 1.3
+++ word.fun 25 Jun 2003 23:15:32 -0000 1.4
@@ -6,12 +6,46 @@
* Please see the file MLton-LICENSE for license information.
*)
functor Word (W: sig
- include PRE_WORD
- val zero: word
- end) =
+ include PRE_WORD_EXTRA
+ end) : WORD_EXTRA =
struct
open W
+structure PW = Primitive.Word
+
+val detectOverflow = Primitive.detectOverflow
+
+(* These are overriden in patch.sml after int-inf.sml has been defined. *)
+val toLargeInt: word -> LargeInt.int = fn _ => raise Fail "toLargeInt"
+val toLargeIntX: word -> LargeInt.int = fn _ => raise Fail "toLargeIntX"
+val fromLargeInt: LargeInt.int -> word = fn _ => raise Fail "fromLargeInt"
+
+val wordSizeWord: Word.word = PW.fromInt wordSize
+val wordSizeMinusOneWord: Word.word = PW.fromInt (Int.-?(wordSize, 1))
+val zero: word = fromInt 0
+val one: word = fromInt 1
+val highBit: word = <<(one, wordSizeMinusOneWord)
+val allOnes: word = ~>>(highBit, wordSizeMinusOneWord)
+
+val (toInt,toIntX) =
+ if detectOverflow andalso
+ Int.>=(wordSize, Int.precision')
+ then let
+ val max: word = fromInt (Int.maxInt')
+ val shift: Word.word = PW.fromInt (Int.-?(Int.precision', 1))
+ in
+ (fn w => if w > max
+ then raise Overflow
+ else W.toInt w,
+ fn w => let
+ val w' = ~>>(w, shift)
+ in
+ if (w' = zero) orelse (w' = allOnes)
+ then W.toIntX w
+ else raise Overflow
+ end)
+ end
+ else (W.toInt, W.toIntX)
local
fun make f (w, w') =
@@ -21,6 +55,23 @@
in val op div = make (op div)
val op mod = make (op mod)
end
+
+fun << (i, n)
+ = if PW.>=(n ,wordSizeWord)
+ then zero
+ else W.<<(i, n)
+
+fun >> (i, n)
+ = if PW.>=(n, wordSizeWord)
+ then zero
+ else W.>>(i, n)
+
+fun ~>> (i, n)
+ = if PW.<(n, wordSizeWord)
+ then W.~>>(i, n)
+ else W.~>>(i, wordSizeMinusOneWord)
+
+val {compare, min, max} = Util.makeCompare(op <)
fun fmt radix (w: word): string =
let val radix = fromInt (StringCvt.radixToInt radix)
1.5 +8 -3 mlton/basis-library/integer/word.sig
Index: word.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- word.sig 24 Nov 2002 01:19:35 -0000 1.4
+++ word.sig 25 Jun 2003 23:15:32 -0000 1.5
@@ -37,19 +37,23 @@
val div: word * word -> word
val mod: word * word -> word
val ~ : word -> word
- val compare: word * word -> order
val < : word * word -> bool
val > : word * word -> bool
val >= : word * word -> bool
val <= : word * word -> bool
- val min: word * word -> word
- val max: word * word -> word
+ end
+signature PRE_WORD_EXTRA =
+ sig
+ include PRE_WORD
end
signature WORD =
sig
include PRE_WORD
+ val compare: word * word -> order
+ val min: word * word -> word
+ val max: word * word -> word
val toLargeInt: word -> LargeInt.int
val toLargeIntX: word -> LargeInt.int
val fromLargeInt: LargeInt.int -> word
@@ -64,6 +68,7 @@
signature WORD_EXTRA =
sig
include WORD
+ (* include PRE_WORD_EXTRA *)
end
signature WORD32_EXTRA =
1.4 +2 -45 mlton/basis-library/integer/word32.sml
Index: word32.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word32.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word32.sml 25 Apr 2002 19:28:18 -0000 1.3
+++ word32.sml 25 Jun 2003 23:15:32 -0000 1.4
@@ -9,50 +9,7 @@
Word
(structure P = Primitive.Word32
open P
-
- val wordSize: int = 32
- val wordSizeWord: word = 0w32
- val zero: word = 0w0
-
- local
- fun id x = x
- in
- val toLargeWord = id
- val toLargeWordX = id
- val fromLargeWord = id
- end
-
- fun highBitSet w = Int.<(toIntX w, 0)
-
- (* This assumes that Words and Ints have the same number of bits.
- * toInt w is supposed to treat w as unsigned. Thus, if the high bit is
- * set in w, it will be unrepresentable as a twos-complement integer with
- * the same number of bits.
- *)
- fun toInt w =
- if Primitive.safe andalso highBitSet w
- then raise Overflow
- else toIntX w
-
- val {compare, min, max} = Util.makeCompare(op <)
-
- fun << (i, n)
- = if n >= wordSizeWord
- then zero
- else P.<<(i, n)
-
- fun >> (i, n)
- = if n >= wordSizeWord
- then zero
- else P.>>(i, n)
-
- fun ~>> (i, n)
- = if n < wordSizeWord
- then P.~>>(i, n)
- else P.~>>(i, wordSizeWord - 0w1)
- )
-
+ )
+structure Word = Word32
structure WordGlobal: WORD_GLOBAL = Word
open WordGlobal
-
-
1.4 +1 -25 mlton/basis-library/integer/word8.sml
Index: word8.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word8.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word8.sml 25 Apr 2002 19:28:18 -0000 1.3
+++ word8.sml 25 Jun 2003 23:15:32 -0000 1.4
@@ -9,30 +9,6 @@
Word
(structure P = Primitive.Word8
open P
-
- val wordSize: int = 8
- val wordSizeWord : Primitive.Word32.word = 0w8
-
- val highBit: word = 0wx80
- val allOnes: word = 0wxFF
- val zero: word = 0w0
-
- val {compare, min, max} = Util.makeCompare(op <)
-
- fun << (i, n)
- = if Primitive.Word32.>=(n ,wordSizeWord)
- then zero
- else P.<<(i, n)
-
- fun >> (i, n)
- = if Primitive.Word32.>=(n, wordSizeWord)
- then zero
- else P.>>(i, n)
-
- fun ~>> (i, n)
- = if Primitive.Word32.<(n, wordSizeWord)
- then P.~>>(i, n)
- else P.~>>(i, Primitive.Word32.-(wordSizeWord, 0w1))
- )
+ )
1.1 mlton/basis-library/integer/word16.sml
Index: word16.sml
===================================================================
(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-1999 NEC Research Institute.
*
* MLton is released under the GNU General Public License (GPL).
* Please see the file MLton-LICENSE for license information.
*)
structure Word16 =
Word
(structure P = Primitive.Word16
open P
)
1.18 +2 -1 mlton/basis-library/libs/build
Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- build 24 Jun 2003 20:48:01 -0000 1.17
+++ build 25 Jun 2003 23:15:32 -0000 1.18
@@ -58,8 +58,9 @@
misc/C.sml
integer/word.sig
integer/word.fun
-integer/word32.sml
integer/word8.sml
+integer/word16.sml
+integer/word32.sml
integer/int-inf.sig
integer/int-inf.sml
real/IEEE-real.sig
1.7 +66 -1 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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- basis.sig 24 Jun 2003 17:35:52 -0000 1.6
+++ basis.sig 25 Jun 2003 23:15:32 -0000 1.7
@@ -119,13 +119,13 @@
structure Timer : TIMER
structure VectorSlice : VECTOR_SLICE
structure Vector : VECTOR
+ structure Word : WORD
structure Word8 : WORD
structure Word8Array : MONO_ARRAY
structure Word8ArraySlice : MONO_ARRAY_SLICE
structure Word8Vector : MONO_VECTOR
structure Word8VectorSlice : MONO_VECTOR_SLICE
structure Word8Array2 : MONO_ARRAY2
- structure Word : WORD
(* Optional structures *)
structure Array2 : ARRAY2
@@ -144,7 +144,17 @@
structure IntVectorSlice : MONO_VECTOR_SLICE
structure IntArray2 : MONO_ARRAY2
structure Int8 : INTEGER
+ structure Int8Array : MONO_ARRAY
+ structure Int8ArraySlice : MONO_ARRAY_SLICE
+ structure Int8Vector : MONO_VECTOR
+ structure Int8VectorSlice : MONO_VECTOR_SLICE
+ structure Int8Array2 : MONO_ARRAY2
structure Int16 : INTEGER
+ structure Int16Array : MONO_ARRAY
+ structure Int16ArraySlice : MONO_ARRAY_SLICE
+ structure Int16Vector : MONO_VECTOR
+ structure Int16VectorSlice : MONO_VECTOR_SLICE
+ structure Int16Array2 : MONO_ARRAY2
structure Int32 : INTEGER
structure Int32Array : MONO_ARRAY
structure Int32ArraySlice : MONO_ARRAY_SLICE
@@ -196,6 +206,17 @@
(*
structure Windows : WINDOWS
*)
+ structure WordArray : MONO_ARRAY
+ structure WordArraySlice : MONO_ARRAY_SLICE
+ structure WordVector : MONO_VECTOR
+ structure WordVectorSlice : MONO_VECTOR_SLICE
+ structure WordArray2 : MONO_ARRAY2
+ structure Word16 : WORD
+ structure Word16Array : MONO_ARRAY
+ structure Word16ArraySlice : MONO_ARRAY_SLICE
+ structure Word16Vector : MONO_VECTOR
+ structure Word16VectorSlice : MONO_VECTOR_SLICE
+ structure Word16Array2 : MONO_ARRAY2
structure Word32 : WORD
structure Word32Array : MONO_ARRAY
structure Word32ArraySlice : MONO_ARRAY_SLICE
@@ -299,6 +320,28 @@
sharing type IntVectorSlice.vector = IntVector.vector
sharing type IntArray2.elem = int
sharing type IntArray2.vector = IntVector.vector
+ sharing type Int8Array.elem = Int8.int
+ sharing type Int8Array.vector = Int8Vector.vector
+ sharing type Int8ArraySlice.elem = Int8.int
+ sharing type Int8ArraySlice.array = Int8Array.array
+ sharing type Int8ArraySlice.vector = Int8Vector.vector
+ sharing type Int8ArraySlice.vector_slice = Int8VectorSlice.slice
+ sharing type Int8Vector.elem = Int8.int
+ sharing type Int8VectorSlice.elem = Int8.int
+ sharing type Int8VectorSlice.vector = Int8Vector.vector
+ sharing type Int8Array2.elem = Int8.int
+ sharing type Int8Array2.vector = Int8Vector.vector
+ sharing type Int16Array.elem = Int16.int
+ sharing type Int16Array.vector = Int16Vector.vector
+ sharing type Int16ArraySlice.elem = Int16.int
+ sharing type Int16ArraySlice.array = Int16Array.array
+ sharing type Int16ArraySlice.vector = Int16Vector.vector
+ sharing type Int16ArraySlice.vector_slice = Int16VectorSlice.slice
+ sharing type Int16Vector.elem = Int16.int
+ sharing type Int16VectorSlice.elem = Int16.int
+ sharing type Int16VectorSlice.vector = Int16Vector.vector
+ sharing type Int16Array2.elem = Int16.int
+ sharing type Int16Array2.vector = Int16Vector.vector
sharing type Int32Array.elem = Int32.int
sharing type Int32Array.vector = Int32Vector.vector
sharing type Int32ArraySlice.elem = Int32.int
@@ -345,6 +388,28 @@
sharing type Real64Array2.elem = Real64.real
sharing type Real64Array2.vector = Real64Vector.vector
sharing type Unix.exit_status = Posix.Process.exit_status
+ sharing type WordArray.elem = Word.word
+ sharing type WordArray.vector = WordVector.vector
+ sharing type WordArraySlice.elem = Word.word
+ sharing type WordArraySlice.array = WordArray.array
+ sharing type WordArraySlice.vector = WordVector.vector
+ sharing type WordArraySlice.vector_slice = WordVectorSlice.slice
+ sharing type WordVector.elem = Word.word
+ sharing type WordVectorSlice.elem = Word.word
+ sharing type WordVectorSlice.vector = WordVector.vector
+ sharing type WordArray2.elem = Word.word
+ sharing type WordArray2.vector = WordVector.vector
+ sharing type Word16Array.elem = Word16.word
+ sharing type Word16Array.vector = Word16Vector.vector
+ sharing type Word16ArraySlice.elem = Word16.word
+ sharing type Word16ArraySlice.array = Word16Array.array
+ sharing type Word16ArraySlice.vector = Word16Vector.vector
+ sharing type Word16ArraySlice.vector_slice = Word16VectorSlice.slice
+ sharing type Word16Vector.elem = Word16.word
+ sharing type Word16VectorSlice.elem = Word16.word
+ sharing type Word16VectorSlice.vector = Word16Vector.vector
+ sharing type Word16Array2.elem = Word16.word
+ sharing type Word16Array2.vector = Word16Vector.vector
sharing type Word32Array.elem = Word32.word
sharing type Word32Array.vector = Word32Vector.vector
sharing type Word32ArraySlice.elem = Word32.word
1.7 +22 -0 mlton/basis-library/libs/basis-2002/top-level/basis.sml
Index: basis.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- basis.sml 24 Jun 2003 17:35:52 -0000 1.6
+++ basis.sml 25 Jun 2003 23:15:32 -0000 1.7
@@ -63,7 +63,17 @@
structure IntVectorSlice = IntVectorSlice
structure IntArray2 = IntArray2
structure Int8 = Int8
+ structure Int8Array = Int8Array
+ structure Int8ArraySlice = Int8ArraySlice
+ structure Int8Vector = Int8Vector
+ structure Int8VectorSlice = Int8VectorSlice
+ structure Int8Array2 = Int8Array2
structure Int16 = Int16
+ structure Int16Array = Int16Array
+ structure Int16ArraySlice = Int16ArraySlice
+ structure Int16Vector = Int16Vector
+ structure Int16VectorSlice = Int16VectorSlice
+ structure Int16Array2 = Int16Array2
structure Int32 = Int32
structure Int32Array = Int32Array
structure Int32ArraySlice = Int32ArraySlice
@@ -115,6 +125,18 @@
(*
structure Windows = Windows
*)
+ structure Word = Word
+ structure WordArray = WordArray
+ structure WordArraySlice = WordArraySlice
+ structure WordVector = WordVector
+ structure WordVectorSlice = WordVectorSlice
+ structure WordArray2 = WordArray2
+ structure Word16 = Word16
+ structure Word16Array = Word16Array
+ structure Word16ArraySlice = Word16ArraySlice
+ structure Word16Vector = Word16Vector
+ structure Word16VectorSlice = Word16VectorSlice
+ structure Word16Array2 = Word16Array2
structure Word32 = Word32
structure Word32Array = Word32Array
structure Word32ArraySlice = Word32ArraySlice
1.60 +20 -0 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -r1.59 -r1.60
--- primitive.sml 24 Jun 2003 20:48:01 -0000 1.59
+++ primitive.sml 25 Jun 2003 23:15:32 -0000 1.60
@@ -278,6 +278,9 @@
structure Int8 =
struct
type int = int8
+ val precision' : Int.int = 8
+ val maxInt' : int = 0x7f
+ val minInt' : int = ~0x80
val *? = _prim "Int8_mul": int * int -> int;
val * =
@@ -311,6 +314,9 @@
structure Int16 =
struct
type int = int16
+ val precision' : Int.int = 16
+ val maxInt' : int = 0x7fff
+ val minInt' : int = ~0x8000
val *? = _prim "Int16_mul": int * int -> int;
val * =
@@ -344,6 +350,9 @@
structure Int32 =
struct
type int = int32
+ val precision' : Int.int = 32
+ val maxInt' : int = 0x7fffffff
+ val minInt' : int = ~0x80000000
val *? = _prim "Int32_mul": int * int -> int;
val * =
@@ -964,8 +973,10 @@
structure Word8 =
struct
type word = word8
+ val wordSize: int = 8
val + = _prim "Word8_add": word * word -> word;
+ val addCheck = _prim "Word8_addCheck": word * word -> word;
val andb = _prim "Word8_andb": word * word -> word;
val ~>> = _prim "Word8_arshift": word * word32 -> word;
val div = _prim "Word8_div": word * word -> word;
@@ -978,6 +989,7 @@
val < = _prim "Word8_lt" : word * word -> bool;
val mod = _prim "Word8_mod": word * word -> word;
val * = _prim "Word8_mul": word * word -> word;
+ val mulCheck = _prim "Word8_mulCheck": word * word -> word;
val ~ = _prim "Word8_neg": word -> word;
val notb = _prim "Word8_notb": word -> word;
val orb = _prim "Word8_orb": word * word -> word;
@@ -1009,8 +1021,10 @@
structure Word16 =
struct
type word = word16
+ val wordSize: int = 16
val + = _prim "Word16_add": word * word -> word;
+ val addCheck = _prim "Word16_addCheck": word * word -> word;
val andb = _prim "Word16_andb": word * word -> word;
val ~>> = _prim "Word16_arshift": word * word32 -> word;
val div = _prim "Word16_div": word * word -> word;
@@ -1023,6 +1037,7 @@
val < = _prim "Word16_lt" : word * word -> bool;
val mod = _prim "Word16_mod": word * word -> word;
val * = _prim "Word16_mul": word * word -> word;
+ val mulCheck = _prim "Word16_mulCheck": word * word -> word;
val ~ = _prim "Word16_neg": word -> word;
val notb = _prim "Word16_notb": word -> word;
val orb = _prim "Word16_orb": word * word -> word;
@@ -1040,6 +1055,7 @@
structure Word32 =
struct
type word = word32
+ val wordSize: int = 32
val + = _prim "Word32_add": word * word -> word;
val addCheck = _prim "Word32_addCheck": word * word -> word;
@@ -1047,6 +1063,7 @@
val ~>> = _prim "Word32_arshift": word * word -> word;
val div = _prim "Word32_div": word * word -> word;
val fromInt = _prim "Int32_toWord32": int -> word;
+ val fromLargeWord : word -> word = fn x => x
val >= = _prim "Word32_ge": word * word -> bool;
val > = _prim "Word32_gt" : word * word -> bool;
val <= = _prim "Word32_le": word * word -> bool;
@@ -1062,7 +1079,10 @@
val ror = _prim "Word32_ror": word * word -> word;
val >> = _prim "Word32_rshift": word * word -> word;
val - = _prim "Word32_sub": word * word -> word;
+ val toInt = _prim "Word32_toInt32": word -> int;
val toIntX = _prim "Word32_toInt32X": word -> int;
+ val toLargeWord : word -> word = fn x => x
+ val toLargeWordX : word -> word = fn x => x
val xorb = _prim "Word32_xorb": word * word -> word;
end
structure Word = Word32
1.8 +48 -6 mlton/include/c-chunk.h
Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- c-chunk.h 25 Jun 2003 21:22:53 -0000 1.7
+++ c-chunk.h 25 Jun 2003 23:15:33 -0000 1.8
@@ -617,25 +617,67 @@
static inline t f##_to##t (f x) { \
return (t)x; \
}
-coerce (Int8, Int32)
+coerce (Int32, Int32)
+coerce (Int32, Int16)
coerce (Int32, Int8)
coerce (Int16, Int32)
-coerce (Int32, Int16)
-coerce (Int32, Real64)
-coerce (Int32, Word8)
+coerce (Int16, Int16)
+coerce (Int16, Int8)
+coerce (Int8, Int32)
+coerce (Int8, Int16)
+coerce (Int8, Int8)
coerce (Int32, Word32)
+coerce (Int32, Word16)
+coerce (Int32, Word8)
+coerce (Int16, Word32)
+coerce (Int16, Word16)
+coerce (Int16, Word8)
+coerce (Int8, Word32)
+coerce (Int8, Word16)
+coerce (Int8, Word8)
+coerce (Int32, Real64)
+coerce (Word32, Int32)
+coerce (Word32, Int16)
+coerce (Word32, Int8)
+coerce (Word16, Int32)
+coerce (Word16, Int16)
+coerce (Word16, Int8)
coerce (Word8, Int32)
-coerce (Word8, Word32)
+coerce (Word8, Int16)
+coerce (Word8, Int8)
+coerce (Word32, Word32)
+coerce (Word32, Word16)
coerce (Word32, Word8)
+coerce (Word16, Word32)
+coerce (Word16, Word16)
+coerce (Word16, Word8)
+coerce (Word8, Word32)
+coerce (Word8, Word16)
+coerce (Word8, Word8)
#undef coerce
#define coerceX(size, t) \
static inline t Word##size##_to##t##X (Word##size x) { \
return (t)(Int##size)x; \
}
-coerceX (8, Int32)
coerceX (32, Int32)
+coerceX (32, Int16)
+coerceX (32, Int8)
+coerceX (32, Word32)
+coerceX (32, Word16)
+coerceX (32, Word8)
+coerceX (16, Int32)
+coerceX (16, Int16)
+coerceX (16, Int8)
+coerceX (16, Word32)
+coerceX (16, Word16)
+coerceX (16, Word8)
+coerceX (8, Int32)
+coerceX (8, Int16)
+coerceX (8, Int8)
coerceX (8, Word32)
+coerceX (8, Word16)
+coerceX (8, Word8)
#undef coerceX
#endif /* #ifndef _C_CHUNK_H_ */
-------------------------------------------------------
This SF.Net email is sponsored by: INetU
Attention Web Developers & Consultants: Become An INetU Hosting Partner.
Refer Dedicated Servers. We Manage Them. You Get 10% Monthly Commission!
INetU Dedicated Managed Hosting http://www.inetu.net/partner/index.php
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel