Add independent pretty printing for sexp
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
463ee3653a
commit
b9dada554e
|
@ -0,0 +1,72 @@
|
|||
type quote =
|
||||
| Needs_quoting_with_length of int
|
||||
| No_quoting
|
||||
|
||||
let quote_length s =
|
||||
let n = ref 0 in
|
||||
let len = String.length s in
|
||||
let needs_quoting = ref false in
|
||||
for i = 0 to len - 1 do
|
||||
n := !n + (match String.unsafe_get s i with
|
||||
| '\"' | '\\' | '\n' | '\t' | '\r' | '\b' ->
|
||||
needs_quoting := true;
|
||||
2
|
||||
| ' ' ->
|
||||
needs_quoting := true;
|
||||
1
|
||||
| '!' .. '~' -> 1
|
||||
| _ ->
|
||||
needs_quoting := true;
|
||||
4)
|
||||
done;
|
||||
if !needs_quoting then
|
||||
Needs_quoting_with_length len
|
||||
else (
|
||||
assert (len = !n);
|
||||
No_quoting
|
||||
)
|
||||
|
||||
let escape_to s ~dst:s' ~ofs =
|
||||
let n = ref ofs in
|
||||
let len = String.length s in
|
||||
for i = 0 to len - 1 do
|
||||
begin match String.unsafe_get s i with
|
||||
| ('\"' | '\\') as c ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
|
||||
| '\n' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
|
||||
| '\t' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
|
||||
| '\r' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
|
||||
| '\b' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
|
||||
| (' ' .. '~') as c -> Bytes.unsafe_set s' !n c
|
||||
| c ->
|
||||
let a = Char.code c in
|
||||
Bytes.unsafe_set s' !n '\\';
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10));
|
||||
end;
|
||||
incr n
|
||||
done
|
||||
|
||||
(* Surround [s] with quotes, escaping it if necessary. *)
|
||||
let quote_if_needed s =
|
||||
let len = String.length s in
|
||||
match quote_length s with
|
||||
| No_quoting ->
|
||||
s
|
||||
| Needs_quoting_with_length n ->
|
||||
let s' = Bytes.create (n + 2) in
|
||||
Bytes.unsafe_set s' 0 '"';
|
||||
if len = 0 || n > len then
|
||||
escape_to s ~dst:s' ~ofs:1
|
||||
else
|
||||
Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len;
|
||||
Bytes.unsafe_set s' (n + 1) '"';
|
||||
Bytes.unsafe_to_string s'
|
|
@ -0,0 +1 @@
|
|||
val quote_if_needed : string -> string
|
|
@ -35,6 +35,26 @@ module To_sexp = struct
|
|||
String0.Map.add acc key data))
|
||||
end
|
||||
|
||||
let to_string _ = "TODO"
|
||||
let rec to_string = function
|
||||
| Atom s -> Escape.quote_if_needed s
|
||||
| List l ->
|
||||
Printf.sprintf "(%s)"
|
||||
(List.map ~f:to_string l
|
||||
|> String.concat ~sep:" ")
|
||||
|
||||
let pp _ppf _t = ()
|
||||
let rec pp ppf = function
|
||||
| Atom s ->
|
||||
Format.pp_print_string ppf (Escape.quote_if_needed s)
|
||||
| List [] ->
|
||||
Format.pp_print_string ppf "()"
|
||||
| List (first :: rest) ->
|
||||
Format.pp_open_box ppf 1;
|
||||
Format.pp_print_string ppf "(";
|
||||
Format.pp_open_hvbox ppf 0;
|
||||
pp ppf first;
|
||||
List.iter rest ~f:(fun sexp ->
|
||||
Format.pp_print_space ppf ();
|
||||
pp ppf sexp);
|
||||
Format.pp_close_box ppf ();
|
||||
Format.pp_print_string ppf ")";
|
||||
Format.pp_close_box ppf ()
|
||||
|
|
|
@ -13,4 +13,4 @@ end with type sexp := t
|
|||
|
||||
val to_string : t -> string
|
||||
|
||||
val pp : Format.formatter -> 'a -> unit
|
||||
val pp : Format.formatter -> t -> unit
|
||||
|
|
|
@ -2,8 +2,8 @@
|
|||
|
||||
#warnings "-40";;
|
||||
|
||||
open Stdune;;
|
||||
open Dune;;
|
||||
open Import;;
|
||||
open Action.Infer.Outcome;;
|
||||
Stdune.Path.set_build_dir (Path.Kind.of_string "_build");;
|
||||
|
||||
|
@ -14,7 +14,7 @@ let infer (a : Action.t) =
|
|||
List.map (Path.Set.to_list x.targets) ~f:Path.to_string)
|
||||
[%%expect{|
|
||||
- : unit = ()
|
||||
val p : ?error_loc:Dsexp.Loc.t -> string -> Path.t = <fun>
|
||||
val p : ?error_loc:Stdune__Loc.t -> string -> Path.t = <fun>
|
||||
val infer : Action.t -> string list * string list = <fun>
|
||||
|}]
|
||||
|
||||
|
|
|
@ -2,10 +2,10 @@
|
|||
open! Stdune;;
|
||||
open Dsexp.Of_sexp;;
|
||||
|
||||
let print_loc ppf (_ : Dsexp.Loc.t) = Format.pp_print_string ppf "<loc>";;
|
||||
let print_loc ppf (_ : Loc.t) = Format.pp_print_string ppf "<loc>";;
|
||||
#install_printer print_loc;;
|
||||
[%%expect{|
|
||||
val print_loc : Format.formatter -> Dsexp.Loc.t -> unit = <fun>
|
||||
val print_loc : Format.formatter -> Loc.t -> unit = <fun>
|
||||
|}]
|
||||
|
||||
Printexc.record_backtrace false;;
|
||||
|
@ -265,7 +265,7 @@ Different
|
|||
| Printing tests |
|
||||
+-----------------------------------------------------------------+ *)
|
||||
|
||||
let loc = Dsexp.Loc.none
|
||||
let loc = Loc.none
|
||||
let a = Dsexp.atom
|
||||
let s x = Dsexp.Quoted_string x
|
||||
let t x = Dsexp.Template { quoted = false; parts = x; loc }
|
||||
|
@ -310,7 +310,7 @@ let test syntax sexp =
|
|||
#install_printer print_sexp
|
||||
|
||||
[%%expect{|
|
||||
val loc : Dsexp.Loc.t = <loc>
|
||||
val loc : Loc.t = <loc>
|
||||
val a : string -> Dsexp.t = <fun>
|
||||
val s : string -> Dsexp.t = <fun>
|
||||
val t : Dsexp.Template.part list -> Dsexp.t = <fun>
|
||||
|
|
Loading…
Reference in New Issue