lib/mlton/basic/format.sml

   1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 (*
   9  * This is based on
  10  *   Functional Unparsing
  11  *   BRICS Technical Report RS 98-12
  12  *   Olivier Danvy, May 1998
  13  *)
  14
  15 structure Format:> FORMAT =
  16 struct
  17
  18 type ('a, 'b) t = (string list -> 'a) * string list -> 'b
  19
  20 val new: ('b -> string) -> ('a, 'b -> 'a) t =
  21    fn toString => fn (k, ss) => fn b => k (toString b :: ss)
  22
  23 val lit: string -> ('a, 'a) t = fn s => fn (k, ss) => k (s :: ss)
  24
  25 val eol: ('a, 'a) t = fn z => lit "\n" z
  26
  27 (* val concat =
  28  *    Trace.trace ("Format.concat", List.layout String.layout, String.layout) concat
  29  *)
  30
  31 val format: (string, 'a) t -> 'a = fn f => f (concat o rev, [])
  32
  33 val int: ('a, int -> 'a) t = fn z => new Int.toString z
  34
  35 val list: ('a, 'b -> 'a) t -> ('a, 'b list -> 'a) t =
  36    fn f => fn (k, ss) =>
  37    fn [] => k ("[]" :: ss)
  38     | x :: xs =>
  39          let
  40             fun loop xs ss =
  41                case xs of
  42                   [] => k ("]" :: ss)
  43                 | x :: xs => f (loop xs, ", " :: ss) x
  44          in f (loop xs, "[" :: ss) x
  45          end
  46
  47 val op o: ('a, 'b) t * ('c, 'a) t -> ('c, 'b) t =
  48    fn (f, g) => fn (k, ss) => f (fn ss => g (k, ss), ss)
  49
  50 val string: ('a, string -> 'a) t = fn z => new (fn s => s) z
  51
  52 end