[MLton-commit] r6513

[Vesa Karvonen]

Added [bin,oct,hex] digit <-> int conversions and predicates for bin and
oct digits.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/mono-seqs.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/text/mk-text-ext.fun
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/text/char.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/mono-seqs.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/mono-seqs.sml	2008-03-28 13:56:44 UTC (rev 6512)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/common/mono-seqs.sml	2008-03-29 11:58:47 UTC (rev 6513)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2008 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.
@@ -15,7 +15,12 @@
 structure Word8ArraySlice : MONO_ARRAY_SLICE =
    MkMonoArraySliceExt (structure MonoArraySlice = BasisWord8ArraySlice)
 
-structure Text : TEXT = MkTextExt (structure Text = BasisText open BasisByte)
+structure Text : TEXT =
+   MkTextExt (structure Text = BasisText
+              open BasisByte
+              val ch_0 = #"0" val ch_1 = #"1" val ch_7 = #"7" val ch_9 = #"9"
+              val ch_a = #"a" val ch_f = #"f"
+              val ch_A = #"A" val ch_F = #"F")
 structure Char : CHAR = Text.Char
 structure CharArray : MONO_ARRAY = Text.CharArray
 structure CharArraySlice : MONO_ARRAY_SLICE = Text.CharArraySlice

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/text/mk-text-ext.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/text/mk-text-ext.fun	2008-03-28 13:56:44 UTC (rev 6512)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/text/mk-text-ext.fun	2008-03-29 11:58:47 UTC (rev 6513)
@@ -8,8 +8,11 @@
                    val stringToBytes :
                        Text.String.string -> BasisWord8Vector.vector
                    val bytesToString :
-                       BasisWord8Vector.vector -> Text.String.string)
-        : TEXT =
+                       BasisWord8Vector.vector -> Text.String.string
+                   val ch_0 : Text.Char.char val ch_1 : Text.Char.char
+                   val ch_7 : Text.Char.char val ch_9 : Text.Char.char
+                   val ch_a : Text.Char.char val ch_f : Text.Char.char
+                   val ch_A : Text.Char.char val ch_F : Text.Char.char) : TEXT =
 struct
    open Text
 
@@ -43,6 +46,31 @@
       open Stringable
 
       open Core
+
+      val isBinDigit = inRange (ch_0, ch_1)
+      val isOctDigit = inRange (ch_0, ch_7)
+
+      fun domain b = if b then () else raise Domain
+
+      fun binDigitToInt c = (domain (isBinDigit c) ; ord c - ord ch_0)
+      fun intToBinDigit i = (domain (Int.inRange (0, 1) i) ; chr (i + ord ch_0))
+
+      fun octDigitToInt c = (domain (isOctDigit c) ; ord c - ord ch_0)
+      fun intToOctDigit i = (domain (Int.inRange (0, 7) i) ; chr (i + ord ch_0))
+
+      fun digitToInt c = (domain (isDigit c) ; ord c - ord ch_0)
+      fun intToDigit i = (domain (Int.inRange (0, 9) i) ; chr (i + ord ch_0))
+
+      fun hexDigitToInt c =
+          if inRange (ch_0, ch_9) c
+          then ord c - ord ch_0
+          else if inRange (ch_a, ch_f) c
+          then ord c - (ord ch_a - 10)
+          else (domain (inRange (ch_A, ch_F) c) ; ord c - (ord ch_A - 10))
+      fun intToHexDigit i =
+          if Int.inRange (0, 9) i
+          then chr (i + ord ch_0)
+          else (domain (Int.inRange (10, 15) i) ; chr (i + (ord ch_A - 10)))
    end
 
    structure CharVector = MkMonoVectorExt (CharVector)

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/text/char.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/text/char.sig	2008-03-28 13:56:44 UTC (rev 6512)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/text/char.sig	2008-03-29 11:58:47 UTC (rev 6513)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2008 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.
@@ -21,19 +21,40 @@
    val contains : string -> t UnPr.t
    val notContains : string -> t UnPr.t
 
+   (** == Digit Conversions ==
+    *
+    * Each of these raises {Domain} if the digit or int is not in the
+    * correct range.
+    *)
+
+   val binDigitToInt : t -> Int.t
+   val intToBinDigit : Int.t -> t
+
+   val octDigitToInt : t -> Int.t
+   val intToOctDigit : Int.t -> t
+
+   val digitToInt : t -> Int.t
+   val intToDigit : Int.t -> t
+
+   val intToHexDigit : Int.t -> t
+   val hexDigitToInt : t -> Int.t
+
    (** == Character Predicates == *)
 
-   val isAscii : t UnPr.t
+   val isBinDigit : t UnPr.t
+   val isOctDigit : t UnPr.t
+   val isDigit : t UnPr.t
+   val isHexDigit : t UnPr.t
+
    val isAlpha : t UnPr.t
    val isAlphaNum : t UnPr.t
+   val isAscii : t UnPr.t
    val isCntrl : t UnPr.t
-   val isDigit : t UnPr.t
    val isGraph : t UnPr.t
-   val isHexDigit : t UnPr.t
    val isLower : t UnPr.t
    val isPrint : t UnPr.t
+   val isPunct : t UnPr.t
    val isSpace : t UnPr.t
-   val isPunct : t UnPr.t
    val isUpper : t UnPr.t
 
    (** == Bounds == *)