PPrintAux.ml 1.97 KB
Newer Older
POTTIER Francois's avatar
POTTIER Francois committed
1 2 3 4 5 6 7 8 9 10 11
open PPrint

(* -------------------------------------------------------------------------- *)

(* A block with indentation. *)

let indentation = 2

let block opening contents closing =
  group (opening ^^ nest indentation (contents) ^^ closing)

POTTIER Francois's avatar
POTTIER Francois committed
12 13 14 15 16 17 18 19 20
(* -------------------------------------------------------------------------- *)

(* Bindings, or annotations: [x : t]. *)

let spacecolon =
  string " :"

let binding x t =
  block (x ^^ spacecolon) (space ^^ t) empty
21

POTTIER Francois's avatar
POTTIER Francois committed
22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
(* -------------------------------------------------------------------------- *)

(* Parentheses with indentation. *)

(* We allow breaking a parenthesized thing into several lines by leaving the
   opening and closing parentheses alone on a line and indenting the content. *)

let parens d =
  block
    lparen
    (break 0 ^^ d)
    (break 0 ^^ rparen)

(* -------------------------------------------------------------------------- *)

(* Lambda-calculus application. *)

let app d1 d2 =
  (* The following definition would reject a large argument on a line of
     its own, indented: *)
  (* group (d1 ^^ nest indentation (break 1 ^^ d2)) *)
  (* However, that would be redundant with the fact that large arguments
     are usually parenthesized, and we already break lines and indent
     within the parentheses. So, the following suffices: *)
  group (d1 ^^ space ^^ d2)

(* -------------------------------------------------------------------------- *)

(* Running a buffer printer in a fresh buffer, and sending the result to an
   output channel. *)

let run (oc : out_channel) (print : Buffer.t -> 'a -> unit) (x : 'a) =
  let b = Buffer.create 1024 in
  print b x;
  Buffer.output_buffer oc b

(* -------------------------------------------------------------------------- *)

(* Printing a document into an output channel, with fixed parameters. *)

let output (oc : out_channel) (d : document) =
  run oc (PPrintEngine.ToBuffer.pretty 0.9 80) d
64 65 66 67

let adapt (f : 'a -> document) : out_channel -> 'a -> unit =
  fun oc x ->
    output oc (f x)