diff --git a/.ocamlformat b/.ocamlformat index c9862378..f820496c 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version = 0.22.4 +version = 0.24.1 profile=conventional margin=80 if-then-else=k-r diff --git a/Makefile b/Makefile index 9120f4c0..f77578bd 100644 --- a/Makefile +++ b/Makefile @@ -30,7 +30,7 @@ update_next_tag: sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) -WATCH?=@src/all @tests/runtest +WATCH?=@src/check @tests/runtest watch: @dune build $(WATCH) -w diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml new file mode 100644 index 00000000..f10a8f1e --- /dev/null +++ b/src/pp/containers_pp.ml @@ -0,0 +1,467 @@ +module B = Buffer + +module Out = struct + type t = { + char: char -> unit; + (** Output a single char. The char is assumed not to be ['\n']. *) + sub_string: string -> int -> int -> unit; + (** Output a string slice (optim for [string]) *) + string: string -> unit; (** Output a string *) + newline: unit -> unit; (** Output a newline *) + } + + let of_buffer (buf : Buffer.t) : t = + let char = B.add_char buf in + let sub_string = B.add_substring buf in + let string = B.add_string buf in + let newline () = B.add_char buf '\n' in + { char; sub_string; string; newline } + + let[@inline] char self c = self.char c + let[@inline] string self s = self.string s + let[@inline] sub_string self s i len = self.sub_string s i len + let[@inline] newline self = self.newline () +end + +module Ext = struct + type 'a t = { + pre: Out.t -> 'a -> unit; (** Printed before the wrapped value. *) + post: Out.t -> 'a -> unit; (** Printed after the wrapped value. *) + } +end + +type t = { + view: view; (** Document view *) + wfl: int; (** Width if flattened *) +} + +and view = + | Nil + | Newline + | Nest of int * t + | Append of t * t + | Char of char + | Text of string + | Text_sub of string * int * int + | Text_zero_width of string + | Group of t + | Fill of { sep: t; l: t list } + | Wrap : 'a Ext.t * 'a * t -> view + +(* debug printer *) +let rec debug out (self : t) : unit = + match self.view with + | Nil -> Format.fprintf out "nil" + | Newline -> Format.fprintf out "nl" + | Nest (i, x) -> Format.fprintf out "(@[nest %d@ %a@])" i debug x + | Append (a, b) -> Format.fprintf out "@[%a ^@ %a@]" debug a debug b + | Char c -> Format.fprintf out "%C" c + | Text s -> Format.fprintf out "%S" s + | Text_zero_width s -> Format.fprintf out "(zw %S)" s + | Text_sub (s, i, len) -> Format.fprintf out "%S" (String.sub s i len) + | Group d -> Format.fprintf out "(@[group@ %a@])" debug d + | Fill { sep = _; l } -> + Format.fprintf out "(@[fill@ %a@])" (Format.pp_print_list debug) l + | Wrap (_, _, d) -> Format.fprintf out "(@[ext@ %a@])" debug d + +let nil : t = { view = Nil; wfl = 0 } +let newline : t = { view = Newline; wfl = 1 } +let nl = newline + +let char c = + if c = '\n' then + nl + else + { view = Char c; wfl = 1 } + +let nest i x : t = + match x.view with + | _ when i <= 0 -> x + | Nil -> nil + | _ -> { view = Nest (i, x); wfl = x.wfl } + +let append a b : t = + match a.view, b.view with + | Nil, _ -> b + | _, Nil -> a + | _ -> { view = Append (a, b); wfl = a.wfl + b.wfl } + +let group d : t = + match d.view with + | Nil -> nil + | Group _ -> d + | _ -> { view = Group d; wfl = d.wfl } + +let ext ext v d : t = { view = Wrap (ext, v, d); wfl = d.wfl } +let ( ^ ) = append +let text_sub_ s i len : t = { view = Text_sub (s, i, len); wfl = len } + +(* Turn [str], which contains some newlines, into a document. + We make a concatenation of + each line's content followed by a newline. + Then we group the result so that it remains in a unified block. *) +let split_text_ (str : string) : t = + let cur = ref nil in + let i = ref 0 in + let len = String.length str in + while !i < len do + match String.index_from str !i '\n' with + | exception Not_found -> + (* last chunk *) + if !i + 1 < len then cur := !cur ^ text_sub_ str !i (len - !i); + i := len + | j -> + cur := !cur ^ text_sub_ str !i (j - !i) ^ nl; + i := j + 1 + done; + !cur + +let text (str : string) : t = + if str = "" then + nil + else if String.contains str '\n' then + split_text_ str + else + { view = Text str; wfl = String.length str } + +let textpf fmt = Printf.ksprintf text fmt +let textf fmt = Format.kasprintf text fmt + +module Flatten = struct + let to_out (out : Out.t) (self : t) : unit = + let rec loop (d : t) = + match d.view with + | Nil -> () + | Char c -> out.char c + | Newline -> out.char ' ' + | Nest (_, x) -> loop x + | Append (x, y) -> + loop x; + loop y + | Text s | Text_zero_width s -> out.string s + | Text_sub (s, i, len) -> out.sub_string s i len + | Group x -> loop x + | Fill { sep; l } -> + List.iteri + (fun i x -> + if i > 0 then loop sep; + loop x) + l + | Wrap (ext, v, d) -> + ext.pre out v; + loop d; + ext.post out v + in + loop self + + let to_buffer buf (self : t) : unit = + let out = Out.of_buffer buf in + to_out out self + + let to_string self : string = + let buf = Buffer.create 32 in + to_buffer buf self; + Buffer.contents buf +end + +module Pretty = struct + type st = { out: Out.t; width: int } + + (** Add [i] spaces of indentation. *) + let add_indent st (i : int) = + for _i = 1 to i do + st.out.char ' ' + done + + let rec pp_flatten (st : st) (self : t) : int = + match self.view with + | Nil -> 0 + | Char c -> + st.out.char c; + 1 + | Newline -> + st.out.char ' '; + 1 + | Nest (_i, x) -> pp_flatten st x + | Append (x, y) -> + let n = pp_flatten st x in + n + pp_flatten st y + | Text s -> + st.out.string s; + String.length s + | Text_zero_width s -> + st.out.string s; + 0 + | Text_sub (s, i, len) -> + st.out.sub_string s i len; + len + | Group x -> pp_flatten st x + | Fill { sep; l } -> + (* print separated by spaces *) + let n = ref 0 in + List.iteri + (fun i x -> + if i > 0 then n := !n + pp_flatten st sep; + n := !n + pp_flatten st x) + l; + !n + | Wrap (ext, v, d) -> + ext.pre st.out v; + let n = pp_flatten st d in + ext.post st.out v; + n + + (** Does [x] fit in the current line when flattened, given that [k] chars + are already on the line? *) + let[@inline] fits_flattened st k x = x.wfl <= st.width - k + + let pp_newline (st : st) i = + st.out.char '\n'; + add_indent st i + + (** Print [self] into the buffer. + @param k how many chars are already printed on the current line + *) + let rec pp_rec (st : st) (k : int) (stack : (int * t) list) : unit = + match stack with + | [] -> () + | (i, d) :: 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 + on the current line, then calls [kont] with the + new [k]. *) + and pp_rec_top st ~k ~i d (kont : int -> unit) : unit = + match d.view with + | Nil -> kont k + | Char c -> + st.out.char c; + kont (k + 1) + | Newline -> + pp_newline st i; + kont i + | Nest (j, x) -> pp_rec_top st ~k ~i:(i + j) x kont + | Append (x, y) -> + (* print [x], then print [y] *) + pp_rec_top st ~k ~i x (fun k -> pp_rec_top st ~k ~i y kont) + | Text s -> + st.out.string s; + kont (k + String.length s) + | Text_zero_width s -> + st.out.string s; + kont k + | Text_sub (s, i, len) -> + st.out.sub_string s i len; + kont (k + len) + | Group x -> + if fits_flattened st k x then ( + (* print flattened *) + let w_x = pp_flatten st x in + assert (w_x = x.wfl); + kont (k + w_x) + ) else + pp_rec_top st ~k ~i x kont + | Fill { sep; l } -> pp_fill st ~k ~i sep l kont + | Wrap (ext, v, d) -> + ext.pre st.out v; + pp_rec_top st ~k ~i d (fun k -> + ext.post st.out v; + kont k) + + and pp_fill st ~k ~i sep l (kont : int -> unit) : unit = + (* [k] is the current offset in the line *) + let rec loop idx k l = + match l with + | x :: tl -> + if fits_flattened st k x then ( + (* all flattened *) + let w_sep = + if idx = 0 then + 0 + else + pp_flatten st sep + in + let w_x = pp_flatten st x in + assert (w_x = x.wfl); + loop (idx + 1) (k + w_x + w_sep) tl + ) else ( + (* print, followed by a newline and resume filling with [k=i] *) + let pp_and_continue k = + pp_rec_top st ~k ~i x (fun k -> loop (idx + 1) k tl) + in + if idx > 0 then + (* separator, then item *) + pp_rec_top st ~k ~i sep pp_and_continue + else + pp_and_continue k + ) + | [] -> kont k + in + loop 0 k l + + let to_out ~width out (self : t) : unit = + let st = { out; width } in + pp_rec st 0 [ 0, self ] + + let to_buffer ~width (buf : Buffer.t) (self : t) : unit = + to_out ~width (Out.of_buffer buf) self + + let to_string ~width (self : t) : string = + let buf = Buffer.create 32 in + to_buffer ~width buf self; + Buffer.contents buf + + let to_format ~width out self : unit = + (* TODO: more efficient implementation based on out *) + CCFormat.string_lines out (to_string ~width self) +end + +let pp = Pretty.to_format ~width:80 + +(* helpers *) + +let sp = char ' ' + +module Infix = struct + let ( ^ ) = append + let[@inline] ( ^+ ) x y = x ^ sp ^ y + let[@inline] ( ^/ ) x y = x ^ nl ^ y +end + +include Infix + +let true_ = text "true" +let false_ = text "false" + +let bool b = + if b then + true_ + else + false_ + +let int x : t = text (string_of_int x) +let float x : t = text (string_of_float x) +let float_hex x : t = textpf "%h" x +let text_quoted s : t = text (Printf.sprintf "%S" s) +let text_zero_width s : t = { view = Text_zero_width s; wfl = 0 } + +let append_l ?(sep = nil) l = + let rec loop = function + | [] -> nil + | [ x ] -> x + | x :: tl -> x ^ sep ^ loop tl + in + loop l + +let append_sp l = append_l ~sep:sp l +let append_nl l = append_l ~sep:nl l + +let fill sep = function + | [] -> nil + | [ x ] -> x + | l -> + (* flattened: just like concat *) + let wfl = + List.fold_left (fun wfl x -> wfl + x.wfl) 0 l + + ((List.length l - 1) * sep.wfl) + in + { view = Fill { sep; l }; wfl } + +let fill_map sep f l = fill sep (List.map f l) + +let of_list ?(sep = nil) f l = + let rec loop = function + | [] -> nil + | [ x ] -> f x + | x :: tl -> f x ^ sep ^ loop tl + in + loop l + +let of_seq ?(sep = nil) f seq : t = + let rec loop first seq = + match seq () with + | Seq.Nil -> nil + | Seq.Cons (x, tl) -> + let x = f x in + (if first then + x + else + sep ^ x) + ^ loop false tl + in + loop true seq + +let bracket l d r : t = group (text l ^ nest (String.length l) d ^ text r) +let bracket2 l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r) +let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')')) +let sexp_apply a l : t = sexp_l (text a :: l) + +module Dump = struct + let list l : t = + let sep = char ';' ^ nl in + group (char '[' ^ nest 1 (fill sep l) ^ char ']') +end + +module Term_color = struct + type color = + [ `Black | `Red | `Yellow | `Green | `Blue | `Magenta | `Cyan | `White ] + + type style = + [ `FG of color (* foreground *) + | `BG of color (* background *) + | `Bold + | `Reset + | `Underline ] + + let int_of_color_ = function + | `Black -> 0 + | `Red -> 1 + | `Green -> 2 + | `Yellow -> 3 + | `Blue -> 4 + | `Magenta -> 5 + | `Cyan -> 6 + | `White -> 7 + + let code_of_style : style -> int = function + | `FG c -> 30 + int_of_color_ c + | `BG c -> 40 + int_of_color_ c + | `Bold -> 1 + | `Reset -> 0 + | `Underline -> 4 + + let spf = Printf.sprintf + let string_of_style a = spf "\x1b[%dm" (code_of_style a) + let reset = string_of_style `Reset + + let string_of_style_list = function + | [] -> reset + | [ a ] -> string_of_style a + | [ a; b ] -> spf "\x1b[%d;%dm" (code_of_style a) (code_of_style b) + | [ a; b; c ] -> + spf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b) (code_of_style c) + | l -> + let buf = Buffer.create 32 in + let pp_num c = Buffer.add_string buf (string_of_int (code_of_style c)) in + Buffer.add_string buf "\x1b["; + List.iteri + (fun i c -> + if i > 0 then Buffer.add_char buf ';'; + pp_num c) + l; + Buffer.add_string buf "m"; + Buffer.contents buf + + (* TODO: handle nested styles *) + let ext_style_ : style list Ext.t = + { + pre = (fun out l -> Out.string out (string_of_style_list l)); + post = (fun out _l -> Out.string out reset); + } + + (** Set the foreground color. *) + let color (c : color) (d : t) : t = ext ext_style_ [ `FG c ] d + + (** Set a full style for this document. *) + let style_l (l : style list) (d : t) : t = ext ext_style_ l d +end diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli new file mode 100644 index 00000000..9c669fad --- /dev/null +++ b/src/pp/containers_pp.mli @@ -0,0 +1,253 @@ +(** Pretty printing of documents. + + A document is a structured tree of text with + formatting instructions. + + It can be rendered into a string ("pretty printed"), + see {!Pretty}. + + This follows Wadler's paper "A prettier printer", but with + some changes in the rendering part because we can't rely on lazyness + to make the algebraic implementation efficient. + + Some general considerations: the type [t] is the type of documents, + a tree with text leaves that is pretty printed within a given width. + + Layout is controlled via the combination of a few primitives: + - [newline] will either print a space or a newline. It is similar + to {!Format}'s ["@ "] in that sense. A big difference with [Format] + is that by default [newline] is actually a newline. It only + becomes a space if it's in a [group] small enough to fit + in the remainder of the current line. + - [group d] tries to write [d] on a single line if there's room. + If not, it has no effect. + - [nest n d] increases the indentation level inside [d]. Any newline + that is rendered as a new line is indented by [n] more spaces (which + are cumulative with surrounding [nest] calls). + - [append a b] (or [a ^ b]) just prints [a] followed by [b]. + - [fill d] is a bit like [group] but it will try to cram + as much as possible on each line. It is not all-or-nothing + like [group]. +*) + +(** {2 Core} *) + +type t +(** The type of documents *) + +val nil : t +(** Empty document *) + +val char : char -> t +(** Single char. *) + +val text : string -> t +(** Text. The string will be split on ['\n'], which are replaced + by {!newline}. *) + +val textpf : ('a, unit, string, t) format4 -> 'a +(** Text, with a {!Printf}-compatible format. + + For example, [textpf "%d-%d" 4 2] is like [text "4-2"]. *) + +val textf : ('a, Format.formatter, unit, t) format4 -> 'a +(** Text, with a {!Format}-compatible format. + + Note that this will bake-in any formatting done by {!Format}. + Newlines introduced by format will become hard newlines + in the resulting document. *) + +val nest : int -> t -> t +(** [nest n d] increases indentation by [n] inside [d]. + If current indentation is [m], then every newline inside [d] + will be followed by [n + m] leading spaces. *) + +val group : t -> t +(** Group the documents inside this. + + Newlines immediately inside this group will either + render as new lines or as spaces, depending on the width available. *) + +val append : t -> t -> t +(** Concatenation. *) + +val newline : t +(** A line break. *) + +val nl : t +(** Alias for {!newline} *) + +val fill : t -> t list -> t +(** [fill sep l] resembles [group (append_l ~sep l)], except it tries + to put as many items of [l] as possible on each line. + + In terms of {!Format}, this is like the hov box. *) + +(** {2 Output device} *) + +(** Arbitrary output. + + This is used for user-provided output. *) +module Out : sig + type t = { + char: char -> unit; + (** Output a single char. The char is assumed not to be ['\n']. *) + sub_string: string -> int -> int -> unit; + (** Output a string slice (optim for [string]) *) + string: string -> unit; (** Output a string *) + newline: unit -> unit; (** Output a newline *) + } + + val of_buffer : Buffer.t -> t + val char : t -> char -> unit + val string : t -> string -> unit + val sub_string : t -> string -> int -> int -> unit + val newline : t -> unit +end + +(** {2 Extensibility} *) + +(** Extension node. + + Custom nodes can be used to add user-defined behavior to + the rendered output. For example, documents + might be annotated with ANSI-terminal colors, or + with HTML tags. *) +module Ext : sig + type 'a t = { + pre: Out.t -> 'a -> unit; (** Printed before the wrapped value. *) + post: Out.t -> 'a -> unit; (** Printed after the wrapped value. *) + } + (** An extension is a custom document node. It takes a value of type ['a], + and a document [d], and can output what it wants based + on the custom value before and after [d] is printed. + + The extension is considered to have width [0]. *) +end + +val ext : 'a Ext.t -> 'a -> t -> t +(** [ext e v d] wraps [d] with value [v]. + + It is a document that has the same + shape (and size) as [d], except that additional data will + be output when it is rendered using extension [e]. + + When this is rendered, first [e.pre out v] is called; + then [d] is printed; then [e.post out v] is called. + Here [out] is the output buffer/stream for rendering. + +*) + +(** {2 Pretty print and rendering} *) + +(** Pretty-printing. + + These functions are parametrized by a width, + and will try to fit the result within this width. *) +module Pretty : sig + val to_out : width:int -> Out.t -> t -> unit + (** Render to an arbitrary output. *) + + val to_string : width:int -> t -> string + (** Render to a string. *) + + val to_buffer : width:int -> Buffer.t -> t -> unit + (** Render to a buffer. *) + + val to_format : width:int -> Format.formatter -> t -> unit +end + +(** Trivial printing, on a single line. + + This is generally ugly, but it's simple and fast when we do not + care about looks. *) +module Flatten : sig + val to_out : Out.t -> t -> unit + val to_buffer : Buffer.t -> t -> unit + val to_string : t -> string +end + +val pp : Format.formatter -> t -> unit +(** Pretty-print, using {!Pretty} and an unspecified margin. *) + +val debug : Format.formatter -> t -> unit +(** Debug printer. This prints the structure of the document, + it does {b not} pretty-print it. See {!pp} or {!Pretty}. *) + +(** {2 Convenience functions} *) + +module Infix : sig + val ( ^ ) : t -> t -> t + (** Alias of {!append}. *) + + val ( ^+ ) : t -> t -> t + (** [x ^+ y] is [x ^ text " " ^ y] *) + + val ( ^/ ) : t -> t -> t + (** [x ^/ y] is [x ^ newline ^ y] *) +end + +include module type of Infix + +val sp : t +(** A single space *) + +val append_l : ?sep:t -> t list -> t +(** [append_l ?sep l] is the concatenation of elements of + [l], separated by [sep] (default [nil]) *) + +val append_sp : t list -> t +(** [append_sp l] is the concatenation of elements of [l], separated by [' '] *) + +val append_nl : t list -> t +(** Same as {!append_l} with [sep=nl] *) + +val fill_map : t -> ('a -> t) -> 'a list -> t +(** [fill_map sep f l] is [fill sep (List.map f l)] *) + +val bool : bool -> t +val int : int -> t +val float : float -> t +val float_hex : float -> t + +val text_quoted : string -> t +(** [text_quoted s] is [text (spf "%S" s)] *) + +val text_zero_width : string -> t +(** Text but we assume it takes no space on screen. *) + +val of_list : ?sep:t -> ('a -> t) -> 'a list -> t +(** [of_list f l] maps each element of [l] to a document + and concatenates them. + @param sep separator inserted between elements (default [nil]) *) + +val of_seq : ?sep:t -> ('a -> t) -> 'a Seq.t -> t +(** Same as {!of_list} but with sequences. *) + +val bracket : string -> t -> string -> t +(** [bracket l d r] groups [d], between brackets [l] and [r] *) + +val bracket2 : string -> t -> string -> t +(** [bracket2 l d r] groups [d], indented by 2, between brackets [l] and [r] *) + +val sexp_apply : string -> t list -> t +(** [sexp_apply a l] is the S-expr ["(text a …l)"], pretty-printed *) + +val sexp_l : t list -> t +(** [sexp_l [l1;…ln]] is the S-expr ["(l1 l2…ln)"], pretty-printed *) + +(** Printers that correspond closely to OCaml's syntax. *) +module Dump : sig + val list : t list -> t +end + +(** Simple colors in terminals *) +module Term_color : sig + type color = + [ `Black | `Blue | `Cyan | `Green | `Magenta | `Red | `White | `Yellow ] + + type style = [ `BG of color | `Bold | `FG of color | `Reset | `Underline ] + + val color : color -> t -> t + val style_l : style list -> t -> t +end diff --git a/src/pp/dune b/src/pp/dune new file mode 100644 index 00000000..fbf9d1fb --- /dev/null +++ b/src/pp/dune @@ -0,0 +1,7 @@ + +(library + (name containers_pp) + (public_name containers.pp) + (synopsis "Pretty printer for Containers") + (flags :standard) + (libraries containers seq)) diff --git a/src/cbor/tests/appendix_a.json b/tests/cbor/appendix_a.json similarity index 100% rename from src/cbor/tests/appendix_a.json rename to tests/cbor/appendix_a.json diff --git a/src/cbor/tests/dune b/tests/cbor/dune similarity index 100% rename from src/cbor/tests/dune rename to tests/cbor/dune diff --git a/src/cbor/tests/t_appendix_a.ml b/tests/cbor/t_appendix_a.ml similarity index 100% rename from src/cbor/tests/t_appendix_a.ml rename to tests/cbor/t_appendix_a.ml diff --git a/tests/core/dune b/tests/core/dune index e17dd3a6..89c12c06 100644 --- a/tests/core/dune +++ b/tests/core/dune @@ -6,5 +6,6 @@ (preprocess (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) - (libraries containers containers.bencode containers.cbor containers.unix + (libraries containers containers.bencode containers.cbor + containers.unix containers.pp threads containers_testlib iter gen uutf csexp)) diff --git a/tests/core/t.ml b/tests/core/t.ml index e5d27999..8508555a 100644 --- a/tests/core/t.ml +++ b/tests/core/t.ml @@ -1,5 +1,6 @@ Containers_testlib.run_all ~descr:"containers" [ + T_pp.get (); T_list.get (); T_array.get (); T_bool.get (); diff --git a/tests/core/t_pp.ml b/tests/core/t_pp.ml new file mode 100644 index 00000000..747cde5a --- /dev/null +++ b/tests/core/t_pp.ml @@ -0,0 +1,61 @@ +include (val Containers_testlib.make ~__FILE__ ()) +open Containers_pp + +let spf = Printf.sprintf + +let () = + eq "hello world" (Flatten.to_string @@ text "hello" ^ newline ^ text "world") + +let () = + eq ~name:"split text" ~printer:(spf "%S") "let rec f x =\n x+2\n" + (let d = text "let rec f x =\n x+2\n" in + Pretty.to_string ~width:15 d) + +let () = + eq ~name:"l1" ~printer:(spf "%S") "[0; 1; 2; 3;\n 4; 5; 6; 7;\n 8; 9]" + (let d = Dump.list (CCList.init 10 int) in + Pretty.to_string ~width:10 d) + +let () = + eq ~name:"l2" ~printer:(spf "%S") + "[[0; 1; 2; 3;\n\ + \ 4; 5];\n\ + \ [1; 2; 3; 4;\n\ + \ 5; 6];\n\ + \ [2; 3; 4; 5;\n\ + \ 6; 7];\n\ + \ [3; 4; 5; 6;\n\ + \ 7; 8];\n\ + \ [4; 5; 6; 7;\n\ + \ 8; 9];\n\ + \ [5; 6; 7; 8;\n\ + \ 9; 10]]" + (let d = + Dump.list + (CCList.init 6 (fun i -> + Dump.list (CCList.init 6 (fun j -> int @@ (i + j))))) + in + Pretty.to_string ~width:10 d) + +let () = + eq ~name:"s1" ~printer:(spf "%S") "(foo\n bar\n baaz\n (g 42 10))" + (let d = + sexp_apply "foo" + [ text "bar"; text "baaz"; sexp_apply "g" [ int 42; int 10 ] ] + in + Pretty.to_string ~width:10 d) + +let ext_coucou = + { + Ext.pre = (fun out () -> out.string ""); + post = (fun out () -> out.string ""); + } + +let () = + eq ~name:"wrap1" ~printer:(spf "%S") + "(foo\n bar\n (g 42 10))" + (let d = + sexp_apply "foo" + [ text "bar"; ext ext_coucou () (sexp_apply "g" [ int 42; int 10 ]) ] + in + Pretty.to_string ~width:10 d)