src/Pure/ML/ml_pretty.ML
author wenzelm
Sat Nov 04 15:24:40 2017 +0100 (20 months ago)
changeset 67003 49850a679c2c
parent 62900 c641bf9402fd
child 68918 3a0db30e5d87
permissions -rw-r--r--
more robust sorted_entries;
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@62784
    16
  val pair: ('a * FixedInt.int -> pretty) -> ('b * FixedInt.int -> pretty) ->
wenzelm@62784
    17
    ('a * 'b) * FixedInt.int -> pretty
wenzelm@62784
    18
  val enum: string -> string -> string -> ('a * FixedInt.int -> pretty) ->
wenzelm@62784
    19
    'a list * FixedInt.int -> pretty
wenzelm@62823
    20
  val to_polyml: pretty -> PolyML_Pretty.pretty
wenzelm@62823
    21
  val from_polyml: PolyML_Pretty.pretty -> pretty
wenzelm@62823
    22
  val format_polyml: int -> PolyML_Pretty.pretty -> string
wenzelm@62662
    23
  val format: int -> pretty -> string
wenzelm@62899
    24
  val default_margin: int
wenzelm@62899
    25
  val string_of_polyml: PolyML_Pretty.pretty -> string
wenzelm@62900
    26
  val make_string_fn: string
wenzelm@62503
    27
end;
wenzelm@62503
    28
wenzelm@62503
    29
structure ML_Pretty: ML_PRETTY =
wenzelm@30622
    30
struct
wenzelm@30622
    31
wenzelm@62661
    32
(* datatype pretty *)
wenzelm@62661
    33
wenzelm@30622
    34
datatype pretty =
wenzelm@62387
    35
  Block of (string * string) * bool * FixedInt.int * pretty list |
wenzelm@62387
    36
  String of string * FixedInt.int |
wenzelm@62387
    37
  Break of bool * FixedInt.int * FixedInt.int;
wenzelm@30622
    38
wenzelm@61869
    39
fun block prts = Block (("", ""), false, 2, prts);
wenzelm@62387
    40
fun str s = String (s, FixedInt.fromInt (size s));
wenzelm@61862
    41
fun brk width = Break (false, width, 0);
wenzelm@38635
    42
wenzelm@62387
    43
fun pair pretty1 pretty2 ((x, y), depth: FixedInt.int) =
wenzelm@38635
    44
  block [str "(", pretty1 (x, depth), str ",", brk 1, pretty2 (y, depth - 1), str ")"];
wenzelm@38635
    45
wenzelm@62387
    46
fun enum sep lpar rpar pretty (args, depth: FixedInt.int) =
wenzelm@38635
    47
  let
wenzelm@38635
    48
    fun elems _ [] = []
wenzelm@38635
    49
      | elems 0 _ = [str "..."]
wenzelm@38635
    50
      | elems d [x] = [pretty (x, d)]
wenzelm@38635
    51
      | elems d (x :: xs) = pretty (x, d) :: str sep :: brk 1 :: elems (d - 1) xs;
wenzelm@62387
    52
  in block (str lpar :: (elems (FixedInt.max (depth, 0)) args @ [str rpar])) end;
wenzelm@38635
    53
wenzelm@62503
    54
wenzelm@62503
    55
(* convert *)
wenzelm@62503
    56
wenzelm@62823
    57
fun to_polyml (Break (false, width, offset)) = PolyML_Pretty.PrettyBreak (width, offset)
wenzelm@62503
    58
  | to_polyml (Break (true, _, _)) =
wenzelm@62823
    59
      PolyML_Pretty.PrettyBlock (0, false, [PolyML_Pretty.ContextProperty ("fbrk", "")],
wenzelm@62823
    60
        [PolyML_Pretty.PrettyString " "])
wenzelm@62503
    61
  | to_polyml (Block ((bg, en), consistent, ind, prts)) =
wenzelm@62503
    62
      let val context =
wenzelm@62823
    63
        (if bg = "" then [] else [PolyML_Pretty.ContextProperty ("begin", bg)]) @
wenzelm@62823
    64
        (if en = "" then [] else [PolyML_Pretty.ContextProperty ("end", en)])
wenzelm@62823
    65
      in PolyML_Pretty.PrettyBlock (ind, consistent, context, map to_polyml prts) end
wenzelm@62503
    66
  | to_polyml (String (s, len)) =
wenzelm@62823
    67
      if len = FixedInt.fromInt (size s) then PolyML_Pretty.PrettyString s
wenzelm@62503
    68
      else
wenzelm@62823
    69
        PolyML_Pretty.PrettyBlock
wenzelm@62503
    70
          (0, false,
wenzelm@62823
    71
            [PolyML_Pretty.ContextProperty ("length", FixedInt.toString len)], [PolyML_Pretty.PrettyString s]);
wenzelm@62503
    72
wenzelm@62503
    73
val from_polyml =
wenzelm@62503
    74
  let
wenzelm@62823
    75
    fun convert _ (PolyML_Pretty.PrettyBreak (width, offset)) = Break (false, width, offset)
wenzelm@62823
    76
      | convert _ (PolyML_Pretty.PrettyBlock (_, _,
wenzelm@62823
    77
            [PolyML_Pretty.ContextProperty ("fbrk", _)], [PolyML_Pretty.PrettyString " "])) =
wenzelm@62503
    78
          Break (true, 1, 0)
wenzelm@62823
    79
      | convert len (PolyML_Pretty.PrettyBlock (ind, consistent, context, prts)) =
wenzelm@62503
    80
          let
wenzelm@62503
    81
            fun property name default =
wenzelm@62823
    82
              (case List.find (fn PolyML_Pretty.ContextProperty (a, _) => name = a | _ => false) context of
wenzelm@62823
    83
                SOME (PolyML_Pretty.ContextProperty (_, b)) => b
wenzelm@62503
    84
              | _ => default);
wenzelm@62503
    85
            val bg = property "begin" "";
wenzelm@62503
    86
            val en = property "end" "";
wenzelm@62503
    87
            val len' = property "length" len;
wenzelm@62503
    88
          in Block ((bg, en), consistent, ind, map (convert len') prts) end
wenzelm@62823
    89
      | convert len (PolyML_Pretty.PrettyString s) =
wenzelm@62503
    90
          String (s, FixedInt.fromInt (case Int.fromString len of SOME i => i | NONE => size s))
wenzelm@62503
    91
  in convert "" end;
wenzelm@62503
    92
wenzelm@62661
    93
wenzelm@62662
    94
(* format *)
wenzelm@62662
    95
wenzelm@62662
    96
fun format_polyml margin prt =
wenzelm@62662
    97
  let
wenzelm@62662
    98
    val result = Unsynchronized.ref [];
wenzelm@62662
    99
    val () = PolyML.prettyPrint (fn s => result := s :: ! result, margin) prt
wenzelm@62662
   100
  in String.concat (List.rev (! result)) end;
wenzelm@62662
   101
wenzelm@62662
   102
fun format margin = format_polyml margin o to_polyml;
wenzelm@62662
   103
wenzelm@62899
   104
val default_margin = 76;
wenzelm@62899
   105
wenzelm@62662
   106
wenzelm@62662
   107
(* make string *)
wenzelm@62662
   108
wenzelm@62899
   109
val string_of_polyml = format_polyml default_margin;
wenzelm@62662
   110
wenzelm@62900
   111
val make_string_fn =
wenzelm@62900
   112
  "(fn x => ML_Pretty.string_of_polyml (ML_system_pretty \
wenzelm@62900
   113
    \(x, FixedInt.fromInt (ML_Print_Depth.get_print_depth ()))))";
wenzelm@62662
   114
wenzelm@62661
   115
end;