Remove subkinds from value slots

middle_end/flambda2/compare/compare.ml

@@ -775,7 +775,7 @@ let sets_of_closures env set1 set2 : Set_of_closures.t Comparison.t =
   let ok = ref true in
   let () =
     let compare (kind1, value1, _var1) (kind2, value2, _var2) =
-      let c = Flambda_kind.With_subkind.compare kind1 kind2 in
+      let c = Flambda_kind.compare kind1 kind2 in
       if c = 0 then Simple.compare value1 value2 else c
     in
     iter2_merged (value_slots_by_value set1) (value_slots_by_value set2)

middle_end/flambda2/from_lambda/closure_conversion.ml

@@ -2627,7 +2627,10 @@ let close_functions acc external_env ~current_region function_declarations =
             | None -> Ident.name id
             | Some var -> Variable.name var
           in
-          Ident.Map.add id (Value_slot.create compilation_unit ~name kind) map)
+          Ident.Map.add id
+            (Value_slot.create compilation_unit ~name
+               (Flambda_kind.With_subkind.kind kind))
+            map)
       (Function_decls.all_free_idents function_declarations)
       Ident.Map.empty
   in
@@ -2774,10 +2777,11 @@ let close_functions acc external_env ~current_region function_declarations =
         let external_simple, kind' =
           find_simple_from_id_with_kind external_env id
         in
