[MLton-commit] r7060
Matthew Fluet
fluet at mlton.org
Wed Apr 8 05:32:00 PDT 2009
Eliminate some dependencies on a fixed-precision default integer type.
----------------------------------------------------------------------
U mlton/trunk/lib/mlton/basic/hash-set.sml
U mlton/trunk/lib/mlton/basic/int.sml
U mlton/trunk/lib/mlton/basic/random.sml
U mlton/trunk/lib/mlton/set/hashed-unique-set.fun
U mlton/trunk/mlton/elaborate/elaborate-env.fun
U mlton/trunk/mlton/elaborate/interface.fun
----------------------------------------------------------------------
Modified: mlton/trunk/lib/mlton/basic/hash-set.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/hash-set.sml 2009-04-08 12:31:55 UTC (rev 7059)
+++ mlton/trunk/lib/mlton/basic/hash-set.sml 2009-04-08 12:31:59 UTC (rev 7060)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2009 Matthew Fluet.
+ * Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
@@ -63,14 +64,14 @@
val (min,max,total)
= Array.fold
(!buckets,
- (Int.maxInt, Int.minInt, 0.0),
+ (NONE, NONE, 0.0),
fn (l,(min,max,total))
=> let
val n = List.length l
val d = (Real.fromInt n) - avg
in
- (Int.min(min,n),
- Int.max(max,n),
+ (SOME (Option.fold(min,n,Int.min)),
+ SOME (Option.fold(max,n,Int.max)),
total + d * d)
end)
val stdd = let open Real in Math.sqrt(total / (fromInt numb')) end
@@ -80,8 +81,8 @@
seq [str "numBuckets = ", Int.layout numb],
seq [str "avg = ", str (rfmt avg),
str " stdd = ", str (rfmt stdd),
- str " min = ", Int.layout min,
- str " max = ", Int.layout max]]
+ str " min = ", Option.layout Int.layout min,
+ str " max = ", Option.layout Int.layout max]]
end
fun resize (T {buckets, hash, mask, ...}, size: int, newMask: word): unit =
Modified: mlton/trunk/lib/mlton/basic/int.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/int.sml 2009-04-08 12:31:55 UTC (rev 7059)
+++ mlton/trunk/lib/mlton/basic/int.sml 2009-04-08 12:31:59 UTC (rev 7060)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2009 Matthew Fluet.
+ * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
@@ -9,8 +10,9 @@
sig
include INTEGER
- val maxInt: t
- val minInt: t
+ val maxInt: t option
+ val minInt: t option
+ val precision: Pervasive.Int.int option
val roundDownToPowerOfTwo: t -> t
val roundUpToPowerOfTwo: t -> t
val toReal: t -> real
@@ -36,8 +38,9 @@
end
type int = t
- val maxInt = valOf Int.maxInt
- val minInt = valOf Int.minInt
+ val maxInt = Int.maxInt
+ val minInt = Int.minInt
+ val precision = Int.precision
val toReal = Pervasive.Real.fromInt
end
Modified: mlton/trunk/lib/mlton/basic/random.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/random.sml 2009-04-08 12:31:55 UTC (rev 7059)
+++ mlton/trunk/lib/mlton/basic/random.sml 2009-04-08 12:31:59 UTC (rev 7060)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2009 Matthew Fluet.
+ * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
@@ -42,23 +43,33 @@
val int = Trace.trace ("Random.int", Unit.layout, Int.layout) int
-val maxInt = Int.maxInt
+local
+val maxNat =
+ let
+ val shft = Option.fold (Int.precision, Word.wordSize, Int.min)
+ val shft = Word.fromInt (shft - 1)
+ in
+ Word.toInt (Word.notb (Word.<< (Word.notb 0w0, shft)))
+ end
-fun nat () = Word.toInt (Word.andb (word (), Word.fromInt maxInt))
+val maxNatW = Word.fromInt maxNat
+fun nat () = Word.toInt (Word.andb (word (), maxNatW))
+
val nat = Trace.trace ("Random.nat", Unit.layout, Int.layout) nat
-val maxIntR = Real.fromInt maxInt
+val maxNatR = Real.fromInt maxNat
-fun scale r = r / maxIntR
+fun scale r = r / maxNatR
val natReal = Real.fromInt o nat
val natReal = Trace.trace0 ("Random.natReal", Real.layout) natReal
-
+in
fun real () = scale (natReal () + scale (natReal ()))
val real = Trace.trace0 ("Random.real", Real.layout) real
+end
local
val r: word ref = ref 0w0
Modified: mlton/trunk/lib/mlton/set/hashed-unique-set.fun
===================================================================
--- mlton/trunk/lib/mlton/set/hashed-unique-set.fun 2009-04-08 12:31:55 UTC (rev 7059)
+++ mlton/trunk/lib/mlton/set/hashed-unique-set.fun 2009-04-08 12:31:59 UTC (rev 7060)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2009 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
@@ -26,13 +27,13 @@
fun stats' {buckets, mask}
= Vector.fold
(buckets,
- (0, Int.maxInt, Int.minInt),
+ (0, NONE, NONE),
fn (s', (size, min, max)) => let
val n = Set.size s'
in
(size + n,
- Int.min(min, n),
- Int.max(max, n))
+ SOME (Option.fold(min,n,Int.min)),
+ SOME (Option.fold(max,n,Int.max)))
end)
fun stats s
= let
@@ -97,6 +98,7 @@
fun T' {buckets, mask}
= let
val (size,min,max) = stats' {buckets = buckets, mask = mask}
+ val max = case max of SOME max => max | NONE => ~1
val n = Vector.length buckets
in
if max > n
Modified: mlton/trunk/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-env.fun 2009-04-08 12:31:55 UTC (rev 7059)
+++ mlton/trunk/mlton/elaborate/elaborate-env.fun 2009-04-08 12:31:59 UTC (rev 7060)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2009 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -1406,8 +1407,8 @@
fun setTyconNames (E as T {currentScope, ...}): unit =
let
- val {get = shortest: Tycon.t -> int ref, ...} =
- Property.get (Tycon.plist, Property.initFun (fn _ => ref Int.maxInt))
+ val {get = shortest: Tycon.t -> int option ref, ...} =
+ Property.get (Tycon.plist, Property.initFun (fn _ => ref NONE))
fun doType (typeStr: TypeStr.t,
name: Ast.Tycon.t,
length: int,
@@ -1418,11 +1419,11 @@
let
val r = shortest c
in
- if length >= !r
+ if isSome (!r) andalso length >= valOf (!r)
then ()
else
let
- val _ = r := length
+ val _ = r := SOME length
val name =
Pretty.longid (List.map (strids, Strid.layout),
Ast.Tycon.layout name)
@@ -1430,9 +1431,9 @@
Tycon.setPrintName (c, Layout.toString name)
end
end
- val {get = strShortest: Structure.t -> int ref, ...} =
+ val {get = strShortest: Structure.t -> int option ref, ...} =
Property.get (Structure.plist,
- Property.initFun (fn _ => ref Int.maxInt))
+ Property.initFun (fn _ => ref NONE))
fun loopStr (s as Structure.T {strs, types, ...},
length: int,
strids: Strid.t list)
@@ -1440,10 +1441,10 @@
let
val r = strShortest s
in
- if length >= !r
+ if isSome (!r) andalso length >= valOf (!r)
then ()
else
- (r := length
+ (r := SOME length
; Info.foreach (types, fn (name, typeStr) =>
doType (typeStr, name, length, strids))
; Info.foreach (strs, fn (strid, str) =>
@@ -1466,7 +1467,7 @@
else
List.foreach
(!allTycons, fn c =>
- if ! (shortest c) < Int.maxInt
+ if isSome (! (shortest c))
then ()
else
Tycon.setPrintName (c, concat ["?.", Tycon.originalName c]))
Modified: mlton/trunk/mlton/elaborate/interface.fun
===================================================================
--- mlton/trunk/mlton/elaborate/interface.fun 2009-04-08 12:31:55 UTC (rev 7059)
+++ mlton/trunk/mlton/elaborate/interface.fun 2009-04-08 12:31:59 UTC (rev 7060)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2009 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -1154,22 +1155,22 @@
val {destroy = destroy1,
get = tyconShortest: (FlexibleTycon.t
-> {flex: FlexibleTycon.t option ref,
- length: int} ref), ...} =
+ length: int option} ref), ...} =
Property.destGet (FlexibleTycon.plist,
Property.initFun (fn _ => ref {flex = ref NONE,
- length = Int.maxInt}))
+ length = NONE}))
val {destroy = destroy2,
- get = interfaceShortest: t -> int ref, ...} =
- Property.destGet (plist, Property.initFun (fn _ => ref Int.maxInt))
+ get = interfaceShortest: t -> int option ref, ...} =
+ Property.destGet (plist, Property.initFun (fn _ => ref NONE))
fun loop (I: t, length: int): FlexibleTycon.t option ref TyconMap.t =
let
val r = interfaceShortest I
in
- if length >= !r
+ if isSome (!r) andalso length >= valOf (!r)
then TyconMap.empty ()
else
let
- val _ = r := length
+ val _ = r := SOME length
val {strs, types, ...} = dest I
val types =
Array.map
@@ -1185,14 +1186,15 @@
let
val r = tyconShortest c
in
- if length >= #length (!r)
+ if isSome (#length (!r))
+ andalso length >= valOf (#length (!r))
then ref NONE
else
let
val _ = #flex (!r) := NONE
val flex = ref (SOME c)
val _ = r := {flex = flex,
- length = length}
+ length = SOME length}
in
flex
end
More information about the MLton-commit
mailing list