[MLton-commit] r5548
Vesa Karvonen
vesak at mlton.org
Sun May 6 07:47:38 PDT 2007
WORD using concepts.
----------------------------------------------------------------------
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/concept/largeable.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/shiftable.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/wordable.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/numeric/integer.sig
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/numeric/word.sig
----------------------------------------------------------------------
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-05-06 14:46:21 UTC (rev 5547)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-word-ext.fun 2007-05-06 14:47:37 UTC (rev 5548)
@@ -1,55 +1,84 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2007 SSH Communications Security, Helsinki, Finland
*
* This code is released under the MLton license, a BSD-style license.
* See the LICENSE file or http://mlton.org/License for details.
*)
functor MkWordExt (W : BASIS_WORD) : WORD = struct
- open W
- type t = word
- val bounds as (minWord, maxWord) = (fromInt 0, fromInt~1)
- val numBytes = BasisInt.quot (BasisInt.+ (wordSize, 7), 8)
- local
- fun mk fold bs =
- if numBytes <> BasisWord8Vector.length bs then
- raise Subscript
- else
- fold (fn (b, w) =>
- W.orb (W.<< (w, 0w8), W.fromLarge (BasisWord8.toLarge b)))
- (W.fromInt 0)
- bs
- in
- val fromBigBytes = mk BasisWord8Vector.foldl
- val fromLittleBytes = mk BasisWord8Vector.foldr
+ structure Core = struct
+ open W
+ type t = word
+ type bitwise = t
+ type bounded = t
+ type formattable = t
+ type formattable_format = BasisStringCvt.radix
+ type intable = t
+ type largeable = t
+ type largeable_large = BasisLargeWord.word
+ type ordered = t
+ type scannable = t
+ type scannable_format = formattable_format
+ type shiftable = t
+ type stringable = t
+ type wordable = t
+ val bounds = (fromInt 0, fromInt~1)
+ val numBytes = BasisInt.quot (BasisInt.+ (wordSize, 7), 8)
+ local
+ fun mk fold bs =
+ if numBytes <> BasisWord8Vector.length bs then
+ raise Subscript
+ else
+ fold (fn (b, w) =>
+ W.orb (W.<< (w, 0w8),
+ W.fromLarge (BasisWord8.toLarge b)))
+ (W.fromInt 0)
+ bs
+ in
+ val fromBigBytes = mk BasisWord8Vector.foldl
+ val fromLittleBytes = mk BasisWord8Vector.foldr
+ end
+ val fromWord = fromLarge o BasisWord.toLarge
+ val fromWordX = fromLarge o BasisWord.toLargeX
+ local
+ fun mk idx w =
+ BasisWord8Vector.tabulate
+ (numBytes,
+ fn i =>
+ BasisWord8.fromLarge
+ (W.toLarge
+ (W.>> (w, BasisWord.*
+ (0w8, BasisWord.fromInt (idx i))))))
+ in
+ val toBigBytes = mk (fn i => BasisInt.- (BasisInt.- (numBytes, 1), i))
+ val toLittleBytes = mk (fn i => i)
+ end
+ val toWord = BasisWord.fromLarge o toLarge
+ val toWordX = BasisWord.fromLarge o toLargeX
+ val embString = (toString, fromString)
+ val isoBigBytes = (toBigBytes, fromBigBytes)
+ 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 isoLittleBytes = (toLittleBytes, fromLittleBytes)
+ val isoWord = (toWord, fromWord)
+ val isoWordX = (toWordX, fromWordX)
+ fun isZero w = fromInt 0 = w
+ fun isEven w = isZero (andb (fromInt 1, w))
+ val isOdd = not o isEven
end
- val fromWord = fromLarge o BasisWord.toLarge
- val fromWordX = fromLarge o BasisWord.toLargeX
- local
- fun mk idx w =
- BasisWord8Vector.tabulate
- (numBytes,
- fn i =>
- BasisWord8.fromLarge
- (W.toLarge (W.>> (w, BasisWord.*
- (0w8, BasisWord.fromInt (idx i))))))
- in
- val toBigBytes = mk (fn i => BasisInt.- (BasisInt.- (numBytes, 1), i))
- val toLittleBytes = mk (fn i => i)
- end
- val toWord = BasisWord.fromLarge o toLarge
- val toWordX = BasisWord.fromLarge o toLargeX
- val embString = (toString, fromString)
- val isoBigBytes = (toBigBytes, fromBigBytes)
- val isoInt = (toInt, fromInt)
- val isoIntX = (toIntX, fromInt)
- val isoLarge = (toLarge, fromLarge)
- val isoLargeInt = (toLargeInt, fromLargeInt)
- val isoLargeIntX = (toLargeIntX, fromLargeInt)
- val isoLargeX = (toLargeX, fromLarge)
- val isoLittleBytes = (toLittleBytes, fromLittleBytes)
- val isoWord = (toWord, fromWord)
- val isoWordX = (toWordX, fromWordX)
- fun isZero w = fromInt 0 = w
- fun isEven w = isZero (andb (fromInt 1, w))
- val isOdd = not o isEven
+
+ structure Bounded = MkBounded (Core)
+ structure Ordered = MkOrdered (Core)
+ structure Stringable = MkStringable (Core)
+
+ open Bounded
+ open Ordered
+ open Stringable
+
+ open Core
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/intable.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/intable.sig 2007-05-06 14:46:21 UTC (rev 5547)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/intable.sig 2007-05-06 14:47:37 UTC (rev 5548)
@@ -18,3 +18,11 @@
val toInt : intable -> Int.t
val toLargeInt : intable -> LargeInt.t
end
+
+signature INTABLE_X = sig
+ include INTABLE
+ val isoIntX : (intable, Int.t) Iso.t
+ val isoLargeIntX : (intable, LargeInt.t) Iso.t
+ val toIntX : intable -> Int.t
+ val toLargeIntX : intable -> LargeInt.t
+end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/largeable.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/largeable.sig 2007-05-06 14:46:21 UTC (rev 5547)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/largeable.sig 2007-05-06 14:47:37 UTC (rev 5548)
@@ -18,3 +18,9 @@
val isoLarge : (largeable, largeable_large) Iso.t
val toLarge : largeable -> largeable_large
end
+
+signature LARGEABLE_X = sig
+ include LARGEABLE
+ val isoLargeX : (largeable, LargeWord.t) Iso.t
+ val toLargeX : largeable -> largeable_large
+end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/shiftable.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/shiftable.sig 2007-05-06 14:46:21 UTC (rev 5547)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/shiftable.sig 2007-05-06 14:47:37 UTC (rev 5548)
@@ -28,3 +28,9 @@
* returns {floor (i / 2^n)}.
*)
end
+
+(** Like {SHIFTABLE}, but the sequence of bits is finite. *)
+signature SHIFTABLE_FIN = sig
+ include SHIFTABLE
+ val >> : shiftable ShiftOp.t
+end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/wordable.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/wordable.sig 2007-05-06 14:46:21 UTC (rev 5547)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/concept/wordable.sig 2007-05-06 14:47:37 UTC (rev 5548)
@@ -18,3 +18,12 @@
val toLargeWord : wordable -> LargeWord.t
val toWord : wordable -> Word.t
end
+
+signature WORDABLE_X = sig
+ include WORDABLE
+ val fromWordX : Word.t -> wordable
+ val isoLargeWordX : (wordable, LargeWord.t) Iso.t
+ val isoWordX : (wordable, Word.t) Iso.t
+ val toLargeWordX : wordable -> LargeWord.t
+ val toWordX : wordable -> Word.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-05-06 14:46:21 UTC (rev 5547)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml 2007-05-06 14:47:37 UTC (rev 5548)
@@ -23,6 +23,10 @@
signature FORMATTABLE_and_SCANNABLE_FROM_FORMAT =
FORMATTABLE_and_SCANNABLE_FROM_FORMAT
signature FUNC = FUNC
+signature INTABLE = INTABLE
+signature INTABLE_X = INTABLE_X
+signature LARGEABLE = LARGEABLE
+signature LARGEABLE_X = LARGEABLE_X
signature MAYBE_BOUNDED = MAYBE_BOUNDED
signature MAYBE_BOUNDED_CORE = MAYBE_BOUNDED_CORE
signature MONAD = MONAD
@@ -45,6 +49,7 @@
signature STRINGABLE = STRINGABLE
signature STRINGABLE_CORE = STRINGABLE_CORE
signature WORDABLE = WORDABLE
+signature WORDABLE_X = WORDABLE_X
(** === Module Signatures === *)
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/numeric/integer.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/numeric/integer.sig 2007-05-06 14:46:21 UTC (rev 5547)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/numeric/integer.sig 2007-05-06 14:47:37 UTC (rev 5548)
@@ -60,6 +60,6 @@
include SIGNED
include STRINGABLE
- sharing type t = int = bounded = formattable = intable = largeable = ordered
- = signed = stringable
+ sharing type bounded = formattable = int = intable = largeable = ordered
+ = signed = stringable = t
end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/numeric/word.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/numeric/word.sig 2007-05-06 14:46:21 UTC (rev 5547)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/numeric/word.sig 2007-05-06 14:47:37 UTC (rev 5548)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2007 SSH Communications Security, Helsinki, Finland
*
* This code is released under the MLton license, a BSD-style license.
* See the LICENSE file or http://mlton.org/License for details.
@@ -6,34 +6,32 @@
(** Extended {WORD} signature. *)
signature WORD = sig
- include BASIS_WORD
+ eqtype word
- type t = word
+ type t
(** Convenience alias. *)
+ (** == Numeric == *)
+
+ val + : t BinOp.t
+ val - : t BinOp.t
+ val * : t BinOp.t
+
+ val div : t BinOp.t
+ val mod : t BinOp.t
+
+ val ~ : t UnOp.t
+
(** == Bounds == *)
+ val wordSize : Int.int
+
val numBytes : Int.t
(**
* The number of bytes (8-bit words) it takes to store a {word}. This
* is always equal to {(wordSize + 7) quot 8}.
*)
- val maxWord : t
- (**
- * The maximal representable {word}. This is always equal to {fromInt
- * ~1}.
- *)
-
- val minWord : t
- (** The minimal representable {word}. This is always {0w0}. *)
-
- val bounds : t Sq.t
- (**
- * Pair of the minimal and maximal representable {word}s. This is
- * always equal to {(minWord, maxWord)}.
- *)
-
(** == Conversions == *)
val fromBigBytes : Word8Vector.t -> t
@@ -52,23 +50,6 @@
* ignored.
*)
- val fromWord : Word.t -> t
- (**
- * Converts the given word {w : Word.t} to the value {w(mod
- * (2^wordSize))} of type {word}. This has the effect of taking the
- * low-order {wordSize} bits of the 2's complement representation of
- * {w}.
- *)
-
- val fromWordX : Word.t -> t
- (**
- * Converts the given word {w : Word.t} to a value of type {word}.
- * {w} is ``sign-extended,'' i.e., the {min (Word.wordSize, wordSize)}
- * low-order bits of {w} and {fromWordX w} are the same, and the
- * remaining bits of {fromWordX w} are all equal to the most
- * significant bit of {w}.
- *)
-
val toBigBytes : t -> Word8Vector.t
(**
* Converts the given word to a vector of bytes in big-endian order.
@@ -83,31 +64,6 @@
* zeroes.
*)
- val toWord : t -> Word.t
- (**
- * Converts the given word {w : word} to the value {w(mod
- * (2^Word.wordSize))} of type {Word.t}. This has the effect of
- * taking the low-order {Word.wordSize} bits of the 2's complement
- * representation of {w}.
- *)
-
- val toWordX : t -> Word.t
- (**
- * Converts the given word {w : word} to a value of type {Word.t}.
- * {w} is ``sign-extended,'' i.e., the {min (Word.wordSize, wordSize)}
- * low-order bits of {w} and {toWordX w} are the same, and the
- * remaining bits of {toWordX w} are all equal to the most significant
- * bit of {w}.
- *)
-
- (** == Embeddings == *)
-
- val embString : (t, String.t) Emb.t
- (**
- * An embedding of words into strings. It is always equivalent to
- * {(toString, fromString)}.
- *)
-
(** == Isomorphisms == *)
val isoBigBytes : (t, Word8Vector.t) Iso.t
@@ -116,74 +72,42 @@
* equivalent to {(toBigBytes, fromBigBytes)}.
*)
- val isoInt : (t, Int.t) Iso.t
- (**
- * An isomorphism between words of type {word} and the default integer
- * type. It is always equivalent to {(toInt, fromInt)}.
- *)
-
- val isoIntX : (t, Int.t) Iso.t
- (**
- * An isomorphism between words of type {word} and the default integer
- * type. It is always equivalent to {(toIntX, fromInt)}.
- *)
-
- val isoLarge : (t, LargeWord.t) Iso.t
- (**
- * An isomorphism between words of type {word} and the {LargeWord.t}
- * type. It is always equivalent to {(toLarge, fromLarge)}.
- *)
-
- val isoLargeInt : (t, LargeInt.t) Iso.t
- (**
- * An isomorphism between words of type {word} and the {LargeInt.t}
- * type. It is always equivalent to {(toLargeInt, fromLargeInt)}.
- *)
-
- val isoLargeIntX : (t, LargeInt.t) Iso.t
- (**
- * An isomorphism between words of type {word} and the {LargeInt.t}
- * type. It is always equivalent to {(toLargeIntX, fromLargeInt)}.
- *)
-
- val isoLargeX : (t, LargeWord.t) Iso.t
- (**
- * An isomorphism between words of type {word} and the {LargeWord.t}
- * type. It is always equivalent to {(toLargeX, fromLarge)}.
- *)
-
val isoLittleBytes : (t, Word8Vector.t) Iso.t
(**
* An isomorphism between words and byte vectors. It is always
* equivalent to {(toLittleBytes, fromLittleBytes)}.
*)
- val isoWord : (t, Word.t) Iso.t
- (**
- * An isomorphism between words of type {word} and the default word
- * type. It is always equivalent to {(toWord, fromWord)}.
- *)
-
- val isoWordX : (t, Word.t) Iso.t
- (**
- * An isomorphism between words of type {word} and the default word
- * type. It is always equivalent to {(toWordX, fromWordX)}.
- *)
-
(** == Predicates == *)
- val isEven : t -> Bool.t
+ val isEven : t UnPr.t
(**
* Returns true if the given word is of the form {0w2*n} for some
* word {n}.
*)
- val isOdd : t -> Bool.t
+ val isOdd : t UnPr.t
(**
* Returns true if the given word is of the form {0w2*n+0w1} for some
* word {n}.
*)
- val isZero : t -> Bool.t
+ val isZero : t UnPr.t
(** Returns true if the given word is {0w0}. *)
+
+ (** == Concepts == *)
+
+ include BITWISE
+ include BOUNDED
+ include FORMATTABLE_and_SCANNABLE_FROM_FORMAT
+ where type formattable_format = BasisStringCvt.radix
+ include INTABLE_X
+ include LARGEABLE_X where type largeable_large = LargeWord.t
+ include ORDERED
+ include SHIFTABLE_FIN
+ include STRINGABLE
+ include WORDABLE_X
+
+ sharing type bitwise = bounded = formattable = intable = largeable = ordered
+ = shiftable = stringable = t = word = wordable
end
More information about the MLton-commit
mailing list