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))
|
String0.Map.add acc key data))
|
||||||
end
|
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 to_string : t -> string
|
||||||
|
|
||||||
val pp : Format.formatter -> 'a -> unit
|
val pp : Format.formatter -> t -> unit
|
||||||
|
|
|
@ -2,8 +2,8 @@
|
||||||
|
|
||||||
#warnings "-40";;
|
#warnings "-40";;
|
||||||
|
|
||||||
|
open Stdune;;
|
||||||
open Dune;;
|
open Dune;;
|
||||||
open Import;;
|
|
||||||
open Action.Infer.Outcome;;
|
open Action.Infer.Outcome;;
|
||||||
Stdune.Path.set_build_dir (Path.Kind.of_string "_build");;
|
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)
|
List.map (Path.Set.to_list x.targets) ~f:Path.to_string)
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
- : unit = ()
|
- : 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>
|
val infer : Action.t -> string list * string list = <fun>
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
|
|
|
@ -2,10 +2,10 @@
|
||||||
open! Stdune;;
|
open! Stdune;;
|
||||||
open Dsexp.Of_sexp;;
|
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;;
|
#install_printer print_loc;;
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
val print_loc : Format.formatter -> Dsexp.Loc.t -> unit = <fun>
|
val print_loc : Format.formatter -> Loc.t -> unit = <fun>
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
Printexc.record_backtrace false;;
|
Printexc.record_backtrace false;;
|
||||||
|
@ -265,7 +265,7 @@ Different
|
||||||
| Printing tests |
|
| Printing tests |
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
|
||||||
let loc = Dsexp.Loc.none
|
let loc = Loc.none
|
||||||
let a = Dsexp.atom
|
let a = Dsexp.atom
|
||||||
let s x = Dsexp.Quoted_string x
|
let s x = Dsexp.Quoted_string x
|
||||||
let t x = Dsexp.Template { quoted = false; parts = x; loc }
|
let t x = Dsexp.Template { quoted = false; parts = x; loc }
|
||||||
|
@ -310,7 +310,7 @@ let test syntax sexp =
|
||||||
#install_printer print_sexp
|
#install_printer print_sexp
|
||||||
|
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
val loc : Dsexp.Loc.t = <loc>
|
val loc : Loc.t = <loc>
|
||||||
val a : string -> Dsexp.t = <fun>
|
val a : string -> Dsexp.t = <fun>
|
||||||
val s : string -> Dsexp.t = <fun>
|
val s : string -> Dsexp.t = <fun>
|
||||||
val t : Dsexp.Template.part list -> Dsexp.t = <fun>
|
val t : Dsexp.Template.part list -> Dsexp.t = <fun>
|
||||||
|
|
Loading…
Reference in New Issue