Remove recursive modules in types/ (#292)

Author: mshinwell

middle_end/flambda2/algorithms/patricia_tree.ml

@@ -965,6 +965,10 @@ struct
   let mapi f t =
     fold (fun key datum result -> add key (f key datum) result) t empty
 
+  (* CR lmaurer: Implement this one properly even if [map] isn't efficient yet,
+     since not sharing makes _other things_ (including row-like types) less
+     efficient. *)
+
   let map_sharing = map
 
   let to_seq t =

middle_end/flambda2/cmx/flambda_cmx.ml

@@ -16,8 +16,8 @@
 
 [@@@ocaml.warning "+a-4-30-40-41-42"]
 
-module T = Flambda_type
-module TE = Flambda_type.Typing_env
+module T = Flambda2_types
+module TE = Flambda2_types.Typing_env
 
 let rec load_cmx_file_contents ~get_global_info comp_unit ~imported_units
     ~imported_names ~imported_code =

middle_end/flambda2/cmx/flambda_cmx.mli

@@ -23,13 +23,13 @@ val load_cmx_file_contents :
   get_global_info:
     (Flambda2_identifiers.Compilation_unit.t -> Flambda_cmx_format.t option) ->
   Compilation_unit.t ->
-  imported_units:Flambda_type.Typing_env.t option Compilation_unit.Map.t ref ->
+  imported_units:Flambda2_types.Typing_env.t option Compilation_unit.Map.t ref ->
   imported_names:Name.Set.t ref ->
   imported_code:Exported_code.t ref ->
-  Flambda_type.Typing_env.t option
+  Flambda2_types.Typing_env.t option
 
 val prepare_cmx_file_contents :
-  final_typing_env:Flambda_type.Typing_env.t option ->
+  final_typing_env:Flambda2_types.Typing_env.t option ->
   module_symbol:Symbol.t ->
   used_closure_vars:Var_within_closure.Set.t ->
   Exported_code.t ->

middle_end/flambda2/cmx/flambda_cmx_format.ml

@@ -31,7 +31,7 @@ type table_data =
 
 type t0 =
   { original_compilation_unit : Compilation_unit.t;
-    final_typing_env : Flambda_type.Typing_env.Serializable.t;
+    final_typing_env : Flambda2_types.Typing_env.Serializable.t;
     all_code : Exported_code.t;
     exported_offsets : Exported_offsets.t;
     used_closure_vars : Var_within_closure.Set.t;
@@ -42,7 +42,7 @@ type t = t0 list
 
 let create ~final_typing_env ~all_code ~exported_offsets ~used_closure_vars =
   let typing_env_exported_ids =
-    Flambda_type.Typing_env.Serializable.all_ids_for_export final_typing_env
+    Flambda2_types.Typing_env.Serializable.all_ids_for_export final_typing_env
   in
   let all_code_exported_ids = Exported_code.all_ids_for_export all_code in
   let exported_ids =
@@ -127,7 +127,7 @@ let import_typing_env_and_code0 t =
       ~continuations ~used_closure_vars
   in
   let typing_env =
-    Flambda_type.Typing_env.Serializable.apply_renaming t.final_typing_env
+    Flambda2_types.Typing_env.Serializable.apply_renaming t.final_typing_env
       renaming
   in
   let all_code = Exported_code.apply_renaming code_ids renaming t.all_code in
@@ -142,7 +142,7 @@ let import_typing_env_and_code t =
       (fun (typing_env, code) t0 ->
         let typing_env0, code0 = import_typing_env_and_code0 t0 in
         let typing_env =
-          Flambda_type.Typing_env.Serializable.merge typing_env typing_env0
+          Flambda2_types.Typing_env.Serializable.merge typing_env typing_env0
         in
         let code = Exported_code.merge code code0 in
         typing_env, code)
@@ -219,7 +219,7 @@ let print0 ppf t =
   Compilation_unit.set_current t.original_compilation_unit;
   let typing_env, code = import_typing_env_and_code0 t in
   Format.fprintf ppf "@[<hov>Typing env:@ %a@]@;"
-    Flambda_type.Typing_env.Serializable.print typing_env;
+    Flambda2_types.Typing_env.Serializable.print typing_env;
   Format.fprintf ppf "@[<hov>Code:@ %a@]@;" Exported_code.print code;
   Format.fprintf ppf "@[<hov>Offsets:@ %a@]@;" Exported_offsets.print
     t.exported_offsets

middle_end/flambda2/cmx/flambda_cmx_format.mli

@@ -21,14 +21,14 @@
 type t
 
 val create :
-  final_typing_env:Flambda_type.Typing_env.Serializable.t ->
+  final_typing_env:Flambda2_types.Typing_env.Serializable.t ->
   all_code:Exported_code.t ->
   exported_offsets:Exported_offsets.t ->
   used_closure_vars:Var_within_closure.Set.t ->
   t
 
 val import_typing_env_and_code :
-  t -> Flambda_type.Typing_env.Serializable.t * Exported_code.t
+  t -> Flambda2_types.Typing_env.Serializable.t * Exported_code.t
 
 val exported_offsets : t -> Exported_offsets.t
 

middle_end/flambda2/identifiers/reg_width_things.ml

@@ -697,7 +697,7 @@ module Simple = struct
   end
 
   let with_coercion t new_coercion =
-    if Coercion.is_id new_coercion
+    if Coercion.is_id new_coercion || Id.flags t = const_flags
     then t
     else if Coercion.is_id (coercion t)
     then

middle_end/flambda2/lattices/or_bottom.ml

@@ -44,3 +44,9 @@ let all ts =
   if List.compare_lengths ts contents <> 0 then Bottom else Ok contents
 
 let bind t ~f = match t with Bottom -> Bottom | Ok contents -> f contents
+
+module Let_syntax = struct
+  let ( let<* ) x f = bind x ~f
+
+  let ( let<+ ) x f = map x ~f
+end

middle_end/flambda2/lattices/or_bottom.mli

@@ -31,3 +31,9 @@ val value_map : 'a t -> bottom:'b -> f:('a -> 'b) -> 'b
 val all : 'a t list -> 'a list t
 
 val bind : 'a t -> f:('a -> 'b t) -> 'b t
+
+module Let_syntax : sig
+  val ( let<* ) : 'a t -> ('a -> 'b t) -> 'b t
+
+  val ( let<+ ) : 'a t -> ('a -> 'b) -> 'b t
+end

middle_end/flambda2/lattices/or_unknown.ml

@@ -44,6 +44,8 @@ let equal equal_contents t1 t2 =
   | Known contents1, Known contents2 -> equal_contents contents1 contents2
   | Unknown, Known _ | Known _, Unknown -> false
 
+let bind t ~f = match t with Known contents -> f contents | Unknown -> Unknown
+
 let map t ~f =
   match t with Known contents -> Known (f contents) | Unknown -> Unknown
 
@@ -90,3 +92,9 @@ module Lift (I : Container_types.S) = struct
     let output _ _ = Misc.fatal_error "Not yet implemented"
   end)
 end
+
+module Let_syntax = struct
+  let ( let>* ) x f = bind x ~f
+
+  let ( let>+ ) x f = map x ~f
+end

middle_end/flambda2/lattices/or_unknown.mli

@@ -26,6 +26,8 @@ val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
 
 val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
 
+val bind : 'a t -> f:('a -> 'b t) -> 'b t
+
 val map : 'a t -> f:('a -> 'b) -> 'b t
 
 val map_sharing : 'a t -> f:('a -> 'a) -> 'a t
@@ -41,3 +43,9 @@ module Lift (I : Container_types.S) : sig
 
   include Container_types.S with type t := t
 end
+
+module Let_syntax : sig
+  val ( let>* ) : 'a t -> ('a -> 'b t) -> 'b t
+
+  val ( let>+ ) : 'a t -> ('a -> 'b) -> 'b t
+end

middle_end/flambda2/lattices/or_unknown_or_bottom.ml

@@ -34,6 +34,12 @@ let equal eq_contents t1 t2 =
   | Bottom, Bottom -> true
   | (Unknown | Ok _ | Bottom), _ -> false
 
+let bind t ~f =
+  match t with
+  | Unknown -> Unknown
+  | Bottom -> Bottom
+  | Ok contents -> f contents
+
 let map t ~f =
   match t with
   | Unknown -> Unknown
@@ -49,3 +55,9 @@ let map_sharing t ~f =
 
 let of_or_unknown (unk : _ Or_unknown.t) : _ t =
   match unk with Known contents -> Ok contents | Unknown -> Unknown
+
+module Let_syntax = struct
+  let ( let<>* ) x f = bind x ~f
+
+  let ( let<>+ ) x f = map x ~f
+end

middle_end/flambda2/lattices/or_unknown_or_bottom.mli

@@ -25,8 +25,16 @@ val print : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
 
 val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
 
+val bind : 'a t -> f:('a -> 'b t) -> 'b t
+
 val map : 'a t -> f:('a -> 'b) -> 'b t
 
 val map_sharing : 'a t -> f:('a -> 'a) -> 'a t
 
 val of_or_unknown : 'a Or_unknown.t -> 'a t
+
+module Let_syntax : sig
+  val ( let<>* ) : 'a t -> ('a -> 'b t) -> 'b t
+
+  val ( let<>+ ) : 'a t -> ('a -> 'b) -> 'b t
+end

middle_end/flambda2/nominal/with_delayed_permutation.ml

@@ -25,8 +25,8 @@ module BP = Bound_parameter
 module NM = Name_mode
 module P = Flambda_primitive
 module RI = Apply_cont_rewrite_id
-module T = Flambda_type
-module TE = Flambda_type.Typing_env
+module T = Flambda2_types
+module TE = Flambda2_types.Typing_env
 module List = ListLabels
 
 type t =
@@ -188,12 +188,12 @@ let cse_with_eligible_lhs ~typing_env_at_fork ~cse_at_each_use ~params prev_cse
                   let aliases =
                     TE.aliases_of_simple env_at_use ~min_name_mode:NM.normal
                       bound_to
-                    |> Aliases.Alias_set.filter ~f:(fun simple ->
+                    |> TE.Alias_set.filter ~f:(fun simple ->
                            not (is_param simple))
                   in
                   (* CR lmaurer: Do we need to make sure there's only one alias?
                      If not, we can use [Aliases.Alias_set.find_best] here. *)
-                  Aliases.Alias_set.get_singleton aliases
+                  TE.Alias_set.get_singleton aliases
               in
               match bound_to with
               | None -> eligible

middle_end/flambda2/nominal/with_delayed_permutation.mli

@@ -23,8 +23,8 @@ module EPA = Continuation_extra_params_and_args
 module BP = Bound_parameter
 module P = Flambda_primitive
 module RI = Apply_cont_rewrite_id
-module T = Flambda_type
-module TE = Flambda_type.Typing_env
+module T = Flambda2_types
+module TE = Flambda2_types.Typing_env
 
 type t
 

middle_end/flambda2/simplify/common_subexpression_elimination.ml

@@ -16,8 +16,8 @@
 
 [@@@ocaml.warning "+a-4-30-40-41-42"]
 
-module T = Flambda_type
-module TE = Flambda_type.Typing_env
+module T = Flambda2_types
+module TE = Flambda2_types.Typing_env
 
 type arg_at_use =
   { arg_type : T.t;

middle_end/flambda2/simplify/common_subexpression_elimination.mli

@@ -17,8 +17,8 @@
 [@@@ocaml.warning "+a-4-30-40-41-42"]
 
 type arg_at_use =
-  { arg_type : Flambda_type.t;
-    typing_env : Flambda_type.Typing_env.t
+  { arg_type : Flambda2_types.t;
+    typing_env : Flambda2_types.Typing_env.t
   }
 
 type t =

middle_end/flambda2/simplify/env/continuation_env_and_param_types.ml

@@ -17,7 +17,7 @@
 [@@@ocaml.warning "+a-30-40-41-42"]
 
 module DE = Downwards_env
-module T = Flambda_type
+module T = Flambda2_types
 module U = One_continuation_use
 
 type t =