Remove more uses of Simple.Set and Simple.Map

Everything is now gone except for a few stragglers in `cmx/` and
`naming/`; these will be more easily dealt with after some changes to
`Simple.t`.

Author: lukemaurer

middle_end/flambda/basic/name.ml

@@ -104,3 +104,11 @@ let must_be_symbol_opt t =
   pattern_match t
     ~var:(fun _ -> None)
     ~symbol:(fun sym -> Some sym)
+
+module Pair = struct
+  include Identifiable.Make_pair
+    (Reg_width_things.Name)
+    (Reg_width_things.Name)
+
+  type nonrec t = t * t
+end

middle_end/flambda/basic/name.mli

@@ -55,3 +55,10 @@ val must_be_var_opt : t -> Variable.t option
 val must_be_symbol_opt : t -> Symbol.t option
 
 val rename : t -> t
+
+module Pair : sig
+  type nonrec t = t * t
+
+  include Identifiable.S with type t := t
+end
+

middle_end/flambda/basic/simple.ml

@@ -158,14 +158,6 @@ module List = struct
     else result
 end
 
-module Pair = struct
-  include Identifiable.Make_pair
-    (Reg_width_things.Simple)
-    (Reg_width_things.Simple)
-
-  type nonrec t = t * t
-end
-
 module With_kind = struct
   type nonrec t = t * Flambda_kind.t
 

middle_end/flambda/basic/simple.mli

@@ -94,12 +94,6 @@ module List : sig
   include Identifiable.S with type t := t
 end
 
-module Pair : sig
-  type nonrec t = t * t
-
-  include Identifiable.S with type t := t
-end
-
 module With_kind : sig
   type nonrec t = t * Flambda_kind.t
 

middle_end/flambda/cmx/flambda_cmx_format.ml

@@ -62,7 +62,7 @@ let create ~final_typing_env ~all_code ~exported_offsets ~used_closure_vars =
       Variable.Map.empty
   in
   let simples =
