diff --git a/src/stdune/escape.ml b/src/stdune/escape.ml new file mode 100644 index 00000000..76b186fc --- /dev/null +++ b/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' diff --git a/src/stdune/escape.mli b/src/stdune/escape.mli new file mode 100644 index 00000000..a9ccd90b --- /dev/null +++ b/src/stdune/escape.mli @@ -0,0 +1 @@ +val quote_if_needed : string -> string diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index 0d77fced..873e4183 100644 --- a/src/stdune/sexp.ml +++ b/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 () diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index 661d9e99..90768bf9 100644 --- a/src/stdune/sexp.mli +++ b/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 diff --git a/test/unit-tests/action.mlt b/test/unit-tests/action.mlt index 2fe2a8ec..82bf0999 100644 --- a/test/unit-tests/action.mlt +++ b/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 = +val p : ?error_loc:Stdune__Loc.t -> string -> Path.t = val infer : Action.t -> string list * string list = |}] diff --git a/test/unit-tests/sexp.mlt b/test/unit-tests/sexp.mlt index 550ce7a7..c245cb09 100644 --- a/test/unit-tests/sexp.mlt +++ b/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 "";; +let print_loc ppf (_ : Loc.t) = Format.pp_print_string ppf "";; #install_printer print_loc;; [%%expect{| -val print_loc : Format.formatter -> Dsexp.Loc.t -> unit = +val print_loc : Format.formatter -> Loc.t -> unit = |}] 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 = +val loc : Loc.t = val a : string -> Dsexp.t = val s : string -> Dsexp.t = val t : Dsexp.Template.part list -> Dsexp.t =