basis-library/text/string-cvt.sml

   1 (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  * Copyright (C) 1997-2000 NEC Research Institute.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 structure StringCvt: STRING_CVT_EXTRA =
  10    struct
  11       open Reader
  12
  13       val wordFromInt = Word.sextdFromInt
  14
  15       datatype radix = BIN | OCT | DEC | HEX
  16
  17       val radixToInt: radix -> int =
  18          fn BIN => 2
  19           | OCT => 8
  20           | DEC => 10
  21           | HEX => 16
  22       val radixToWord: radix -> word = wordFromInt o radixToInt
  23
  24       datatype realfmt =
  25          SCI of int option
  26        | FIX of int option
  27        | GEN of int option
  28        | EXACT
  29
  30       type ('a, 'b) reader = 'b -> ('a * 'b) option
  31
  32       open Int
  33
  34       local
  35          fun pad f (c: char) i s =
  36             let
  37                val n = String.size s
  38             in
  39                if n >= i
  40                   then s
  41                else f (s, String.vector (i -? n, c))
  42             end
  43       in
  44          val padLeft = pad (fn (s, pad) => String.^ (pad, s))
  45          val padRight = pad String.^
  46       end
  47
  48       fun splitl p f src =
  49          let fun done chars = String.implode (rev chars)
  50             fun loop (src, chars) =
  51                case f src of
  52                   NONE => (done chars, src)
  53                 | SOME (c, src') =>
  54                      if p c
  55                         then loop (src', c :: chars)
  56                      else (done chars, src)
  57          in loop (src, [])
  58          end
  59
  60       fun takel p f s = #1 (splitl p f s)
  61       fun dropl p f s = #2 (splitl p f s)
  62
  63       type cs = int
  64
  65       fun stringReader (s: string): (char, cs) reader =
  66          fn i => if i >= String.size s
  67                     then NONE
  68                  else SOME (String.sub (s, i), i + 1)
  69
  70       fun 'a scanString (f: ((char, cs) reader -> ('a, cs) reader)) (s: string)
  71         : 'a option =
  72          case f (stringReader s) 0 of
  73             NONE => NONE
  74           | SOME (a, _) => SOME a
  75
  76       local
  77          fun memoize (f: char -> 'a): char -> 'a =
  78             let val a = Array.tabulate (Char.numChars, f o Char.chrUnsafe)
  79             in fn c => Array.sub (a, Char.ord c)
  80             end
  81
  82          fun range (add: int, cmin: char, cmax: char): char -> int option =
  83             let val min = Char.ord cmin
  84             in fn c => if Char.<= (cmin, c) andalso Char.<= (c, cmax)
  85                           then SOME (add +? Char.ord c -? min)
  86                        else NONE
  87             end
  88
  89          fun 'a combine (ds: (char -> 'a option) list): char -> 'a option =
  90             memoize
  91             (fn c =>
  92              let
  93                 val rec loop =
  94                    fn [] => NONE
  95                     | d :: ds =>
  96                          case d c of
  97                             NONE => loop ds
  98                           | z => z
  99              in loop ds
 100              end)
 101
 102          val bin = memoize (range (0, #"0", #"1"))
 103          val oct = memoize (range (0, #"0", #"7"))
 104          val dec = memoize (range (0, #"0", #"9"))
 105          val hex = combine [range (0, #"0", #"9"),
 106                             range (10, #"a", #"f"),
 107                             range (10, #"A", #"F")]
 108
 109          fun isSpace c = (c = #" "  orelse c = #"\t" orelse c = #"\r" orelse
 110                           c = #"\n" orelse c = #"\v" orelse c = #"\f")
 111       in
 112          val isSpace = memoize isSpace
 113          fun skipWS x = dropl isSpace x
 114
 115          fun charToDigit (radix: radix): char -> int option =
 116             case radix of
 117                BIN => bin
 118              | OCT => oct
 119              | DEC => dec
 120              | HEX => hex
 121       end
 122
 123       fun charToWDigit radix = (Option.map wordFromInt) o (charToDigit radix)
 124
 125       fun digits (radix, max, accum) reader state =
 126          let
 127             val r = radixToInt radix
 128             fun loop (max, accum, state) =
 129                let fun done () = SOME (accum, state)
 130                in if max <= 0
 131                      then done ()
 132                   else
 133                      case reader state of
 134                         NONE => done ()
 135                       | SOME (c, state) =>
 136                            case charToDigit radix c of
 137                               NONE => done ()
 138                             | SOME n => loop (max - 1, n + accum * r, state)
 139                end
 140          in loop (max, accum, state)
 141          end
 142
 143       fun digitsPlus (radix, max) reader state =
 144          case reader state of
 145             NONE => NONE
 146           | SOME (c, state) =>
 147                case charToDigit radix c of
 148                   NONE => NONE
 149                 | SOME n => digits (radix, max -? 1, n) reader state
 150
 151       fun digitsExact (radix, num) reader state =
 152          let val r = radixToInt radix
 153             fun loop (num, accum, state) =
 154                if num <= 0
 155                   then SOME (accum, state)
 156                else
 157                   case reader state of
 158                      NONE => NONE
 159                    | SOME (c, state) =>
 160                         case charToDigit radix c of
 161                            NONE => NONE
 162                          | SOME n => loop (num - 1, n + accum * r, state)
 163          in loop (num, 0, state)
 164          end
 165
 166       fun digits radix reader state =
 167          let
 168             val r = radixToInt radix
 169             fun loop (accum, state) =
 170                case reader state of
 171                   NONE => SOME (accum, state)
 172                 | SOME (c, state') =>
 173                      case charToDigit radix c of
 174                         NONE => SOME (accum, state)
 175                       | SOME n => loop (n + accum * r, state')
 176          in case reader state of
 177             NONE => NONE
 178           | SOME (c, state) =>
 179                case charToDigit radix c of
 180                   NONE => NONE
 181                 | SOME n => loop (n, state)
 182          end
 183
 184       fun wdigits radix reader state =
 185          let
 186             val op + = Word.+
 187             val op * = Word.*
 188             val r = radixToWord radix
 189             fun loop (accum, state) =
 190                case reader state of
 191                   NONE => SOME (accum, state)
 192                 | SOME (c, state') =>
 193                      case charToWDigit radix c of
 194                         NONE => SOME (accum, state)
 195                       | SOME n => loop (n + accum * r, state')
 196          in case reader state of
 197             NONE => NONE
 198           | SOME (c, state) =>
 199                case charToWDigit radix c of
 200                   NONE => NONE
 201                 | SOME n => loop (n, state)
 202          end
 203
 204       fun digitToChar (n: int): char = String.sub ("0123456789ABCDEF", n)
 205    end