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