From 530dbfeb81819556a687993cc51b986b826bdb56 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 23 Apr 2018 12:08:09 +0700 Subject: [PATCH 1/3] Move String_set to stdune --- bin/main.ml | 20 ++++++++++---------- src/action.ml | 8 ++++---- src/build.ml | 2 +- src/build_system.ml | 16 ++++++++-------- src/build_system.mli | 2 +- src/file_tree.ml | 20 ++++++++++---------- src/file_tree.mli | 4 ++-- src/findlib.ml | 8 ++++---- src/gen_meta.ml | 4 ++-- src/gen_rules.ml | 16 ++++++++-------- src/import.ml | 1 - src/install_rules.ml | 2 +- src/jbuild.ml | 34 +++++++++++++++++----------------- src/jbuild.mli | 6 +++--- src/jbuild_load.ml | 4 ++-- src/lib.ml | 8 ++++---- src/lib.mli | 6 +++--- src/main.ml | 2 +- src/merlin.ml | 4 ++-- src/module.ml | 2 +- src/ordered_set_lang.ml | 4 ++-- src/ordered_set_lang.mli | 2 +- src/path.ml | 6 +++--- src/path.mli | 2 +- src/process.ml | 12 ++++++------ src/report_error.ml | 6 +++--- src/sexp.ml | 6 +++--- src/sexp.mli | 2 +- src/stdune/string.ml | 7 +++++++ src/stdune/string.mli | 2 ++ src/string_with_vars.ml | 2 +- src/string_with_vars.mli | 2 +- src/super_context.ml | 4 ++-- src/super_context.mli | 2 +- src/top_closure.ml | 2 +- src/workspace.ml | 8 ++++---- 36 files changed, 123 insertions(+), 115 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 3d4519d2..5d32efae 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -131,10 +131,10 @@ let do_build (setup : Main.setup) targets = let find_root () = let cwd = Sys.getcwd () in let rec loop counter ~candidates ~to_cwd dir = - let files = Sys.readdir dir |> Array.to_list |> String_set.of_list in - if String_set.mem files "jbuild-workspace" then + let files = Sys.readdir dir |> Array.to_list |> String.Set.of_list in + if String.Set.mem files "jbuild-workspace" then cont counter ~candidates:((0, dir, to_cwd) :: candidates) dir ~to_cwd - else if String_set.exists files ~f:(fun fn -> + else if String.Set.exists files ~f:(fun fn -> String.is_prefix fn ~prefix:"jbuild-workspace") then cont counter ~candidates:((1, dir, to_cwd) :: candidates) dir ~to_cwd else @@ -571,12 +571,12 @@ let target_hint (setup : Main.setup) path = else None) in - let candidates = String_set.of_list candidates |> String_set.to_list in + let candidates = String.Set.of_list candidates |> String.Set.to_list in hint (Path.to_string path) candidates let check_path contexts = let contexts = - String_set.of_list (List.map contexts ~f:(fun c -> c.Context.name)) + String.Set.of_list (List.map contexts ~f:(fun c -> c.Context.name)) in fun path -> let internal path = @@ -588,11 +588,11 @@ let check_path contexts = | None -> internal path | Some (name, _) -> if name = "" || name.[0] = '.' then internal path; - if not (name = "install" || String_set.mem contexts name) then + if not (name = "install" || String.Set.mem contexts name) then die "%s refers to unknown build context: %s%s" (Path.to_string_maybe_quoted path) name - (hint name (String_set.to_list contexts)) + (hint name (String.Set.to_list contexts)) let resolve_targets ~log common (setup : Main.setup) user_targets = match user_targets with @@ -772,7 +772,7 @@ let external_lib_deps = in let externals = String_map.filteri lib_deps ~f:(fun name _ -> - not (String_set.mem internals name)) + not (String.Set.mem internals name)) in if only_missing then begin let context = @@ -811,8 +811,8 @@ let external_lib_deps = match (kind : Build.lib_dep_kind) with | Optional -> None | Required -> Some (Findlib.root_package_name name)) - |> String_set.of_list - |> String_set.to_list + |> String.Set.of_list + |> String.Set.to_list |> String.concat ~sep:" "); true end diff --git a/src/action.ml b/src/action.ml index d465f079..ac780e89 100644 --- a/src/action.ml +++ b/src/action.ml @@ -890,18 +890,18 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = | Merge_files_into (sources, extras, target) -> let lines = List.fold_left - ~init:(String_set.of_list extras) + ~init:(String.Set.of_list extras) ~f:(fun set source_path -> Path.to_string source_path |> Io.lines_of_file - |> String_set.of_list - |> String_set.union set + |> String.Set.of_list + |> String.Set.union set ) sources in Io.write_lines (Path.to_string target) - (String_set.to_list lines); + (String.Set.to_list lines); Fiber.return () and redirect outputs fn t ~ectx ~dir ~env ~stdout_to ~stderr_to = diff --git a/src/build.ml b/src/build.ml index 247d6d89..e3d59093 100644 --- a/src/build.ml +++ b/src/build.ml @@ -91,7 +91,7 @@ let record_lib_deps ~kind lib_deps = | Jbuild.Lib_dep.Direct (_, s) -> [(s, kind)] | Select { choices; _ } -> List.concat_map choices ~f:(fun c -> - String_set.to_list c.Jbuild.Lib_dep.required + String.Set.to_list c.Jbuild.Lib_dep.required |> List.map ~f:(fun d -> (d, Optional)))) |> String_map.of_list_reduce ~f:merge_lib_dep_kind) diff --git a/src/build_system.ml b/src/build_system.ml index d6bf4c49..bebc05ac 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -336,7 +336,7 @@ end type extra_sub_directories_to_keep = | All - | These of String_set.t + | These of String.Set.t type hook = | Rule_started @@ -624,7 +624,7 @@ let remove_old_artifacts t ~dir ~subdirs_to_keep = match subdirs_to_keep with | All -> () | These set -> - if String_set.mem set fn || + if String.Set.mem set fn || Pset.mem t.build_dirs_to_keep path then () else @@ -854,7 +854,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = (* Load all the rules *) let extra_subdirs_to_keep = if context_name = "install" then - These String_set.empty + These String.Set.empty else let gen_rules = Option.value_exn (String_map.find t.gen_rules context_name) in gen_rules ~dir (Option.value_exn (Path.explode sub_dir)) @@ -922,13 +922,13 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = | "install" -> (user_rule_targets, None, - String_set.empty) + String.Set.empty) | ctx_name -> (* This condition is [true] because of [get_dir_status] *) assert (String_map.mem t.contexts ctx_name); let files, subdirs = match File_tree.find_dir t.file_tree sub_dir with - | None -> (Pset.empty, String_set.empty) + | None -> (Pset.empty, String.Set.empty) | Some dir -> (File_tree.Dir.file_paths dir, File_tree.Dir.sub_dir_names dir) @@ -946,7 +946,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = let subdirs_to_keep = match extra_subdirs_to_keep with | All -> All - | These set -> These (String_set.union subdirs_to_keep set) + | These set -> These (String.Set.union subdirs_to_keep set) in (* Filter out fallback rules *) @@ -1507,8 +1507,8 @@ let eval_glob t ~dir re = match File_tree.find_dir t.file_tree dir with | None -> targets | Some d -> - String_set.union (String_set.of_list targets) (File_tree.Dir.files d) - |> String_set.to_list + String.Set.union (String.Set.of_list targets) (File_tree.Dir.files d) + |> String.Set.to_list in List.filter files ~f:(Re.execp re) diff --git a/src/build_system.mli b/src/build_system.mli index 82f99435..62887804 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -22,7 +22,7 @@ val create type extra_sub_directories_to_keep = | All - | These of String_set.t + | These of String.Set.t (** Set the rule generators callback. There must be one callback per build context name. diff --git a/src/file_tree.ml b/src/file_tree.ml index 8233ddcc..7f305950 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -3,7 +3,7 @@ open! Import module Dir = struct type t = { path : Path.t - ; files : String_set.t + ; files : String.Set.t ; sub_dirs : t String_map.t ; ignored : bool } @@ -17,8 +17,8 @@ module Dir = struct Path.Set.of_string_set t.files ~f:(Path.relative t.path) let sub_dir_names t = - String_map.foldi t.sub_dirs ~init:String_set.empty - ~f:(fun s _ acc -> String_set.add acc s) + String_map.foldi t.sub_dirs ~init:String.Set.empty + ~f:(fun s _ acc -> String.Set.add acc s) let sub_dir_paths t = String_map.foldi t.sub_dirs ~init:Path.Set.empty @@ -59,9 +59,9 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path = else Left fn) in - let files = String_set.of_list files in + let files = String.Set.of_list files in let ignored_sub_dirs = - if not ignored && String_set.mem files "jbuild-ignore" then + if not ignored && String.Set.mem files "jbuild-ignore" then let ignore_file = Path.to_string (Path.relative path "jbuild-ignore") in let files = Io.lines_of_file ignore_file @@ -75,15 +75,15 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path = false end in - String_set.of_list (List.filteri ~f:remove_subdirs files) + String.Set.of_list (List.filteri ~f:remove_subdirs files) else - String_set.empty + String.Set.empty in let sub_dirs = List.map sub_dirs ~f:(fun (fn, path) -> let ignored = ignored - || String_set.mem ignored_sub_dirs fn + || String.Set.mem ignored_sub_dirs fn || Path.Set.mem extra_ignored_subtrees path in (fn, walk path ~ignored)) @@ -119,7 +119,7 @@ let files_of t path = let file_exists t path fn = match Path.Map.find t.dirs path with | None -> false - | Some { files; _ } -> String_set.mem files fn + | Some { files; _ } -> String.Set.mem files fn let exists t path = Path.Map.mem t.dirs path || @@ -132,5 +132,5 @@ let files_recursively_in t ?(prefix_with=Path.root) path = Dir.fold dir ~init:Path.Set.empty ~traverse_ignored_dirs:true ~f:(fun dir acc -> let path = Path.append prefix_with (Dir.path dir) in - String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc -> + String.Set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc -> Path.Set.add acc (Path.relative path fn))) diff --git a/src/file_tree.mli b/src/file_tree.mli index 3559c662..cb1a8173 100644 --- a/src/file_tree.mli +++ b/src/file_tree.mli @@ -4,11 +4,11 @@ module Dir : sig type t val path : t -> Path.t - val files : t -> String_set.t + val files : t -> String.Set.t val file_paths : t -> Path.Set.t val sub_dirs : t -> t String_map.t val sub_dir_paths : t -> Path.Set.t - val sub_dir_names : t -> String_set.t + val sub_dir_names : t -> String.Set.t (** Whether this directory is ignored by a [jbuild-ignore] file in one of its ancestor directories. *) diff --git a/src/findlib.ml b/src/findlib.ml index f1d9d87a..51eb501b 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -311,13 +311,13 @@ let root_packages t = |> Array.to_list |> List.filter ~f:(fun name -> Path.exists (Path.relative dir (name ^ "/META")))) - |> String_set.of_list + |> String.Set.of_list in let pkgs = - String_set.union pkgs - (String_set.of_list (String_map.keys t.builtins)) + String.Set.union pkgs + (String.Set.of_list (String_map.keys t.builtins)) in - String_set.to_list pkgs + String.Set.to_list pkgs let load_all_packages t = List.iter (root_packages t) ~f:(fun pkg -> diff --git a/src/gen_meta.ml b/src/gen_meta.ml index c9e2c2b2..d9a91e13 100644 --- a/src/gen_meta.ml +++ b/src/gen_meta.ml @@ -31,7 +31,7 @@ module Pub_name = struct let to_string t = String.concat ~sep:"." (to_list t) end -let string_of_deps deps = String_set.to_list deps |> String.concat ~sep:" " +let string_of_deps deps = String.Set.to_list deps |> String.concat ~sep:" " let rule var predicates action value = Rule { var; predicates; action; value } @@ -81,7 +81,7 @@ let gen_lib pub_name lib ~version = ; requires ~preds lib_deps ] ; archives ~preds lib - ; if String_set.is_empty ppx_rt_deps then + ; if String.Set.is_empty ppx_rt_deps then [] else [ Comment "This is what jbuilder uses to find out the runtime \ diff --git a/src/gen_rules.ml b/src/gen_rules.ml index ef7e54ed..9f05227f 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -245,7 +245,7 @@ module Gen(P : Install_rules.Params) = struct fun ~dir -> Hashtbl.find_or_add cache dir ~f:(fun dir -> match Path.Map.find stanzas_per_dir dir with - | None -> String_set.empty + | None -> String.Set.empty | Some { stanzas; src_dir; scope; _ } -> (* Interpret a few stanzas in order to determine the list of files generated by the user. *) @@ -268,9 +268,9 @@ module Gen(P : Install_rules.Params) = struct | Direct _ -> None | Select s -> Some s.result_fn) | Documentation _ | Alias _ | Provides _ | Install _ -> []) - |> String_set.of_list + |> String.Set.of_list in - String_set.union generated_files + String.Set.union generated_files (SC.source_files sctx ~src_path:src_dir)) (* +-----------------------------------------------------------------+ @@ -279,7 +279,7 @@ module Gen(P : Install_rules.Params) = struct let guess_modules ~dir ~files = let impl_files, intf_files = - String_set.to_list files + String.Set.to_list files |> List.filter_partition_map ~f:(fun fn -> (* we aren't using Filename.extension because we want to handle filenames such as foo.cppo.ml *) @@ -314,7 +314,7 @@ module Gen(P : Install_rules.Params) = struct ) let guess_mlds ~files = - String_set.to_list files + String.Set.to_list files |> List.filter_map ~f:(fun fn -> match String.lsplit2 fn ~on:'.' with | Some (s, "mld") -> Some (s, fn) @@ -620,7 +620,7 @@ module Gen(P : Install_rules.Params) = struct if Library.has_stubs lib then begin let h_files = - String_set.to_list files + String.Set.to_list files |> List.filter_map ~f:(fun fn -> if String.is_suffix fn ~suffix:".h" then Some (Path.relative dir fn) @@ -998,9 +998,9 @@ module Gen(P : Install_rules.Params) = struct (Path.drop_build_context_exn dir)) then SC.load_dir sctx ~dir:(Path.parent dir)); match components with - | [] -> These (String_set.of_list [".js"; "_doc"; ".ppx"]) + | [] -> These (String.Set.of_list [".js"; "_doc"; ".ppx"]) | [(".js"|"_doc"|".ppx")] -> All - | _ -> These String_set.empty + | _ -> These String.Set.empty let init () = let module Install_rules = diff --git a/src/import.ml b/src/import.ml index b233dbaf..0b4565ef 100644 --- a/src/import.ml +++ b/src/import.ml @@ -10,7 +10,6 @@ let ksprintf = Printf.ksprintf let initial_cwd = Sys.getcwd () -module String_set = Set.Make(String) module String_map = struct include Map.Make(String) diff --git a/src/install_rules.ml b/src/install_rules.ml index fed05398..c96a18c3 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -219,7 +219,7 @@ module Gen(P : Install_params) = struct let install_file package_path package entries = let entries = let files = SC.source_files sctx ~src_path:Path.root in - String_set.fold files ~init:entries ~f:(fun fn acc -> + String.Set.fold files ~init:entries ~f:(fun fn acc -> if is_odig_doc_file fn then Install.Entry.make Doc (Path.relative ctx.build_dir fn) :: acc else diff --git a/src/jbuild.ml b/src/jbuild.ml index d3fd4581..9d85b14f 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -36,7 +36,7 @@ let module_name sexp = | _ -> invalid_module_name name sexp); String.capitalize s -let module_names sexp = String_set.of_list (list module_name sexp) +let module_names sexp = String.Set.of_list (list module_name sexp) let invalid_lib_name sexp = of_sexp_error sexp "invalid library name" @@ -304,7 +304,7 @@ module Per_module = struct | List (_, Atom (_, A "per_module") :: rest) -> begin List.map rest ~f:(fun sexp -> let pp, names = pair a module_names sexp in - (List.map ~f:Module.Name.of_string (String_set.to_list names), pp)) + (List.map ~f:Module.Name.of_string (String.Set.to_list names), pp)) |> of_mapping ~default |> function | Ok t -> t @@ -367,8 +367,8 @@ end module Lib_dep = struct type choice = - { required : String_set.t - ; forbidden : String_set.t + { required : String.Set.t + ; forbidden : String.Set.t ; file : string } @@ -386,8 +386,8 @@ module Lib_dep = struct | List (_, l) as sexp -> let rec loop required forbidden = function | [Atom (_, A "->"); fsexp] -> - let common = String_set.inter required forbidden in - Option.iter (String_set.choose common) ~f:(fun name -> + let common = String.Set.inter required forbidden in + Option.iter (String.Set.choose common) ~f:(fun name -> of_sexp_errorf sexp "library %S is both required and forbidden in this clause" name); @@ -402,11 +402,11 @@ module Lib_dep = struct let len = String.length s in if len > 0 && s.[0] = '!' then let s = String.sub s ~pos:1 ~len:(len - 1) in - loop required (String_set.add forbidden s) l + loop required (String.Set.add forbidden s) l else - loop (String_set.add required s) forbidden l + loop (String.Set.add required s) forbidden l in - loop String_set.empty String_set.empty l + loop String.Set.empty String.Set.empty l | sexp -> of_sexp_error sexp "( ) expected" let t = function @@ -423,9 +423,9 @@ module Lib_dep = struct let to_lib_names = function | Direct (_, s) -> [s] | Select s -> - List.fold_left s.choices ~init:String_set.empty ~f:(fun acc x -> - String_set.union acc (String_set.union x.required x.forbidden)) - |> String_set.to_list + List.fold_left s.choices ~init:String.Set.empty ~f:(fun acc x -> + String.Set.union acc (String.Set.union x.required x.forbidden)) + |> String.Set.to_list let direct x = Direct x @@ -466,8 +466,8 @@ module Lib_deps = struct | Lib_dep.Direct (_, s) -> add Required s acc | Select { choices; _ } -> List.fold_left choices ~init:acc ~f:(fun acc c -> - let acc = String_set.fold c.Lib_dep.required ~init:acc ~f:(add Optional) in - String_set.fold c.forbidden ~init:acc ~f:(add Forbidden))) + let acc = String.Set.fold c.Lib_dep.required ~init:acc ~f:(add Optional) in + String.Set.fold c.forbidden ~init:acc ~f:(add Forbidden))) : kind String_map.t); t @@ -1298,14 +1298,14 @@ module Stanzas = struct (line_loc x)))) let lib_names ts = - List.fold_left ts ~init:String_set.empty ~f:(fun acc (_, _, stanzas) -> + List.fold_left ts ~init:String.Set.empty ~f:(fun acc (_, _, stanzas) -> List.fold_left stanzas ~init:acc ~f:(fun acc -> function | Stanza.Library lib -> let acc = match lib.public with | None -> acc - | Some { name; _ } -> String_set.add acc name + | Some { name; _ } -> String.Set.add acc name in - String_set.add acc lib.name + String.Set.add acc lib.name | _ -> acc)) end diff --git a/src/jbuild.mli b/src/jbuild.mli index cc38d1ea..36a1cbea 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -95,8 +95,8 @@ end module Lib_dep : sig type choice = - { required : String_set.t - ; forbidden : String_set.t + { required : String.Set.t + ; forbidden : String.Set.t ; file : string } @@ -392,5 +392,5 @@ module Stanzas : sig -> Scope_info.t -> Sexp.Ast.t list -> t - val lib_names : (_ * _ * t) list -> String_set.t + val lib_names : (_ * _ * t) list -> String.Set.t end diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 2bf6e9dd..56b3b857 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -187,7 +187,7 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs -> let path = File_tree.Dir.path dir in let files = File_tree.Dir.files dir in - String_set.fold files ~init:pkgs ~f:(fun fn acc -> + String.Set.fold files ~init:pkgs ~f:(fun fn acc -> match Filename.split_extension fn with | (pkg, ".opam") when pkg <> "" -> let version_from_opam_file = @@ -237,7 +237,7 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = let sub_dirs = File_tree.Dir.sub_dirs dir in let scope = Option.value (Path.Map.find scopes path) ~default:scope in let jbuilds = - if String_set.mem files "jbuild" then + if String.Set.mem files "jbuild" then let jbuild = load ~dir:path ~scope ~ignore_promoted_rules in jbuild :: jbuilds else diff --git a/src/lib.ml b/src/lib.ml index 37a69471..b246eeb7 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -768,13 +768,13 @@ and resolve_complex_deps db deps ~allow_private_deps ~stack = let res, src_fn = match List.find_map choices ~f:(fun { required; forbidden; file } -> - if String_set.exists forbidden + if String.Set.exists forbidden ~f:(available_internal db ~stack) then None else match let deps = - String_set.fold required ~init:[] ~f:(fun x acc -> + String.Set.fold required ~init:[] ~f:(fun x acc -> (Loc.none, x) :: acc) in resolve_simple_deps ~allow_private_deps db deps ~stack @@ -1110,8 +1110,8 @@ end module Meta = struct let to_names ts = - List.fold_left ts ~init:String_set.empty ~f:(fun acc t -> - String_set.add acc t.name) + List.fold_left ts ~init:String.Set.empty ~f:(fun acc t -> + String.Set.add acc t.name) (* For the deprecated method, we need to put all the runtime dependencies of the transitive closure. diff --git a/src/lib.mli b/src/lib.mli index da50b8c5..6ab24343 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -336,7 +336,7 @@ end with type lib := t (** {1 Dependencies for META files} *) module Meta : sig - val requires : t -> String_set.t - val ppx_runtime_deps : t -> String_set.t - val ppx_runtime_deps_for_deprecated_method : t -> String_set.t + val requires : t -> String.Set.t + val ppx_runtime_deps : t -> String.Set.t + val ppx_runtime_deps_for_deprecated_method : t -> String.Set.t end diff --git a/src/main.ml b/src/main.ml index 428205f8..11cf6a03 100644 --- a/src/main.ml +++ b/src/main.ml @@ -128,7 +128,7 @@ let external_lib_deps ?log ~packages () = (Build_system.all_lib_deps setup.build_system ~request:(Build.paths install_files)) ~f:(String_map.filteri ~f:(fun name _ -> - not (String_set.mem internals name)))) + not (String.Set.mem internals name)))) let ignored_during_bootstrap = Path.Set.of_list diff --git a/src/merlin.ml b/src/merlin.ml index 0089079e..68d2d735 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -141,8 +141,8 @@ let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) = ] in dot_merlin - |> String_set.of_list - |> String_set.to_list + |> String.Set.of_list + |> String.Set.to_list |> List.map ~f:(Printf.sprintf "%s\n") |> String.concat ~sep:"") >>> diff --git a/src/module.ml b/src/module.ml index cf88729f..945d6cdb 100644 --- a/src/module.ml +++ b/src/module.ml @@ -14,7 +14,7 @@ module Name = struct let pp = Format.pp_print_string let pp_quote fmt x = Format.fprintf fmt "%S" x - module Set = String_set + module Set = String.Set module Map = String_map module Top_closure = Top_closure.String end diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index 61c0c10b..eeade900 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -215,13 +215,13 @@ module Unexpanded = struct | Element _ | Special _ -> acc | Include fn -> - String_set.add acc (f fn) + String.Set.add acc (f fn) | Union l -> List.fold_left l ~init:acc ~f:loop | Diff (l, r) -> loop (loop acc l) r in - loop String_set.empty t.ast + loop String.Set.empty t.ast let expand t ~files_contents ~f = let rec expand (t : ast) : ast_expanded = diff --git a/src/ordered_set_lang.mli b/src/ordered_set_lang.mli index 5a2f4859..7a68f151 100644 --- a/src/ordered_set_lang.mli +++ b/src/ordered_set_lang.mli @@ -59,7 +59,7 @@ module Unexpanded : sig val field : ?default:t -> string -> t Sexp.Of_sexp.record_parser (** List of files needed to expand this set *) - val files : t -> f:(String_with_vars.t -> string) -> String_set.t + val files : t -> f:(String_with_vars.t -> string) -> String.Set.t (** Expand [t] using with the given file contents. [file_contents] is a map from filenames to their parsed contents. Every [(:include fn)] in [t] is replaced by diff --git a/src/path.ml b/src/path.ml index f46cdf71..61176c88 100644 --- a/src/path.ml +++ b/src/path.ml @@ -59,7 +59,7 @@ module Local = struct let compare = String.compare - module Set = String_set + module Set = String.Set let to_list = let rec loop t acc i j = @@ -221,8 +221,8 @@ type t = string let compare = String.compare module Set = struct - include String_set - let sexp_of_t t = Sexp.To_sexp.(list string) (String_set.to_list t) + include String.Set + let sexp_of_t t = Sexp.To_sexp.(list string) (String.Set.to_list t) let of_string_set = map end diff --git a/src/path.mli b/src/path.mli index b43ee8d9..ccc0f15c 100644 --- a/src/path.mli +++ b/src/path.mli @@ -42,7 +42,7 @@ val compare : t -> t -> Ordering.t module Set : sig include Set.S with type elt = t val sexp_of_t : t Sexp.To_sexp.t - val of_string_set : String_set.t -> f:(string -> elt) -> t + val of_string_set : String.Set.t -> f:(string -> elt) -> t end module Map : Map.S with type key = t diff --git a/src/process.ml b/src/process.ml index 5fee4593..8c93000e 100644 --- a/src/process.ml +++ b/src/process.ml @@ -49,22 +49,22 @@ type purpose = | Build_job of Path.t list module Temp = struct - let tmp_files = ref String_set.empty + let tmp_files = ref String.Set.empty let () = at_exit (fun () -> let fns = !tmp_files in - tmp_files := String_set.empty; - String_set.iter fns ~f:(fun fn -> + tmp_files := String.Set.empty; + String.Set.iter fns ~f:(fun fn -> try Sys.force_remove fn with _ -> ())) let create prefix suffix = let fn = Filename.temp_file prefix suffix in - tmp_files := String_set.add !tmp_files fn; + tmp_files := String.Set.add !tmp_files fn; fn let destroy fn = (try Sys.force_remove fn with Sys_error _ -> ()); - tmp_files := String_set.remove !tmp_files fn + tmp_files := String.Set.remove !tmp_files fn end module Fancy = struct @@ -142,7 +142,7 @@ module Fancy = struct Format.fprintf ppf "(internal)" | Build_job targets -> let rec split_paths targets_acc ctxs_acc = function - | [] -> List.rev targets_acc, String_set.(to_list (of_list ctxs_acc)) + | [] -> List.rev targets_acc, String.Set.(to_list (of_list ctxs_acc)) | path :: rest -> let add_ctx ctx acc = if ctx = "default" then acc else ctx :: acc in match Utils.analyse_target path with diff --git a/src/report_error.ml b/src/report_error.ml index 13dfc4c8..ca111d1e 100644 --- a/src/report_error.ml +++ b/src/report_error.ml @@ -74,7 +74,7 @@ let report_with_backtrace exn = Format.fprintf ppf "@{Error@}: exception %s\n" s } -let reported = ref String_set.empty +let reported = ref String.Set.empty let report exn = let exn, dependency_path = Dep_path.unwrap_exn exn in @@ -91,10 +91,10 @@ let report exn = let s = Buffer.contents err_buf in (* Hash to avoid keeping huge errors in memory *) let hash = Digest.string s in - if String_set.mem !reported hash then + if String.Set.mem !reported hash then Buffer.clear err_buf else begin - reported := String_set.add !reported hash; + reported := String.Set.add !reported hash; if p.backtrace || !Clflags.debug_backtraces then Format.fprintf ppf "Backtrace:\n%s" (Printexc.raw_backtrace_to_string backtrace); diff --git a/src/sexp.ml b/src/sexp.ml index 71dacfaa..707c56ab 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -77,7 +77,7 @@ 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 : String_set.t t + val string_set : String.Set.t t val string_map : 'a t -> 'a String_map.t t val string_hashtbl : 'a t -> (string, 'a) Hashtbl.t t end @@ -96,7 +96,7 @@ 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_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])) @@ -181,7 +181,7 @@ module Of_sexp = struct | List (_, [x]) -> Some (f x) | sexp -> of_sexp_error sexp "S-expression of the form () or (_) expected" - let string_set sexp = String_set.of_list (list string sexp) + let string_set sexp = String.Set.of_list (list string sexp) let string_map f sexp = match String_map.of_list (list (pair string f) sexp) with | Ok x -> x diff --git a/src/sexp.mli b/src/sexp.mli index d28798b4..b281ddf7 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -29,7 +29,7 @@ module type Combinators = sig val array : 'a t -> 'a array t val option : 'a t -> 'a option t - val string_set : String_set.t t + val string_set : String.Set.t t (** [atom_set] is a conversion to/from a set of strings representing atoms. *) val string_map : 'a t -> 'a String_map.t t diff --git a/src/stdune/string.ml b/src/stdune/string.ml index fdd727de..7b8a0e46 100644 --- a/src/stdune/string.ml +++ b/src/stdune/string.ml @@ -13,6 +13,11 @@ include StringLabels let compare a b = Ordering.of_int (String.compare a b) +module T = struct + type t = StringLabels.t + let compare = compare +end + let capitalize = capitalize_ascii let uncapitalize = uncapitalize_ascii let uppercase = uppercase_ascii @@ -169,3 +174,5 @@ let exists s ~f = false with Exit -> true + +module Set = Set.Make(T) diff --git a/src/stdune/string.mli b/src/stdune/string.mli index 48e45275..f0e526cf 100644 --- a/src/stdune/string.mli +++ b/src/stdune/string.mli @@ -39,3 +39,5 @@ val longest : string list -> int val longest_map : 'a list -> f:('a -> string) -> int val exists : t -> f:(char -> bool) -> bool + +module Set : Set.S with type elt = t diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 0b76b6ba..554dced1 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -97,7 +97,7 @@ let iter t ~f = List.iter t.items ~f:(function | Text _ -> () | Var (_, v) -> f t.loc v) -let vars t = fold t ~init:String_set.empty ~f:(fun acc _ x -> String_set.add acc x) +let vars t = fold t ~init:String.Set.empty ~f:(fun acc _ x -> String.Set.add acc x) let string_of_var syntax v = match syntax with diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 14afb0f4..29eea545 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -32,7 +32,7 @@ val virt : ?quoted: bool -> (string * int * int * int) -> string -> t val virt_var : ?quoted: bool -> (string * int * int * int) -> string -> t val virt_text : (string * int * int * int) -> string -> t -val vars : t -> String_set.t +val vars : t -> String.Set.t (** [vars t] returns the set of all variables in [t]. *) val fold : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a diff --git a/src/super_context.ml b/src/super_context.ml index 1e379a00..4e6e6a0f 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -251,7 +251,7 @@ let on_load_dir t ~dir ~f = Build_system.on_load_dir t.build_system ~dir ~f let source_files t ~src_path = match File_tree.find_dir t.file_tree src_path with - | None -> String_set.empty + | None -> String.Set.empty | Some dir -> File_tree.Dir.files dir module Libs = struct @@ -700,7 +700,7 @@ let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = let open Build.O in let f = expand_vars t ~scope ~dir ?extra_vars in let parse ~loc:_ s = s in - match Ordered_set_lang.Unexpanded.files set ~f |> String_set.to_list with + match Ordered_set_lang.Unexpanded.files set ~f |> String.Set.to_list with | [] -> let set = Ordered_set_lang.Unexpanded.expand set ~files_contents:String_map.empty ~f diff --git a/src/super_context.mli b/src/super_context.mli index 860d3a50..c888ae68 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -114,7 +114,7 @@ val eval_glob : t -> dir:Path.t -> Re.re -> string list val load_dir : t -> dir:Path.t -> unit val on_load_dir : t -> dir:Path.t -> f:(unit -> unit) -> unit -val source_files : t -> src_path:Path.t -> String_set.t +val source_files : t -> src_path:Path.t -> String.Set.t (** [prog_spec t ?hint name] resolve a program. [name] is looked up in the workspace, if it is not found in the tree is is looked up in the PATH. If it diff --git a/src/top_closure.ml b/src/top_closure.ml index 8b7c9122..f7490947 100644 --- a/src/top_closure.ml +++ b/src/top_closure.ml @@ -47,4 +47,4 @@ module Make(Keys : Keys) = struct end module Int = Make(Int_set) -module String = Make(String_set) +module String = Make(String.Set) diff --git a/src/workspace.ml b/src/workspace.ml index 60bda09e..70448a68 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -73,7 +73,7 @@ type t = } let t ?x sexps = - let defined_names = ref String_set.empty in + let defined_names = ref String.Set.empty in let merlin_ctx, contexts = List.fold_left sexps ~init:(None, []) ~f:(fun (merlin_ctx, ctxs) sexp -> let ctx = @@ -104,10 +104,10 @@ let t ?x sexps = String.contains name '/' || String.contains name '\\' then of_sexp_errorf sexp "%S is not allowed as a build context name" name; - if String_set.mem !defined_names name then + if String.Set.mem !defined_names name then of_sexp_errorf sexp "second definition of build context %S" name; - defined_names := String_set.union !defined_names - (String_set.of_list (Context.all_names ctx)); + defined_names := String.Set.union !defined_names + (String.Set.of_list (Context.all_names ctx)); match ctx, merlin_ctx with | Opam { merlin = true; _ }, Some _ -> of_sexp_errorf sexp "you can only have one context for merlin" From 98b2ea795c2d40932cd909a153a396e447efb810 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 23 Apr 2018 12:43:20 +0700 Subject: [PATCH 2/3] Move String_map to stdune --- bin/main.ml | 16 ++++---- src/artifacts.ml | 8 ++-- src/build.ml | 6 +-- src/build.mli | 2 +- src/build_interpret.ml | 2 +- src/build_system.ml | 60 +++++++++++++++--------------- src/build_system.mli | 4 +- src/configurator/v1.ml | 11 +++--- src/file_tree.ml | 10 ++--- src/file_tree.mli | 2 +- src/findlib.ml | 18 ++++----- src/gen_meta.ml | 4 +- src/gen_rules.ml | 16 ++++---- src/gen_rules.mli | 2 +- src/import.ml | 2 +- src/inline_tests.ml | 4 +- src/jbuild.ml | 8 ++-- src/jbuild_load.ml | 2 +- src/lib.ml | 12 +++--- src/main.ml | 6 +-- src/main.mli | 2 +- src/meta.ml | 10 ++--- src/meta.mli | 4 +- src/module.ml | 2 +- src/ocaml-config/ocaml_config.ml | 8 ++-- src/ocaml-config/ocaml_config.mli | 2 +- src/odoc.ml | 8 ++-- src/ordered_set_lang.ml | 12 +++--- src/ordered_set_lang.mli | 4 +- src/path.ml | 2 +- src/process.ml | 4 +- src/scope.ml | 6 +-- src/sexp.ml | 14 +++---- src/sexp.mli | 2 +- src/stdune/string.ml | 1 + src/stdune/string.mli | 1 + src/super_context.ml | 36 +++++++++--------- src/super_context.mli | 6 +-- src/watermarks.ml | 6 +-- test/unit-tests/import_dot_map.mlt | 6 +-- 40 files changed, 165 insertions(+), 166 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 5d32efae..6aed5641 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -735,7 +735,7 @@ let clean = , Term.info "clean" ~doc ~man) let format_external_libs libs = - String_map.to_list libs + String.Map.to_list libs |> List.map ~f:(fun (name, kind) -> match (kind : Build.lib_dep_kind) with | Optional -> sprintf "- %s (optional)" name @@ -761,17 +761,17 @@ let external_lib_deps = let targets = resolve_targets_exn ~log common setup targets in let request = request_of_targets setup targets in let failure = - String_map.foldi ~init:false + String.Map.foldi ~init:false (Build_system.all_lib_deps_by_context setup.build_system ~request) ~f:(fun context_name lib_deps acc -> let internals = Jbuild.Stanzas.lib_names - (match String_map.find setup.Main.stanzas context_name with + (match String.Map.find setup.Main.stanzas context_name with | None -> assert false | Some x -> x) in let externals = - String_map.filteri lib_deps ~f:(fun name _ -> + String.Map.filteri lib_deps ~f:(fun name _ -> not (String.Set.mem internals name)) in if only_missing then begin @@ -783,12 +783,12 @@ let external_lib_deps = | Some c -> c in let missing = - String_map.filteri externals ~f:(fun name _ -> + String.Map.filteri externals ~f:(fun name _ -> not (Findlib.available context.findlib name)) in - if String_map.is_empty missing then + if String.Map.is_empty missing then acc - else if String_map.for_alli missing + else if String.Map.for_alli missing ~f:(fun _ kind -> kind = Build.Optional) then begin Format.eprintf @@ -806,7 +806,7 @@ let external_lib_deps = Hint: try: opam install %s@." context_name (format_external_libs missing) - (String_map.to_list missing + (String.Map.to_list missing |> List.filter_map ~f:(fun (name, kind) -> match (kind : Build.lib_dep_kind) with | Optional -> None diff --git a/src/artifacts.ml b/src/artifacts.ml index 06e5dc62..d614d0bc 100644 --- a/src/artifacts.ml +++ b/src/artifacts.ml @@ -3,14 +3,14 @@ open Jbuild type t = { context : Context.t - ; local_bins : Path.t String_map.t + ; local_bins : Path.t String.Map.t ; public_libs : Lib.DB.t } let create (context : Context.t) ~public_libs l ~f = let bin_dir = Config.local_install_bin_dir ~context:context.name in let local_bins = - List.fold_left l ~init:String_map.empty ~f:(fun acc x -> + List.fold_left l ~init:String.Map.empty ~f:(fun acc x -> List.fold_left (f x) ~init:acc ~f:(fun local_bins stanza -> match (stanza : Stanza.t) with | Install { section = Bin; files; _ } -> @@ -42,7 +42,7 @@ let create (context : Context.t) ~public_libs l ~f = in Path.relative bin_dir fn in - String_map.add acc key in_bin_dir) + String.Map.add acc key in_bin_dir) | _ -> local_bins)) in @@ -55,7 +55,7 @@ let binary t ?hint name = if not (Filename.is_relative name) then Ok (Path.absolute name) else - match String_map.find t.local_bins name with + match String.Map.find t.local_bins name with | Some path -> Ok path | None -> match Context.which t.context name with diff --git a/src/build.ml b/src/build.ml index e3d59093..1d69484a 100644 --- a/src/build.ml +++ b/src/build.ml @@ -9,7 +9,7 @@ end type lib_dep_kind = | Optional | Required -type lib_deps = lib_dep_kind String_map.t +type lib_deps = lib_dep_kind String.Map.t let merge_lib_dep_kind a b = match a, b with @@ -73,7 +73,7 @@ include Repr let repr t = t let merge_lib_deps a b = - String_map.merge a b ~f:(fun _ a b -> + String.Map.merge a b ~f:(fun _ a b -> match a, b with | None, None -> None | x, None | None, x -> x @@ -93,7 +93,7 @@ let record_lib_deps ~kind lib_deps = List.concat_map choices ~f:(fun c -> String.Set.to_list c.Jbuild.Lib_dep.required |> List.map ~f:(fun d -> (d, Optional)))) - |> String_map.of_list_reduce ~f:merge_lib_dep_kind) + |> String.Map.of_list_reduce ~f:merge_lib_dep_kind) module O = struct let ( >>> ) a b = diff --git a/src/build.mli b/src/build.mli index d10508b9..bb13b950 100644 --- a/src/build.mli +++ b/src/build.mli @@ -174,7 +174,7 @@ val record_lib_deps -> Jbuild.Lib_dep.t list -> ('a, 'a) t -type lib_deps = lib_dep_kind String_map.t +type lib_deps = lib_dep_kind String.Map.t val record_lib_deps_simple : lib_deps -> ('a, 'a) t diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 59037a43..2ab5c98a 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -144,7 +144,7 @@ let lib_deps = | Memo m -> loop m.t acc | Catch (t, _) -> loop t acc in - fun t -> loop (Build.repr t) String_map.empty + fun t -> loop (Build.repr t) String.Map.empty let targets = let rec loop : type a b. (a, b) t -> Target.t list -> Target.t list = fun t acc -> diff --git a/src/build_system.ml b/src/build_system.ml index bebc05ac..957e6006 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -315,7 +315,7 @@ module Dir_status = struct type rules_collector = { mutable rules : Build_interpret.Rule.t list - ; mutable aliases : alias String_map.t + ; mutable aliases : alias String.Map.t ; mutable stage : collection_stage } @@ -328,9 +328,9 @@ end module Files_of = struct type t = - { files_by_ext : Path.t list String_map.t + { files_by_ext : Path.t list String.Map.t ; dir_hash : string - ; mutable stamps : Path.t String_map.t + ; mutable stamps : Path.t String.Map.t } end @@ -345,7 +345,7 @@ type hook = type t = { (* File specification by targets *) files : (Path.t, File_spec.packed) Hashtbl.t - ; contexts : Context.t String_map.t + ; contexts : Context.t String.Map.t ; (* Table from target to digest of [(deps (filename + contents), targets (filename only), action)] *) trace : (Path.t, Digest.t) Hashtbl.t @@ -353,7 +353,7 @@ type t = ; mutable local_mkdirs : Path.Local.Set.t ; mutable dirs : (Path.t, Dir_status.t) Hashtbl.t ; mutable gen_rules : - (dir:Path.t -> string list -> extra_sub_directories_to_keep) String_map.t + (dir:Path.t -> string list -> extra_sub_directories_to_keep) String.Map.t ; mutable load_dir_stack : Path.t list ; (* Set of directories under _build that have at least one rule and all their ancestors. *) @@ -373,7 +373,7 @@ let string_of_paths set = |> String.concat ~sep:"\n" let set_rule_generators t generators = - assert (String_map.keys generators = String_map.keys t.contexts); + assert (String.Map.keys generators = String.Map.keys t.contexts); t.gen_rules <- generators let get_dir_status t ~dir = @@ -393,12 +393,12 @@ let get_dir_status t ~dir = let (ctx, sub_dir) = Option.value_exn (Path.extract_build_context dir) in if ctx = ".aliases" then Forward (Path.(append build_dir) sub_dir) - else if ctx <> "install" && not (String_map.mem t.contexts ctx) then + else if ctx <> "install" && not (String.Map.mem t.contexts ctx) then Dir_status.Loaded Pset.empty else Collecting_rules { rules = [] - ; aliases = String_map.empty + ; aliases = String.Map.empty ; stage = Pending { lazy_generators = [] } } end) @@ -643,13 +643,13 @@ let no_rule_found = match Path.extract_build_context fn with | None -> fail fn | Some (ctx, _) -> - if String_map.mem t.contexts ctx then + if String.Map.mem t.contexts ctx then fail fn else die "Trying to build %s but build context %s doesn't exist.%s" (Path.to_string_maybe_quoted fn) ctx - (hint ctx (String_map.keys t.contexts)) + (hint ctx (String.Map.keys t.contexts)) let rec compile_rule t ?(copy_source=false) pre_rule = let { Pre_rule. @@ -856,7 +856,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = if context_name = "install" then These String.Set.empty else - let gen_rules = Option.value_exn (String_map.find t.gen_rules context_name) in + let gen_rules = Option.value_exn (String.Map.find t.gen_rules context_name) in gen_rules ~dir (Option.value_exn (Path.explode sub_dir)) in let rules = collector.rules in @@ -865,7 +865,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = let alias_dir = Path.append (Path.relative alias_dir context_name) sub_dir in let alias_rules, alias_stamp_files = let open Build.O in - String_map.foldi collector.aliases ~init:([], Pset.empty) + String.Map.foldi collector.aliases ~init:([], Pset.empty) ~f:(fun name { Dir_status. deps; dyn_deps; actions } (rules, alias_stamp_files) -> let base_path = Path.relative alias_dir name in let rules, deps = @@ -925,7 +925,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = String.Set.empty) | ctx_name -> (* This condition is [true] because of [get_dir_status] *) - assert (String_map.mem t.contexts ctx_name); + assert (String.Map.mem t.contexts ctx_name); let files, subdirs = match File_tree.find_dir t.file_tree sub_dir with | None -> (Pset.empty, String.Set.empty) @@ -1076,20 +1076,20 @@ let stamp_file_for_files_of t ~dir ~ext = targets_of t ~dir |> Path.Set.to_list |> List.map ~f:(fun fn -> Filename.extension (Path.to_string fn), fn) - |> String_map.of_list_multi + |> String.Map.of_list_multi in { files_by_ext ; dir_hash = Path.to_string dir |> Digest.string |> Digest.to_hex - ; stamps = String_map.empty + ; stamps = String.Map.empty }) in - match String_map.find files_of_dir.stamps ext with + match String.Map.find files_of_dir.stamps ext with | Some fn -> fn | None -> let stamp_file = Path.relative misc_dir (files_of_dir.dir_hash ^ ext) in let files = Option.value - (String_map.find files_of_dir.files_by_ext ext) + (String.Map.find files_of_dir.files_by_ext ext) ~default:[] in compile_rule t @@ -1100,7 +1100,7 @@ let stamp_file_for_files_of t ~dir ~ext = Build.action ~targets:[stamp_file] (Action.with_stdout_to stamp_file (Action.digest_files files)))); - files_of_dir.stamps <- String_map.add files_of_dir.stamps ext stamp_file; + files_of_dir.stamps <- String.Map.add files_of_dir.stamps ext stamp_file; stamp_file module Trace = struct @@ -1136,7 +1136,7 @@ module Trace = struct end let all_targets t = - String_map.iter t.contexts ~f:(fun ctx -> + String.Map.iter t.contexts ~f:(fun ctx -> File_tree.fold t.file_tree ~traverse_ignored_dirs:true ~init:() ~f:(fun dir () -> load_dir t @@ -1155,7 +1155,7 @@ let create ~contexts ~file_tree ~hook = Utils.Cached_digest.load (); let contexts = List.map contexts ~f:(fun c -> (c.Context.name, c)) - |> String_map.of_list_exn + |> String.Map.of_list_exn in let t = { contexts @@ -1166,7 +1166,7 @@ let create ~contexts ~file_tree ~hook = ; dirs = Hashtbl.create 1024 ; load_dir_stack = [] ; file_tree - ; gen_rules = String_map.map contexts ~f:(fun _ ~dir:_ -> + ; gen_rules = String.Map.map contexts ~f:(fun _ ~dir:_ -> die "gen_rules called too early") ; build_dirs_to_keep = Pset.empty ; files_of = Hashtbl.create 1024 @@ -1261,7 +1261,7 @@ let all_lib_deps t ~request = List.fold_left (rules_for_targets t targets) ~init:Pmap.empty ~f:(fun acc (rule : Internal_rule.t) -> let deps = Build_interpret.lib_deps rule.build in - if String_map.is_empty deps then + if String.Map.is_empty deps then acc else let deps = @@ -1276,15 +1276,15 @@ let all_lib_deps_by_context t ~request = let rules = rules_for_targets t targets in List.fold_left rules ~init:[] ~f:(fun acc (rule : Internal_rule.t) -> let deps = Build_interpret.lib_deps rule.build in - if String_map.is_empty deps then + if String.Map.is_empty deps then acc else match Path.extract_build_context rule.dir with | None -> acc | Some (context, _) -> (context, deps) :: acc) - |> String_map.of_list_multi - |> String_map.map ~f:(function - | [] -> String_map.empty + |> String.Map.of_list_multi + |> String.Map.map ~f:(function + | [] -> String.Map.empty | x :: l -> List.fold_left l ~init:x ~f:Build.merge_lib_deps) module Rule = struct @@ -1443,7 +1443,7 @@ let rec add_build_dir_to_keep t ~dir = let get_collector t ~dir = match get_dir_status t ~dir with | Collecting_rules collector -> - if collector.rules = [] && String_map.is_empty collector.aliases then + if collector.rules = [] && String.Map.is_empty collector.aliases then add_build_dir_to_keep t ~dir; collector | Failed_to_load -> raise Already_reported @@ -1497,7 +1497,7 @@ let on_load_dir t ~dir ~f = let lazy_generators = p.lazy_generators in if lazy_generators = [] && collector.rules = [] && - String_map.is_empty collector.aliases then + String.Map.is_empty collector.aliases then add_build_dir_to_keep t ~dir; p.lazy_generators <- f :: lazy_generators @@ -1517,7 +1517,7 @@ module Alias = struct let get_alias_def build_system t = let collector = get_collector build_system ~dir:t.dir in - match String_map.find collector.aliases t.name with + match String.Map.find collector.aliases t.name with | None -> let x = { Dir_status. @@ -1526,7 +1526,7 @@ module Alias = struct ; actions = [] } in - collector.aliases <- String_map.add collector.aliases t.name x; + collector.aliases <- String.Map.add collector.aliases t.name x; x | Some x -> x diff --git a/src/build_system.mli b/src/build_system.mli index 62887804..069aa47d 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -36,7 +36,7 @@ type extra_sub_directories_to_keep = It is expected that [f] only generate rules whose targets are descendant of [dir]. *) -val set_rule_generators : t -> (dir:Path.t -> string list -> extra_sub_directories_to_keep) String_map.t -> unit +val set_rule_generators : t -> (dir:Path.t -> string list -> extra_sub_directories_to_keep) String.Map.t -> unit (** All other functions in this section must be called inside the rule generator callback. *) @@ -199,7 +199,7 @@ val all_lib_deps val all_lib_deps_by_context : t -> request:(unit, unit) Build.t - -> Build.lib_deps String_map.t + -> Build.lib_deps String.Map.t (** List of all buildable targets *) val all_targets : t -> Path.t list diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml index 8d114783..f0b68e56 100644 --- a/src/configurator/v1.ml +++ b/src/configurator/v1.ml @@ -7,7 +7,6 @@ let ( ^/ ) = Filename.concat exception Fatal_error of string -module String_map = Stdune.Map.Make(Stdune.String) module Int_map = Stdune.Map.Make(Stdune.Int) let die fmt = @@ -25,7 +24,7 @@ type t = ; c_compiler : string ; stdlib_dir : string ; ccomp_type : string - ; ocamlc_config : string String_map.t + ; ocamlc_config : string String.Map.t ; ocamlc_config_cmd : string } @@ -166,11 +165,11 @@ let run_capture_exn t ~dir cmd = let run_ok t ~dir cmd = (run t ~dir cmd).exit_code = 0 let get_ocaml_config_var_exn ~ocamlc_config_cmd map var = - match String_map.find map var with + match String.Map.find map var with | None -> die "variable %S not found in the output of `%s`" var ocamlc_config_cmd | Some s -> s -let ocaml_config_var t var = String_map.find t.ocamlc_config var +let ocaml_config_var t var = String.Map.find t.ocamlc_config var let ocaml_config_var_exn t var = get_ocaml_config_var_exn t.ocamlc_config var ~ocamlc_config_cmd:t.ocamlc_config_cmd @@ -197,7 +196,7 @@ let create ?dest_dir ?ocamlc ?(log=ignore) name = ; c_compiler = "" ; stdlib_dir = "" ; ccomp_type = "" - ; ocamlc_config = String_map.empty + ; ocamlc_config = String.Map.empty ; ocamlc_config_cmd } in @@ -215,7 +214,7 @@ let create ?dest_dir ?ocamlc ?(log=ignore) name = in let get = get_ocaml_config_var_exn ocamlc_config ~ocamlc_config_cmd in let c_compiler = - match String_map.find ocamlc_config "c_compiler" with + match String.Map.find ocamlc_config "c_compiler" with | Some c_comp -> c_comp ^ " " ^ get "ocamlc_cflags" | None -> get "bytecomp_c_compiler" in diff --git a/src/file_tree.ml b/src/file_tree.ml index 7f305950..20272254 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -4,7 +4,7 @@ module Dir = struct type t = { path : Path.t ; files : String.Set.t - ; sub_dirs : t String_map.t + ; sub_dirs : t String.Map.t ; ignored : bool } @@ -17,11 +17,11 @@ module Dir = struct Path.Set.of_string_set t.files ~f:(Path.relative t.path) let sub_dir_names t = - String_map.foldi t.sub_dirs ~init:String.Set.empty + String.Map.foldi t.sub_dirs ~init:String.Set.empty ~f:(fun s _ acc -> String.Set.add acc s) let sub_dir_paths t = - String_map.foldi t.sub_dirs ~init:Path.Set.empty + String.Map.foldi t.sub_dirs ~init:Path.Set.empty ~f:(fun s _ acc -> Path.Set.add acc (Path.relative t.path s)) let rec fold t ~traverse_ignored_dirs ~init:acc ~f = @@ -29,7 +29,7 @@ module Dir = struct acc else let acc = f t acc in - String_map.fold t.sub_dirs ~init:acc ~f:(fun t acc -> + String.Map.fold t.sub_dirs ~init:acc ~f:(fun t acc -> fold t ~traverse_ignored_dirs ~init:acc ~f) end @@ -87,7 +87,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path = || Path.Set.mem extra_ignored_subtrees path in (fn, walk path ~ignored)) - |> String_map.of_list_exn + |> String.Map.of_list_exn in { path ; files diff --git a/src/file_tree.mli b/src/file_tree.mli index cb1a8173..bb56eb9d 100644 --- a/src/file_tree.mli +++ b/src/file_tree.mli @@ -6,7 +6,7 @@ module Dir : sig val path : t -> Path.t val files : t -> String.Set.t val file_paths : t -> Path.Set.t - val sub_dirs : t -> t String_map.t + val sub_dirs : t -> t String.Map.t val sub_dir_paths : t -> Path.Set.t val sub_dir_names : t -> String.Set.t diff --git a/src/findlib.ml b/src/findlib.ml index 51eb501b..107a7cc0 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -74,10 +74,10 @@ module Rules = struct end module Vars = struct - type t = Rules.t String_map.t + type t = Rules.t String.Map.t let get (t : t) var preds = - match String_map.find t var with + match String.Map.find t var with | None -> None | Some rules -> Some (Rules.interpret rules ~preds) @@ -100,7 +100,7 @@ module Config = struct die "@{Error@}: ocamlfind toolchain %s isn't defined in %a \ (context: %s)" toolchain Path.pp path context; let vars = (Meta.load ~name:"" ~fn:(Path.to_string conf_file)).vars in - { vars = String_map.map vars ~f:Rules.of_meta_rules + { vars = String.Map.map vars ~f:Rules.of_meta_rules ; preds = Ps.make [toolchain] } @@ -163,7 +163,7 @@ end type t = { stdlib_dir : Path.t ; path : Path.t list - ; builtins : Meta.Simplified.t String_map.t + ; builtins : Meta.Simplified.t String.Map.t ; packages : (string, (Package.t, Unavailable_reason.t) result) Hashtbl.t } @@ -184,7 +184,7 @@ let dummy_package t ~name = meta_file = Path.relative dir "META" ; name = name ; dir = dir - ; vars = String_map.empty + ; vars = String.Map.empty } (* Parse a single package from a META file *) @@ -217,7 +217,7 @@ let parse_package t ~meta_file ~name ~parent_dir ~vars = List.for_all exists_if ~f:(fun fn -> Path.exists (Path.relative dir fn)) | [] -> - if not (String_map.mem t.builtins (root_package_name name)) then + if not (String.Map.mem t.builtins (root_package_name name)) then true else (* The META files for installed packages are sometimes broken, @@ -244,7 +244,7 @@ let parse_package t ~meta_file ~name ~parent_dir ~vars = [t.packages] *) let parse_and_acknowledge_meta t ~dir ~meta_file (meta : Meta.Simplified.t) = let rec loop ~dir ~full_name (meta : Meta.Simplified.t) = - let vars = String_map.map meta.vars ~f:Rules.of_meta_rules in + let vars = String.Map.map meta.vars ~f:Rules.of_meta_rules in let dir, res = parse_package t ~meta_file ~name:full_name ~parent_dir:dir ~vars in @@ -277,7 +277,7 @@ let find_and_acknowledge_meta t ~fq_name = else loop dirs | [] -> - match String_map.find t.builtins root_name with + match String.Map.find t.builtins root_name with | Some meta -> Some (t.stdlib_dir, Path.of_string "", meta) | None -> None in @@ -315,7 +315,7 @@ let root_packages t = in let pkgs = String.Set.union pkgs - (String.Set.of_list (String_map.keys t.builtins)) + (String.Set.of_list (String.Map.keys t.builtins)) in String.Set.to_list pkgs diff --git a/src/gen_meta.ml b/src/gen_meta.ml index d9a91e13..a265d607 100644 --- a/src/gen_meta.ml +++ b/src/gen_meta.ml @@ -154,8 +154,8 @@ let gen ~package ~version libs = in let entries = List.concat entries in let subs = - String_map.of_list_multi sub_pkgs - |> String_map.to_list + String.Map.of_list_multi sub_pkgs + |> String.Map.to_list |> List.map ~f:(fun (name, pkgs) -> let pkg = loop name pkgs in Package { pkg with diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 9f05227f..d138027e 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -152,7 +152,7 @@ module Gen(P : Install_rules.Params) = struct modules end - let parse_mlds ~dir ~(all_mlds : string String_map.t) ~mlds_written_by_user = + let parse_mlds ~dir ~(all_mlds : string String.Map.t) ~mlds_written_by_user = if Ordered_set_lang.is_standard mlds_written_by_user then all_mlds else @@ -160,7 +160,7 @@ module Gen(P : Install_rules.Params) = struct Ordered_set_lang.String.eval_unordered mlds_written_by_user ~parse:(fun ~loc s -> - match String_map.find all_mlds s with + match String.Map.find all_mlds s with | Some s -> s | None -> @@ -319,7 +319,7 @@ module Gen(P : Install_rules.Params) = struct match String.lsplit2 fn ~on:'.' with | Some (s, "mld") -> Some (s, fn) | _ -> None) - |> String_map.of_list_exn + |> String.Map.of_list_exn let mlds_by_dir = let cache = Hashtbl.create 32 in @@ -332,7 +332,7 @@ module Gen(P : Install_rules.Params) = struct parse_mlds ~dir ~all_mlds:(mlds_by_dir ~dir) ~mlds_written_by_user:doc.mld_files - |> String_map.values + |> String.Map.values |> List.map ~f:(Path.relative dir) let modules_by_dir = @@ -1086,8 +1086,8 @@ let gen ~contexts ~build_system (context.name, ((module M : Gen), stanzas)) in Fiber.parallel_map contexts ~f:make_sctx >>| fun l -> - let map = String_map.of_list_exn l in + let map = String.Map.of_list_exn l in Build_system.set_rule_generators build_system - (String_map.map map ~f:(fun ((module M : Gen), _) -> M.gen_rules)); - String_map.iter map ~f:(fun ((module M : Gen), _) -> M.init ()); - String_map.map map ~f:snd + (String.Map.map map ~f:(fun ((module M : Gen), _) -> M.gen_rules)); + String.Map.iter map ~f:(fun ((module M : Gen), _) -> M.init ()); + String.Map.map map ~f:snd diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 77d202c2..65e4014d 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -8,4 +8,4 @@ val gen -> ?external_lib_deps_mode:bool (* default: false *) -> ?only_packages:Package.Name.Set.t -> Jbuild_load.conf - -> (Path.t * Scope_info.t * Stanzas.t) list String_map.t Fiber.t + -> (Path.t * Scope_info.t * Stanzas.t) list String.Map.t Fiber.t diff --git a/src/import.ml b/src/import.ml index 0b4565ef..b6b486a2 100644 --- a/src/import.ml +++ b/src/import.ml @@ -11,7 +11,7 @@ let ksprintf = Printf.ksprintf let initial_cwd = Sys.getcwd () module String_map = struct - include Map.Make(String) + include String.Map let pp f fmt t = Format.pp_print_list (fun fmt (k, v) -> diff --git a/src/inline_tests.ml b/src/inline_tests.ml index c4b32236..a186766b 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -190,7 +190,7 @@ include Sub_system.Register_end_point( in let extra_vars = - String_map.singleton "library-name" + String.Map.singleton "library-name" (Action.Var_expansion.Strings ([lib.name], Concat)) in @@ -224,7 +224,7 @@ include Sub_system.Register_end_point( ; "intf-files", files Intf ] ~init:extra_vars - ~f:(fun acc (k, v) -> String_map.add acc k v) + ~f:(fun acc (k, v) -> String.Map.add acc k v) in Build.return [] >>> diff --git a/src/jbuild.ml b/src/jbuild.ml index 9d85b14f..5d3bee15 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -443,8 +443,8 @@ module Lib_deps = struct let t sexp = let t = list Lib_dep.t sexp in let add kind name acc = - match String_map.find acc name with - | None -> String_map.add acc name kind + match String.Map.find acc name with + | None -> String.Map.add acc name kind | Some kind' -> match kind, kind' with | Required, Required -> @@ -461,14 +461,14 @@ module Lib_deps = struct name in ignore ( - List.fold_left t ~init:String_map.empty ~f:(fun acc x -> + List.fold_left t ~init:String.Map.empty ~f:(fun acc x -> match x with | Lib_dep.Direct (_, s) -> add Required s acc | Select { choices; _ } -> List.fold_left choices ~init:acc ~f:(fun acc c -> let acc = String.Set.fold c.Lib_dep.required ~init:acc ~f:(add Optional) in String.Set.fold c.forbidden ~init:acc ~f:(add Forbidden))) - : kind String_map.t); + : kind String.Map.t); t let of_pps pps = diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 56b3b857..f1ef80ca 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -243,7 +243,7 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = else jbuilds in - String_map.fold sub_dirs ~init:jbuilds + String.Map.fold sub_dirs ~init:jbuilds ~f:(fun dir jbuilds -> walk dir jbuilds scope) end in diff --git a/src/lib.ml b/src/lib.ml index b246eeb7..ba816b0b 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -852,11 +852,11 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack = (deps, pps, resolved_selects) and closure_with_overlap_checks db ts ~stack = - let visited = ref String_map.empty in + let visited = ref String.Map.empty in let res = ref [] in let orig_stack = stack in let rec loop t ~stack = - match String_map.find !visited t.name with + match String.Map.find !visited t.name with | Some (t', stack') -> if t.unique_id = t'.unique_id then Ok () @@ -867,7 +867,7 @@ and closure_with_overlap_checks db ts ~stack = ; lib2 = (t , req_by stack ) })) | None -> - visited := String_map.add !visited t.name (t, stack); + visited := String.Map.add !visited t.name (t, stack); (match db with | None -> Ok () | Some db -> @@ -984,7 +984,7 @@ module DB = struct [ p.name , Found info ; conf.name, Redirect (None, p.name) ]) - |> String_map.of_list + |> String.Map.of_list |> function | Ok x -> x | Error (name, _, _) -> @@ -1008,10 +1008,10 @@ module DB = struct in create () ?parent ~resolve:(fun name -> - match String_map.find map name with + match String.Map.find map name with | None -> Not_found | Some x -> x) - ~all:(fun () -> String_map.keys map) + ~all:(fun () -> String.Map.keys map) let create_from_findlib ?(external_lib_deps_mode=false) findlib = create () diff --git a/src/main.ml b/src/main.ml index 11cf6a03..4edc096e 100644 --- a/src/main.ml +++ b/src/main.ml @@ -5,7 +5,7 @@ let () = Inline_tests.linkme type setup = { build_system : Build_system.t - ; stanzas : (Path.t * Jbuild.Scope_info.t * Jbuild.Stanzas.t) list String_map.t + ; stanzas : (Path.t * Jbuild.Scope_info.t * Jbuild.Stanzas.t) list String.Map.t ; contexts : Context.t list ; packages : Package.t Package.Name.Map.t ; file_tree : File_tree.t @@ -122,12 +122,12 @@ let external_lib_deps ?log ~packages () = | Ok path -> Path.append context.build_dir path | Error () -> die "Unknown package %S" (Package.Name.to_string pkg)) in - let stanzas = Option.value_exn (String_map.find setup.stanzas "default") in + let stanzas = Option.value_exn (String.Map.find setup.stanzas "default") in let internals = Jbuild.Stanzas.lib_names stanzas in Path.Map.map (Build_system.all_lib_deps setup.build_system ~request:(Build.paths install_files)) - ~f:(String_map.filteri ~f:(fun name _ -> + ~f:(String.Map.filteri ~f:(fun name _ -> not (String.Set.mem internals name)))) let ignored_during_bootstrap = diff --git a/src/main.mli b/src/main.mli index 4d49e7bb..a98a9c90 100644 --- a/src/main.mli +++ b/src/main.mli @@ -4,7 +4,7 @@ open Jbuild type setup = { build_system : Build_system.t ; (* Evaluated jbuilds per context names *) - stanzas : (Path.t * Scope_info.t * Stanzas.t) list String_map.t + stanzas : (Path.t * Scope_info.t * Stanzas.t) list String.Map.t ; contexts : Context.t list ; packages : Package.t Package.Name.Map.t ; file_tree : File_tree.t diff --git a/src/meta.ml b/src/meta.ml index c1553e03..a216c6d8 100644 --- a/src/meta.ml +++ b/src/meta.ml @@ -134,7 +134,7 @@ module Simplified = struct type t = { name : string - ; vars : Rules.t String_map.t + ; vars : Rules.t String.Map.t ; subs : t list } @@ -150,7 +150,7 @@ let rec simplify t = List.fold_right t.entries ~init: { name = t.name - ; vars = String_map.empty + ; vars = String.Map.empty ; subs = [] } ~f:(fun entry (pkg : Simplified.t) -> @@ -160,7 +160,7 @@ let rec simplify t = { pkg with subs = simplify sub :: pkg.subs } | Rule rule -> let rules = - Option.value (String_map.find pkg.vars rule.var) + Option.value (String.Map.find pkg.vars rule.var) ~default:{ set_rules = []; add_rules = [] } in let rules = @@ -168,7 +168,7 @@ let rec simplify t = | Set -> { rules with set_rules = rule :: rules.set_rules } | Add -> { rules with add_rules = rule :: rules.add_rules } in - { pkg with vars = String_map.add pkg.vars rule.var rules }) + { pkg with vars = String.Map.add pkg.vars rule.var rules }) let load ~fn ~name = { name @@ -259,7 +259,7 @@ let builtins ~stdlib_dir = [ compiler_libs; str; unix; bigarray; threads ] in List.map libs ~f:(fun t -> t.name, simplify t) - |> String_map.of_list_exn + |> String.Map.of_list_exn let string_of_action = function | Set -> "=" diff --git a/src/meta.mli b/src/meta.mli index b609ebcb..9d3c9d5a 100644 --- a/src/meta.mli +++ b/src/meta.mli @@ -35,7 +35,7 @@ module Simplified : sig type t = { name : string - ; vars : Rules.t String_map.t + ; vars : Rules.t String.Map.t ; subs : t list } @@ -46,6 +46,6 @@ val load : fn:string -> name:string -> Simplified.t (** Builtin META files for libraries distributed with the compiler. For when ocamlfind is not installed. *) -val builtins : stdlib_dir:Path.t -> Simplified.t String_map.t +val builtins : stdlib_dir:Path.t -> Simplified.t String.Map.t val pp : Format.formatter -> entry list -> unit diff --git a/src/module.ml b/src/module.ml index 945d6cdb..b46f85c9 100644 --- a/src/module.ml +++ b/src/module.ml @@ -15,7 +15,7 @@ module Name = struct let pp_quote fmt x = Format.fprintf fmt "%S" x module Set = String.Set - module Map = String_map + module Map = String.Map module Top_closure = Top_closure.String end diff --git a/src/ocaml-config/ocaml_config.ml b/src/ocaml-config/ocaml_config.ml index e88c7a9a..c5aa56d1 100644 --- a/src/ocaml-config/ocaml_config.ml +++ b/src/ocaml-config/ocaml_config.ml @@ -199,9 +199,7 @@ let split_prog s = | prog :: args -> Some { prog; args } module Vars = struct - module M = Map.Make(String) - - type t = string M.t + type t = string String.Map.t let of_lines lines = let rec loop acc = function @@ -218,10 +216,10 @@ module Vars = struct Error (Printf.sprintf "Unrecognized line: %S" line) in loop [] lines >>= fun vars -> - Result.map_error (M.of_list vars) ~f:(fun (var, _, _) -> + Result.map_error (String.Map.of_list vars) ~f:(fun (var, _, _) -> Printf.sprintf "Variable %S present twice." var) - let get_opt t var = M.find t var + let get_opt t var = String.Map.find t var let get t var = match get_opt t var with diff --git a/src/ocaml-config/ocaml_config.mli b/src/ocaml-config/ocaml_config.mli index fbdbb92b..5dc3d054 100644 --- a/src/ocaml-config/ocaml_config.mli +++ b/src/ocaml-config/ocaml_config.mli @@ -20,7 +20,7 @@ end (** Represent the parsed but uninterpreted output of [ocamlc -config] *) module Vars : sig - type t = string Map.Make(String).t + type t = string String.Map.t (** Parse the output of [ocamlc -config] given as a list of lines. *) val of_lines : string list -> (t, string) Result.t diff --git a/src/odoc.ml b/src/odoc.ml index 66e44e27..dccc23d9 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -434,7 +434,7 @@ module Gen (S : sig val sctx : SC.t end) = struct let check_mlds_no_dupes ~pkg ~mlds = match List.map mlds ~f:(fun mld -> (Path.basename mld, mld)) - |> String_map.of_list + |> String.Map.of_list with | Ok m -> m | Error (_, p1, p2) -> @@ -446,7 +446,7 @@ module Gen (S : sig val sctx : SC.t end) = struct let setup_package_odoc_rules ~pkg ~mlds ~entry_modules_by_lib = let mlds = check_mlds_no_dupes ~pkg ~mlds in let mlds = - if String_map.mem mlds "index" then + if String.Map.mem mlds "index" then mlds else let entry_modules = entry_modules ~pkg ~entry_modules_by_lib in @@ -454,8 +454,8 @@ module Gen (S : sig val sctx : SC.t end) = struct SC.add_rule sctx ( Build.write_file gen_mld (default_index entry_modules) ); - String_map.add mlds "index" gen_mld in - let odocs = List.map (String_map.values mlds) ~f:(fun mld -> + String.Map.add mlds "index" gen_mld in + let odocs = List.map (String.Map.values mlds) ~f:(fun mld -> compile_mld (Mld.create mld) ~pkg:pkg.name diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index eeade900..67657ccd 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -102,7 +102,7 @@ module Make(Key : Key)(Value : Value with type key = Key.t) = struct let x = parse ~loc s in M.singleton x | Special (loc, name) -> begin - match String_map.find special_values name with + match String.Map.find special_values name with | Some x -> x | None -> Loc.fail loc "undefined symbol %s" name end @@ -153,14 +153,14 @@ module Make(Key : Key)(Value : Value with type key = Key.t) = struct standard (* inline common case *) else Ordered.eval t ~parse - ~special_values:(String_map.singleton "standard" standard) + ~special_values:(String.Map.singleton "standard" standard) let eval_unordered t ~parse ~standard = if is_standard t then standard (* inline common case *) else Unordered.eval t ~parse - ~special_values:(String_map.singleton "standard" standard) + ~special_values:(String.Map.singleton "standard" standard) end let standard = @@ -232,14 +232,14 @@ module Unexpanded = struct | Include fn -> let sexp = let fn = f fn in - match String_map.find files_contents fn with + match String.Map.find files_contents fn with | Some x -> x | None -> Sexp.code_error "Ordered_set_lang.Unexpanded.expand" [ "included-file", Quoted_string fn ; "files", Sexp.To_sexp.(list string) - (String_map.keys files_contents) + (String.Map.keys files_contents) ] in parse_general sexp ~f:(fun sexp -> @@ -254,7 +254,7 @@ end module String = Make(struct type t = string let compare = String.compare - module Map = String_map + module Map = String.Map end)(struct type t = string type key = string diff --git a/src/ordered_set_lang.mli b/src/ordered_set_lang.mli index 7a68f151..77e15f60 100644 --- a/src/ordered_set_lang.mli +++ b/src/ordered_set_lang.mli @@ -66,9 +66,9 @@ module Unexpanded : sig [Map.find files_contents fn]. Every element is converted to a string using [f]. *) val expand : t - -> files_contents:Sexp.Ast.t String_map.t + -> files_contents:Sexp.Ast.t String.Map.t -> f:(String_with_vars.t -> string) -> expanded end with type expanded := t -module String : S with type value = string and type 'a map = 'a String_map.t +module String : S with type value = string and type 'a map = 'a String.Map.t diff --git a/src/path.ml b/src/path.ml index 61176c88..f07ad4c9 100644 --- a/src/path.ml +++ b/src/path.ml @@ -226,7 +226,7 @@ module Set = struct let of_string_set = map end -module Map = String_map +module Map = String.Map module Kind = struct type t = diff --git a/src/process.ml b/src/process.ml index 8c93000e..c1077f9e 100644 --- a/src/process.ml +++ b/src/process.ml @@ -158,8 +158,8 @@ module Fancy = struct let target_names, contexts = split_paths [] [] targets in let target_names_grouped_by_prefix = List.map target_names ~f:Filename.split_extension_after_dot - |> String_map.of_list_multi - |> String_map.to_list + |> String.Map.of_list_multi + |> String.Map.to_list in let pp_comma ppf () = Format.fprintf ppf "," in let pp_group ppf (prefix, suffixes) = diff --git a/src/scope.ml b/src/scope.ml index 844e1769..c539d109 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -77,7 +77,7 @@ module DB = struct match lib.public with | None -> None | Some p -> Some (p.name, lib.scope_name)) - |> String_map.of_list + |> String.Map.of_list |> function | Ok x -> x | Error (name, _, _) -> @@ -99,14 +99,14 @@ module DB = struct Lib.DB.create () ~parent:installed_libs ~resolve:(fun name -> - match String_map.find public_libs name with + match String.Map.find public_libs name with | None -> Not_found | Some scope_name -> let scope = Option.value_exn (Scope_name_map.find !by_name_cell scope_name) in Redirect (Some scope.db, name)) - ~all:(fun () -> String_map.keys public_libs) + ~all:(fun () -> String.Map.keys public_libs) in let by_name = Scope_name_map.merge scopes_info_by_name libs_by_scope_name diff --git a/src/sexp.ml b/src/sexp.ml index 707c56ab..f89d938c 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -78,7 +78,7 @@ module type Combinators = sig val array : 'a t -> 'a array t val option : 'a t -> 'a option t val string_set : String.Set.t t - val string_map : 'a t -> 'a String_map.t t + val string_map : 'a t -> 'a String.Map.t t val string_hashtbl : 'a t -> (string, 'a) Hashtbl.t t end @@ -97,13 +97,13 @@ module To_sexp = struct | 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 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)) + (Hashtbl.foldi h ~init:String.Map.empty ~f:(fun key data acc -> + String.Map.add acc key data)) type field = string * Usexp.t option @@ -183,15 +183,15 @@ module Of_sexp = struct let string_set sexp = String.Set.of_list (list string sexp) let string_map f sexp = - match String_map.of_list (list (pair string f) sexp) with + match String.Map.of_list (list (pair string f) sexp) with | Ok x -> x | Error (key, _v1, _v2) -> of_sexp_error sexp (sprintf "key %S present multiple times" key) let string_hashtbl f sexp = let map = string_map f sexp in - let tbl = Hashtbl.create (String_map.cardinal map + 32) in - String_map.iteri map ~f:(Hashtbl.add tbl); + let tbl = Hashtbl.create (String.Map.cardinal map + 32) in + String.Map.iteri map ~f:(Hashtbl.add tbl); tbl type unparsed_field = diff --git a/src/sexp.mli b/src/sexp.mli index b281ddf7..24b48481 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -32,7 +32,7 @@ module type Combinators = sig val string_set : String.Set.t t (** [atom_set] is a conversion to/from a set of strings representing atoms. *) - val string_map : 'a t -> 'a String_map.t t + val string_map : 'a t -> 'a String.Map.t t (** [atom_map conv]: given a conversion [conv] to/from ['a], returns a conversion to/from a map where the keys are atoms and the values are of type ['a]. *) diff --git a/src/stdune/string.ml b/src/stdune/string.ml index 7b8a0e46..925def86 100644 --- a/src/stdune/string.ml +++ b/src/stdune/string.ml @@ -176,3 +176,4 @@ let exists s ~f = true module Set = Set.Make(T) +module Map = Map.Make(T) diff --git a/src/stdune/string.mli b/src/stdune/string.mli index f0e526cf..15f49958 100644 --- a/src/stdune/string.mli +++ b/src/stdune/string.mli @@ -41,3 +41,4 @@ val longest_map : 'a list -> f:('a -> string) -> int val exists : t -> f:(char -> bool) -> bool module Set : Set.S with type elt = t +module Map : Map.S with type key = t diff --git a/src/super_context.ml b/src/super_context.ml index 4e6e6a0f..42db4eb7 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -26,7 +26,7 @@ type t = ; artifacts : Artifacts.t ; stanzas_to_consider_for_install : (Path.t * Scope.t * Stanza.t) list ; cxx_flags : string list - ; vars : Action.Var_expansion.t String_map.t + ; vars : Action.Var_expansion.t String.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t @@ -51,9 +51,9 @@ let installed_libs t = t.installed_libs let find_scope_by_dir t dir = Scope.DB.find_by_dir t.scopes dir let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name -let expand_var_no_root t var = String_map.find t.vars var +let expand_var_no_root t var = String.Map.find t.vars var -let expand_vars t ~scope ~dir ?(extra_vars=String_map.empty) s = +let expand_vars t ~scope ~dir ?(extra_vars=String.Map.empty) s = String_with_vars.expand s ~f:(fun _loc -> function | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir) | "SCOPE_ROOT" -> @@ -62,7 +62,7 @@ let expand_vars t ~scope ~dir ?(extra_vars=String_map.empty) s = Option.map ~f:(fun e -> Action.Var_expansion.to_string dir e) (match expand_var_no_root t var with | Some _ as x -> x - | None -> String_map.find extra_vars var)) + | None -> String.Map.find extra_vars var)) let resolve_program t ?hint bin = Artifacts.binary ?hint t.artifacts bin @@ -185,7 +185,7 @@ let create | Words x -> strings x | Prog_and_args x -> strings (x.prog :: x.args))) in - match String_map.of_list vars with + match String.Map.of_list vars with | Ok x -> x | Error _ -> assert false in @@ -421,18 +421,18 @@ module Action = struct ; (* Static deps from ${...} variables. For instance ${exe:...} *) mutable sdeps : Pset.t ; (* Dynamic deps from ${...} variables. For instance ${read:...} *) - mutable ddeps : (unit, Action.Var_expansion.t) Build.t String_map.t + mutable ddeps : (unit, Action.Var_expansion.t) Build.t String.Map.t } let add_lib_dep acc lib kind = - acc.lib_deps <- String_map.add acc.lib_deps lib kind + acc.lib_deps <- String.Map.add acc.lib_deps lib kind let add_fail acc fail = acc.failures <- fail :: acc.failures; None let add_ddep acc ~key dep = - acc.ddeps <- String_map.add acc.ddeps key dep; + acc.ddeps <- String.Map.add acc.ddeps key dep; None let path_exp path = Action.Var_expansion.Paths ([path], Concat) @@ -458,9 +458,9 @@ module Action = struct ~map_exe ~extra_vars t = let acc = { failures = [] - ; lib_deps = String_map.empty + ; lib_deps = String.Map.empty ; sdeps = Pset.empty - ; ddeps = String_map.empty + ; ddeps = String.Map.empty } in let open Action.Var_expansion in @@ -550,7 +550,7 @@ module Action = struct | _ -> match expand_var_no_root sctx var with | Some _ as x -> x - | None -> String_map.find extra_vars var + | None -> String.Map.find extra_vars var in let t = U.partial_expand t ~dir ~map_exe ~f:(fun loc key -> @@ -584,7 +584,7 @@ module Action = struct let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t = let open Action.Var_expansion in U.Partial.expand t ~dir ~map_exe ~f:(fun loc key -> - match String_map.find dynamic_expansions key with + match String.Map.find dynamic_expansions key with | Some _ as opt -> opt | None -> let _, var = parse_bang key in @@ -601,7 +601,7 @@ module Action = struct | "^" -> Some (Paths (deps_written_by_user, Split)) | _ -> None) - let run sctx ?(extra_vars=String_map.empty) + let run sctx ?(extra_vars=String.Map.empty) t ~dir ~dep_kind ~targets:targets_written_by_user ~scope : (Path.t list, Action.t) Build.t = let map_exe = map_exe sctx in @@ -667,12 +667,12 @@ module Action = struct >>> Build.arr (fun paths -> ((), paths)) >>> - let ddeps = String_map.to_list forms.ddeps in + let ddeps = String.Map.to_list forms.ddeps in Build.first (Build.all (List.map ddeps ~f:snd)) >>^ (fun (vals, deps_written_by_user) -> let dynamic_expansions = - List.fold_left2 ddeps vals ~init:String_map.empty - ~f:(fun acc (var, _) value -> String_map.add acc var value) + List.fold_left2 ddeps vals ~init:String.Map.empty + ~f:(fun acc (var, _) value -> String.Map.add acc var value) in let unresolved = expand_step2 t ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe @@ -703,13 +703,13 @@ let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = match Ordered_set_lang.Unexpanded.files set ~f |> String.Set.to_list with | [] -> let set = - Ordered_set_lang.Unexpanded.expand set ~files_contents:String_map.empty ~f + Ordered_set_lang.Unexpanded.expand set ~files_contents:String.Map.empty ~f in Build.return (Ordered_set_lang.String.eval set ~standard ~parse) | files -> let paths = List.map files ~f:(Path.relative dir) in Build.all (List.map paths ~f:Build.read_sexp) >>^ fun sexps -> - let files_contents = List.combine files sexps |> String_map.of_list_exn in + let files_contents = List.combine files sexps |> String.Map.of_list_exn in let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in Ordered_set_lang.String.eval set ~standard ~parse diff --git a/src/super_context.mli b/src/super_context.mli index c888ae68..a989de94 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -56,7 +56,7 @@ val expand_vars : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Action.Var_expansion.t String_map.t + -> ?extra_vars:Action.Var_expansion.t String.Map.t -> String_with_vars.t -> string @@ -64,7 +64,7 @@ val expand_and_eval_set : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Action.Var_expansion.t String_map.t + -> ?extra_vars:Action.Var_expansion.t String.Map.t -> Ordered_set_lang.Unexpanded.t -> standard:string list -> (unit, string list) Build.t @@ -190,7 +190,7 @@ module Action : sig (** The arrow takes as input the list of actual dependencies *) val run : t - -> ?extra_vars:Action.Var_expansion.t String_map.t + -> ?extra_vars:Action.Var_expansion.t String.Map.t -> Action.Unexpanded.t -> dir:Path.t -> dep_kind:Build.lib_dep_kind diff --git a/src/watermarks.ml b/src/watermarks.ml index 95d0ae1e..c62cd90a 100644 --- a/src/watermarks.ml +++ b/src/watermarks.ml @@ -50,7 +50,7 @@ let make_watermark_map ~name ~version ~commit = end | _ -> err in - String_map.of_list_exn + String.Map.of_list_exn [ "NAME" , Ok name ; "VERSION" , Ok version ; "VERSION_NUM" , Ok version_num @@ -66,7 +66,7 @@ let make_watermark_map ~name ~version ~commit = let subst_string s ~fname ~map = let len = String.length s in - let longest_var = String.longest (String_map.keys map) in + let longest_var = String.longest (String.Map.keys map) in let loc_of_offset ~ofs ~len = let rec loop lnum bol i = if i = ofs then @@ -125,7 +125,7 @@ let subst_string s ~fname ~map = match s.[i] with | '%' -> begin let var = String.sub s ~pos:(start + 2) ~len:(i - start - 3) in - match String_map.find map var with + match String.Map.find map var with | None -> in_var ~start:(i - 1) (i + 1) acc | Some (Ok repl) -> let acc = (start, i + 1, repl) :: acc in diff --git a/test/unit-tests/import_dot_map.mlt b/test/unit-tests/import_dot_map.mlt index cdcdff9a..a82fc6d8 100644 --- a/test/unit-tests/import_dot_map.mlt +++ b/test/unit-tests/import_dot_map.mlt @@ -6,15 +6,15 @@ open Jbuilder;; open Import;; (* Check that [of_alist_multi] groups elements in the right order *) -String_map.of_list_multi +String.Map.of_list_multi [ "a", 1 ; "b", 1 ; "a", 2 ; "a", 3 ; "b", 2 ] -|> String_map.to_list;; +|> String.Map.to_list;; [%%expect{| -- : (Jbuilder.Import.String_map.key * int list) list = +- : (Jbuilder.Import.String.Map.key * int list) list = [("a", [1; 2; 3]); ("b", [1; 2])] |}] From 24041593dac9dd191bc05f8e9bf00d143303f472 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 23 Apr 2018 14:04:15 +0700 Subject: [PATCH 3/3] Move Code_error to Stdune.Exn This exception is useful outside of jbuilder --- src/action.ml | 2 +- src/build_interpret.ml | 2 +- src/build_system.ml | 4 ++-- src/env.ml | 2 +- src/errors.ml | 3 +-- src/errors.mli | 5 ----- src/jbuild.ml | 2 +- src/lib.ml | 4 ++-- src/ocamldep.ml | 2 +- src/ordered_set_lang.ml | 2 +- src/path.ml | 12 ++++++------ src/report_error.ml | 6 +++--- src/scope.ml | 6 +++--- src/sexp.ml | 6 ------ src/sexp.mli | 2 -- src/stdune/exn.ml | 9 +++++++++ src/stdune/exn.mli | 6 ++++++ src/stdune/jbuild | 2 +- src/syntax.ml | 4 ++-- 19 files changed, 41 insertions(+), 40 deletions(-) diff --git a/src/action.ml b/src/action.ml index ac780e89..85ac8f53 100644 --- a/src/action.ml +++ b/src/action.ml @@ -852,7 +852,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = (match Path.kind path with | External _ -> (* Internally we make sure never to do that, and [Unexpanded.*expand] check that *) - Sexp.code_error + Exn.code_error "(mkdir ...) is not supported for paths outside of the workspace" [ "mkdir", Path.sexp_of_t path ] | Local path -> diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 2ab5c98a..8ae453d2 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -208,7 +208,7 @@ module Rule = struct if Path.parent path <> dir then match loc with | None -> - Sexp.code_error "rule has targets in different directories" + Exn.code_error "rule has targets in different directories" [ "targets", Sexp.To_sexp.list Path.sexp_of_t (List.map targets ~f:Target.path) ] diff --git a/src/build_system.ml b/src/build_system.ml index 957e6006..995c750a 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -1448,7 +1448,7 @@ let get_collector t ~dir = collector | Failed_to_load -> raise Already_reported | Loaded _ | Forward _ -> - Sexp.code_error + Exn.code_error (if Path.is_in_source_tree dir then "Build_system.get_collector called on source directory" else if dir = Path.build_dir then @@ -1477,7 +1477,7 @@ let prefix_rules t prefix ~f = begin match Build_interpret.targets prefix with | [] -> () | targets -> - Sexp.code_error "Build_system.prefix_rules' prefix contains targets" + Exn.code_error "Build_system.prefix_rules' prefix contains targets" ["targets", Path.Set.sexp_of_t (Build_interpret.Target.paths targets)] end; let prefix = diff --git a/src/env.ml b/src/env.ml index e5510ac7..09cf9cd9 100644 --- a/src/env.ml +++ b/src/env.ml @@ -41,7 +41,7 @@ let of_unix arr = |> List.map ~f:(fun s -> match String.lsplit2 s ~on:'=' with | None -> - Sexp.code_error "Env.of_unix: entry without '=' found in the environ" + Exn.code_error "Env.of_unix: entry without '=' found in the environ" ["var", Sexp.To_sexp.string s] | Some (k, v) -> (k, v)) |> Map.of_list_multi diff --git a/src/errors.ml b/src/errors.ml index 56ed2b7f..453f3543 100644 --- a/src/errors.ml +++ b/src/errors.ml @@ -1,5 +1,4 @@ exception Fatal_error of string -exception Code_error of string exception Already_reported let err_buf = Buffer.create 128 @@ -14,7 +13,7 @@ let kerrf fmt ~f = err_ppf fmt let code_errorf fmt = - kerrf fmt ~f:(fun s -> raise (Code_error s)) + kerrf fmt ~f:(fun s -> Stdune.Exn.code_error s []) let die fmt = kerrf fmt ~f:(fun s -> raise (Fatal_error s)) diff --git a/src/errors.mli b/src/errors.mli index a53ffb43..cb728d76 100644 --- a/src/errors.mli +++ b/src/errors.mli @@ -12,11 +12,6 @@ (** A fatal error, that should be reported to the user in a nice way *) exception Fatal_error of string -(* CR-soon diml: replace the [string] argument by [Usexp.t] *) -(** An programming error in the code of jbuilder, that should be reported upstream. The - error message shouldn't try to be developper friendly rather than user friendly. *) -exception Code_error of string - (* CR-soon diml: we won't need this once we can generate rules dynamically *) (** Raised for errors that have already been reported to the user and shouldn't be reported again. This might happen when trying to build a dependency that has already diff --git a/src/jbuild.ml b/src/jbuild.ml index 5d3bee15..d196bef7 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -596,7 +596,7 @@ module Sub_system_info = struct let () = match Sub_system_name.Table.get all name with | Some _ -> - Sexp.code_error "Sub_system_info.register: already registered" + Exn.code_error "Sub_system_info.register: already registered" [ "name", Sexp.To_sexp.string (Sub_system_name.to_string name) ]; | None -> Sub_system_name.Table.set all ~key:name ~data:(Some (module M : S)); diff --git a/src/lib.ml b/src/lib.ml index ba816b0b..7c0bc0aa 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -600,7 +600,7 @@ let already_in_table (info : Info.t) name x = List [Sexp.unsafe_atom_of_string "Hidden"; Path.sexp_of_t path; Sexp.atom reason] in - Sexp.code_error + Exn.code_error "Lib_db.DB: resolver returned name that's already in the table" [ "name" , Sexp.atom name ; "returned_lib" , to_sexp (info.src_dir, name) @@ -1061,7 +1061,7 @@ module DB = struct let get_compile_info t ?(allow_overlaps=false) name = match find_even_when_hidden t name with | None -> - Sexp.code_error "Lib.DB.get_compile_info got library that doesn't exist" + Exn.code_error "Lib.DB.get_compile_info got library that doesn't exist" [ "name", Sexp.To_sexp.string name ] | Some lib -> let t = Option.some_if (not allow_overlaps) t in diff --git a/src/ocamldep.ml b/src/ocamldep.ml index b8c16dfa..0ef535cc 100644 --- a/src/ocamldep.ml +++ b/src/ocamldep.ml @@ -13,7 +13,7 @@ module Dep_graph = struct match Module.Name.Map.find t.per_module m.name with | Some x -> x | None -> - Sexp.code_error "Ocamldep.Dep_graph.deps_of" + Exn.code_error "Ocamldep.Dep_graph.deps_of" [ "dir", Path.sexp_of_t t.dir ; "modules", Sexp.To_sexp.(list Module.Name.t) (Module.Name.Map.keys t.per_module) diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index 67657ccd..29c2293a 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -235,7 +235,7 @@ module Unexpanded = struct match String.Map.find files_contents fn with | Some x -> x | None -> - Sexp.code_error + Exn.code_error "Ordered_set_lang.Unexpanded.expand" [ "included-file", Quoted_string fn ; "files", Sexp.To_sexp.(list string) diff --git a/src/path.ml b/src/path.ml index f07ad4c9..38dd7911 100644 --- a/src/path.ml +++ b/src/path.ml @@ -290,7 +290,7 @@ let reach t ~from = match is_local t, is_local from with | false, _ -> t | true, false -> - Sexp.code_error "Path.reach called with invalid combination" + Exn.code_error "Path.reach called with invalid combination" [ "t" , sexp_of_t t ; "from", sexp_of_t from ] @@ -300,7 +300,7 @@ let reach_for_running t ~from = match is_local t, is_local from with | false, _ -> t | true, false -> - Sexp.code_error "Path.reach_for_running called with invalid combination" + Exn.code_error "Path.reach_for_running called with invalid combination" [ "t" , sexp_of_t t ; "from", sexp_of_t from ] @@ -325,7 +325,7 @@ let is_descendant t ~of_ = let append a b = if not (is_local b) then - Sexp.code_error "Path.append called with non-local second path" + Exn.code_error "Path.append called with non-local second path" [ "a", sexp_of_t a ; "b", sexp_of_t b ]; @@ -391,7 +391,7 @@ let drop_build_context t = let drop_build_context_exn t = match extract_build_context t with - | None -> Sexp.code_error "Path.drop_build_context_exn" [ "t", sexp_of_t t ] + | None -> Exn.code_error "Path.drop_build_context_exn" [ "t", sexp_of_t t ] | Some (_, t) -> t let drop_optional_build_context t = @@ -424,7 +424,7 @@ let explode_exn t = else if is_local t then String.split t ~on:'/' else - Sexp.code_error "Path.explode_exn" + Exn.code_error "Path.explode_exn" ["path", Sexp.atom_or_quoted_string t] let exists t = Sys.file_exists (to_string t) @@ -456,7 +456,7 @@ let extend_basename t ~suffix = t ^ suffix let insert_after_build_dir_exn = let error a b = - Sexp.code_error + Exn.code_error "Path.insert_after_build_dir_exn" [ "path" , Sexp.unsafe_atom_of_string a ; "insert", Sexp.unsafe_atom_of_string b diff --git a/src/report_error.ml b/src/report_error.ml index ca111d1e..dfc801d9 100644 --- a/src/report_error.ml +++ b/src/report_error.ml @@ -49,14 +49,14 @@ let report_with_backtrace exn = else Format.fprintf ppf "%s\n" (String.capitalize msg) } - | Code_error msg -> + | Stdune.Exn.Code_error sexp -> { p with backtrace = true ; pp = fun ppf -> Format.fprintf ppf "@{Internal error, please report upstream \ including the contents of _build/log.@}\n\ - Description: %s\n" - msg + Description: %a\n" + Usexp.pp sexp } | Unix.Unix_error (err, func, fname) -> { p with pp = fun ppf -> diff --git a/src/scope.ml b/src/scope.ml index c539d109..7abdc431 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -27,7 +27,7 @@ module DB = struct | Some scope -> scope | None -> if Path.is_root d || not (Path.is_local d) then - Sexp.code_error "Scope.DB.find_by_dir got an invalid path" + Exn.code_error "Scope.DB.find_by_dir got an invalid path" [ "dir" , Path.sexp_of_t dir ; "context", Sexp.To_sexp.string t.context ]; @@ -41,7 +41,7 @@ module DB = struct match Scope_name_map.find t.by_name name with | Some x -> x | None -> - Sexp.code_error "Scope.DB.find_by_name" + Exn.code_error "Scope.DB.find_by_name" [ "name" , Sexp.To_sexp.(option string) name ; "context", Sexp.To_sexp.string t.context ; "names", @@ -60,7 +60,7 @@ module DB = struct Sexp.To_sexp.(pair (option string) Path.sexp_of_t) (scope.name, scope.root) in - Sexp.code_error "Scope.DB.create got two scopes with the same name" + Exn.code_error "Scope.DB.create got two scopes with the same name" [ "scope1", to_sexp scope1 ; "scope2", to_sexp scope2 ] diff --git a/src/sexp.ml b/src/sexp.ml index f89d938c..fca46913 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -3,12 +3,6 @@ open Import include (Usexp : module type of struct include Usexp end with module Loc := Usexp.Loc) -let code_error message vars = - code_errorf "%a" pp - (List (Usexp.atom_or_quoted_string message - :: List.map vars ~f:(fun (name, value) -> - List [Usexp.atom_or_quoted_string name; value]))) - let buf_len = 65_536 let load ~fname ~mode = diff --git a/src/sexp.mli b/src/sexp.mli index 24b48481..7bdeb939 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -2,8 +2,6 @@ open Import include module type of struct include Usexp end with module Loc := Usexp.Loc -val code_error : string -> (string * t) list -> _ - val load : fname:string -> mode:'a Parser.Mode.t -> 'a val load_many_as_one : fname:string -> Ast.t diff --git a/src/stdune/exn.ml b/src/stdune/exn.ml index 469de331..7520ed44 100644 --- a/src/stdune/exn.ml +++ b/src/stdune/exn.ml @@ -1,5 +1,7 @@ type t = exn +exception Code_error of Usexp.t + external raise : exn -> _ = "%raise" external raise_notrace : exn -> _ = "%raise_notrace" external reraise : exn -> _ = "%reraise" @@ -11,6 +13,13 @@ let protectx x ~f ~finally = let protect ~f ~finally = protectx () ~f ~finally +let code_error message vars = + Code_error + (Usexp.List (Usexp.atom_or_quoted_string message + :: List.map vars ~f:(fun (name, value) -> + Usexp.List [Usexp.atom_or_quoted_string name; value]))) + |> raise + include ((struct [@@@warning "-32-3"] diff --git a/src/stdune/exn.mli b/src/stdune/exn.mli index 6df3fa9f..aba7218a 100644 --- a/src/stdune/exn.mli +++ b/src/stdune/exn.mli @@ -1,5 +1,11 @@ (** Exceptions *) +(** 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 Usexp.t + +val code_error : string -> (string * Usexp.t) list -> _ + type t = exn external raise : exn -> _ = "%raise" diff --git a/src/stdune/jbuild b/src/stdune/jbuild index b1f82de0..f79d508b 100644 --- a/src/stdune/jbuild +++ b/src/stdune/jbuild @@ -2,4 +2,4 @@ ((name stdune) (public_name jbuilder.stdune) (synopsis "[Internal] Standard library of Dune") - (libraries (caml unix)))) + (libraries (caml unix usexp)))) diff --git a/src/syntax.ml b/src/syntax.ml index dc2e1dde..1141fd5f 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -26,14 +26,14 @@ module Versioned_parser = struct let make l = if List.is_empty l then - Sexp.code_error "Syntax.Versioned_parser.make got empty list" []; + Exn.code_error "Syntax.Versioned_parser.make got empty list" []; match List.map l ~f:(fun ((major, minor), p) -> (major, (minor, p))) |> Int_map.of_list with | Ok x -> x | Error _ -> - Sexp.code_error + Exn.code_error "Syntax.Versioned_parser.make" [ "versions", Sexp.To_sexp.list Version.sexp_of_t (List.map l ~f:fst) ]