[MLton] Scanf

[Vesa Karvonen]

While on a train to Kajaani (>7 hours - argh) today, I wrote an experimental
Scanf implementation. It is still quite unpolished and I've only implemented
two conversion specifiers (D and G). I plan to improve it over the weekend,
but I thought that even the raw version might give something to think about
while bootstrapping MLton. ;-)

The syntax is similar to the alternative Printf:

  scanf <source> (<conversion-specifier> <arg>*)* ($ | >>)

The <source> must be a pair of the type

   ('stream -> (char * 'stream) option) * 'stream

The $ terminator returns the product of the extracted elements and the
remaining stream, while >> passes the product to a function
(success continuation). For example,

  - let open Scanf in scanf (fromString "3 - 3.1") D`" - "G $ end ;
  val it = 3 & 3.1 & - : ((int,real) product,substring) product

and

  - let open Scanf in scanf (fromString "3 - 3.1") D`" - "G >> (fn x => x) end ;
  val it = 3 & 3.1 & - : ((int,real) product,substring) product

-Vesa Karvonen

fun id x = x
datatype ('a, 'b) product = & of 'a * 'b
infix &

(* this is just the same old alternative Printf *)
structure Printf =
   struct
      fun printf f = f id

      fun newCvt_0_1 toS m f =
          f (fn k => m (fn (g, s) => fn x1 => k (g, g (toS x1, s))))
      fun newCvt_1_0 toS m a1 f =
          f (fn k => m (fn (g, s) => k (g, g (toS a1, s))))
      fun newCvt_1_1 toS m a1 f =
          f (fn k => m (fn (g, s) => fn x1 => k (g, g (toS (a1, x1), s))))

      val $ = fn m => m (List.app print o rev o (fn (_, s) => s)) (op::, [])

      val $$ = fn m => m (fn (_, s) => concat (rev s)) (op::, [])

      val ` = fn z => newCvt_1_0 id z

      val C = fn z => newCvt_0_1 Char.toString z
      val D = fn z => newCvt_0_1 Int.toString z
      val G = fn z => newCvt_0_1 Real.toString z
      val S = fn z => newCvt_0_1 id z

      fun L cvt =
          fn z =>
             newCvt_0_1
                let fun loop ss =
                        fn [] => "[]"
                         | [v] => concat ("["::rev ("]"::printf cvt$$v::ss))
                         | v::vs => loop (", "::printf cvt$$v::ss) vs
                in loop [] end
                z
   end

structure Scanf =
   struct
      exception Scanf

      fun scanf (g, s) f = f (g, s, fn v => v)

      fun newCvt_0_1 scan (g, s, vs) f =
          case scan (g, s) of
             NONE => raise Scanf
           | SOME (v, s) =>
             f (g, s, let val vs = vs v in fn v => vs & v end)

      fun newCvt_1_0 scan (g, s, vs) a1 f =
          case scan (g, s, a1) of
             NONE => raise Scanf
           | SOME s =>
             f (g, s, vs)

      fun $ (g, s, vs) = vs s
      fun >> (g, s, vs) f = f (vs s)

      val ` = fn z => newCvt_1_0 (fn (g, s, s') =>
                                     let
                                        fun loop (s, s') =
                                            case g s & Substring.getc s' of
                                               SOME (c, s) & SOME (c', s') =>
                                               if c = c' then
                                                  loop (s, s')
                                               else
                                                  NONE
                                             | _ & NONE => SOME s
                                             | _ & SOME _ => NONE
                                     in
                                        loop (s, Substring.full s')
                                     end)
                                 z

      val D = fn z => newCvt_0_1 (fn (g, s) => Int.scan StringCvt.DEC g s) z
      val G = fn z => newCvt_0_1 (fn (g, s) => Real.scan g s) z

      fun fromString s = (Substring.getc, Substring.full s)
   end

val () =
    let open Scanf in
       scanf (fromString "An int 25 and a real 3.141\n")
             `"An int "D`" and a real "G`"\n" >> end
       let open Printf in
          fn i & r & _ =>
             printf `"Got an int "D`" and a real "G`".\n"$ i r end