feat pp: add a bunch of extensions

thanks to @grayswandyr
This commit is contained in:
Simon Cruanes 2024-08-19 12:17:58 -04:00
parent 02ac5bd78a
commit 65fc920427
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 117 additions and 0 deletions

View file

@ -1,6 +1,8 @@
module B = Buffer module B = Buffer
module Int_map = Map.Make (CCInt) module Int_map = Map.Make (CCInt)
type 'a iter = ('a -> unit) -> unit
module Out = struct module Out = struct
type t = { type t = {
char: char -> unit; char: char -> unit;
@ -464,11 +466,64 @@ 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 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_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')'))
let sexp_apply a l : t = sexp_l (text a :: l) let sexp_apply a l : t = sexp_l (text a :: l)
let surround ?(width = 1) l b r = group (l ^ nest width b ^ r)
module Char = struct
let bang = char '!'
let at = char '@'
let hash = char '#'
let dollar = char '$'
let tilde = char '~'
let backquote = char '`'
let percent = char '%'
let caret = char '^'
let ampersand = char '&'
let star = char '*'
let minus = char '-'
let underscore = char '_'
let plus = char '+'
let equal = char '='
let pipe = char '|'
let slash = char '/'
let backslash = char '\\'
let colon = char ':'
let semi = char ';'
let guillemet = char '"'
let quote = char '\''
let comma = char ','
let dot = char '.'
let question = char '?'
let lparen = char '('
let rparen = char ')'
let lbrace = char '{'
let rbrace = char '}'
let lbracket = char '['
let rbracket = char ']'
let langle = char '<'
let rangle = char '>'
end
module Dump = struct module Dump = struct
let list l : t = let list l : t =
let sep = char ';' ^ nl in let sep = char ';' ^ nl in
group (char '[' ^ nest 1 (fill sep l) ^ char ']') group (char '[' ^ nest 1 (fill sep l) ^ char ']')
let parens d = surround Char.lparen d Char.rparen
let braces d = surround Char.lbrace d Char.rbrace
let brackets d = surround Char.lbracket d Char.rbracket
let angles d = surround Char.langle d Char.rangle
let of_iter ?(sep = nil) g it =
let r = ref nil in
it (fun elt -> r := !r ^ sep ^ g elt);
!r
let of_array ?(sep = nil) g arr =
let r = ref nil in
for i = 0 to Array.length arr - 1 do
r := !r ^ sep ^ g arr.(i)
done;
!r
end end
module Term_color = struct module Term_color = struct

View file

@ -32,6 +32,8 @@
(** {2 Core} *) (** {2 Core} *)
type 'a iter = ('a -> unit) -> unit
type t type t
(** The type of documents *) (** The type of documents *)
@ -256,6 +258,26 @@ val sexp_l : t list -> t
(** Printers that correspond closely to OCaml's syntax. *) (** Printers that correspond closely to OCaml's syntax. *)
module Dump : sig module Dump : sig
val list : t list -> t val list : t list -> t
val of_iter : ?sep:t -> ('a -> t) -> 'a iter -> t
(** @since NEXT_RELEASE *)
val of_array : ?sep:t -> ('a -> t) -> 'a array -> t
(** @since NEXT_RELEASE *)
val parens : t -> t
(** @since NEXT_RELEASE *)
val braces : t -> t
(** @since NEXT_RELEASE *)
val brackets : t -> t
(** Adds '[' ']' around the term
@since NEXT_RELEASE *)
val angles : t -> t
(** Adds '<' '>' around the term
@since NEXT_RELEASE *)
end end
(** Simple colors in terminals *) (** Simple colors in terminals *)
@ -282,3 +304,43 @@ module Term_color : sig
val color : color -> t -> t val color : color -> t -> t
val style_l : style list -> t -> t val style_l : style list -> t -> t
end end
(** @since NEXT_RELEASE *)
module Char : sig
val bang : t
val at : t
val hash : t
val dollar : t
val tilde : t
val backquote : t
val percent : t
val caret : t
val ampersand : t
val star : t
val minus : t
val underscore : t
val plus : t
val equal : t
val pipe : t
val slash : t
val backslash : t
val colon : t
val semi : t
val guillemet : t
val quote : t
val comma : t
val dot : t
val question : t
val lparen : t
val rparen : t
val lbrace : t
val rbrace : t
val lbracket : t
val rbracket : t
val langle : t
val rangle : t
end
val surround : ?width:int -> t -> t -> t -> t
(** Generalization of {!bracket}
@since NEXT_RELEASE *)