diff --git a/src/context.ml b/src/context.ml index 29d261d2..b666dbd6 100644 --- a/src/context.ml +++ b/src/context.ml @@ -110,9 +110,9 @@ let sexp_of_t t = bool (Dynlink_supported.By_the_os.get t.natdynlink_supported) ; "supports_shared_libraries", bool (Dynlink_supported.By_the_os.get t.supports_shared_libraries) - ; "opam_vars", string_hashtbl string t.opam_var_cache + ; "opam_vars", Hashtbl.sexp_of_t string string t.opam_var_cache ; "ocaml_config", Ocaml_config.sexp_of_t t.ocaml_config - ; "which", string_hashtbl (option path) t.which_cache + ; "which", Hashtbl.sexp_of_t string (option path) t.which_cache ] let compare a b = compare a.name b.name diff --git a/src/dsexp/dsexp.ml b/src/dsexp/dsexp.ml index 83eb5269..635d717d 100644 --- a/src/dsexp/dsexp.ml +++ b/src/dsexp/dsexp.ml @@ -5,7 +5,17 @@ module Template = Template type syntax = Atom.syntax = Jbuild | Dune -include Dsexp0 +type t = + | Atom of Atom.t + | Quoted_string of string + | List of t list + | Template of Template.t + +let atom_or_quoted_string s = + if Atom.is_valid_dune s then + Atom (Atom.of_string s) + else + Quoted_string s let atom s = Atom (Atom.of_string s) @@ -128,6 +138,7 @@ let prepare_formatter ppf = } module Ast = struct + type dsexp = t type t = | Atom of Loc.t * Atom.t | Quoted_string of Loc.t * string @@ -144,7 +155,7 @@ module Ast = struct let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _) | Template { loc ; _ }) = loc - let rec remove_locs t : Dsexp0.t = + let rec remove_locs t : dsexp = match t with | Template t -> Template (Template.remove_locs t) | Atom (_, s) -> Atom s @@ -259,7 +270,6 @@ module To_sexp = struct type nonrec 'a t = 'a -> t let unit () = List [] let string = atom_or_quoted_string - let atom = string let int n = Atom (Atom.of_int n) let float f = Atom (Atom.of_float f) let bool b = Atom (Atom.of_bool b) @@ -270,14 +280,8 @@ module To_sexp = struct let option f = function | None -> List [] | Some x -> List [f x] - let string_set set = list atom (String.Set.to_list set) - let string_map f map = list (pair atom f) (String.Map.to_list map) let record l = List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v])) - let string_hashtbl f h = - string_map f - (Hashtbl.foldi h ~init:String.Map.empty ~f:(fun key data acc -> - String.Map.add acc key data)) type field = string * dsexp option @@ -670,21 +674,6 @@ module Of_sexp = struct | true -> return None | false -> t >>| Option.some) - let string_set = list string >>| String.Set.of_list - let string_map t = - list (pair string t) >>= fun bindings -> - match String.Map.of_list bindings with - | Result.Ok x -> return x - | Error (key, _v1, _v2) -> - loc >>= fun loc -> - of_sexp_errorf loc "key %s present multiple times" key - - let string_hashtbl t = - string_map t >>| fun map -> - let tbl = Hashtbl.create (String.Map.cardinal map + 32) in - String.Map.iteri map ~f:(Hashtbl.add tbl); - tbl - let find_cstr cstrs loc name ctx values = match List.assoc cstrs name with | Some t -> diff --git a/src/dsexp/dsexp0.ml b/src/dsexp/dsexp0.ml deleted file mode 100644 index f8cbb38c..00000000 --- a/src/dsexp/dsexp0.ml +++ /dev/null @@ -1,7 +0,0 @@ -include Types.Sexp - -let atom_or_quoted_string s = - if Atom.is_valid_dune s then - Atom (Atom.of_string s) - else - Quoted_string s diff --git a/src/dsexp/dsexp0.mli b/src/dsexp/dsexp0.mli deleted file mode 100644 index 94c45ca5..00000000 --- a/src/dsexp/dsexp0.mli +++ /dev/null @@ -1,7 +0,0 @@ -type t = Types.Sexp.t = - | Atom of Atom.t - | Quoted_string of string - | List of t list - | Template of Types.Template.t - -val atom_or_quoted_string : string -> t diff --git a/src/dsexp/types.ml b/src/dsexp/types.ml index eee28b0a..5c129ac6 100644 --- a/src/dsexp/types.ml +++ b/src/dsexp/types.ml @@ -20,11 +20,3 @@ module Template = struct ; loc: Loc.t } end - -module Sexp = struct - type t = - | Atom of Atom.t - | Quoted_string of string - | List of t list - | Template of Template.t -end diff --git a/src/stdune/escape.ml b/src/stdune/escape.ml index 76b186fc..830a9d88 100644 --- a/src/stdune/escape.ml +++ b/src/stdune/escape.ml @@ -1,3 +1,5 @@ +module String = StringLabels + type quote = | Needs_quoting_with_length of int | No_quoting diff --git a/src/stdune/exn.ml b/src/stdune/exn.ml index 6e9be578..ead3de51 100644 --- a/src/stdune/exn.ml +++ b/src/stdune/exn.ml @@ -1,10 +1,10 @@ type t = exn -exception Code_error of Sexp0.t +exception Code_error of Sexp.t exception Fatal_error of string -exception Loc_error of Loc0.t * string +exception Loc_error of Loc.t * string external raise : exn -> _ = "%raise" external raise_notrace : exn -> _ = "%raise_notrace" @@ -26,9 +26,9 @@ let protect ~f ~finally = protectx () ~f ~finally let code_error message vars = Code_error - (Sexp0.List (Sexp0.Atom message - :: List.map vars ~f:(fun (name, value) -> - Sexp0.List [Sexp0.Atom name; value]))) + (List (Atom message + :: List.map vars ~f:(fun (name, value) -> + Sexp.List [Atom name; value]))) |> raise include diff --git a/src/stdune/exn.mli b/src/stdune/exn.mli index bc117c8c..d7e3e2ab 100644 --- a/src/stdune/exn.mli +++ b/src/stdune/exn.mli @@ -2,7 +2,7 @@ (** An programming error, that should be reported upstream. The error message shouldn't try to be developer friendly rather than user friendly. *) -exception Code_error of Sexp0.t +exception Code_error of Sexp.t (* CR-soon diml: @@ -14,14 +14,14 @@ exception Code_error of Sexp0.t (** A fatal error, that should be reported to the user in a nice way *) exception Fatal_error of string -exception Loc_error of Loc0.t * string +exception Loc_error of Loc.t * string val fatalf - : ?loc:Loc0.t + : ?loc:Loc.t -> ('a, unit, string, string, string, 'b) format6 -> 'a -val code_error : string -> (string * Sexp0.t) list -> _ +val code_error : string -> (string * Sexp.t) list -> _ type t = exn diff --git a/src/stdune/hashtbl.ml b/src/stdune/hashtbl.ml index 3e8c41e5..1f599556 100644 --- a/src/stdune/hashtbl.ml +++ b/src/stdune/hashtbl.ml @@ -87,3 +87,14 @@ let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x) let iter t ~f = iter ~f t let keys t = foldi t ~init:[] ~f:(fun key _ acc -> key :: acc) + +let sexp_of_t (type key) f g t = + let module M = + Map.Make(struct + type t = key + let compare a b = Ordering.of_int (compare a b) + end) + in + Map.sexp_of_t M.to_list f g + (foldi t ~init:M.empty ~f:(fun key data acc -> + M.add acc key data)) diff --git a/src/stdune/hashtbl.mli b/src/stdune/hashtbl.mli index e86e7b00..cf27722a 100644 --- a/src/stdune/hashtbl.mli +++ b/src/stdune/hashtbl.mli @@ -27,3 +27,5 @@ val foldi : ('a, 'b) t -> init:'c -> f:('a -> 'b -> 'c -> 'c) -> 'c val mem : ('a, _) t -> 'a -> bool val keys : ('a, _) t -> 'a list + +val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b) t -> Sexp.t diff --git a/src/stdune/int.ml b/src/stdune/int.ml index 0e6b6ec1..c2e4f901 100644 --- a/src/stdune/int.ml +++ b/src/stdune/int.ml @@ -7,6 +7,7 @@ module T = struct Eq else Gt + let sexp_of_t = Sexp.To_sexp.int end include T diff --git a/src/stdune/int.mli b/src/stdune/int.mli index eeafb3dd..577146a0 100644 --- a/src/stdune/int.mli +++ b/src/stdune/int.mli @@ -1,5 +1,6 @@ type t = int val compare : t -> t -> Ordering.t +val sexp_of_t : t -> Sexp.t module Set : Set.S with type elt = t module Map : Map.S with type key = t diff --git a/src/stdune/loc.ml b/src/stdune/loc.ml index 3cb59375..5355a336 100644 --- a/src/stdune/loc.ml +++ b/src/stdune/loc.ml @@ -1,4 +1,4 @@ -type t = Loc0.t = +type t = { start : Lexing.position ; stop : Lexing.position } @@ -45,7 +45,7 @@ let equal_position ; pos_bol = b_b; pos_cnum = c_b } = let open Int.Infix in - String.equal f_a f_b + Caml.String.equal f_a f_b && l_a = l_b && b_a = b_b && c_a = c_b diff --git a/src/stdune/loc.mli b/src/stdune/loc.mli index 52ae71c4..4893079b 100644 --- a/src/stdune/loc.mli +++ b/src/stdune/loc.mli @@ -1,4 +1,4 @@ -type t = Loc0.t = +type t = { start : Lexing.position ; stop : Lexing.position } @@ -9,9 +9,9 @@ val none : t val of_lexbuf : Lexing.lexbuf -> t -val sexp_of_t : t -> Sexp0.t +val sexp_of_t : t -> Sexp.t -val sexp_of_position_no_file : Lexing.position -> Sexp0.t +val sexp_of_position_no_file : Lexing.position -> Sexp.t val equal : t -> t -> bool diff --git a/src/stdune/loc0.ml b/src/stdune/loc0.ml deleted file mode 100644 index 84c22b5b..00000000 --- a/src/stdune/loc0.ml +++ /dev/null @@ -1,4 +0,0 @@ -type t = - { start : Caml.Lexing.position - ; stop : Caml.Lexing.position - } diff --git a/src/stdune/map.ml b/src/stdune/map.ml index e9e9e611..86c43bbc 100644 --- a/src/stdune/map.ml +++ b/src/stdune/map.ml @@ -143,3 +143,6 @@ module Make(Key : Comparable.S) : S with type key = Key.t = struct let superpose a b = union a b ~f:(fun _ _ y -> Some y) end + +let sexp_of_t to_list f g t = + Sexp.To_sexp.(list (pair f g)) (to_list t) diff --git a/src/stdune/map.mli b/src/stdune/map.mli index 5666e9ab..f3145923 100644 --- a/src/stdune/map.mli +++ b/src/stdune/map.mli @@ -1,3 +1,9 @@ module type S = Map_intf.S module Make(Key : Comparable.S) : S with type key = Key.t + +val sexp_of_t + : ('a -> ('b * 'c) list) + -> 'b Sexp.To_sexp.t + -> 'c Sexp.To_sexp.t + -> 'a Sexp.To_sexp.t diff --git a/src/stdune/set.ml b/src/stdune/set.ml index 4cc7b8d0..3ccf0ad9 100644 --- a/src/stdune/set.ml +++ b/src/stdune/set.ml @@ -45,3 +45,6 @@ module Make(Elt : Comparable.S) : S with type elt = Elt.t = struct let choose = choose_opt let split x t = split t x end + +let sexp_of_t to_list f t = + Sexp.To_sexp.list f (to_list t) diff --git a/src/stdune/set.mli b/src/stdune/set.mli index 71f6c0fc..3a03686f 100644 --- a/src/stdune/set.mli +++ b/src/stdune/set.mli @@ -1,3 +1,8 @@ module type S = Set_intf.S module Make(Elt : Comparable.S) : S with type elt = Elt.t + +val sexp_of_t + : ('a -> 'b list) + -> 'b Sexp.To_sexp.t + -> 'a Sexp.To_sexp.t diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index 873e4183..005e27fc 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -1,4 +1,8 @@ -type t = Sexp0.t = +module Array = ArrayLabels +module List = ListLabels +module String = StringLabels + +type t = | Atom of string | List of t list @@ -21,18 +25,11 @@ module To_sexp = struct let option f = function | None -> List [] | Some x -> List [f x] - let string_set set = list string (String0.Set.to_list set) - let string_map f map = list (pair string f) (String0.Map.to_list map) let record l = List (List.map l ~f:(fun (n, v) -> List [Atom n; v])) let unknown _ = Atom "" - - let string_hashtbl f h = - string_map f - (Caml.Hashtbl.fold h ~init:String0.Map.empty ~f:(fun ~key ~data acc -> - String0.Map.add acc key data)) end let rec to_string = function diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index 90768bf9..c299d18b 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -1,4 +1,4 @@ -type t = Sexp0.t = +type t = | Atom of string | List of t list diff --git a/src/stdune/sexp0.ml b/src/stdune/sexp0.ml deleted file mode 100644 index a7151a9c..00000000 --- a/src/stdune/sexp0.ml +++ /dev/null @@ -1,3 +0,0 @@ -type t = - | Atom of string - | List of t list diff --git a/src/stdune/sexp_intf.ml b/src/stdune/sexp_intf.ml index ea2edd22..8954d017 100644 --- a/src/stdune/sexp_intf.ml +++ b/src/stdune/sexp_intf.ml @@ -10,7 +10,4 @@ module type Combinators = sig val list : 'a t -> 'a list t val array : 'a t -> 'a array t val option : 'a t -> 'a option t - val string_set : String0.Set.t t - val string_map : 'a t -> 'a String0.Map.t t - val string_hashtbl : 'a t -> (string, 'a) Caml.Hashtbl.t t end diff --git a/src/stdune/string.ml b/src/stdune/string.ml index 9bcb17d3..5816ff03 100644 --- a/src/stdune/string.ml +++ b/src/stdune/string.ml @@ -12,7 +12,14 @@ end include StringLabels -include String0.T.Include +let compare a b = Ordering.of_int (String.compare a b) + +module T = struct + type t = StringLabels.t + let compare = compare + let equal (x : t) (y : t) = x = y + let hash (s : t) = Hashtbl.hash s +end let capitalize = capitalize_ascii let uncapitalize = uncapitalize_ascii @@ -195,16 +202,16 @@ let maybe_quoted s = else Printf.sprintf {|"%s"|} escaped -module Set = String0.Set +module Set = Set.Make(T) module Map = struct - include String0.Map + include Map.Make(T) let pp f fmt t = Format.pp_print_list (fun fmt (k, v) -> Format.fprintf fmt "@[(%s@ =@ %a)@]" k f v ) fmt (to_list t) end -module Table = Hashtbl.Make(String0.T) +module Table = Hashtbl.Make(T) let enumerate_gen s = let s = " " ^ s ^ " " in diff --git a/src/stdune/string.mli b/src/stdune/string.mli index b781d2b6..6ba31660 100644 --- a/src/stdune/string.mli +++ b/src/stdune/string.mli @@ -53,9 +53,9 @@ val enumerate_and : string list -> string (** Produces: "x, y or z" *) val enumerate_or : string list -> string -module Set : Set.S with type elt = t and type t = String0.Set.t +module Set : Set.S with type elt = t module Map : sig - include Map.S with type key = t and type 'a t = 'a String0.Map.t + include Map.S with type key = t val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit end diff --git a/src/stdune/string0.ml b/src/stdune/string0.ml deleted file mode 100644 index e279fad7..00000000 --- a/src/stdune/string0.ml +++ /dev/null @@ -1,14 +0,0 @@ -module T = struct - type t = StringLabels.t - - module Include = struct - let compare a b = Ordering.of_int (Caml.String.compare a b) - let equal (x : t) (y : t) = x = y - let hash (s : t) = Caml.Hashtbl.hash s - end - - include Include -end - -module Set = Set.Make(T) -module Map = Map.Make(T)