src/Pure/ML/ml_pretty.ML
changeset 62508 d0b68218ea55
parent 62503 19afb533028e
child 62661 c23ff2f45a18
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/Pure/ML/ml_pretty.ML	Thu Mar 03 21:59:21 2016 +0100
     1.3 @@ -0,0 +1,84 @@
     1.4 +(*  Title:      Pure/ML/ml_pretty.ML
     1.5 +    Author:     Makarius
     1.6 +
     1.7 +Minimal support for raw ML pretty printing, notably for toplevel pp.
     1.8 +*)
     1.9 +
    1.10 +signature ML_PRETTY =
    1.11 +sig
    1.12 +  datatype pretty =
    1.13 +    Block of (string * string) * bool * FixedInt.int * pretty list |
    1.14 +    String of string * FixedInt.int |
    1.15 +    Break of bool * FixedInt.int * FixedInt.int
    1.16 +  val block: pretty list -> pretty
    1.17 +  val str: string -> pretty
    1.18 +  val brk: FixedInt.int -> pretty
    1.19 +  val pair: ('a * int -> pretty) -> ('b * int -> pretty) -> ('a * 'b) * int -> pretty
    1.20 +  val enum: string -> string -> string -> ('a * int -> pretty) -> 'a list * int -> pretty
    1.21 +  val to_polyml: pretty -> PolyML.pretty
    1.22 +  val from_polyml: PolyML.pretty -> pretty
    1.23 +end;
    1.24 +
    1.25 +structure ML_Pretty: ML_PRETTY =
    1.26 +struct
    1.27 +
    1.28 +datatype pretty =
    1.29 +  Block of (string * string) * bool * FixedInt.int * pretty list |
    1.30 +  String of string * FixedInt.int |
    1.31 +  Break of bool * FixedInt.int * FixedInt.int;
    1.32 +
    1.33 +fun block prts = Block (("", ""), false, 2, prts);
    1.34 +fun str s = String (s, FixedInt.fromInt (size s));
    1.35 +fun brk width = Break (false, width, 0);
    1.36 +
    1.37 +fun pair pretty1 pretty2 ((x, y), depth: FixedInt.int) =
    1.38 +  block [str "(", pretty1 (x, depth), str ",", brk 1, pretty2 (y, depth - 1), str ")"];
    1.39 +
    1.40 +fun enum sep lpar rpar pretty (args, depth: FixedInt.int) =
    1.41 +  let
    1.42 +    fun elems _ [] = []
    1.43 +      | elems 0 _ = [str "..."]
    1.44 +      | elems d [x] = [pretty (x, d)]
    1.45 +      | elems d (x :: xs) = pretty (x, d) :: str sep :: brk 1 :: elems (d - 1) xs;
    1.46 +  in block (str lpar :: (elems (FixedInt.max (depth, 0)) args @ [str rpar])) end;
    1.47 +
    1.48 +
    1.49 +(* convert *)
    1.50 +
    1.51 +fun to_polyml (Break (false, width, offset)) = PolyML.PrettyBreak (width, offset)
    1.52 +  | to_polyml (Break (true, _, _)) =
    1.53 +      PolyML.PrettyBlock (0, false, [PolyML.ContextProperty ("fbrk", "")],
    1.54 +        [PolyML.PrettyString " "])
    1.55 +  | to_polyml (Block ((bg, en), consistent, ind, prts)) =
    1.56 +      let val context =
    1.57 +        (if bg = "" then [] else [PolyML.ContextProperty ("begin", bg)]) @
    1.58 +        (if en = "" then [] else [PolyML.ContextProperty ("end", en)])
    1.59 +      in PolyML.PrettyBlock (ind, consistent, context, map to_polyml prts) end
    1.60 +  | to_polyml (String (s, len)) =
    1.61 +      if len = FixedInt.fromInt (size s) then PolyML.PrettyString s
    1.62 +      else
    1.63 +        PolyML.PrettyBlock
    1.64 +          (0, false,
    1.65 +            [PolyML.ContextProperty ("length", FixedInt.toString len)], [PolyML.PrettyString s]);
    1.66 +
    1.67 +val from_polyml =
    1.68 +  let
    1.69 +    fun convert _ (PolyML.PrettyBreak (width, offset)) = Break (false, width, offset)
    1.70 +      | convert _ (PolyML.PrettyBlock (_, _,
    1.71 +            [PolyML.ContextProperty ("fbrk", _)], [PolyML.PrettyString " "])) =
    1.72 +          Break (true, 1, 0)
    1.73 +      | convert len (PolyML.PrettyBlock (ind, consistent, context, prts)) =
    1.74 +          let
    1.75 +            fun property name default =
    1.76 +              (case List.find (fn PolyML.ContextProperty (a, _) => name = a | _ => false) context of
    1.77 +                SOME (PolyML.ContextProperty (_, b)) => b
    1.78 +              | _ => default);
    1.79 +            val bg = property "begin" "";
    1.80 +            val en = property "end" "";
    1.81 +            val len' = property "length" len;
    1.82 +          in Block ((bg, en), consistent, ind, map (convert len') prts) end
    1.83 +      | convert len (PolyML.PrettyString s) =
    1.84 +          String (s, FixedInt.fromInt (case Int.fromString len of SOME i => i | NONE => size s))
    1.85 +  in convert "" end;
    1.86 +
    1.87 +end;