More robust handling of missing imported variables

middle_end/flambda2/lifting/reification.ml

@@ -109,11 +109,14 @@ let lift dacc ty ~bound_to static_const =
   in
   Simplified_named.reachable term, dacc, var_ty
 
-let try_to_reify dacc (term : Simplified_named.t) ~bound_to ~allow_lifting =
+let try_to_reify dacc (term : Simplified_named.t) ~bound_to ~kind_of_bound_to
+      ~allow_lifting =
   let occ_kind = Var_in_binding_pos.name_mode bound_to in
   let bound_to = Var_in_binding_pos.var bound_to in
   let denv = DA.denv dacc in
-  let ty = DE.find_variable denv bound_to in
+  let ty =
+    TE.find (DE.typing_env denv) (Name.var bound_to) (Some kind_of_bound_to)
+  in
   match term with
   | Invalid _ ->
     let ty = T.bottom_like ty in

middle_end/flambda2/lifting/reification.mli

@@ -22,5 +22,6 @@ val try_to_reify
    : Downwards_acc.t
   -> Simplified_named.t
   -> bound_to:Var_in_binding_pos.t
+  -> kind_of_bound_to:Flambda_kind.t
   -> allow_lifting:bool
   -> Simplified_named.t * Downwards_acc.t * Flambda_type.t

middle_end/flambda2/simplify/env/downwards_env.ml

@@ -284,16 +284,6 @@ let add_equation_on_variable t var ty =
 
 let mem_name t name = TE.mem t.typing_env name
 
-let find_name t name =
-  match TE.find t.typing_env name None with
-  | exception Not_found ->
-    Misc.fatal_errorf "Unbound name %a in environment:@ %a"
-      Name.print name
-      print t
-  | ty -> ty
-
-let find_variable t var = find_name t (Name.var var)
-
 let mem_variable t var = TE.mem t.typing_env (Name.var var)
 
 let define_symbol t sym kind =
@@ -329,7 +319,7 @@ let add_equation_on_symbol t sym ty =
 
 let mem_symbol t sym = mem_name t (Name.symbol sym)
 
-let find_symbol t sym = find_name t (Name.symbol sym)
+let find_symbol t sym = TE.find (typing_env t) (Name.symbol sym) (Some K.value)
 
 let add_symbol_projection t var proj =
   { t with

middle_end/flambda2/simplify/env/downwards_env.mli

@@ -93,8 +93,6 @@ val add_variable : t -> Var_in_binding_pos.t -> Flambda_type.t -> t
 
 val add_equation_on_variable : t -> Variable.t -> Flambda_type.t -> t
 
-val find_variable : t -> Variable.t -> Flambda_type.t
-
 val mem_variable : t -> Variable.t -> bool
 
 val add_symbol : t -> Symbol.t -> Flambda_type.t -> t

middle_end/flambda2/simplify/simplify_named.ml

@@ -196,7 +196,8 @@ let simplify_named0 dacc (bindable_let_bound : Bindable_let_bound.t)
         && Name_mode.is_normal (Var_in_binding_pos.name_mode bound_var)
     in
     let defining_expr, dacc, ty =
-      Reification.try_to_reify dacc term ~bound_to:bound_var ~allow_lifting
+      Reification.try_to_reify dacc term ~bound_to:bound_var
+        ~kind_of_bound_to:kind ~allow_lifting
     in
     let defining_expr =
       if T.is_bottom (DA.typing_env dacc) ty then Simplified_named.invalid ()

middle_end/flambda2/simplify/simplify_rec_info_expr.ml

@@ -18,7 +18,9 @@
 
 module DA = Downwards_acc
 module DE = Downwards_env
+module K = Flambda_kind
 module T = Flambda_type
+module TE = T.Typing_env
 
 let compute_succ
       ~(depth : int Or_infinity.t)
@@ -62,7 +64,7 @@ let rec simplify_rec_info_expr0 denv orig ~on_unknown : Rec_info_expr.t =
   match (orig : Rec_info_expr.t) with
   | Const _ -> orig
   | Var dv ->
-    let ty = DE.find_variable denv dv in
+    let ty = TE.find (DE.typing_env denv) (Name.var dv) (Some K.rec_info) in
     begin match T.prove_rec_info (DE.typing_env denv) ty with
     | Proved rec_info_expr ->
       (* All bound names are fresh, so fine to use the same environment *)

middle_end/flambda2/simplify/simplify_set_of_closures.ml

@@ -92,7 +92,7 @@ end = struct
   let previously_free_depth_variables t = t.previously_free_depth_variables
 
   let compute_closure_element_types_inside_function ~env_prior_to_sets
-        ~env_inside_function ~closure_element_types =
+        ~env_inside_function ~closure_element_types ~degraded_closure_vars =
     Var_within_closure.Map.fold
       (fun clos_var type_prior_to_sets
            (env_inside_function, types_inside_function) ->
@@ -103,6 +103,12 @@ end = struct
             (Name_in_binding_pos.var var)
             K.value
         in
+        let type_prior_to_sets =
+          (* See comment below about [degraded_closure_vars]. *)
+          if Var_within_closure.Set.mem clos_var degraded_closure_vars
+          then T.any_value ()
+          else type_prior_to_sets
+        in
         let env_extension =
           T.make_suitable_for_environment type_prior_to_sets
             env_prior_to_sets
@@ -254,23 +260,40 @@ end = struct
       |> DE.increment_continuation_scope_level_twice
       (* Even if we are not rebuilding terms we should always rebuild them
          for local functions. The type of a function is dependent on its
-	 term and not knowing it prohibits us from inlining it.*)
+       	 term and not knowing it prohibits us from inlining it. *)
       |> DE.set_rebuild_terms
     in
+    (* We collect a set of "degraded closure variables" whose types involve
+       imported variables from missing .cmx files.  Since we don't know the
+       kind of these variables, we can't run the code below that checks if
+       they might need binding as "never inline" depth variables.  Instead we
+       will treat the whole closure variable as having [Unknown] type. *)
+    let degraded_closure_vars = ref Var_within_closure.Set.empty in
     let free_depth_variables =
       List.concat_map (fun closure_element_types ->
-          List.map (fun ty ->
+          Var_within_closure.Map.mapi (fun closure_var ty ->
               let vars = TE.free_names_transitive (DE.typing_env denv) ty in
               Name_occurrences.fold_variables vars ~init:Variable.Set.empty
                 ~f:(fun free_depth_variables var ->
-                    let ty = DE.find_variable denv_inside_functions var in
-                    match T.kind ty with
-                    | Rec_info ->
-                      Variable.Set.add var free_depth_variables
-                    | Value | Naked_number _ | Fabricated ->
+                    let ty_opt =
+                      TE.find_or_missing (DE.typing_env denv_inside_functions)
+                        (Name.var var)
+                    in
+                    match ty_opt with
+                    | None ->
+                      degraded_closure_vars
+                        := Var_within_closure.Set.add closure_var
+                             !degraded_closure_vars;
                       free_depth_variables
+                    | Some ty ->
+                      match T.kind ty with
+                      | Rec_info ->
+                        Variable.Set.add var free_depth_variables
+                      | Value | Naked_number _ | Fabricated ->
+                        free_depth_variables
                   )
-            ) (closure_element_types |> Var_within_closure.Map.data)
+            ) closure_element_types
+          |> Var_within_closure.Map.data
         ) closure_element_types_all_sets
       |> Variable.Set.union_list
     in
@@ -305,6 +328,7 @@ end = struct
             compute_closure_element_types_inside_function
               ~env_prior_to_sets:(DE.typing_env denv)
               ~env_inside_function:env_inside_functions ~closure_element_types
+              ~degraded_closure_vars:!degraded_closure_vars
           in
           env_inside_functions,
             closure_element_types_inside_function

middle_end/flambda2/simplify/simplify_static_const.ml

@@ -47,15 +47,15 @@ let simplify_field_of_block dacc (field : Field_of_block.t) =
           field, ty)
 
 let simplify_or_variable dacc type_for_const
