[MLton-devel] cvs commit: Upgrade to SML/NJ 110.43
Stephen Weeks
sweeks@users.sourceforge.net
Thu, 11 Sep 2003 18:00:25 -0700
sweeks 03/09/11 18:00:25
Modified: bin check-basis
lib/basis-stubs sources.cm
lib/mlton-stubs-in-smlnj array.sml int-inf.sml other.sml
real.sml sources.cm time.sml vector.sml word.sml
Added: lib/mlton-stubs-in-smlnj posix.sml
Removed: lib/basis-stubs os.sml
lib/mlton-stubs-in-smlnj int-inf-sig.cm int-inf.sig
pre-int-inf-sig.sml
Log:
Upgraded mlton-stubs-in-smlnj to 110.43. Most of the changes were in
the handling of IntInf, which is now done properly in SML/NJ. There
were also a couple of bugs in Real.{from,to}LargeInt to work around.
A pleasant side effect is that check-basis will no longer mistakenly
report errors due to Int constants being too large.
All in all, surprisingly painless.
Because of these changes, MLton no longer compiles with 110.42, so you
will need to upgrade.
Revision Changes Path
1.21 +3 -2 mlton/bin/check-basis
Index: check-basis
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/check-basis,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- check-basis 11 Sep 2003 18:58:45 -0000 1.20
+++ check-basis 12 Sep 2003 01:00:19 -0000 1.21
@@ -93,6 +93,7 @@
rm -f $basis
cat >>$basis <<-EOF
val _ = SMLofNJ.Internals.GC.messages false
+ val _ = #set CM.Control.verbose false
val _ =
let
open Control
@@ -116,8 +117,8 @@
type int8 = Int32.int
type int16 = Int32.int
type int32 = Int32.int
- type int64 = Int32.int
- type intInf = int32
+ type int64 = IntInf.int
+ type intInf = IntInf.int
type int = int32
datatype list = datatype list
datatype pointer = T
1.2 +0 -1 mlton/lib/basis-stubs/sources.cm
Index: sources.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/basis-stubs/sources.cm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- sources.cm 24 Nov 2002 01:19:41 -0000 1.1
+++ sources.cm 12 Sep 2003 01:00:21 -0000 1.2
@@ -10,4 +10,3 @@
#endif
basis-2002.sml
-os.sml
1.3 +13 -34 mlton/lib/mlton-stubs-in-smlnj/array.sml
Index: array.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/array.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- array.sml 18 Jul 2001 21:08:59 -0000 1.2
+++ array.sml 12 Sep 2003 01:00:21 -0000 1.3
@@ -11,32 +11,16 @@
val length: 'a array -> int
val sub: 'a array * int -> 'a elem
val update: 'a array * int * 'a elem -> unit
- val extract: 'a array * int * int option -> 'a vector
- val copy: {src: 'a array,
- si: int,
- len: int option,
- dst: 'a array,
- di: int} -> unit
- val copyVec: {src: 'a vector,
- si: int,
- len: int option,
- dst: 'a array,
- di: int} -> unit
- val appi: (int * 'a elem -> unit) -> 'a array * int * int option -> unit
+ val copy: {src: 'a array, dst: 'a array, di: int} -> unit
+ val copyVec: {src: 'a vector, dst: 'a array, di: int} -> unit
+ val appi: (int * 'a elem -> unit) -> 'a array -> unit
val app: ('a elem -> unit) -> 'a array -> unit
- val foldli:
- (int * 'a elem * 'b -> 'b)
- -> 'b -> 'a array * int * int option -> 'b
- val foldri:
- (int * 'a elem * 'b -> 'b)
- -> 'b -> 'a array * int * int option -> 'b
+ val foldli: (int * 'a elem * 'b -> 'b) -> 'b -> 'a array -> 'b
+ val foldri: (int * 'a elem * 'b -> 'b) -> 'b -> 'a array -> 'b
val foldl: ('a elem * 'b -> 'b) -> 'b -> 'a array -> 'b
val foldr: ('a elem * 'b -> 'b) -> 'b -> 'a array -> 'b
- val modifyi:
- (int * 'a elem -> 'a elem)
- -> 'a array * int * int option -> unit
- val modify:
- ('a elem -> 'a elem) -> 'a array -> unit
+ val modifyi: (int * 'a elem -> 'a elem) -> 'a array -> unit
+ val modify: ('a elem -> 'a elem) -> 'a array -> unit
end) =
struct
open Array OpenInt32
@@ -48,26 +32,22 @@
fun update (a, i, x) = Array.update (a, toInt i, x)
fun sub (a, i: Int.int) = Array.sub (a, toInt i)
fun convertSlice (a, i, io) = (a, toInt i, toIntOpt io)
- fun extract s = Array.extract (convertSlice s)
local
- fun doit (f, {src, si, len, dst, di}) =
- {src = src, si = toInt si, len = toIntOpt len,
- dst = dst, di = toInt di}
+ fun doit (f, {src, dst, di}) =
+ f {di = toInt di, dst = dst, src = src}
in
fun copy (f, a) = doit (Array.copy, a)
fun copyVec (f, a) = doit (Array.copyVec, a)
end
- fun appi f slice =
- Array.appi (fn (i, x) => f (fromInt i, x)) (convertSlice slice)
+ fun appi f a = Array.appi (fn (i, x) => f (fromInt i, x)) a
local
- fun make fold f b s =
- fold (fn (i, a, b) => f (fromInt i, a, b)) b (convertSlice s)
+ fun make fold f b a =
+ fold (fn (i, a, b) => f (fromInt i, a, b)) b a
in
fun foldli z = make Array.foldli z
fun foldri z = make Array.foldri z
end
- fun modifyi f s =
- Array.modifyi (fn (i, x) => f (fromInt i, x)) (convertSlice s)
+ fun modifyi f a = Array.modifyi (fn (i, x) => f (fromInt i, x)) a
end
structure Array =
@@ -91,7 +71,6 @@
val array = array
val copy = copy
val copyVec = copyVec
- val extract = extract
val fromList = fromList
val length = length
val modify = modify
1.4 +52 -6 mlton/lib/mlton-stubs-in-smlnj/int-inf.sml
Index: int-inf.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/int-inf.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- int-inf.sml 14 Jan 2003 23:35:36 -0000 1.3
+++ int-inf.sml 12 Sep 2003 01:00:21 -0000 1.4
@@ -1,15 +1,61 @@
+signature INT_INF =
+ sig
+ eqtype int
+
+ val * : int * int -> int
+ val + : int * int -> int
+ val - : int * int -> int
+ val < : int * int -> bool
+ val <= : int * int -> bool
+ val > : int * int -> bool
+ val >= : int * int -> bool
+ val abs: int -> int
+ val compare: int * int -> order
+ val div: int * int -> int
+ val divMod: int * int -> int * int
+ val fmt: StringCvt.radix -> int -> string
+ val fromInt: Pervasive.Int32.int -> int
+ val fromLarge: Pervasive.IntInf.int -> int
+ val fromString: string -> int option
+ val log2: int -> Pervasive.Int32.int
+ val max: int * int -> int
+ val maxInt: int option
+ val min: int * int -> int
+ val minInt: int option
+ val mod: int * int -> int
+ val pow: int * Pervasive.Int32.int -> int
+ val precision: Pervasive.Int32.int option
+ val quot: int * int -> int
+ val quotRem: int * int -> int * int
+ val rem: int * int -> int
+ val sameSign: int * int -> bool
+ val scan:
+ StringCvt.radix
+ -> (char, 'a) StringCvt.reader
+ -> (int, 'a) StringCvt.reader
+ val sign: int -> Pervasive.Int32.int
+ val toInt: int -> Pervasive.Int32.int
+ val toLarge: int -> Pervasive.IntInf.int
+ val toString: int -> string
+ val ~ : int -> int
+ val orb: int * int -> int
+ val xorb: int * int -> int
+ val andb: int * int -> int
+ val notb: int -> int
+ val << : int * Pervasive.Word32.word -> int
+ val ~>> : int * Pervasive.Word32.word -> int
+ end
+
structure IntInf: INT_INF =
struct
open Pervasive.IntInf
- val toInt = toLarge
+ val fromInt = Pervasive.Int32.toLarge
+ val toInt = Pervasive.Int32.fromLarge
val sign = Pervasive.Int32.fromInt o sign
- val fromInt = fromLarge
- val divMod = divmod
- val quotRem = quotrem
+ val divMod = divMod
+ val quotRem = quotRem
val precision: Pervasive.Int32.int option = NONE
- fun toLarge x = x
- fun fromLarge x = x
val log2 = Pervasive.Int32.fromInt o log2
fun pow (a, b) = Pervasive.IntInf.pow (a, Pervasive.Int32.toInt b)
1.3 +0 -1 mlton/lib/mlton-stubs-in-smlnj/other.sml
Index: other.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/other.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- other.sml 10 Sep 2003 00:49:51 -0000 1.2
+++ other.sml 12 Sep 2003 01:00:21 -0000 1.3
@@ -11,7 +11,6 @@
structure Pack32Big = Pack32Big
structure Pack32Little = Pack32Little
structure Position = Position
-structure Posix = Posix
structure SML90 = SML90
structure SMLofNJ = SMLofNJ
structure Unix = Unix
1.3 +127 -20 mlton/lib/mlton-stubs-in-smlnj/real.sml
Index: real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/real.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- real.sml 2 Nov 2002 03:37:37 -0000 1.2
+++ real.sml 12 Sep 2003 01:00:22 -0000 1.3
@@ -1,28 +1,135 @@
-structure Real =
+type int = Int32.int
+
+signature REAL =
+ sig
+ type real
+
+ structure Math: MATH where type real = real
+
+ val != : real * real -> bool
+ val * : real * real -> real
+ val *+ : real * real * real -> real
+ val *- : real * real * real -> real
+ val + : real * real -> real
+ val - : real * real -> real
+ val / : real * real -> real
+ val < : real * real -> bool
+ val <= : real * real -> bool
+ val == : real * real -> bool
+ val > : real * real -> bool
+ val >= : real * real -> bool
+ val ?= : real * real -> bool
+ val abs: real -> real
+ val checkFloat: real -> real
+ val class: real -> IEEEReal.float_class
+ val compare: real * real -> order
+ val compareReal: real * real -> IEEEReal.real_order
+ val copySign: real * real -> real
+ val fmt: StringCvt.realfmt -> real -> string
+ val fromDecimal: IEEEReal.decimal_approx -> real option
+ val fromInt: int -> real
+ val fromLarge: IEEEReal.rounding_mode -> LargeReal.real -> real
+ val fromLargeInt: LargeInt.int -> real
+ val fromManExp: {man: real, exp: int} -> real
+ val fromString: string -> real option
+ val isFinite: real -> bool
+ val isNan: real -> bool
+ val isNormal: real -> bool
+ val max: real * real -> real
+ val maxFinite: real
+ val min: real * real -> real
+ val minNormalPos: real
+ val minPos: real
+ val negInf: real
+ val nextAfter: real * real -> real
+ val posInf: real
+ val precision: int
+ val radix: int
+ val realCeil: real -> real
+ val realFloor: real -> real
+ val realMod: real -> real
+ val realTrunc: real -> real
+ val rem: real * real -> real
+ val round: real -> Int.int
+ val sameSign: real * real -> bool
+ val scan: (char, 'a) StringCvt.reader -> (real, 'a) StringCvt.reader
+ val sign: real -> int
+ val signBit: real -> bool
+ val split: real -> {whole: real, frac: real}
+ val toDecimal: real -> IEEEReal.decimal_approx
+ val toInt: IEEEReal.rounding_mode -> real -> int
+ val toLarge: real -> LargeReal.real
+ val toLargeInt: IEEEReal.rounding_mode -> real -> LargeInt.int
+ val toManExp: real -> {man: real, exp: int}
+ val toString: real -> string
+ val unordered: real * real -> bool
+ val ~ : real -> real
+ val ceil: real -> Int.int
+ val floor: real -> Int.int
+ val trunc: real -> Int.int
+ end
+
+structure Real: REAL =
struct
open Real
+ datatype z = datatype IEEEReal.float_class
+ datatype z = datatype IEEEReal.rounding_mode
+
+ fun fromLargeInt i =
+ valOf (Real.fromString (LargeInt.toString i))
+
+ val toLargeInt: IEEEReal.rounding_mode -> real -> LargeInt.int =
+ fn mode => fn x =>
+ case class x of
+ INF => raise Overflow
+ | NAN _ => raise Domain
+ | ZERO => 0
+ | _ =>
+ let
+ val x =
+ case mode of
+ TO_NEAREST =>
+ let
+ val x1 = realFloor x
+ val x2 = realCeil x
+ in
+ if abs (x - x1) < abs (x - x2)
+ then x1
+ else x2
+ end
+ | TO_NEGINF => realFloor x
+ | TO_POSINF => realCeil x
+ | TO_ZERO => realTrunc x
+ in
+ valOf (LargeInt.fromString (fmt (StringCvt.FIX (SOME 0)) x))
+ end
+
+ open OpenInt32
+
local
- open OpenInt32
+ fun make m r = Pervasive.Int32.fromLarge (toLargeInt m r)
+ datatype z = datatype IEEEReal.rounding_mode
in
- val floor = fromInt o floor
- val ceil = fromInt o ceil
- val trunc = fromInt o trunc
- val round = fromInt o round
- val radix = fromInt radix
- val precision = fromInt precision
- val sign = fromInt o sign
- fun toManExp x =
- let val {man, exp} = Real.toManExp x
- in {man = man, exp = fromInt exp}
- end
- fun fromManExp{man, exp} = Real.fromManExp{man = man, exp = toInt exp}
- fun toInt m x = fromInt(Real.toInt m x)
- val fromInt = Real.fromLargeInt
+ val floor = make TO_NEGINF
+ val ceil = make TO_POSINF
+ val round = make TO_NEAREST
+ val trunc = make TO_ZERO
end
- val fromLargeInt: IntInf.int -> real =
- fn _ => raise Fail "Real.fromLargeInt"
- val toLargeInt: IEEEReal.rounding_mode -> real -> IntInf.int =
- fn _ => fn _ => raise Fail "Real.toLargeInt"
+ val radix = fromInt radix
+ val precision = fromInt precision
+ val sign = fromInt o sign
+ fun toManExp x =
+ let
+ val {man, exp} = Real.toManExp x
+ in
+ {man = man, exp = fromInt exp}
+ end
+ fun fromManExp {man, exp} =
+ Real.fromManExp {man = man, exp = toInt exp}
+ fun toInt m x = Pervasive.Int32.fromLarge (toLargeInt m x)
+ val fromInt = fromLargeInt o Pervasive.Int32.toLarge
+
+ val fromDecimal = SOME o fromDecimal
end
1.11 +1 -1 mlton/lib/mlton-stubs-in-smlnj/sources.cm
Index: sources.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/sources.cm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- sources.cm 10 Sep 2003 00:49:51 -0000 1.10
+++ sources.cm 12 Sep 2003 01:00:22 -0000 1.11
@@ -68,13 +68,13 @@
bin-io.sml
char.sml
date.sml
-int-inf-sig.cm
int-inf.sml
int.sml
list.sml
open-int32.sml
os.sml
other.sml
+posix.sml
real.sml
string-cvt.sml
string.sml
1.2 +0 -6 mlton/lib/mlton-stubs-in-smlnj/time.sml
Index: time.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/time.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- time.sml 18 Jul 2001 05:51:03 -0000 1.1
+++ time.sml 12 Sep 2003 01:00:22 -0000 1.2
@@ -2,11 +2,5 @@
struct
open Time
- val toSeconds = IntInf.fromInt o toSeconds
- val toMilliseconds = IntInf.fromInt o toMilliseconds
- val toMicroseconds = IntInf.fromInt o toMicroseconds
- val fromSeconds = fromSeconds o IntInf.toInt
- val fromMilliseconds = fromMilliseconds o IntInf.toInt
- val fromMicroseconds = fromMicroseconds o IntInf.toInt
val fmt = fmt o Int32.toInt
end
1.3 +11 -19 mlton/lib/mlton-stubs-in-smlnj/vector.sml
Index: vector.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/vector.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- vector.sml 9 Oct 2001 00:17:49 -0000 1.2
+++ vector.sml 12 Sep 2003 01:00:23 -0000 1.3
@@ -6,19 +6,12 @@
val tabulate: Int31.int * (Int31.int -> 'a elem) -> 'a vector
val length: 'a vector -> Int31.int
val sub: ('a vector * Int31.int) -> 'a elem
- val extract: ('a vector * Int31.int * Int31.int option) -> 'a vector
- val mapi:
- ((Int31.int * 'a elem) -> 'b elem)
- -> ('a vector * Int31.int * Int31.int option) -> 'b vector
- val appi:
- ((Int31.int * 'a elem) -> unit)
- -> ('a vector * Int31.int * Int31.int option) -> unit
- val foldli :
- ((Int31.int * 'a elem * 'b) -> 'b)
- -> 'b -> ('a vector * Int31.int * Int31.int option) -> 'b
- val foldri :
- ((Int31.int * 'a elem * 'b) -> 'b)
- -> 'b -> ('a vector * Int31.int * Int31.int option) -> 'b
+ val mapi: ((Int31.int * 'a elem) -> 'b elem) -> 'a vector -> 'b vector
+ val appi: ((Int31.int * 'a elem) -> unit) -> 'a vector -> unit
+ val foldli:
+ ((Int31.int * 'a elem * 'b) -> 'b) -> 'b -> 'a vector -> 'b
+ val foldri:
+ ((Int31.int * 'a elem * 'b) -> 'b) -> 'b -> 'a vector -> 'b
end) =
struct
open V OpenInt32
@@ -28,15 +21,15 @@
fun length (v: 'a vector) = fromInt (V.length v)
fun sub (v, i) = V.sub (v, toInt i)
fun convertSlice (v: 'a vector, i, io) = (v, toInt i, toIntOpt io)
- fun extract z = V.extract (convertSlice z)
local
- fun make f g s = f (fn (i, e) => g (fromInt i, e)) (convertSlice s)
- in val mapi = fn z => make mapi z
+ fun make f g v = f (fn (i, e) => g (fromInt i, e)) v
+ in
+ val mapi = fn z => make mapi z
val appi = fn z => make appi z
end
local
- fun make fold f a s =
- fold (fn (i, e, a) => f (fromInt i, e, a)) a (convertSlice s)
+ fun make fold f a v =
+ fold (fn (i, e, a) => f (fromInt i, e, a)) a v
in
val foldli = fn z => make foldli z
val foldri = fn z => make foldri z
@@ -57,7 +50,6 @@
type 'a elem = elem
(* These rebindings are because of an SML/NJ bug. *)
val appi = appi
- val extract = extract
val length = length
val mapi = mapi
val sub = sub
1.8 +3 -3 mlton/lib/mlton-stubs-in-smlnj/word.sml
Index: word.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/word.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- word.sml 10 Sep 2003 19:04:24 -0000 1.7
+++ word.sml 12 Sep 2003 01:00:23 -0000 1.8
@@ -84,15 +84,15 @@
val >> = fix W.>>
val ~>> = fix W.~>>
end
- val fromInt = W.fromLargeInt
+ val fromInt = W.fromLargeInt o Pervasive.Int32.toLarge
val fromLarge = W.fromLargeWord o LargeWord.toLargeWord
fun fromLargeInt i =
if IntInf.< (i, IntInf.fromInt 0)
then raise Overflow
else valOf (W.fromString (IntInf.fmt StringCvt.HEX i))
val fromLargeWord = fromLarge
- val toInt = W.toLargeInt
- val toIntX = W.toLargeIntX
+ val toInt = Pervasive.Int32.fromLarge o W.toLargeInt
+ val toIntX = Pervasive.Int32.fromLarge o W.toLargeIntX
val toLarge = LargeWord.fromLargeWord o W.toLargeWord
fun toLargeInt w = valOf (IntInf.fromString (W.fmt StringCvt.DEC w))
val highBit = W.<< (W.fromLargeWord 0w1,
1.1 mlton/lib/mlton-stubs-in-smlnj/posix.sml
Index: posix.sml
===================================================================
structure Posix =
struct
open Posix
structure ProcEnv =
struct
open ProcEnv
(* SML/NJ times is broken. So it's probably best to ignore what
* it says and return zero.
*)
fun times () =
{cstime = Time.zeroTime,
cutime = Time.zeroTime,
elapsed = Time.zeroTime,
stime = Time.zeroTime,
utime = Time.zeroTime}
end
end
-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel