Simon Génier pushed to branch gensym-without-spaces at Stefan / Typer WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 01dbc11d by Simon Génier at 2023-03-25T12:28:15-04:00 Escape charaters like spaces when printing a symbol or vname. - - - - - 4 changed files: - src/grammar.ml - src/sexp.ml - src/util.ml - tests/sexp_test.ml Changes: ===================================== src/grammar.ml ===================================== @@ -46,6 +46,9 @@ let find (name : string) (Grammar (ps) : t) : int option * int option = try SMap.find name ps with | Not_found -> (None, None) +let separate_chars = + CSet.of_list [','; '('; ')'; ';'] + (* A token_end array indicates the few chars which are separate tokens, * even if not surrounded by spaces, such as '(', ')', and ';'. * It also indicates which chars are "inner" operators, i.e. those chars @@ -54,13 +57,10 @@ let find (name : string) (Grammar (ps) : t) : int option * int option = type char_kind = | CKnormal | CKseparate | CKinner of int type token_env = char_kind array let default_stt : token_env = - let stt = Array.make 256 CKnormal - in stt.(Char.code ';') <- CKseparate; - stt.(Char.code ',') <- CKseparate; - stt.(Char.code '(') <- CKseparate; - stt.(Char.code ')') <- CKseparate; - stt.(Char.code '.') <- CKinner 5; - stt + let stt = Array.make 256 CKnormal in + CSet.iter (fun c -> stt.(Char.code c) <- CKseparate) separate_chars; + stt.(Char.code '.') <- CKinner 5; + stt (* default_grammar is auto-generated from typer-smie-grammar via: ===================================== src/sexp.ml ===================================== @@ -26,6 +26,17 @@ open Prelexer let sexp_error ?print_action loc fmt = Log.log_error ~section:"SEXP" ?print_action ~loc fmt +(** Prints an identifier in a way that reading it back will yield the same + identifier. Spaces, inner operators like ‘.’, and separate characters like + ‘,’ are escaped. *) +let pp_print_id (f : Format.formatter) (name : string) : unit = + let pp_print_escaped_char c = + if c = '.' || c = ' ' || CSet.mem c Grammar.separate_chars then + Format.pp_print_char f '\\'; + Format.pp_print_char f c + in + String.iter pp_print_escaped_char name + module Sym = struct type t = Source.Location.t * string @@ -53,7 +64,10 @@ module Sym = struct && name l = name r let pp_print (f : Format.formatter) (_, name : t) : unit = - Format.pp_print_string f name + pp_print_id f name + + let to_string : t -> string = + Format.asprintf "%a" pp_print end type symbol = Sym.t @@ -105,7 +119,7 @@ let string_of_vname ?(default : string = "<anon>") : vname -> string = function let pp_print_vname ?(default : string option) (f : Format.formatter) (name : vname) : unit = - Format.pp_print_string f (string_of_vname ?default name) + pp_print_id f (string_of_vname ?default name) (********************** Sexp tests **********************) ===================================== src/util.ml ===================================== @@ -22,6 +22,7 @@ this program. If not, see <http://www.gnu.org/licenses/>. *) module SMap = Map.Make(String) module IMap = Map.Make(Int) +module CSet = Set.Make(Char) type location = Source.Location.t let dummy_location = Source.Location.dummy ===================================== tests/sexp_test.ml ===================================== @@ -87,5 +87,33 @@ let _ = "x = 4 : Int" "(_=_ x (_:_ 4 Int))" +let () = + add_test + "SEXP" + "Spaces are escaped in symbols" + (fun () -> + if + "Laura Palmer" + |> Sym.intern ~location:Source.Location.dummy + |> Sym.to_string + = "Laura\\ Palmer" + then + success + else failure) + +let () = + add_test + "SEXP" + "Dots are escaped in symbols" + (fun () -> + if + "DaleB.Cooper" + |> Sym.intern ~location:Source.Location.dummy + |> Sym.to_string + = "DaleB\\.Cooper" + then + success + else failure) + (* run all tests *) let _ = run_all () View it on GitLab: https://gitlab.com/monnier/typer/-/commit/01dbc11da02b8e5e5896659d712e6e1ab2... -- View it on GitLab: https://gitlab.com/monnier/typer/-/commit/01dbc11da02b8e5e5896659d712e6e1ab2... You're receiving this email because of your account on gitlab.com.