Some stuffs on pr 3937

middle_end/flambda2/nominal/name_mode.ml

@@ -54,14 +54,6 @@ let is_in_types t = match t with In_types -> true | Normal | Phantom -> false
 let can_be_in_terms t =
   match t with Normal | Phantom -> true | In_types -> false
 
-let compare_partial_order t1 t2 =
-  match t1, t2 with
-  | Normal, Normal | Phantom, Phantom | In_types, In_types -> Some 0
-  | Normal, (Phantom | In_types) -> Some 1
-  | (Phantom | In_types), Normal -> Some (-1)
-  | Phantom, In_types -> Some 1
-  | In_types, Phantom -> Some (-1)
-
 include Container_types.Make (struct
   type nonrec t = t
 
@@ -74,8 +66,6 @@ include Container_types.Make (struct
   let hash _ = Misc.fatal_error "Name_mode.hash not yet implemented"
 
   let compare t1 t2 =
-    (* This is a linear extension of the ordering used by
-       [compare_partial_order], above. *)
     match t1, t2 with
     | Normal, Normal | Phantom, Phantom | In_types, In_types -> 0
     | Normal, (Phantom | In_types) -> 1
@@ -88,8 +78,6 @@ end)
 
 let compare_total_order = compare
 
-let compare _ _ = `Be_explicit_about_total_or_partial_ordering
-
 module Or_absent = struct
   type t =
     | Absent
@@ -128,15 +116,7 @@ module Or_absent = struct
     let equal t1 t2 = compare t1 t2 = 0
   end)
 
-  let compare _ _ = `Be_explicit_about_total_or_partial_ordering
-
-  let compare_partial_order t1 t2 =
-    match t1, t2 with
-    | Absent, Absent -> Some 0
-    | Absent, Present _ -> Some (-1)
-    | Present _, Absent -> Some 1
-    | Present name_mode1, Present name_mode2 ->
-      compare_partial_order name_mode1 name_mode2
+  let compare_total_order = compare
 
   let join_in_terms t1 t2 =
     match t1, t2 with

middle_end/flambda2/nominal/name_mode.mli

@@ -51,11 +51,6 @@ include Container_types.S with type t := t
 
 val compare_total_order : t -> t -> int
 
-val compare_partial_order : t -> t -> int option
-
-(** This shadows [compare] from the above [include]. *)
-val compare : t -> t -> [`Be_explicit_about_total_or_partial_ordering]
-
 module Or_absent : sig
   type t = private
     | Absent
@@ -71,10 +66,7 @@ module Or_absent : sig
 
   include Container_types.S with type t := t
 
-  val compare_partial_order : t -> t -> int option
-
-  (** This shadows [compare] from the above [include]. *)
-  val compare : t -> t -> [`Be_explicit_about_total_or_partial_ordering]
+  val compare_total_order : t -> t -> int
 
   val join_in_terms : t -> t -> t
 end

middle_end/flambda2/simplify/simplify_let_expr.ml

@@ -134,12 +134,9 @@ let rebuild_let simplify_named_result removed_operations ~rewrite_id
           let greatest_name_mode = compute_greatest_name_mode bound_vars in
           let declared_name_mode = Bound_pattern.name_mode bound_vars in
           let mismatched_modes =
-            match
-              Name_mode.Or_absent.compare_partial_order greatest_name_mode
-                (Name_mode.Or_absent.present declared_name_mode)
-            with
-            | None -> true
-            | Some c -> c > 0
+            Name_mode.Or_absent.compare_total_order greatest_name_mode
+              (Name_mode.Or_absent.present declared_name_mode)
+            > 0
           in
           let { Simplified_named.named = defining_expr;
                 free_names = _;

middle_end/flambda2/types/env/aliases.ml

@@ -167,15 +167,12 @@ end = struct
       (fun order aliases res_opt ->
         match res_opt with
         | Some _ -> res_opt
-        | None -> (
-          match Name_mode.compare_partial_order order min_name_mode with
-          | None -> None
-          | Some result ->
-            if result >= 0
-            then
-              let aliases = filter_by_scope order aliases in
-              if Name.Map.is_empty aliases then None else Some aliases
-            else None))
+        | None ->
+          if Name_mode.compare_total_order order min_name_mode >= 0
+          then
+            let aliases = filter_by_scope order aliases in
+            if Name.Map.is_empty aliases then None else Some aliases
+          else None)
       t.aliases None
 
   let mem t elt = Name.Map.mem elt t.all
@@ -907,11 +904,9 @@ let get_canonical_element_exn ~binding_time_resolver ~binding_times_and_modes t
   let canonical = canonical t element in
   match canonical with
   | Is_canonical
-    when match Name_mode.compare_partial_order elt_name_mode min_name_mode with
-         | None -> false
-         | Some c -> c >= 0 ->
+    when Name_mode.compare_total_order elt_name_mode min_name_mode >= 0 ->
     element
-  | Is_canonical | Alias_of_canonical _ -> (
+  | Is_canonical | Alias_of_canonical _ ->
     let canonical_element, name_mode, coercion_from_canonical_to_element =
       match canonical with
       | Is_canonical ->
@@ -924,20 +919,13 @@ let get_canonical_element_exn ~binding_time_resolver ~binding_times_and_modes t
         canonical_element, name_mode, Coercion.inverse coercion_to_canonical
     in
     assert (not (Simple.has_coercion canonical_element));
-    match Name_mode.compare_partial_order name_mode min_name_mode with
-    | None ->
+    if Name_mode.compare_total_order name_mode min_name_mode >= 0
+    then
+      Simple.with_coercion canonical_element coercion_from_canonical_to_element
+    else
       find_earliest_alias t ~canonical_element ~binding_times_and_modes
         ~min_binding_time ~min_name_mode ~binding_time_resolver
         ~coercion_from_canonical_to_element
-    | Some c ->
-      if c >= 0
-      then
-        Simple.with_coercion canonical_element
-          coercion_from_canonical_to_element
-      else
-        find_earliest_alias t ~canonical_element ~binding_times_and_modes
-          ~min_binding_time ~min_name_mode ~binding_time_resolver
-          ~coercion_from_canonical_to_element)
 
 let get_aliases t element =
   match canonical t element with

middle_end/flambda2/types/env/typing_env.ml

@@ -563,10 +563,8 @@ let mem ?min_name_mode t name =
       match name_mode, min_name_mode with
       | None, _ -> false
       | Some _, None -> true
-      | Some name_mode, Some min_name_mode -> (
-        match Name_mode.compare_partial_order min_name_mode name_mode with
-        | None -> false
-        | Some c -> c <= 0))
+      | Some name_mode, Some min_name_mode ->
+        Name_mode.compare_total_order min_name_mode name_mode <= 0)
     ~symbol:(fun sym ->
       (* CR mshinwell: This might not take account of symbols in missing .cmx
          files *)
@@ -997,9 +995,7 @@ let aliases_of_simple t ~min_name_mode simple =
            Binding_time.With_name_mode.name_mode
              (binding_time_and_mode_of_simple t alias)
          in
-         match Name_mode.compare_partial_order name_mode min_name_mode with
-         | None -> false
-         | Some c -> c >= 0)
+         Name_mode.compare_total_order name_mode min_name_mode >= 0)
 
 let aliases_of_simple_allowable_in_types t simple =
   aliases_of_simple t ~min_name_mode:Name_mode.in_types simple