[MLton-commit] r6309

[Vesa Karvonen]

Taught Int<?>.scan to recognize 0[bB] and 0[oO] prefixes for binary and
octal, respectively.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-integer-ext.fun

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

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	2008-01-09 17:47:39 UTC (rev 6308)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/numeric/mk-integer-ext.fun	2008-01-09 21:20:53 UTC (rev 6309)
@@ -42,6 +42,39 @@
              (NONE,         NONE) => NONE
            | (SOME min, SOME max) => SOME (min, max)
            | _                    => raise Fail "illegal"
+      local
+         open BasisStringCvt
+         fun skip radix x get s = let
+            datatype t = INITIAL | FINAL
+            val s = (INITIAL, dropl BasisChar.isSpace get s)
+            val get =
+             fn (FINAL, s) =>
+                BasisOption.map (fn (c, s) => (c, (FINAL, s))) (get s)
+              | (INITIAL, s) =>
+                case get s
+                 of NONE        => NONE
+                  | SOME (c, s) =>
+                    SOME (c,
+                          (if BasisChar.<= (#"0", c)
+                              andalso BasisChar.<= (c, #"9")
+                           then FINAL
+                           else INITIAL,
+                           if #"0" <> c
+                           then s
+                           else case get s
+                                 of SOME (c, s') =>
+                                    if BasisChar.toLower c = x then s' else s
+                                  | _            => s))
+         in
+            BasisOption.map (fn (c, (_, s)) => (c, s)) (scan radix get s)
+         end
+      in
+         val scan =
+          fn DEC => scan DEC
+           | HEX => scan HEX
+           | OCT => skip OCT #"o"
+           | BIN => skip BIN #"b"
+      end
    end
 
    structure MaybeBounded = MkMaybeBounded (Core)