2 * Copyright (c) 2016, Facebook, Inc.
5 * This source code is licensed under the MIT license found in the
6 * LICENSE file in the "hack" directory of this source tree.
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
15 module type LineSpec
= sig
19 (* comparator using line width as constraint *)
20 module WidthConstrainedDocComparator
(C
: LineSpec
) : DocCompare
= struct
27 let strlen = String.length
29 let line_width = C.line_width
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
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
)
48 format width k
((i
, Vert
, x
) :: tl
)
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 *)
55 | _
when w
< 0 -> false
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
)
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 *)
70 let rec aux_must_break = function
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
)
82 let best k doc
= format line_width k
[(0, Flat
, Group doc
)]