[MLton-commit] r5882

Vesa Karvonen vesak at mlton.org
Wed Aug 15 07:30:19 PDT 2007


Explicit support for FixedInt, which is no longer optional.

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/bool.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/basis.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/scalars.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlkit/ints.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlton/basis.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlton/ints.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/basis.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/ints.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-integer-ext.fun
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-word-ext.fun
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/intable.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/mlton.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/smlnj.sml

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -16,24 +16,25 @@
    fun isFalse b = b = false
    fun isTrue b = b = true
 end
+structure Array = struct open BasisArray type 'a t = 'a array end
+structure ArraySlice = struct open BasisArraySlice type 'a t = 'a slice end
 structure Char = struct open BasisChar type t = char end
 structure CharVector = struct open BasisCharVector type t = vector end
+structure Effect = struct type 'a t = 'a -> Unit.t end
+structure FixedInt = struct open BasisFixedInt type t = int end
+structure Int = struct open BasisInt type t = int end
+structure LargeInt = struct open BasisLargeInt type t = int end
+structure LargeReal = struct open BasisLargeReal type t = real end
+structure LargeWord = struct open BasisLargeWord type t = word end
+structure List = struct open BasisList type 'a t = 'a list end
 structure Option = struct open BasisOption type 'a t = 'a option end
+structure Order = struct datatype order = datatype order type t = order end
 structure String = struct open BasisString type t = string end
-structure Int = struct open BasisInt type t = int end
-structure LargeInt = struct open BasisLargeInt type t = int end
+structure Vector = struct open BasisVector type 'a t = 'a vector end
+structure VectorSlice = struct open BasisVectorSlice type 'a t = 'a slice end
 structure Word = struct open BasisWord type t = word end
 structure Word8 = struct open BasisWord8 type t = word end
-structure LargeWord = struct open BasisLargeWord type t = word end
-structure LargeReal = struct open BasisLargeReal type t = real end
 structure Word8Vector = struct open BasisWord8Vector type t = vector end
-structure Array = struct open BasisArray type 'a t = 'a array end
-structure ArraySlice = struct open BasisArraySlice type 'a t = 'a slice end
-structure Vector = struct open BasisVector type 'a t = 'a vector end
-structure VectorSlice = struct open BasisVectorSlice type 'a t = 'a slice end
-structure List = struct open BasisList type 'a t = 'a list end
-structure Effect = struct type 'a t = 'a -> Unit.t end
-structure Order = struct datatype order = datatype order type t = order end
 structure Pair = struct
    type ('a, 'b) pair = 'a * 'b
    type ('a, 'b) t = ('a, 'b) pair

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/bool.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/bool.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/bool.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -24,6 +24,9 @@
       val xorb = op <>
       val isoInt as (toInt, fromInt) =
           (fn true => 1 | false => 0, fn 0 => false | _ => true)
+      val isoFixedInt as (toFixedInt, fromFixedInt) =
+          (fn true => 1 | false => 0 : FixedInt.t,
+           fn 0 : FixedInt.t => false | _ => true)
       val isoLargeInt as (toLargeInt, fromLargeInt) =
           (fn true => 1 | false => 0 : LargeInt.t,
            fn 0 : LargeInt.t => false | _ => true)

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/basis.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/basis.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/basis.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -85,6 +85,7 @@
 structure BasisCharVector = CharVector
 structure BasisCommandLine = CommandLine
 structure BasisDate = Date
+structure BasisFixedInt = FixedInt
 structure BasisGeneral = General
 structure BasisGenericSock = GenericSock
 structure BasisIEEEReal = IEEEReal

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/scalars.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/scalars.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/scalars.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -6,6 +6,7 @@
 
 (* Extended scalar modules common to all compilers *)
 
+structure FixedInt = MkIntegerExt (FixedInt)
 structure Int = MkIntegerExt (BasisInt)
 structure LargeInt = MkIntegerExt (BasisLargeInt)
 structure Position = MkIntegerExt (BasisPosition)

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlkit/ints.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlkit/ints.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlkit/ints.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -6,8 +6,6 @@
 
 (** == Extended {INTEGER} and {INT_INF} modules for MLKit == *)
 
