Stefan pushed to branch main at Stefan / Typer
Commits: 964e7cd7 by Simon Génier at 2023-06-11T22:04:06-04:00 Escape special charaters such as spaces when printing back symbols.
- - - - - 9bdaed9b by Stefan Monnier at 2023-07-13T23:37:25-04:00 * src/sexp.ml (escape_sym_name.escape_sym_name): < SPC is considered blank
- - - - -
3 changed files:
- src/sexp.ml - src/string.ml - tests/sexp_test.ml
Changes:
===================================== src/sexp.ml ===================================== @@ -26,6 +26,27 @@ open Prelexer let sexp_error ?print_action loc fmt = Log.log_error ~section:"SEXP" ?print_action ~loc fmt
+open struct + let escape_sym_name (name : string) : string = + let is_normal_char c = + c > ' ' + && c <> '\' + && c <> '%' + && c <> '"' + && c <> '{' + && c <> '}' + && Grammar.default_stt.(Char.code c) = Grammar.CKnormal + in + let escape_char c = + let cc = Seq.return c in + if is_normal_char c then cc else Seq.cons '\' cc + in + + if String.for_all is_normal_char name + then name + else name |> String.to_seq |> Seq.flat_map escape_char |> String.of_seq +end + module Sym = struct type t = Source.Location.t * string
@@ -52,8 +73,16 @@ module Sym = struct Source.Location.same (location l) (location r) && name l = name r
+ (** Prints the symbol. Unlike simply printing the name of the symbol, this + function will escape special characters so it can be read back. + + Note that we do not track the lexical environment whence it came, so we + assume the default configuration. *) let pp_print (f : Format.formatter) (_, name : t) : unit = - Format.pp_print_string f name + name |> escape_sym_name |> Format.pp_print_string f + + let to_string (sym : t) : string = + Format.asprintf "%a" pp_print sym end type symbol = Sym.t
@@ -100,7 +129,7 @@ type vref = vname * db_index
let string_of_vname ?(default : string = "<anon>") : vname -> string = function | (_, None) -> default - | (_, Some (name)) -> name + | (_, Some (name)) -> escape_sym_name name
let pp_print_vname ?(default : string option) (f : Format.formatter) (name : vname)
===================================== src/string.ml ===================================== @@ -31,3 +31,13 @@ let fold_left (type a) (f : a -> char -> a) (a : a) (chars : string) : a = else a in loop 0 a + +let for_all (f : char -> bool) (chars : string) : bool = + let rec loop n = + if n = length chars + then true + else if f (get chars n) + then loop (n + 1) + else false + in + loop 0
===================================== tests/sexp_test.ml ===================================== @@ -87,5 +87,37 @@ let _ = "x = 4 : Int" "(_=_ x (_:_ 4 Int))"
+let add_sym_printing_test name source expected = + add_test + "SEXP" + name + (fun () + -> if + source + |> Sym.intern ~location:Source.Location.dummy + |> Sym.to_string + |> String.equal expected + then success + else failure) + + +let _ = + add_sym_printing_test + "Convert average symbol to string" + "monoïde单子функтор" + "monoïde单子функтор" + +let _ = + add_sym_printing_test + "Convert symbol with dot to string" + ".asdf" + "\.asdf" + +let _ = + add_sym_printing_test + "Convert symbol with parens to string" + "asdf)" + "asdf\)" + (* run all tests *) let _ = run_all ()
View it on GitLab: https://gitlab.com/monnier/typer/-/compare/2c710bedb3526814d3530abbbd92472a5...