-        if not (K.With_subkind.equal kind kind')
+        if not (K.equal kind (K.With_subkind.kind kind'))
         then
           Misc.fatal_errorf "Value slot kinds %a and %a don't match for slot %a"
-            K.With_subkind.print kind K.With_subkind.print kind'
+            K.print kind K.print
+            (K.With_subkind.kind kind')
             Value_slot.print value_slot;
         (* We're sure [external_simple] is a variable since
            [value_slot_from_idents] has already filtered constants and symbols
@@ -2946,7 +2950,7 @@ let wrap_partial_application acc env apply_continuation (apply : IR.apply)
   let function_slot =
     Function_slot.create
       (Compilation_unit.get_current_exn ())
-      ~name:(Ident.name wrapper_id) K.With_subkind.any_value
+      ~name:(Ident.name wrapper_id) K.value
   in
   let num_provided = Flambda_arity.num_params provided_arity in
   let missing_arity_and_param_modes =

middle_end/flambda2/from_lambda/lambda_to_flambda.ml

@@ -1353,7 +1353,7 @@ and cps_function env ~fid ~(recursive : Recursive.t) ?precomputed_free_idents
         Function_slot.create
           (Compilation_unit.get_current_exn ())
           ~name:(Ident.name fid ^ "_unboxed")
-          Flambda_kind.With_subkind.any_value
+          Flambda_kind.value
       in
       let unboxed_return =
         if attr.unbox_return then unboxing_kind return else None
@@ -1424,7 +1424,7 @@ and cps_function env ~fid ~(recursive : Recursive.t) ?precomputed_free_idents
   let function_slot =
     Function_slot.create
       (Compilation_unit.get_current_exn ())
-      ~name:(Ident.name fid) Flambda_kind.With_subkind.any_value
+      ~name:(Ident.name fid) Flambda_kind.value
   in
   let unboxed_products = ref Ident.Map.empty in
   let params =

middle_end/flambda2/identifiers/slot.ml

@@ -19,8 +19,7 @@ module type S = sig
 
   module Lmap : Lmap.S with type key = t
 
-  val create :
-    Compilation_unit.t -> name:string -> Flambda_kind.With_subkind.t -> t
+  val create : Compilation_unit.t -> name:string -> Flambda_kind.t -> t
 
   val get_compilation_unit : t -> Compilation_unit.t
 
@@ -32,7 +31,7 @@ module type S = sig
 
   val name : t -> string
 
-  val kind : t -> Flambda_kind.With_subkind.t
+  val kind : t -> Flambda_kind.t
 
   val rename : t -> t
 end
@@ -45,7 +44,7 @@ end) : S = struct
       name : string;
       name_stamp : int;
           (** [name_stamp]s are unique within any given compilation unit. *)
-      kind : Flambda_kind.With_subkind.t
+      kind : Flambda_kind.t
     }
 
   module Self = Container_types.Make (struct
@@ -83,8 +82,7 @@ end) : S = struct
       else
         Format.fprintf ppf "%a.%s/%d" Compilation_unit.print t.compilation_unit
           t.name t.name_stamp;
-      Format.fprintf ppf " @<1>\u{2237} %a" Flambda_kind.With_subkind.print
-        t.kind;
+      Format.fprintf ppf " @<1>\u{2237} %a" Flambda_kind.print t.kind;
       Format.fprintf ppf ")%t@]" Flambda_colours.pop
   end)
 

middle_end/flambda2/identifiers/slot.mli

@@ -19,8 +19,7 @@ module type S = sig
 
   module Lmap : Lmap.S with type key = t
 
-  val create :
-    Compilation_unit.t -> name:string -> Flambda_kind.With_subkind.t -> t
+  val create : Compilation_unit.t -> name:string -> Flambda_kind.t -> t
 
   val get_compilation_unit : t -> Compilation_unit.t
 
@@ -32,7 +31,7 @@ module type S = sig
 
   val name : t -> string
 
-  val kind : t -> Flambda_kind.With_subkind.t
+  val kind : t -> Flambda_kind.t
 
   val rename : t -> t
 end

middle_end/flambda2/parser/fexpr_to_flambda.ml

@@ -144,7 +144,7 @@ let fresh_function_slot env { Fexpr.txt = name; loc = _ } =
   let c =
     Function_slot.create
       (Compilation_unit.get_current_exn ())
-      ~name Flambda_kind.With_subkind.any_value
+      ~name Flambda_kind.value
   in
   UT.add env.function_slots name c;
   c
@@ -436,7 +436,7 @@ let unop env (unop : Fexpr.unop) : Flambda_primitive.unary_primitive =
     Opaque_identity { middle_end_only = false; kind = Flambda_kind.value }
   | Project_value_slot { project_from; value_slot } ->
     (* CR mshinwell: support non-value kinds *)
-    let kind = Flambda_kind.With_subkind.any_value in
+    let kind = Flambda_kind.value in
     let value_slot = fresh_or_existing_value_slot env value_slot kind in
     let project_from = fresh_or_existing_function_slot env project_from in
     Project_value_slot { project_from; value_slot }
@@ -562,8 +562,7 @@ let set_of_closures env fun_decls value_slots alloc =
   let value_slots : Simple.t Value_slot.Map.t =
     let convert ({ var; value } : Fexpr.one_value_slot) =
       (* CR mshinwell: support non-value kinds *)
-      ( fresh_or_existing_value_slot env var Flambda_kind.With_subkind.any_value,
-        simple env value )
+      fresh_or_existing_value_slot env var Flambda_kind.value, simple env value
     in
     List.map convert value_slots |> Value_slot.Map.of_list
   in

middle_end/flambda2/parser/flambda_to_fexpr.ml

@@ -676,10 +676,7 @@ let value_slots env map =
   List.map
     (fun (var, value) ->
       let kind = Value_slot.kind var in
-      if not
-           (Flambda_kind.equal
-              (Flambda_kind.With_subkind.kind kind)
-              Flambda_kind.value)
+      if not (Flambda_kind.equal kind Flambda_kind.value)
       then
         Misc.fatal_errorf "Value slot %a not of kind Value" Simple.print value;
       let var = Env.translate_value_slot env var in

middle_end/flambda2/simplify/simplify_apply_expr.ml

@@ -417,15 +417,14 @@ let simplify_direct_partial_application ~simplify_expr dacc apply
   in
   let applied_unarized_args, _ =
     Misc.Stdlib.List.map2_prefix
-      (fun arg kind -> arg, kind)
+      (fun arg kind -> arg, K.With_subkind.kind kind)
       args
       (Flambda_arity.unarize param_arity)
   in
   let wrapper_var = Variable.create "partial_app" in
   let compilation_unit = Compilation_unit.get_current_exn () in
   let wrapper_function_slot =
-    Function_slot.create compilation_unit ~name:"partial_app_closure"
-      K.With_subkind.any_value
+    Function_slot.create compilation_unit ~name:"partial_app_closure" K.value
   in
   (* The allocation mode of the closure is directly determined by the alloc_mode
      of the application. We check here that it is consistent with
@@ -517,7 +516,7 @@ let simplify_direct_partial_application ~simplify_expr dacc apply
               then Symbol symbol
               else
                 let var = Variable.create "symbol" in
-                if not (K.equal (K.With_subkind.kind kind) K.value)
+                if not (K.equal kind K.value)
                 then
                   Misc.fatal_errorf
                     "Simple %a which is a symbol should be of kind Value"
@@ -529,8 +528,7 @@ let simplify_direct_partial_application ~simplify_expr dacc apply
         let applied_callee =
           match Apply.callee apply with
           | None -> None
-          | Some callee ->
-            Some (applied_value (callee, K.With_subkind.any_value))
+          | Some callee -> Some (applied_value (callee, K.value))
         in
         let applied_unarized_args =
           List.map applied_value applied_unarized_args

middle_end/flambda2/simplify/simplify_set_of_closures.ml

@@ -682,7 +682,7 @@ let simplify_and_lift_set_of_closures dacc ~closure_bound_vars_inverse
   let value_slot_types =
     Value_slot.Map.mapi
       (fun value_slot in_slot ->
-        let kind = K.With_subkind.kind (Value_slot.kind value_slot) in
+        let kind = Value_slot.kind value_slot in
         Simple.pattern_match in_slot
           ~const:(fun _ -> T.alias_type_of kind in_slot)
           ~name:(fun name ~coercion ->

middle_end/flambda2/simplify/simplify_unary_primitive.ml

@@ -69,8 +69,7 @@ let simplify_project_value_slot function_slot value_slot ~min_name_mode dacc
           simple
       in
       let dacc =
-        DA.add_variable dacc result_var
-          (T.alias_type_of (K.With_subkind.kind kind) simple)
+        DA.add_variable dacc result_var (T.alias_type_of kind simple)
       in
       SPR.create (Named.create_simple simple) ~try_reify:true dacc
     | Need_meet ->
@@ -81,15 +80,16 @@ let simplify_project_value_slot function_slot value_slot ~min_name_mode dacc
             (T.closure_with_at_least_this_value_slot
                ~this_function_slot:function_slot value_slot
                ~value_slot_var:(Bound_var.var result_var) ~value_slot_kind:kind)
-          ~result_var ~result_kind:(K.With_subkind.kind kind)
+          ~result_var ~result_kind:kind
       in
       let dacc = DA.add_use_of_value_slot result.dacc value_slot in
       SPR.with_dacc result dacc
   in
   let dacc =
     Simplify_common.add_symbol_projection result.dacc ~projected_from:closure
       (Symbol_projection.Projection.project_value_slot function_slot value_slot)
-      ~projection_bound_to:result_var ~kind
+      ~projection_bound_to:result_var
+      ~kind:(Flambda_kind.With_subkind.anything kind)
   in
   SPR.with_dacc result dacc
 

middle_end/flambda2/simplify/unboxing/build_unboxing_denv.ml

@@ -67,7 +67,7 @@ let rec denv_of_decision denv ~param_var (decision : U.decision) : DE.t =
     let map =
       Value_slot.Map.map
         (fun ({ epa = { param = var; _ }; kind; _ } : U.field_decision) ->
-          var, kind)
+          var, K.With_subkind.kind kind)
         vars_within_closure
     in
     let shape =

middle_end/flambda2/simplify/unboxing/unboxers.ml

@@ -181,10 +181,7 @@ module Closure_field = struct
 
   let unboxer function_slot value_slot =
     { var_name = "closure_field_at_use";
-      poison_const =
-        Const.of_int_of_kind
-          (Flambda_kind.With_subkind.kind (Value_slot.kind value_slot))
-          0;
+      poison_const = Const.of_int_of_kind (Value_slot.kind value_slot) 0;
       unboxing_prim =
         (fun closure -> unboxing_prim function_slot ~closure value_slot);
       prove_simple =

middle_end/flambda2/simplify_shared/slot_offsets.ml

@@ -880,7 +880,7 @@ end = struct
       (fun value_slot _ ->
         let kind = Value_slot.kind value_slot in
         let size, is_unboxed =
-          match Flambda_kind.With_subkind.kind kind with
+          match kind with
           | Region | Rec_info ->
             Misc.fatal_errorf "Value slot %a has Region or Rec_info kind"
               Value_slot.print value_slot
@@ -891,12 +891,7 @@ end = struct
           (* flambda2 only supports 64-bit targets for now, so naked numbers can
              only be of size 1 *)
           | Naked_number Naked_vec128 -> 2, true
-          | Value -> (
-            match[@ocaml.warning "-4"]
-              Flambda_kind.With_subkind.non_null_value_subkind kind
-            with
-            | Tagged_immediate -> 1, true
-            | _ -> 1, false)
+          | Value -> 1, false
         in
         if is_unboxed
         then

middle_end/flambda2/terms/flambda_primitive.ml

@@ -1379,7 +1379,7 @@ let result_kind_of_unary_primitive p : result_kind =
   | Untag_immediate -> Singleton K.naked_immediate
   | Box_number _ | Tag_immediate | Project_function_slot _ -> Singleton K.value
   | Project_value_slot { value_slot; _ } ->
-    Singleton (K.With_subkind.kind (Value_slot.kind value_slot))
+    Singleton (Value_slot.kind value_slot)
   | Is_boxed_float | Is_flat_float_array -> Singleton K.naked_immediate
   | End_region _ -> Singleton K.value
   | End_try_region _ -> Singleton K.value

middle_end/flambda2/to_cmm/to_cmm_primitive.ml

@@ -933,7 +933,9 @@ let unary_primitive env res dbg f arg =
       value_slot_offset env value_slot, function_slot_offset env project_from
     with
     | Live_value_slot { offset; _ }, Live_function_slot { offset = base; _ } ->
-      let memory_chunk = To_cmm_shared.memory_chunk_of_kind kind in
+      let memory_chunk =
+        To_cmm_shared.memory_chunk_of_kind (KS.anything kind)
+      in
       let expr =
         C.get_field_gen_given_memory_chunk memory_chunk Asttypes.Immutable arg
           (offset - base) dbg

middle_end/flambda2/to_cmm/to_cmm_set_of_closures.ml

@@ -149,11 +149,7 @@ end = struct
     | Value_slot { value_slot; is_scanned; size } ->
       let simple = Value_slot.Map.find value_slot value_slots in
       let kind = Value_slot.kind value_slot in
-      if (not
-            (Flambda_kind.equal
-               (Flambda_kind.With_subkind.kind kind)
-               Flambda_kind.value))
-         && is_scanned
+      if (not (Flambda_kind.equal kind Flambda_kind.value)) && is_scanned
       then
         Misc.fatal_errorf
           "Value slot %a not of kind Value (%a) but is visible by GC"
@@ -162,7 +158,7 @@ end = struct
       let env, res, fields, chunk_acc, updates =
         match contents with
         | `Expr field ->
-          let chunk = C.memory_chunk_of_kind kind in
+          let chunk = C.memory_chunk_of_kind (KS.anything kind) in
           let chunk_acc =
             rev_append_chunks ~for_static_sets [chunk] chunk_acc
           in
@@ -179,13 +175,8 @@ end = struct
               } ->
             let update_kind =
               let module UK = C.Update_kind in
-              match KS.kind kind with
-              | Value ->
-                if KS.Non_null_value_subkind.equal
-                     (KS.non_null_value_subkind kind)
-                     Tagged_immediate
-                then UK.tagged_immediates
-                else UK.pointers
+              match kind with
+              | Value -> UK.pointers
               | Naked_number Naked_immediate
               | Naked_number Naked_int64
               | Naked_number Naked_nativeint ->
@@ -198,7 +189,7 @@ end = struct
               | Naked_number Naked_float32 -> UK.naked_float32_fields
               | Region | Rec_info ->
                 Misc.fatal_errorf "Unexpected value slot kind for %a: %a"
-                  Value_slot.print value_slot KS.print kind
+                  Value_slot.print value_slot Flambda_kind.print kind
             in
             let env, res, updates =
               C.make_update env res dbg update_kind

middle_end/flambda2/types/flambda2_types.mli

@@ -505,12 +505,12 @@ val closure_with_at_least_this_value_slot :
   this_function_slot:Function_slot.t ->
   Value_slot.t ->
   value_slot_var:Variable.t ->
-  value_slot_kind:Flambda_kind.With_subkind.t ->
+  value_slot_kind:Flambda_kind.t ->
   flambda_type
 
 val closure_with_at_least_these_value_slots :
   this_function_slot:Function_slot.t ->
-  (Variable.t * Flambda_kind.With_subkind.t) Value_slot.Map.t ->
+  (Variable.t * Flambda_kind.t) Value_slot.Map.t ->
   flambda_type
 
 val array_of_length :

middle_end/flambda2/types/grammar/more_type_creators.ml

@@ -339,9 +339,7 @@ let closure_with_at_least_these_function_slots ~this_function_slot
 
 let closure_with_at_least_these_value_slots ~this_function_slot value_slots =
   let value_slot_types =
-    let type_of_var (v, kind) =
-      TG.alias_type_of (K.With_subkind.kind kind) (Simple.var v)
-    in
+    let type_of_var (v, kind) = TG.alias_type_of kind (Simple.var v) in
     let value_slot_components_by_index =
       Value_slot.Map.map type_of_var value_slots
     in

middle_end/flambda2/types/grammar/more_type_creators.mli

@@ -150,14 +150,14 @@ val static_closure_with_this_code :
 
 val closure_with_at_least_these_value_slots :
   this_function_slot:Function_slot.t ->
-  (Variable.t * Flambda_kind.With_subkind.t) Value_slot.Map.t ->
+  (Variable.t * Flambda_kind.t) Value_slot.Map.t ->
   Type_grammar.t
 
 val closure_with_at_least_this_value_slot :
   this_function_slot:Function_slot.t ->
   Value_slot.t ->
   value_slot_var:Variable.t ->
-  value_slot_kind:Flambda_kind.With_subkind.t ->
+  value_slot_kind:Flambda_kind.t ->
   Type_grammar.t
 
 val type_for_const : Reg_width_const.t -> Type_grammar.t

middle_end/flambda2/types/provers.ml

@@ -935,9 +935,7 @@ let meet_project_value_slot_simple_value ~min_name_mode value_slot env
     | Known ty -> (
       if (* It's more straightforward to check the kind of [ty] instead of
             examining the row-like structure directly. *)
-         not
-           (Flambda_kind.equal (TG.kind ty)
-              (Value_slot.kind value_slot |> Flambda_kind.With_subkind.kind))
+         not (Flambda_kind.equal (TG.kind ty) (Value_slot.kind value_slot))
       then Invalid
       else
         match TG.get_alias_exn ty with