matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge pull request #716 from rgrinberg/sexp-stdune 

Move Code_error to stdune
This commit is contained in:
Rudi Grinberg 2018-04-23 18:20:15 +07:00 committed by GitHub
parent f9373b2e46 24041593da
commit e991c261ca
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
59 changed files with 327 additions and 319 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
bin/main.ml
View File

@ -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
@ -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,18 +761,18 @@ 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 _ ->
not (String_set.mem internals name))
String.Map.filteri lib_deps ~f:(fun name _ ->
not (String.Set.mem internals name))
in
if only_missing then begin
let context =
@ -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,13 +806,13 @@ 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
| 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

10
src/action.ml
View File

@ -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 ->
@ -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 =

8
src/artifacts.ml
View File

@ -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

8
src/build.ml
View File

@ -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
@ -91,9 +91,9 @@ 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)
|> String.Map.of_list_reduce ~f:merge_lib_dep_kind)
module O = struct
let ( >>> ) a b =

2
src/build.mli
View File

@ -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

4
src/build_interpret.ml
View File

@ -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 ->
@ -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)
]

80
src/build_system.ml
View File

@ -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,15 +328,15 @@ 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
type extra_sub_directories_to_keep =
| All
| These of String_set.t
| These of String.Set.t
type hook =
| Rule_started
@ -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)
@ -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
@ -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.
@ -854,9 +854,9 @@ 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
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 =
@ -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);
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 *)
@ -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,12 +1443,12 @@ 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
| 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 =
@ -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
@ -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)
@ -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

6
src/build_system.mli
View File

@ -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.
@ -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

11
src/configurator/v1.ml
View File

@ -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

2
src/env.ml
View File

@ -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

3
src/errors.ml
View File

@ -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))

5
src/errors.mli
View File

@ -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

28
src/file_tree.ml
View File

@ -3,8 +3,8 @@ open! Import
module Dir = struct
type t =
{ path : Path.t
; files : String_set.t
; sub_dirs : t String_map.t
; files : String.Set.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
~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
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
@ -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,19 +75,19 @@ 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))
|> String_map.of_list_exn
|> String.Map.of_list_exn
in
{ path
; files
@ -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)))

6
src/file_tree.mli
View File

@ -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_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. *)

24
src/findlib.ml
View File

@ -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>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 "<internal>", meta)
| None -> None
in
@ -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 ->

8
src/gen_meta.ml
View File

@ -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 \
@ -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

32
src/gen_rules.ml
View File

@ -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 ->
@ -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,12 +314,12 @@ 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)
| _ -> 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 =
@ -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 =
@ -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

2
src/gen_rules.mli
View File

@ -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

3
src/import.ml
View File

@ -10,9 +10,8 @@ let ksprintf = Printf.ksprintf
let initial_cwd = Sys.getcwd ()
module String_set = Set.Make(String)
module String_map = struct
include Map.Make(String)
include String.Map
let pp f fmt t =
Format.pp_print_list (fun fmt (k, v) ->

4
src/inline_tests.ml
View File

@ -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 []
>>>

2
src/install_rules.ml
View File

@ -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

44
src/jbuild.ml
View File

@ -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 "(<library-name> <code>) 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
@ -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);
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
let of_pps pps =
@ -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));
@ -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

6
src/jbuild.mli
View File

@ -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

6
src/jbuild_load.ml
View File

@ -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,13 +237,13 @@ 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
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

24
src/lib.ml
View File

@ -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)
@ -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
@ -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 ()
@ -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
@ -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.

6
src/lib.mli
View File

@ -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

8
src/main.ml
View File

@ -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,13 +122,13 @@ 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 _ ->
not (String_set.mem internals name))))
~f:(String.Map.filteri ~f:(fun name _ ->
not (String.Set.mem internals name))))
let ignored_during_bootstrap =
Path.Set.of_list

2
src/main.mli
View File

@ -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

4
src/merlin.ml
View File

@ -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:"")
>>>

10
src/meta.ml
View File

@ -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 -> "="

4
src/meta.mli
View File

@ -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

4
src/module.ml
View File

@ -14,8 +14,8 @@ module Name = struct
let pp = Format.pp_print_string
let pp_quote fmt x = Format.fprintf fmt "%S" x
module Set = String_set
module Map = String_map
module Set = String.Set
module Map = String.Map
module Top_closure = Top_closure.String
end

8
src/ocaml-config/ocaml_config.ml
View File

@ -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

2
src/ocaml-config/ocaml_config.mli
View File

@ -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

2
src/ocamldep.ml
View File

@ -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)

8
src/odoc.ml
View File

@ -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

18
src/ordered_set_lang.ml
View File

@ -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 =
@ -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 =
@ -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
Exn.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

6
src/ordered_set_lang.mli
View File

@ -59,16 +59,16 @@ 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
[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

20
src/path.ml
View File

@ -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,12 +221,12 @@ 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
module Map = String_map
module Map = String.Map
module Kind = struct
type t =
@ -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

2
src/path.mli
View File

@ -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

16
src/process.ml
View File

@ -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
@ -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) =

12
src/report_error.ml
View File

@ -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 "@{<error>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 ->
@ -74,7 +74,7 @@ let report_with_backtrace exn =
Format.fprintf ppf "@{<error>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);

12
src/scope.ml
View File

@ -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
]
@ -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

26
src/sexp.ml
View File

@ -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 =
@ -77,8 +71,8 @@ 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_map : 'a t -> 'a String_map.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,14 +90,14 @@ module To_sexp = struct
let option f = function
| None -> List []
| Some x -> List [f x]
let string_set set = list atom (String_set.to_list set)
let string_map f map = list (pair atom f) (String_map.to_list map)
let string_set set = list atom (String.Set.to_list set)
let string_map f map = list (pair atom f) (String.Map.to_list map)
let record l =
List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
let string_hashtbl f h =
string_map f
(Hashtbl.foldi h ~init:String_map.empty ~f:(fun key data acc ->
String_map.add acc key data))
(Hashtbl.foldi h ~init:String.Map.empty ~f:(fun key data acc ->
String.Map.add acc key data))
type field = string * Usexp.t option
@ -181,17 +175,17 @@ 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
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 =

6
src/sexp.mli
View File

@ -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
@ -29,10 +27,10 @@ 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
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]. *)

9
src/stdune/exn.ml
View File

@ -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"]

6
src/stdune/exn.mli
View File

@ -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"

2
src/stdune/jbuild
View File

@ -2,4 +2,4 @@
((name stdune)
(public_name jbuilder.stdune)
(synopsis "[Internal] Standard library of Dune")
(libraries (caml unix))))
(libraries (caml unix usexp))))

8
src/stdune/string.ml
View File

@ -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,6 @@ let exists s ~f =
false
with Exit ->
true
module Set = Set.Make(T)
module Map = Map.Make(T)

3
src/stdune/string.mli
View File

@ -39,3 +39,6 @@ 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
module Map : Map.S with type key = t

2
src/string_with_vars.ml
View File

@ -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

2
src/string_with_vars.mli
View File

@ -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

40
src/super_context.ml
View File

@ -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
@ -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
@ -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
@ -700,16 +700,16 @@ 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
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

8
src/super_context.mli
View File

@ -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
@ -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
@ -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

4
src/syntax.ml
View File

@ -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) ]

2
src/top_closure.ml
View File

@ -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)

6
src/watermarks.ml
View File

@ -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

8
src/workspace.ml
View File

@ -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"

6
test/unit-tests/import_dot_map.mlt
View File

@ -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])]
|}]