-structure FixedInt : INTEGER = MkIntegerExt (FixedInt)
-
 structure Int31 : INTEGER = MkIntegerExt (Int31)
 structure Int32 : INTEGER = MkIntegerExt (Int32)
 

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlton/basis.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlton/basis.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlton/basis.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -9,7 +9,6 @@
 structure BasisBoolVector = BoolVector
 structure BasisBoolVector = BoolVector
 structure BasisBoolVectorSlice = BoolVectorSlice
-structure BasisFixedInt = FixedInt
 structure BasisInt1 = Int1
 structure BasisInt10 = Int10
 structure BasisInt11 = Int11

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlton/ints.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlton/ints.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/mlton/ints.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -6,8 +6,6 @@
 
 (** == Extended {INTEGER} and {INT_INF} modules for MLton == *)
 
-structure FixedInt : INTEGER = MkIntegerExt (BasisFixedInt)
-
 structure Int1  : INTEGER = MkIntegerExt (BasisInt1)
 structure Int2  : INTEGER = MkIntegerExt (BasisInt2)
 structure Int3  : INTEGER = MkIntegerExt (BasisInt3)

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/basis.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/basis.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/basis.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -6,7 +6,6 @@
 
 structure SMLofNJ = SMLofNJ
 
-structure BasisFixedInt = FixedInt
 structure BasisInt31 = Int31
 structure BasisInt32 = Int32
 structure BasisInt64 = Int64

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/ints.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/ints.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/ints.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -6,8 +6,6 @@
 
 (** == Extended {INTEGER} and {INT_INF} modules for SML/NJ == *)
 
-structure FixedInt = MkIntegerExt (BasisFixedInt)
-
 structure Int31 = MkIntegerExt (BasisInt31)
 structure Int32 = MkIntegerExt (BasisInt32)
 

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-integer-ext.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-integer-ext.fun	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-integer-ext.fun	2007-08-15 14:30:17 UTC (rev 5882)
@@ -26,6 +26,14 @@
       val isoInt = (toInt, fromInt)
       val isoLarge = (toLarge, fromLarge)
       val isoLargeInt as (toLargeInt, fromLargeInt) = isoLarge
+      val isoFixedInt as (toFixedInt, fromFixedInt) =
+          if case (precision, BasisInt.precision)
+              of (SOME n, SOME m) => BasisInt.<= (n, m)
+               | _                => false
+          then (BasisFixedInt.fromInt o I.toInt,
+                I.fromInt o BasisFixedInt.toInt)
+          else (BasisFixedInt.fromLarge o I.toLarge,
+                I.fromLarge o BasisFixedInt.toLarge)
       fun isZero i = zero = i
       fun isEven i = isZero (rem (i, fromInt 2))
       val isOdd = not o isEven

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-word-ext.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-word-ext.fun	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-word-ext.fun	2007-08-15 14:30:17 UTC (rev 5882)
@@ -58,6 +58,18 @@
          val fromBigBytes = mk BasisWord8Vector.foldl
          val fromLittleBytes = mk BasisWord8Vector.foldr
       end
+      val toFixedInt =
+          if case BasisInt.precision
+              of NONE   => false
+               | SOME n => BasisInt.< (wordSize, n)
+          then BasisFixedInt.fromInt o toInt
+          else BasisFixedInt.fromLarge o toLargeInt
+      val toFixedIntX =
+          if case BasisInt.precision
+              of NONE   => false
+               | SOME n => BasisInt.<= (wordSize, n)
+          then BasisFixedInt.fromInt o toIntX
+          else BasisFixedInt.fromLarge o toLargeIntX
       val fromWord = fromLarge o BasisWord.toLarge
       val fromWord8 = fromInt o BasisWord8.toInt
       val fromWord8X = fromInt o BasisWord8.toIntX
