[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