Add [@layout_poly] attribute for layout representation polymorphic externals

middle_end/flambda2/from_lambda/closure_conversion.ml

@@ -450,11 +450,16 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds
         prim_coeffects;
         prim_native_name;
         prim_native_repr_args;
-        prim_native_repr_res
+        prim_native_repr_res;
+        prim_is_layout_poly
       } :
-       Primitive.description) as prim_desc) ~(args : Simple.t list list)
-    exn_continuation dbg ~current_region
+       Lambda.external_call_description) as prim_desc)
+    ~(args : Simple.t list list) exn_continuation dbg ~current_region
     (k : Acc.t -> Named.t list -> Expr_with_acc.t) : Expr_with_acc.t =
+  if prim_is_layout_poly
+  then
+    Misc.fatal_errorf
+      "close_c_call: C call primitive %s can't be layout polymorphic." prim_name;
   let args =
     List.map
       (function
@@ -529,8 +534,8 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds
       Apply_cont_expr.continuation apply_cont, false
     | _ -> Continuation.create (), true
   in
-  let kind_of_primitive_native_repr
-      ((_, repr) : Primitive.mode * Primitive.native_repr) =
+  let kind_of_primitive_extern_repr
+      ((_, repr) : Primitive.mode * Lambda.extern_repr) =
     match repr with
     | Same_as_ocaml_repr sort ->
       K.With_subkind.(
@@ -548,11 +553,11 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds
     | Unboxed_vector (Pvec128 _) -> K.naked_vec128
   in
   let param_arity =
-    List.map kind_of_primitive_native_repr prim_native_repr_args
+    List.map kind_of_primitive_extern_repr prim_native_repr_args
     |> List.map K.With_subkind.anything
     |> Flambda_arity.create_singletons
   in
-  let return_kind = kind_of_primitive_native_repr prim_native_repr_res in
+  let return_kind = kind_of_primitive_extern_repr prim_native_repr_res in
   let return_arity =
     Flambda_arity.create_singletons [K.With_subkind.anything return_kind]
   in
@@ -625,7 +630,7 @@ let close_c_call acc env ~loc ~let_bound_ids_with_kinds
   let call : Acc.t -> Expr_with_acc.t =
     List.fold_left2
       (fun (call : Simple.t list -> Acc.t -> Expr_with_acc.t) arg
-           (arg_repr : Primitive.mode * Primitive.native_repr) ->
+           (arg_repr : Primitive.mode * Lambda.extern_repr) ->
         let unbox_arg : P.unary_primitive option =
           match arg_repr with
           | _, Same_as_ocaml_repr _ -> None

middle_end/flambda2/from_lambda/dissect_letrec.ml

@@ -171,7 +171,7 @@ let lsequence (lam1, lam2) =
   [@@ocaml.warning "-fragile-match"]
 
 let caml_update_dummy_prim =
-  Primitive.simple_on_values ~name:"caml_update_dummy" ~arity:2 ~alloc:true
+  Lambda.simple_prim_on_values ~name:"caml_update_dummy" ~arity:2 ~alloc:true
 
 let update_dummy var expr =
   Lprim (Pccall caml_update_dummy_prim, [Lvar var; expr], Loc_unknown)
@@ -570,7 +570,7 @@ let dissect_letrec ~bindings ~body ~free_vars_kind =
           | Normal _tag -> "caml_alloc_dummy"
           | Flat_float_record -> "caml_alloc_dummy_float"
         in
-        let desc = Primitive.simple_on_values ~name:fn ~arity:1 ~alloc:true in
+        let desc = Lambda.simple_prim_on_values ~name:fn ~arity:1 ~alloc:true in
         let size : lambda = Lconst (Const_base (Const_int size)) in
         id, Lprim (Pccall desc, [size], Loc_unknown))
       letrec.blocks

middle_end/flambda2/from_lambda/lambda_to_flambda.ml

@@ -302,7 +302,7 @@ let transform_primitive env (prim : L.primitive) args loc =
       then
         let arity = 1 + num_dimensions in
         let name = "caml_ba_get_" ^ string_of_int num_dimensions in
-        let desc = Primitive.simple_on_values ~name ~arity ~alloc:true in
+        let desc = Lambda.simple_prim_on_values ~name ~arity ~alloc:true in
         Primitive (L.Pccall desc, args, loc)
       else
         Misc.fatal_errorf
@@ -319,7 +319,7 @@ let transform_primitive env (prim : L.primitive) args loc =
       then
         let arity = 2 + num_dimensions in
         let name = "caml_ba_set_" ^ string_of_int num_dimensions in
-        let desc = Primitive.simple_on_values ~name ~arity ~alloc:true in
+        let desc = Lambda.simple_prim_on_values ~name ~arity ~alloc:true in
         Primitive (L.Pccall desc, args, loc)
       else
         Misc.fatal_errorf