src/Pure/ML/ml_pretty.ML
author wenzelm
Thu Mar 17 13:44:18 2016 +0100 (2016-03-17)
changeset 62661 c23ff2f45a18
parent 62508 d0b68218ea55
child 62662 291cc01f56f5
permissions -rw-r--r--
clarified modules;
wenzelm@62508
     1
(*  Title:      Pure/ML/ml_pretty.ML
wenzelm@30622
     2
    Author:     Makarius
wenzelm@30622
     3
wenzelm@62503
     4
Minimal support for raw ML pretty printing, notably for toplevel pp.
wenzelm@30622
     5
*)
wenzelm@30622
     6
wenzelm@62503
     7
signature ML_PRETTY =
wenzelm@62503
     8
sig
wenzelm@62503
     9
  datatype pretty =
wenzelm@62503
    10
    Block of (string * string) * bool * FixedInt.int * pretty list |
wenzelm@62503
    11
    String of string * FixedInt.int |
wenzelm@62503
    12
    Break of bool * FixedInt.int * FixedInt.int
wenzelm@62503
    13
  val block: pretty list -> pretty
wenzelm@62503
    14
  val str: string -> pretty
wenzelm@62503
    15
  val brk: FixedInt.int -> pretty
wenzelm@62503
    16
  val pair: ('a * int -> pretty) -> ('b * int -> pretty) -> ('a * 'b) * int -> pretty
wenzelm@62503
    17
  val enum: string -> string -> string -> ('a * int -> pretty) -> 'a list * int -> pretty
wenzelm@62503
    18
  val to_polyml: pretty -> PolyML.pretty
wenzelm@62503
    19
  val from_polyml: PolyML.pretty -> pretty
wenzelm@62661
    20
  val get_print_depth: unit -> int
wenzelm@62661
    21
  val print_depth: int -> unit
wenzelm@62503
    22
end;
wenzelm@62503
    23
wenzelm@62503
    24
structure ML_Pretty: ML_PRETTY =
wenzelm@30622
    25
struct
wenzelm@30622
    26
wenzelm@62661
    27
(* datatype pretty *)
wenzelm@62661
    28
wenzelm@30622
    29
datatype pretty =
wenzelm@62387
    30
  Block of (string * string) * bool * FixedInt.int * pretty list |
wenzelm@62387
    31
  String of string * FixedInt.int |
wenzelm@62387
    32
  Break of bool * FixedInt.int * FixedInt.int;
wenzelm@30622
    33
wenzelm@61869
    34
fun block prts = Block (("", ""), false, 2, prts);
wenzelm@62387
    35
fun str s = String (s, FixedInt.fromInt (size s));
wenzelm@61862
    36
fun brk width = Break (false, width, 0);
wenzelm@38635
    37
wenzelm@62387
    38
fun pair pretty1 pretty2 ((x, y), depth: FixedInt.int) =
wenzelm@38635
    39
  block [str "(", pretty1 (x, depth), str ",", brk 1, pretty2 (y, depth - 1), str ")"];
wenzelm@38635
    40
wenzelm@62387
    41
fun enum sep lpar rpar pretty (args, depth: FixedInt.int) =
wenzelm@38635
    42
  let
wenzelm@38635
    43
    fun elems _ [] = []
wenzelm@38635
    44
      | elems 0 _ = [str "..."]
wenzelm@38635
    45
      | elems d [x] = [pretty (x, d)]
wenzelm@38635
    46
      | elems d (x :: xs) = pretty (x, d) :: str sep :: brk 1 :: elems (d - 1) xs;
wenzelm@62387
    47
  in block (str lpar :: (elems (FixedInt.max (depth, 0)) args @ [str rpar])) end;
wenzelm@38635
    48
wenzelm@62503
    49
wenzelm@62503
    50
(* convert *)
wenzelm@62503
    51
wenzelm@62503
    52
fun to_polyml (Break (false, width, offset)) = PolyML.PrettyBreak (width, offset)
wenzelm@62503
    53
  | to_polyml (Break (true, _, _)) =
wenzelm@62503
    54
      PolyML.PrettyBlock (0, false, [PolyML.ContextProperty ("fbrk", "")],
wenzelm@62503
    55
        [PolyML.PrettyString " "])
wenzelm@62503
    56
  | to_polyml (Block ((bg, en), consistent, ind, prts)) =
wenzelm@62503
    57
      let val context =
wenzelm@62503
    58
        (if bg = "" then [] else [PolyML.ContextProperty ("begin", bg)]) @
wenzelm@62503
    59
        (if en = "" then [] else [PolyML.ContextProperty ("end", en)])
wenzelm@62503
    60
      in PolyML.PrettyBlock (ind, consistent, context, map to_polyml prts) end
wenzelm@62503
    61
  | to_polyml (String (s, len)) =
wenzelm@62503
    62
      if len = FixedInt.fromInt (size s) then PolyML.PrettyString s
wenzelm@62503
    63
      else
wenzelm@62503
    64
        PolyML.PrettyBlock
wenzelm@62503
    65
          (0, false,
wenzelm@62503
    66
            [PolyML.ContextProperty ("length", FixedInt.toString len)], [PolyML.PrettyString s]);
wenzelm@62503
    67
wenzelm@62503
    68
val from_polyml =
wenzelm@62503
    69
  let
wenzelm@62503
    70
    fun convert _ (PolyML.PrettyBreak (width, offset)) = Break (false, width, offset)
wenzelm@62503
    71
      | convert _ (PolyML.PrettyBlock (_, _,
wenzelm@62503
    72
            [PolyML.ContextProperty ("fbrk", _)], [PolyML.PrettyString " "])) =
wenzelm@62503
    73
          Break (true, 1, 0)
wenzelm@62503
    74
      | convert len (PolyML.PrettyBlock (ind, consistent, context, prts)) =
wenzelm@62503
    75
          let
wenzelm@62503
    76
            fun property name default =
wenzelm@62503
    77
              (case List.find (fn PolyML.ContextProperty (a, _) => name = a | _ => false) context of
wenzelm@62503
    78
                SOME (PolyML.ContextProperty (_, b)) => b
wenzelm@62503
    79
              | _ => default);
wenzelm@62503
    80
            val bg = property "begin" "";
wenzelm@62503
    81
            val en = property "end" "";
wenzelm@62503
    82
            val len' = property "length" len;
wenzelm@62503
    83
          in Block ((bg, en), consistent, ind, map (convert len') prts) end
wenzelm@62503
    84
      | convert len (PolyML.PrettyString s) =
wenzelm@62503
    85
          String (s, FixedInt.fromInt (case Int.fromString len of SOME i => i | NONE => size s))
wenzelm@62503
    86
  in convert "" end;
wenzelm@62503
    87
wenzelm@62661
    88
wenzelm@62661
    89
(* default print depth *)
wenzelm@62661
    90
wenzelm@62661
    91
local
wenzelm@62661
    92
  val depth = Unsynchronized.ref 0;
wenzelm@62661
    93
in
wenzelm@62661
    94
  fun get_print_depth () = ! depth;
wenzelm@62661
    95
  fun print_depth n = (depth := n; PolyML.print_depth n);
wenzelm@62661
    96
  val _ = print_depth 10;
wenzelm@30622
    97
end;
wenzelm@62661
    98
wenzelm@62661
    99
end;