add Containers_pp.newline_or_spaces

This commit is contained in:
Simon Cruanes 2023-11-13 13:27:20 -05:00
parent 94e9335c35
commit 1508b6c940
2 changed files with 30 additions and 12 deletions

View file

@ -37,7 +37,7 @@ type t = {
and view = and view =
| Nil | Nil
| Newline | Newline of int
| Nest of int * t | Nest of int * t
| Append of t * t | Append of t * t
| Char of char | Char of char
@ -52,7 +52,8 @@ and view =
let rec debug out (self : t) : unit = let rec debug out (self : t) : unit =
match self.view with match self.view with
| Nil -> Format.fprintf out "nil" | Nil -> Format.fprintf out "nil"
| Newline -> Format.fprintf out "nl" | Newline 1 -> Format.fprintf out "nl"
| Newline i -> Format.fprintf out "nl(%d)" i
| Nest (i, x) -> Format.fprintf out "(@[nest %d@ %a@])" i debug x | Nest (i, x) -> Format.fprintf out "(@[nest %d@ %a@])" i debug x
| Append (a, b) -> Format.fprintf out "@[%a ^@ %a@]" debug a debug b | Append (a, b) -> Format.fprintf out "@[%a ^@ %a@]" debug a debug b
| Char c -> Format.fprintf out "%C" c | Char c -> Format.fprintf out "%C" c
@ -65,7 +66,12 @@ let rec debug out (self : t) : unit =
| Wrap (_, _, d) -> Format.fprintf out "(@[ext@ %a@])" debug d | Wrap (_, _, d) -> Format.fprintf out "(@[ext@ %a@])" debug d
let nil : t = { view = Nil; wfl = 0 } let nil : t = { view = Nil; wfl = 0 }
let newline : t = { view = Newline; wfl = 1 } let newline : t = { view = Newline 1; wfl = 1 }
let newline_or_spaces n : t =
if n < 0 then invalid_arg "Containers_pp.newline_or_spaces";
{ view = Newline n; wfl = n }
let nl = newline let nl = newline
let char c = let char c =
@ -131,9 +137,13 @@ module Flatten = struct
let to_out (out : Out.t) (self : t) : unit = let to_out (out : Out.t) (self : t) : unit =
let rec loop (d : t) = let rec loop (d : t) =
match d.view with match d.view with
| Nil -> () | Nil | Newline 0 -> ()
| Char c -> out.char c | Char c -> out.char c
| Newline -> out.char ' ' | Newline 1 -> out.char ' '
| Newline n ->
for _i = 1 to n do
out.char ' '
done
| Nest (_, x) -> loop x | Nest (_, x) -> loop x
| Append (x, y) -> | Append (x, y) ->
loop x; loop x;
@ -175,13 +185,15 @@ module Pretty = struct
let rec pp_flatten (st : st) (self : t) : int = let rec pp_flatten (st : st) (self : t) : int =
match self.view with match self.view with
| Nil -> 0 | Nil | Newline 0 -> 0
| Char c -> | Char c ->
st.out.char c; st.out.char c;
1 1
| Newline -> | Newline n ->
st.out.char ' '; for _i = 1 to n do
1 st.out.char ' '
done;
n
| Nest (_i, x) -> pp_flatten st x | Nest (_i, x) -> pp_flatten st x
| Append (x, y) -> | Append (x, y) ->
let n = pp_flatten st x in let n = pp_flatten st x in
@ -229,15 +241,15 @@ module Pretty = struct
pp_rec_top st ~k ~i d (fun k -> pp_rec st k stack_tl) pp_rec_top st ~k ~i d (fun k -> pp_rec st k stack_tl)
(** Print [d] at indentation [i], with [k] chars already printed (** Print [d] at indentation [i], with [k] chars already printed
on the current line, then calls [kont] with the on the current line, then calls [kont] with the
new [k]. *) new [k]. *)
and pp_rec_top st ~k ~i d (kont : int -> unit) : unit = and pp_rec_top st ~k ~i d (kont : int -> unit) : unit =
match d.view with match d.view with
| Nil -> kont k | Nil -> kont k
| Char c -> | Char c ->
st.out.char c; st.out.char c;
kont (k + 1) kont (k + 1)
| Newline -> | Newline _ ->
pp_newline st i; pp_newline st i;
kont i kont i
| Nest (j, x) -> pp_rec_top st ~k ~i:(i + j) x kont | Nest (j, x) -> pp_rec_top st ~k ~i:(i + j) x kont

View file

@ -74,6 +74,12 @@ val append : t -> t -> t
val newline : t val newline : t
(** A line break. *) (** A line break. *)
val newline_or_spaces : int -> t
(** [newline_or_spaces n] either prints a newline (respecting indentation),
or prints [n] spaces. {!newline} is basically [newline_or_spaces 1].
@raise Invalid_argument if [n < 0].
@since NEXT_RELEASE *)
val nl : t val nl : t
(** Alias for {!newline} *) (** Alias for {!newline} *)