@@ -79,21 +91,24 @@
       val toWord8 = BasisWord8.fromInt o toIntX
       val toWord8X = toWord8
       val toWordX = BasisWord.fromLarge o toLargeX
+      val fromFixedInt = fromLargeInt o BasisFixedInt.toLarge
       val embString = (toString, fromString)
       val isoBigBytes = (toBigBytes, fromBigBytes)
+      val isoFixedInt = (toFixedInt, fromFixedInt)
+      val isoFixedIntX = (toFixedIntX, fromFixedInt)
       val isoInt = (toInt, fromInt)
       val isoIntX = (toIntX, fromInt)
       val isoLarge = (toLarge, fromLarge)
-      val isoLargeX = (toLargeX, fromLarge)
       val isoLargeInt = (toLargeInt, fromLargeInt)
       val isoLargeIntX = (toLargeIntX, fromLargeInt)
-      val isoLargeWord = isoLarge
-      val isoLargeWordX = isoLargeX
+      val isoLargeX = (toLargeX, fromLarge)
       val isoLittleBytes = (toLittleBytes, fromLittleBytes)
       val isoWord = (toWord, fromWord)
       val isoWord8 = (toWord8, fromWord8)
       val isoWord8X = (toWord8X, fromWord8X)
       val isoWordX = (toWordX, fromWordX)
+      val isoLargeWord = isoLarge
+      val isoLargeWordX = isoLargeX
       fun isZero w = fromInt 0 = w
       fun isEven w = isZero (andb (fromInt 1, w))
       val isOdd = not o isEven

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/intable.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/intable.sig	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/intable.sig	2007-08-15 14:30:17 UTC (rev 5882)
@@ -11,18 +11,23 @@
 
 signature INTABLE = sig
    type intable
+   val fromFixedInt : FixedInt.t -> intable
    val fromInt : Int.t -> intable
    val fromLargeInt : LargeInt.t -> intable
+   val isoFixedInt : (intable, FixedInt.t) Iso.t
    val isoInt : (intable, Int.t) Iso.t
    val isoLargeInt : (intable, LargeInt.t) Iso.t
+   val toFixedInt : intable -> FixedInt.t
    val toInt : intable -> Int.t
    val toLargeInt : intable -> LargeInt.t
 end
 
 signature INTABLE_X = sig
    include INTABLE
+   val isoFixedIntX : (intable, FixedInt.t) Iso.t
    val isoIntX : (intable, Int.t) Iso.t
    val isoLargeIntX : (intable, LargeInt.t) Iso.t
+   val toFixedIntX : intable -> FixedInt.t
    val toIntX : intable -> Int.t
    val toLargeIntX : intable -> LargeInt.t
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -145,6 +145,7 @@
 structure Exit : EXIT = Exit
 structure Exn : EXN = Exn
 structure Fix : FIX = Fix
+structure FixedInt : INTEGER = FixedInt
 structure Fn : FN = Fn
 structure Fold : FOLD = Fold
 structure Int : INTEGER = Int

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/mlton.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/mlton.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/mlton.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -10,7 +10,6 @@
 structure BoolArraySlice : MONO_ARRAY_SLICE = BoolArraySlice
 structure BoolVector : MONO_VECTOR = BoolVector
 structure BoolVectorSlice : MONO_VECTOR_SLICE = BoolVectorSlice
-structure FixedInt : INTEGER = FixedInt
 structure Int1 : INTEGER = Int1
 structure Int10 : INTEGER = Int10
 structure Int11 : INTEGER = Int11

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/smlnj.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/smlnj.sml	2007-08-15 13:09:31 UTC (rev 5881)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/smlnj.sml	2007-08-15 14:30:17 UTC (rev 5882)
@@ -6,7 +6,6 @@
 
 (** == SML/NJ specific extensions == *)
 
-structure FixedInt : INTEGER = FixedInt
 structure Int31 : INTEGER = Int31
 structure Int32 : INTEGER = Int32
 structure Int64 : INTEGER = Int64




More information about the MLton-commit mailing list