Slightly refactor object capture check

Author: ccasin

ocaml/typing/env.ml

@@ -2928,43 +2928,35 @@ let lookup_ident_module (type a) (load : a load) ~errors ~use ~loc s env =
 let lock_mode ~errors ~loc env id vda locks =
   let vmode = vda.vda_mode in
   List.fold_left
-    (fun vmode lock ->
+    (fun (vmode, must_box) lock ->
       match lock with
-      | Region_lock -> Value_mode.local_to_regional vmode
+      | Region_lock -> Value_mode.local_to_regional vmode, must_box
       | Lock {mode; escaping_context} ->
         begin
           match Value_mode.submode vmode (Value_mode.of_alloc mode) with
-          | Ok () -> vmode
+          | Ok () -> vmode, must_box
           | Error _ ->
               may_lookup_error errors loc env
                 (Local_value_used_in_closure (id, escaping_context))
         end
       | Exclave_lock ->
         begin
           match Value_mode.submode vmode Value_mode.regional with
-          | Ok () -> Value_mode.regional_to_local vmode
+          | Ok () -> Value_mode.regional_to_local vmode, must_box
           | Error _ ->
             may_lookup_error errors loc env
               (Local_value_used_in_exclave id);
         end
-      | Unboxed_lock ->
-        let vd = Subst.Lazy.force_value_description vda.vda_description in
-        match !constrain_type_layout env vd.val_type
-                (Layout.(value ~why:Captured_in_object))
-        with
-        | Ok () -> vmode
-        | Result.Error err ->
-          may_lookup_error errors loc env
-            (Non_value_used_in_object (id, vd.val_type, err))
+      | Unboxed_lock -> vmode, true
     )
-    vmode locks
+    (vmode, false) locks
 
 let lookup_ident_value ~errors ~use ~loc name env =
   match IdTbl.find_name_and_modes wrap_value ~mark:use name env.values with
   | (path, locks, Val_bound vda) ->
-      let mode = lock_mode ~errors ~loc env (Lident name) vda locks in
+      let mode, must_box = lock_mode ~errors ~loc env (Lident name) vda locks in
       use_value ~use ~loc path vda;
-      path, vda.vda_description, mode
+      path, vda.vda_description, mode, must_box
   | (_, _, Val_unbound reason) ->
       report_value_unbound ~errors ~loc env reason (Lident name)
   | exception Not_found ->
@@ -3244,7 +3236,7 @@ let lookup_value_lazy ~errors ~use ~loc lid env =
   | Ldot(l, s) ->
     let path, desc = lookup_dot_value ~errors ~use ~loc l s env in
     let mode = Value_mode.global in
-    path, desc, mode
+    path, desc, mode, false
   | Lapply _ -> assert false
 
 let lookup_type_full ~errors ~use ~loc lid env =
@@ -3335,7 +3327,7 @@ let find_module_by_name lid env =
 
 let find_value_by_name lid env =
   let loc = Location.(in_file !input_name) in
-  let path, desc, _ = lookup_value_lazy ~errors:false ~use:false ~loc lid env in
+  let path, desc, _, _ = lookup_value_lazy ~errors:false ~use:false ~loc lid env in
   path, Subst.Lazy.force_value_description desc
 
 let find_type_by_name lid env =
@@ -3372,8 +3364,19 @@ let lookup_module ?(use=true) ~loc lid env =
 
 let lookup_value ?(use=true) ~loc lid env =
   check_value_name (Longident.last lid) loc;
-  let path, desc, mode = lookup_value_lazy ~errors:true ~use ~loc lid env in
-  path, Subst.Lazy.force_value_description desc, mode
+  let path, desc, mode, must_box =
+    lookup_value_lazy ~errors:true ~use ~loc lid env
+  in
+  let vd = Subst.Lazy.force_value_description desc in
+  if must_box then begin
+    match !constrain_type_layout env vd.val_type
+            (Layout.(value ~why:Captured_in_object))
+    with
+    | Ok () -> ()
+    | Result.Error err ->
+      lookup_error loc env (Non_value_used_in_object (lid, vd.val_type, err))
+  end;
+  path, vd, mode
 
 let lookup_type ?(use=true) ~loc lid env =
   lookup_type ~errors:true ~use ~loc lid env