regression/format.sml

   1 (*
   2  * This is based on
   3  *   Functional Unparsing
   4  *   BRICS Technical Report RS 98-12
   5  *   Olivier Danvy, May 1998
   6  *)
   7
   8 signature FORMAT =
   9    sig
  10       type ('a, 'b) t
  11
  12       val eol: ('a, 'a) t
  13       val format: (string, 'a) t -> 'a
  14       val int: ('a, int -> 'a) t
  15       val list: ('a, 'b -> 'a) t -> ('a, 'b list -> 'a) t
  16       val lit: string -> ('a, 'a) t
  17       val new: ('b -> string) -> ('a, 'b -> 'a) t
  18       val o: ('a, 'b) t * ('c, 'a) t -> ('c, 'b) t
  19       val string: ('a, string -> 'a) t
  20    end
  21
  22 structure Format:> FORMAT =
  23 struct
  24
  25 type ('a, 'b) t = (string list -> 'a) * string list -> 'b
  26
  27 val new: ('b -> string) -> ('a, 'b -> 'a) t =
  28    fn toString => fn (k, ss) => fn b => k (toString b :: ss)
  29
  30 val lit: string -> ('a, 'a) t = fn s => fn (k, ss) => k (s :: ss)
  31
  32 val eol: ('a, 'a) t = fn z => lit "\n" z
  33
  34 val format: (string, 'a) t -> 'a = fn f => f (concat o rev, [])
  35
  36 val int: ('a, int -> 'a) t = fn z => new Int.toString z
  37
  38 val list: ('a, 'b -> 'a) t -> ('a, 'b list -> 'a) t =
  39    fn f => fn (k, ss) =>
  40    fn [] => k ("[]" :: ss)
  41     | x :: xs =>
  42          let
  43             fun loop xs ss =
  44                case xs of
  45                   [] => k ("]" :: ss)
  46                 | x :: xs => f (loop xs, ", " :: ss) x
  47          in f (loop xs, "[" :: ss) x
  48          end
  49
  50 val op o: ('a, 'b) t * ('c, 'a) t -> ('c, 'b) t =
  51    fn (f, g) => fn (k, ss) => f (fn ss => g (k, ss), ss)
  52
  53 val string: ('a, string -> 'a) t = fn z => new (fn s => s) z
  54
  55 end
  56
  57 open Format
  58
  59 val _ =
  60    if
  61       "abc" = format (lit "abc")
  62       andalso "abc" = format string "abc"
  63       andalso "abc" = format (lit "a" o lit "b" o lit "c")
  64       andalso "abc" = format (string o string o string) "a" "b" "c"
  65       andalso "[a, b, c]" = format (list string) ["a", "b", "c"]
  66       andalso "[1, 2, 3]" = format (list int) [1, 2, 3]
  67       then ()
  68    else raise Fail "bug"