-      (or_variable : _ Or_variable.t) =
+      (or_variable : _ Or_variable.t) kind =
   let denv = DA.denv dacc in
   match or_variable with
   | Const const -> or_variable, type_for_const const
   | Var var ->
     (* CR mshinwell: This needs to check the type of the variable according
        to the various cases below. *)
     (* CR mshinwell: This should be calling [simplify_simple] *)
-    or_variable, DE.find_variable denv var
+    or_variable, TE.find (DE.typing_env denv) (Name.var var) (Some kind)
 
 let simplify_static_const_of_kind_value dacc
       (static_const : Static_const.t) ~result_sym
@@ -90,6 +90,7 @@ let simplify_static_const_of_kind_value dacc
   | Boxed_float or_var ->
     let or_var, ty =
       simplify_or_variable dacc (fun f -> T.this_boxed_float f) or_var
+        K.value
     in
     let dacc = bind_result_sym ty in
     Rebuilt_static_const.create_boxed_float (DA.are_rebuilding_terms dacc)
@@ -98,6 +99,7 @@ let simplify_static_const_of_kind_value dacc
   | Boxed_int32 or_var ->
     let or_var, ty =
       simplify_or_variable dacc (fun f -> T.this_boxed_int32 f) or_var
+        K.value
     in
     let dacc = bind_result_sym ty in
     Rebuilt_static_const.create_boxed_int32 (DA.are_rebuilding_terms dacc)
@@ -106,6 +108,7 @@ let simplify_static_const_of_kind_value dacc
   | Boxed_int64 or_var ->
     let or_var, ty =
       simplify_or_variable dacc (fun f -> T.this_boxed_int64 f) or_var
+        K.value
     in
     let dacc = bind_result_sym ty in
     Rebuilt_static_const.create_boxed_int64 (DA.are_rebuilding_terms dacc)
@@ -114,6 +117,7 @@ let simplify_static_const_of_kind_value dacc
   | Boxed_nativeint or_var ->
     let or_var, ty =
       simplify_or_variable dacc (fun f -> T.this_boxed_nativeint f) or_var
+        K.value
     in
     let dacc = bind_result_sym ty in
     Rebuilt_static_const.create_boxed_nativeint (DA.are_rebuilding_terms dacc)
@@ -122,7 +126,8 @@ let simplify_static_const_of_kind_value dacc
   | Immutable_float_block fields ->
     let fields_with_tys =
       List.map (fun field ->
-          simplify_or_variable dacc (fun f -> T.this_naked_float f) field)
+          simplify_or_variable dacc (fun f -> T.this_naked_float f) field
+            K.naked_float)
         fields
     in
     let fields, _field_tys = List.split fields_with_tys in
@@ -133,7 +138,8 @@ let simplify_static_const_of_kind_value dacc
   | Immutable_float_array fields ->
     let fields_with_tys =
       List.map (fun field ->
-          simplify_or_variable dacc (fun f -> T.this_naked_float f) field)
+          simplify_or_variable dacc (fun f -> T.this_naked_float f) field
+            K.naked_float)
         fields
     in
     let fields, _field_tys = List.split fields_with_tys in