Pretty printing ASTs

The AST

type const = Int of int | String of string

type pattern = Any | Var of string | Const of const

type expr =
  | Const of const
  | Var of string
  | Let of string * expr * expr
  | Match of expr * (pattern * expr) list

Some example programs

Which will also serve as test cases for our printing-combinators:

let small_test =
  Let ("x",
       Match (Var "free", [ Const (String "foo"), Const (Int 0)
                          ; Any, Const (Int 42) ]),
       Var "x"
      )

let test =
  Let ("some_longer_variable_name",
       Match (Var "free", [ Const (String "foo"), Const (Int 0)
                          ; Any, Const (Int 42) ]),
       Var "some_longer_variable_name"
      )

let large_test =
  Let (
    "x",
    Match (
      Var "free",
      [ Const (String "foo bar lol"), Const (String "ok")
      ; Const (String "bar baz test"), Const (String "ko")
      ; Var "otherwise_a_very_long_var_name",
        Var "otherwise_a_very_long_var_name"
      ; Var "otherwise_a_very_very_very_very_very_very_very_long_var_name",
        Var "otherwise_a_very_very_very_very_very_very_very_long_var_name" ]
    ),
    Var "x"
  )

Defining our printing combinators

open PPrint

Basic blocks

Constants and variables aren't very interesting: they are just atomic documents as already seen in A taste of the layout language.

let print_const = function
  | Int i -> string (string_of_int i)
  | String s -> dquote ^^ string s ^^ dquote

let print_var s = string s

Complex structures

The Let and Match constructs are more interesting, there is a variety of ways we could display them: as compactly as possible, with as many spaces as possible, etc.

The Let construct

Here we are aiming for a middle ground:

• if the whole construct fits on one line, then do so
• if it doesn't, then the lhs, the bound expression, the in keyword and the body should be on different lines. Note that in this case we want the bound expression to be indented.
• finally, if the left-hand side doesn't fit on one line, then the let, the name and the = should also be on different lines.

This can be expressed with the following grouping and nesting structure:

let rec print_let binding_name bound_expr body =
  (* TODO(explain): if I don't add this group around everything, lets are
     never printed on one line, even tiny ones... *)
  group (
    group (string "let" ^/^ string binding_name ^/^ string "=") ^^
    (nest 2 (break 1 ^^ group (print_expr bound_expr)))
    ^/^ string "in" ^/^ group (print_expr body)
  )

The Match construct

Once again: we fit the whole match on one line if we can, omitting the pipe before the first pattern then, or we put each case on a separate line :

and print_match arg cases =
    group (
      string "match" ^^
      nest 2 (break 1 ^^ group (print_expr arg)) ^/^
      string "with"
    ) ^^
    ifflat space (hardline ^^ string "| ") ^^
    separate_map (break 1 ^^ string "| ") print_case cases

To display cases, we follow the same idea: if it doesn't fit on one line, we put the body on a different line, and indent it by 4 spaces.

However, if the left-hand-side itself doesn't fit on one line, we want to put the arrow on its own line, but indent it only by 2 spaces.

In the end, the code looks like this:

and print_case (pat, exp) =
  let open PPrint in
  nest 2 
    (prefix 2 1
       (group ((print_pattern pat) ^/^ (string "->")))
       (print_expr exp))

Putting it all together

and print_pattern = function
  | Any -> underscore
  | Var s -> print_var s
  | Const c -> print_const c

and print_expr = function
  | Const c -> print_const c
  | Var s -> print_var s
  | Let (name, e1, e2) -> print_let name e1 e2
  | Match (arg, cases) -> print_match arg cases

Doing the actual printing

TODO: Clearly I haven't understood how the ribbon is working; while I should read the paper, not every user is going to want to do that, and we should probably provide some more explanation here.

let () =
  PPrint.ToChannel.pretty 10. 60 stdout (print_expr small_test);
  print_newline ();
  print_newline ();
  PPrint.ToChannel.pretty 10. 60 stdout (print_expr test);
  print_newline ();
  print_newline ();
  PPrint.ToChannel.pretty 10. 60 stdout (print_expr large_test);
  print_newline ();
  flush stdout

The result

let x = match free with "foo" -> 0 | _ -> 42 in x

let some_longer_variable_name =
  match free with "foo" -> 0 | _ -> 42
in
some_longer_variable_name

let x =
  match free with
  | "foo bar lol" -> "ok"
  | "bar baz test" -> "ko"
  | otherwise_a_very_long_var_name ->
      otherwise_a_very_long_var_name
  | otherwise_a_very_very_very_very_very_very_very_long_var_name
    ->
      otherwise_a_very_very_very_very_very_very_very_long_var_name
in
x