hphp/hack/src/parser/limited_width_pretty_printing_library.ml

   1 (*
   2  * Copyright (c) 2016, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 (* implementation of pretty printing library based on Philip Wadler's paper
  11  * titled "A Prettier Printer", and the strict ocaml implementation based on
  12  * Christian Lindig's paper "Strictly Pretty" *)
  13 open Pretty_printing_library_sig
  14
  15 module type LineSpec = sig
  16   val line_width : int
  17 end
  18
  19 (* comparator using line width as constraint *)
  20 module WidthConstrainedDocComparator (C : LineSpec) : DocCompare = struct
  21   type t = doc
  22
  23   type mode =
  24     | Flat
  25     | Vert
  26
  27   let strlen = String.length
  28
  29   let line_width = C.line_width
  30
  31   (* implementation as specified in the Prettier Printer paper *)
  32   (* width is the constraint, and k is the number of chars already occupied *)
  33   let rec format width k = function
  34     | [] -> LNil
  35     | (_i, _m, Nil) :: tl -> format width k tl
  36     | (i, m, Cons (x, y)) :: tl -> format width k ((i, m, x) :: (i, m, y) :: tl)
  37     | (i, m, Nest (j, x)) :: tl -> format width k ((i + j, m, x) :: tl)
  38     | (_i, _m, Text s) :: tl -> LText (s, format width (k + strlen s) tl)
  39     | (_i, Flat, Break s) :: tl -> LText (s, format width (k + strlen s) tl)
  40     | (i, Vert, Break _s) :: tl -> LLine (i, format width i tl)
  41     | (i, _m, MustBreak) :: tl -> LLine (i, format width i tl)
  42     (* "lazy evaluation". We expand group only at here.
  43      * Note also that only one of if and else will be executed *)
  44     | (i, _m, Group x) :: tl ->
  45       if fits (width - k) ((i, Flat, x) :: tl) && not (must_break x) then
  46         format width k ((i, Flat, x) :: tl)
  47       else
  48         format width k ((i, Vert, x) :: tl)
  49
  50   (* recursively check that the subgroup fits in the given width
  51    * "Fit" is checked by seeing that the document being expanded
  52    * horizontally can stay in one line within the width limit, unitil
  53    * a known newline is seen *)
  54   and fits w = function
  55     | _ when w < 0 -> false
  56     | [] -> true
  57     | (_i, _m, Nil) :: tl -> fits w tl
  58     | (i, m, Cons (x, y)) :: tl -> fits w ((i, m, x) :: (i, m, y) :: tl)
  59     | (i, m, Nest (j, x)) :: tl -> fits w ((i + j, m, x) :: tl)
  60     | (_i, _m, Text s) :: tl -> fits (w - strlen s) tl
  61     | (_i, Flat, Break s) :: tl -> fits (w - strlen s) tl
  62     | (_i, Vert, Break _) :: _tl -> true
  63     | (_i, _m, MustBreak) :: _tl -> true
  64     (* See flatten in Wadler's paper. Entire document is flattened *)
  65     | (i, _m, Group x) :: tl -> fits w ((i, Flat, x) :: tl)
  66
  67   (* returns true if the doc expands to contain a Mustbreak. If it does, then
  68    * we know that all breaks in this part of the doc have to be newlines *)
  69   and must_break x =
  70     let rec aux_must_break = function
  71       | [] -> false
  72       | Nil :: tl -> aux_must_break tl
  73       | Cons (x, y) :: tl -> aux_must_break (x :: y :: tl)
  74       | Nest (_j, x) :: tl -> aux_must_break (x :: tl)
  75       | Text _ :: tl -> aux_must_break tl
  76       | Break _ :: tl -> aux_must_break tl
  77       | MustBreak :: _tl -> true
  78       | Group x :: tl -> aux_must_break (x :: tl)
  79     in
  80     aux_must_break [x]
  81
  82   let best k doc = format line_width k [(0, Flat, Group doc)]
  83 end