Runtime and compiler support for more local allocations (#23)

* Local allocation support for arrays and records

* Relax the Max_young_wosize constraint on local allocs

* Runtime support for local array allocations.

Includes a bugfix in realloc_local (wsize/bsize confusion).

Author: stedolan

asmcomp/amd64/emit.mlp

@@ -663,11 +663,9 @@ let emit_instr fallthrough i =
         I.lea (mem64 NONE 8 R15) (res i 0)
       end
   | Lop(Ialloc { bytes = n; dbginfo=_; mode = Alloc_local }) ->
-      assert (n <= (Config.max_young_wosize + 1) * Arch.size_addr);
       let r = res i 0 in
       I.mov (domain_field Domainstate.Domain_local_sp) r;
       I.sub (int n) r;
-      (* FIXME: before or after check? Calling conv w/ realloc *)
       I.mov r (domain_field Domainstate.Domain_local_sp);
       I.cmp (domain_field Domainstate.Domain_local_limit) r;
       let lbl_call = new_label () in

asmcomp/cmm_helpers.ml

@@ -794,7 +794,7 @@ let call_cached_method obj tag cache pos args dbg =
 (* Allocation *)
 
 let make_alloc_generic ~mode set_fn dbg tag wordsize args =
-  if wordsize <= Config.max_young_wosize then
+  if mode = Lambda.Alloc_local || wordsize <= Config.max_young_wosize then
     Cop(Calloc mode,
         Cconst_natint(block_header tag wordsize, dbg) :: args, dbg)
   else begin
@@ -816,8 +816,8 @@ let make_alloc ?(mode=Lambda.Alloc_heap) dbg tag args =
   in
   make_alloc_generic ~mode addr_array_init dbg tag (List.length args) args
 
-let make_float_alloc dbg tag args =
-  make_alloc_generic ~mode:Alloc_heap float_array_set dbg tag
+let make_float_alloc ?(mode=Lambda.Alloc_heap) dbg tag args =
+  make_alloc_generic ~mode float_array_set dbg tag
                      (List.length args * size_float / size_addr) args
 
 (* Bounds checking *)

asmcomp/cmm_helpers.mli

@@ -303,7 +303,8 @@ val make_alloc :
   ?mode:Lambda.alloc_mode -> Debuginfo.t -> int -> expression list -> expression
 
 (** Allocate a block of unboxed floats with the given tag *)
-val make_float_alloc : Debuginfo.t -> int -> expression list -> expression
+val make_float_alloc :
+  ?mode:Lambda.alloc_mode -> Debuginfo.t -> int -> expression list -> expression
 
 (** Bounds checking *)
 

asmcomp/cmmgen.ml

@@ -144,11 +144,11 @@ let rec expr_size env = function
       expr_size env body
   | Uprim(Pmakeblock _, args, _) ->
       RHS_block (List.length args)
-  | Uprim(Pmakearray((Paddrarray | Pintarray), _), args, _) ->
+  | Uprim(Pmakearray((Paddrarray | Pintarray), _, _), args, _) ->
       RHS_block (List.length args)
-  | Uprim(Pmakearray(Pfloatarray, _), args, _) ->
+  | Uprim(Pmakearray(Pfloatarray, _, _), args, _) ->
       RHS_floatblock (List.length args)
-  | Uprim(Pmakearray(Pgenarray, _), _, _) ->
+  | Uprim(Pmakearray(Pgenarray, _, _), _, _) ->
      (* Pgenarray is excluded from recursive bindings by the
         check in Translcore.check_recursive_lambda *)
      RHS_nonrec
@@ -463,7 +463,7 @@ let rec transl env e =
           make_alloc ~mode dbg tag (List.map (transl env) args)
       | (Pccall prim, args) ->
           transl_ccall env prim args dbg
-      | (Pduparray (kind, _), [Uprim (Pmakearray (kind', _), args, _dbg)]) ->
+      | (Pduparray (kind, _), [Uprim (Pmakearray (kind', _, _), args, _dbg)]) ->
           (* We arrive here in two cases:
              1. When using Closure, all the time.
              2. When using Flambda, if a float array longer than
@@ -475,15 +475,16 @@ let rec transl env e =
              state of [Translcore], we will in fact only get here with
              [Pfloatarray]s. *)
           assert (kind = kind');
-          transl_make_array dbg env kind args
+          transl_make_array dbg env kind Alloc_heap args
       | (Pduparray _, [arg]) ->
           let prim_obj_dup =
             Primitive.simple ~name:"caml_obj_dup" ~arity:1 ~alloc:true
           in
           transl_ccall env prim_obj_dup [arg] dbg
       | (Pmakearray _, []) ->
           Misc.fatal_error "Pmakearray is not allowed for an empty array"
-      | (Pmakearray (kind, _), args) -> transl_make_array dbg env kind args
+      | (Pmakearray (kind, _, mode), args) ->
+         transl_make_array dbg env kind mode args
       | (Pbigarrayref(unsafe, _num_dims, elt_kind, layout), arg1 :: argl) ->
           let elt =
             bigarray_get unsafe elt_kind layout
@@ -728,15 +729,20 @@ and transl_catch env nfail ids body handler dbg =
     in
     ccatch (new_nfail, ids, body, transl new_env handler, dbg)
 
-and transl_make_array dbg env kind args =
+and transl_make_array dbg env kind mode args =
   match kind with
   | Pgenarray ->
-      Cop(Cextcall("caml_make_array", typ_val, [], true),
-          [make_alloc dbg 0 (List.map (transl env) args)], dbg)
+      let prim =
+        match (mode : Lambda.alloc_mode) with
+        | Alloc_heap -> "caml_make_array"
+        | Alloc_local -> "caml_make_array_local"
+      in
+      Cop(Cextcall(prim, typ_val, [], true),
+          [make_alloc ~mode dbg 0 (List.map (transl env) args)], dbg)
   | Paddrarray | Pintarray ->
-      make_alloc dbg 0 (List.map (transl env) args)
+      make_alloc ~mode dbg 0 (List.map (transl env) args)
   | Pfloatarray ->
-      make_float_alloc dbg Obj.double_array_tag
+      make_float_alloc ~mode dbg Obj.double_array_tag
                       (List.map (transl_unbox_float dbg env) args)
 
 and transl_ccall env prim args dbg =
@@ -854,7 +860,7 @@ and transl_prim_1 env p arg dbg =
     | Pbytesrefs | Pbytessets | Pisout | Pread_symbol _
     | Pmakeblock (_, _, _, _) | Psetfield (_, _, _) | Psetfield_computed (_, _)
     | Psetfloatfield (_, _) | Pduprecord (_, _) | Pccall _ | Pdivint _
-    | Pmodint _ | Pintcomp _ | Pfloatcomp _ | Pmakearray (_, _)
+    | Pmodint _ | Pintcomp _ | Pfloatcomp _ | Pmakearray (_, _, _)
     | Pcompare_ints | Pcompare_floats | Pcompare_bints _
     | Pduparray (_, _) | Parrayrefu _ | Parraysetu _
     | Parrayrefs _ | Parraysets _ | Paddbint _ | Psubbint _ | Pmulbint _
@@ -1036,7 +1042,7 @@ and transl_prim_2 env p arg1 arg2 dbg =
   | Pmakeblock (_, _, _, _) | Pfield _ | Psetfield_computed (_, _)
   | Pfloatfield _
   | Pduprecord (_, _) | Pccall _ | Praise _ | Poffsetint _ | Poffsetref _
-  | Pmakearray (_, _) | Pduparray (_, _) | Parraylength _ | Parraysetu _
+  | Pmakearray (_, _, _) | Pduparray (_, _) | Parraylength _ | Parraysetu _
   | Parraysets _ | Pbintofint _ | Pintofbint _ | Pcvtbint (_, _)
   | Pnegbint _ | Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _)
   | Pbigarraydim _ | Pbytes_set _ | Pbigstring_set _ | Pbbswap _
@@ -1092,7 +1098,7 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg =
   | Pfield _ | Psetfield (_, _, _) | Pfloatfield _ | Psetfloatfield (_, _)
   | Pduprecord (_, _) | Pccall _ | Praise _ | Pdivint _ | Pmodint _ | Pintcomp _
   | Pcompare_ints | Pcompare_floats | Pcompare_bints _
-  | Poffsetint _ | Poffsetref _ | Pfloatcomp _ | Pmakearray (_, _)
+  | Poffsetint _ | Poffsetref _ | Pfloatcomp _ | Pmakearray (_, _, _)
   | Pduparray (_, _) | Parraylength _ | Parrayrefu _ | Parrayrefs _
   | Pbintofint _ | Pintofbint _ | Pcvtbint (_, _) | Pnegbint _ | Paddbint _
   | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _ | Pandbint _ | Porbint _

asmcomp/comballoc.ml

@@ -47,7 +47,8 @@ let rec combine i allocstate =
       assert (List.length dbginfo = 1);
       begin match get_mode mode allocstate with
       | Pending_alloc {reg; dbginfos; totalsz}
-          when totalsz + sz <= (Config.max_young_wosize + 1) * Arch.size_addr ->
+          when (totalsz + sz <= (Config.max_young_wosize + 1) * Arch.size_addr)
+               || mode = Lambda.Alloc_local ->
           let (next, state) =
            combine i.next
              (set_mode mode allocstate

bytecomp/bytegen.ml

@@ -207,11 +207,11 @@ let rec size_of_lambda env = function
       in
       size_of_lambda env body
   | Lprim(Pmakeblock _, args, _) -> RHS_block (List.length args)
-  | Lprim (Pmakearray ((Paddrarray|Pintarray), _), args, _) ->
+  | Lprim (Pmakearray ((Paddrarray|Pintarray), _, _), args, _) ->
       RHS_block (List.length args)
-  | Lprim (Pmakearray (Pfloatarray, _), args, _) ->
+  | Lprim (Pmakearray (Pfloatarray, _, _), args, _) ->
       RHS_floatblock (List.length args)
-  | Lprim (Pmakearray (Pgenarray, _), _, _) ->
+  | Lprim (Pmakearray (Pgenarray, _, _), _, _) ->
      (* Pgenarray is excluded from recursive bindings by the
         check in Translcore.check_recursive_lambda *)
       RHS_nonrec
@@ -734,7 +734,7 @@ let rec comp_expr env exp sz cont =
         (Kpush::
          Kconst (Const_base (Const_int n))::
          Kaddint::cont)
-  | Lprim(Pmakearray (kind, _), args, loc) ->
+  | Lprim(Pmakearray (kind, _, _), args, loc) ->
       let cont = add_pseudo_event loc !compunit_name cont in
       begin match kind with
         Pintarray | Paddrarray ->
@@ -749,9 +749,9 @@ let rec comp_expr env exp sz cont =
                   Kccall("caml_make_array", 1) :: cont)
       end
   | Lprim (Pduparray (kind, mutability),
-           [Lprim (Pmakearray (kind',_),args,_)], loc) ->
+           [Lprim (Pmakearray (kind',_,m),args,_)], loc) ->
       assert (kind = kind');
-      comp_expr env (Lprim (Pmakearray (kind, mutability), args, loc)) sz cont
+      comp_expr env (Lprim (Pmakearray (kind, mutability, m), args, loc)) sz cont
   | Lprim (Pduparray _, [arg], loc) ->
       let prim_obj_dup =
         Primitive.simple ~name:"caml_obj_dup" ~arity:1 ~alloc:true

lambda/lambda.ml

@@ -87,7 +87,7 @@ type primitive =
   | Pstringlength | Pstringrefu  | Pstringrefs
   | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
   (* Array operations *)
-  | Pmakearray of array_kind * mutable_flag
+  | Pmakearray of array_kind * mutable_flag * alloc_mode
   | Pduparray of array_kind * mutable_flag
   | Parraylength of array_kind
   | Parrayrefu of array_kind

lambda/lambda.mli

@@ -93,7 +93,7 @@ type primitive =
   | Pstringlength | Pstringrefu  | Pstringrefs
   | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
   (* Array operations *)
-  | Pmakearray of array_kind * mutable_flag
+  | Pmakearray of array_kind * mutable_flag * alloc_mode
   | Pduparray of array_kind * mutable_flag
   (** For [Pduparray], the argument must be an immutable array.
       The arguments of [Pduparray] give the kind and mutability of the

lambda/printlambda.ml

@@ -245,8 +245,10 @@ let primitive ppf = function
   | Pbytessets -> fprintf ppf "bytes.set"
 
   | Parraylength k -> fprintf ppf "array.length[%s]" (array_kind k)
-  | Pmakearray (k, Mutable) -> fprintf ppf "makearray[%s]" (array_kind k)
-  | Pmakearray (k, Immutable) -> fprintf ppf "makearray_imm[%s]" (array_kind k)
+  | Pmakearray (k, mut, mode) ->
+     let mode = match mode with Alloc_local -> "local" | Alloc_heap -> "" in
+     let mut = match mut with Immutable -> "_imm" | Mutable -> "" in
+     fprintf ppf "make%sarray%s[%s]" mode mut (array_kind k)
   | Pduparray (k, Mutable) -> fprintf ppf "duparray[%s]" (array_kind k)
   | Pduparray (k, Immutable) -> fprintf ppf "duparray_imm[%s]" (array_kind k)
   | Parrayrefu k -> fprintf ppf "array.unsafe_get[%s]" (array_kind k)

lambda/translcore.ml

@@ -62,6 +62,9 @@ let transl_extension_constructor ~scopes env path ext =
   let loc = of_location ~scopes ext.ext_loc in
   match ext.ext_kind with
     Text_decl _ ->
+      (* Extension constructors are currently always Alloc_heap.
+         They could be Alloc_local, but that would require changes
+         to pattern typing, as patterns can close over them. *)
       Lprim (Pmakeblock (Obj.object_tag, Immutable, None, Alloc_heap),
         [Lconst (Const_base (Const_string (name, ext.ext_loc, None)));
          Lprim (prim_fresh_oo_id, [Lconst (const_int 0)], loc)],
@@ -409,6 +412,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
   | Texp_array expr_list ->
       let kind = array_kind e in
       let ll = transl_list ~scopes expr_list in
+      let mode = transl_alloc_mode e.exp_mode in
       begin try
         (* For native code the decision as to which compilation strategy to
            use is made later.  This enables the Flambda passes to lift certain
@@ -418,6 +422,8 @@ and transl_exp0 ~in_new_scope ~scopes e =
         then begin
           raise Not_constant
         end;
+        (* Pduparray only works in Alloc_heap mode *)
+        if mode <> Alloc_heap then raise Not_constant;
         begin match List.map extract_constant ll with
         | exception Not_constant when kind = Pfloatarray ->
             (* We cannot currently lift [Pintarray] arrays safely in Flambda
@@ -433,7 +439,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
                When not [Pfloatarray], the exception propagates to the handler
                below. *)
             let imm_array =
-              Lprim (Pmakearray (kind, Immutable), ll,
+              Lprim (Pmakearray (kind, Immutable, mode), ll,
                      of_location ~scopes e.exp_loc)
             in
             Lprim (Pduparray (kind, Mutable), [imm_array],
@@ -452,7 +458,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
                    of_location ~scopes e.exp_loc)
         end
       with Not_constant ->
-        Lprim(Pmakearray (kind, Mutable), ll,
+        Lprim(Pmakearray (kind, Mutable, mode), ll,
               of_location ~scopes e.exp_loc)
       end
   | Texp_ifthenelse(cond, ifso, Some ifnot) ->
@@ -958,7 +964,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
   (* Determine if there are "enough" fields (only relevant if this is a
      functional-style record update *)
   let no_init = match opt_init_expr with None -> true | _ -> false in
-  if no_init || size < Config.max_young_wosize
+  if no_init || size < Config.max_young_wosize || mode = Lambda.Alloc_local
   then begin
     (* Allocate new record with given fields (and remaining fields
        taken from init_expr if any *)
@@ -1009,7 +1015,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
             Lprim(Pmakeblock(tag, mut, Some shape, mode), ll, loc)
         | Record_unboxed _ -> (match ll with [v] -> v | _ -> assert false)
         | Record_float ->
-            Lprim(Pmakearray (Pfloatarray, mut), ll, loc)
+            Lprim(Pmakearray (Pfloatarray, mut, mode), ll, loc)
         | Record_extension path ->
             let slot = transl_extension_path loc env path in
             Lprim(Pmakeblock(0, mut, Some (Pgenval :: shape), mode),
@@ -1045,6 +1051,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
     begin match opt_init_expr with
       None -> assert false
     | Some init_expr ->
+        assert (mode = Lambda.Alloc_heap); (* Pduprecord must be Alloc_heap *)
         Llet(Strict, Pgenval, copy_id,
              Lprim(Pduprecord (repres, size), [transl_exp ~scopes init_expr],
                    of_location ~scopes loc),

lambda/translprim.ml

@@ -128,6 +128,8 @@ let primitives_table =
     "%setfield0", Primitive ((Psetfield(0, Pointer, Assignment)), 2);
     "%makeblock", Primitive ((Pmakeblock(0, Immutable, None, Alloc_heap)), 1);
     "%makemutable", Primitive ((Pmakeblock(0, Mutable, None, Alloc_heap)), 1);
+    "%makelocalmutable",
+       Primitive ((Pmakeblock(0, Mutable, None, Alloc_local)), 1);
     "%raise", Raise Raise_regular;
     "%reraise", Raise Raise_reraise;
     "%raise_notrace", Raise Raise_notrace;
@@ -747,7 +749,7 @@ let lambda_primitive_needs_event_after = function
      collect the call stack. *)
   | Pduprecord _ | Pccall _ | Pfloatofint | Pnegfloat | Pabsfloat
   | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat | Pstringrefs | Pbytesrefs
-  | Pbytessets | Pmakearray (Pgenarray, _) | Pduparray _
+  | Pbytessets | Pmakearray (Pgenarray, _, _) | Pduparray _
   | Parrayrefu (Pgenarray | Pfloatarray) | Parraysetu (Pgenarray | Pfloatarray)
   | Parrayrefs _ | Parraysets _ | Pbintofint _ | Pcvtbint _ | Pnegbint _
   | Paddbint _ | Psubbint _ | Pmulbint _ | Pdivbint _ | Pmodbint _ | Pandbint _
@@ -768,7 +770,7 @@ let lambda_primitive_needs_event_after = function
   | Pasrint | Pintcomp _ | Poffsetint _ | Poffsetref _ | Pintoffloat
   | Pcompare_ints | Pcompare_floats
   | Pfloatcomp _ | Pstringlength | Pstringrefu | Pbyteslength | Pbytesrefu
-  | Pbytessetu | Pmakearray ((Pintarray | Paddrarray | Pfloatarray), _)
+  | Pbytessetu | Pmakearray ((Pintarray | Paddrarray | Pfloatarray), _, _)
   | Parraylength _ | Parrayrefu _ | Parraysetu _ | Pisint | Pisout
   | Pintofbint _ | Pctconst _ | Pbswap16 | Pint_as_pointer | Popaque ->
      false

middle_end/clambda_primitives.ml

@@ -65,7 +65,7 @@ type primitive =
   | Pstringlength | Pstringrefu  | Pstringrefs
   | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
   (* Array operations *)
-  | Pmakearray of array_kind * mutable_flag
+  | Pmakearray of array_kind * mutable_flag * Lambda.alloc_mode
   | Pduparray of array_kind * mutable_flag
   (** For [Pduparray], the argument must be an immutable array.
       The arguments of [Pduparray] give the kind and mutability of the

middle_end/clambda_primitives.mli

@@ -65,7 +65,7 @@ type primitive =
   | Pstringlength | Pstringrefu  | Pstringrefs
   | Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
   (* Array operations *)
-  | Pmakearray of array_kind * mutable_flag
+  | Pmakearray of array_kind * mutable_flag * Lambda.alloc_mode
   (** For [Pmakearray], the list of arguments must not be empty.  The empty
       array should be represented by a distinguished constant in the middle
       end. *)

middle_end/convert_primitives.ml

@@ -76,7 +76,7 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
   | Pbytessetu -> Pbytessetu
   | Pbytesrefs -> Pbytesrefs
   | Pbytessets -> Pbytessets
-  | Pmakearray (kind, mutability) -> Pmakearray (kind, mutability)
+  | Pmakearray (kind, mutability, mode) -> Pmakearray (kind, mutability, mode)
   | Pduparray (kind, mutability) -> Pduparray (kind, mutability)
   | Parraylength kind -> Parraylength kind
   | Parrayrefu kind -> Parrayrefu kind

middle_end/flambda/inconstant_idents.ml

@@ -343,9 +343,9 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct
       when toplevel ->
       List.iter (mark_loop ~toplevel curr) args
 *)
-    | Prim (Pmakearray (Pfloatarray, Immutable), args, _) ->
+    | Prim (Pmakearray (Pfloatarray, Immutable, _mode), args, _) ->
       mark_vars args curr
-    | Prim (Pmakearray (Pfloatarray, Mutable), args, _) ->
+    | Prim (Pmakearray (Pfloatarray, Mutable, _mode), args, _) ->
       (* CR-someday pchambart: Toplevel float arrays could always be
          statically allocated using an equivalent of the
          Initialize_symbol construction.

middle_end/flambda/lift_constants.ml

@@ -94,7 +94,7 @@ let assign_symbols_and_collect_constant_definitions
       | Prim (Pfield _, _, _) ->
         Misc.fatal_errorf "[Pfield] with the wrong number of arguments"
           Flambda.print_named named
-      | Prim (Pmakearray (Pfloatarray as kind, mutability), args, _) ->
+      | Prim (Pmakearray (Pfloatarray as kind, mutability, _mode), args, _) ->
         assign_symbol ();
         record_definition (AA.Allocated_const (Array (kind, mutability, args)))
       | Prim (Pduparray (kind, mutability), [arg], _) ->

middle_end/flambda/simplify_primitives.ml

@@ -120,15 +120,15 @@ let primitive (p : Clambda_primitives.primitive) (args, approxs)
     A.value_block tag (Array.of_list approxs), C.Benefit.zero
   | Praise _ ->
     expr, A.value_bottom, C.Benefit.zero
-  | Pmakearray(_, _) when is_empty approxs ->
-    Prim (Pmakeblock(0, Asttypes.Immutable, Some [], Alloc_heap), [], dbg),
+  | Pmakearray(_, _, mode) when is_empty approxs ->
+    Prim (Pmakeblock(0, Asttypes.Immutable, Some [], mode), [], dbg),
     A.value_block (Tag.create_exn 0) [||], C.Benefit.zero
-  | Pmakearray (Pfloatarray, Mutable) ->
+  | Pmakearray (Pfloatarray, Mutable, _) ->
       let approx =
         A.value_mutable_float_array ~size:(List.length args)
       in
       expr, approx, C.Benefit.zero
-  | Pmakearray (Pfloatarray, Immutable) ->
+  | Pmakearray (Pfloatarray, Immutable, _) ->
       let approx =
         A.value_immutable_float_array (Array.of_list approxs)
       in

middle_end/printclambda_primitives.ml

@@ -148,8 +148,10 @@ let primitive ppf (prim:Clambda_primitives.primitive) =
   | Pbytessets -> fprintf ppf "bytes.set"
 
   | Parraylength k -> fprintf ppf "array.length[%s]" (array_kind k)
-  | Pmakearray (k, Mutable) -> fprintf ppf "makearray[%s]" (array_kind k)
-  | Pmakearray (k, Immutable) -> fprintf ppf "makearray_imm[%s]" (array_kind k)
+  | Pmakearray (k, mut, mode) ->
+     let mode = match mode with Alloc_local -> "local" | Alloc_heap -> "" in
+     let mut = match mut with Mutable -> "" | Immutable -> "_imm" in
+     fprintf ppf "make%sarray%s[%s]" mut mode (array_kind k)
   | Pduparray (k, Mutable) -> fprintf ppf "duparray[%s]" (array_kind k)
   | Pduparray (k, Immutable) -> fprintf ppf "duparray_imm[%s]" (array_kind k)
   | Parrayrefu k -> fprintf ppf "array.unsafe_get[%s]" (array_kind k)