Add independent pretty printing for sexp

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/stdune/escape.ml

@@ -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'

src/stdune/escape.mli

@@ -0,0 +1 @@
+val quote_if_needed : string -> string

src/stdune/sexp.ml

@@ -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 ()

src/stdune/sexp.mli

@@ -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

test/unit-tests/action.mlt

@@ -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>
 |}]
 

test/unit-tests/sexp.mlt

@@ -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>