Merge pull request #1100 from ocaml/remove-some-polymorphic-comparisons
Remove some polymorphic comparisons
This commit is contained in:
commit
87f962df10
|
@ -630,7 +630,7 @@ let target_hint (setup : Main.setup) path =
|
|||
(* Only suggest hints for the basename, otherwise it's slow when there are lots of
|
||||
files *)
|
||||
List.filter_map candidates ~f:(fun path ->
|
||||
if Path.parent_exn path = sub_dir then
|
||||
if Path.equal (Path.parent_exn path) sub_dir then
|
||||
Some (Path.to_string path)
|
||||
else
|
||||
None)
|
||||
|
|
|
@ -431,7 +431,7 @@ let get_dir_status t ~dir =
|
|||
Path.Table.find_or_add t.dirs dir ~f:(fun _ ->
|
||||
if Path.is_in_source_tree dir then
|
||||
Dir_status.Loaded (File_tree.files_of t.file_tree dir)
|
||||
else if dir = Path.build_dir then
|
||||
else if Path.equal dir Path.build_dir then
|
||||
(* Not allowed to look here *)
|
||||
Dir_status.Loaded Path.Set.empty
|
||||
else if not (Path.is_managed dir) then
|
||||
|
@ -901,7 +901,7 @@ and load_dir_and_get_targets t ~dir =
|
|||
| [] -> assert false
|
||||
| x :: l ->
|
||||
t.load_dir_stack <- l;
|
||||
assert (x = dir)));
|
||||
assert (Path.equal x dir)));
|
||||
Path.Table.replace t.dirs ~key:dir ~data:Failed_to_load;
|
||||
reraise exn
|
||||
|
||||
|
@ -1095,7 +1095,7 @@ The following targets are not:
|
|||
| [] -> assert false
|
||||
| x :: l ->
|
||||
t.load_dir_stack <- l;
|
||||
assert (x = dir));
|
||||
assert (Path.equal x dir));
|
||||
|
||||
(* Compile the rules and cleanup stale artifacts *)
|
||||
List.iter rules ~f:(compile_rule t ~copy_source:false);
|
||||
|
@ -1475,6 +1475,7 @@ let package_deps t pkg files =
|
|||
else
|
||||
List.fold_left pkgs ~init:acc ~f:add_package
|
||||
and add_package acc p =
|
||||
let open Package.Name.Infix in
|
||||
if p = pkg then
|
||||
acc
|
||||
else
|
||||
|
@ -1528,7 +1529,7 @@ let get_collector t ~dir =
|
|||
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
|
||||
else if Path.equal dir Path.build_dir then
|
||||
"Build_system.get_collector called on build_dir"
|
||||
else if not (Path.is_managed dir) then
|
||||
"Build_system.get_collector called on external directory"
|
||||
|
|
|
@ -175,6 +175,7 @@ module Library_modules = struct
|
|||
if not lib.wrapped then
|
||||
modules
|
||||
else
|
||||
let open Module.Name.Infix in
|
||||
Module.Name.Map.map modules ~f:(fun m ->
|
||||
if m.name = main_module_name then
|
||||
m
|
||||
|
@ -274,7 +275,7 @@ let mlds t (doc : Documentation.t) =
|
|||
let map = Lazy.force t.mlds in
|
||||
match
|
||||
List.find_map map ~f:(fun (doc', x) ->
|
||||
Option.some_if (doc.loc = doc'.loc) x)
|
||||
Option.some_if (Loc.equal doc.loc doc'.loc) x)
|
||||
with
|
||||
| Some x -> x
|
||||
| None ->
|
||||
|
@ -409,6 +410,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
|
|||
match Module.Name.Map.of_list rev_modules with
|
||||
| Ok x -> x
|
||||
| Error (name, _, _) ->
|
||||
let open Module.Name.Infix in
|
||||
let locs =
|
||||
List.filter_map rev_modules ~f:(fun (n, b) ->
|
||||
Option.some_if (n = name) b.loc)
|
||||
|
@ -549,7 +551,7 @@ module Dir_status = struct
|
|||
let project_root = Path.of_local (File_tree.Dir.project ft_dir).root in
|
||||
match Super_context.stanzas_in sctx ~dir with
|
||||
| None ->
|
||||
if dir = project_root ||
|
||||
if Path.equal dir project_root ||
|
||||
is_standalone (get sctx ~dir:(Path.parent_exn dir)) then
|
||||
Standalone (Some (ft_dir, None))
|
||||
else
|
||||
|
|
|
@ -32,20 +32,28 @@ module Name : sig
|
|||
val named : string -> t option
|
||||
|
||||
val anonymous_root : t
|
||||
|
||||
module Infix : Comparable.OPS with type t = t
|
||||
end = struct
|
||||
type t =
|
||||
| Named of string
|
||||
| Anonymous of Path.t
|
||||
module T = struct
|
||||
type t =
|
||||
| Named of string
|
||||
| Anonymous of Path.t
|
||||
|
||||
let compare a b =
|
||||
match a, b with
|
||||
| Named x, Named y -> String.compare x y
|
||||
| Anonymous x, Anonymous y -> Path.compare x y
|
||||
| Named _, Anonymous _ -> Lt
|
||||
| Anonymous _, Named _ -> Gt
|
||||
end
|
||||
|
||||
include T
|
||||
|
||||
module Infix = Comparable.Operators(T)
|
||||
|
||||
let anonymous_root = Anonymous Path.root
|
||||
|
||||
let compare a b =
|
||||
match a, b with
|
||||
| Named x, Named y -> String.compare x y
|
||||
| Anonymous x, Anonymous y -> Path.compare x y
|
||||
| Named _, Anonymous _ -> Lt
|
||||
| Anonymous _, Named _ -> Gt
|
||||
|
||||
let to_string_hum = function
|
||||
| Named s -> s
|
||||
| Anonymous p -> sprintf "<anonymous %s>" (Path.to_string_maybe_quoted p)
|
||||
|
@ -305,6 +313,7 @@ let default_name ~dir ~packages =
|
|||
| None -> Option.value_exn (Name.anonymous dir)
|
||||
| Some (_, pkg) ->
|
||||
let pkg =
|
||||
let open Package.Name.Infix in
|
||||
Package.Name.Map.fold packages ~init:pkg ~f:(fun pkg acc ->
|
||||
if acc.Package.name <= pkg.Package.name then
|
||||
acc
|
||||
|
|
|
@ -27,6 +27,8 @@ module Name : sig
|
|||
(** Convert to/from an encoded string that is suitable to use in filenames *)
|
||||
val encode : t -> string
|
||||
val decode : string -> t
|
||||
|
||||
module Infix : Comparable.OPS with type t = t
|
||||
end
|
||||
|
||||
module Project_file : sig
|
||||
|
|
16
src/exe.ml
16
src/exe.ml
|
@ -76,25 +76,27 @@ module Linkage = struct
|
|||
let flags =
|
||||
match m.kind with
|
||||
| Exe ->
|
||||
if wanted_mode = Native && real_mode = Byte then
|
||||
["-custom"]
|
||||
else
|
||||
[]
|
||||
begin
|
||||
match wanted_mode, real_mode with
|
||||
| Native, Byte -> ["-custom"]
|
||||
| _ -> []
|
||||
end
|
||||
| Object -> o_flags
|
||||
| Shared_object ->
|
||||
let so_flags =
|
||||
if ctx.os_type = "Win32" then
|
||||
if String.equal ctx.os_type "Win32" then
|
||||
so_flags_windows
|
||||
else
|
||||
so_flags_unix
|
||||
in
|
||||
if real_mode = Native then
|
||||
match real_mode with
|
||||
| Native ->
|
||||
(* The compiler doesn't pass these flags in native mode. This
|
||||
looks like a bug in the compiler. *)
|
||||
List.concat_map ctx.native_c_libraries ~f:(fun flag ->
|
||||
["-cclib"; flag])
|
||||
@ so_flags
|
||||
else
|
||||
| Byte ->
|
||||
so_flags
|
||||
in
|
||||
{ ext
|
||||
|
|
|
@ -487,9 +487,10 @@ module Gen(P : Install_rules.Params) = struct
|
|||
let l =
|
||||
let has_native = Option.is_some ctx.ocamlopt in
|
||||
List.filter_map (L.Set.to_list exes.modes) ~f:(fun (mode : L.t) ->
|
||||
if not has_native && mode.mode = Native then
|
||||
match has_native, mode.mode with
|
||||
| false, Native ->
|
||||
None
|
||||
else
|
||||
| _ ->
|
||||
Some (Exe.Linkage.of_user_config ctx mode))
|
||||
in
|
||||
(* If bytecode was requested but not native or best version,
|
||||
|
@ -697,7 +698,7 @@ module Gen(P : Install_rules.Params) = struct
|
|||
Option.bind (Dir_contents.lookup_module dir_contents name)
|
||||
~f:(fun buildable ->
|
||||
List.find_map cctxs ~f:(fun (loc, cctx) ->
|
||||
Option.some_if (loc = buildable.loc) cctx)))
|
||||
Option.some_if (Loc.equal loc buildable.loc) cctx)))
|
||||
with
|
||||
| None ->
|
||||
(* This happens often when passing a [-p ...] option that
|
||||
|
|
|
@ -870,15 +870,9 @@ module Mode_conf = struct
|
|||
let default = of_list [Byte; Best]
|
||||
|
||||
let eval t ~has_native =
|
||||
let best : Mode.t =
|
||||
if has_native then
|
||||
Native
|
||||
else
|
||||
Byte
|
||||
in
|
||||
let has_best = mem t Best in
|
||||
let byte = mem t Byte || (has_best && best = Byte) in
|
||||
let native = best = Native && (mem t Native || has_best) in
|
||||
let byte = mem t Byte || (has_best && (not has_native)) in
|
||||
let native = has_native && (mem t Native || has_best) in
|
||||
{ Mode.Dict.byte; native }
|
||||
end
|
||||
end
|
||||
|
@ -958,6 +952,7 @@ module Library = struct
|
|||
and dune_version = Syntax.get_exn Stanza.syntax
|
||||
in
|
||||
let name =
|
||||
let open Syntax.Version.Infix in
|
||||
match name, public with
|
||||
| Some n, _ ->
|
||||
Lib_name.validate n ~wrapped
|
||||
|
@ -1202,6 +1197,7 @@ module Executables = struct
|
|||
in
|
||||
fun names public_names ~multi ->
|
||||
let names =
|
||||
let open Syntax.Version.Infix in
|
||||
match names, public_names with
|
||||
| Some names, _ -> names
|
||||
| None, Some public_names ->
|
||||
|
@ -1844,7 +1840,7 @@ module Stanzas = struct
|
|||
if not (Path.exists current_file) then
|
||||
Loc.fail loc "File %s doesn't exist."
|
||||
(Path.to_string_maybe_quoted current_file);
|
||||
if List.exists include_stack ~f:(fun (_, f) -> f = current_file) then
|
||||
if List.exists include_stack ~f:(fun (_, f) -> Path.equal f current_file) then
|
||||
raise (Include_loop (current_file, include_stack));
|
||||
let sexps = Io.Sexp.load ~lexer current_file ~mode:Many in
|
||||
parse stanza_parser sexps ~lexer ~current_file ~include_stack
|
||||
|
|
|
@ -242,7 +242,7 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
|
|||
~f:(fun dir acc ->
|
||||
let p = File_tree.Dir.project dir in
|
||||
match Path.kind (File_tree.Dir.path dir) with
|
||||
| Local d when d = p.root -> p :: acc
|
||||
| Local d when Path.Local.equal d p.root -> p :: acc
|
||||
| _ -> acc)
|
||||
in
|
||||
let packages =
|
||||
|
|
|
@ -125,7 +125,7 @@ let build_cm cc ~(js_of_ocaml:Jbuild.Js_of_ocaml.t) ~src ~target =
|
|||
>>>
|
||||
js_of_ocaml_rule sctx ~dir ~flags:(fun flags -> As flags) ~spec ~target:itarget
|
||||
]
|
||||
@ (if target = itarget then
|
||||
@ (if Path.equal target itarget then
|
||||
[]
|
||||
else
|
||||
[Build.symlink ~src:itarget ~dst:target])
|
||||
|
|
|
@ -533,7 +533,7 @@ module Dep_stack = struct
|
|||
let to_required_by t ~stop_at =
|
||||
let stop_at = stop_at.stack in
|
||||
let rec loop acc l =
|
||||
if l == stop_at then
|
||||
if List.physically_equal l stop_at then
|
||||
List.rev acc
|
||||
else
|
||||
match l with
|
||||
|
|
19
src/loc.ml
19
src/loc.ml
|
@ -77,3 +77,22 @@ let to_file_colon_line t =
|
|||
|
||||
let pp_file_colon_line ppf t =
|
||||
Format.pp_print_string ppf (to_file_colon_line t)
|
||||
|
||||
let equal_position
|
||||
{ Lexing.pos_fname = f_a; pos_lnum = l_a
|
||||
; pos_bol = b_a; pos_cnum = c_a }
|
||||
{ Lexing.pos_fname = f_b; pos_lnum = l_b
|
||||
; pos_bol = b_b; pos_cnum = c_b }
|
||||
=
|
||||
let open Int.Infix in
|
||||
String.equal f_a f_b
|
||||
&& l_a = l_b
|
||||
&& b_a = b_b
|
||||
&& c_a = c_b
|
||||
|
||||
let equal
|
||||
{ start = start_a ; stop = stop_a }
|
||||
{ start = start_b ; stop = stop_b }
|
||||
=
|
||||
equal_position start_a start_b
|
||||
&& equal_position stop_a stop_b
|
||||
|
|
|
@ -3,6 +3,8 @@ type t = Usexp.Loc.t =
|
|||
; stop : Lexing.position
|
||||
}
|
||||
|
||||
val equal : t -> t -> bool
|
||||
|
||||
val sexp_of_t : t -> Usexp.t
|
||||
|
||||
val of_lexbuf : Lexing.lexbuf -> t
|
||||
|
|
|
@ -1,13 +1,17 @@
|
|||
open Import
|
||||
|
||||
module Name = struct
|
||||
type t = string
|
||||
module T = struct
|
||||
type t = string
|
||||
let compare = compare
|
||||
end
|
||||
|
||||
include T
|
||||
|
||||
let t = Sexp.atom
|
||||
|
||||
let add_suffix = (^)
|
||||
|
||||
let compare = compare
|
||||
let of_string = String.capitalize
|
||||
let to_string x = x
|
||||
|
||||
|
@ -19,6 +23,7 @@ module Name = struct
|
|||
module Set = String.Set
|
||||
module Map = String.Map
|
||||
module Top_closure = Top_closure.String
|
||||
module Infix = Comparable.Operators(T)
|
||||
end
|
||||
|
||||
module Syntax = struct
|
||||
|
|
|
@ -19,6 +19,8 @@ module Name : sig
|
|||
module Map : Map.S with type key = t
|
||||
|
||||
module Top_closure : Top_closure.S with type key := t
|
||||
|
||||
module Infix : Comparable.OPS with type t = t
|
||||
end
|
||||
|
||||
module Syntax : sig
|
||||
|
|
|
@ -60,6 +60,7 @@ module Dep_graphs = struct
|
|||
end
|
||||
|
||||
let parse_module_names ~(unit : Module.t) ~modules words =
|
||||
let open Module.Name.Infix in
|
||||
List.filter_map words ~f:(fun m ->
|
||||
let m = Module.Name.of_string m in
|
||||
if m = unit.name then
|
||||
|
@ -68,6 +69,7 @@ let parse_module_names ~(unit : Module.t) ~modules words =
|
|||
Module.Name.Map.find modules m)
|
||||
|
||||
let is_alias_module cctx (m : Module.t) =
|
||||
let open Module.Name.Infix in
|
||||
match CC.alias_module cctx with
|
||||
| None -> false
|
||||
| Some alias -> alias.name = m.name
|
||||
|
@ -103,6 +105,7 @@ let parse_deps cctx ~file ~unit lines =
|
|||
(match lib_interface_module with
|
||||
| None -> ()
|
||||
| Some (m : Module.t) ->
|
||||
let open Module.Name.Infix in
|
||||
if unit.name <> m.name && not (is_alias_module cctx unit) &&
|
||||
List.exists deps ~f:(fun x -> Module.name x = m.name) then
|
||||
die "Module %a in directory %s depends on %a.\n\
|
||||
|
|
|
@ -1,12 +1,14 @@
|
|||
open Stdune
|
||||
|
||||
module Name = struct
|
||||
include Interned.Make(struct
|
||||
module T = Interned.Make(struct
|
||||
let initial_size = 16
|
||||
let resize_policy = Interned.Conservative
|
||||
let order = Interned.Natural
|
||||
end)()
|
||||
|
||||
include T
|
||||
|
||||
let of_string = make
|
||||
|
||||
let opam_fn (t : t) = to_string t ^ ".opam"
|
||||
|
@ -14,6 +16,8 @@ module Name = struct
|
|||
let pp fmt t = Format.pp_print_string fmt (to_string t)
|
||||
|
||||
let t = Sexp.Of_sexp.(map string ~f:of_string)
|
||||
|
||||
module Infix = Comparable.Operators(T)
|
||||
end
|
||||
|
||||
|
||||
|
|
|
@ -14,6 +14,8 @@ module Name : sig
|
|||
include Interned.S with type t := t
|
||||
|
||||
val t : t Sexp.Of_sexp.t
|
||||
|
||||
module Infix : Comparable.OPS with type t = t
|
||||
end
|
||||
|
||||
type t =
|
||||
|
|
|
@ -157,6 +157,7 @@ module Map = struct
|
|||
|
||||
let rec expand map ~syntax_version ~pform =
|
||||
let open Option.O in
|
||||
let open Syntax.Version.Infix in
|
||||
let name = String_with_vars.Var.name pform in
|
||||
String.Map.find map name >>= fun v ->
|
||||
let describe = String_with_vars.Var.describe in
|
||||
|
|
|
@ -346,6 +346,7 @@ let ppx_driver_exe sctx libs ~dir_kind =
|
|||
| Private scope_name -> Some scope_name
|
||||
| Public _ | Installed -> None
|
||||
in
|
||||
let open Dune_project.Name.Infix in
|
||||
match acc, scope_for_key with
|
||||
| Some a, Some b -> assert (a = b); acc
|
||||
| Some _, None -> acc
|
||||
|
|
|
@ -8,7 +8,7 @@ let print ?(skip_trailing_cr=Sys.win32) path1 path2 =
|
|||
Path.extract_build_context_dir path1,
|
||||
Path.extract_build_context_dir path2
|
||||
with
|
||||
| Some (dir1, f1), Some (dir2, f2) when dir1 = dir2 ->
|
||||
| Some (dir1, f1), Some (dir2, f2) when Path.equal dir1 dir2 ->
|
||||
(dir1, Path.to_string f1, Path.to_string f2)
|
||||
| _ ->
|
||||
(Path.root, Path.to_string path1, Path.to_string path2)
|
||||
|
|
|
@ -125,7 +125,7 @@ module Fancy = struct
|
|||
in
|
||||
match stdout_to, stderr_to with
|
||||
| (File fn1 | Opened_file { filename = fn1; _ }),
|
||||
(File fn2 | Opened_file { filename = fn2; _ }) when fn1 = fn2 ->
|
||||
(File fn2 | Opened_file { filename = fn2; _ }) when Path.equal fn1 fn2 ->
|
||||
sprintf "%s &> %s" s (Path.to_string fn1)
|
||||
| _ ->
|
||||
let s =
|
||||
|
|
|
@ -114,7 +114,12 @@ let report exn =
|
|||
let backtrace = Printexc.get_raw_backtrace () in
|
||||
let ppf = err_ppf in
|
||||
let p = report_with_backtrace exn in
|
||||
let loc = if p.loc = Some Loc.none then None else p.loc in
|
||||
let loc =
|
||||
if Option.equal Loc.equal p.loc (Some Loc.none) then
|
||||
None
|
||||
else
|
||||
p.loc
|
||||
in
|
||||
Option.iter loc ~f:(fun loc -> Loc.print ppf loc);
|
||||
p.pp ppf;
|
||||
Format.pp_print_flush ppf ();
|
||||
|
|
|
@ -2,3 +2,41 @@ module type S = sig
|
|||
type t
|
||||
val compare : t -> t -> Ordering.t
|
||||
end
|
||||
|
||||
module type OPS = sig
|
||||
type t
|
||||
val (=) : t -> t -> bool
|
||||
val (>=) : t -> t -> bool
|
||||
val (>) : t -> t -> bool
|
||||
val (<=) : t -> t -> bool
|
||||
val (<) : t -> t -> bool
|
||||
end
|
||||
|
||||
module Operators (X : S) = struct
|
||||
type t = X.t
|
||||
|
||||
let (=) a b =
|
||||
match X.compare a b with
|
||||
| Eq -> true
|
||||
| Gt | Lt -> false
|
||||
|
||||
let (>=) a b =
|
||||
match X.compare a b with
|
||||
| Gt | Eq -> true
|
||||
| Lt -> false
|
||||
|
||||
let (>) a b =
|
||||
match X.compare a b with
|
||||
| Gt -> true
|
||||
| Lt | Eq -> false
|
||||
|
||||
let (<=) a b =
|
||||
match X.compare a b with
|
||||
| Lt | Eq -> true
|
||||
| Gt -> false
|
||||
|
||||
let (<) a b =
|
||||
match X.compare a b with
|
||||
| Lt -> true
|
||||
| Gt | Eq -> false
|
||||
end
|
||||
|
|
|
@ -2,3 +2,14 @@ module type S = sig
|
|||
type t
|
||||
val compare : t -> t -> Ordering.t
|
||||
end
|
||||
|
||||
module type OPS = sig
|
||||
type t
|
||||
val (=) : t -> t -> bool
|
||||
val (>=) : t -> t -> bool
|
||||
val (>) : t -> t -> bool
|
||||
val (<=) : t -> t -> bool
|
||||
val (<) : t -> t -> bool
|
||||
end
|
||||
|
||||
module Operators (X : S) : OPS with type t = X.t
|
||||
|
|
|
@ -19,3 +19,5 @@ let of_string_exn s =
|
|||
| exception Failure _ ->
|
||||
failwith (Printf.sprintf "of_string_exn: invalid int %S" s)
|
||||
| s -> s
|
||||
|
||||
module Infix = Comparable.Operators(T)
|
||||
|
|
|
@ -5,3 +5,5 @@ module Set : Set.S with type elt = t
|
|||
module Map : Map.S with type key = t
|
||||
|
||||
val of_string_exn : string -> t
|
||||
|
||||
module Infix : Comparable.OPS with type t = t
|
||||
|
|
|
@ -115,3 +115,5 @@ let rec nth t i =
|
|||
| [], _ -> None
|
||||
| x :: _, 0 -> Some x
|
||||
| _ :: xs, i -> nth xs (i - 1)
|
||||
|
||||
let physically_equal = Pervasives.(==)
|
||||
|
|
|
@ -43,3 +43,5 @@ val assoc : ('a * 'b) t -> 'a -> 'b option
|
|||
val singleton : 'a -> 'a t
|
||||
|
||||
val nth : 'a t -> int -> 'a option
|
||||
|
||||
val physically_equal : 'a t -> 'a t -> bool
|
||||
|
|
|
@ -52,3 +52,10 @@ let both x y =
|
|||
let to_list = function
|
||||
| None -> []
|
||||
| Some x -> [x]
|
||||
|
||||
let equal eq x y =
|
||||
match (x, y) with
|
||||
| None, None -> true
|
||||
| Some _, None -> false
|
||||
| None, Some _ -> false
|
||||
| Some sx, Some sy -> eq sx sy
|
||||
|
|
|
@ -26,3 +26,5 @@ val is_none : _ t -> bool
|
|||
val both : 'a t -> 'b t -> ('a * 'b) t
|
||||
|
||||
val to_list : 'a t -> 'a list
|
||||
|
||||
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
|
||||
|
|
|
@ -136,6 +136,7 @@ module Local : sig
|
|||
val is_root : t -> bool
|
||||
val compare : t -> t -> Ordering.t
|
||||
val compare_val : t -> t -> Ordering.t
|
||||
val equal : t -> t -> bool
|
||||
val of_string : ?error_loc:Usexp.Loc.t -> string -> t
|
||||
val to_string : t -> string
|
||||
val relative : ?error_loc:Usexp.Loc.t -> t -> string -> t
|
||||
|
@ -172,6 +173,11 @@ end = struct
|
|||
|
||||
let compare_val x y = String.compare (to_string x) (to_string y)
|
||||
|
||||
let equal x y =
|
||||
match compare x y with
|
||||
| Eq -> true
|
||||
| Gt | Lt -> false
|
||||
|
||||
let root = make "."
|
||||
|
||||
let is_root t = t = root
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
module Local : sig
|
||||
type t
|
||||
val sexp_of_t : t -> Sexp.t
|
||||
val equal : t -> t -> bool
|
||||
end
|
||||
|
||||
(** In the outside world *)
|
||||
|
@ -31,6 +32,8 @@ val sexp_of_t : t Sexp.To_sexp.t
|
|||
val compare : t -> t -> Ordering.t
|
||||
(** a directory is smaller than its descendants *)
|
||||
|
||||
val equal : t -> t -> bool
|
||||
|
||||
module Set : sig
|
||||
include Set.S with type elt = t
|
||||
val sexp_of_t : t Sexp.To_sexp.t
|
||||
|
|
|
@ -7,6 +7,7 @@ include struct
|
|||
let uncapitalize_ascii = String.uncapitalize
|
||||
let uppercase_ascii = String.uppercase
|
||||
let lowercase_ascii = String.lowercase
|
||||
let equal (a:string) b = Pervasives.(=) a b
|
||||
end
|
||||
|
||||
include StringLabels
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
include module type of struct include StringLabels end
|
||||
|
||||
val equal : t -> t -> bool
|
||||
val compare : t -> t -> Ordering.t
|
||||
|
||||
val break : t -> pos:int -> t * t
|
||||
|
|
|
@ -638,7 +638,7 @@ let create
|
|||
List.iter stanzas ~f:(function
|
||||
| Dune_env.T config ->
|
||||
let inherit_from =
|
||||
if ctx_dir = Scope.root scope then
|
||||
if Path.equal ctx_dir (Scope.root scope) then
|
||||
context_env_node
|
||||
else
|
||||
lazy (Env.get t ~dir:(Path.parent_exn ctx_dir))
|
||||
|
@ -811,7 +811,7 @@ module Action = struct
|
|||
| Some host ->
|
||||
fun exe ->
|
||||
match Path.extract_build_context_dir exe with
|
||||
| Some (dir, exe) when dir = sctx.context.build_dir ->
|
||||
| Some (dir, exe) when Path.equal dir sctx.context.build_dir ->
|
||||
Path.append host.context.build_dir exe
|
||||
| _ -> exe
|
||||
|
||||
|
|
|
@ -1,7 +1,18 @@
|
|||
open Import
|
||||
|
||||
module Version = struct
|
||||
type t = int * int
|
||||
module T = struct
|
||||
type t = int * int
|
||||
|
||||
let compare (major_a, minor_a) (major_b, minor_b) =
|
||||
match Int.compare major_a major_b with
|
||||
| (Gt | Lt) as ne -> ne
|
||||
| Eq -> Int.compare minor_a minor_b
|
||||
end
|
||||
|
||||
include T
|
||||
|
||||
module Infix = Comparable.Operators(T)
|
||||
|
||||
let to_string (a, b) = sprintf "%u.%u" a b
|
||||
|
||||
|
@ -19,8 +30,11 @@ module Version = struct
|
|||
| sexp ->
|
||||
of_sexp_error (Sexp.Ast.loc sexp) "Atom expected"
|
||||
|
||||
let can_read ~parser_version:(pa, pb) ~data_version:(da, db) =
|
||||
pa = da && db <= pb
|
||||
let can_read
|
||||
~parser_version:(parser_major, parser_minor)
|
||||
~data_version:(data_major, data_minor) =
|
||||
let open Int.Infix in
|
||||
parser_major = data_major && parser_minor >= data_minor
|
||||
end
|
||||
|
||||
module Supported_versions = struct
|
||||
|
@ -92,6 +106,7 @@ let check_supported t (loc, ver) =
|
|||
(String.concat ~sep:"\n"
|
||||
(List.map (Supported_versions.supported_ranges t.supported_versions)
|
||||
~f:(fun (a, b) ->
|
||||
let open Version.Infix in
|
||||
if a = b then
|
||||
sprintf "- %s" (Version.to_string a)
|
||||
else
|
||||
|
@ -125,6 +140,7 @@ let desc () =
|
|||
| Fields (loc, Some s) -> (loc, sprintf "Field '%s'" s)
|
||||
|
||||
let deleted_in t ver =
|
||||
let open Version.Infix in
|
||||
get_exn t >>= fun current_ver ->
|
||||
if current_ver < ver then
|
||||
return ()
|
||||
|
@ -134,6 +150,7 @@ let deleted_in t ver =
|
|||
end
|
||||
|
||||
let renamed_in t ver ~to_ =
|
||||
let open Version.Infix in
|
||||
get_exn t >>= fun current_ver ->
|
||||
if current_ver < ver then
|
||||
return ()
|
||||
|
@ -143,6 +160,7 @@ let renamed_in t ver ~to_ =
|
|||
end
|
||||
|
||||
let since t ver =
|
||||
let open Version.Infix in
|
||||
get_exn t >>= fun current_ver ->
|
||||
if current_ver >= ver then
|
||||
return ()
|
||||
|
|
|
@ -16,6 +16,9 @@ module Version : sig
|
|||
|
||||
(** Whether the parser can read the data or not *)
|
||||
val can_read : parser_version:t -> data_version:t -> bool
|
||||
|
||||
val compare : t -> t -> Ordering.t
|
||||
module Infix : Comparable.OPS with type t = t
|
||||
end
|
||||
|
||||
type t
|
||||
|
|
Loading…
Reference in New Issue