-    Simple.Set.fold (fun simple simples ->
+    Reg_width_things.Simple.Set.fold (fun simple simples ->
         Simple.Map.add simple (Simple.export simple) simples)
       exported_ids.simples
       Simple.Map.empty

middle_end/flambda/compare/compare.ml

@@ -766,6 +766,25 @@ let function_decls env decl1 decl2 : unit Comparison.t =
   else Different { approximant = () }
 ;;
 
+(** Match up equal elements in two lists and iterate through both of them,
+    using [f] analogously to [Map.S.merge] *)
+let iter2_merged l1 l2 ~compare ~f =
+  let l1 = List.sort compare l1 in
+  let l2 = List.sort compare l2 in
+  let rec go l1 l2 =
+    match l1, l2 with
+    | []      , []       -> ()
+    | a1 :: l1, []       -> f (Some a1) None     ; go l1         []
+    | []      , a2 :: l2 -> f None      (Some a2); go []         l2 
+    | a1 :: l1, a2 :: l2 ->
+      begin match compare a1 a2 with
+      | 0                -> f (Some a1) (Some a2); go l1         l2
+      | c when c < 0     -> f (Some a1) None     ; go l1         (a2 :: l2)
+      | _                -> f None      (Some a2); go (a1 :: l1) l2
+      end
+  in
+  go l1 l2
+
 let sets_of_closures env set1 set2 : Set_of_closures.t Comparison.t =
   (* Need to do unification on closure vars and closure ids, we we're going to
    * invert both maps, figuring the closure vars with the same value should be
@@ -777,28 +796,28 @@ let sets_of_closures env set1 set2 : Set_of_closures.t Comparison.t =
     |> List.map (fun (var, value) ->
          subst_simple env value, var
        )
-    |> Simple.Map.of_list
   in
   (* We want to process the whole map to find new correspondences between
    * closure vars, so we need to remember whether we've found any mismatches *)
   let ok = ref true in
-  (* Using merge here as a map version of [List.iter2]; always returning None
-   * means the returned map is always empty, so this shouldn't waste much *)
-  let _ : unit Simple.Map.t =
-    Simple.Map.merge (fun _value var1 var2 ->
-      begin
-        match var1, var2 with
-        | None, None -> ()
-        | Some _, None | None, Some _ -> ok := false
-        | Some var1, Some var2 ->
-          begin
-            match closure_vars env var1 var2 with
-            | Equivalent -> ()
-            | Different { approximant = _ } -> ok := false
-          end
-      end;
-      None
-    ) (closure_vars_by_value set1) (closure_vars_by_value set2)
+  let () =
+    let compare (value1, _var1) (value2, _var2) =
+      Simple.compare value1 value2
+    in
+    iter2_merged (closure_vars_by_value set1) (closure_vars_by_value set2)
+      ~compare
+      ~f:(fun elt1 elt2 ->
+        begin
+          match elt1, elt2 with
+          | None, None -> ()
+          | Some _, None | None, Some _ -> ok := false
+          | Some (_value1, var1), Some (_value2, var2) ->
+            begin
+              match closure_vars env var1 var2 with
+              | Equivalent -> ()
+              | Different { approximant = _ } -> ok := false
+            end
+        end)
   in
   let closure_ids_and_fun_decls_by_code_id set =
     let map = Function_declarations.funs (Set_of_closures.function_decls set) in
@@ -809,6 +828,8 @@ let sets_of_closures env set1 set2 : Set_of_closures.t Comparison.t =
        )
     |> Code_id.Map.of_list
   in
+  (* Using merge here as a map version of [List.iter2]; always returning None
+   * means the returned map is always empty, so this shouldn't waste much *)
   let _ : unit Code_id.Map.t =
     Code_id.Map.merge (fun _code_id value1 value2 ->
       begin

middle_end/flambda/types/env/meet_env.rec.ml

@@ -18,7 +18,7 @@
 
 type t = {
   env : Typing_env.t;
-  already_meeting : Simple.Pair.Set.t;
+  already_meeting : Name.Pair.Set.t;
 }
 
 let print ppf { env; already_meeting; } =
@@ -27,33 +27,45 @@ let print ppf { env; already_meeting; } =
       @[<hov 1>(env@ %a)@]@ \
       @[<hov 1>(already_meeting@ %a)@])@]"
     Typing_env.print env
-    Simple.Pair.Set.print already_meeting
+    Name.Pair.Set.print already_meeting
 
 let create env =
   { env;
-    already_meeting = Simple.Pair.Set.empty;
+    already_meeting = Name.Pair.Set.empty;
   }
 
 let env t = t.env
+      
+let already_meeting_names t name1 name2 =
+  Name.Pair.Set.mem (name1, name2) t.already_meeting
+    || Name.Pair.Set.mem (name2, name1) t.already_meeting
 
 let already_meeting t simple1 simple2 =
-  Simple.Pair.Set.mem (simple1, simple2) t.already_meeting
-    || Simple.Pair.Set.mem (simple2, simple1) t.already_meeting
+  let const _const = false in
+  Simple.pattern_match simple1 ~const ~name:(fun name1 ->
+    Simple.pattern_match simple2 ~const ~name:(fun name2 ->
+      already_meeting_names t name1 name2))
 
-let now_meeting t simple1 simple2 =
-  if already_meeting t simple1 simple2 then begin
+let now_meeting_names t name1 name2 =
+  if already_meeting_names t name1 name2 then begin
     Misc.fatal_errorf "Already meeting %a and %a:@ %a"
-      Simple.print simple1
-      Simple.print simple2
+      Name.print name1
+      Name.print name2
       print t
   end;
   let already_meeting =
-    Simple.Pair.Set.add (simple1, simple2) t.already_meeting
+    Name.Pair.Set.add (name1, name2) t.already_meeting
   in
   { t with
     already_meeting;
   }
 
+let now_meeting t simple1 simple2 =
+  let const _const = t in
+  Simple.pattern_match simple1 ~const ~name:(fun name1 ->
+    Simple.pattern_match simple2 ~const ~name:(fun name2 ->
+      now_meeting_names t name1 name2))
+
 (* let with_typing_env t typing_env =
  *   { t with
  *     env = typing_env;