address more comments

ocaml-flambda · Jun 20, 2024 · ae66af1 · ae66af1
1 parent c022aa2
commit ae66af1
Show file tree

Hide file tree

Showing 21 changed files with 306 additions and 309 deletions.
diff --git a/native_toplevel/opttoploop.ml b/native_toplevel/opttoploop.ml
@@ -345,7 +345,7 @@ let name_expression ~loc ~attrs sort exp =
       val_loc = loc;
       val_attributes = attrs;
       val_zero_alloc = Default_zero_alloc;
-      val_modalities = Mode.Modality.Value.id |> Mode.Modality.Value.internalize;
+      val_modalities = Mode.Modality.Value.id;
       val_uid = Uid.internal_not_actually_unique; }
   in
   let sg = [Sig_value(id, vd, Exported)] in

diff --git a/ocaml/lambda/lambda.ml b/ocaml/lambda/lambda.ml
@@ -1402,7 +1402,7 @@ let build_substs update_env ?(freshen_bound_variables = false) s =
         let env_updates =
           let find_in_old id =
             let vd = Env.find_value (Path.Pident id) old_env in
-            let vd = {vd with val_modalities = Mode.Modality.Value.id'} in
+            let vd = {vd with val_modalities = Mode.Modality.Value.id} in
             let mode = Mode.Value.max |> Mode.Value.disallow_right in
             (vd, mode)
           in

diff --git a/ocaml/ocamldoc/odoc_sig.ml b/ocaml/ocamldoc/odoc_sig.ml
@@ -492,7 +492,7 @@ module Analyser =
       let record comments
           { Typedtree.ld_id; ld_mutable; ld_type; ld_loc; ld_attributes } =
         get_field env comments @@
-        {Types.ld_id; ld_mutable; ld_modalities = Mode.Modality.Value.id;
+        {Types.ld_id; ld_mutable; ld_modalities = Mode.Modality.Value.Const.id;
          ld_jkind=Jkind.any ~why:Dummy_jkind (* ignored *);
          ld_type=ld_type.Typedtree.ctyp_type;
          ld_loc; ld_attributes; ld_uid=Types.Uid.internal_not_actually_unique} in

diff --git a/ocaml/typing/datarepr.ml b/ocaml/typing/datarepr.ml
@@ -97,7 +97,7 @@ let constructor_args ~current_unit priv cd_args cd_res path rep =
       [
         {
           ca_type = newgenconstr path type_params;
-          ca_modalities = Mode.Modality.Value.id;
+          ca_modalities = Mode.Modality.Value.Const.id;
           ca_loc = Location.none
         }
       ],
@@ -206,7 +206,7 @@ let none =
 
 let dummy_label =
   { lbl_name = ""; lbl_res = none; lbl_arg = none;
-    lbl_mut = Immutable; lbl_modalities = Mode.Modality.Value.id;
+    lbl_mut = Immutable; lbl_modalities = Mode.Modality.Value.Const.id;
     lbl_jkind = Jkind.any ~why:Dummy_jkind;
     lbl_num = -1; lbl_pos = -1; lbl_all = [||];
     lbl_repres = Record_unboxed;

diff --git a/ocaml/typing/env.ml b/ocaml/typing/env.ml
@@ -906,9 +906,9 @@ let normalize_vda_mode vda =
   let vda_description = vda.vda_description in
   let modalities = vda_description.val_modalities in
   let vda_description =
-    {vda_description with val_modalities = Mode.Modality.Value.id'}
+    {vda_description with val_modalities = Mode.Modality.Value.id}
   in
-  let vda_mode = Mode.Modality.Value.apply_left modalities vda.vda_mode in
+  let vda_mode = Mode.Modality.Value.apply modalities vda.vda_mode in
   {vda with vda_description; vda_mode}
 
 (* Print addresses *)
@@ -2040,7 +2040,6 @@ and store_value ?check ~mode id addr decl shape env =
   Option.iter
     (fun f -> check_usage decl.val_loc id decl.val_uid f !value_declarations)
     check;
-  let _ = Mode.Modality.Value.apply_left decl.val_modalities mode in
   let vda =
     { vda_description = decl;
       vda_address = addr;

diff --git a/ocaml/typing/includecore.ml b/ocaml/typing/includecore.ml
@@ -653,7 +653,9 @@ module Record_diffing = struct
         begin match mut with
         | Some mut -> Some (Mutability mut)
         | None ->
-          match Modality.Value.equate ld1.ld_modalities ld2.ld_modalities with
+          match
+            Modality.Value.Const.equate ld1.ld_modalities ld2.ld_modalities
+          with
           | Ok () ->
             let tl1 = params1 @ [ld1.ld_type] in
             let tl2 = params2 @ [ld2.ld_type] in
@@ -826,7 +828,7 @@ module Variant_diffing = struct
           | exception Ctype.Equality err -> Some (Type err)
           | () -> List.combine arg1_gfs arg2_gfs
                   |> find_map_idx
-                    (fun (x,y) -> get_error @@ Modality.Value.equate x y)
+                    (fun (x,y) -> get_error @@ Modality.Value.Const.equate x y)
                   |> Option.map (fun (i, err) -> Modality (i, err))
         end
     | Types.Cstr_record l1, Types.Cstr_record l2 ->