[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