From 050b51304ad794832fd4d4558b8f489af4ff523c Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 13:43:41 +0200
Subject: [PATCH 001/110] enabling native-compiler

---
 config/dune | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/config/dune b/config/dune
index fb11fbee2401..ab124197513c 100644
--- a/config/dune
+++ b/config/dune
@@ -28,4 +28,4 @@
    %{project_root}/dev/header.c
    ; Needed to generate include lists for coq_makefile
    plugin_list)
- (action (chdir %{project_root} (run %{project_root}/tools/configure/configure.exe -quiet -relocatable))))
+ (action (chdir %{project_root} (run %{project_root}/tools/configure/configure.exe -quiet -relocatable -native-compiler yes))))

From bb6c614a5330e7aefebe974a14ceac0cbf4f21b3 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 13:46:41 +0200
Subject: [PATCH 002/110] Created placeholder functions for compiling to mlf

Is now able to compile strings, floats and sequences of mllambda to malfunction
---
 kernel/float64.mli        |   2 +
 kernel/float64_common.ml  |   4 +
 kernel/float64_common.mli |   2 +
 kernel/nativecode.ml      | 240 ++++++++++++++++++++++++++++++++++++++
 kernel/nativecode.mli     |   2 +
 kernel/nativeconv.ml      |   2 +
 kernel/nativelib.ml       |  26 +++++
 kernel/nativelib.mli      |   7 ++
 kernel/pstring.ml         |   3 +
 kernel/pstring.mli        |   3 +
 kernel/uint63.mli         |   2 +
 kernel/uint63_31.ml       |   3 +
 kernel/uint63_63.ml       |   3 +
 13 files changed, 299 insertions(+)

diff --git a/kernel/float64.mli b/kernel/float64.mli
index 0d2fcaaac7e7..b264d68a0a0d 100644
--- a/kernel/float64.mli
+++ b/kernel/float64.mli
@@ -34,6 +34,8 @@ val to_string : t -> string
 
 val compile : t -> string
 
+val compile_mlf : t -> string
+
 val of_float : float -> t
 
 (** All NaNs are normalized to [Stdlib.nan].
diff --git a/kernel/float64_common.ml b/kernel/float64_common.ml
index a6ac22bf9d94..8d64aa4a5639 100644
--- a/kernel/float64_common.ml
+++ b/kernel/float64_common.ml
@@ -41,6 +41,10 @@ let of_string = float_of_string
 let compile f =
   Printf.sprintf "Float64.of_float (%s)" (to_hex_string f)
 
+(* Compiles a float to malfunction code *)
+let compile_mlf f =
+  Printf.sprintf "(apply (global $Float6 $of_float) (%s))" (to_hex_string f)
+
 let of_float f = f
 
 let to_float f = if is_nan f then nan else f
diff --git a/kernel/float64_common.mli b/kernel/float64_common.mli
index 61c061af90b2..9f8d8d208d3a 100644
--- a/kernel/float64_common.mli
+++ b/kernel/float64_common.mli
@@ -34,6 +34,8 @@ val to_string : t -> string
 
 val compile : t -> string
 
+val compile_mlf : t -> string
+
 val of_float : float -> t
 
 (** All NaNs are normalized to [Stdlib.nan].
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 4d3abb6a5900..e36dd9c34176 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2033,6 +2033,205 @@ let pp_mllam fmt l =
   in
   Format.fprintf fmt "@[%a@]" pp_mllam l
 
+
+let pp_mllam_mlf fmt l =
+
+  let rec pp_mllam fmt l =
+    match l with
+    | MLint i -> pp_int fmt i
+    | MLuint i -> Format.fprintf fmt "(%s)" (Uint63.compile_mlf i)
+    | MLfloat f -> Format.fprintf fmt "(%s)" (Float64.compile_mlf f)
+    | MLstring s -> Format.fprintf fmt "(%s)" (Pstring.compile_mlf s)
+    | MLsequence(l1,l2) ->
+        Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam l1 pp_mllam l2
+    | _ -> Format.fprintf fmt "0"
+    (* | MLlocal ln -> Format.fprintf fmt "@[%a@]" pp_lname ln
+    | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
+    | MLprimitive (p, args) ->
+      Format.fprintf fmt "@[<2>%a@ %a@]" pp_primitive p (pp_args true) args
+    | MLlam(ids,body) ->
+        Format.fprintf fmt "@[(fun%a ->@ %a)@]"
+          pp_ldecls ids pp_mllam body
+    | MLletrec(defs, body) ->
+        Format.fprintf fmt "@[(%a@ in@\n%a)@]" pp_letrec defs
+          pp_mllam body
+    | MLlet(id,def,body) ->
+        Format.fprintf fmt "@[(@[let@ %a@ =@ %a@ in@]@\n%a)@]"
+          pp_lname id pp_mllam def pp_mllam body
+    | MLapp(f, args) ->
+        Format.fprintf fmt "@[<2>%a@ %a@]" pp_mllam f (pp_args true) args
+    | MLif(t,l1,l2) ->
+        Format.fprintf fmt "@[(if %a then@\n  %a@\nelse@\n  %a)@]"
+          pp_mllam t pp_mllam l1 pp_mllam l2
+    | MLmatch (annot, c, accu_br, br) ->
+      let ind = annot.asw_ind in
+      let prefix = annot.asw_prefix in
+      let accu = string_of_accu_construct prefix ind in
+      Format.fprintf fmt
+        "@[begin match Obj.magic (%a) with@\n| %s _ ->@\n  %a@\n%aend@]"
+        pp_mllam c accu pp_mllam accu_br (pp_branches prefix ind) br
+
+    | MLconstruct(prefix,ind,tag,args) ->
+        Format.fprintf fmt "@[<2>(Obj.magic@ @[<2>(%s%a)@] : Nativevalues.t)@]"
+          (string_of_construct prefix ~constant:false ind tag) pp_cargs args
+    | MLsetref (s, body) ->
+        Format.fprintf fmt "@[%s@ :=@\n Some (%a)@]" s pp_mllam body
+    | MLarray arr ->
+      (* We need to ensure that the array does not use the flat representation
+          if ever the first argument is a float *)
+      let len = Array.length arr in
+      if Int.equal len 0 then begin
+        Format.fprintf fmt "@[(Obj.magic [||])@]"
+      end else if Int.equal len 1 then begin
+        (* We have to emulate a 1-uplet *)
+        Format.fprintf fmt "@[(Obj.magic (ref (%a)))@]" pp_mllam arr.(0)
+      end else begin
+        Format.fprintf fmt "@[(Obj.magic (";
+        for i = 0 to len - 2 do
+          Format.fprintf fmt "%a,@ " pp_mllam arr.(i)
+        done;
+        pp_mllam fmt arr.(len-1);
+        Format.fprintf fmt "))@]"
+      end;
+    | MLisaccu (prefix, ind, c) ->
+        let accu = string_of_accu_construct prefix ind in
+        Format.fprintf fmt
+          "@[begin match Obj.magic (%a) with@\n| %s _ ->@\n  true@\n| _ ->@\n  false@\nend@]"
+        pp_mllam c accu *)
+
+  (* and pp_letrec fmt defs =
+    let len = Array.length defs in
+    let pp_one_rec (fn, argsn, body) =
+      Format.fprintf fmt "%a%a =@\n  %a"
+        pp_lname fn
+        pp_ldecls argsn pp_mllam body in
+    Format.fprintf fmt "@[let rec ";
+    pp_one_rec defs.(0);
+    for i = 1 to len - 1 do
+      Format.fprintf fmt "@\nand ";
+      pp_one_rec defs.(i)
+    done;
+
+  and pp_blam fmt l =
+    match l with
+    | MLprimitive (_, _) | MLlam _ | MLletrec _ | MLlet _ | MLapp _ | MLif _ ->
+        Format.fprintf fmt "(%a)" pp_mllam l
+    | MLconstruct(_,_,_,args) when Array.length args > 0 ->
+        Format.fprintf fmt "(%a)" pp_mllam l
+    | _ -> pp_mllam fmt l
+
+  and pp_args sep fmt args =
+    let sep = if sep then "" else "," in
+    let len = Array.length args in
+    if len > 0 then begin
+      Format.fprintf fmt "%a" pp_blam args.(0);
+      for i = 1 to len - 1 do
+        Format.fprintf fmt "%s@ %a" sep pp_blam args.(i)
+      done
+    end
+
+  and pp_cargs fmt args =
+    let len = Array.length args in
+    match len with
+    | 0 -> ()
+    | 1 -> Format.fprintf fmt "@ %a" pp_blam args.(0)
+    | _ -> Format.fprintf fmt "@ @[<2>(%a)@]" (pp_args false) args
+
+  and pp_cparam fmt param =
+    match param with
+    | Some l -> pp_mllam fmt (MLlocal l)
+    | None -> Format.fprintf fmt "_"
+
+  and pp_cparams fmt params =
+    let len = Array.length params in
+    match len with
+    | 0 -> ()
+    | 1 -> Format.fprintf fmt " %a" pp_cparam params.(0)
+    | _ ->
+        let aux fmt params =
+          Format.fprintf fmt "%a" pp_cparam params.(0);
+          for i = 1 to len - 1 do
+            Format.fprintf fmt ",%a" pp_cparam params.(i)
+          done in
+        Format.fprintf fmt "(%a)" aux params
+
+  and pp_branches prefix ind fmt bs =
+    let pp_branch (cargs,body) =
+      let pp_pat fmt = function
+        | ConstPattern i ->
+          Format.fprintf fmt "| %s "
+            (string_of_construct prefix ~constant:true ind i)
+        | NonConstPattern (tag,args) ->
+          Format.fprintf fmt "| %s%a "
+            (string_of_construct prefix ~constant:false ind tag) pp_cparams args in
+      let rec pp_pats fmt pats =
+        match pats with
+        | [] -> ()
+        | pat::pats ->
+          Format.fprintf fmt "%a%a" pp_pat pat pp_pats pats
+      in
+      Format.fprintf fmt "%a ->@\n  %a@\n" pp_pats cargs pp_mllam body
+    in
+    Array.iter pp_branch bs
+
+  and pp_primitive fmt = function
+    | Mk_prod -> Format.fprintf fmt "mk_prod"
+    | Mk_sort -> Format.fprintf fmt "mk_sort_accu"
+    | Mk_ind -> Format.fprintf fmt "mk_ind_accu"
+    | Mk_const -> Format.fprintf fmt "mk_constant_accu"
+    | Mk_sw -> Format.fprintf fmt "mk_sw_accu"
+    | Mk_fix(rec_pos,start) ->
+        let pp_rec_pos fmt rec_pos =
+          Format.fprintf fmt "@[[| %i" rec_pos.(0);
+          for i = 1 to Array.length rec_pos - 1 do
+            Format.fprintf fmt ";@ %i" rec_pos.(i)
+          done;
+          Format.fprintf fmt " |]@]" in
+        Format.fprintf fmt "mk_fix_accu %a %i" pp_rec_pos rec_pos start
+    | Mk_cofix(start) -> Format.fprintf fmt "mk_cofix_accu %i" start
+    | Mk_rel i -> Format.fprintf fmt "mk_rel_accu %i" i
+    | Mk_var id ->
+        Format.fprintf fmt "mk_var_accu (Names.Id.of_string \"%s\")" (string_of_id id)
+    | Mk_proj -> Format.fprintf fmt "mk_proj_accu"
+    | Mk_empty_instance -> Format.fprintf fmt "UVars.Instance.empty"
+    | Is_int -> Format.fprintf fmt "is_int"
+    | Is_float -> Format.fprintf fmt "is_float"
+    | Is_string -> Format.fprintf fmt "is_string"
+    | Is_parray -> Format.fprintf fmt "is_parray"
+    | Cast_accu -> Format.fprintf fmt "cast_accu"
+    | Array_get -> Format.fprintf fmt "Array.get"
+    | Force_cofix -> Format.fprintf fmt "force_cofix"
+    | Mk_uint -> Format.fprintf fmt "mk_uint"
+    | Mk_float -> Format.fprintf fmt "mk_float"
+    | Mk_string -> Format.fprintf fmt "mk_string"
+    | Mk_int -> Format.fprintf fmt "mk_int"
+    | Val_to_int -> Format.fprintf fmt "val_to_int"
+    | Mk_evar -> Format.fprintf fmt "mk_evar_accu"
+    | MLand -> Format.fprintf fmt "(&&)"
+    | MLnot -> Format.fprintf fmt "not"
+    | MLland -> Format.fprintf fmt "(land)"
+    | MLmagic -> Format.fprintf fmt "Obj.magic"
+    | MLsubst_instance_instance -> Format.fprintf fmt "UVars.subst_instance_instance"
+    | MLsubst_instance_sort -> Format.fprintf fmt "UVars.subst_instance_sort"
+    | MLparray_of_array -> Format.fprintf fmt "parray_of_array"
+    | Coq_primitive (op, false) ->
+       Format.fprintf fmt "no_check_%s" (CPrimitives.to_string op)
+    | Coq_primitive (op, true) -> Format.fprintf fmt "%s" (CPrimitives.to_string op)
+    | Get_value -> Format.fprintf fmt "get_value"
+    | Get_sort -> Format.fprintf fmt "get_sort"
+    | Get_name -> Format.fprintf fmt "get_name"
+    | Get_const -> Format.fprintf fmt "get_const"
+    | Get_match -> Format.fprintf fmt "get_match"
+    | Get_ind -> Format.fprintf fmt "get_ind"
+    | Get_evar -> Format.fprintf fmt "get_evar"
+    | Get_instance -> Format.fprintf fmt "get_instance"
+    | Get_proj -> Format.fprintf fmt "get_proj"
+    | Get_symbols -> Format.fprintf fmt "get_symbols"
+    | Lazy -> Format.fprintf fmt "lazy" *)
+  in
+  Format.fprintf fmt "@[%a@]" pp_mllam l
+
+
 let pp_array fmt t =
   let len = Array.length t in
   Format.fprintf fmt "@[<2>[|";
@@ -2107,6 +2306,47 @@ let pp_global fmt g =
   | Gcomment s ->
       Format.fprintf fmt "@[(* %s *)@]@." s
 
+let pp_global_mlf fmt g =
+  match g with
+  | Glet (gn, c) ->
+      Format.fprintf fmt "@[( $%a  %a )@]@\n@." pp_gname gn pp_mllam_mlf c
+  | Gtype (ind, lar) -> (* types are not needed in malfunction, we will leave them as comments *)
+    let rec aux s arity =
+      if Int.equal arity 0 then s else aux (s^" * Nativevalues.t") (arity-1) in
+    let pp_const_sig fmt (tag,arity) =
+      if arity > 0 then
+        let sig_str = aux "of Nativevalues.t" (arity-1) in
+        let cstr = string_of_construct "" ~constant:false ind tag in
+        Format.fprintf fmt ";  | %s %s@\n" cstr sig_str
+      else
+        let cstr = string_of_construct "" ~constant:true ind tag in
+        Format.fprintf fmt ";  | %s@\n" cstr
+    in
+    let pp_const_sigs fmt lar =
+      Format.fprintf fmt ";  | %s of Nativevalues.t@\n" (string_of_accu_construct "" ind);
+      Array.iter (pp_const_sig fmt) lar
+    in
+    Format.fprintf fmt "@[;type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
+  (* | Gopen s ->
+      Format.fprintf fmt "@[open %s@]@." s
+  | Gtblfixtype (g, params, t) ->
+      Format.fprintf fmt "@[let %a %a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
+        pp_ldecls params pp_array t
+  | Gtblnorm (g, params, t) ->
+      Format.fprintf fmt "@[let %a %a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
+        pp_ldecls params pp_array t
+  | Gtblcofix (g, params, s) ->
+      Format.fprintf fmt "@[let %a%a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
+        pp_ldecls params pp_cofix (g, s);
+  | Gletcase(gn,params,annot,a,accu,bs) ->
+      Format.fprintf fmt "@[(* Hash = %i *)@\nlet rec %a %a : Nativevalues.t = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@."
+      (hash_global g)
+        pp_gname gn pp_ldecls params
+        pp_mllam (MLmatch(annot,a,accu,bs)) *)
+  | Gcomment s ->
+      List.iter (fun line -> Format.fprintf fmt ";@[ %s @]@." line) (String.split_on_char '\n' s)
+  | _ -> ()
+
 (** Compilation of elements in environment **)
 let rec compile_with_fv ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
   let const_prefix c = get_const_prefix env c in
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index d3eb9750f457..cdfc23705900 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -30,6 +30,8 @@ val keep_debug_files : unit -> bool
 
 val pp_global : Format.formatter -> global -> unit
 
+val pp_global_mlf : Format.formatter -> global -> unit
+
 val mk_open : string -> global
 
 val get_value : symbols -> int -> Nativevalues.t
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 0b40d61b78e9..4b1dfe5ed514 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -190,8 +190,10 @@ let warn_no_native_compiler =
 let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
   Nativelib.link_libraries ();
   let ml_filename, prefix = Nativelib.get_ml_filename () in
+  let mlf_filename, _ = Nativelib.get_mlf_filename () in
   let code, symbols, upds = mk_conv_code env sigma prefix t1 t2 in
   let fn = Nativelib.compile ml_filename code ~profile:false in
+  let _  = Nativelib.compile_mlf (mlf_filename) code ~profile:false in
   debug_native_compiler (fun () -> Pp.str "Running test...");
   let t0 = Sys.time () in
   let (rt1, rt2) = Nativelib.execute_library ~prefix fn symbols upds in
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 4a2c2c731b18..788e5880025e 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -98,6 +98,12 @@ let get_ml_filename () =
   let prefix = Filename.chop_extension (Filename.basename filename) ^ "." in
   filename, prefix
 
+let get_mlf_filename () =
+  let temp_dir = force_temp_dir() in
+  let filename = Filename.temp_file ~temp_dir "Coq_native" (source_ext^"mlf") in
+  let prefix = Filename.chop_extension (Filename.basename filename) ^ "." in
+  filename, prefix
+
 let write_ml_code fn ?(header=[]) code =
   let header = open_header@header in
   let ch_out = open_out fn in
@@ -105,6 +111,15 @@ let write_ml_code fn ?(header=[]) code =
   List.iter (pp_global fmt) (header@code);
   close_out ch_out
 
+let write_mlf_code fn ?(header=[]) code =
+  let header = open_header@header in
+  let ch_out = open_out fn in
+  let fmt = Format.formatter_of_out_channel ch_out in
+  Format.fprintf fmt "@[(module@]@\n";
+  List.iter (pp_global_mlf fmt) (header@code);
+  Format.fprintf fmt "@[(_ 0) (export))@]@.";
+  close_out ch_out
+
 let error_native_compiler_failed e =
   let msg = match e with
   | Inl (Unix.WEXITED 127) -> Pp.(strbrk "The OCaml compiler was not found. Make sure it is installed, together with findlib.")
@@ -174,6 +189,17 @@ let compile fn code ~profile:profile =
   delay_cleanup_file fn;
   r
 
+  
+let compile_mlf fn code ~profile:_ =
+  write_mlf_code fn code;
+  (* let r = call_compiler ~profile fn in
+  (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
+     cf #15263 *)
+  delay_cleanup_file fn;
+  r *)
+  ""
+
+
 type native_library = Nativecode.global list * Nativevalues.symbols
 
 let compile_library (code, symb) fn =
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index 650047464281..90c8848d48c7 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -24,11 +24,18 @@ val load_obj : (string -> unit) ref
 
 val get_ml_filename : unit -> string * string
 
+val get_mlf_filename : unit -> string * string
+
 (** [compile file code ~profile] will compile native [code] to [file],
    and return the name of the object file; this name depends on
    whether are in byte mode or not; file is expected to be .ml file *)
 val compile : string -> Nativecode.global list -> profile:bool -> string
 
+(** [compile_mlf file code ~profile] will compile native [code] to [file],
+   and return the name of the object file; this name depends on
+   whether are in byte mode or not; file is expected to be .mlf file *)
+val compile_mlf : string -> Nativecode.global list -> profile:bool -> string
+
 type native_library = Nativecode.global list * Nativevalues.symbols
 
 (** [compile_library (code, _) file] is similar to [compile file code]
diff --git a/kernel/pstring.ml b/kernel/pstring.ml
index aff724116f05..e6552edc0a27 100644
--- a/kernel/pstring.ml
+++ b/kernel/pstring.ml
@@ -76,3 +76,6 @@ let unsafe_of_string : string -> t = fun s -> s
 
 let compile : t -> string =
   Printf.sprintf "Pstring.unsafe_of_string %S"
+
+let compile_mlf : t -> string =
+  Printf.sprintf "(apply (global $Pstring$ $unsafe_of_string) %S)"
diff --git a/kernel/pstring.mli b/kernel/pstring.mli
index 120a6359fd87..49fc45a97812 100644
--- a/kernel/pstring.mli
+++ b/kernel/pstring.mli
@@ -66,3 +66,6 @@ val unsafe_of_string : string -> t
 
 (** [compile s] outputs an OCaml expression producing primitive string [s]. *)
 val compile : t -> string
+
+(** [compile_mlf s] outputs a malfunction expression producing primitive string [s]. *)
+val compile_mlf : t -> string
diff --git a/kernel/uint63.mli b/kernel/uint63.mli
index e77bd78eea37..995885d21d3f 100644
--- a/kernel/uint63.mli
+++ b/kernel/uint63.mli
@@ -36,6 +36,8 @@ val to_string : t -> string
 
 val compile : t -> string
 
+val compile_mlf : t -> string
+
 (* constants *)
 val zero    : t
 val one : t
diff --git a/kernel/uint63_31.ml b/kernel/uint63_31.ml
index 1c6a4489a23b..770714c10734 100644
--- a/kernel/uint63_31.ml
+++ b/kernel/uint63_31.ml
@@ -45,6 +45,9 @@ let to_string i = Int64.to_string i
 (* Compiles an unsigned int to OCaml code *)
 let compile i = Printf.sprintf "Uint63.of_int64 (%LiL)" i
 
+(* Compiles an unsigned int to malfunction code *)
+let compile_mlf i = Printf.sprintf "(apply (global &Uint63 &of_int64) (%LiL)" i
+
     (* comparison *)
 let lt x y =
   Int64.compare x y < 0
diff --git a/kernel/uint63_63.ml b/kernel/uint63_63.ml
index e376a4a91937..9acada7c4001 100644
--- a/kernel/uint63_63.ml
+++ b/kernel/uint63_63.ml
@@ -43,6 +43,9 @@ let to_string i = Int64.to_string (to_uint64 i)
 (* Compiles an unsigned int to OCaml code *)
 let compile i = Printf.sprintf "Uint63.of_int (%i)" i
 
+(* Compiles an unsigned int to malfunction code *)
+let compile_mlf i = Printf.sprintf "(apply (global $Uint63 $of_int) (%i)" i
+
 let zero = 0
 let one = 1
 

From 238477b918f011cd081559c554451da6d245b838 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 17:23:56 +0200
Subject: [PATCH 003/110] Now compiles lambda functions

---
 kernel/nativecode.ml | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index e36dd9c34176..a1428510d288 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2042,6 +2042,9 @@ let pp_mllam_mlf fmt l =
     | MLuint i -> Format.fprintf fmt "(%s)" (Uint63.compile_mlf i)
     | MLfloat f -> Format.fprintf fmt "(%s)" (Float64.compile_mlf f)
     | MLstring s -> Format.fprintf fmt "(%s)" (Pstring.compile_mlf s)
+    | MLlam(ids,body) ->
+        Format.fprintf fmt "@[(lambda (%a) @ %a)@]"
+          pp_ldecls_mlf ids pp_mllam body
     | MLsequence(l1,l2) ->
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam l1 pp_mllam l2
     | _ -> Format.fprintf fmt "0"
@@ -2049,9 +2052,6 @@ let pp_mllam_mlf fmt l =
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>%a@ %a@]" pp_primitive p (pp_args true) args
-    | MLlam(ids,body) ->
-        Format.fprintf fmt "@[(fun%a ->@ %a)@]"
-          pp_ldecls ids pp_mllam body
     | MLletrec(defs, body) ->
         Format.fprintf fmt "@[(%a@ in@\n%a)@]" pp_letrec defs
           pp_mllam body
@@ -2228,6 +2228,11 @@ let pp_mllam_mlf fmt l =
     | Get_proj -> Format.fprintf fmt "get_proj"
     | Get_symbols -> Format.fprintf fmt "get_symbols"
     | Lazy -> Format.fprintf fmt "lazy" *)
+  and pp_ldecls_mlf fmt ids =
+    let len = Array.length ids in
+    for i = 0 to len - 1 do
+      Format.fprintf fmt " $%a" pp_lname ids.(i)
+    done
   in
   Format.fprintf fmt "@[%a@]" pp_mllam l
 

From 24371fff5c46f0525bec39905d6c0053d549216b Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 18:06:14 +0200
Subject: [PATCH 004/110] Now compiles primitives

---
 kernel/nativecode.ml | 129 +++++++++++++++++++++----------------------
 1 file changed, 64 insertions(+), 65 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index a1428510d288..8a306b8a23f7 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2036,7 +2036,7 @@ let pp_mllam fmt l =
 
 let pp_mllam_mlf fmt l =
 
-  let rec pp_mllam fmt l =
+  let rec pp_mllam_mlf fmt l =
     match l with
     | MLint i -> pp_int fmt i
     | MLuint i -> Format.fprintf fmt "(%s)" (Uint63.compile_mlf i)
@@ -2044,14 +2044,14 @@ let pp_mllam_mlf fmt l =
     | MLstring s -> Format.fprintf fmt "(%s)" (Pstring.compile_mlf s)
     | MLlam(ids,body) ->
         Format.fprintf fmt "@[(lambda (%a) @ %a)@]"
-          pp_ldecls_mlf ids pp_mllam body
+          pp_ldecls_mlf ids pp_mllam_mlf body
     | MLsequence(l1,l2) ->
-        Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam l1 pp_mllam l2
+        Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
+    | MLprimitive (p, args) ->
+      Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p (pp_args_mlf true) args
     | _ -> Format.fprintf fmt "0"
     (* | MLlocal ln -> Format.fprintf fmt "@[%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
-    | MLprimitive (p, args) ->
-      Format.fprintf fmt "@[<2>%a@ %a@]" pp_primitive p (pp_args true) args
     | MLletrec(defs, body) ->
         Format.fprintf fmt "@[(%a@ in@\n%a)@]" pp_letrec defs
           pp_mllam body
@@ -2112,24 +2112,6 @@ let pp_mllam_mlf fmt l =
       pp_one_rec defs.(i)
     done;
 
-  and pp_blam fmt l =
-    match l with
-    | MLprimitive (_, _) | MLlam _ | MLletrec _ | MLlet _ | MLapp _ | MLif _ ->
-        Format.fprintf fmt "(%a)" pp_mllam l
-    | MLconstruct(_,_,_,args) when Array.length args > 0 ->
-        Format.fprintf fmt "(%a)" pp_mllam l
-    | _ -> pp_mllam fmt l
-
-  and pp_args sep fmt args =
-    let sep = if sep then "" else "," in
-    let len = Array.length args in
-    if len > 0 then begin
-      Format.fprintf fmt "%a" pp_blam args.(0);
-      for i = 1 to len - 1 do
-        Format.fprintf fmt "%s@ %a" sep pp_blam args.(i)
-      done
-    end
-
   and pp_cargs fmt args =
     let len = Array.length args in
     match len with
@@ -2174,13 +2156,30 @@ let pp_mllam_mlf fmt l =
     in
     Array.iter pp_branch bs
 
-  and pp_primitive fmt = function
-    | Mk_prod -> Format.fprintf fmt "mk_prod"
-    | Mk_sort -> Format.fprintf fmt "mk_sort_accu"
-    | Mk_ind -> Format.fprintf fmt "mk_ind_accu"
-    | Mk_const -> Format.fprintf fmt "mk_constant_accu"
-    | Mk_sw -> Format.fprintf fmt "mk_sw_accu"
-    | Mk_fix(rec_pos,start) ->
+  *)
+  and pp_blam_mlf fmt l =
+    match l with
+    | MLprimitive (_, _) | MLlam _ | MLletrec _ | MLlet _ | MLapp _ | MLif _ ->
+        Format.fprintf fmt "(%a)" pp_mllam l
+    | MLconstruct(_,_,_,args) when Array.length args > 0 ->
+        Format.fprintf fmt "(%a)" pp_mllam l
+    | _ -> pp_mllam fmt l
+  and pp_args_mlf sep fmt args =
+    let sep = if sep then "" else "," in
+    let len = Array.length args in
+    if len > 0 then begin
+      Format.fprintf fmt "%a" pp_blam_mlf args.(0);
+      for i = 1 to len - 1 do
+        Format.fprintf fmt "%s@ %a" sep pp_blam_mlf args.(i)
+      done
+    end else Format.fprintf fmt "0" (* 0 is () in malfunction *)
+  and pp_primitive_mlf fmt = function
+    | Mk_prod -> Format.fprintf fmt "(Global $Stdlib $mk_prod)"
+    | Mk_sort -> Format.fprintf fmt "(Global $Stdlib $mk_sort_accu)"
+    | Mk_ind -> Format.fprintf fmt "(Global $Stdlib $mk_ind_accu)"
+    | Mk_const -> Format.fprintf fmt "(Global $Stdlib $mk_constant_accu)"
+    | Mk_sw -> Format.fprintf fmt "(Global $Stdlib $mk_sw_accu)"
+    | Mk_fix(rec_pos,start) -> (* TODO: what is that ??? *)
         let pp_rec_pos fmt rec_pos =
           Format.fprintf fmt "@[[| %i" rec_pos.(0);
           for i = 1 to Array.length rec_pos - 1 do
@@ -2189,52 +2188,52 @@ let pp_mllam_mlf fmt l =
           Format.fprintf fmt " |]@]" in
         Format.fprintf fmt "mk_fix_accu %a %i" pp_rec_pos rec_pos start
     | Mk_cofix(start) -> Format.fprintf fmt "mk_cofix_accu %i" start
-    | Mk_rel i -> Format.fprintf fmt "mk_rel_accu %i" i
+    | Mk_rel i -> Format.fprintf fmt "(apply (global $Nativevalues $mk_rel_accu) %i)" i
     | Mk_var id ->
         Format.fprintf fmt "mk_var_accu (Names.Id.of_string \"%s\")" (string_of_id id)
-    | Mk_proj -> Format.fprintf fmt "mk_proj_accu"
-    | Mk_empty_instance -> Format.fprintf fmt "UVars.Instance.empty"
-    | Is_int -> Format.fprintf fmt "is_int"
-    | Is_float -> Format.fprintf fmt "is_float"
-    | Is_string -> Format.fprintf fmt "is_string"
-    | Is_parray -> Format.fprintf fmt "is_parray"
-    | Cast_accu -> Format.fprintf fmt "cast_accu"
-    | Array_get -> Format.fprintf fmt "Array.get"
-    | Force_cofix -> Format.fprintf fmt "force_cofix"
-    | Mk_uint -> Format.fprintf fmt "mk_uint"
-    | Mk_float -> Format.fprintf fmt "mk_float"
-    | Mk_string -> Format.fprintf fmt "mk_string"
-    | Mk_int -> Format.fprintf fmt "mk_int"
-    | Val_to_int -> Format.fprintf fmt "val_to_int"
-    | Mk_evar -> Format.fprintf fmt "mk_evar_accu"
+    | Mk_proj -> Format.fprintf fmt "(global $Nativevalues $mk_proj_accu)"
+    | Mk_empty_instance -> Format.fprintf fmt "(global $UVars $Instance $empty)"
+    | Is_int -> Format.fprintf fmt "(global $Nativevalues $is_int)"
+    | Is_float -> Format.fprintf fmt "(global $Nativevalues $is_float)"
+    | Is_string -> Format.fprintf fmt "(global $Nativevalues $is_string)"
+    | Is_parray -> Format.fprintf fmt "(global $Nativevalues $is_parray)"
+    | Cast_accu -> Format.fprintf fmt "(global $Nativevalues $cast_accu)"
+    | Array_get -> Format.fprintf fmt "(global $Stdlib $Array $get)"
+    | Force_cofix -> Format.fprintf fmt "(global $Nativevalues $force_cofix)"
+    | Mk_uint -> Format.fprintf fmt "(global $Nativevalues $mk_uint)"
+    | Mk_float -> Format.fprintf fmt "(global $Nativevalues $mk_float)"
+    | Mk_string -> Format.fprintf fmt "(global $Nativevalues $mk_string)"
+    | Mk_int -> Format.fprintf fmt "(global $Nativevalues $mk_int)"
+    | Val_to_int -> Format.fprintf fmt "(global $Nativevalues $val_to_int)"
+    | Mk_evar -> Format.fprintf fmt "(global $Nativevalues $mk_evar_accu)"
     | MLand -> Format.fprintf fmt "(&&)"
-    | MLnot -> Format.fprintf fmt "not"
-    | MLland -> Format.fprintf fmt "(land)"
+    | MLnot -> Format.fprintf fmt "(global $not)"
+    | MLland -> Format.fprintf fmt "(global $land)"
     | MLmagic -> Format.fprintf fmt "Obj.magic"
-    | MLsubst_instance_instance -> Format.fprintf fmt "UVars.subst_instance_instance"
-    | MLsubst_instance_sort -> Format.fprintf fmt "UVars.subst_instance_sort"
-    | MLparray_of_array -> Format.fprintf fmt "parray_of_array"
+    | MLsubst_instance_instance -> Format.fprintf fmt "(global $UVars $subst_instance_instance)"
+    | MLsubst_instance_sort -> Format.fprintf fmt "(global $UVars $subst_instance_sort)"
+    | MLparray_of_array -> Format.fprintf fmt "(global $Nativevalues $parray_of_array)"
     | Coq_primitive (op, false) ->
-       Format.fprintf fmt "no_check_%s" (CPrimitives.to_string op)
-    | Coq_primitive (op, true) -> Format.fprintf fmt "%s" (CPrimitives.to_string op)
-    | Get_value -> Format.fprintf fmt "get_value"
-    | Get_sort -> Format.fprintf fmt "get_sort"
-    | Get_name -> Format.fprintf fmt "get_name"
-    | Get_const -> Format.fprintf fmt "get_const"
-    | Get_match -> Format.fprintf fmt "get_match"
-    | Get_ind -> Format.fprintf fmt "get_ind"
-    | Get_evar -> Format.fprintf fmt "get_evar"
-    | Get_instance -> Format.fprintf fmt "get_instance"
-    | Get_proj -> Format.fprintf fmt "get_proj"
-    | Get_symbols -> Format.fprintf fmt "get_symbols"
-    | Lazy -> Format.fprintf fmt "lazy" *)
+       Format.fprintf fmt "(global $Nativelib $no_check_%s)" (CPrimitives.to_string op)
+    | Coq_primitive (op, true) -> Format.fprintf fmt "(Global $Nativelib $%s)" (CPrimitives.to_string op)
+    | Get_value -> Format.fprintf fmt "(global $Nativecode $get_value)"
+    | Get_sort -> Format.fprintf fmt "(global $Nativecode $get_sort)"
+    | Get_name -> Format.fprintf fmt "(global $Nativecode $get_name)"
+    | Get_const -> Format.fprintf fmt "(global $Nativecode $get_const)"
+    | Get_match -> Format.fprintf fmt "(global $Nativecode $get_match)"
+    | Get_ind -> Format.fprintf fmt "(global $Nativecode $get_ind)"
+    | Get_evar -> Format.fprintf fmt "(global $Nativecode $get_evar)"
+    | Get_instance -> Format.fprintf fmt "(global $Nativecode $get_instance)"
+    | Get_proj -> Format.fprintf fmt "(global $Nativecode $get_proj)"
+    | Get_symbols -> Format.fprintf fmt "(global $Nativelib $get_symbols)"
+    | Lazy -> Format.fprintf fmt "(global $lazy)" (* TODO: verify this *)
   and pp_ldecls_mlf fmt ids =
     let len = Array.length ids in
     for i = 0 to len - 1 do
       Format.fprintf fmt " $%a" pp_lname ids.(i)
     done
   in
-  Format.fprintf fmt "@[%a@]" pp_mllam l
+  Format.fprintf fmt "@[%a@]" pp_mllam_mlf l
 
 
 let pp_array fmt t =

From 21cdcaae456ccc674e5c5e27c9d0b05a6e65d155 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 10:23:08 +0200
Subject: [PATCH 005/110] the mlf compiler is now called by the general compile
 function

---
 kernel/nativeconv.ml |  2 --
 kernel/nativelib.ml  | 12 ++----------
 kernel/nativelib.mli |  5 -----
 3 files changed, 2 insertions(+), 17 deletions(-)

diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 4b1dfe5ed514..0b40d61b78e9 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -190,10 +190,8 @@ let warn_no_native_compiler =
 let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
   Nativelib.link_libraries ();
   let ml_filename, prefix = Nativelib.get_ml_filename () in
-  let mlf_filename, _ = Nativelib.get_mlf_filename () in
   let code, symbols, upds = mk_conv_code env sigma prefix t1 t2 in
   let fn = Nativelib.compile ml_filename code ~profile:false in
-  let _  = Nativelib.compile_mlf (mlf_filename) code ~profile:false in
   debug_native_compiler (fun () -> Pp.str "Running test...");
   let t0 = Sys.time () in
   let (rt1, rt2) = Nativelib.execute_library ~prefix fn symbols upds in
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 788e5880025e..58086a30e714 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -183,22 +183,14 @@ let call_compiler ?profile:(profile=false) ml_filename =
 
 let compile fn code ~profile:profile =
   write_ml_code fn code;
+  write_mlf_code (fn ^ "mlf") code;
   let r = call_compiler ~profile fn in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
   delay_cleanup_file fn;
+  delay_cleanup_file (fn ^ "mlf");
   r
 
-  
-let compile_mlf fn code ~profile:_ =
-  write_mlf_code fn code;
-  (* let r = call_compiler ~profile fn in
-  (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
-     cf #15263 *)
-  delay_cleanup_file fn;
-  r *)
-  ""
-
 
 type native_library = Nativecode.global list * Nativevalues.symbols
 
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index 90c8848d48c7..9ed97ee83b5d 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -31,11 +31,6 @@ val get_mlf_filename : unit -> string * string
    whether are in byte mode or not; file is expected to be .ml file *)
 val compile : string -> Nativecode.global list -> profile:bool -> string
 
-(** [compile_mlf file code ~profile] will compile native [code] to [file],
-   and return the name of the object file; this name depends on
-   whether are in byte mode or not; file is expected to be .mlf file *)
-val compile_mlf : string -> Nativecode.global list -> profile:bool -> string
-
 type native_library = Nativecode.global list * Nativevalues.symbols
 
 (** [compile_library (code, _) file] is similar to [compile file code]

From 50fcc05c9f691bbb69691d0cf4ebdf99e041d52f Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 10:38:28 +0200
Subject: [PATCH 006/110] fixed two naming errors

---
 kernel/nativecode.ml | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 8a306b8a23f7..004f9087a8c7 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2160,10 +2160,10 @@ let pp_mllam_mlf fmt l =
   and pp_blam_mlf fmt l =
     match l with
     | MLprimitive (_, _) | MLlam _ | MLletrec _ | MLlet _ | MLapp _ | MLif _ ->
-        Format.fprintf fmt "(%a)" pp_mllam l
+        Format.fprintf fmt "(%a)" pp_mllam_mlf l
     | MLconstruct(_,_,_,args) when Array.length args > 0 ->
-        Format.fprintf fmt "(%a)" pp_mllam l
-    | _ -> pp_mllam fmt l
+        Format.fprintf fmt "(%a)" pp_mllam_mlf l
+    | _ -> pp_mllam_mlf fmt l
   and pp_args_mlf sep fmt args =
     let sep = if sep then "" else "," in
     let len = Array.length args in
@@ -2174,11 +2174,11 @@ let pp_mllam_mlf fmt l =
       done
     end else Format.fprintf fmt "0" (* 0 is () in malfunction *)
   and pp_primitive_mlf fmt = function
-    | Mk_prod -> Format.fprintf fmt "(Global $Stdlib $mk_prod)"
-    | Mk_sort -> Format.fprintf fmt "(Global $Stdlib $mk_sort_accu)"
-    | Mk_ind -> Format.fprintf fmt "(Global $Stdlib $mk_ind_accu)"
-    | Mk_const -> Format.fprintf fmt "(Global $Stdlib $mk_constant_accu)"
-    | Mk_sw -> Format.fprintf fmt "(Global $Stdlib $mk_sw_accu)"
+    | Mk_prod -> Format.fprintf fmt "(Global $Nativevalues $mk_prod)"
+    | Mk_sort -> Format.fprintf fmt "(Global $Nativevalues $mk_sort_accu)"
+    | Mk_ind -> Format.fprintf fmt "(Global $Nativevalues $mk_ind_accu)"
+    | Mk_const -> Format.fprintf fmt "(Global $Nativevalues $mk_constant_accu)"
+    | Mk_sw -> Format.fprintf fmt "(Global $Nativevalues $mk_sw_accu)"
     | Mk_fix(rec_pos,start) -> (* TODO: what is that ??? *)
         let pp_rec_pos fmt rec_pos =
           Format.fprintf fmt "@[[| %i" rec_pos.(0);

From c501fcfb13ec72e3069595b7515c448c445e11a8 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 11:16:13 +0200
Subject: [PATCH 007/110] Now compiles local and global variable names,
 applications and let statements

---
 kernel/nativecode.ml | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 004f9087a8c7..694a9d4c805a 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2049,17 +2049,17 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p (pp_args_mlf true) args
-    | _ -> Format.fprintf fmt "0"
-    (* | MLlocal ln -> Format.fprintf fmt "@[%a@]" pp_lname ln
+    | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
-    | MLletrec(defs, body) ->
+    | MLapp(f, args) ->
+        Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f (pp_args_mlf true) args
+    | MLlet(id,def,body) ->
+        Format.fprintf fmt "@[(let@ ($%a@ %a)@\n@[<2>%a@])@]"
+          pp_lname id pp_mllam_mlf def pp_mllam_mlf body
+    | _ -> Format.fprintf fmt "000"
+    (* | MLletrec(defs, body) ->
         Format.fprintf fmt "@[(%a@ in@\n%a)@]" pp_letrec defs
           pp_mllam body
-    | MLlet(id,def,body) ->
-        Format.fprintf fmt "@[(@[let@ %a@ =@ %a@ in@]@\n%a)@]"
-          pp_lname id pp_mllam def pp_mllam body
-    | MLapp(f, args) ->
-        Format.fprintf fmt "@[<2>%a@ %a@]" pp_mllam f (pp_args true) args
     | MLif(t,l1,l2) ->
         Format.fprintf fmt "@[(if %a then@\n  %a@\nelse@\n  %a)@]"
           pp_mllam t pp_mllam l1 pp_mllam l2

From 741d5125c14391cb6ed6e281bc06eeb418406cca Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 14:33:43 +0200
Subject: [PATCH 008/110] Now compiles if and letrec statements, and fixed a
 bug with global names

---
 kernel/nativecode.ml | 39 +++++++++++++++++++--------------------
 1 file changed, 19 insertions(+), 20 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 694a9d4c805a..33a08eed259c 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2050,19 +2050,20 @@ let pp_mllam_mlf fmt l =
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p (pp_args_mlf true) args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
-    | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
+    | MLglobal g -> Format.fprintf fmt "@[$%a@]" pp_gname g
     | MLapp(f, args) ->
         Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f (pp_args_mlf true) args
     | MLlet(id,def,body) ->
         Format.fprintf fmt "@[(let@ ($%a@ %a)@\n@[<2>%a@])@]"
           pp_lname id pp_mllam_mlf def pp_mllam_mlf body
-    | _ -> Format.fprintf fmt "000"
-    (* | MLletrec(defs, body) ->
-        Format.fprintf fmt "@[(%a@ in@\n%a)@]" pp_letrec defs
-          pp_mllam body
     | MLif(t,l1,l2) ->
-        Format.fprintf fmt "@[(if %a then@\n  %a@\nelse@\n  %a)@]"
-          pp_mllam t pp_mllam l1 pp_mllam l2
+        Format.fprintf fmt "@[(if %a@\n  %a@\n  %a)@]"
+          pp_mllam_mlf t pp_mllam_mlf l1 pp_mllam_mlf l2
+    | MLletrec(defs, body) ->
+        Format.fprintf fmt "@[(let (rec @[<2>%a%a@]))@]" pp_letrec_mlf defs
+          pp_mllam_mlf body
+    | _ -> Format.fprintf fmt "000"
+    (* 
     | MLmatch (annot, c, accu_br, br) ->
       let ind = annot.asw_ind in
       let prefix = annot.asw_prefix in
@@ -2099,19 +2100,7 @@ let pp_mllam_mlf fmt l =
           "@[begin match Obj.magic (%a) with@\n| %s _ ->@\n  true@\n| _ ->@\n  false@\nend@]"
         pp_mllam c accu *)
 
-  (* and pp_letrec fmt defs =
-    let len = Array.length defs in
-    let pp_one_rec (fn, argsn, body) =
-      Format.fprintf fmt "%a%a =@\n  %a"
-        pp_lname fn
-        pp_ldecls argsn pp_mllam body in
-    Format.fprintf fmt "@[let rec ";
-    pp_one_rec defs.(0);
-    for i = 1 to len - 1 do
-      Format.fprintf fmt "@\nand ";
-      pp_one_rec defs.(i)
-    done;
-
+  (*
   and pp_cargs fmt args =
     let len = Array.length args in
     match len with
@@ -2157,6 +2146,16 @@ let pp_mllam_mlf fmt l =
     Array.iter pp_branch bs
 
   *)
+  and pp_letrec_mlf fmt defs =
+    let len = Array.length defs in
+    let pp_one_rec (fn, argsn, body) =
+      Format.fprintf fmt "($%a@ %a)"
+        pp_lname fn
+        pp_mllam_mlf (MLlam(argsn, body));
+      Format.fprintf fmt "@\n" in
+    for i = 0 to len - 1 do
+      pp_one_rec defs.(i)
+    done
   and pp_blam_mlf fmt l =
     match l with
     | MLprimitive (_, _) | MLlam _ | MLletrec _ | MLlet _ | MLapp _ | MLif _ ->

From 01393e97b81f171589b3d5b6029b2ecc6ab96547 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 14:54:31 +0200
Subject: [PATCH 009/110] Now compiles (at least define) let cases

---
 kernel/nativecode.ml | 36 +++++++++++++++++++-----------------
 1 file changed, 19 insertions(+), 17 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 33a08eed259c..dd2d455d98a4 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1827,6 +1827,12 @@ let pp_ldecls fmt ids =
     Format.fprintf fmt " (%a : Nativevalues.t)" pp_lname ids.(i)
   done
 
+let pp_ldecls_mlf fmt ids =
+    let len = Array.length ids in
+    for i = 0 to len - 1 do
+      Format.fprintf fmt " $%a" pp_lname ids.(i)
+    done
+
 let string_of_construct prefix ~constant ind tag =
   let base = if constant then "Int" else "Construct" in
   Format.sprintf "%s%s_%s_%i" prefix base (string_of_ind ind) tag
@@ -2062,16 +2068,15 @@ let pp_mllam_mlf fmt l =
     | MLletrec(defs, body) ->
         Format.fprintf fmt "@[(let (rec @[<2>%a%a@]))@]" pp_letrec_mlf defs
           pp_mllam_mlf body
-    | _ -> Format.fprintf fmt "000"
-    (* 
-    | MLmatch (annot, c, accu_br, br) ->
+    (* | MLmatch (annot, c, accu_br, br) ->
       let ind = annot.asw_ind in
       let prefix = annot.asw_prefix in
       let accu = string_of_accu_construct prefix ind in
       Format.fprintf fmt
         "@[begin match Obj.magic (%a) with@\n| %s _ ->@\n  %a@\n%aend@]"
-        pp_mllam c accu pp_mllam accu_br (pp_branches prefix ind) br
-
+        pp_mllam c accu pp_mllam accu_br (pp_branches prefix ind) br *)
+    | _ -> Format.fprintf fmt "000"
+    (* 
     | MLconstruct(prefix,ind,tag,args) ->
         Format.fprintf fmt "@[<2>(Obj.magic@ @[<2>(%s%a)@] : Nativevalues.t)@]"
           (string_of_construct prefix ~constant:false ind tag) pp_cargs args
@@ -2226,11 +2231,6 @@ let pp_mllam_mlf fmt l =
     | Get_proj -> Format.fprintf fmt "(global $Nativecode $get_proj)"
     | Get_symbols -> Format.fprintf fmt "(global $Nativelib $get_symbols)"
     | Lazy -> Format.fprintf fmt "(global $lazy)" (* TODO: verify this *)
-  and pp_ldecls_mlf fmt ids =
-    let len = Array.length ids in
-    for i = 0 to len - 1 do
-      Format.fprintf fmt " $%a" pp_lname ids.(i)
-    done
   in
   Format.fprintf fmt "@[%a@]" pp_mllam_mlf l
 
@@ -2330,8 +2330,14 @@ let pp_global_mlf fmt g =
       Array.iter (pp_const_sig fmt) lar
     in
     Format.fprintf fmt "@[;type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
-  (* | Gopen s ->
-      Format.fprintf fmt "@[open %s@]@." s
+  | Gopen s ->
+      Format.fprintf fmt ";@[open %s@]@." s
+  | Gletcase(gn,params,annot,a,accu,bs) ->
+      Format.fprintf fmt "@[; Hash = %i@\n(rec ($%a (lambda (%a)@\n  %a)))@]@\n@."
+      (hash_global g)
+        pp_gname gn pp_ldecls_mlf params
+        pp_mllam_mlf (MLmatch(annot,a,accu,bs))
+  (*
   | Gtblfixtype (g, params, t) ->
       Format.fprintf fmt "@[let %a %a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
         pp_ldecls params pp_array t
@@ -2341,11 +2347,7 @@ let pp_global_mlf fmt g =
   | Gtblcofix (g, params, s) ->
       Format.fprintf fmt "@[let %a%a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
         pp_ldecls params pp_cofix (g, s);
-  | Gletcase(gn,params,annot,a,accu,bs) ->
-      Format.fprintf fmt "@[(* Hash = %i *)@\nlet rec %a %a : Nativevalues.t = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@."
-      (hash_global g)
-        pp_gname gn pp_ldecls params
-        pp_mllam (MLmatch(annot,a,accu,bs)) *)
+   *)
   | Gcomment s ->
       List.iter (fun line -> Format.fprintf fmt ";@[ %s @]@." line) (String.split_on_char '\n' s)
   | _ -> ()

From 1d8d2c45e7dfc86b2af3815c2a54c321e406eeae Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 15:15:10 +0200
Subject: [PATCH 010/110] Now compiles global table fix types (whatever that
 is)

---
 kernel/nativecode.ml | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index dd2d455d98a4..5933d596accd 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2245,6 +2245,19 @@ let pp_array fmt t =
     Format.fprintf fmt "%a" pp_mllam t.(len - 1);
   Format.fprintf fmt "|]@]"
 
+let pp_array_mlf fmt t =
+  let len = Array.length t in
+  let rec aux i =
+    if i < 0 then Format.fprintf fmt "(makevec 0 0)" else
+    if i = 0 then Format.fprintf fmt "(makevec %i %a)" len pp_mllam_mlf t.(0) else begin
+    Format.fprintf fmt "(store@\n";
+    aux (i-1);
+    Format.fprintf fmt "@\n%i %a)" i pp_mllam_mlf t.(i)
+  end in
+  Format.fprintf fmt "@[<2>";
+  aux (len-1);
+  Format.fprintf fmt "@]"
+
 let pp_cofix fmt (gn, s) =
   let pp_dummy fmt len =
     let dummy = String.concat "; " (List.make len "0") in
@@ -2337,13 +2350,13 @@ let pp_global_mlf fmt g =
       (hash_global g)
         pp_gname gn pp_ldecls_mlf params
         pp_mllam_mlf (MLmatch(annot,a,accu,bs))
-  (*
   | Gtblfixtype (g, params, t) ->
+      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a@))]@\n@." pp_gname g
+        pp_ldecls_mlf params pp_array_mlf t
+  (* | Gtblnorm (g, params, t) ->
       Format.fprintf fmt "@[let %a %a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
-        pp_ldecls params pp_array t
-  | Gtblnorm (g, params, t) ->
-      Format.fprintf fmt "@[let %a %a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
-        pp_ldecls params pp_array t
+        pp_ldecls params pp_array t *)
+  (*
   | Gtblcofix (g, params, s) ->
       Format.fprintf fmt "@[let %a%a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
         pp_ldecls params pp_cofix (g, s);

From 1ed11def496d0bf59fe4725a609c15af6a7acf0b Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 15:33:12 +0200
Subject: [PATCH 011/110] Now compiles global table norm and fixed a few bugs

---
 kernel/nativecode.ml | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 5933d596accd..1eab71e58e7a 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1829,6 +1829,7 @@ let pp_ldecls fmt ids =
 
 let pp_ldecls_mlf fmt ids =
     let len = Array.length ids in
+    if len = 0 then Format.fprintf fmt "($_)" else (* argument list cannot be empty in malfunction *)
     for i = 0 to len - 1 do
       Format.fprintf fmt " $%a" pp_lname ids.(i)
     done
@@ -2351,11 +2352,11 @@ let pp_global_mlf fmt g =
         pp_gname gn pp_ldecls_mlf params
         pp_mllam_mlf (MLmatch(annot,a,accu,bs))
   | Gtblfixtype (g, params, t) ->
-      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a@))]@\n@." pp_gname g
+      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a))@]@\n@." pp_gname g
+        pp_ldecls_mlf params pp_array_mlf t
+  | Gtblnorm (g, params, t) ->
+      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a))@]@\n@." pp_gname g
         pp_ldecls_mlf params pp_array_mlf t
-  (* | Gtblnorm (g, params, t) ->
-      Format.fprintf fmt "@[let %a %a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
-        pp_ldecls params pp_array t *)
   (*
   | Gtblcofix (g, params, s) ->
       Format.fprintf fmt "@[let %a%a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g

From 53890e2d3153dd4a39798ab94ea65418c275a66d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 15:41:19 +0200
Subject: [PATCH 012/110] Fixed a capitalization error and a few
 inconsistencies

---
 kernel/nativecode.ml | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 1eab71e58e7a..a4ffd47b081a 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1829,7 +1829,7 @@ let pp_ldecls fmt ids =
 
 let pp_ldecls_mlf fmt ids =
     let len = Array.length ids in
-    if len = 0 then Format.fprintf fmt "($_)" else (* argument list cannot be empty in malfunction *)
+    if len = 0 then Format.fprintf fmt "$_" else (* argument list cannot be empty in malfunction *)
     for i = 0 to len - 1 do
       Format.fprintf fmt " $%a" pp_lname ids.(i)
     done
@@ -2179,11 +2179,11 @@ let pp_mllam_mlf fmt l =
       done
     end else Format.fprintf fmt "0" (* 0 is () in malfunction *)
   and pp_primitive_mlf fmt = function
-    | Mk_prod -> Format.fprintf fmt "(Global $Nativevalues $mk_prod)"
-    | Mk_sort -> Format.fprintf fmt "(Global $Nativevalues $mk_sort_accu)"
-    | Mk_ind -> Format.fprintf fmt "(Global $Nativevalues $mk_ind_accu)"
-    | Mk_const -> Format.fprintf fmt "(Global $Nativevalues $mk_constant_accu)"
-    | Mk_sw -> Format.fprintf fmt "(Global $Nativevalues $mk_sw_accu)"
+    | Mk_prod -> Format.fprintf fmt "(global $Nativevalues $mk_prod)"
+    | Mk_sort -> Format.fprintf fmt "(global $Nativevalues $mk_sort_accu)"
+    | Mk_ind -> Format.fprintf fmt "(global $Nativevalues $mk_ind_accu)"
+    | Mk_const -> Format.fprintf fmt "(global $Nativevalues $mk_constant_accu)"
+    | Mk_sw -> Format.fprintf fmt "(global $Nativevalues $mk_sw_accu)"
     | Mk_fix(rec_pos,start) -> (* TODO: what is that ??? *)
         let pp_rec_pos fmt rec_pos =
           Format.fprintf fmt "@[[| %i" rec_pos.(0);
@@ -2220,7 +2220,7 @@ let pp_mllam_mlf fmt l =
     | MLparray_of_array -> Format.fprintf fmt "(global $Nativevalues $parray_of_array)"
     | Coq_primitive (op, false) ->
        Format.fprintf fmt "(global $Nativelib $no_check_%s)" (CPrimitives.to_string op)
-    | Coq_primitive (op, true) -> Format.fprintf fmt "(Global $Nativelib $%s)" (CPrimitives.to_string op)
+    | Coq_primitive (op, true) -> Format.fprintf fmt "(global $Nativelib $%s)" (CPrimitives.to_string op)
     | Get_value -> Format.fprintf fmt "(global $Nativecode $get_value)"
     | Get_sort -> Format.fprintf fmt "(global $Nativecode $get_sort)"
     | Get_name -> Format.fprintf fmt "(global $Nativecode $get_name)"

From 0a3be3fa5636d7678ad3111db236dbfda5bac728 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:04:00 +0200
Subject: [PATCH 013/110] Now compiles arrays and reference assignment

---
 kernel/nativecode.ml | 35 ++++++++++++++++-------------------
 1 file changed, 16 insertions(+), 19 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index a4ffd47b081a..b1d87ce85f41 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2069,6 +2069,22 @@ let pp_mllam_mlf fmt l =
     | MLletrec(defs, body) ->
         Format.fprintf fmt "@[(let (rec @[<2>%a%a@]))@]" pp_letrec_mlf defs
           pp_mllam_mlf body
+    | MLarray arr ->
+      let len = Array.length arr in
+      if Int.equal len 0 then begin
+        Format.fprintf fmt "@[(makevec 0 0)@]"
+      end else if Int.equal len 1 then begin
+        (* We have to emulate a 1-uplet *)
+        Format.fprintf fmt "@[(makevec 1 %a)@]" pp_mllam_mlf arr.(0)
+      end else begin
+        Format.fprintf fmt "@[(block (tag 0)";
+        for i = 0 to len - 1 do
+          Format.fprintf fmt "@ %a" pp_mllam_mlf arr.(i)
+        done;
+        Format.fprintf fmt ")@]"
+      end;
+    | MLsetref (s, body) ->
+        Format.fprintf fmt "@[(store $%s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam_mlf body
     (* | MLmatch (annot, c, accu_br, br) ->
       let ind = annot.asw_ind in
       let prefix = annot.asw_prefix in
@@ -2081,25 +2097,6 @@ let pp_mllam_mlf fmt l =
     | MLconstruct(prefix,ind,tag,args) ->
         Format.fprintf fmt "@[<2>(Obj.magic@ @[<2>(%s%a)@] : Nativevalues.t)@]"
           (string_of_construct prefix ~constant:false ind tag) pp_cargs args
-    | MLsetref (s, body) ->
-        Format.fprintf fmt "@[%s@ :=@\n Some (%a)@]" s pp_mllam body
-    | MLarray arr ->
-      (* We need to ensure that the array does not use the flat representation
-          if ever the first argument is a float *)
-      let len = Array.length arr in
-      if Int.equal len 0 then begin
-        Format.fprintf fmt "@[(Obj.magic [||])@]"
-      end else if Int.equal len 1 then begin
-        (* We have to emulate a 1-uplet *)
-        Format.fprintf fmt "@[(Obj.magic (ref (%a)))@]" pp_mllam arr.(0)
-      end else begin
-        Format.fprintf fmt "@[(Obj.magic (";
-        for i = 0 to len - 2 do
-          Format.fprintf fmt "%a,@ " pp_mllam arr.(i)
-        done;
-        pp_mllam fmt arr.(len-1);
-        Format.fprintf fmt "))@]"
-      end;
     | MLisaccu (prefix, ind, c) ->
         let accu = string_of_accu_construct prefix ind in
         Format.fprintf fmt

From 2fe67eebddd06fcb07d4756e00704b53073346ff Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:12:48 +0200
Subject: [PATCH 014/110] Fixed an arror where global names where wrongly
 assumed to come from the same file

---
 kernel/nativecode.ml | 20 ++++++++++++++------
 1 file changed, 14 insertions(+), 6 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index b1d87ce85f41..1d96e1571d01 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1818,6 +1818,14 @@ let string_of_gname g =
 let pp_gname fmt g =
   Format.fprintf fmt "%s" (string_of_gname g)
 
+let pp_gname_mlf fmt g =
+  let name = string_of_gname g in
+  if String.contains name '.' then begin (* the global name comes from a module *)
+    let name = Str.global_replace (Str.regexp_string ".") " $" name in
+    Format.fprintf fmt "(global $%s)" name
+  end else
+  Format.fprintf fmt "$%s" name
+
 let pp_lname fmt ln =
   Format.fprintf fmt "x_%s_%i" (string_of_name ln.lname) ln.luid
 
@@ -2057,7 +2065,7 @@ let pp_mllam_mlf fmt l =
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p (pp_args_mlf true) args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
-    | MLglobal g -> Format.fprintf fmt "@[$%a@]" pp_gname g
+    | MLglobal g -> Format.fprintf fmt "@[$%a@]" pp_gname_mlf g
     | MLapp(f, args) ->
         Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f (pp_args_mlf true) args
     | MLlet(id,def,body) ->
@@ -2323,7 +2331,7 @@ let pp_global fmt g =
 let pp_global_mlf fmt g =
   match g with
   | Glet (gn, c) ->
-      Format.fprintf fmt "@[( $%a  %a )@]@\n@." pp_gname gn pp_mllam_mlf c
+      Format.fprintf fmt "@[( $%a  %a )@]@\n@." pp_gname_mlf gn pp_mllam_mlf c
   | Gtype (ind, lar) -> (* types are not needed in malfunction, we will leave them as comments *)
     let rec aux s arity =
       if Int.equal arity 0 then s else aux (s^" * Nativevalues.t") (arity-1) in
@@ -2346,17 +2354,17 @@ let pp_global_mlf fmt g =
   | Gletcase(gn,params,annot,a,accu,bs) ->
       Format.fprintf fmt "@[; Hash = %i@\n(rec ($%a (lambda (%a)@\n  %a)))@]@\n@."
       (hash_global g)
-        pp_gname gn pp_ldecls_mlf params
+        pp_gname_mlf gn pp_ldecls_mlf params
         pp_mllam_mlf (MLmatch(annot,a,accu,bs))
   | Gtblfixtype (g, params, t) ->
-      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a))@]@\n@." pp_gname g
+      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t
   | Gtblnorm (g, params, t) ->
-      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a))@]@\n@." pp_gname g
+      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t
   (*
   | Gtblcofix (g, params, s) ->
-      Format.fprintf fmt "@[let %a%a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
+      Format.fprintf fmt "@[let %a%a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname_mlf g
         pp_ldecls params pp_cofix (g, s);
    *)
   | Gcomment s ->

From e6fd9ede08f6139c8763b25739123981254e40bc Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:15:58 +0200
Subject: [PATCH 015/110] Fixed a bug introduced by the last fix where some
 global variable would have two dolla sign in front of them

---
 kernel/nativecode.ml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 1d96e1571d01..fd7c2c3d67f4 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2065,7 +2065,7 @@ let pp_mllam_mlf fmt l =
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p (pp_args_mlf true) args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
-    | MLglobal g -> Format.fprintf fmt "@[$%a@]" pp_gname_mlf g
+    | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname_mlf g
     | MLapp(f, args) ->
         Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f (pp_args_mlf true) args
     | MLlet(id,def,body) ->
@@ -2331,7 +2331,7 @@ let pp_global fmt g =
 let pp_global_mlf fmt g =
   match g with
   | Glet (gn, c) ->
-      Format.fprintf fmt "@[( $%a  %a )@]@\n@." pp_gname_mlf gn pp_mllam_mlf c
+      Format.fprintf fmt "@[( %a  %a )@]@\n@." pp_gname_mlf gn pp_mllam_mlf c
   | Gtype (ind, lar) -> (* types are not needed in malfunction, we will leave them as comments *)
     let rec aux s arity =
       if Int.equal arity 0 then s else aux (s^" * Nativevalues.t") (arity-1) in
@@ -2357,10 +2357,10 @@ let pp_global_mlf fmt g =
         pp_gname_mlf gn pp_ldecls_mlf params
         pp_mllam_mlf (MLmatch(annot,a,accu,bs))
   | Gtblfixtype (g, params, t) ->
-      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
+      Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t
   | Gtblnorm (g, params, t) ->
-      Format.fprintf fmt "@[($%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
+      Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t
   (*
   | Gtblcofix (g, params, s) ->

From 5a62b2418e514b4e3e448b7b9dc32188ad3a55ef Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:28:08 +0200
Subject: [PATCH 016/110] refactored some of the code and fixed a bug where ()
 would be translated as $() instead of 0

---
 kernel/nativecode.ml | 14 ++++----------
 1 file changed, 4 insertions(+), 10 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index fd7c2c3d67f4..e06371df3f4a 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1824,7 +1824,8 @@ let pp_gname_mlf fmt g =
     let name = Str.global_replace (Str.regexp_string ".") " $" name in
     Format.fprintf fmt "(global $%s)" name
   end else
-  Format.fprintf fmt "$%s" name
+  if name = "()" then Format.fprintf fmt "0"
+  else Format.fprintf fmt "$%s" name
 
 let pp_lname fmt ln =
   Format.fprintf fmt "x_%s_%i" (string_of_name ln.lname) ln.luid
@@ -2167,20 +2168,13 @@ let pp_mllam_mlf fmt l =
     for i = 0 to len - 1 do
       pp_one_rec defs.(i)
     done
-  and pp_blam_mlf fmt l =
-    match l with
-    | MLprimitive (_, _) | MLlam _ | MLletrec _ | MLlet _ | MLapp _ | MLif _ ->
-        Format.fprintf fmt "(%a)" pp_mllam_mlf l
-    | MLconstruct(_,_,_,args) when Array.length args > 0 ->
-        Format.fprintf fmt "(%a)" pp_mllam_mlf l
-    | _ -> pp_mllam_mlf fmt l
   and pp_args_mlf sep fmt args =
     let sep = if sep then "" else "," in
     let len = Array.length args in
     if len > 0 then begin
-      Format.fprintf fmt "%a" pp_blam_mlf args.(0);
+      Format.fprintf fmt "%a" pp_mllam_mlf args.(0);
       for i = 1 to len - 1 do
-        Format.fprintf fmt "%s@ %a" sep pp_blam_mlf args.(i)
+        Format.fprintf fmt "%s@ %a" sep pp_mllam_mlf args.(i)
       done
     end else Format.fprintf fmt "0" (* 0 is () in malfunction *)
   and pp_primitive_mlf fmt = function

From 5962c7829c5fa5a6da55651d18602f67bb285fba Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:42:37 +0200
Subject: [PATCH 017/110] rt1 and rt2 are now correctly marked as coming from
 the Nativelib module

---
 kernel/nativecode.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index e06371df3f4a..81d247f0c81a 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2093,7 +2093,11 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt ")@]"
       end;
     | MLsetref (s, body) ->
-        Format.fprintf fmt "@[(store $%s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam_mlf body
+        let s = match s with
+          | "rt1" -> "(global $Nativelib $rt1)" (* we have to do this as there is no other indication of the origin of those variables *)
+          | "rt2" -> "(global $Nativelib $rt2)"
+          | s -> "$"^s in
+        Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam_mlf body
     (* | MLmatch (annot, c, accu_br, br) ->
       let ind = annot.asw_ind in
       let prefix = annot.asw_prefix in

From fd8852f8e7c66a5e0d04659bb9037301e74ae445 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 17:04:13 +0200
Subject: [PATCH 018/110] refactored pp_gname_plf

---
 kernel/nativecode.ml | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 81d247f0c81a..5f399e3b2d9f 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1815,17 +1815,20 @@ let string_of_gname g =
   | Gnamed id ->
       Format.sprintf "named_%s" (string_of_id id)
 
-let pp_gname fmt g =
-  Format.fprintf fmt "%s" (string_of_gname g)
-
-let pp_gname_mlf fmt g =
+let string_of_gname_mlf g =
   let name = string_of_gname g in
   if String.contains name '.' then begin (* the global name comes from a module *)
     let name = Str.global_replace (Str.regexp_string ".") " $" name in
-    Format.fprintf fmt "(global $%s)" name
+    Format.sprintf "(global $%s)" name
   end else
-  if name = "()" then Format.fprintf fmt "0"
-  else Format.fprintf fmt "$%s" name
+  if name = "()" then "0"
+  else Format.sprintf "$%s" name
+
+let pp_gname fmt g =
+  Format.fprintf fmt "%s" (string_of_gname g)
+
+let pp_gname_mlf fmt g =
+  Format.fprintf fmt "%s" (string_of_gname_mlf g)
 
 let pp_lname fmt ln =
   Format.fprintf fmt "x_%s_%i" (string_of_name ln.lname) ln.luid

From 8d28a82c2b1c027a0d35a569ba5b68aa31c6c915 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:09:42 +0200
Subject: [PATCH 019/110] Fixed an error whith double dollar signs before
 variables

---
 kernel/nativecode.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 5f399e3b2d9f..0d45a4c05eb7 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2353,7 +2353,7 @@ let pp_global_mlf fmt g =
   | Gopen s ->
       Format.fprintf fmt ";@[open %s@]@." s
   | Gletcase(gn,params,annot,a,accu,bs) ->
-      Format.fprintf fmt "@[; Hash = %i@\n(rec ($%a (lambda (%a)@\n  %a)))@]@\n@."
+      Format.fprintf fmt "@[; Hash = %i@\n(rec (%a (lambda (%a)@\n  %a)))@]@\n@."
       (hash_global g)
         pp_gname_mlf gn pp_ldecls_mlf params
         pp_mllam_mlf (MLmatch(annot,a,accu,bs))

From 3b6b7d3eb5f6cc91ab2259909f3fa29082cffffd Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:10:08 +0200
Subject: [PATCH 020/110] Now compiles match statements

---
 kernel/nativecode.ml | 59 ++++++++++++++++----------------------------
 1 file changed, 21 insertions(+), 38 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 0d45a4c05eb7..fee159f6bef3 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2101,13 +2101,10 @@ let pp_mllam_mlf fmt l =
           | "rt2" -> "(global $Nativelib $rt2)"
           | s -> "$"^s in
         Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam_mlf body
-    (* | MLmatch (annot, c, accu_br, br) ->
-      let ind = annot.asw_ind in
-      let prefix = annot.asw_prefix in
-      let accu = string_of_accu_construct prefix ind in
-      Format.fprintf fmt
-        "@[begin match Obj.magic (%a) with@\n| %s _ ->@\n  %a@\n%aend@]"
-        pp_mllam c accu pp_mllam accu_br (pp_branches prefix ind) br *)
+    | MLmatch (_, c, accu_br, br) ->
+      Format.fprintf fmt (* accumulator is always tag 0 *)
+        "@[(let ($matched_value %a) (switch $matched_value @\n ((tag 0)@\n  %a)@\n%a))@]"
+        pp_mllam_mlf c pp_mllam_mlf accu_br pp_branches_mlf br
     | _ -> Format.fprintf fmt "000"
     (* 
     | MLconstruct(prefix,ind,tag,args) ->
@@ -2127,44 +2124,30 @@ let pp_mllam_mlf fmt l =
     | 1 -> Format.fprintf fmt "@ %a" pp_blam args.(0)
     | _ -> Format.fprintf fmt "@ @[<2>(%a)@]" (pp_args false) args
 
-  and pp_cparam fmt param =
+  *)
+  and pp_cparam_mlf fmt param =
     match param with
-    | Some l -> pp_mllam fmt (MLlocal l)
+    | Some l -> pp_mllam_mlf fmt (MLlocal l)
     | None -> Format.fprintf fmt "_"
-
-  and pp_cparams fmt params =
+  and pp_cparams_mlf fmt params =
     let len = Array.length params in
-    match len with
-    | 0 -> ()
-    | 1 -> Format.fprintf fmt " %a" pp_cparam params.(0)
-    | _ ->
-        let aux fmt params =
-          Format.fprintf fmt "%a" pp_cparam params.(0);
-          for i = 1 to len - 1 do
-            Format.fprintf fmt ",%a" pp_cparam params.(i)
-          done in
-        Format.fprintf fmt "(%a)" aux params
-
-  and pp_branches prefix ind fmt bs =
-    let pp_branch (cargs,body) =
+    for i = 0 to len - 1 do
+      Format.fprintf fmt " ($%a (field $matched_value %i))" pp_cparam_mlf params.(i) i
+    done
+  and pp_branches_mlf fmt bs =
+    let rec pp_branch fmt (cargs,body) =
       let pp_pat fmt = function
         | ConstPattern i ->
-          Format.fprintf fmt "| %s "
-            (string_of_construct prefix ~constant:true ind i)
+          Format.fprintf fmt "%i (let" i
         | NonConstPattern (tag,args) ->
-          Format.fprintf fmt "| %s%a "
-            (string_of_construct prefix ~constant:false ind tag) pp_cparams args in
-      let rec pp_pats fmt pats =
-        match pats with
-        | [] -> ()
-        | pat::pats ->
-          Format.fprintf fmt "%a%a" pp_pat pat pp_pats pats
-      in
-      Format.fprintf fmt "%a ->@\n  %a@\n" pp_pats cargs pp_mllam body
+          Format.fprintf fmt "(tag %i) (let%a"
+            tag pp_cparams_mlf args in
+      match cargs with
+      | [] -> ()
+      | pat::pats -> (* be duplicate the branches because there is no simpler alternative to due to match bindings *)
+        Format.fprintf fmt "(%a@\n  %a))@\n%a" pp_pat pat pp_mllam_mlf body pp_branch (pats, body)
     in
-    Array.iter pp_branch bs
-
-  *)
+    Array.iter (pp_branch fmt) bs
   and pp_letrec_mlf fmt defs =
     let len = Array.length defs in
     let pp_one_rec (fn, argsn, body) =

From a9153b48249374067a3c564186672339b70c6746 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:23:12 +0200
Subject: [PATCH 021/110] Now compiles primitives Mk_fix and Mk_var

---
 kernel/nativecode.ml | 32 ++++++++++++++++++--------------
 1 file changed, 18 insertions(+), 14 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index fee159f6bef3..83915d433634 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2173,18 +2173,22 @@ let pp_mllam_mlf fmt l =
     | Mk_ind -> Format.fprintf fmt "(global $Nativevalues $mk_ind_accu)"
     | Mk_const -> Format.fprintf fmt "(global $Nativevalues $mk_constant_accu)"
     | Mk_sw -> Format.fprintf fmt "(global $Nativevalues $mk_sw_accu)"
-    | Mk_fix(rec_pos,start) -> (* TODO: what is that ??? *)
-        let pp_rec_pos fmt rec_pos =
-          Format.fprintf fmt "@[[| %i" rec_pos.(0);
-          for i = 1 to Array.length rec_pos - 1 do
-            Format.fprintf fmt ";@ %i" rec_pos.(i)
-          done;
-          Format.fprintf fmt " |]@]" in
-        Format.fprintf fmt "mk_fix_accu %a %i" pp_rec_pos rec_pos start
-    | Mk_cofix(start) -> Format.fprintf fmt "mk_cofix_accu %i" start
+    | Mk_fix(rec_pos,start) ->
+        let len = Array.length rec_pos in
+        let rec pp_array_part i =
+          if i < 0 then Format.fprintf fmt "(makevec 0 0)" else
+          if i = 0 then Format.fprintf fmt "(makevec %i %i)" len rec_pos.(0) else begin
+          Format.fprintf fmt "(store@\n";
+          pp_array_part (i-1);
+          Format.fprintf fmt "@%i %i)" i rec_pos.(i)
+        end in
+        Format.fprintf fmt "(apply (global $Nativevalues $mk_fix_accu) @[";
+        pp_array_part (len-1);
+        Format.fprintf fmt "@] %i)" start
+    | Mk_cofix(start) -> Format.fprintf fmt "(apply (global $Nativevalues $mk_cofix_accu) %i)" start
     | Mk_rel i -> Format.fprintf fmt "(apply (global $Nativevalues $mk_rel_accu) %i)" i
     | Mk_var id ->
-        Format.fprintf fmt "mk_var_accu (Names.Id.of_string \"%s\")" (string_of_id id)
+        Format.fprintf fmt "(apply (global $Nativevalues $mk_var_accu) (apply (global $Names $Id $of_string) \"%s\"))" (string_of_id id)
     | Mk_proj -> Format.fprintf fmt "(global $Nativevalues $mk_proj_accu)"
     | Mk_empty_instance -> Format.fprintf fmt "(global $UVars $Instance $empty)"
     | Is_int -> Format.fprintf fmt "(global $Nativevalues $is_int)"
@@ -2200,7 +2204,7 @@ let pp_mllam_mlf fmt l =
     | Mk_int -> Format.fprintf fmt "(global $Nativevalues $mk_int)"
     | Val_to_int -> Format.fprintf fmt "(global $Nativevalues $val_to_int)"
     | Mk_evar -> Format.fprintf fmt "(global $Nativevalues $mk_evar_accu)"
-    | MLand -> Format.fprintf fmt "(&&)"
+    | MLand -> Format.fprintf fmt "(&&)" (* TODO: fix that *)
     | MLnot -> Format.fprintf fmt "(global $not)"
     | MLland -> Format.fprintf fmt "(global $land)"
     | MLmagic -> Format.fprintf fmt "Obj.magic"
@@ -2237,15 +2241,15 @@ let pp_array fmt t =
 
 let pp_array_mlf fmt t =
   let len = Array.length t in
-  let rec aux i =
+  let rec pp_array_part i =
     if i < 0 then Format.fprintf fmt "(makevec 0 0)" else
     if i = 0 then Format.fprintf fmt "(makevec %i %a)" len pp_mllam_mlf t.(0) else begin
     Format.fprintf fmt "(store@\n";
-    aux (i-1);
+    pp_array_part (i-1);
     Format.fprintf fmt "@\n%i %a)" i pp_mllam_mlf t.(i)
   end in
   Format.fprintf fmt "@[<2>";
-  aux (len-1);
+  pp_array_part (len-1);
   Format.fprintf fmt "@]"
 
 let pp_cofix fmt (gn, s) =

From 6ef07512f499e61357a64dce6c893fd322176967 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:35:48 +0200
Subject: [PATCH 022/110] Fixed a double dollar bug and some values being
 wrongly compiled as functions

---
 kernel/nativecode.ml | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 83915d433634..459edc29a9e5 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2132,7 +2132,7 @@ let pp_mllam_mlf fmt l =
   and pp_cparams_mlf fmt params =
     let len = Array.length params in
     for i = 0 to len - 1 do
-      Format.fprintf fmt " ($%a (field $matched_value %i))" pp_cparam_mlf params.(i) i
+      Format.fprintf fmt " (%a (field $matched_value %i))" pp_cparam_mlf params.(i) i
     done
   and pp_branches_mlf fmt bs =
     let rec pp_branch fmt (cargs,body) =
@@ -2339,7 +2339,12 @@ let pp_global_mlf fmt g =
     Format.fprintf fmt "@[;type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
   | Gopen s ->
       Format.fprintf fmt ";@[open %s@]@." s
-  | Gletcase(gn,params,annot,a,accu,bs) ->
+  | Gletcase(gn,[||],annot,a,accu,bs) -> (* simple biding and not a function *)
+      Format.fprintf fmt "@[; Hash = %i@\n(%a %a)@]@\n@." (* no need to be recursive as we are sane and do not create recursive values other than function *)
+      (hash_global g)
+        pp_gname_mlf gn
+        pp_mllam_mlf (MLmatch(annot,a,accu,bs))
+  | Gletcase(gn,params,annot,a,accu,bs) -> (* a function *)
       Format.fprintf fmt "@[; Hash = %i@\n(rec (%a (lambda (%a)@\n  %a)))@]@\n@."
       (hash_global g)
         pp_gname_mlf gn pp_ldecls_mlf params

From d06b9e0236a59f766d4dd02f16ae271a447cf76d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:53:37 +0200
Subject: [PATCH 023/110] Fixed multiple cases where definition would be
 compiled as functions, and string_of_gname_mlf now properly handles wildcards

---
 kernel/nativecode.ml | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 459edc29a9e5..fe89b18b76d9 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1821,8 +1821,10 @@ let string_of_gname_mlf g =
     let name = Str.global_replace (Str.regexp_string ".") " $" name in
     Format.sprintf "(global $%s)" name
   end else
-  if name = "()" then "0"
-  else Format.sprintf "$%s" name
+  match name with
+  | "()" -> "0"
+  | "_" -> "_"
+  | _ -> Format.sprintf "$%s" name
 
 let pp_gname fmt g =
   Format.fprintf fmt "%s" (string_of_gname g)
@@ -2070,6 +2072,8 @@ let pp_mllam_mlf fmt l =
       Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p (pp_args_mlf true) args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname_mlf g
+    | MLapp(f, [||]) -> (* not an application and instead simply a function *)
+        Format.fprintf fmt "@[%a@]" pp_mllam_mlf f
     | MLapp(f, args) ->
         Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f (pp_args_mlf true) args
     | MLlet(id,def,body) ->
@@ -2349,9 +2353,15 @@ let pp_global_mlf fmt g =
       (hash_global g)
         pp_gname_mlf gn pp_ldecls_mlf params
         pp_mllam_mlf (MLmatch(annot,a,accu,bs))
+  | Gtblfixtype (g, [||], t) -> (* not a function but a definition *)
+      Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
+        pp_array_mlf t
   | Gtblfixtype (g, params, t) ->
       Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t
+  | Gtblnorm (g, [||], t) -> (* not a function but a definition *)
+      Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
+        pp_array_mlf t
   | Gtblnorm (g, params, t) ->
       Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t

From c974fe7b004939632f14b634f0e7444daeaf363d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 11:13:59 +0200
Subject: [PATCH 024/110] Now compiles global cofix tables and all global
 declaration !

---
 kernel/nativecode.ml | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index fe89b18b76d9..ecb1ae2ac1cd 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2269,6 +2269,15 @@ let pp_cofix fmt (gn, s) =
   let len = Array.length s in
   Format.fprintf fmt "@[let %a = %a in@\n%a%a@]" pp_gname gn pp_dummy len pp_knot len pp_gname gn
 
+let pp_cofix_mlf fmt (gn, s) =
+  let pp_knot fmt n =
+    for i = 0 to n - 1 do
+      Format.fprintf fmt "@[<2>(store %a %i @[<2>%a@] )@]@\n" pp_gname_mlf gn i pp_mllam_mlf s.(i)
+    done
+  in
+  let len = Array.length s in
+  Format.fprintf fmt "@[(let (%a (makevec %i 0))@\n(seq%a %a))@]" pp_gname_mlf gn len pp_knot len pp_gname_mlf gn
+
 let type_of_global gn c = match gn with
   | Ginternal "symbols_tbl" -> ""
   | _ -> match c with
@@ -2365,14 +2374,14 @@ let pp_global_mlf fmt g =
   | Gtblnorm (g, params, t) ->
       Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t
-  (*
+  | Gtblcofix (g, [||], s) -> (* not a function but a definition *)
+      Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
+        pp_cofix_mlf (g, s);
   | Gtblcofix (g, params, s) ->
-      Format.fprintf fmt "@[let %a%a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname_mlf g
-        pp_ldecls params pp_cofix (g, s);
-   *)
+      Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
+        pp_ldecls_mlf params pp_cofix_mlf (g, s);
   | Gcomment s ->
       List.iter (fun line -> Format.fprintf fmt ";@[ %s @]@." line) (String.split_on_char '\n' s)
-  | _ -> ()
 
 (** Compilation of elements in environment **)
 let rec compile_with_fv ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =

From 8c98c41d1ef77cec540948734f558c1324945618 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 11:49:47 +0200
Subject: [PATCH 025/110] Now compiles MLconstruct and MLisaccu, and thus, all
 mllambda expressions ! also refactored many functions.

---
 kernel/nativecode.ml | 66 +++++++++++++-------------------------------
 1 file changed, 19 insertions(+), 47 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index ecb1ae2ac1cd..4c77a5c74991 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2069,13 +2069,13 @@ let pp_mllam_mlf fmt l =
     | MLsequence(l1,l2) ->
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
     | MLprimitive (p, args) ->
-      Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p (pp_args_mlf true) args
+      Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p pp_args_mlf args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname_mlf g
     | MLapp(f, [||]) -> (* not an application and instead simply a function *)
         Format.fprintf fmt "@[%a@]" pp_mllam_mlf f
     | MLapp(f, args) ->
-        Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f (pp_args_mlf true) args
+        Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f pp_args_mlf args
     | MLlet(id,def,body) ->
         Format.fprintf fmt "@[(let@ ($%a@ %a)@\n@[<2>%a@])@]"
           pp_lname id pp_mllam_mlf def pp_mllam_mlf body
@@ -2107,28 +2107,18 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam_mlf body
     | MLmatch (_, c, accu_br, br) ->
       Format.fprintf fmt (* accumulator is always tag 0 *)
-        "@[(let ($matched_value %a) (switch $matched_value @\n ((tag 0)@\n  %a)@\n%a))@]"
+        "@[(let ($matched_value %a) (switch $matched_value @\n  ((tag 0)@\n  %a)@\n%a))@]"
         pp_mllam_mlf c pp_mllam_mlf accu_br pp_branches_mlf br
-    | _ -> Format.fprintf fmt "000"
-    (* 
-    | MLconstruct(prefix,ind,tag,args) ->
-        Format.fprintf fmt "@[<2>(Obj.magic@ @[<2>(%s%a)@] : Nativevalues.t)@]"
-          (string_of_construct prefix ~constant:false ind tag) pp_cargs args
-    | MLisaccu (prefix, ind, c) ->
-        let accu = string_of_accu_construct prefix ind in
+    | MLconstruct(_,_,tag,[||]) -> (* not a construct but a constant *)
+        Format.fprintf fmt "%i"
+          tag
+    | MLconstruct(_,_,tag,args) ->
+        Format.fprintf fmt "@[<2>(block (tag %i) %a)@]"
+          tag pp_args_mlf args
+    | MLisaccu (_, _, c) ->
         Format.fprintf fmt
-          "@[begin match Obj.magic (%a) with@\n| %s _ ->@\n  true@\n| _ ->@\n  false@\nend@]"
-        pp_mllam c accu *)
-
-  (*
-  and pp_cargs fmt args =
-    let len = Array.length args in
-    match len with
-    | 0 -> ()
-    | 1 -> Format.fprintf fmt "@ %a" pp_blam args.(0)
-    | _ -> Format.fprintf fmt "@ @[<2>(%a)@]" (pp_args false) args
-
-  *)
+          "@[(switch %a@\n  ((tag 0) 1)@\n  (_ (tag _) 0))@]"
+        pp_mllam_mlf c
   and pp_cparam_mlf fmt param =
     match param with
     | Some l -> pp_mllam_mlf fmt (MLlocal l)
@@ -2162,13 +2152,12 @@ let pp_mllam_mlf fmt l =
     for i = 0 to len - 1 do
       pp_one_rec defs.(i)
     done
-  and pp_args_mlf sep fmt args =
-    let sep = if sep then "" else "," in
+  and pp_args_mlf fmt args =
     let len = Array.length args in
     if len > 0 then begin
       Format.fprintf fmt "%a" pp_mllam_mlf args.(0);
       for i = 1 to len - 1 do
-        Format.fprintf fmt "%s@ %a" sep pp_mllam_mlf args.(i)
+        Format.fprintf fmt "@ %a" pp_mllam_mlf args.(i)
       done
     end else Format.fprintf fmt "0" (* 0 is () in malfunction *)
   and pp_primitive_mlf fmt = function
@@ -2244,17 +2233,9 @@ let pp_array fmt t =
   Format.fprintf fmt "|]@]"
 
 let pp_array_mlf fmt t =
-  let len = Array.length t in
-  let rec pp_array_part i =
-    if i < 0 then Format.fprintf fmt "(makevec 0 0)" else
-    if i = 0 then Format.fprintf fmt "(makevec %i %a)" len pp_mllam_mlf t.(0) else begin
-    Format.fprintf fmt "(store@\n";
-    pp_array_part (i-1);
-    Format.fprintf fmt "@\n%i %a)" i pp_mllam_mlf t.(i)
-  end in
-  Format.fprintf fmt "@[<2>";
-  pp_array_part (len-1);
-  Format.fprintf fmt "@]"
+  Format.fprintf fmt "@[<2>(block (tag 0) ";
+  Array.iter (Format.fprintf fmt "@ %a" pp_mllam_mlf) t;
+  Format.fprintf fmt ")@]"
 
 let pp_cofix fmt (gn, s) =
   let pp_dummy fmt len =
@@ -2269,15 +2250,6 @@ let pp_cofix fmt (gn, s) =
   let len = Array.length s in
   Format.fprintf fmt "@[let %a = %a in@\n%a%a@]" pp_gname gn pp_dummy len pp_knot len pp_gname gn
 
-let pp_cofix_mlf fmt (gn, s) =
-  let pp_knot fmt n =
-    for i = 0 to n - 1 do
-      Format.fprintf fmt "@[<2>(store %a %i @[<2>%a@] )@]@\n" pp_gname_mlf gn i pp_mllam_mlf s.(i)
-    done
-  in
-  let len = Array.length s in
-  Format.fprintf fmt "@[(let (%a (makevec %i 0))@\n(seq%a %a))@]" pp_gname_mlf gn len pp_knot len pp_gname_mlf gn
-
 let type_of_global gn c = match gn with
   | Ginternal "symbols_tbl" -> ""
   | _ -> match c with
@@ -2376,10 +2348,10 @@ let pp_global_mlf fmt g =
         pp_ldecls_mlf params pp_array_mlf t
   | Gtblcofix (g, [||], s) -> (* not a function but a definition *)
       Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
-        pp_cofix_mlf (g, s);
+        pp_array_mlf s
   | Gtblcofix (g, params, s) ->
       Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
-        pp_ldecls_mlf params pp_cofix_mlf (g, s);
+        pp_ldecls_mlf params pp_array_mlf s
   | Gcomment s ->
       List.iter (fun line -> Format.fprintf fmt ";@[ %s @]@." line) (String.split_on_char '\n' s)
 

From e472d184df10fb75e7acc24c9dc91c7bd998f3f6 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 14:09:12 +0200
Subject: [PATCH 026/110] Now compiles lazy values  correctly

---
 kernel/nativecode.ml | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 4c77a5c74991..5130f3d59ec5 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2068,6 +2068,8 @@ let pp_mllam_mlf fmt l =
           pp_ldecls_mlf ids pp_mllam_mlf body
     | MLsequence(l1,l2) ->
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
+    | MLprimitive (Lazy, args) -> (* lazy values must be treated separately *)
+      Format.fprintf fmt "@[<2>(lazy@ %a)@]" pp_args_mlf args
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p pp_args_mlf args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
@@ -2197,10 +2199,10 @@ let pp_mllam_mlf fmt l =
     | Mk_int -> Format.fprintf fmt "(global $Nativevalues $mk_int)"
     | Val_to_int -> Format.fprintf fmt "(global $Nativevalues $val_to_int)"
     | Mk_evar -> Format.fprintf fmt "(global $Nativevalues $mk_evar_accu)"
-    | MLand -> Format.fprintf fmt "(&&)" (* TODO: fix that *)
+    | MLand -> Format.fprintf fmt "(lambda ($a $b) (if $a $b 0))"
     | MLnot -> Format.fprintf fmt "(global $not)"
     | MLland -> Format.fprintf fmt "(global $land)"
-    | MLmagic -> Format.fprintf fmt "Obj.magic"
+    | MLmagic -> Format.fprintf fmt "(lambda ($a) $a)"
     | MLsubst_instance_instance -> Format.fprintf fmt "(global $UVars $subst_instance_instance)"
     | MLsubst_instance_sort -> Format.fprintf fmt "(global $UVars $subst_instance_sort)"
     | MLparray_of_array -> Format.fprintf fmt "(global $Nativevalues $parray_of_array)"
@@ -2217,7 +2219,7 @@ let pp_mllam_mlf fmt l =
     | Get_instance -> Format.fprintf fmt "(global $Nativecode $get_instance)"
     | Get_proj -> Format.fprintf fmt "(global $Nativecode $get_proj)"
     | Get_symbols -> Format.fprintf fmt "(global $Nativelib $get_symbols)"
-    | Lazy -> Format.fprintf fmt "(global $lazy)" (* TODO: verify this *)
+    | Lazy -> assert false (* this case has been treated separately in pp_mllam_mlf *)
   in
   Format.fprintf fmt "@[%a@]" pp_mllam_mlf l
 

From 867d435eff8f7a5e46a4f5073decd7d70b7ebb90 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 14:56:50 +0200
Subject: [PATCH 027/110] Started to make a function to call the mlf compiler

---
 kernel/nativelib.ml | 59 +++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 57 insertions(+), 2 deletions(-)

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 58086a30e714..fe33f181f5f9 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -181,14 +181,69 @@ let call_compiler ?profile:(profile=false) ml_filename =
   with Unix.Unix_error (e,_,_) ->
     error_native_compiler_failed (Inr e)
 
+let call_mlf_compiler ?profile:(profile=false) mlf_filename =
+  (* The below path is computed from Require statements, by uniquizing
+     the paths, see [Library.get_used_load_paths] This is in general
+     hacky and we should do a bit better once we move loadpath to its
+     own library *)
+  let require_load_path = !get_load_paths () in
+  (* We assume that installed files always go in .coq-native for now *)
+  (* To ease the build we also consider the current dir, but at some point the build system should manage both *)
+  let install_load_path = List.map (fun dn -> dn / dft_output_dir) require_load_path @ require_load_path in
+  let include_dirs = List.flatten (List.map (fun x -> ["-I"; x]) (get_include_dirs () @ install_load_path)) in
+  let f = Filename.chop_extension mlf_filename in
+  let link_filename = f ^ ".cmo" in
+  let link_filename = Dynlink.adapt_filename link_filename in
+  let remove f = if Sys.file_exists f then Sys.remove f in
+  remove link_filename;
+  remove (f ^ ".cmi");
+  let initial_args =
+    if Dynlink.is_native then
+      ["opt"; "-shared"]
+     else
+      ["ocamlc"; "-c"]
+  in
+  let profile_args =
+    if profile then
+      ["-g"]
+    else
+      []
+  in
+  let flambda_args = if Sys.(backend_type = Native) then ["-Oclassic"] else [] in
+  let args =
+    initial_args @
+      profile_args @
+        flambda_args @
+      ("-o"::link_filename
+       ::"-rectypes"
+       ::"-w"::"a"
+       ::include_dirs) @
+    ["-impl"; mlf_filename] in
+  let ocamlfind = Boot.Env.ocamlfind () in
+
+  debug_native_compiler (fun () -> Pp.str (ocamlfind ^ " " ^ (String.concat " " args)));
+  try
+    let res = CUnix.sys_command ocamlfind args in
+    match res with
+    | Unix.WEXITED 0 -> link_filename
+    | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
+      error_native_compiler_failed (Inl res)
+  with Unix.Unix_error (e,_,_) ->
+    error_native_compiler_failed (Inr e)
+
+let _ = call_mlf_compiler
+
 let compile fn code ~profile:profile =
+  let fn_mlf = (Filename.chop_extension fn) ^ "_mlf.nativemlf" in
   write_ml_code fn code;
-  write_mlf_code (fn ^ "mlf") code;
+  write_mlf_code fn_mlf code;
   let r = call_compiler ~profile fn in
+  (* let r_mlf = call_mlf_compiler ~profile fn_mlf in
+  let _ = r_mlf in *)
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
   delay_cleanup_file fn;
-  delay_cleanup_file (fn ^ "mlf");
+  delay_cleanup_file fn_mlf;
   r
 
 

From 5aa109b90c35fd966a8d16aad835c9e6f7ee3cc4 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 15:30:01 +0200
Subject: [PATCH 028/110] Now correctly compiles uints and floats in 32 and 64
 bits architectures

---
 kernel/float64_common.ml | 5 +++--
 kernel/uint63_31.ml      | 2 +-
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/kernel/float64_common.ml b/kernel/float64_common.ml
index 8d64aa4a5639..4839b3b88b10 100644
--- a/kernel/float64_common.ml
+++ b/kernel/float64_common.ml
@@ -42,8 +42,9 @@ let compile f =
   Printf.sprintf "Float64.of_float (%s)" (to_hex_string f)
 
 (* Compiles a float to malfunction code *)
-let compile_mlf f =
-  Printf.sprintf "(apply (global $Float6 $of_float) (%s))" (to_hex_string f)
+let compile_mlf f = (* malfunction does not support whriting -1.1, so we have to be careful *)
+  if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) (neg.f64 (%s)))" (to_hex_string f)
+  else Printf.sprintf "(apply (global $Float64 $of_float) (%s))" (to_hex_string f)
 
 let of_float f = f
 
diff --git a/kernel/uint63_31.ml b/kernel/uint63_31.ml
index 770714c10734..f23429e658e9 100644
--- a/kernel/uint63_31.ml
+++ b/kernel/uint63_31.ml
@@ -46,7 +46,7 @@ let to_string i = Int64.to_string i
 let compile i = Printf.sprintf "Uint63.of_int64 (%LiL)" i
 
 (* Compiles an unsigned int to malfunction code *)
-let compile_mlf i = Printf.sprintf "(apply (global &Uint63 &of_int64) (%LiL)" i
+let compile_mlf i = Printf.sprintf "(apply (global &Uint63 &of_int64) (%LiL.i64)" i
 
     (* comparison *)
 let lt x y =

From 9f7a637c68ffe86f0918f6d1653682b222e3c1e7 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 15:31:38 +0200
Subject: [PATCH 029/110] Now correctly compiles negative ints

---
 kernel/nativecode.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 5130f3d59ec5..52849c436e77 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2059,7 +2059,8 @@ let pp_mllam_mlf fmt l =
 
   let rec pp_mllam_mlf fmt l =
     match l with
-    | MLint i -> pp_int fmt i
+    | MLint i when i >= 0 -> pp_int fmt i
+    | MLint i -> Format.fprintf fmt "(neg %i)" (-i) (* i < 0 *)
     | MLuint i -> Format.fprintf fmt "(%s)" (Uint63.compile_mlf i)
     | MLfloat f -> Format.fprintf fmt "(%s)" (Float64.compile_mlf f)
     | MLstring s -> Format.fprintf fmt "(%s)" (Pstring.compile_mlf s)

From 988090ef8bcacc8ee59251a61ed8af9176c1c833 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 16:20:36 +0200
Subject: [PATCH 030/110] Refactored code and improved generated code
 identation

---
 kernel/nativecode.ml | 18 ++++--------------
 1 file changed, 4 insertions(+), 14 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 52849c436e77..85e5bb507f8b 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2089,19 +2089,9 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt "@[(let (rec @[<2>%a%a@]))@]" pp_letrec_mlf defs
           pp_mllam_mlf body
     | MLarray arr ->
-      let len = Array.length arr in
-      if Int.equal len 0 then begin
-        Format.fprintf fmt "@[(makevec 0 0)@]"
-      end else if Int.equal len 1 then begin
-        (* We have to emulate a 1-uplet *)
-        Format.fprintf fmt "@[(makevec 1 %a)@]" pp_mllam_mlf arr.(0)
-      end else begin
-        Format.fprintf fmt "@[(block (tag 0)";
-        for i = 0 to len - 1 do
-          Format.fprintf fmt "@ %a" pp_mllam_mlf arr.(i)
-        done;
-        Format.fprintf fmt ")@]"
-      end;
+      Format.fprintf fmt "@[(block (tag 0)";
+      Array.iter (Format.fprintf fmt "@ %a" pp_mllam_mlf) arr;
+      Format.fprintf fmt ")@]"
     | MLsetref (s, body) ->
         let s = match s with
           | "rt1" -> "(global $Nativelib $rt1)" (* we have to do this as there is no other indication of the origin of those variables *)
@@ -2110,7 +2100,7 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam_mlf body
     | MLmatch (_, c, accu_br, br) ->
       Format.fprintf fmt (* accumulator is always tag 0 *)
-        "@[(let ($matched_value %a) (switch $matched_value @\n  ((tag 0)@\n  %a)@\n%a))@]"
+        "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 0)@\n@ @ %a)@\n  @[%a@]))@]"
         pp_mllam_mlf c pp_mllam_mlf accu_br pp_branches_mlf br
     | MLconstruct(_,_,tag,[||]) -> (* not a construct but a constant *)
         Format.fprintf fmt "%i"

From 2c6e11e99bef8abcdaa892ca05781bbdc24eaeaf Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 18:37:23 +0200
Subject: [PATCH 031/110] fixed bugs with uint compilation, refactored code,
 removed useless parentheses and improved identation of the generated code

---
 kernel/nativecode.ml | 52 +++++++++++++++++++-------------------------
 kernel/uint63_31.ml  |  2 +-
 kernel/uint63_63.ml  |  2 +-
 3 files changed, 24 insertions(+), 32 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 85e5bb507f8b..23678a74eb59 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2061,11 +2061,11 @@ let pp_mllam_mlf fmt l =
     match l with
     | MLint i when i >= 0 -> pp_int fmt i
     | MLint i -> Format.fprintf fmt "(neg %i)" (-i) (* i < 0 *)
-    | MLuint i -> Format.fprintf fmt "(%s)" (Uint63.compile_mlf i)
-    | MLfloat f -> Format.fprintf fmt "(%s)" (Float64.compile_mlf f)
-    | MLstring s -> Format.fprintf fmt "(%s)" (Pstring.compile_mlf s)
+    | MLuint i -> Format.fprintf fmt "%s" (Uint63.compile_mlf i)
+    | MLfloat f -> Format.fprintf fmt "%s" (Float64.compile_mlf f)
+    | MLstring s -> Format.fprintf fmt "%s" (Pstring.compile_mlf s)
     | MLlam(ids,body) ->
-        Format.fprintf fmt "@[(lambda (%a) @ %a)@]"
+        Format.fprintf fmt "@[<2>(lambda (%a) @ %a)@]"
           pp_ldecls_mlf ids pp_mllam_mlf body
     | MLsequence(l1,l2) ->
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
@@ -2076,7 +2076,7 @@ let pp_mllam_mlf fmt l =
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname_mlf g
     | MLapp(f, [||]) -> (* not an application and instead simply a function *)
-        Format.fprintf fmt "@[%a@]" pp_mllam_mlf f
+        Format.fprintf fmt "%a" pp_mllam_mlf f
     | MLapp(f, args) ->
         Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f pp_args_mlf args
     | MLlet(id,def,body) ->
@@ -2100,7 +2100,7 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam_mlf body
     | MLmatch (_, c, accu_br, br) ->
       Format.fprintf fmt (* accumulator is always tag 0 *)
-        "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 0)@\n@ @ %a)@\n  @[%a@]))@]"
+        "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 0)@\n    %a)@\n  @[%a@]))@]"
         pp_mllam_mlf c pp_mllam_mlf accu_br pp_branches_mlf br
     | MLconstruct(_,_,tag,[||]) -> (* not a construct but a constant *)
         Format.fprintf fmt "%i"
@@ -2123,16 +2123,16 @@ let pp_mllam_mlf fmt l =
     done
   and pp_branches_mlf fmt bs =
     let rec pp_branch fmt (cargs,body) =
-      let pp_pat fmt = function
-        | ConstPattern i ->
-          Format.fprintf fmt "%i (let" i
-        | NonConstPattern (tag,args) ->
-          Format.fprintf fmt "(tag %i) (let%a"
-            tag pp_cparams_mlf args in
+      let pp_pat_and_block fmt = function
+        | ConstPattern i, body ->
+          Format.fprintf fmt "%i %a" i pp_mllam_mlf body
+        | NonConstPattern (tag,args), body ->
+          Format.fprintf fmt "@[<2>(tag %i) (let%a@\n%a)@]"
+            tag pp_cparams_mlf args pp_mllam_mlf body in
       match cargs with
       | [] -> ()
       | pat::pats -> (* be duplicate the branches because there is no simpler alternative to due to match bindings *)
-        Format.fprintf fmt "(%a@\n  %a))@\n%a" pp_pat pat pp_mllam_mlf body pp_branch (pats, body)
+        Format.fprintf fmt "(%a)@\n%a" pp_pat_and_block (pat, body) pp_branch (pats, body)
     in
     Array.iter (pp_branch fmt) bs
   and pp_letrec_mlf fmt defs =
@@ -2160,17 +2160,9 @@ let pp_mllam_mlf fmt l =
     | Mk_const -> Format.fprintf fmt "(global $Nativevalues $mk_constant_accu)"
     | Mk_sw -> Format.fprintf fmt "(global $Nativevalues $mk_sw_accu)"
     | Mk_fix(rec_pos,start) ->
-        let len = Array.length rec_pos in
-        let rec pp_array_part i =
-          if i < 0 then Format.fprintf fmt "(makevec 0 0)" else
-          if i = 0 then Format.fprintf fmt "(makevec %i %i)" len rec_pos.(0) else begin
-          Format.fprintf fmt "(store@\n";
-          pp_array_part (i-1);
-          Format.fprintf fmt "@%i %i)" i rec_pos.(i)
-        end in
-        Format.fprintf fmt "(apply (global $Nativevalues $mk_fix_accu) @[";
-        pp_array_part (len-1);
-        Format.fprintf fmt "@] %i)" start
+        Format.fprintf fmt "@[<2>(apply (global $Nativevalues $mk_fix_accu) (block (tag 0)";
+        Array.iter (fun i -> Format.fprintf fmt "@\n%a" pp_mllam_mlf (MLint i)) rec_pos;
+        Format.fprintf fmt ")@]@\n %i)" start
     | Mk_cofix(start) -> Format.fprintf fmt "(apply (global $Nativevalues $mk_cofix_accu) %i)" start
     | Mk_rel i -> Format.fprintf fmt "(apply (global $Nativevalues $mk_rel_accu) %i)" i
     | Mk_var id ->
@@ -2226,9 +2218,9 @@ let pp_array fmt t =
   Format.fprintf fmt "|]@]"
 
 let pp_array_mlf fmt t =
-  Format.fprintf fmt "@[<2>(block (tag 0) ";
+  Format.fprintf fmt "(block (tag 0)";
   Array.iter (Format.fprintf fmt "@ %a" pp_mllam_mlf) t;
-  Format.fprintf fmt ")@]"
+  Format.fprintf fmt ")"
 
 let pp_cofix fmt (gn, s) =
   let pp_dummy fmt len =
@@ -2328,16 +2320,16 @@ let pp_global_mlf fmt g =
         pp_gname_mlf gn pp_ldecls_mlf params
         pp_mllam_mlf (MLmatch(annot,a,accu,bs))
   | Gtblfixtype (g, [||], t) -> (* not a function but a definition *)
-      Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
+      Format.fprintf fmt "@[<2>(%a %a)@]@\n@." pp_gname_mlf g
         pp_array_mlf t
   | Gtblfixtype (g, params, t) ->
-      Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
+      Format.fprintf fmt "@[<2>(%a (lambda (%a)@\n%a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t
   | Gtblnorm (g, [||], t) -> (* not a function but a definition *)
-      Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
+      Format.fprintf fmt "@[<2>(%a %a)@]@\n@." pp_gname_mlf g
         pp_array_mlf t
   | Gtblnorm (g, params, t) ->
-      Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
+      Format.fprintf fmt "@[<2>(%a (lambda (%a)@\n%a))@]@\n@." pp_gname_mlf g
         pp_ldecls_mlf params pp_array_mlf t
   | Gtblcofix (g, [||], s) -> (* not a function but a definition *)
       Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
diff --git a/kernel/uint63_31.ml b/kernel/uint63_31.ml
index f23429e658e9..d611dd8a3ce5 100644
--- a/kernel/uint63_31.ml
+++ b/kernel/uint63_31.ml
@@ -46,7 +46,7 @@ let to_string i = Int64.to_string i
 let compile i = Printf.sprintf "Uint63.of_int64 (%LiL)" i
 
 (* Compiles an unsigned int to malfunction code *)
-let compile_mlf i = Printf.sprintf "(apply (global &Uint63 &of_int64) (%LiL.i64)" i
+let compile_mlf i = Printf.sprintf "(apply (global &Uint63 &of_int64) (%LiL.i64))" i
 
     (* comparison *)
 let lt x y =
diff --git a/kernel/uint63_63.ml b/kernel/uint63_63.ml
index 9acada7c4001..11a1a46635e6 100644
--- a/kernel/uint63_63.ml
+++ b/kernel/uint63_63.ml
@@ -44,7 +44,7 @@ let to_string i = Int64.to_string (to_uint64 i)
 let compile i = Printf.sprintf "Uint63.of_int (%i)" i
 
 (* Compiles an unsigned int to malfunction code *)
-let compile_mlf i = Printf.sprintf "(apply (global $Uint63 $of_int) (%i)" i
+let compile_mlf i = Printf.sprintf "(apply (global $Uint63 $of_int) %i)" i
 
 let zero = 0
 let one = 1

From 86120279613d1e8491fc9f447f3e9112f4db723d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 10:16:16 +0200
Subject: [PATCH 032/110] refactored and fixed typos

---
 kernel/float64_common.ml |  2 +-
 kernel/nativecode.ml     | 34 +++++++++++++---------------------
 2 files changed, 14 insertions(+), 22 deletions(-)

diff --git a/kernel/float64_common.ml b/kernel/float64_common.ml
index 4839b3b88b10..7d9b8330869e 100644
--- a/kernel/float64_common.ml
+++ b/kernel/float64_common.ml
@@ -42,7 +42,7 @@ let compile f =
   Printf.sprintf "Float64.of_float (%s)" (to_hex_string f)
 
 (* Compiles a float to malfunction code *)
-let compile_mlf f = (* malfunction does not support whriting -1.1, so we have to be careful *)
+let compile_mlf f = (* malfunction does not support writing -1.1, so we have to be careful *)
   if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) (neg.f64 (%s)))" (to_hex_string f)
   else Printf.sprintf "(apply (global $Float64 $of_float) (%s))" (to_hex_string f)
 
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 23678a74eb59..e3d0a8727f08 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2070,15 +2070,15 @@ let pp_mllam_mlf fmt l =
     | MLsequence(l1,l2) ->
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
     | MLprimitive (Lazy, args) -> (* lazy values must be treated separately *)
-      Format.fprintf fmt "@[<2>(lazy@ %a)@]" pp_args_mlf args
+      Format.fprintf fmt "@[<2>(lazy%a)@]" pp_args_mlf args
     | MLprimitive (p, args) ->
-      Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_primitive_mlf p pp_args_mlf args
+      Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_primitive_mlf p pp_args_mlf args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname_mlf g
     | MLapp(f, [||]) -> (* not an application and instead simply a function *)
         Format.fprintf fmt "%a" pp_mllam_mlf f
     | MLapp(f, args) ->
-        Format.fprintf fmt "@[<2>(apply %a@ %a)@]" pp_mllam_mlf f pp_args_mlf args
+        Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_mllam_mlf f pp_args_mlf args
     | MLlet(id,def,body) ->
         Format.fprintf fmt "@[(let@ ($%a@ %a)@\n@[<2>%a@])@]"
           pp_lname id pp_mllam_mlf def pp_mllam_mlf body
@@ -2106,7 +2106,7 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt "%i"
           tag
     | MLconstruct(_,_,tag,args) ->
-        Format.fprintf fmt "@[<2>(block (tag %i) %a)@]"
+        Format.fprintf fmt "@[<2>(block (tag %i)%a)@]"
           tag pp_args_mlf args
     | MLisaccu (_, _, c) ->
         Format.fprintf fmt
@@ -2136,23 +2136,15 @@ let pp_mllam_mlf fmt l =
     in
     Array.iter (pp_branch fmt) bs
   and pp_letrec_mlf fmt defs =
-    let len = Array.length defs in
     let pp_one_rec (fn, argsn, body) =
-      Format.fprintf fmt "($%a@ %a)"
+      Format.fprintf fmt "($%a@ %a)@\n"
         pp_lname fn
-        pp_mllam_mlf (MLlam(argsn, body));
-      Format.fprintf fmt "@\n" in
-    for i = 0 to len - 1 do
-      pp_one_rec defs.(i)
-    done
+        pp_mllam_mlf (MLlam(argsn, body)) in
+    Array.iter pp_one_rec defs
   and pp_args_mlf fmt args =
-    let len = Array.length args in
-    if len > 0 then begin
-      Format.fprintf fmt "%a" pp_mllam_mlf args.(0);
-      for i = 1 to len - 1 do
-        Format.fprintf fmt "@ %a" pp_mllam_mlf args.(i)
-      done
-    end else Format.fprintf fmt "0" (* 0 is () in malfunction *)
+    if args <> [||] then
+      Array.iter (Format.fprintf fmt "@ %a" pp_mllam_mlf) args
+    else Format.fprintf fmt "@ 0" (* 0 is () in malfunction *)
   and pp_primitive_mlf fmt = function
     | Mk_prod -> Format.fprintf fmt "(global $Nativevalues $mk_prod)"
     | Mk_sort -> Format.fprintf fmt "(global $Nativevalues $mk_sort_accu)"
@@ -2307,10 +2299,10 @@ let pp_global_mlf fmt g =
       Array.iter (pp_const_sig fmt) lar
     in
     Format.fprintf fmt "@[;type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
-  | Gopen s ->
-      Format.fprintf fmt ";@[open %s@]@." s
+  | Gopen _ ->
+      () (* open do not exist in malfunction, and there is no interest in leaving them as comments *)
   | Gletcase(gn,[||],annot,a,accu,bs) -> (* simple biding and not a function *)
-      Format.fprintf fmt "@[; Hash = %i@\n(%a %a)@]@\n@." (* no need to be recursive as we are sane and do not create recursive values other than function *)
+      Format.fprintf fmt "@[; Hash = %i@\n(%a %a)@]@\n@." (* no need to be recursive as we are sane and do not create recursive values other than functions *)
       (hash_global g)
         pp_gname_mlf gn
         pp_mllam_mlf (MLmatch(annot,a,accu,bs))

From 2d07c606bf01903e04cde0228004124f6882d063 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 10:21:41 +0200
Subject: [PATCH 033/110] Now compiles field access correctly

---
 kernel/nativecode.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index e3d0a8727f08..a70c45d35b8d 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2119,7 +2119,7 @@ let pp_mllam_mlf fmt l =
   and pp_cparams_mlf fmt params =
     let len = Array.length params in
     for i = 0 to len - 1 do
-      Format.fprintf fmt " (%a (field $matched_value %i))" pp_cparam_mlf params.(i) i
+      Format.fprintf fmt " (%a (field %i $matched_value))" pp_cparam_mlf params.(i) i
     done
   and pp_branches_mlf fmt bs =
     let rec pp_branch fmt (cargs,body) =

From 7bc7c2860711ddee901bb9724acc8516cfcc0d10 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 10:22:01 +0200
Subject: [PATCH 034/110] the malfunction compiler is now called

---
 kernel/nativelib.ml | 31 +++++++++++++++----------------
 1 file changed, 15 insertions(+), 16 deletions(-)

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index fe33f181f5f9..e6428d6b73b1 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -197,11 +197,11 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
   let remove f = if Sys.file_exists f then Sys.remove f in
   remove link_filename;
   remove (f ^ ".cmi");
-  let initial_args =
-    if Dynlink.is_native then
+  let initial_args = ["cmo"]
+    (* if Dynlink.is_native then
       ["opt"; "-shared"]
      else
-      ["ocamlc"; "-c"]
+      ["ocamlc"; "-c"] *)
   in
   let profile_args =
     if profile then
@@ -209,21 +209,22 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
     else
       []
   in
-  let flambda_args = if Sys.(backend_type = Native) then ["-Oclassic"] else [] in
+  (* let flambda_args = if Sys.(backend_type = Native) then ["-Oclassic"] else [] in *)
   let args =
     initial_args @
+      [mlf_filename] @
       profile_args @
-        flambda_args @
+        (* flambda_args @ *)
       ("-o"::link_filename
-       ::"-rectypes"
-       ::"-w"::"a"
-       ::include_dirs) @
-    ["-impl"; mlf_filename] in
-  let ocamlfind = Boot.Env.ocamlfind () in
+       (* ::"-rectypes" *)
+       (* ::"-w"::"a" *)
+       ::include_dirs) in
+  (* let ocamlfind = Boot.Env.ocamlfind () in *)
+  let malfunction = "malfunction" in
 
-  debug_native_compiler (fun () -> Pp.str (ocamlfind ^ " " ^ (String.concat " " args)));
+  debug_native_compiler (fun () -> Pp.str (malfunction ^ " " ^ (String.concat " " args)));
   try
-    let res = CUnix.sys_command ocamlfind args in
+    let res = CUnix.sys_command malfunction args in
     match res with
     | Unix.WEXITED 0 -> link_filename
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
@@ -231,15 +232,13 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
   with Unix.Unix_error (e,_,_) ->
     error_native_compiler_failed (Inr e)
 
-let _ = call_mlf_compiler
-
 let compile fn code ~profile:profile =
   let fn_mlf = (Filename.chop_extension fn) ^ "_mlf.nativemlf" in
   write_ml_code fn code;
   write_mlf_code fn_mlf code;
   let r = call_compiler ~profile fn in
-  (* let r_mlf = call_mlf_compiler ~profile fn_mlf in
-  let _ = r_mlf in *)
+  let r_mlf = call_mlf_compiler ~profile fn_mlf in
+  let _ = r_mlf in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
   delay_cleanup_file fn;

From ab1de573ebc71011ad97efa21b84ed2e1ed62ff9 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 10:37:05 +0200
Subject: [PATCH 035/110] letrec are now compiled properly

---
 kernel/nativecode.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index a70c45d35b8d..4be0d9970f19 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2086,7 +2086,7 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt "@[(if %a@\n  %a@\n  %a)@]"
           pp_mllam_mlf t pp_mllam_mlf l1 pp_mllam_mlf l2
     | MLletrec(defs, body) ->
-        Format.fprintf fmt "@[(let (rec @[<2>%a%a@]))@]" pp_letrec_mlf defs
+        Format.fprintf fmt "@[<2>(let (rec @[<2>%a@])@\n%a)@]" pp_letrec_mlf defs
           pp_mllam_mlf body
     | MLarray arr ->
       Format.fprintf fmt "@[(block (tag 0)";

From 2ad5d7e7aae0ea92a7c24459c0e2357f21554d28 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 13:52:24 +0200
Subject: [PATCH 036/110] compiled mlf programs now generate mli files and
 import each other

---
 kernel/nativecode.ml  | 24 ++++++++++++++++++++++--
 kernel/nativecode.mli |  2 ++
 kernel/nativelib.ml   | 17 +++++++++++++----
 3 files changed, 37 insertions(+), 6 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 4be0d9970f19..da40b799ee65 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1818,8 +1818,15 @@ let string_of_gname g =
 let string_of_gname_mlf g =
   let name = string_of_gname g in
   if String.contains name '.' then begin (* the global name comes from a module *)
-    let name = Str.global_replace (Str.regexp_string ".") " $" name in
-    Format.sprintf "(global $%s)" name
+    let name = String.split_on_char '.' name in
+    let name = match name with
+      | [] -> []
+      | modul::rest when String.starts_with ~prefix:"Coq_native" modul ->
+        (modul^"_mlf")::rest (* we try to access ml values that had just been compiled, we instead decide to access the corresponding mlf values *)
+      | name -> name in
+    let name = List.map ((^) " $") name in
+    let name = List.fold_left (^) "" name in
+    Format.sprintf "(global%s)" name
   end else
   match name with
   | "()" -> "0"
@@ -2332,6 +2339,19 @@ let pp_global_mlf fmt g =
   | Gcomment s ->
       List.iter (fun line -> Format.fprintf fmt ";@[ %s @]@." line) (String.split_on_char '\n' s)
 
+let global_to_mlf_name g =
+  match g with
+  | Gtblfixtype (gn,_,_)
+  | Gtblnorm (gn,_,_)
+  | Gtblcofix (gn,_,_)
+  | Gletcase(gn,_,_,_,_,_)
+  | Glet (gn,_) ->
+    let gn = string_of_gname_mlf gn in
+    if gn = "_" then None else Some gn 
+  | Gtype _
+  | Gcomment _
+  | Gopen _ -> None
+
 (** Compilation of elements in environment **)
 let rec compile_with_fv ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
   let const_prefix c = get_const_prefix env c in
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index cdfc23705900..f5c715bd74be 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -32,6 +32,8 @@ val pp_global : Format.formatter -> global -> unit
 
 val pp_global_mlf : Format.formatter -> global -> unit
 
+val global_to_mlf_name : global -> string option
+
 val mk_open : string -> global
 
 val get_value : symbols -> int -> Nativevalues.t
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index e6428d6b73b1..3e30befbd41c 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -117,8 +117,17 @@ let write_mlf_code fn ?(header=[]) code =
   let fmt = Format.formatter_of_out_channel ch_out in
   Format.fprintf fmt "@[(module@]@\n";
   List.iter (pp_global_mlf fmt) (header@code);
-  Format.fprintf fmt "@[(_ 0) (export))@]@.";
-  close_out ch_out
+  Format.fprintf fmt "@[(export";
+  List.iter (Format.fprintf fmt " %s") (List.map_filter global_to_mlf_name code);
+  Format.fprintf fmt "))@]@.";
+  close_out ch_out;
+  let ch_mli_out = open_out ((Filename.chop_extension fn)^".mli") in
+  let fmt = Format.formatter_of_out_channel ch_mli_out in
+  Format.fprintf fmt "type t\n";
+  let defined_values = List.map_filter global_to_mlf_name code in
+  let defined_values = List.map (fun s -> String.sub s 1 ((String.length s)-1)) defined_values in
+  List.iter (Format.fprintf fmt "val %s : t\n") defined_values;
+  close_out ch_mli_out
 
 let error_native_compiler_failed e =
   let msg = match e with
@@ -197,7 +206,7 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
   let remove f = if Sys.file_exists f then Sys.remove f in
   remove link_filename;
   remove (f ^ ".cmi");
-  let initial_args = ["cmo"]
+  let initial_args = ["cmx"]
     (* if Dynlink.is_native then
       ["opt"; "-shared"]
      else
@@ -224,6 +233,7 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
 
   debug_native_compiler (fun () -> Pp.str (malfunction ^ " " ^ (String.concat " " args)));
   try
+    let _ = CUnix.sys_command "ocamlc" ["-opaque"; "-c"; f^".mli"] in
     let res = CUnix.sys_command malfunction args in
     match res with
     | Unix.WEXITED 0 -> link_filename
@@ -245,7 +255,6 @@ let compile fn code ~profile:profile =
   delay_cleanup_file fn_mlf;
   r
 
-
 type native_library = Nativecode.global list * Nativevalues.symbols
 
 let compile_library (code, symb) fn =

From c3918aa120a574a440f54765c5fc3f224a1b1420 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 16:08:52 +0200
Subject: [PATCH 037/110] Cleaned code and did a small fix

---
 kernel/nativelib.ml | 28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 3e30befbd41c..a71af3a5f884 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -126,7 +126,7 @@ let write_mlf_code fn ?(header=[]) code =
   Format.fprintf fmt "type t\n";
   let defined_values = List.map_filter global_to_mlf_name code in
   let defined_values = List.map (fun s -> String.sub s 1 ((String.length s)-1)) defined_values in
-  List.iter (Format.fprintf fmt "val %s : t\n") defined_values;
+  List.iter (Format.fprintf fmt "val %s : t\n@.") defined_values;
   close_out ch_mli_out
 
 let error_native_compiler_failed e =
@@ -206,12 +206,7 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
   let remove f = if Sys.file_exists f then Sys.remove f in
   remove link_filename;
   remove (f ^ ".cmi");
-  let initial_args = ["cmx"]
-    (* if Dynlink.is_native then
-      ["opt"; "-shared"]
-     else
-      ["ocamlc"; "-c"] *)
-  in
+  let initial_args = ["cmx"] in
   let profile_args =
     if profile then
       ["-g"]
@@ -230,15 +225,24 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
        ::include_dirs) in
   (* let ocamlfind = Boot.Env.ocamlfind () in *)
   let malfunction = "malfunction" in
-
+  let ocamlfind = Boot.Env.ocamlfind () in
   debug_native_compiler (fun () -> Pp.str (malfunction ^ " " ^ (String.concat " " args)));
   try
-    let _ = CUnix.sys_command "ocamlc" ["-opaque"; "-c"; f^".mli"] in
-    let res = CUnix.sys_command malfunction args in
-    match res with
+    let res1 = CUnix.sys_command ocamlfind ["ocamlc"; "-opaque"; "-c"; f^".mli"] in
+    let res2 = CUnix.sys_command malfunction args in
+    let res3 = if Dynlink.is_native then CUnix.sys_command ocamlfind ["opt"; "-shared"; "-o"; f^".cmxs"; f^".cmx"] else Unix.WEXITED 0 in
+    let _ = match res1 with
+    | Unix.WEXITED 0 -> ()
+    | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
+      error_native_compiler_failed (Inl res1) in
+    let _ = match res1 with
+    | Unix.WEXITED 0 -> ()
+    | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
+      error_native_compiler_failed (Inl res2) in
+    match res1 with
     | Unix.WEXITED 0 -> link_filename
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
-      error_native_compiler_failed (Inl res)
+      error_native_compiler_failed (Inl res3)
   with Unix.Unix_error (e,_,_) ->
     error_native_compiler_failed (Inr e)
 

From d538c9f5bd4b516b8d35db46c9b6269666de81e1 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 16:31:16 +0200
Subject: [PATCH 038/110] ML primitives without arguments are now correctly
 compiled as values and not function applications

---
 kernel/nativecode.ml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index da40b799ee65..ba6158cfa65d 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2078,6 +2078,8 @@ let pp_mllam_mlf fmt l =
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
     | MLprimitive (Lazy, args) -> (* lazy values must be treated separately *)
       Format.fprintf fmt "@[<2>(lazy%a)@]" pp_args_mlf args
+    | MLprimitive (p, [||]) -> (* not a function and just a value *)
+      Format.fprintf fmt "%a" pp_primitive_mlf p
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_primitive_mlf p pp_args_mlf args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln

From a707d7391622c894a8c0ab32535029acaa2c6c67 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 17:30:37 +0200
Subject: [PATCH 039/110] Compilation now works perfectly

---
 kernel/nativelib.ml | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index a71af3a5f884..6b00a8d2ecc0 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -220,7 +220,7 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
       profile_args @
         (* flambda_args @ *)
       ("-o"::link_filename
-       (* ::"-rectypes" *)
+       ::"-rectypes"
        (* ::"-w"::"a" *)
        ::include_dirs) in
   (* let ocamlfind = Boot.Env.ocamlfind () in *)
@@ -248,16 +248,15 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
 
 let compile fn code ~profile:profile =
   let fn_mlf = (Filename.chop_extension fn) ^ "_mlf.nativemlf" in
-  write_ml_code fn code;
+  (* write_ml_code fn code; *)
   write_mlf_code fn_mlf code;
-  let r = call_compiler ~profile fn in
+  (* let r = call_compiler ~profile fn in *)
   let r_mlf = call_mlf_compiler ~profile fn_mlf in
-  let _ = r_mlf in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
-  delay_cleanup_file fn;
+  (* delay_cleanup_file fn; *)
   delay_cleanup_file fn_mlf;
-  r
+  r_mlf
 
 type native_library = Nativecode.global list * Nativevalues.symbols
 

From 788da359666c4facc93302f087bdcb965b6ceede Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 11:28:02 +0200
Subject: [PATCH 040/110] Cleaned generated code and fixed ml primitives being
 imported from the wrong module

---
 kernel/nativecode.ml | 18 ++++++++++++------
 kernel/uint63_31.ml  |  4 +++-
 kernel/uint63_63.ml  |  4 +++-
 3 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index ba6158cfa65d..98bed8cb7a2d 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2076,6 +2076,12 @@ let pp_mllam_mlf fmt l =
           pp_ldecls_mlf ids pp_mllam_mlf body
     | MLsequence(l1,l2) ->
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
+    | MLprimitive (MLland, args) -> (* malfunction has a special operator for logical and *)
+      Format.fprintf fmt "(& %a)" pp_args_mlf args
+    | MLprimitive (MLnot, args) ->
+      Format.fprintf fmt "(== 0 %a)" pp_args_mlf args
+    | MLprimitive (MLmagic, args) -> (* Obj.magic is unneeded in malfunction *)
+      Format.fprintf fmt "%a" pp_args_mlf args
     | MLprimitive (Lazy, args) -> (* lazy values must be treated separately *)
       Format.fprintf fmt "@[<2>(lazy%a)@]" pp_args_mlf args
     | MLprimitive (p, [||]) -> (* not a function and just a value *)
@@ -2184,15 +2190,12 @@ let pp_mllam_mlf fmt l =
     | Val_to_int -> Format.fprintf fmt "(global $Nativevalues $val_to_int)"
     | Mk_evar -> Format.fprintf fmt "(global $Nativevalues $mk_evar_accu)"
     | MLand -> Format.fprintf fmt "(lambda ($a $b) (if $a $b 0))"
-    | MLnot -> Format.fprintf fmt "(global $not)"
-    | MLland -> Format.fprintf fmt "(global $land)"
-    | MLmagic -> Format.fprintf fmt "(lambda ($a) $a)"
     | MLsubst_instance_instance -> Format.fprintf fmt "(global $UVars $subst_instance_instance)"
     | MLsubst_instance_sort -> Format.fprintf fmt "(global $UVars $subst_instance_sort)"
     | MLparray_of_array -> Format.fprintf fmt "(global $Nativevalues $parray_of_array)"
     | Coq_primitive (op, false) ->
-       Format.fprintf fmt "(global $Nativelib $no_check_%s)" (CPrimitives.to_string op)
-    | Coq_primitive (op, true) -> Format.fprintf fmt "(global $Nativelib $%s)" (CPrimitives.to_string op)
+       Format.fprintf fmt "(global $Nativevalues $no_check_%s)" (CPrimitives.to_string op)
+    | Coq_primitive (op, true) -> Format.fprintf fmt "(global $Nativevalues $%s)" (CPrimitives.to_string op)
     | Get_value -> Format.fprintf fmt "(global $Nativecode $get_value)"
     | Get_sort -> Format.fprintf fmt "(global $Nativecode $get_sort)"
     | Get_name -> Format.fprintf fmt "(global $Nativecode $get_name)"
@@ -2203,7 +2206,10 @@ let pp_mllam_mlf fmt l =
     | Get_instance -> Format.fprintf fmt "(global $Nativecode $get_instance)"
     | Get_proj -> Format.fprintf fmt "(global $Nativecode $get_proj)"
     | Get_symbols -> Format.fprintf fmt "(global $Nativelib $get_symbols)"
-    | Lazy -> assert false (* this case has been treated separately in pp_mllam_mlf *)
+    | MLnot
+    | MLland
+    | MLmagic
+    | Lazy -> assert false (* theses cases has been treated separately in pp_mllam_mlf *)
   in
   Format.fprintf fmt "@[%a@]" pp_mllam_mlf l
 
diff --git a/kernel/uint63_31.ml b/kernel/uint63_31.ml
index d611dd8a3ce5..820e332f82ce 100644
--- a/kernel/uint63_31.ml
+++ b/kernel/uint63_31.ml
@@ -46,7 +46,9 @@ let to_string i = Int64.to_string i
 let compile i = Printf.sprintf "Uint63.of_int64 (%LiL)" i
 
 (* Compiles an unsigned int to malfunction code *)
-let compile_mlf i = Printf.sprintf "(apply (global &Uint63 &of_int64) (%LiL.i64))" i
+let compile_mlf i =
+  if Int64.compare i 0L >= 0 then Printf.sprintf "(apply (global &Uint63 &of_int64) %Li.i64)" i (* the internal value (a signed integer) is positive *)
+  else Printf.sprintf "(apply (global &Uint63 &of_int64) (neg.i64 %Li.i64))" (Int64.neg i) (* the internal value is negative and we must take it into account *)
 
     (* comparison *)
 let lt x y =
diff --git a/kernel/uint63_63.ml b/kernel/uint63_63.ml
index 11a1a46635e6..99347be4c135 100644
--- a/kernel/uint63_63.ml
+++ b/kernel/uint63_63.ml
@@ -44,7 +44,9 @@ let to_string i = Int64.to_string (to_uint64 i)
 let compile i = Printf.sprintf "Uint63.of_int (%i)" i
 
 (* Compiles an unsigned int to malfunction code *)
-let compile_mlf i = Printf.sprintf "(apply (global $Uint63 $of_int) %i)" i
+let compile_mlf i =
+  if i >= 0 then Printf.sprintf "(apply (global $Uint63 $of_int) %i)" i
+  else Printf.sprintf "(apply (global $Uint63 $of_int) (neg %i))" (-i)
 
 let zero = 0
 let one = 1

From dea39995e9928e899dd542dedee8fdcc253cbb30 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 13:22:09 +0200
Subject: [PATCH 041/110] Fixed Lazy.force being incorrectly compiled

---
 kernel/nativecode.ml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 98bed8cb7a2d..7b208cbd9211 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2092,6 +2092,8 @@ let pp_mllam_mlf fmt l =
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname_mlf g
     | MLapp(f, [||]) -> (* not an application and instead simply a function *)
         Format.fprintf fmt "%a" pp_mllam_mlf f
+    | MLapp(MLglobal (Ginternal "Lazy.force"), args) -> (* force has to be hardcoded as mlf won't let us bypass the force keyword *)
+        Format.fprintf fmt "@[<2>(force%a)@]" pp_args_mlf args
     | MLapp(f, args) ->
         Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_mllam_mlf f pp_args_mlf args
     | MLlet(id,def,body) ->

From 7b90bb85db73deda03d444be9672d1317edfffb8 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 13:44:54 +0200
Subject: [PATCH 042/110] Fixed an error in string compilation

---
 kernel/pstring.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/pstring.ml b/kernel/pstring.ml
index e6552edc0a27..0b833d89729c 100644
--- a/kernel/pstring.ml
+++ b/kernel/pstring.ml
@@ -78,4 +78,4 @@ let compile : t -> string =
   Printf.sprintf "Pstring.unsafe_of_string %S"
 
 let compile_mlf : t -> string =
-  Printf.sprintf "(apply (global $Pstring$ $unsafe_of_string) %S)"
+  Printf.sprintf "(apply (global $Pstring $unsafe_of_string) %S)"

From 8fc86af4263ab9c3b1ad4a22e03aabb7beebc1c3 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 15:58:23 +0200
Subject: [PATCH 043/110] Generated interface is now compatible with Ocaml
 native compilation

---
 kernel/nativecode.ml |  4 +---
 kernel/nativelib.ml  | 13 ++++++-------
 2 files changed, 7 insertions(+), 10 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 7b208cbd9211..54087a5b1269 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1821,8 +1821,6 @@ let string_of_gname_mlf g =
     let name = String.split_on_char '.' name in
     let name = match name with
       | [] -> []
-      | modul::rest when String.starts_with ~prefix:"Coq_native" modul ->
-        (modul^"_mlf")::rest (* we try to access ml values that had just been compiled, we instead decide to access the corresponding mlf values *)
       | name -> name in
     let name = List.map ((^) " $") name in
     let name = List.fold_left (^) "" name in
@@ -2357,7 +2355,7 @@ let global_to_mlf_name g =
   | Gletcase(gn,_,_,_,_,_)
   | Glet (gn,_) ->
     let gn = string_of_gname_mlf gn in
-    if gn = "_" then None else Some gn 
+    if gn = "_" then None else Some gn
   | Gtype _
   | Gcomment _
   | Gopen _ -> None
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 6b00a8d2ecc0..74036b1bda5c 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -123,10 +123,9 @@ let write_mlf_code fn ?(header=[]) code =
   close_out ch_out;
   let ch_mli_out = open_out ((Filename.chop_extension fn)^".mli") in
   let fmt = Format.formatter_of_out_channel ch_mli_out in
-  Format.fprintf fmt "type t\n";
   let defined_values = List.map_filter global_to_mlf_name code in
   let defined_values = List.map (fun s -> String.sub s 1 ((String.length s)-1)) defined_values in
-  List.iter (Format.fprintf fmt "val %s : t\n@.") defined_values;
+  List.iter (Format.fprintf fmt "val %s : Nativevalues.t Lazy.t\n@.") defined_values;
   close_out ch_mli_out
 
 let error_native_compiler_failed e =
@@ -228,7 +227,7 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
   let ocamlfind = Boot.Env.ocamlfind () in
   debug_native_compiler (fun () -> Pp.str (malfunction ^ " " ^ (String.concat " " args)));
   try
-    let res1 = CUnix.sys_command ocamlfind ["ocamlc"; "-opaque"; "-c"; f^".mli"] in
+    let res1 = CUnix.sys_command ocamlfind (["ocamlc"; "-opaque"; "-c"; f^".mli"]@include_dirs) in
     let res2 = CUnix.sys_command malfunction args in
     let res3 = if Dynlink.is_native then CUnix.sys_command ocamlfind ["opt"; "-shared"; "-o"; f^".cmxs"; f^".cmx"] else Unix.WEXITED 0 in
     let _ = match res1 with
@@ -247,15 +246,15 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
     error_native_compiler_failed (Inr e)
 
 let compile fn code ~profile:profile =
-  let fn_mlf = (Filename.chop_extension fn) ^ "_mlf.nativemlf" in
+  (* let fn_mlf = (Filename.chop_extension fn) ^ "_mlf.nativemlf" in *)
   (* write_ml_code fn code; *)
-  write_mlf_code fn_mlf code;
+  write_mlf_code fn code;
   (* let r = call_compiler ~profile fn in *)
-  let r_mlf = call_mlf_compiler ~profile fn_mlf in
+  let r_mlf = call_mlf_compiler ~profile fn in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
   (* delay_cleanup_file fn; *)
-  delay_cleanup_file fn_mlf;
+  delay_cleanup_file fn;
   r_mlf
 
 type native_library = Nativecode.global list * Nativevalues.symbols

From 3e3a42d4486860e6a19c528aa374233ac3451b30 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 16:31:57 +0200
Subject: [PATCH 044/110] .mli interfaces now contains defined types

---
 kernel/nativecode.ml  | 13 ++++++++++++-
 kernel/nativecode.mli |  2 ++
 kernel/nativelib.ml   |  2 ++
 3 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 54087a5b1269..60398a46e989 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1302,7 +1302,7 @@ let compile_prim env decl cond paux =
   else
     add_decl decl (compile_cond cond paux)
 
- let rec ml_of_lam env l t =
+let rec ml_of_lam env l t =
   match node t with
   | Lrel(id ,i) -> get_rel env id i
   | Lvar id -> get_var env id
@@ -2360,6 +2360,17 @@ let global_to_mlf_name g =
   | Gcomment _
   | Gopen _ -> None
 
+let is_type_decl g =
+  match g with
+  | Gtblfixtype _
+  | Gtblnorm _
+  | Gtblcofix _
+  | Gletcase _
+  | Gcomment _
+  | Gopen _
+  | Glet _ -> false
+  | Gtype _ -> true
+
 (** Compilation of elements in environment **)
 let rec compile_with_fv ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
   let const_prefix c = get_const_prefix env c in
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index f5c715bd74be..5403bbd3adef 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -34,6 +34,8 @@ val pp_global_mlf : Format.formatter -> global -> unit
 
 val global_to_mlf_name : global -> string option
 
+val is_type_decl : global -> bool
+
 val mk_open : string -> global
 
 val get_value : symbols -> int -> Nativevalues.t
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 74036b1bda5c..2d3b3d3b40ed 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -123,6 +123,8 @@ let write_mlf_code fn ?(header=[]) code =
   close_out ch_out;
   let ch_mli_out = open_out ((Filename.chop_extension fn)^".mli") in
   let fmt = Format.formatter_of_out_channel ch_mli_out in
+  let defined_types = List.filter is_type_decl code in
+  List.iter (pp_global fmt) defined_types; (* we define types in the .mli as they would have been in the .ml to allow Ocaml code to interface with it *)
   let defined_values = List.map_filter global_to_mlf_name code in
   let defined_values = List.map (fun s -> String.sub s 1 ((String.length s)-1)) defined_values in
   List.iter (Format.fprintf fmt "val %s : Nativevalues.t Lazy.t\n@.") defined_values;

From 406f5acae68f648e97ec07baeab3d80ef089aea4 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 12 Jun 2026 10:02:58 +0200
Subject: [PATCH 045/110] refactored code, and generated interfaces now have
 types more coherent with inner value

---
 kernel/nativecode.ml  | 34 ++++++++++++++++++++++++++--------
 kernel/nativecode.mli |  2 +-
 kernel/nativelib.ml   |  6 +-----
 3 files changed, 28 insertions(+), 14 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 60398a46e989..11b651c3526f 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2360,16 +2360,34 @@ let global_to_mlf_name g =
   | Gcomment _
   | Gopen _ -> None
 
-let is_type_decl g =
+let pp_global_interface fmt g =
   match g with
-  | Gtblfixtype _
-  | Gtblnorm _
-  | Gtblcofix _
-  | Gletcase _
+  | Gtblnorm (ident, args, _)
+  | Gtblcofix (ident, args, _)
+  | Gtblfixtype (ident, args, _) ->
+    let ident = string_of_gname ident in
+    Format.fprintf fmt "val %s : " ident;
+    for _ = 0 to Array.length args do
+      Format.fprintf fmt "Nativevalues.t -> "
+    done;
+    Format.fprintf fmt "Nativevalues.t array\n@."
+  | Gletcase (ident, args, _,_,_,_) ->
+    let ident = string_of_gname ident in
+    Format.fprintf fmt "val %s : " ident;
+    for _ = 0 to Array.length args do
+      Format.fprintf fmt "Nativevalues.t -> "
+    done;
+    Format.fprintf fmt "Nativevalues.t\n@."
   | Gcomment _
-  | Gopen _
-  | Glet _ -> false
-  | Gtype _ -> true
+  | Glet (Ginternal "_", _)
+  | Gopen _ -> ()
+  | Glet (Ginternal "symbols_tbl", _) -> (* for strange reasons, type_of_global will return "" for symbols_tbl, so we have to treat it separately *)
+      Format.fprintf fmt "val symbols_tbl : Nativevalues.t\n@."
+  | Glet (ident, lam) ->
+    let typ = type_of_global ident lam in
+    let ident = string_of_gname ident in
+      Format.fprintf fmt "val %s%s\n@." ident typ
+  | Gtype _ -> pp_global fmt g
 
 (** Compilation of elements in environment **)
 let rec compile_with_fv ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index 5403bbd3adef..ec19ea5e9b64 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -34,7 +34,7 @@ val pp_global_mlf : Format.formatter -> global -> unit
 
 val global_to_mlf_name : global -> string option
 
-val is_type_decl : global -> bool
+val pp_global_interface : Format.formatter -> global -> unit
 
 val mk_open : string -> global
 
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 2d3b3d3b40ed..20bbdac05ca3 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -123,11 +123,7 @@ let write_mlf_code fn ?(header=[]) code =
   close_out ch_out;
   let ch_mli_out = open_out ((Filename.chop_extension fn)^".mli") in
   let fmt = Format.formatter_of_out_channel ch_mli_out in
-  let defined_types = List.filter is_type_decl code in
-  List.iter (pp_global fmt) defined_types; (* we define types in the .mli as they would have been in the .ml to allow Ocaml code to interface with it *)
-  let defined_values = List.map_filter global_to_mlf_name code in
-  let defined_values = List.map (fun s -> String.sub s 1 ((String.length s)-1)) defined_values in
-  List.iter (Format.fprintf fmt "val %s : Nativevalues.t Lazy.t\n@.") defined_values;
+  List.iter (pp_global_interface fmt) code;
   close_out ch_mli_out
 
 let error_native_compiler_failed e =

From a92cac258bfa8604523caddecbfbc620fb720327 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 12 Jun 2026 14:01:41 +0200
Subject: [PATCH 046/110] Now correctly compiles floats, Array.get and cofix

---
 kernel/float64_common.ml |  4 ++--
 kernel/nativecode.ml     | 11 ++++++++---
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/kernel/float64_common.ml b/kernel/float64_common.ml
index 7d9b8330869e..ed0982af24ec 100644
--- a/kernel/float64_common.ml
+++ b/kernel/float64_common.ml
@@ -43,8 +43,8 @@ let compile f =
 
 (* Compiles a float to malfunction code *)
 let compile_mlf f = (* malfunction does not support writing -1.1, so we have to be careful *)
-  if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) (neg.f64 (%s)))" (to_hex_string f)
-  else Printf.sprintf "(apply (global $Float64 $of_float) (%s))" (to_hex_string f)
+  if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) (neg.f64 %.17e))" (-. f) (* malfunction supports scientific notation *)
+  else Printf.sprintf "(apply (global $Float64 $of_float) %.17e)" f
 
 let of_float f = f
 
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 11b651c3526f..98d1b30b1231 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2082,6 +2082,8 @@ let pp_mllam_mlf fmt l =
       Format.fprintf fmt "%a" pp_args_mlf args
     | MLprimitive (Lazy, args) -> (* lazy values must be treated separately *)
       Format.fprintf fmt "@[<2>(lazy%a)@]" pp_args_mlf args
+    | MLprimitive (Array_get, args) ->
+      Format.fprintf fmt "@[<2>(load%a)@]" pp_args_mlf args
     | MLprimitive (p, [||]) -> (* not a function and just a value *)
       Format.fprintf fmt "%a" pp_primitive_mlf p
     | MLprimitive (p, args) ->
@@ -2181,7 +2183,6 @@ let pp_mllam_mlf fmt l =
     | Is_string -> Format.fprintf fmt "(global $Nativevalues $is_string)"
     | Is_parray -> Format.fprintf fmt "(global $Nativevalues $is_parray)"
     | Cast_accu -> Format.fprintf fmt "(global $Nativevalues $cast_accu)"
-    | Array_get -> Format.fprintf fmt "(global $Stdlib $Array $get)"
     | Force_cofix -> Format.fprintf fmt "(global $Nativevalues $force_cofix)"
     | Mk_uint -> Format.fprintf fmt "(global $Nativevalues $mk_uint)"
     | Mk_float -> Format.fprintf fmt "(global $Nativevalues $mk_float)"
@@ -2206,6 +2207,7 @@ let pp_mllam_mlf fmt l =
     | Get_instance -> Format.fprintf fmt "(global $Nativecode $get_instance)"
     | Get_proj -> Format.fprintf fmt "(global $Nativecode $get_proj)"
     | Get_symbols -> Format.fprintf fmt "(global $Nativelib $get_symbols)"
+    | Array_get
     | MLnot
     | MLland
     | MLmagic
@@ -2242,6 +2244,9 @@ let pp_cofix fmt (gn, s) =
   let len = Array.length s in
   Format.fprintf fmt "@[let %a = %a in@\n%a%a@]" pp_gname gn pp_dummy len pp_knot len pp_gname gn
 
+let pp_cofix_mlf fmt (gn, s) =
+  Format.fprintf fmt "@[(let (rec (%a (lazy %a))) (force %a))@]" pp_gname_mlf gn pp_array_mlf s pp_gname_mlf gn
+
 let type_of_global gn c = match gn with
   | Ginternal "symbols_tbl" -> ""
   | _ -> match c with
@@ -2340,10 +2345,10 @@ let pp_global_mlf fmt g =
         pp_ldecls_mlf params pp_array_mlf t
   | Gtblcofix (g, [||], s) -> (* not a function but a definition *)
       Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
-        pp_array_mlf s
+        pp_cofix_mlf (g, s)
   | Gtblcofix (g, params, s) ->
       Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
-        pp_ldecls_mlf params pp_array_mlf s
+        pp_ldecls_mlf params pp_cofix_mlf (g, s)
   | Gcomment s ->
       List.iter (fun line -> Format.fprintf fmt ";@[ %s @]@." line) (String.split_on_char '\n' s)
 

From d112f42f8a8e058330c506948b8038b03247432b Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Sat, 13 Jun 2026 14:13:50 +0200
Subject: [PATCH 047/110] Now correctly compiles cofix

---
 kernel/nativecode.ml | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 98d1b30b1231..dbd856ddfdba 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2245,6 +2245,30 @@ let pp_cofix fmt (gn, s) =
   Format.fprintf fmt "@[let %a = %a in@\n%a%a@]" pp_gname gn pp_dummy len pp_knot len pp_gname gn
 
 let pp_cofix_mlf fmt (gn, s) =
+  let subst_gname gn v l =
+    let rec aux l =
+      match l with
+      | MLglobal id when eq_gname gn id -> v
+      | MLglobal _ | MLlocal _ | MLint _ | MLuint _ | MLfloat _ | MLstring _ -> l
+      | MLprimitive (p, args) -> MLprimitive (p, Array.map aux args)
+      | MLlam(params,body) -> MLlam(params, aux body)
+      | MLletrec(defs,body) ->
+        let arec (f,params,body) = (f,params,aux body) in
+        MLletrec(Array.map arec defs, aux body)
+      | MLlet(id,def,body) -> MLlet(id,aux def, aux body)
+      | MLapp(f,args) -> MLapp(aux f, Array.map aux args)
+      | MLif(t,b1,b2) -> MLif(aux t, aux b1, aux b2)
+      | MLmatch(annot,a,accu,bs) ->
+          let auxb (cargs,body) = (cargs,aux body) in
+          MLmatch(annot,a,aux accu, Array.map auxb bs)
+      | MLconstruct(prefix,c,tag,args) -> MLconstruct(prefix,c,tag,Array.map aux args)
+      | MLsetref(s,l1) -> MLsetref(s,aux l1)
+      | MLsequence(l1,l2) -> MLsequence(aux l1, aux l2)
+      | MLarray arr -> MLarray (Array.map aux arr)
+      | MLisaccu (s, ind, l) -> MLisaccu (s, ind, aux l)
+    in
+    aux l
+  in let s = Array.map (subst_gname gn (MLapp(MLglobal (Ginternal "Lazy.force"), [|MLglobal gn|])) ) s in
   Format.fprintf fmt "@[(let (rec (%a (lazy %a))) (force %a))@]" pp_gname_mlf gn pp_array_mlf s pp_gname_mlf gn
 
 let type_of_global gn c = match gn with

From 1a6a8058a106769546d442abcd5f7cfac7978f56 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 15 Jun 2026 10:16:35 +0200
Subject: [PATCH 048/110] removed now unecessary code

---
 kernel/nativelib.ml  | 6 ------
 kernel/nativelib.mli | 2 --
 2 files changed, 8 deletions(-)

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 20bbdac05ca3..773fa183d0c6 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -98,12 +98,6 @@ let get_ml_filename () =
   let prefix = Filename.chop_extension (Filename.basename filename) ^ "." in
   filename, prefix
 
-let get_mlf_filename () =
-  let temp_dir = force_temp_dir() in
-  let filename = Filename.temp_file ~temp_dir "Coq_native" (source_ext^"mlf") in
-  let prefix = Filename.chop_extension (Filename.basename filename) ^ "." in
-  filename, prefix
-
 let write_ml_code fn ?(header=[]) code =
   let header = open_header@header in
   let ch_out = open_out fn in
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index 9ed97ee83b5d..650047464281 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -24,8 +24,6 @@ val load_obj : (string -> unit) ref
 
 val get_ml_filename : unit -> string * string
 
-val get_mlf_filename : unit -> string * string
-
 (** [compile file code ~profile] will compile native [code] to [file],
    and return the name of the object file; this name depends on
    whether are in byte mode or not; file is expected to be .ml file *)

From f02c67d1f91dc16ac357cf14c524f2ab9bda5b44 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 15 Jun 2026 14:26:01 +0200
Subject: [PATCH 049/110] Now correctly handles nan and infinity

---
 kernel/float64_common.ml | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/kernel/float64_common.ml b/kernel/float64_common.ml
index ed0982af24ec..2fd84570205a 100644
--- a/kernel/float64_common.ml
+++ b/kernel/float64_common.ml
@@ -43,7 +43,11 @@ let compile f =
 
 (* Compiles a float to malfunction code *)
 let compile_mlf f = (* malfunction does not support writing -1.1, so we have to be careful *)
-  if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) (neg.f64 %.17e))" (-. f) (* malfunction supports scientific notation *)
+  if Float.is_nan f then "(apply (global $Float64 $of_float) nan)"
+  else if Float.is_infinite f then begin
+    if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) neg_infinity)"
+    else Printf.sprintf "(apply (global $Float64 $of_float) infinity)"
+  end else if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) (neg.f64 %.17e))" (-. f) (* malfunction supports scientific notation *)
   else Printf.sprintf "(apply (global $Float64 $of_float) %.17e)" f
 
 let of_float f = f

From adc655a86c00b21ce19aa9237b3f7e42ebb19540 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 15 Jun 2026 14:29:16 +0200
Subject: [PATCH 050/110] Now handles decode_string and compilation in specific
 folders

---
 kernel/nativecode.ml | 12 +++++++++---
 kernel/nativelib.ml  |  6 +++---
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index dbd856ddfdba..151f37fb03d5 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -292,6 +292,7 @@ type primitive =
   | Lazy
   | Coq_primitive of CPrimitives.t * bool (* check for accu *)
   | Mk_empty_instance
+  | Str_decode
 
 let eq_primitive p1 p2 =
   match p1, p2 with
@@ -333,6 +334,7 @@ let eq_primitive p1 p2 =
   | Get_symbols, Get_symbols
   | Lazy, Lazy
   | Mk_empty_instance, Mk_empty_instance
+  | Str_decode, Str_decode
     -> true
 
   | Mk_fix (rp1, i1), Mk_fix (rp2, i2) -> Int.equal i1 i2 && eq_rec_pos rp1 rp2
@@ -384,7 +386,8 @@ let eq_primitive p1 p2 =
     | Get_symbols
     | Lazy
     | Coq_primitive _
-    | Mk_empty_instance), _
+    | Mk_empty_instance
+    | Str_decode), _
     -> false
 
 let primitive_hash = function
@@ -436,6 +439,7 @@ let primitive_hash = function
   | Lazy -> 42
   | Mk_empty_instance -> 43
   | Mk_string -> 44
+  | Str_decode -> 45
 
 type mllambda =
   | MLlocal        of lname
@@ -1827,6 +1831,7 @@ let string_of_gname_mlf g =
     Format.sprintf "(global%s)" name
   end else
   match name with
+  | s when String.length s > 0 && s.[0] = '"' -> s
   | "()" -> "0"
   | "_" -> "_"
   | _ -> Format.sprintf "$%s" name
@@ -2056,6 +2061,7 @@ let pp_mllam fmt l =
     | Get_proj -> Format.fprintf fmt "get_proj"
     | Get_symbols -> Format.fprintf fmt "get_symbols"
     | Lazy -> Format.fprintf fmt "lazy"
+    | Str_decode -> Format.fprintf fmt "str_decode"
   in
   Format.fprintf fmt "@[%a@]" pp_mllam l
 
@@ -2207,6 +2213,7 @@ let pp_mllam_mlf fmt l =
     | Get_instance -> Format.fprintf fmt "(global $Nativecode $get_instance)"
     | Get_proj -> Format.fprintf fmt "(global $Nativecode $get_proj)"
     | Get_symbols -> Format.fprintf fmt "(global $Nativelib $get_symbols)"
+    | Str_decode -> Format.fprintf fmt "(global $Nativevalues $str_decode)"
     | Array_get
     | MLnot
     | MLland
@@ -2735,8 +2742,7 @@ let mk_norm_code env sigma prefix t =
   header::gl, symbols, (mind_updates, const_updates)
 
 let mk_library_header (symbols : Nativevalues.symbols) =
-  let symbols = Format.sprintf "(str_decode \"%s\")" (str_encode symbols) in
-  [Glet(Ginternal "symbols_tbl", MLglobal (Ginternal symbols))]
+  [Glet(Ginternal "symbols_tbl", MLprimitive (Str_decode, [|MLglobal (Ginternal ("\"" ^ (str_encode symbols) ^ "\""))|]))]
 
 let update_location r =
   r.upd_info := Linked r.upd_prefix
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 773fa183d0c6..81756887efc2 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -212,9 +212,9 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
         (* flambda_args @ *)
       ("-o"::link_filename
        ::"-rectypes"
+       ::"-I"::(Filename.dirname mlf_filename)
        (* ::"-w"::"a" *)
        ::include_dirs) in
-  (* let ocamlfind = Boot.Env.ocamlfind () in *)
   let malfunction = "malfunction" in
   let ocamlfind = Boot.Env.ocamlfind () in
   debug_native_compiler (fun () -> Pp.str (malfunction ^ " " ^ (String.concat " " args)));
@@ -226,11 +226,11 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
     | Unix.WEXITED 0 -> ()
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
       error_native_compiler_failed (Inl res1) in
-    let _ = match res1 with
+    let _ = match res2 with
     | Unix.WEXITED 0 -> ()
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
       error_native_compiler_failed (Inl res2) in
-    match res1 with
+    match res3 with
     | Unix.WEXITED 0 -> link_filename
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
       error_native_compiler_failed (Inl res3)

From a1d3c2c61b21640570827c4ed55fdfc95c7cb467 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 15 Jun 2026 15:31:22 +0200
Subject: [PATCH 051/110] Went back to simpler mli generation as interfacing
 with Ocaml will no longer be needed

---
 kernel/nativecode.ml | 29 +++++++----------------------
 kernel/nativelib.ml  |  1 +
 2 files changed, 8 insertions(+), 22 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 151f37fb03d5..07da3861a051 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2398,31 +2398,16 @@ let global_to_mlf_name g =
 
 let pp_global_interface fmt g =
   match g with
-  | Gtblnorm (ident, args, _)
-  | Gtblcofix (ident, args, _)
-  | Gtblfixtype (ident, args, _) ->
+  | Gtblnorm (ident, _,_)
+  | Gtblcofix (ident, _,_)
+  | Gtblfixtype (ident, _,_)
+  | Gletcase (ident, _,_,_,_,_)
+  | Glet (ident, _) ->
     let ident = string_of_gname ident in
-    Format.fprintf fmt "val %s : " ident;
-    for _ = 0 to Array.length args do
-      Format.fprintf fmt "Nativevalues.t -> "
-    done;
-    Format.fprintf fmt "Nativevalues.t array\n@."
-  | Gletcase (ident, args, _,_,_,_) ->
-    let ident = string_of_gname ident in
-    Format.fprintf fmt "val %s : " ident;
-    for _ = 0 to Array.length args do
-      Format.fprintf fmt "Nativevalues.t -> "
-    done;
-    Format.fprintf fmt "Nativevalues.t\n@."
+    if ident <> "_" then
+      Format.fprintf fmt "val %s : t@." ident
   | Gcomment _
-  | Glet (Ginternal "_", _)
   | Gopen _ -> ()
-  | Glet (Ginternal "symbols_tbl", _) -> (* for strange reasons, type_of_global will return "" for symbols_tbl, so we have to treat it separately *)
-      Format.fprintf fmt "val symbols_tbl : Nativevalues.t\n@."
-  | Glet (ident, lam) ->
-    let typ = type_of_global ident lam in
-    let ident = string_of_gname ident in
-      Format.fprintf fmt "val %s%s\n@." ident typ
   | Gtype _ -> pp_global fmt g
 
 (** Compilation of elements in environment **)
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 81756887efc2..c943babda281 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -117,6 +117,7 @@ let write_mlf_code fn ?(header=[]) code =
   close_out ch_out;
   let ch_mli_out = open_out ((Filename.chop_extension fn)^".mli") in
   let fmt = Format.formatter_of_out_channel ch_mli_out in
+  Format.fprintf fmt "type t\n";
   List.iter (pp_global_interface fmt) code;
   close_out ch_mli_out
 

From c6545e3f99f1f7d41657c3a0a3a5576fe5c0b7c5 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 10:04:20 +0200
Subject: [PATCH 052/110] removed Ocaml compilation

---
 kernel/nativeconv.ml    |  2 +-
 kernel/nativelib.ml     | 73 +++++------------------------------------
 kernel/nativelib.mli    |  2 +-
 pretyping/nativenorm.ml |  2 +-
 4 files changed, 11 insertions(+), 68 deletions(-)

diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 0b40d61b78e9..83216e242b01 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -189,7 +189,7 @@ let warn_no_native_compiler =
 
 let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
   Nativelib.link_libraries ();
-  let ml_filename, prefix = Nativelib.get_ml_filename () in
+  let ml_filename, prefix = Nativelib.get_mlf_filename () in
   let code, symbols, upds = mk_conv_code env sigma prefix t1 t2 in
   let fn = Nativelib.compile ml_filename code ~profile:false in
   debug_native_compiler (fun () -> Pp.str "Running test...");
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index c943babda281..3d967c5e5f69 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -92,19 +92,12 @@ let rt2 = ref None
 
 let get_symbols () = !rsymbols
 
-let get_ml_filename () =
+let get_mlf_filename () =
   let temp_dir = force_temp_dir() in
   let filename = Filename.temp_file ~temp_dir "Coq_native" source_ext in
   let prefix = Filename.chop_extension (Filename.basename filename) ^ "." in
   filename, prefix
 
-let write_ml_code fn ?(header=[]) code =
-  let header = open_header@header in
-  let ch_out = open_out fn in
-  let fmt = Format.formatter_of_out_channel ch_out in
-  List.iter (pp_global fmt) (header@code);
-  close_out ch_out
-
 let write_mlf_code fn ?(header=[]) code =
   let header = open_header@header in
   let ch_out = open_out fn in
@@ -133,56 +126,7 @@ let error_native_compiler_failed e =
   in
   CErrors.user_err msg
 
-let call_compiler ?profile:(profile=false) ml_filename =
-  (* The below path is computed from Require statements, by uniquizing
-     the paths, see [Library.get_used_load_paths] This is in general
-     hacky and we should do a bit better once we move loadpath to its
-     own library *)
-  let require_load_path = !get_load_paths () in
-  (* We assume that installed files always go in .coq-native for now *)
-  (* To ease the build we also consider the current dir, but at some point the build system should manage both *)
-  let install_load_path = List.map (fun dn -> dn / dft_output_dir) require_load_path @ require_load_path in
-  let include_dirs = List.flatten (List.map (fun x -> ["-I"; x]) (get_include_dirs () @ install_load_path)) in
-  let f = Filename.chop_extension ml_filename in
-  let link_filename = f ^ ".cmo" in
-  let link_filename = Dynlink.adapt_filename link_filename in
-  let remove f = if Sys.file_exists f then Sys.remove f in
-  remove link_filename;
-  remove (f ^ ".cmi");
-  let initial_args =
-    if Dynlink.is_native then
-      ["opt"; "-shared"]
-     else
-      ["ocamlc"; "-c"]
-  in
-  let profile_args =
-    if profile then
-      ["-g"]
-    else
-      []
-  in
-  let flambda_args = if Sys.(backend_type = Native) then ["-Oclassic"] else [] in
-  let args =
-    initial_args @
-      profile_args @
-        flambda_args @
-      ("-o"::link_filename
-       ::"-rectypes"
-       ::"-w"::"a"
-       ::include_dirs) @
-    ["-impl"; ml_filename] in
-  let ocamlfind = Boot.Env.ocamlfind () in
-  debug_native_compiler (fun () -> Pp.str (ocamlfind ^ " " ^ (String.concat " " args)));
-  try
-    let res = CUnix.sys_command ocamlfind args in
-    match res with
-    | Unix.WEXITED 0 -> link_filename
-    | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
-      error_native_compiler_failed (Inl res)
-  with Unix.Unix_error (e,_,_) ->
-    error_native_compiler_failed (Inr e)
-
-let call_mlf_compiler ?profile:(profile=false) mlf_filename =
+let call_compiler ?profile:(profile=false) mlf_filename =
   (* The below path is computed from Require statements, by uniquizing
      the paths, see [Library.get_used_load_paths] This is in general
      hacky and we should do a bit better once we move loadpath to its
@@ -226,29 +170,28 @@ let call_mlf_compiler ?profile:(profile=false) mlf_filename =
     let _ = match res1 with
     | Unix.WEXITED 0 -> ()
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
+      Format.printf "1@.";
       error_native_compiler_failed (Inl res1) in
     let _ = match res2 with
     | Unix.WEXITED 0 -> ()
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
+      Format.printf "2@.";
       error_native_compiler_failed (Inl res2) in
     match res3 with
     | Unix.WEXITED 0 -> link_filename
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
+      Format.printf "3@.";
       error_native_compiler_failed (Inl res3)
   with Unix.Unix_error (e,_,_) ->
     error_native_compiler_failed (Inr e)
 
 let compile fn code ~profile:profile =
-  (* let fn_mlf = (Filename.chop_extension fn) ^ "_mlf.nativemlf" in *)
-  (* write_ml_code fn code; *)
   write_mlf_code fn code;
-  (* let r = call_compiler ~profile fn in *)
-  let r_mlf = call_mlf_compiler ~profile fn in
+  let r = call_compiler ~profile fn in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
-  (* delay_cleanup_file fn; *)
   delay_cleanup_file fn;
-  r_mlf
+  r
 
 type native_library = Nativecode.global list * Nativevalues.symbols
 
@@ -263,7 +206,7 @@ let compile_library (code, symb) fn =
     with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
   in
   let fn = dirname / basename in
-  write_ml_code fn ~header code;
+  write_mlf_code fn ~header code;
   let _ = call_compiler fn in
   delay_cleanup_file fn
 
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index 650047464281..b58c414d31a6 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -22,7 +22,7 @@ val get_load_paths : (unit -> string list) ref
 
 val load_obj : (string -> unit) ref
 
-val get_ml_filename : unit -> string * string
+val get_mlf_filename : unit -> string * string
 
 (** [compile file code ~profile] will compile native [code] to [file],
    and return the name of the object file; this name depends on
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index fea696a3867a..d65d09c47f93 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -497,7 +497,7 @@ let native_norm env sigma c ty =
   let ty = EConstr.Unsafe.to_constr ty in
     let profile = get_profiling_enabled () in
     let print_timing = get_timing_enabled () in
-    let ml_filename, prefix = Nativelib.get_ml_filename () in
+    let ml_filename, prefix = Nativelib.get_mlf_filename () in
     let tnc0 = Unix.gettimeofday () in
     let code, symbols, upd = mk_norm_code env (evars_of_evar_map sigma) prefix c in
     let tnc1 = Unix.gettimeofday () in

From c0a6506f8f1e702af95cc98e674b89f0bd02e4d0 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 10:17:44 +0200
Subject: [PATCH 053/110] Added cleaner debug messages and error handling

---
 kernel/nativelib.ml | 54 +++++++++++++++++++++++++--------------------
 1 file changed, 30 insertions(+), 24 deletions(-)

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 3d967c5e5f69..8e89a68d2029 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -114,15 +114,15 @@ let write_mlf_code fn ?(header=[]) code =
   List.iter (pp_global_interface fmt) code;
   close_out ch_mli_out
 
-let error_native_compiler_failed e =
+let error_native_compiler_failed e head =
   let msg = match e with
-  | Inl (Unix.WEXITED 127) -> Pp.(strbrk "The OCaml compiler was not found. Make sure it is installed, together with findlib.")
+  | Inl (Unix.WEXITED 127) -> Pp.(strbrk head ++ str "The OCaml compiler was not found. Make sure it is installed, together with findlib.")
   | Inl (Unix.WEXITED n) ->
-     Pp.(strbrk "Native compiler exited with status" ++ str" " ++ int n
+     Pp.(strbrk head ++ str "Native compiler exited with status" ++ str" " ++ int n
          ++ strbrk (if n = 2 then " (in case of stack overflow, increasing stack size (typically with \"ulimit -s\") often helps)" else ""))
-  | Inl (Unix.WSIGNALED n) -> Pp.(strbrk "Native compiler killed by signal" ++ str" " ++ int n)
-  | Inl (Unix.WSTOPPED n) -> Pp.(strbrk "Native compiler stopped by signal" ++ str" " ++ int n)
-  | Inr e -> Pp.(strbrk "Native compiler failed with error: " ++ strbrk (Unix.error_message e))
+  | Inl (Unix.WSIGNALED n) -> Pp.(strbrk head ++ str "Native compiler killed by signal" ++ str" " ++ int n)
+  | Inl (Unix.WSTOPPED n) -> Pp.(strbrk head ++ str "Native compiler stopped by signal" ++ str" " ++ int n)
+  | Inr e -> Pp.(strbrk head ++ str "Native compiler failed with error: " ++ strbrk (Unix.error_message e))
   in
   CErrors.user_err msg
 
@@ -142,7 +142,6 @@ let call_compiler ?profile:(profile=false) mlf_filename =
   let remove f = if Sys.file_exists f then Sys.remove f in
   remove link_filename;
   remove (f ^ ".cmi");
-  let initial_args = ["cmx"] in
   let profile_args =
     if profile then
       ["-g"]
@@ -151,8 +150,7 @@ let call_compiler ?profile:(profile=false) mlf_filename =
   in
   (* let flambda_args = if Sys.(backend_type = Native) then ["-Oclassic"] else [] in *)
   let args =
-    initial_args @
-      [mlf_filename] @
+      ["cmx"; mlf_filename] @
       profile_args @
         (* flambda_args @ *)
       ("-o"::link_filename
@@ -160,30 +158,38 @@ let call_compiler ?profile:(profile=false) mlf_filename =
        ::"-I"::(Filename.dirname mlf_filename)
        (* ::"-w"::"a" *)
        ::include_dirs) in
+  let ocamlc_args = ["ocamlc"; "-opaque"; "-c"; f^".mli"]@include_dirs in
+  let ocamlopt_args = ["opt"; "-shared"; "-o"; f^".cmxs"; f^".cmx"] in
   let malfunction = "malfunction" in
   let ocamlfind = Boot.Env.ocamlfind () in
-  debug_native_compiler (fun () -> Pp.str (malfunction ^ " " ^ (String.concat " " args)));
-  try
-    let res1 = CUnix.sys_command ocamlfind (["ocamlc"; "-opaque"; "-c"; f^".mli"]@include_dirs) in
-    let res2 = CUnix.sys_command malfunction args in
-    let res3 = if Dynlink.is_native then CUnix.sys_command ocamlfind ["opt"; "-shared"; "-o"; f^".cmxs"; f^".cmx"] else Unix.WEXITED 0 in
-    let _ = match res1 with
+  begin try
+    debug_native_compiler (fun () -> Pp.str (ocamlfind ^ " " ^ (String.concat " " ocamlc_args)));
+    let res = CUnix.sys_command ocamlfind ocamlc_args in
+    match res with
     | Unix.WEXITED 0 -> ()
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
-      Format.printf "1@.";
-      error_native_compiler_failed (Inl res1) in
-    let _ = match res2 with
+      error_native_compiler_failed (Inl res) "During .cmi generation: "
+  with Unix.Unix_error (e,_,_) ->
+    error_native_compiler_failed (Inr e) "During .cmi generation: "
+  end; begin try
+    debug_native_compiler (fun () -> Pp.str (malfunction ^ " " ^ (String.concat " " args)));
+    let res = CUnix.sys_command malfunction args in
+    match res with
     | Unix.WEXITED 0 -> ()
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
-      Format.printf "2@.";
-      error_native_compiler_failed (Inl res2) in
-    match res3 with
+      error_native_compiler_failed (Inl res) "During .mlf compilation: "
+  with Unix.Unix_error (e,_,_) ->
+    error_native_compiler_failed (Inr e) "During .mlf compilation: "
+  end; begin try
+    debug_native_compiler (fun () -> Pp.str (ocamlfind ^ " " ^ (String.concat " " ocamlopt_args)));
+    let res = if Dynlink.is_native then CUnix.sys_command ocamlfind ocamlopt_args else Unix.WEXITED 0 in
+    match res with
     | Unix.WEXITED 0 -> link_filename
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
-      Format.printf "3@.";
-      error_native_compiler_failed (Inl res3)
+      error_native_compiler_failed (Inl res) "During .cmxs generation"
   with Unix.Unix_error (e,_,_) ->
-    error_native_compiler_failed (Inr e)
+    error_native_compiler_failed (Inr e) "During .cmxs generation"
+  end
 
 let compile fn code ~profile:profile =
   write_mlf_code fn code;

From 530b3b9d123c74bb4e1a6222c444c1790f61f420 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 10:22:52 +0200
Subject: [PATCH 054/110] removed most of Ocaml code generation

---
 kernel/nativecode.ml  | 301 +++---------------------------------------
 kernel/nativecode.mli |   2 -
 2 files changed, 19 insertions(+), 284 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 07da3861a051..e455b9a78a35 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1836,21 +1836,12 @@ let string_of_gname_mlf g =
   | "_" -> "_"
   | _ -> Format.sprintf "$%s" name
 
-let pp_gname fmt g =
-  Format.fprintf fmt "%s" (string_of_gname g)
-
 let pp_gname_mlf fmt g =
   Format.fprintf fmt "%s" (string_of_gname_mlf g)
 
 let pp_lname fmt ln =
   Format.fprintf fmt "x_%s_%i" (string_of_name ln.lname) ln.luid
 
-let pp_ldecls fmt ids =
-  let len = Array.length ids in
-  for i = 0 to len - 1 do
-    Format.fprintf fmt " (%a : Nativevalues.t)" pp_lname ids.(i)
-  done
-
 let pp_ldecls_mlf fmt ids =
     let len = Array.length ids in
     if len = 0 then Format.fprintf fmt "$_" else (* argument list cannot be empty in malfunction *)
@@ -1868,204 +1859,6 @@ let string_of_accu_construct prefix ind =
 let pp_int fmt i =
   if i < 0 then Format.fprintf fmt "(%i)" i else Format.fprintf fmt "%i" i
 
-let pp_mllam fmt l =
-
-  let rec pp_mllam fmt l =
-    match l with
-    | MLlocal ln -> Format.fprintf fmt "@[%a@]" pp_lname ln
-    | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
-    | MLprimitive (p, args) ->
-      Format.fprintf fmt "@[<2>%a@ %a@]" pp_primitive p (pp_args true) args
-    | MLlam(ids,body) ->
-        Format.fprintf fmt "@[(fun%a ->@ %a)@]"
-          pp_ldecls ids pp_mllam body
-    | MLletrec(defs, body) ->
-        Format.fprintf fmt "@[(%a@ in@\n%a)@]" pp_letrec defs
-          pp_mllam body
-    | MLlet(id,def,body) ->
-        Format.fprintf fmt "@[(@[let@ %a@ =@ %a@ in@]@\n%a)@]"
-          pp_lname id pp_mllam def pp_mllam body
-    | MLapp(f, args) ->
-        Format.fprintf fmt "@[<2>%a@ %a@]" pp_mllam f (pp_args true) args
-    | MLif(t,l1,l2) ->
-        Format.fprintf fmt "@[(if %a then@\n  %a@\nelse@\n  %a)@]"
-          pp_mllam t pp_mllam l1 pp_mllam l2
-    | MLmatch (annot, c, accu_br, br) ->
-      let ind = annot.asw_ind in
-      let prefix = annot.asw_prefix in
-      let accu = string_of_accu_construct prefix ind in
-      Format.fprintf fmt
-        "@[begin match Obj.magic (%a) with@\n| %s _ ->@\n  %a@\n%aend@]"
-        pp_mllam c accu pp_mllam accu_br (pp_branches prefix ind) br
-
-    | MLconstruct(prefix,ind,tag,args) ->
-        Format.fprintf fmt "@[<2>(Obj.magic@ @[<2>(%s%a)@] : Nativevalues.t)@]"
-          (string_of_construct prefix ~constant:false ind tag) pp_cargs args
-    | MLint i -> pp_int fmt i
-    | MLuint i -> Format.fprintf fmt "(%s)" (Uint63.compile i)
-    | MLfloat f -> Format.fprintf fmt "(%s)" (Float64.compile f)
-    | MLstring s -> Format.fprintf fmt "(%s)" (Pstring.compile s)
-    | MLsetref (s, body) ->
-        Format.fprintf fmt "@[%s@ :=@\n Some (%a)@]" s pp_mllam body
-    | MLsequence(l1,l2) ->
-        Format.fprintf fmt "@[%a;@\n%a@]" pp_mllam l1 pp_mllam l2
-    | MLarray arr ->
-      (* We need to ensure that the array does not use the flat representation
-          if ever the first argument is a float *)
-      let len = Array.length arr in
-      if Int.equal len 0 then begin
-        Format.fprintf fmt "@[(Obj.magic [||])@]"
-      end else if Int.equal len 1 then begin
-        (* We have to emulate a 1-uplet *)
-        Format.fprintf fmt "@[(Obj.magic (ref (%a)))@]" pp_mllam arr.(0)
-      end else begin
-        Format.fprintf fmt "@[(Obj.magic (";
-        for i = 0 to len - 2 do
-          Format.fprintf fmt "%a,@ " pp_mllam arr.(i)
-        done;
-        pp_mllam fmt arr.(len-1);
-        Format.fprintf fmt "))@]"
-      end;
-    | MLisaccu (prefix, ind, c) ->
-        let accu = string_of_accu_construct prefix ind in
-        Format.fprintf fmt
-          "@[begin match Obj.magic (%a) with@\n| %s _ ->@\n  true@\n| _ ->@\n  false@\nend@]"
-        pp_mllam c accu
-
-  and pp_letrec fmt defs =
-    let len = Array.length defs in
-    let pp_one_rec (fn, argsn, body) =
-      Format.fprintf fmt "%a%a =@\n  %a"
-        pp_lname fn
-        pp_ldecls argsn pp_mllam body in
-    Format.fprintf fmt "@[let rec ";
-    pp_one_rec defs.(0);
-    for i = 1 to len - 1 do
-      Format.fprintf fmt "@\nand ";
-      pp_one_rec defs.(i)
-    done
-
-  and pp_blam fmt l =
-    match l with
-    | MLprimitive (_, _) | MLlam _ | MLletrec _ | MLlet _ | MLapp _ | MLif _ ->
-        Format.fprintf fmt "(%a)" pp_mllam l
-    | MLconstruct(_,_,_,args) when Array.length args > 0 ->
-        Format.fprintf fmt "(%a)" pp_mllam l
-    | _ -> pp_mllam fmt l
-
-  and pp_args sep fmt args =
-    let sep = if sep then "" else "," in
-    let len = Array.length args in
-    if len > 0 then begin
-      Format.fprintf fmt "%a" pp_blam args.(0);
-      for i = 1 to len - 1 do
-        Format.fprintf fmt "%s@ %a" sep pp_blam args.(i)
-      done
-    end
-
-  and pp_cargs fmt args =
-    let len = Array.length args in
-    match len with
-    | 0 -> ()
-    | 1 -> Format.fprintf fmt "@ %a" pp_blam args.(0)
-    | _ -> Format.fprintf fmt "@ @[<2>(%a)@]" (pp_args false) args
-
-  and pp_cparam fmt param =
-    match param with
-    | Some l -> pp_mllam fmt (MLlocal l)
-    | None -> Format.fprintf fmt "_"
-
-  and pp_cparams fmt params =
-    let len = Array.length params in
-    match len with
-    | 0 -> ()
-    | 1 -> Format.fprintf fmt " %a" pp_cparam params.(0)
-    | _ ->
-        let aux fmt params =
-          Format.fprintf fmt "%a" pp_cparam params.(0);
-          for i = 1 to len - 1 do
-            Format.fprintf fmt ",%a" pp_cparam params.(i)
-          done in
-        Format.fprintf fmt "(%a)" aux params
-
-  and pp_branches prefix ind fmt bs =
-    let pp_branch (cargs,body) =
-      let pp_pat fmt = function
-        | ConstPattern i ->
-          Format.fprintf fmt "| %s "
-            (string_of_construct prefix ~constant:true ind i)
-        | NonConstPattern (tag,args) ->
-          Format.fprintf fmt "| %s%a "
-            (string_of_construct prefix ~constant:false ind tag) pp_cparams args in
-      let rec pp_pats fmt pats =
-        match pats with
-        | [] -> ()
-        | pat::pats ->
-          Format.fprintf fmt "%a%a" pp_pat pat pp_pats pats
-      in
-      Format.fprintf fmt "%a ->@\n  %a@\n" pp_pats cargs pp_mllam body
-    in
-    Array.iter pp_branch bs
-
-  and pp_primitive fmt = function
-    | Mk_prod -> Format.fprintf fmt "mk_prod"
-    | Mk_sort -> Format.fprintf fmt "mk_sort_accu"
-    | Mk_ind -> Format.fprintf fmt "mk_ind_accu"
-    | Mk_const -> Format.fprintf fmt "mk_constant_accu"
-    | Mk_sw -> Format.fprintf fmt "mk_sw_accu"
-    | Mk_fix(rec_pos,start) ->
-        let pp_rec_pos fmt rec_pos =
-          Format.fprintf fmt "@[[| %i" rec_pos.(0);
-          for i = 1 to Array.length rec_pos - 1 do
-            Format.fprintf fmt ";@ %i" rec_pos.(i)
-          done;
-          Format.fprintf fmt " |]@]" in
-        Format.fprintf fmt "mk_fix_accu %a %i" pp_rec_pos rec_pos start
-    | Mk_cofix(start) -> Format.fprintf fmt "mk_cofix_accu %i" start
-    | Mk_rel i -> Format.fprintf fmt "mk_rel_accu %i" i
-    | Mk_var id ->
-        Format.fprintf fmt "mk_var_accu (Names.Id.of_string \"%s\")" (string_of_id id)
-    | Mk_proj -> Format.fprintf fmt "mk_proj_accu"
-    | Mk_empty_instance -> Format.fprintf fmt "UVars.Instance.empty"
-    | Is_int -> Format.fprintf fmt "is_int"
-    | Is_float -> Format.fprintf fmt "is_float"
-    | Is_string -> Format.fprintf fmt "is_string"
-    | Is_parray -> Format.fprintf fmt "is_parray"
-    | Cast_accu -> Format.fprintf fmt "cast_accu"
-    | Array_get -> Format.fprintf fmt "Array.get"
-    | Force_cofix -> Format.fprintf fmt "force_cofix"
-    | Mk_uint -> Format.fprintf fmt "mk_uint"
-    | Mk_float -> Format.fprintf fmt "mk_float"
-    | Mk_string -> Format.fprintf fmt "mk_string"
-    | Mk_int -> Format.fprintf fmt "mk_int"
-    | Val_to_int -> Format.fprintf fmt "val_to_int"
-    | Mk_evar -> Format.fprintf fmt "mk_evar_accu"
-    | MLand -> Format.fprintf fmt "(&&)"
-    | MLnot -> Format.fprintf fmt "not"
-    | MLland -> Format.fprintf fmt "(land)"
-    | MLmagic -> Format.fprintf fmt "Obj.magic"
-    | MLsubst_instance_instance -> Format.fprintf fmt "UVars.subst_instance_instance"
-    | MLsubst_instance_sort -> Format.fprintf fmt "UVars.subst_instance_sort"
-    | MLparray_of_array -> Format.fprintf fmt "parray_of_array"
-    | Coq_primitive (op, false) ->
-       Format.fprintf fmt "no_check_%s" (CPrimitives.to_string op)
-    | Coq_primitive (op, true) -> Format.fprintf fmt "%s" (CPrimitives.to_string op)
-    | Get_value -> Format.fprintf fmt "get_value"
-    | Get_sort -> Format.fprintf fmt "get_sort"
-    | Get_name -> Format.fprintf fmt "get_name"
-    | Get_const -> Format.fprintf fmt "get_const"
-    | Get_match -> Format.fprintf fmt "get_match"
-    | Get_ind -> Format.fprintf fmt "get_ind"
-    | Get_evar -> Format.fprintf fmt "get_evar"
-    | Get_instance -> Format.fprintf fmt "get_instance"
-    | Get_proj -> Format.fprintf fmt "get_proj"
-    | Get_symbols -> Format.fprintf fmt "get_symbols"
-    | Lazy -> Format.fprintf fmt "lazy"
-    | Str_decode -> Format.fprintf fmt "str_decode"
-  in
-  Format.fprintf fmt "@[%a@]" pp_mllam l
-
-
 let pp_mllam_mlf fmt l =
 
   let rec pp_mllam_mlf fmt l =
@@ -2222,35 +2015,11 @@ let pp_mllam_mlf fmt l =
   in
   Format.fprintf fmt "@[%a@]" pp_mllam_mlf l
 
-
-let pp_array fmt t =
-  let len = Array.length t in
-  Format.fprintf fmt "@[<2>[|";
-  for i = 0 to len - 2 do
-    Format.fprintf fmt "%a;@ " pp_mllam t.(i)
-  done;
-  if len > 0 then
-    Format.fprintf fmt "%a" pp_mllam t.(len - 1);
-  Format.fprintf fmt "|]@]"
-
 let pp_array_mlf fmt t =
   Format.fprintf fmt "(block (tag 0)";
   Array.iter (Format.fprintf fmt "@ %a" pp_mllam_mlf) t;
   Format.fprintf fmt ")"
 
-let pp_cofix fmt (gn, s) =
-  let pp_dummy fmt len =
-    let dummy = String.concat "; " (List.make len "0") in
-    Format.fprintf fmt "@[(Obj.magic [|%s|] : Nativevalues.t array)@]" dummy
-  in
-  let pp_knot fmt n =
-    for i = 0 to n - 1 do
-      Format.fprintf fmt "@[<2>let () = (%a).(%i) <-@ Obj.magic @[<2>(%a)@] in@]@\n" pp_gname gn i pp_mllam s.(i)
-    done
-  in
-  let len = Array.length s in
-  Format.fprintf fmt "@[let %a = %a in@\n%a%a@]" pp_gname gn pp_dummy len pp_knot len pp_gname gn
-
 let pp_cofix_mlf fmt (gn, s) =
   let subst_gname gn v l =
     let rec aux l =
@@ -2278,56 +2047,24 @@ let pp_cofix_mlf fmt (gn, s) =
   in let s = Array.map (subst_gname gn (MLapp(MLglobal (Ginternal "Lazy.force"), [|MLglobal gn|])) ) s in
   Format.fprintf fmt "@[(let (rec (%a (lazy %a))) (force %a))@]" pp_gname_mlf gn pp_array_mlf s pp_gname_mlf gn
 
-let type_of_global gn c = match gn with
-  | Ginternal "symbols_tbl" -> ""
-  | _ -> match c with
-    | MLprimitive (Lazy, _) -> " : Nativevalues.t Lazy.t"
-    | MLlam ([|_|], MLprimitive (Lazy, _)) -> " : Nativevalues.t -> Nativevalues.t Lazy.t"
-    | MLprimitive ((Mk_ind | Mk_const), [|_|]) -> " : UVars.Instance.t -> Nativevalues.t"
-    | MLsetref (_,_) -> " : unit"
-    | _ -> " : Nativevalues.t"
-
-let pp_global fmt g =
-  match g with
-  | Glet (gn, c) ->
-      Format.fprintf fmt "@[let %a%s = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname gn
-        (type_of_global gn c)
-        pp_mllam c
-  | Gopen s ->
-      Format.fprintf fmt "@[open %s@]@." s
-  | Gtype (ind, lar) ->
-    let rec aux s arity =
-      if Int.equal arity 0 then s else aux (s^" * Nativevalues.t") (arity-1) in
-    let pp_const_sig fmt (tag,arity) =
-      if arity > 0 then
-        let sig_str = aux "of Nativevalues.t" (arity-1) in
-        let cstr = string_of_construct "" ~constant:false ind tag in
-        Format.fprintf fmt "  | %s %s@\n" cstr sig_str
-      else
-        let cstr = string_of_construct "" ~constant:true ind tag in
-        Format.fprintf fmt "  | %s@\n" cstr
-    in
-    let pp_const_sigs fmt lar =
-      Format.fprintf fmt "  | %s of Nativevalues.t@\n" (string_of_accu_construct "" ind);
-      Array.iter (pp_const_sig fmt) lar
-    in
-    Format.fprintf fmt "@[type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
-  | Gtblfixtype (g, params, t) ->
-      Format.fprintf fmt "@[let %a %a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
-        pp_ldecls params pp_array t
-  | Gtblnorm (g, params, t) ->
-      Format.fprintf fmt "@[let %a %a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
-        pp_ldecls params pp_array t
-  | Gtblcofix (g, params, s) ->
-      Format.fprintf fmt "@[let %a%a : Nativevalues.t array = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@." pp_gname g
-        pp_ldecls params pp_cofix (g, s);
-  | Gletcase(gn,params,annot,a,accu,bs) ->
-      Format.fprintf fmt "@[(* Hash = %i *)@\nlet rec %a %a : Nativevalues.t = let Refl = Nativevalues.t_eq in@\n  %a@]@\n@."
-      (hash_global g)
-        pp_gname gn pp_ldecls params
-        pp_mllam (MLmatch(annot,a,accu,bs))
-  | Gcomment s ->
-      Format.fprintf fmt "@[(* %s *)@]@." s
+let pp_type_decl fmt ind lar =
+  let rec aux s arity =
+    if Int.equal arity 0 then s else aux (s^" * Nativevalues.t") (arity-1) in
+  let pp_const_sig fmt (tag,arity) =
+    if arity > 0 then
+      let sig_str = aux "of Nativevalues.t" (arity-1) in
+      let cstr = string_of_construct "" ~constant:false ind tag in
+      Format.fprintf fmt "  | %s %s@\n" cstr sig_str
+    else
+      let sig_str = if arity > 0 then aux "of Nativevalues.t" (arity-1) else "" in
+      let cstr = string_of_construct "" ~constant:true ind tag in
+      Format.fprintf fmt "  | %s %s@\n" cstr sig_str
+  in
+  let pp_const_sigs fmt lar =
+    Format.fprintf fmt "  | %s of Nativevalues.t@\n" (string_of_accu_construct "" ind);
+    Array.iter (pp_const_sig fmt) lar
+  in
+  Format.fprintf fmt "@[type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
 
 let pp_global_mlf fmt g =
   match g with
@@ -2408,7 +2145,7 @@ let pp_global_interface fmt g =
       Format.fprintf fmt "val %s : t@." ident
   | Gcomment _
   | Gopen _ -> ()
-  | Gtype _ -> pp_global fmt g
+  | Gtype (ind, lar) -> pp_type_decl fmt ind lar
 
 (** Compilation of elements in environment **)
 let rec compile_with_fv ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index ec19ea5e9b64..1620ef03cd26 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -28,8 +28,6 @@ val debug_native_compiler : CDebug.t
 
 val keep_debug_files : unit -> bool
 
-val pp_global : Format.formatter -> global -> unit
-
 val pp_global_mlf : Format.formatter -> global -> unit
 
 val global_to_mlf_name : global -> string option

From b92250a89e1a0f582e0aeb065c027d6eb2d8f7ba Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 11:22:15 +0200
Subject: [PATCH 055/110] More cleanup, reused now free function names, and
 moved Lazy.force into a MLprimitive

---
 kernel/nativecode.ml  | 255 ++++++++++++++++++++----------------------
 kernel/nativecode.mli |   2 +-
 kernel/nativelib.ml   |   8 +-
 3 files changed, 127 insertions(+), 138 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index e455b9a78a35..0176ae9b7790 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -290,6 +290,7 @@ type primitive =
   | Get_proj
   | Get_symbols
   | Lazy
+  | Force
   | Coq_primitive of CPrimitives.t * bool (* check for accu *)
   | Mk_empty_instance
   | Str_decode
@@ -333,6 +334,7 @@ let eq_primitive p1 p2 =
   | Get_proj, Get_proj
   | Get_symbols, Get_symbols
   | Lazy, Lazy
+  | Force, Force
   | Mk_empty_instance, Mk_empty_instance
   | Str_decode, Str_decode
     -> true
@@ -385,6 +387,7 @@ let eq_primitive p1 p2 =
     | Get_proj
     | Get_symbols
     | Lazy
+    | Force
     | Coq_primitive _
     | Mk_empty_instance
     | Str_decode), _
@@ -437,9 +440,10 @@ let primitive_hash = function
   | Get_proj -> 40
   | Get_symbols -> 41
   | Lazy -> 42
-  | Mk_empty_instance -> 43
-  | Mk_string -> 44
-  | Str_decode -> 45
+  | Force -> 43
+  | Mk_empty_instance -> 44
+  | Mk_string -> 45
+  | Str_decode -> 46
 
 type mllambda =
   | MLlocal        of lname
@@ -1075,7 +1079,7 @@ let fv_args env fvn fvr =
       args
     end
 
-let symbols_tbl_name = Ginternal "symbols_tbl"
+let symbols_tbl_name = Ginternal "$symbols_tbl"
 
 let get_value_code i =
   MLprimitive (Get_value,
@@ -1335,7 +1339,7 @@ let rec ml_of_lam env l t =
      let prefix = env.env_const_prefix c in
      let args = ml_of_instance env u in
      let ans = mkMLapp (MLglobal(Gconstant (prefix, c))) args in
-     if env.env_const_lazy c then MLapp (MLglobal (Ginternal "Lazy.force"), [|ans|])
+     if env.env_const_lazy c then MLprimitive (Force, [|ans|])
      else ans
   | Lproj (p, c) ->
     let ind = Projection.Repr.inductive p in
@@ -1796,53 +1800,41 @@ let string_of_mind mind = string_of_kn (MutInd.user mind)
 let string_of_ind (mind,i) = string_of_kn (MutInd.user mind) ^ "_" ^ string_of_int i
 
 let string_of_gname g =
-  match g with
-  | Gind (prefix, (mind, i)) ->
-      Format.sprintf "%sindaccu_%s_%i" prefix (string_of_mind mind) i
-  | Gconstant (prefix, c) ->
-      Format.sprintf "%sconst_%s" prefix (string_of_con c)
-  | Gproj (prefix, (mind, n), i) ->
-      Format.sprintf "%sproj_%s_%i_%i" prefix (string_of_mind mind) n i
-  | Gcase (l,i) ->
-      Format.sprintf "case_%s_%i" (string_of_label_def l) i
-  | Gpred (l,i) ->
-      Format.sprintf "pred_%s_%i" (string_of_label_def l) i
-  | Gfixtype (l,i) ->
-      Format.sprintf "fixtype_%s_%i" (string_of_label_def l) i
-  | Gnorm (l,i) ->
-      Format.sprintf "norm_%s_%i" (string_of_label_def l) i
-  | Ginternal s -> Format.sprintf "%s" s
-  | Gnormtbl (l,i) ->
-      Format.sprintf "normtbl_%s_%i" (string_of_label_def l) i
-  | Grel i ->
-      Format.sprintf "rel_%i" i
-  | Gnamed id ->
-      Format.sprintf "named_%s" (string_of_id id)
-
-let string_of_gname_mlf g =
-  let name = string_of_gname g in
-  if String.contains name '.' then begin (* the global name comes from a module *)
-    let name = String.split_on_char '.' name in
-    let name = match name with
-      | [] -> []
-      | name -> name in
-    let name = List.map ((^) " $") name in
-    let name = List.fold_left (^) "" name in
-    Format.sprintf "(global%s)" name
-  end else
-  match name with
-  | s when String.length s > 0 && s.[0] = '"' -> s
-  | "()" -> "0"
-  | "_" -> "_"
-  | _ -> Format.sprintf "$%s" name
-
-let pp_gname_mlf fmt g =
-  Format.fprintf fmt "%s" (string_of_gname_mlf g)
+  let ret = match g with
+    | Gind (prefix, (mind, i)) ->
+        Format.sprintf "$%sindaccu_%s_%i" prefix (string_of_mind mind) i
+    | Gconstant (prefix, c) ->
+        Format.sprintf "$%sconst_%s" prefix (string_of_con c)
+    | Gproj (prefix, (mind, n), i) ->
+        Format.sprintf "$%sproj_%s_%i_%i" prefix (string_of_mind mind) n i
+    | Gcase (l,i) ->
+        Format.sprintf "$case_%s_%i" (string_of_label_def l) i
+    | Gpred (l,i) ->
+        Format.sprintf "$pred_%s_%i" (string_of_label_def l) i
+    | Gfixtype (l,i) ->
+        Format.sprintf "$fixtype_%s_%i" (string_of_label_def l) i
+    | Gnorm (l,i) ->
+        Format.sprintf "$norm_%s_%i" (string_of_label_def l) i
+    | Ginternal s -> Format.sprintf "%s" s
+    | Gnormtbl (l,i) ->
+        Format.sprintf "$normtbl_%s_%i" (string_of_label_def l) i
+    | Grel i ->
+        Format.sprintf "$rel_%i" i
+    | Gnamed id ->
+        Format.sprintf "$named_%s" (string_of_id id) in
+  if String.contains ret '.' then (* the global name comes from a module *)
+    let ret = String.split_on_char '.' ret in
+    let ret = String.concat " $" ret in 
+    Format.sprintf "(global%s)" ret
+  else ret
+
+let pp_gname fmt g =
+  Format.fprintf fmt "%s" (string_of_gname g)
 
 let pp_lname fmt ln =
   Format.fprintf fmt "x_%s_%i" (string_of_name ln.lname) ln.luid
 
-let pp_ldecls_mlf fmt ids =
+let pp_ldecls fmt ids =
     let len = Array.length ids in
     if len = 0 then Format.fprintf fmt "$_" else (* argument list cannot be empty in malfunction *)
     for i = 0 to len - 1 do
@@ -1856,31 +1848,30 @@ let string_of_construct prefix ~constant ind tag =
 let string_of_accu_construct prefix ind =
   Format.sprintf "%sAccu_%s" prefix (string_of_ind ind)
 
-let pp_int fmt i =
-  if i < 0 then Format.fprintf fmt "(%i)" i else Format.fprintf fmt "%i" i
-
-let pp_mllam_mlf fmt l =
+let pp_mllam fmt l =
 
-  let rec pp_mllam_mlf fmt l =
+  let rec pp_mllam fmt l =
     match l with
-    | MLint i when i >= 0 -> pp_int fmt i
+    | MLint i when i >= 0 -> Format.fprintf fmt "%i" i
     | MLint i -> Format.fprintf fmt "(neg %i)" (-i) (* i < 0 *)
     | MLuint i -> Format.fprintf fmt "%s" (Uint63.compile_mlf i)
     | MLfloat f -> Format.fprintf fmt "%s" (Float64.compile_mlf f)
     | MLstring s -> Format.fprintf fmt "%s" (Pstring.compile_mlf s)
     | MLlam(ids,body) ->
         Format.fprintf fmt "@[<2>(lambda (%a) @ %a)@]"
-          pp_ldecls_mlf ids pp_mllam_mlf body
+          pp_ldecls ids pp_mllam body
     | MLsequence(l1,l2) ->
-        Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam_mlf l1 pp_mllam_mlf l2
+        Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam l1 pp_mllam l2
     | MLprimitive (MLland, args) -> (* malfunction has a special operator for logical and *)
       Format.fprintf fmt "(& %a)" pp_args_mlf args
     | MLprimitive (MLnot, args) ->
       Format.fprintf fmt "(== 0 %a)" pp_args_mlf args
     | MLprimitive (MLmagic, args) -> (* Obj.magic is unneeded in malfunction *)
-      Format.fprintf fmt "%a" pp_args_mlf args
+      pp_args_mlf fmt args
     | MLprimitive (Lazy, args) -> (* lazy values must be treated separately *)
       Format.fprintf fmt "@[<2>(lazy%a)@]" pp_args_mlf args
+    | MLprimitive (Force, args) ->
+      Format.fprintf fmt "@[<2>(force%a)@]" pp_args_mlf args
     | MLprimitive (Array_get, args) ->
       Format.fprintf fmt "@[<2>(load%a)@]" pp_args_mlf args
     | MLprimitive (p, [||]) -> (* not a function and just a value *)
@@ -1888,36 +1879,30 @@ let pp_mllam_mlf fmt l =
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_primitive_mlf p pp_args_mlf args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
-    | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname_mlf g
+    | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
     | MLapp(f, [||]) -> (* not an application and instead simply a function *)
-        Format.fprintf fmt "%a" pp_mllam_mlf f
-    | MLapp(MLglobal (Ginternal "Lazy.force"), args) -> (* force has to be hardcoded as mlf won't let us bypass the force keyword *)
-        Format.fprintf fmt "@[<2>(force%a)@]" pp_args_mlf args
+        Format.fprintf fmt "%a" pp_mllam f
     | MLapp(f, args) ->
-        Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_mllam_mlf f pp_args_mlf args
+        Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_mllam f pp_args_mlf args
     | MLlet(id,def,body) ->
         Format.fprintf fmt "@[(let@ ($%a@ %a)@\n@[<2>%a@])@]"
-          pp_lname id pp_mllam_mlf def pp_mllam_mlf body
+          pp_lname id pp_mllam def pp_mllam body
     | MLif(t,l1,l2) ->
         Format.fprintf fmt "@[(if %a@\n  %a@\n  %a)@]"
-          pp_mllam_mlf t pp_mllam_mlf l1 pp_mllam_mlf l2
+          pp_mllam t pp_mllam l1 pp_mllam l2
     | MLletrec(defs, body) ->
         Format.fprintf fmt "@[<2>(let (rec @[<2>%a@])@\n%a)@]" pp_letrec_mlf defs
-          pp_mllam_mlf body
+          pp_mllam body
     | MLarray arr ->
       Format.fprintf fmt "@[(block (tag 0)";
-      Array.iter (Format.fprintf fmt "@ %a" pp_mllam_mlf) arr;
+      Array.iter (Format.fprintf fmt "@ %a" pp_mllam) arr;
       Format.fprintf fmt ")@]"
     | MLsetref (s, body) ->
-        let s = match s with
-          | "rt1" -> "(global $Nativelib $rt1)" (* we have to do this as there is no other indication of the origin of those variables *)
-          | "rt2" -> "(global $Nativelib $rt2)"
-          | s -> "$"^s in
-        Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam_mlf body
+        Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam body
     | MLmatch (_, c, accu_br, br) ->
       Format.fprintf fmt (* accumulator is always tag 0 *)
         "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 0)@\n    %a)@\n  @[%a@]))@]"
-        pp_mllam_mlf c pp_mllam_mlf accu_br pp_branches_mlf br
+        pp_mllam c pp_mllam accu_br pp_branches_mlf br
     | MLconstruct(_,_,tag,[||]) -> (* not a construct but a constant *)
         Format.fprintf fmt "%i"
           tag
@@ -1927,10 +1912,10 @@ let pp_mllam_mlf fmt l =
     | MLisaccu (_, _, c) ->
         Format.fprintf fmt
           "@[(switch %a@\n  ((tag 0) 1)@\n  (_ (tag _) 0))@]"
-        pp_mllam_mlf c
+        pp_mllam c
   and pp_cparam_mlf fmt param =
     match param with
-    | Some l -> pp_mllam_mlf fmt (MLlocal l)
+    | Some l -> pp_mllam fmt (MLlocal l)
     | None -> Format.fprintf fmt "_"
   and pp_cparams_mlf fmt params =
     let len = Array.length params in
@@ -1941,13 +1926,13 @@ let pp_mllam_mlf fmt l =
     let rec pp_branch fmt (cargs,body) =
       let pp_pat_and_block fmt = function
         | ConstPattern i, body ->
-          Format.fprintf fmt "%i %a" i pp_mllam_mlf body
+          Format.fprintf fmt "%i %a" i pp_mllam body
         | NonConstPattern (tag,args), body ->
           Format.fprintf fmt "@[<2>(tag %i) (let%a@\n%a)@]"
-            tag pp_cparams_mlf args pp_mllam_mlf body in
+            tag pp_cparams_mlf args pp_mllam body in
       match cargs with
       | [] -> ()
-      | pat::pats -> (* be duplicate the branches because there is no simpler alternative to due to match bindings *)
+      | pat::pats -> (* we duplicate the branches because there is no simpler alternative to due to match bindings *)
         Format.fprintf fmt "(%a)@\n%a" pp_pat_and_block (pat, body) pp_branch (pats, body)
     in
     Array.iter (pp_branch fmt) bs
@@ -1955,11 +1940,11 @@ let pp_mllam_mlf fmt l =
     let pp_one_rec (fn, argsn, body) =
       Format.fprintf fmt "($%a@ %a)@\n"
         pp_lname fn
-        pp_mllam_mlf (MLlam(argsn, body)) in
+        pp_mllam (MLlam(argsn, body)) in
     Array.iter pp_one_rec defs
   and pp_args_mlf fmt args =
     if args <> [||] then
-      Array.iter (Format.fprintf fmt "@ %a" pp_mllam_mlf) args
+      Array.iter (Format.fprintf fmt "@ %a" pp_mllam) args
     else Format.fprintf fmt "@ 0" (* 0 is () in malfunction *)
   and pp_primitive_mlf fmt = function
     | Mk_prod -> Format.fprintf fmt "(global $Nativevalues $mk_prod)"
@@ -1969,7 +1954,7 @@ let pp_mllam_mlf fmt l =
     | Mk_sw -> Format.fprintf fmt "(global $Nativevalues $mk_sw_accu)"
     | Mk_fix(rec_pos,start) ->
         Format.fprintf fmt "@[<2>(apply (global $Nativevalues $mk_fix_accu) (block (tag 0)";
-        Array.iter (fun i -> Format.fprintf fmt "@\n%a" pp_mllam_mlf (MLint i)) rec_pos;
+        Array.iter (fun i -> Format.fprintf fmt "@\n%a" pp_mllam (MLint i)) rec_pos;
         Format.fprintf fmt ")@]@\n %i)" start
     | Mk_cofix(start) -> Format.fprintf fmt "(apply (global $Nativevalues $mk_cofix_accu) %i)" start
     | Mk_rel i -> Format.fprintf fmt "(apply (global $Nativevalues $mk_rel_accu) %i)" i
@@ -2011,16 +1996,17 @@ let pp_mllam_mlf fmt l =
     | MLnot
     | MLland
     | MLmagic
-    | Lazy -> assert false (* theses cases has been treated separately in pp_mllam_mlf *)
+    | Force
+    | Lazy -> assert false (* theses cases has been treated separately in pp_mllam *)
   in
-  Format.fprintf fmt "@[%a@]" pp_mllam_mlf l
+  Format.fprintf fmt "@[%a@]" pp_mllam l
 
-let pp_array_mlf fmt t =
+let pp_array fmt t =
   Format.fprintf fmt "(block (tag 0)";
-  Array.iter (Format.fprintf fmt "@ %a" pp_mllam_mlf) t;
+  Array.iter (Format.fprintf fmt "@ %a" pp_mllam) t;
   Format.fprintf fmt ")"
 
-let pp_cofix_mlf fmt (gn, s) =
+let pp_cofix fmt (gn, s) =
   let subst_gname gn v l =
     let rec aux l =
       match l with
@@ -2044,32 +2030,31 @@ let pp_cofix_mlf fmt (gn, s) =
       | MLisaccu (s, ind, l) -> MLisaccu (s, ind, aux l)
     in
     aux l
-  in let s = Array.map (subst_gname gn (MLapp(MLglobal (Ginternal "Lazy.force"), [|MLglobal gn|])) ) s in
-  Format.fprintf fmt "@[(let (rec (%a (lazy %a))) (force %a))@]" pp_gname_mlf gn pp_array_mlf s pp_gname_mlf gn
+  in let s = Array.map (subst_gname gn (MLprimitive(Force, [|MLglobal gn|])) ) s in
+  Format.fprintf fmt "@[(let (rec (%a (lazy %a))) (force %a))@]" pp_gname gn pp_array s pp_gname gn
 
 let pp_type_decl fmt ind lar =
   let rec aux s arity =
-    if Int.equal arity 0 then s else aux (s^" * Nativevalues.t") (arity-1) in
+    if Int.equal arity 0 then s else aux (s^" * t") (arity-1) in
   let pp_const_sig fmt (tag,arity) =
     if arity > 0 then
-      let sig_str = aux "of Nativevalues.t" (arity-1) in
+      let sig_str = aux "of t" (arity-1) in
       let cstr = string_of_construct "" ~constant:false ind tag in
       Format.fprintf fmt "  | %s %s@\n" cstr sig_str
     else
-      let sig_str = if arity > 0 then aux "of Nativevalues.t" (arity-1) else "" in
       let cstr = string_of_construct "" ~constant:true ind tag in
-      Format.fprintf fmt "  | %s %s@\n" cstr sig_str
+      Format.fprintf fmt "  | %s@\n" cstr
   in
   let pp_const_sigs fmt lar =
-    Format.fprintf fmt "  | %s of Nativevalues.t@\n" (string_of_accu_construct "" ind);
+    Format.fprintf fmt "  | %s of t@\n" (string_of_accu_construct "" ind);
     Array.iter (pp_const_sig fmt) lar
   in
   Format.fprintf fmt "@[type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
 
-let pp_global_mlf fmt g =
+let pp_global fmt g =
   match g with
   | Glet (gn, c) ->
-      Format.fprintf fmt "@[( %a  %a )@]@\n@." pp_gname_mlf gn pp_mllam_mlf c
+      Format.fprintf fmt "@[( %a  %a )@]@\n@." pp_gname gn pp_mllam c
   | Gtype (ind, lar) -> (* types are not needed in malfunction, we will leave them as comments *)
     let rec aux s arity =
       if Int.equal arity 0 then s else aux (s^" * Nativevalues.t") (arity-1) in
@@ -2092,34 +2077,35 @@ let pp_global_mlf fmt g =
   | Gletcase(gn,[||],annot,a,accu,bs) -> (* simple biding and not a function *)
       Format.fprintf fmt "@[; Hash = %i@\n(%a %a)@]@\n@." (* no need to be recursive as we are sane and do not create recursive values other than functions *)
       (hash_global g)
-        pp_gname_mlf gn
-        pp_mllam_mlf (MLmatch(annot,a,accu,bs))
+        pp_gname gn
+        pp_mllam (MLmatch(annot,a,accu,bs))
   | Gletcase(gn,params,annot,a,accu,bs) -> (* a function *)
       Format.fprintf fmt "@[; Hash = %i@\n(rec (%a (lambda (%a)@\n  %a)))@]@\n@."
       (hash_global g)
-        pp_gname_mlf gn pp_ldecls_mlf params
-        pp_mllam_mlf (MLmatch(annot,a,accu,bs))
+        pp_gname gn pp_ldecls params
+        pp_mllam (MLmatch(annot,a,accu,bs))
   | Gtblfixtype (g, [||], t) -> (* not a function but a definition *)
-      Format.fprintf fmt "@[<2>(%a %a)@]@\n@." pp_gname_mlf g
-        pp_array_mlf t
+      Format.fprintf fmt "@[<2>(%a %a)@]@\n@." pp_gname g
+        pp_array t
   | Gtblfixtype (g, params, t) ->
-      Format.fprintf fmt "@[<2>(%a (lambda (%a)@\n%a))@]@\n@." pp_gname_mlf g
-        pp_ldecls_mlf params pp_array_mlf t
+      Format.fprintf fmt "@[<2>(%a (lambda (%a)@\n%a))@]@\n@." pp_gname g
+        pp_ldecls params pp_array t
   | Gtblnorm (g, [||], t) -> (* not a function but a definition *)
-      Format.fprintf fmt "@[<2>(%a %a)@]@\n@." pp_gname_mlf g
-        pp_array_mlf t
+      Format.fprintf fmt "@[<2>(%a %a)@]@\n@." pp_gname g
+        pp_array t
   | Gtblnorm (g, params, t) ->
-      Format.fprintf fmt "@[<2>(%a (lambda (%a)@\n%a))@]@\n@." pp_gname_mlf g
-        pp_ldecls_mlf params pp_array_mlf t
+      Format.fprintf fmt "@[<2>(%a (lambda (%a)@\n%a))@]@\n@." pp_gname g
+        pp_ldecls params pp_array t
   | Gtblcofix (g, [||], s) -> (* not a function but a definition *)
-      Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname_mlf g
-        pp_cofix_mlf (g, s)
+      Format.fprintf fmt "@[(%a %a)@]@\n@." pp_gname g
+        pp_cofix (g, s)
   | Gtblcofix (g, params, s) ->
-      Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname_mlf g
-        pp_ldecls_mlf params pp_cofix_mlf (g, s)
+      Format.fprintf fmt "@[(%a (lambda (%a)@\n  %a))@]@\n@." pp_gname g
+        pp_ldecls params pp_cofix (g, s)
   | Gcomment s ->
       List.iter (fun line -> Format.fprintf fmt ";@[ %s @]@." line) (String.split_on_char '\n' s)
 
+(* needed to know the names of the values to export *)
 let global_to_mlf_name g =
   match g with
   | Gtblfixtype (gn,_,_)
@@ -2127,22 +2113,25 @@ let global_to_mlf_name g =
   | Gtblcofix (gn,_,_)
   | Gletcase(gn,_,_,_,_,_)
   | Glet (gn,_) ->
-    let gn = string_of_gname_mlf gn in
-    if gn = "_" then None else Some gn
+    let gn = string_of_gname gn in
+    if gn = "_" || gn = "" then None else Some gn
   | Gtype _
   | Gcomment _
   | Gopen _ -> None
 
 let pp_global_interface fmt g =
   match g with
-  | Gtblnorm (ident, _,_)
-  | Gtblcofix (ident, _,_)
-  | Gtblfixtype (ident, _,_)
-  | Gletcase (ident, _,_,_,_,_)
-  | Glet (ident, _) ->
-    let ident = string_of_gname ident in
-    if ident <> "_" then
+  | Gtblnorm (_,_,_)
+  | Gtblcofix (_,_,_)
+  | Gtblfixtype (_,_,_)
+  | Gletcase (_,_,_,_,_,_)
+  | Glet (_,_) ->
+    begin match global_to_mlf_name g with
+    | None -> ()
+    | Some ident ->
+      let ident = String.sub ident 1 ((String.length ident) - 1) in (* we remove the $ before the local variable *)
       Format.fprintf fmt "val %s : t@." ident
+    end
   | Gcomment _
   | Gopen _ -> ()
   | Gtype (ind, lar) -> pp_type_decl fmt ind lar
@@ -2432,16 +2421,16 @@ let mk_conv_code env sigma prefix t1 t2 =
   let code2 = lambda_of_constr env sigma t2 in
   let (gl,code1) = compile_with_fv cenv env sigma UGlobal gl None code1 in
   let (gl,code2) = compile_with_fv cenv env sigma UGlobal gl None code2 in
-  let t1 = mk_internal_let "t1" code1 in
-  let t2 = mk_internal_let "t2" code2 in
-  let g1 = MLglobal (Ginternal "t1") in
-  let g2 = MLglobal (Ginternal "t2") in
-  let setref1 = Glet(Ginternal "_", MLsetref("rt1",g1)) in
-  let setref2 = Glet(Ginternal "_", MLsetref("rt2",g2)) in
+  let t1 = mk_internal_let "$t1" code1 in
+  let t2 = mk_internal_let "$t2" code2 in
+  let g1 = MLglobal (Ginternal "$t1") in
+  let g2 = MLglobal (Ginternal "$t2") in
+  let setref1 = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt1)",g1)) in
+  let setref2 = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt2)",g2)) in
   let gl = List.rev (setref2 :: setref1 :: t2 :: t1 :: gl) in
-  let header = Glet(Ginternal "symbols_tbl",
+  let header = Glet(Ginternal "$symbols_tbl",
     MLprimitive (Get_symbols,
-      [|MLglobal (Ginternal "()")|])) in
+      [|MLglobal (Ginternal "0")|])) in
   let symbols = get_cenv_symbols cenv in
   header::gl, symbols, (mind_updates, const_updates)
 
@@ -2453,18 +2442,18 @@ let mk_norm_code env sigma prefix t =
   in
   let code = lambda_of_constr env sigma t in
   let (gl,code) = compile_with_fv cenv env sigma UGlobal gl None code in
-  let t1 = mk_internal_let "t1" code in
-  let g1 = MLglobal (Ginternal "t1") in
-  let setref = Glet(Ginternal "_", MLsetref("rt1",g1)) in
+  let t1 = mk_internal_let "$t1" code in
+  let g1 = MLglobal (Ginternal "$t1") in
+  let setref = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt1)",g1)) in
   let gl = List.rev (setref :: t1 :: gl) in
-  let header = Glet(Ginternal "symbols_tbl",
+  let header = Glet(Ginternal "$symbols_tbl",
     MLprimitive (Get_symbols,
-      [|MLglobal (Ginternal "()")|])) in
+      [|MLglobal (Ginternal "0")|])) in
   let symbols = get_cenv_symbols cenv in
   header::gl, symbols, (mind_updates, const_updates)
 
 let mk_library_header (symbols : Nativevalues.symbols) =
-  [Glet(Ginternal "symbols_tbl", MLprimitive (Str_decode, [|MLglobal (Ginternal ("\"" ^ (str_encode symbols) ^ "\""))|]))]
+  [Glet(Ginternal "$symbols_tbl", MLprimitive (Str_decode, [|MLglobal (Ginternal ("\"" ^ (str_encode symbols) ^ "\""))|]))]
 
 let update_location r =
   r.upd_info := Linked r.upd_prefix
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index 1620ef03cd26..7a5133c6a796 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -28,7 +28,7 @@ val debug_native_compiler : CDebug.t
 
 val keep_debug_files : unit -> bool
 
-val pp_global_mlf : Format.formatter -> global -> unit
+val pp_global : Format.formatter -> global -> unit
 
 val global_to_mlf_name : global -> string option
 
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 8e89a68d2029..56104f8cf5f9 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -98,12 +98,12 @@ let get_mlf_filename () =
   let prefix = Filename.chop_extension (Filename.basename filename) ^ "." in
   filename, prefix
 
-let write_mlf_code fn ?(header=[]) code =
+let write_code fn ?(header=[]) code =
   let header = open_header@header in
   let ch_out = open_out fn in
   let fmt = Format.formatter_of_out_channel ch_out in
   Format.fprintf fmt "@[(module@]@\n";
-  List.iter (pp_global_mlf fmt) (header@code);
+  List.iter (pp_global fmt) (header@code);
   Format.fprintf fmt "@[(export";
   List.iter (Format.fprintf fmt " %s") (List.map_filter global_to_mlf_name code);
   Format.fprintf fmt "))@]@.";
@@ -192,7 +192,7 @@ let call_compiler ?profile:(profile=false) mlf_filename =
   end
 
 let compile fn code ~profile:profile =
-  write_mlf_code fn code;
+  write_code fn code;
   let r = call_compiler ~profile fn in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
@@ -212,7 +212,7 @@ let compile_library (code, symb) fn =
     with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
   in
   let fn = dirname / basename in
-  write_mlf_code fn ~header code;
+  write_code fn ~header code;
   let _ = call_compiler fn in
   delay_cleanup_file fn
 

From a31380bd9f67c3290ea34b02b34c9ffe68bd1f4e Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 11:27:05 +0200
Subject: [PATCH 056/110] more renaming

---
 kernel/float64.mli        |  2 --
 kernel/float64_common.ml  |  6 +----
 kernel/float64_common.mli |  2 --
 kernel/nativecode.ml      | 46 +++++++++++++++++++--------------------
 kernel/pstring.ml         |  3 ---
 kernel/pstring.mli        |  5 +----
 kernel/uint63.mli         |  2 --
 kernel/uint63_31.ml       |  5 +----
 kernel/uint63_63.ml       |  5 +----
 9 files changed, 27 insertions(+), 49 deletions(-)

diff --git a/kernel/float64.mli b/kernel/float64.mli
index b264d68a0a0d..0d2fcaaac7e7 100644
--- a/kernel/float64.mli
+++ b/kernel/float64.mli
@@ -34,8 +34,6 @@ val to_string : t -> string
 
 val compile : t -> string
 
-val compile_mlf : t -> string
-
 val of_float : float -> t
 
 (** All NaNs are normalized to [Stdlib.nan].
diff --git a/kernel/float64_common.ml b/kernel/float64_common.ml
index 2fd84570205a..e2380a3c958a 100644
--- a/kernel/float64_common.ml
+++ b/kernel/float64_common.ml
@@ -37,12 +37,8 @@ let to_string = to_string_raw "%.17g"
 
 let of_string = float_of_string
 
-(* Compiles a float to OCaml code *)
-let compile f =
-  Printf.sprintf "Float64.of_float (%s)" (to_hex_string f)
-
 (* Compiles a float to malfunction code *)
-let compile_mlf f = (* malfunction does not support writing -1.1, so we have to be careful *)
+let compile f = (* malfunction does not support writing -1.1, so we have to be careful *)
   if Float.is_nan f then "(apply (global $Float64 $of_float) nan)"
   else if Float.is_infinite f then begin
     if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) neg_infinity)"
diff --git a/kernel/float64_common.mli b/kernel/float64_common.mli
index 9f8d8d208d3a..61c061af90b2 100644
--- a/kernel/float64_common.mli
+++ b/kernel/float64_common.mli
@@ -34,8 +34,6 @@ val to_string : t -> string
 
 val compile : t -> string
 
-val compile_mlf : t -> string
-
 val of_float : float -> t
 
 (** All NaNs are normalized to [Stdlib.nan].
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 0176ae9b7790..c0987d0b0903 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1854,36 +1854,36 @@ let pp_mllam fmt l =
     match l with
     | MLint i when i >= 0 -> Format.fprintf fmt "%i" i
     | MLint i -> Format.fprintf fmt "(neg %i)" (-i) (* i < 0 *)
-    | MLuint i -> Format.fprintf fmt "%s" (Uint63.compile_mlf i)
-    | MLfloat f -> Format.fprintf fmt "%s" (Float64.compile_mlf f)
-    | MLstring s -> Format.fprintf fmt "%s" (Pstring.compile_mlf s)
+    | MLuint i -> Format.fprintf fmt "%s" (Uint63.compile i)
+    | MLfloat f -> Format.fprintf fmt "%s" (Float64.compile f)
+    | MLstring s -> Format.fprintf fmt "%s" (Pstring.compile s)
     | MLlam(ids,body) ->
         Format.fprintf fmt "@[<2>(lambda (%a) @ %a)@]"
           pp_ldecls ids pp_mllam body
     | MLsequence(l1,l2) ->
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam l1 pp_mllam l2
     | MLprimitive (MLland, args) -> (* malfunction has a special operator for logical and *)
-      Format.fprintf fmt "(& %a)" pp_args_mlf args
+      Format.fprintf fmt "(& %a)" pp_args args
     | MLprimitive (MLnot, args) ->
-      Format.fprintf fmt "(== 0 %a)" pp_args_mlf args
+      Format.fprintf fmt "(== 0 %a)" pp_args args
     | MLprimitive (MLmagic, args) -> (* Obj.magic is unneeded in malfunction *)
-      pp_args_mlf fmt args
+      pp_args fmt args
     | MLprimitive (Lazy, args) -> (* lazy values must be treated separately *)
-      Format.fprintf fmt "@[<2>(lazy%a)@]" pp_args_mlf args
+      Format.fprintf fmt "@[<2>(lazy%a)@]" pp_args args
     | MLprimitive (Force, args) ->
-      Format.fprintf fmt "@[<2>(force%a)@]" pp_args_mlf args
+      Format.fprintf fmt "@[<2>(force%a)@]" pp_args args
     | MLprimitive (Array_get, args) ->
-      Format.fprintf fmt "@[<2>(load%a)@]" pp_args_mlf args
+      Format.fprintf fmt "@[<2>(load%a)@]" pp_args args
     | MLprimitive (p, [||]) -> (* not a function and just a value *)
-      Format.fprintf fmt "%a" pp_primitive_mlf p
+      Format.fprintf fmt "%a" pp_primitive p
     | MLprimitive (p, args) ->
-      Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_primitive_mlf p pp_args_mlf args
+      Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_primitive p pp_args args
     | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
     | MLapp(f, [||]) -> (* not an application and instead simply a function *)
         Format.fprintf fmt "%a" pp_mllam f
     | MLapp(f, args) ->
-        Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_mllam f pp_args_mlf args
+        Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_mllam f pp_args args
     | MLlet(id,def,body) ->
         Format.fprintf fmt "@[(let@ ($%a@ %a)@\n@[<2>%a@])@]"
           pp_lname id pp_mllam def pp_mllam body
@@ -1891,7 +1891,7 @@ let pp_mllam fmt l =
         Format.fprintf fmt "@[(if %a@\n  %a@\n  %a)@]"
           pp_mllam t pp_mllam l1 pp_mllam l2
     | MLletrec(defs, body) ->
-        Format.fprintf fmt "@[<2>(let (rec @[<2>%a@])@\n%a)@]" pp_letrec_mlf defs
+        Format.fprintf fmt "@[<2>(let (rec @[<2>%a@])@\n%a)@]" pp_letrec defs
           pp_mllam body
     | MLarray arr ->
       Format.fprintf fmt "@[(block (tag 0)";
@@ -1902,51 +1902,51 @@ let pp_mllam fmt l =
     | MLmatch (_, c, accu_br, br) ->
       Format.fprintf fmt (* accumulator is always tag 0 *)
         "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 0)@\n    %a)@\n  @[%a@]))@]"
-        pp_mllam c pp_mllam accu_br pp_branches_mlf br
+        pp_mllam c pp_mllam accu_br pp_branches br
     | MLconstruct(_,_,tag,[||]) -> (* not a construct but a constant *)
         Format.fprintf fmt "%i"
           tag
     | MLconstruct(_,_,tag,args) ->
         Format.fprintf fmt "@[<2>(block (tag %i)%a)@]"
-          tag pp_args_mlf args
+          tag pp_args args
     | MLisaccu (_, _, c) ->
         Format.fprintf fmt
           "@[(switch %a@\n  ((tag 0) 1)@\n  (_ (tag _) 0))@]"
         pp_mllam c
-  and pp_cparam_mlf fmt param =
+  and pp_cparam fmt param =
     match param with
     | Some l -> pp_mllam fmt (MLlocal l)
     | None -> Format.fprintf fmt "_"
-  and pp_cparams_mlf fmt params =
+  and pp_cparams fmt params =
     let len = Array.length params in
     for i = 0 to len - 1 do
-      Format.fprintf fmt " (%a (field %i $matched_value))" pp_cparam_mlf params.(i) i
+      Format.fprintf fmt " (%a (field %i $matched_value))" pp_cparam params.(i) i
     done
-  and pp_branches_mlf fmt bs =
+  and pp_branches fmt bs =
     let rec pp_branch fmt (cargs,body) =
       let pp_pat_and_block fmt = function
         | ConstPattern i, body ->
           Format.fprintf fmt "%i %a" i pp_mllam body
         | NonConstPattern (tag,args), body ->
           Format.fprintf fmt "@[<2>(tag %i) (let%a@\n%a)@]"
-            tag pp_cparams_mlf args pp_mllam body in
+            tag pp_cparams args pp_mllam body in
       match cargs with
       | [] -> ()
       | pat::pats -> (* we duplicate the branches because there is no simpler alternative to due to match bindings *)
         Format.fprintf fmt "(%a)@\n%a" pp_pat_and_block (pat, body) pp_branch (pats, body)
     in
     Array.iter (pp_branch fmt) bs
-  and pp_letrec_mlf fmt defs =
+  and pp_letrec fmt defs =
     let pp_one_rec (fn, argsn, body) =
       Format.fprintf fmt "($%a@ %a)@\n"
         pp_lname fn
         pp_mllam (MLlam(argsn, body)) in
     Array.iter pp_one_rec defs
-  and pp_args_mlf fmt args =
+  and pp_args fmt args =
     if args <> [||] then
       Array.iter (Format.fprintf fmt "@ %a" pp_mllam) args
     else Format.fprintf fmt "@ 0" (* 0 is () in malfunction *)
-  and pp_primitive_mlf fmt = function
+  and pp_primitive fmt = function
     | Mk_prod -> Format.fprintf fmt "(global $Nativevalues $mk_prod)"
     | Mk_sort -> Format.fprintf fmt "(global $Nativevalues $mk_sort_accu)"
     | Mk_ind -> Format.fprintf fmt "(global $Nativevalues $mk_ind_accu)"
diff --git a/kernel/pstring.ml b/kernel/pstring.ml
index 0b833d89729c..63f2e40d285b 100644
--- a/kernel/pstring.ml
+++ b/kernel/pstring.ml
@@ -75,7 +75,4 @@ let hash : t -> int =
 let unsafe_of_string : string -> t = fun s -> s
 
 let compile : t -> string =
-  Printf.sprintf "Pstring.unsafe_of_string %S"
-
-let compile_mlf : t -> string =
   Printf.sprintf "(apply (global $Pstring $unsafe_of_string) %S)"
diff --git a/kernel/pstring.mli b/kernel/pstring.mli
index 49fc45a97812..54c4484652c2 100644
--- a/kernel/pstring.mli
+++ b/kernel/pstring.mli
@@ -64,8 +64,5 @@ val hash : t -> int
     code, via [compile]. *)
 val unsafe_of_string : string -> t
 
-(** [compile s] outputs an OCaml expression producing primitive string [s]. *)
+(** [compile s] outputs a malfunction expression producing primitive string [s]. *)
 val compile : t -> string
-
-(** [compile_mlf s] outputs a malfunction expression producing primitive string [s]. *)
-val compile_mlf : t -> string
diff --git a/kernel/uint63.mli b/kernel/uint63.mli
index 995885d21d3f..e77bd78eea37 100644
--- a/kernel/uint63.mli
+++ b/kernel/uint63.mli
@@ -36,8 +36,6 @@ val to_string : t -> string
 
 val compile : t -> string
 
-val compile_mlf : t -> string
-
 (* constants *)
 val zero    : t
 val one : t
diff --git a/kernel/uint63_31.ml b/kernel/uint63_31.ml
index 820e332f82ce..ab7cf7657106 100644
--- a/kernel/uint63_31.ml
+++ b/kernel/uint63_31.ml
@@ -42,11 +42,8 @@ let hash i =
     (* conversion of an uint63 to a string *)
 let to_string i = Int64.to_string i
 
-(* Compiles an unsigned int to OCaml code *)
-let compile i = Printf.sprintf "Uint63.of_int64 (%LiL)" i
-
 (* Compiles an unsigned int to malfunction code *)
-let compile_mlf i =
+let compile i =
   if Int64.compare i 0L >= 0 then Printf.sprintf "(apply (global &Uint63 &of_int64) %Li.i64)" i (* the internal value (a signed integer) is positive *)
   else Printf.sprintf "(apply (global &Uint63 &of_int64) (neg.i64 %Li.i64))" (Int64.neg i) (* the internal value is negative and we must take it into account *)
 
diff --git a/kernel/uint63_63.ml b/kernel/uint63_63.ml
index 99347be4c135..6150fc7cc57a 100644
--- a/kernel/uint63_63.ml
+++ b/kernel/uint63_63.ml
@@ -40,11 +40,8 @@ let hash i = i
     (* conversion of an uint63 to a string *)
 let to_string i = Int64.to_string (to_uint64 i)
 
-(* Compiles an unsigned int to OCaml code *)
-let compile i = Printf.sprintf "Uint63.of_int (%i)" i
-
 (* Compiles an unsigned int to malfunction code *)
-let compile_mlf i =
+let compile i =
   if i >= 0 then Printf.sprintf "(apply (global $Uint63 $of_int) %i)" i
   else Printf.sprintf "(apply (global $Uint63 $of_int) (neg %i))" (-i)
 

From cbc1348709e7e53600bc4f673fd66c04db7ab18d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 11:30:36 +0200
Subject: [PATCH 057/110] fixed identation

---
 kernel/nativecode.ml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index c0987d0b0903..bda4282b0b0e 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1835,11 +1835,11 @@ let pp_lname fmt ln =
   Format.fprintf fmt "x_%s_%i" (string_of_name ln.lname) ln.luid
 
 let pp_ldecls fmt ids =
-    let len = Array.length ids in
-    if len = 0 then Format.fprintf fmt "$_" else (* argument list cannot be empty in malfunction *)
-    for i = 0 to len - 1 do
-      Format.fprintf fmt " $%a" pp_lname ids.(i)
-    done
+  let len = Array.length ids in
+  if len = 0 then Format.fprintf fmt "$_" else (* argument list cannot be empty in malfunction *)
+  for i = 0 to len - 1 do
+    Format.fprintf fmt " $%a" pp_lname ids.(i)
+  done
 
 let string_of_construct prefix ~constant ind tag =
   let base = if constant then "Int" else "Construct" in

From e181096966a23963ad83e60051490eba3540bff0 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 11:35:36 +0200
Subject: [PATCH 058/110] pp_lname now adds truly returns the variable name in
 mlf (with the dollar)

---
 kernel/nativecode.ml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index bda4282b0b0e..832b748be742 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1832,13 +1832,13 @@ let pp_gname fmt g =
   Format.fprintf fmt "%s" (string_of_gname g)
 
 let pp_lname fmt ln =
-  Format.fprintf fmt "x_%s_%i" (string_of_name ln.lname) ln.luid
+  Format.fprintf fmt "$x_%s_%i" (string_of_name ln.lname) ln.luid
 
 let pp_ldecls fmt ids =
   let len = Array.length ids in
   if len = 0 then Format.fprintf fmt "$_" else (* argument list cannot be empty in malfunction *)
   for i = 0 to len - 1 do
-    Format.fprintf fmt " $%a" pp_lname ids.(i)
+    Format.fprintf fmt " %a" pp_lname ids.(i)
   done
 
 let string_of_construct prefix ~constant ind tag =
@@ -1878,14 +1878,14 @@ let pp_mllam fmt l =
       Format.fprintf fmt "%a" pp_primitive p
     | MLprimitive (p, args) ->
       Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_primitive p pp_args args
-    | MLlocal ln -> Format.fprintf fmt "@[$%a@]" pp_lname ln
+    | MLlocal ln -> Format.fprintf fmt "@[%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
     | MLapp(f, [||]) -> (* not an application and instead simply a function *)
         Format.fprintf fmt "%a" pp_mllam f
     | MLapp(f, args) ->
         Format.fprintf fmt "@[<2>(apply %a%a)@]" pp_mllam f pp_args args
     | MLlet(id,def,body) ->
-        Format.fprintf fmt "@[(let@ ($%a@ %a)@\n@[<2>%a@])@]"
+        Format.fprintf fmt "@[(let@ (%a@ %a)@\n@[<2>%a@])@]"
           pp_lname id pp_mllam def pp_mllam body
     | MLif(t,l1,l2) ->
         Format.fprintf fmt "@[(if %a@\n  %a@\n  %a)@]"
@@ -1938,7 +1938,7 @@ let pp_mllam fmt l =
     Array.iter (pp_branch fmt) bs
   and pp_letrec fmt defs =
     let pp_one_rec (fn, argsn, body) =
-      Format.fprintf fmt "($%a@ %a)@\n"
+      Format.fprintf fmt "(%a@ %a)@\n"
         pp_lname fn
         pp_mllam (MLlam(argsn, body)) in
     Array.iter pp_one_rec defs

From f505c2ca9f5d9bbd3b3718b31ff790c8dace9d4b Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 13:33:17 +0200
Subject: [PATCH 059/110] replaced arrays with normal memory blocks

---
 kernel/nativecode.ml | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 832b748be742..92a957ddd230 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1533,7 +1533,7 @@ let rec ml_of_lam env l t =
         let unit = fresh_lname env.env_cenv Anonymous in
         let args = Array.map (fun id -> MLlocal id) t_params.(i) in
         let mk_let i lname cont =
-          MLlet (lname, MLprimitive (Array_get, [|MLglobal knot; MLint i|]), cont)
+          MLlet (lname, MLprimitive (Array_get, [|MLint i; MLglobal knot|]), cont) (* in malfunction, the index is first *)
         in
         let self = Array.map (fun id -> MLlocal id) lf in
         let body = mkMLapp (MLglobal g) (Array.concat [fv_args'; self; args]) in
@@ -1544,7 +1544,7 @@ let rec ml_of_lam env l t =
       in
       (* Tie the knot *)
       let knot = push_global_cofix env.env_cenv knot fv_params (Array.mapi map t_norm_f) in
-      MLprimitive (Array_get, [|MLapp (MLglobal knot, fv_args); MLint start|])
+      MLprimitive (Array_get, [|MLint start; MLapp (MLglobal knot, fv_args)|]) (* in malfunction, the index is first *)
 
   | Lint tag -> MLprimitive (Mk_int, [|MLint tag|])
 
@@ -1873,7 +1873,7 @@ let pp_mllam fmt l =
     | MLprimitive (Force, args) ->
       Format.fprintf fmt "@[<2>(force%a)@]" pp_args args
     | MLprimitive (Array_get, args) ->
-      Format.fprintf fmt "@[<2>(load%a)@]" pp_args args
+      Format.fprintf fmt "@[<2>(field%a)@]" pp_args args (* we compile arrays as classical blocks, so array_get is just a field access (we do not mutate arrays) *)
     | MLprimitive (p, [||]) -> (* not a function and just a value *)
       Format.fprintf fmt "%a" pp_primitive p
     | MLprimitive (p, args) ->
@@ -1913,14 +1913,13 @@ let pp_mllam fmt l =
         Format.fprintf fmt
           "@[(switch %a@\n  ((tag 0) 1)@\n  (_ (tag _) 0))@]"
         pp_mllam c
-  and pp_cparam fmt param =
-    match param with
-    | Some l -> pp_mllam fmt (MLlocal l)
-    | None -> Format.fprintf fmt "_"
   and pp_cparams fmt params =
     let len = Array.length params in
     for i = 0 to len - 1 do
-      Format.fprintf fmt " (%a (field %i $matched_value))" pp_cparam params.(i) i
+      match params.(i) with
+      | None -> ()
+      | Some param ->
+        Format.fprintf fmt " (%a (field %i $matched_value))" pp_mllam (MLlocal param) i
     done
   and pp_branches fmt bs =
     let rec pp_branch fmt (cargs,body) =

From 16379d0224fad397ea4cf1eb0142e1396c852fb8 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:09:18 +0200
Subject: [PATCH 060/110] removed Obj_magic primitive as it is no longer needed

---
 kernel/nativecode.ml | 67 ++++++++++++++++++++------------------------
 1 file changed, 30 insertions(+), 37 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 92a957ddd230..3afe5f4abe3e 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -275,7 +275,6 @@ type primitive =
   | MLand
   | MLnot
   | MLland
-  | MLmagic
   | MLsubst_instance_instance
   | MLsubst_instance_sort
   | MLparray_of_array
@@ -319,7 +318,6 @@ let eq_primitive p1 p2 =
   | MLand, MLand
   | MLnot, MLnot
   | MLland, MLland
-  | MLmagic, MLmagic
   | MLsubst_instance_instance, MLsubst_instance_instance
   | MLsubst_instance_sort, MLsubst_instance_sort
   | MLparray_of_array, MLparray_of_array
@@ -372,7 +370,6 @@ let eq_primitive p1 p2 =
     | MLand
     | MLnot
     | MLland
-    | MLmagic
     | MLsubst_instance_instance
     | MLsubst_instance_sort
     | MLparray_of_array
@@ -418,32 +415,31 @@ let primitive_hash = function
   | Mk_evar -> 18
   | MLand -> 19
   | MLland -> 20
-  | MLmagic -> 21
-  | Coq_primitive (prim, b) -> combinesmall 22 (combine (CPrimitives.hash prim) (Hashtbl.hash b))
-  | Mk_proj -> 23
-  | MLsubst_instance_instance -> 24
-  | MLsubst_instance_sort -> 25
-  | Mk_float -> 26
-  | Is_float -> 27
-  | Is_string -> 28
-  | Is_parray -> 29
-  | MLnot -> 30
-  | MLparray_of_array -> 31
-  | Get_value -> 32
-  | Get_sort -> 33
-  | Get_name -> 34
-  | Get_const -> 35
-  | Get_match -> 36
-  | Get_ind -> 37
-  | Get_evar -> 38
-  | Get_instance -> 39
-  | Get_proj -> 40
-  | Get_symbols -> 41
-  | Lazy -> 42
-  | Force -> 43
-  | Mk_empty_instance -> 44
-  | Mk_string -> 45
-  | Str_decode -> 46
+  | Coq_primitive (prim, b) -> combinesmall 21 (combine (CPrimitives.hash prim) (Hashtbl.hash b))
+  | Mk_proj -> 22
+  | MLsubst_instance_instance -> 23
+  | MLsubst_instance_sort -> 24
+  | Mk_float -> 25
+  | Is_float -> 26
+  | Is_string -> 27
+  | Is_parray -> 28
+  | MLnot -> 29
+  | MLparray_of_array -> 30
+  | Get_value -> 31
+  | Get_sort -> 32
+  | Get_name -> 33
+  | Get_const -> 34
+  | Get_match -> 35
+  | Get_ind -> 36
+  | Get_evar -> 37
+  | Get_instance -> 38
+  | Get_proj -> 39
+  | Get_symbols -> 40
+  | Lazy -> 41
+  | Force -> 42
+  | Mk_empty_instance -> 43
+  | Mk_string -> 44
+  | Str_decode -> 45
 
 type mllambda =
   | MLlocal        of lname
@@ -1222,13 +1218,13 @@ let ml_of_instance env u =
       let u_code =
         if has_variable then
           (* if there are variables then [instance] guaranteed non-None *)
-          let univ = MLprimitive (MLmagic, [|MLlocal (Option.get instance)|]) in
+          let univ = MLlocal (Option.get instance) in
           MLprimitive (MLsubst_instance_instance, [|univ; u_code|])
         else u_code
       in
     u_code
     in
-    [|MLprimitive (MLmagic, [|u_code|])|]
+    [|u_code|]
 
 let ml_of_sort env s =
   let i = push_symbol env.env_cenv (SymbSort s) in
@@ -1237,7 +1233,7 @@ let ml_of_sort env s =
   | UGlobal | ULocal None -> s_code
   | ULocal (Some u) ->
     (* FIXME: use a dedicated cast function *)
-    let u = MLprimitive (MLmagic, [|MLlocal u|]) in
+    let u = MLlocal u in
     MLprimitive (MLsubst_instance_sort, [|u; s_code|])
   in
   MLprimitive (Mk_sort, [|s_code|])
@@ -1277,7 +1273,7 @@ let compile_prim env decl cond paux =
           List.fold_left
             (fun ml (_, c) -> app_prim MLland [| ml; cast_to_int c|])
             (MLint 0) ci in
-        app_prim MLmagic [|cond|] in
+        cond in
       let condo = match co with
         | [] -> MLint 0
         | (CPrimitives.PTE ty, c1) :: condo ->
@@ -1537,7 +1533,7 @@ let rec ml_of_lam env l t =
         in
         let self = Array.map (fun id -> MLlocal id) lf in
         let body = mkMLapp (MLglobal g) (Array.concat [fv_args'; self; args]) in
-        let body = MLprimitive (MLmagic, [|MLlam ([|unit|], Array.fold_right_i mk_let lf body)|]) in
+        let body = MLlam ([|unit|], Array.fold_right_i mk_let lf body) in
         let typs = mk_type in
         let self = mk_norm in
         mkMLlam t_params.(i) (MLprimitive ((Mk_cofix i), [| typs; self; body; MLarray args |]))
@@ -1866,8 +1862,6 @@ let pp_mllam fmt l =
       Format.fprintf fmt "(& %a)" pp_args args
     | MLprimitive (MLnot, args) ->
       Format.fprintf fmt "(== 0 %a)" pp_args args
-    | MLprimitive (MLmagic, args) -> (* Obj.magic is unneeded in malfunction *)
-      pp_args fmt args
     | MLprimitive (Lazy, args) -> (* lazy values must be treated separately *)
       Format.fprintf fmt "@[<2>(lazy%a)@]" pp_args args
     | MLprimitive (Force, args) ->
@@ -1994,7 +1988,6 @@ let pp_mllam fmt l =
     | Array_get
     | MLnot
     | MLland
-    | MLmagic
     | Force
     | Lazy -> assert false (* theses cases has been treated separately in pp_mllam *)
   in

From dd3ade117bba5dc4a3aae8d26f9e38fdd0f84b32 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:26:26 +0200
Subject: [PATCH 061/110] The compilation of logical and is now cleaner

---
 kernel/nativecode.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 3afe5f4abe3e..4f00f8771859 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1868,6 +1868,8 @@ let pp_mllam fmt l =
       Format.fprintf fmt "@[<2>(force%a)@]" pp_args args
     | MLprimitive (Array_get, args) ->
       Format.fprintf fmt "@[<2>(field%a)@]" pp_args args (* we compile arrays as classical blocks, so array_get is just a field access (we do not mutate arrays) *)
+    | MLprimitive (MLand, [|a; b|]) -> (* a and b are booleans *)
+      Format.fprintf fmt "(if %a %a 0)" pp_mllam a pp_mllam b
     | MLprimitive (p, [||]) -> (* not a function and just a value *)
       Format.fprintf fmt "%a" pp_primitive p
     | MLprimitive (p, args) ->
@@ -1967,7 +1969,7 @@ let pp_mllam fmt l =
     | Mk_int -> Format.fprintf fmt "(global $Nativevalues $mk_int)"
     | Val_to_int -> Format.fprintf fmt "(global $Nativevalues $val_to_int)"
     | Mk_evar -> Format.fprintf fmt "(global $Nativevalues $mk_evar_accu)"
-    | MLand -> Format.fprintf fmt "(lambda ($a $b) (if $a $b 0))"
+    | MLand -> Format.fprintf fmt "(lambda ($a $b) (if $a $b 0))" (* we keep this version to correctly compute clotures *)
     | MLsubst_instance_instance -> Format.fprintf fmt "(global $UVars $subst_instance_instance)"
     | MLsubst_instance_sort -> Format.fprintf fmt "(global $UVars $subst_instance_sort)"
     | MLparray_of_array -> Format.fprintf fmt "(global $Nativevalues $parray_of_array)"

From 389ea575b8959d596fb2ec0944bef6c2ec6249e8 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:40:05 +0200
Subject: [PATCH 062/110] fixed a comment

---
 kernel/nativecode.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 4f00f8771859..e1e7a412c0ec 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1858,7 +1858,7 @@ let pp_mllam fmt l =
           pp_ldecls ids pp_mllam body
     | MLsequence(l1,l2) ->
         Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam l1 pp_mllam l2
-    | MLprimitive (MLland, args) -> (* malfunction has a special operator for logical and *)
+    | MLprimitive (MLland, args) -> (* malfunction has a special operator for bitwise and *)
       Format.fprintf fmt "(& %a)" pp_args args
     | MLprimitive (MLnot, args) ->
       Format.fprintf fmt "(== 0 %a)" pp_args args

From 45a2e42d3ae21f714ded88c162e20bfdb7c70346 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:42:27 +0200
Subject: [PATCH 063/110] removed some support for the creation of clotures on
 primitives

---
 kernel/nativecode.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index e1e7a412c0ec..6b577f95478b 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1969,7 +1969,6 @@ let pp_mllam fmt l =
     | Mk_int -> Format.fprintf fmt "(global $Nativevalues $mk_int)"
     | Val_to_int -> Format.fprintf fmt "(global $Nativevalues $val_to_int)"
     | Mk_evar -> Format.fprintf fmt "(global $Nativevalues $mk_evar_accu)"
-    | MLand -> Format.fprintf fmt "(lambda ($a $b) (if $a $b 0))" (* we keep this version to correctly compute clotures *)
     | MLsubst_instance_instance -> Format.fprintf fmt "(global $UVars $subst_instance_instance)"
     | MLsubst_instance_sort -> Format.fprintf fmt "(global $UVars $subst_instance_sort)"
     | MLparray_of_array -> Format.fprintf fmt "(global $Nativevalues $parray_of_array)"
@@ -1987,6 +1986,7 @@ let pp_mllam fmt l =
     | Get_proj -> Format.fprintf fmt "(global $Nativecode $get_proj)"
     | Get_symbols -> Format.fprintf fmt "(global $Nativelib $get_symbols)"
     | Str_decode -> Format.fprintf fmt "(global $Nativevalues $str_decode)"
+    | MLand
     | Array_get
     | MLnot
     | MLland

From 2bd1cd7ce84f4a322025c034e70783c6da502b89 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:54:23 +0200
Subject: [PATCH 064/110] added a space to make code generation clearer

---
 kernel/nativecode.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 6b577f95478b..b52c2601b839 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1821,7 +1821,7 @@ let string_of_gname g =
   if String.contains ret '.' then (* the global name comes from a module *)
     let ret = String.split_on_char '.' ret in
     let ret = String.concat " $" ret in 
-    Format.sprintf "(global%s)" ret
+    Format.sprintf "(global %s)" ret
   else ret
 
 let pp_gname fmt g =

From e7862cd99655358a85d776ff0493e169a9d742e4 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 11:48:33 +0200
Subject: [PATCH 065/110] removed annotations from matches as they are no
 longer needed

---
 kernel/nativecode.ml | 66 +++++++++++++++++++++-----------------------
 1 file changed, 31 insertions(+), 35 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index b52c2601b839..516ad26cf4a3 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -450,7 +450,7 @@ type mllambda =
   | MLlet          of lname * mllambda * mllambda
   | MLapp          of mllambda * mllambda array
   | MLif           of mllambda * mllambda * mllambda
-  | MLmatch        of annot_sw * mllambda * mllambda * mllam_branches
+  | MLmatch        of mllambda * mllambda * mllam_branches
                               (* argument, prefix, accu branch, branches *)
   | MLconstruct    of string * inductive * int * mllambda array
                    (* prefix, inductive name, tag, arguments *)
@@ -517,8 +517,7 @@ let rec eq_mllambda gn1 gn2 n env1 env2 t1 t2 =
       eq_mllambda gn1 gn2 n env1 env2 cond1 cond2 &&
       eq_mllambda gn1 gn2 n env1 env2 br1 br2 &&
       eq_mllambda gn1 gn2 n env1 env2 br'1 br'2
-  | MLmatch (annot1, c1, accu1, br1), MLmatch (annot2, c2, accu2, br2) ->
-      eq_annot_sw annot1 annot2 &&
+  | MLmatch (c1, accu1, br1), MLmatch (c2, accu2, br2) ->
       eq_mllambda gn1 gn2 n env1 env2 c1 c2 &&
       eq_mllambda gn1 gn2 n env1 env2 accu1 accu2 &&
       eq_mllam_branches gn1 gn2 n env1 env2 br1 br2
@@ -611,11 +610,10 @@ let rec hash_mllambda gn n env t =
       let hbr = hash_mllambda gn n env br in
       let hbr' = hash_mllambda gn n env br' in
       combinesmall 8 (combine3 hcond hbr hbr')
-  | MLmatch (annot, c, accu, br) ->
-      let hannot = hash_annot_sw annot in
+  | MLmatch (c, accu, br) ->
       let hc = hash_mllambda gn n env c in
       let haccu = hash_mllambda gn n env accu in
-      combinesmall 9 (hash_mllam_branches gn n env (combine3 hannot hc haccu) br)
+      combinesmall 9 (hash_mllam_branches gn n env (combine hc haccu) br)
   | MLconstruct (pf, ind, tag, args) ->
       let hpf = String.hash pf in
       let hcs = Ind.UserOrd.hash ind in
@@ -695,7 +693,7 @@ let fv_lam l =
         Array.fold_right fv_arg args (aux f bind fv)
     | MLif(t,b1,b2) ->
         aux t bind (aux b1 bind (aux b2 bind fv))
-    | MLmatch(_,a,p,bs) ->
+    | MLmatch(a,p,bs) ->
       let fv = aux a bind (aux p bind fv) in
       let fv_bs (cargs, body) fv =
         let bind =
@@ -769,13 +767,13 @@ let eq_global g1 g2 =
       Array.for_all2 (eq_mllambda gn1 gn2 (Array.length lns1) env1 env2) mls1 mls2
   | Glet (gn1, def1), Glet (gn2, def2) ->
       eq_mllambda gn1 gn2 0 LNmap.empty LNmap.empty def1 def2
-  | Gletcase (gn1,lns1,annot1,c1,accu1,br1),
-      Gletcase (gn2,lns2,annot2,c2,accu2,br2) ->
+  | Gletcase (gn1,lns1,_,c1,accu1,br1),
+      Gletcase (gn2,lns2,_,c2,accu2,br2) ->
       Int.equal (Array.length lns1) (Array.length lns2) &&
       let env1 = push_lnames 0 LNmap.empty lns1 in
       let env2 = push_lnames 0 LNmap.empty lns2 in
-      let t1 = MLmatch (annot1,c1,accu1,br1) in
-      let t2 = MLmatch (annot2,c2,accu2,br2) in
+      let t1 = MLmatch (c1,accu1,br1) in
+      let t2 = MLmatch (c2,accu2,br2) in
       eq_mllambda gn1 gn2 (Array.length lns1) env1 env2 t1 t2
   | Gopen s1, Gopen s2 -> String.equal s1 s2
   | Gtype (ind1, arr1), Gtype (ind2, arr2) ->
@@ -806,10 +804,10 @@ let hash_global g =
       combinesmall 3 hmls
   | Glet (gn, def) ->
       combinesmall 4 (hash_mllambda gn 0 LNmap.empty def)
-  | Gletcase (gn,lns,annot,c,accu,br) ->
+  | Gletcase (gn,lns,_,c,accu,br) ->
       let nlns = Array.length lns in
       let env = push_lnames 0 LNmap.empty lns in
-      let t = MLmatch (annot,c,accu,br) in
+      let t = MLmatch (c,accu,br) in
       combinesmall 5 (combine nlns (hash_mllambda gn nlns env t))
   | Gopen s -> combinesmall 5 (String.hash s)
   | Gtype (ind, arr) ->
@@ -1606,9 +1604,9 @@ let subst s l =
       | MLlet(id,def,body) -> MLlet(id,aux def, aux body)
       | MLapp(f,args) -> MLapp(aux f, Array.map aux args)
       | MLif(t,b1,b2) -> MLif(aux t, aux b1, aux b2)
-      | MLmatch(annot,a,accu,bs) ->
+      | MLmatch(a,accu,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
-          MLmatch(annot,a,aux accu, Array.map auxb bs)
+          MLmatch(a,aux accu, Array.map auxb bs)
       | MLconstruct(prefix,c,tag,args) -> MLconstruct(prefix,c,tag,Array.map aux args)
       | MLsetref(s,l1) -> MLsetref(s,aux l1)
       | MLsequence(l1,l2) -> MLsequence(aux l1, aux l2)
@@ -1656,13 +1654,13 @@ let all_lam n bs =
     | _ -> false in
   Array.for_all f bs
 
-let commutative_cut annot a accu bs args =
+let commutative_cut a accu bs args =
   let mkb (c,b) =
      match b with
      | MLlam(params, body) ->
          (c, Array.fold_left2 (fun body x v -> MLlet(x,v,body)) body params args)
      | _ -> assert false in
-  MLmatch(annot, a, mkMLapp accu args, Array.map mkb bs)
+  MLmatch( a, mkMLapp accu args, Array.map mkb bs)
 
 let optimize gdef l =
   let rec optimize s l =
@@ -1699,9 +1697,9 @@ let optimize gdef l =
         | _ ->
             let f = optimize s f in
             match f with
-            | MLmatch (annot,a,accu,bs) ->
+            | MLmatch (a,accu,bs) ->
               if all_lam (Array.length args) bs then
-                commutative_cut annot a accu bs args
+                commutative_cut a accu bs args
               else MLapp(f, args)
             | _ -> MLapp(f, args)
 
@@ -1713,13 +1711,13 @@ let optimize gdef l =
         let b1 = optimize s b1 in
         let b2 = optimize s b2 in
         begin match t, b2 with
-        | MLisaccu (_, _, l1), MLmatch(annot, l2, _, bs)
-            when eq_mllambda l1 l2 -> MLmatch(annot, l1, b1, bs)
+        | MLisaccu (_, _, l1), MLmatch(l2, _, bs)
+            when eq_mllambda l1 l2 -> MLmatch(l1, b1, bs)
         | _, _ -> MLif(t, b1, b2)
         end
-    | MLmatch(annot,a,accu,bs) ->
+    | MLmatch(a,accu,bs) ->
         let opt_b (cargs,body) = (cargs,optimize s body) in
-        MLmatch(annot, optimize s a, subst s accu, Array.map opt_b bs)
+        MLmatch(optimize s a, subst s accu, Array.map opt_b bs)
     | MLconstruct(prefix,c,tag,args) ->
         MLconstruct(prefix,c,tag,Array.map (optimize s) args)
     | MLsetref(r,l) -> MLsetref(r, optimize s l)
@@ -1735,9 +1733,9 @@ let optimize_stk stk =
     | Glet (Gnorm (_,i), body) ->
         let (gnorm, gcase) = gdef in
         (Int.Map.add i (decompose_MLlam body) gnorm, gcase)
-    | Gletcase(Gcase (_,i), params, annot,a,accu,bs) ->
+    | Gletcase(Gcase (_,i), params, _,a,accu,bs) ->
         let (gnorm,gcase) = gdef in
-        (gnorm, Int.Map.add i (params,MLmatch(annot,a,accu,bs)) gcase)
+        (gnorm, Int.Map.add i (params,MLmatch(a,accu,bs)) gcase)
     | Gletcase _ -> assert false
     | _ -> gdef in
   let gdef = List.fold_left add_global empty_gdef stk in
@@ -1895,7 +1893,7 @@ let pp_mllam fmt l =
       Format.fprintf fmt ")@]"
     | MLsetref (s, body) ->
         Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam body
-    | MLmatch (_, c, accu_br, br) ->
+    | MLmatch (c, accu_br, br) ->
       Format.fprintf fmt (* accumulator is always tag 0 *)
         "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 0)@\n    %a)@\n  @[%a@]))@]"
         pp_mllam c pp_mllam accu_br pp_branches br
@@ -2014,9 +2012,9 @@ let pp_cofix fmt (gn, s) =
       | MLlet(id,def,body) -> MLlet(id,aux def, aux body)
       | MLapp(f,args) -> MLapp(aux f, Array.map aux args)
       | MLif(t,b1,b2) -> MLif(aux t, aux b1, aux b2)
-      | MLmatch(annot,a,accu,bs) ->
+      | MLmatch(a,accu,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
-          MLmatch(annot,a,aux accu, Array.map auxb bs)
+          MLmatch(a,aux accu, Array.map auxb bs)
       | MLconstruct(prefix,c,tag,args) -> MLconstruct(prefix,c,tag,Array.map aux args)
       | MLsetref(s,l1) -> MLsetref(s,aux l1)
       | MLsequence(l1,l2) -> MLsequence(aux l1, aux l2)
@@ -2068,16 +2066,16 @@ let pp_global fmt g =
     Format.fprintf fmt "@[;type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
   | Gopen _ ->
       () (* open do not exist in malfunction, and there is no interest in leaving them as comments *)
-  | Gletcase(gn,[||],annot,a,accu,bs) -> (* simple biding and not a function *)
+  | Gletcase(gn,[||],_,a,accu,bs) -> (* simple biding and not a function *)
       Format.fprintf fmt "@[; Hash = %i@\n(%a %a)@]@\n@." (* no need to be recursive as we are sane and do not create recursive values other than functions *)
       (hash_global g)
         pp_gname gn
-        pp_mllam (MLmatch(annot,a,accu,bs))
-  | Gletcase(gn,params,annot,a,accu,bs) -> (* a function *)
+        pp_mllam (MLmatch(a,accu,bs))
+  | Gletcase(gn,params,_,a,accu,bs) -> (* a function *)
       Format.fprintf fmt "@[; Hash = %i@\n(rec (%a (lambda (%a)@\n  %a)))@]@\n@."
       (hash_global g)
         pp_gname gn pp_ldecls params
-        pp_mllam (MLmatch(annot,a,accu,bs))
+        pp_mllam (MLmatch(a,accu,bs))
   | Gtblfixtype (g, [||], t) -> (* not a function but a definition *)
       Format.fprintf fmt "@[<2>(%a %a)@]@\n@." pp_gname g
         pp_array t
@@ -2259,8 +2257,6 @@ let compile_mind cenv mb mind stack =
     let add_proj proj_arg acc _pb =
       let tbl = ob.mind_reloc_tbl in
       (* Building info *)
-      let asw = { asw_ind = ind; asw_prefix = "";
-                  asw_reloc = tbl } in
       let c_uid = fresh_lname cenv Anonymous in
       let cf_uid = fresh_lname cenv Anonymous in
       let tag, arity = tbl.(0) in
@@ -2272,7 +2268,7 @@ let compile_mind cenv mb mind stack =
       let i = push_symbol cenv (SymbProj (ind, proj_arg)) in
       let accu = MLprimitive (Cast_accu, [|MLlocal cf_uid|]) in
       let accu_br = MLprimitive (Mk_proj, [|get_proj_code i;accu|]) in
-      let code = MLmatch(asw,MLlocal cf_uid,accu_br,[|[NonConstPattern (tag,cargs)],MLlocal ci_uid|]) in
+      let code = MLmatch(MLlocal cf_uid,accu_br,[|[NonConstPattern (tag,cargs)],MLlocal ci_uid|]) in
       let force_c =
         if mb.mind_finite <> CoFinite
         then MLlocal c_uid

From 862960924fe7edb0db64ad8e06546760fec16298 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 11:53:23 +0200
Subject: [PATCH 066/110] removed annotations from Gletcase as they are no
 longer needed

---
 kernel/nativecode.ml | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 516ad26cf4a3..3fbc3fc495b7 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -748,7 +748,7 @@ type global =
   | Gtblfixtype of gname * lname array * mllambda array
   | Glet of gname * mllambda
   | Gletcase of
-      gname * lname array * annot_sw * mllambda * mllambda * mllam_branches
+      gname * lname array * mllambda * mllambda * mllam_branches
   | Gopen of string
   | Gtype of inductive * (tag * int) array
     (* ind name, tag and arities of constructors *)
@@ -767,8 +767,8 @@ let eq_global g1 g2 =
       Array.for_all2 (eq_mllambda gn1 gn2 (Array.length lns1) env1 env2) mls1 mls2
   | Glet (gn1, def1), Glet (gn2, def2) ->
       eq_mllambda gn1 gn2 0 LNmap.empty LNmap.empty def1 def2
-  | Gletcase (gn1,lns1,_,c1,accu1,br1),
-      Gletcase (gn2,lns2,_,c2,accu2,br2) ->
+  | Gletcase (gn1,lns1,c1,accu1,br1),
+      Gletcase (gn2,lns2,c2,accu2,br2) ->
       Int.equal (Array.length lns1) (Array.length lns2) &&
       let env1 = push_lnames 0 LNmap.empty lns1 in
       let env2 = push_lnames 0 LNmap.empty lns2 in
@@ -804,7 +804,7 @@ let hash_global g =
       combinesmall 3 hmls
   | Glet (gn, def) ->
       combinesmall 4 (hash_mllambda gn 0 LNmap.empty def)
-  | Gletcase (gn,lns,_,c,accu,br) ->
+  | Gletcase (gn,lns,c,accu,br) ->
       let nlns = Array.length lns in
       let env = push_lnames 0 LNmap.empty lns in
       let t = MLmatch (c,accu,br) in
@@ -900,8 +900,8 @@ let push_global_norm cenv gn params body =
 let push_global_cofix cenv gn params self =
   push_global cenv gn (Gtblcofix (gn, params, self))
 
-let push_global_case cenv gn params annot a accu bs =
-  push_global cenv gn (Gletcase (gn, params, annot, a, accu, bs))
+let push_global_case cenv gn params a accu bs =
+  push_global cenv gn (Gletcase (gn, params, a, accu, bs))
 
 let push_symbol cenv x =
   try HashtblSymbol.find cenv.symb_tbl x
@@ -1396,7 +1396,7 @@ let rec ml_of_lam env l t =
 (*      let body = MLlam([|a_uid|], MLmatch(annot, la_uid, accu, bs)) in
       let case = generalize_fv env_c body in *)
       let cn = push_global_case env.env_cenv cn (Array.append (fv_params env_c) [|a_uid|])
-        annot la_uid accu (merge_branches br)
+        la_uid accu (merge_branches br)
       in
       (* Final result *)
       let arg = ml_of_lam env l a in
@@ -1733,7 +1733,7 @@ let optimize_stk stk =
     | Glet (Gnorm (_,i), body) ->
         let (gnorm, gcase) = gdef in
         (Int.Map.add i (decompose_MLlam body) gnorm, gcase)
-    | Gletcase(Gcase (_,i), params, _,a,accu,bs) ->
+    | Gletcase(Gcase (_,i), params,a,accu,bs) ->
         let (gnorm,gcase) = gdef in
         (gnorm, Int.Map.add i (params,MLmatch(a,accu,bs)) gcase)
     | Gletcase _ -> assert false
@@ -2066,12 +2066,12 @@ let pp_global fmt g =
     Format.fprintf fmt "@[;type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
   | Gopen _ ->
       () (* open do not exist in malfunction, and there is no interest in leaving them as comments *)
-  | Gletcase(gn,[||],_,a,accu,bs) -> (* simple biding and not a function *)
+  | Gletcase(gn,[||],a,accu,bs) -> (* simple biding and not a function *)
       Format.fprintf fmt "@[; Hash = %i@\n(%a %a)@]@\n@." (* no need to be recursive as we are sane and do not create recursive values other than functions *)
       (hash_global g)
         pp_gname gn
         pp_mllam (MLmatch(a,accu,bs))
-  | Gletcase(gn,params,_,a,accu,bs) -> (* a function *)
+  | Gletcase(gn,params,a,accu,bs) -> (* a function *)
       Format.fprintf fmt "@[; Hash = %i@\n(rec (%a (lambda (%a)@\n  %a)))@]@\n@."
       (hash_global g)
         pp_gname gn pp_ldecls params
@@ -2103,7 +2103,7 @@ let global_to_mlf_name g =
   | Gtblfixtype (gn,_,_)
   | Gtblnorm (gn,_,_)
   | Gtblcofix (gn,_,_)
-  | Gletcase(gn,_,_,_,_,_)
+  | Gletcase(gn,_,_,_,_)
   | Glet (gn,_) ->
     let gn = string_of_gname gn in
     if gn = "_" || gn = "" then None else Some gn
@@ -2116,7 +2116,7 @@ let pp_global_interface fmt g =
   | Gtblnorm (_,_,_)
   | Gtblcofix (_,_,_)
   | Gtblfixtype (_,_,_)
-  | Gletcase (_,_,_,_,_,_)
+  | Gletcase (_,_,_,_,_)
   | Glet (_,_) ->
     begin match global_to_mlf_name g with
     | None -> ()

From 261cc4a7140e65bc378f18ef557e85da55211f2d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 14:13:10 +0200
Subject: [PATCH 067/110] updated Dockerfile to add malfunction as an opam pin

---
 .gitlab-ci.yml                          | 4 ++--
 dev/ci/docker/edge_ubuntu/Dockerfile    | 3 ++-
 dev/ci/docker/old_ubuntu_lts/Dockerfile | 4 +++-
 3 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 511c6a533dab..e3748259c968 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -40,8 +40,8 @@ variables:
   # The $hash is the first 10 characters of the md5 of the Dockerfile. e.g.
   # echo $(md5sum dev/ci/docker/old_ubuntu_lts/Dockerfile | head -c 10)
   # echo $(md5sum dev/ci/docker/edge_ubuntu/Dockerfile | head -c 10)
-  BASE_CACHEKEY: "old_ubuntu_lts-V2026-07-06-00242ff07f"
-  EDGE_CACHEKEY: "edge_ubuntu-V2026-07-06-62b9804f8c"
+  BASE_CACHEKEY: "old_ubuntu_lts-V2026-06-17-3f4ccef838"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-06-17-d451657c63"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 
diff --git a/dev/ci/docker/edge_ubuntu/Dockerfile b/dev/ci/docker/edge_ubuntu/Dockerfile
index 8d0e0697e360..ec2e5d8c0698 100644
--- a/dev/ci/docker/edge_ubuntu/Dockerfile
+++ b/dev/ci/docker/edge_ubuntu/Dockerfile
@@ -53,7 +53,7 @@ RUN mkdir -p ~/.config/dune && printf '(lang dune 2.1)\n(jobs %s)\n' $NJOBS > ~/
 
 # Edge opam is the set of edge packages required by Coq
 ENV COMPILER="4.14.2" \
-    BASE_OPAM="zarith.1.14 ounit2.2.2.7 camlzip.1.14" \
+    BASE_OPAM="zarith.1.14 ounit2.2.2.7 camlzip.1.14 ocaml-compiler-libs" \
     CI_OPAM="ocamlgraph.2.0.0 cppo.1.8.0" \
     BASE_OPAM_EDGE="dune.3.23.1 dune-build-info.3.23.1 dune-release.2.2.1 ocamlfind.1.9.8 odoc.3.2.1" \
     CI_OPAM_EDGE="memprof-limits.0.3.0 elpi.3.7.1 ppx_import.1.12.0 cmdliner.2.1.1 sexplib.v0.16.0 ppx_sexp_conv.v0.16.0 ppx_hash.v0.16.0 ppx_compare.v0.16.0 ppx_deriving_yojson.3.9.1 yojson.2.2.2 uri.4.4.0 ppx_yojson_conv.v0.16.0 ppx_inline_test.v0.16.1 ppx_assert.v0.16.0 ppx_optcomp.v0.16.0 lsp.1.26.0 sel.0.8.0" \
@@ -68,6 +68,7 @@ RUN opam init -a --disable-sandboxing --bare && eval $(opam env) && \
     opam repo add archive git+https://github.com/ocaml/opam-repository-archive && \
     opam update && \
     opam install $BASE_OPAM $BASE_OPAM_EDGE $COQIDE_OPAM_EDGE $CI_OPAM $CI_OPAM_EDGE && \
+    opam pin add git+https://github.com/IBBXEF/malfunction#recusive_types && \
     opam clean -a -c
 
 # set the locale for the benefit of Python
diff --git a/dev/ci/docker/old_ubuntu_lts/Dockerfile b/dev/ci/docker/old_ubuntu_lts/Dockerfile
index 2626e66b3b01..670220c5aef6 100644
--- a/dev/ci/docker/old_ubuntu_lts/Dockerfile
+++ b/dev/ci/docker/old_ubuntu_lts/Dockerfile
@@ -55,7 +55,7 @@ RUN mkdir -p ~/.config/dune && printf '(lang dune 2.1)\n(jobs %s)\n' $NJOBS > ~/
 ENV COMPILER="4.14.0"
 
 # Common OPAM packages
-ENV BASE_OPAM="zarith.1.11 ounit2.2.2.6 yojson.1.7.0 camlzip.1.10" \
+ENV BASE_OPAM="zarith.1.11 ounit2.2.2.6 yojson.1.7.0 camlzip.1.10 ocaml-compiler-libs" \
     CI_OPAM="ocamlgraph.2.0.0 cppo.1.6.9" \
     BASE_ONLY_OPAM="dune.3.21.1 stdlib-shims.0.1.0 ocamlfind.1.9.1 odoc.3.2.1 num.1.4"
 
@@ -70,6 +70,7 @@ RUN opam init -a --disable-sandboxing --compiler="$COMPILER" default https://opa
     opam repo add archive git+https://github.com/ocaml/opam-repository-archive && \
     opam update && \
     opam install $BASE_OPAM $COQIDE_OPAM $CI_OPAM $BASE_ONLY_OPAM && \
+    opam pin add git+https://github.com/IBBXEF/malfunction#recusive_types && \
     opam clean -a -c && \
     find ~ '(' -name '*.cmt' -o -name '*.cmti' ')' -delete
 
@@ -81,6 +82,7 @@ RUN opam switch create "${COMPILER}+32bit" \
     opam update && \
     i386 env CC='gcc -m32' opam install zarith.1.11 && \
     opam install $BASE_OPAM && \
+    opam pin add git+https://github.com/IBBXEF/malfunction#recusive_types && \
     opam clean -a -c && \
     find ~ '(' -name '*.cmt' -o -name '*.cmti' ')' -delete
 

From 138cc5c9a4243117f28b864577179574dd1c1c5e Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 19 Jun 2026 13:04:26 +0200
Subject: [PATCH 068/110] The compilation of Uint, float, and pstring into mlf
 is now separated in a different function to stay compatible with extraction

---
 kernel/float64.mli        | 2 ++
 kernel/float64_common.ml  | 8 ++++++--
 kernel/float64_common.mli | 2 ++
 kernel/nativecode.ml      | 6 +++---
 kernel/pstring.ml         | 3 +++
 kernel/pstring.mli        | 5 ++++-
 kernel/uint63.mli         | 2 ++
 kernel/uint63_31.ml       | 5 ++++-
 kernel/uint63_63.ml       | 5 ++++-
 9 files changed, 30 insertions(+), 8 deletions(-)

diff --git a/kernel/float64.mli b/kernel/float64.mli
index 0d2fcaaac7e7..b264d68a0a0d 100644
--- a/kernel/float64.mli
+++ b/kernel/float64.mli
@@ -34,6 +34,8 @@ val to_string : t -> string
 
 val compile : t -> string
 
+val compile_mlf : t -> string
+
 val of_float : float -> t
 
 (** All NaNs are normalized to [Stdlib.nan].
diff --git a/kernel/float64_common.ml b/kernel/float64_common.ml
index e2380a3c958a..8769361c9146 100644
--- a/kernel/float64_common.ml
+++ b/kernel/float64_common.ml
@@ -37,8 +37,12 @@ let to_string = to_string_raw "%.17g"
 
 let of_string = float_of_string
 
-(* Compiles a float to malfunction code *)
-let compile f = (* malfunction does not support writing -1.1, so we have to be careful *)
+(* Compiles a float to OCaml code *)
+let compile f =
+  Printf.sprintf "Float64.of_float (%s)" (to_hex_string f)
+
+  (* Compiles a float to malfunction code *)
+let compile_mlf f = (* malfunction does not support writing -1.1, so we have to be careful *)
   if Float.is_nan f then "(apply (global $Float64 $of_float) nan)"
   else if Float.is_infinite f then begin
     if f < 0. then Printf.sprintf "(apply (global $Float64 $of_float) neg_infinity)"
diff --git a/kernel/float64_common.mli b/kernel/float64_common.mli
index 61c061af90b2..9f8d8d208d3a 100644
--- a/kernel/float64_common.mli
+++ b/kernel/float64_common.mli
@@ -34,6 +34,8 @@ val to_string : t -> string
 
 val compile : t -> string
 
+val compile_mlf : t -> string
+
 val of_float : float -> t
 
 (** All NaNs are normalized to [Stdlib.nan].
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 3fbc3fc495b7..d76f94ff6e96 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1848,9 +1848,9 @@ let pp_mllam fmt l =
     match l with
     | MLint i when i >= 0 -> Format.fprintf fmt "%i" i
     | MLint i -> Format.fprintf fmt "(neg %i)" (-i) (* i < 0 *)
-    | MLuint i -> Format.fprintf fmt "%s" (Uint63.compile i)
-    | MLfloat f -> Format.fprintf fmt "%s" (Float64.compile f)
-    | MLstring s -> Format.fprintf fmt "%s" (Pstring.compile s)
+    | MLuint i -> Format.fprintf fmt "%s" (Uint63.compile_mlf i)
+    | MLfloat f -> Format.fprintf fmt "%s" (Float64.compile_mlf f)
+    | MLstring s -> Format.fprintf fmt "%s" (Pstring.compile_mlf s)
     | MLlam(ids,body) ->
         Format.fprintf fmt "@[<2>(lambda (%a) @ %a)@]"
           pp_ldecls ids pp_mllam body
diff --git a/kernel/pstring.ml b/kernel/pstring.ml
index 63f2e40d285b..0b833d89729c 100644
--- a/kernel/pstring.ml
+++ b/kernel/pstring.ml
@@ -75,4 +75,7 @@ let hash : t -> int =
 let unsafe_of_string : string -> t = fun s -> s
 
 let compile : t -> string =
+  Printf.sprintf "Pstring.unsafe_of_string %S"
+
+let compile_mlf : t -> string =
   Printf.sprintf "(apply (global $Pstring $unsafe_of_string) %S)"
diff --git a/kernel/pstring.mli b/kernel/pstring.mli
index 54c4484652c2..49fc45a97812 100644
--- a/kernel/pstring.mli
+++ b/kernel/pstring.mli
@@ -64,5 +64,8 @@ val hash : t -> int
     code, via [compile]. *)
 val unsafe_of_string : string -> t
 
-(** [compile s] outputs a malfunction expression producing primitive string [s]. *)
+(** [compile s] outputs an OCaml expression producing primitive string [s]. *)
 val compile : t -> string
+
+(** [compile_mlf s] outputs a malfunction expression producing primitive string [s]. *)
+val compile_mlf : t -> string
diff --git a/kernel/uint63.mli b/kernel/uint63.mli
index e77bd78eea37..995885d21d3f 100644
--- a/kernel/uint63.mli
+++ b/kernel/uint63.mli
@@ -36,6 +36,8 @@ val to_string : t -> string
 
 val compile : t -> string
 
+val compile_mlf : t -> string
+
 (* constants *)
 val zero    : t
 val one : t
diff --git a/kernel/uint63_31.ml b/kernel/uint63_31.ml
index ab7cf7657106..820e332f82ce 100644
--- a/kernel/uint63_31.ml
+++ b/kernel/uint63_31.ml
@@ -42,8 +42,11 @@ let hash i =
     (* conversion of an uint63 to a string *)
 let to_string i = Int64.to_string i
 
+(* Compiles an unsigned int to OCaml code *)
+let compile i = Printf.sprintf "Uint63.of_int64 (%LiL)" i
+
 (* Compiles an unsigned int to malfunction code *)
-let compile i =
+let compile_mlf i =
   if Int64.compare i 0L >= 0 then Printf.sprintf "(apply (global &Uint63 &of_int64) %Li.i64)" i (* the internal value (a signed integer) is positive *)
   else Printf.sprintf "(apply (global &Uint63 &of_int64) (neg.i64 %Li.i64))" (Int64.neg i) (* the internal value is negative and we must take it into account *)
 
diff --git a/kernel/uint63_63.ml b/kernel/uint63_63.ml
index 6150fc7cc57a..99347be4c135 100644
--- a/kernel/uint63_63.ml
+++ b/kernel/uint63_63.ml
@@ -40,8 +40,11 @@ let hash i = i
     (* conversion of an uint63 to a string *)
 let to_string i = Int64.to_string (to_uint64 i)
 
+(* Compiles an unsigned int to OCaml code *)
+let compile i = Printf.sprintf "Uint63.of_int (%i)" i
+
 (* Compiles an unsigned int to malfunction code *)
-let compile i =
+let compile_mlf i =
   if i >= 0 then Printf.sprintf "(apply (global $Uint63 $of_int) %i)" i
   else Printf.sprintf "(apply (global $Uint63 $of_int) (neg %i))" (-i)
 

From 423641e021feb868fa50b5040f52150acef77049 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 23 Jun 2026 10:52:33 +0200
Subject: [PATCH 069/110] updated benchmarks

---
 dev/bench/bench.sh | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/dev/bench/bench.sh b/dev/bench/bench.sh
index 55b57436dc74..4830f2c8ce84 100755
--- a/dev/bench/bench.sh
+++ b/dev/bench/bench.sh
@@ -437,6 +437,8 @@ create_opam() {
     opam install -qy -j "$number_of_processors" $initial_opam_packages
     if [ ! -z "$BENCH_DEBUG" ]; then opam repo list; fi
 
+    opam pin add -qy -j "$number_of_processors" git+https://github.com/IBBXEF/malfunction#recusive_types
+
     cd "$coq_dir"
     echo "$1_coq_commit = $COQ_HASH"
 

From 5928a2b2bfbdb1fe4155291c24babd985a378518 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 23 Jun 2026 11:53:10 +0200
Subject: [PATCH 070/110] enabled native for benchmarks

---
 dev/bench/bench.sh | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/dev/bench/bench.sh b/dev/bench/bench.sh
index 4830f2c8ce84..8146d9cf4420 100755
--- a/dev/bench/bench.sh
+++ b/dev/bench/bench.sh
@@ -49,8 +49,8 @@ check_variable () {
 : "${old_coq_version:=dev}"
 : "${num_of_iterations:=1}"
 : "${timeout:=3h}"
-: "${coq_opam_packages:=rocq-stdlib rocq-bignums coq-hott coq-performance-tests-lite coq-engine-bench-lite rocq-elpi rocq-mathcomp-boot rocq-mathcomp-order rocq-mathcomp-ssreflect rocq-mathcomp-finite-group rocq-mathcomp-algebra rocq-mathcomp-solvable rocq-mathcomp-field rocq-mathcomp-group-representation coq-mathcomp-odd-order rocq-mathcomp-analysis coq-math-classes coq-corn coq-compcert rocq-equations rocq-metarocq-utils rocq-metarocq-common rocq-metarocq-template rocq-metarocq-pcuic rocq-metarocq-safechecker rocq-metarocq-erasure rocq-metarocq-translations coq-color coq-coqprime coq-coqutil coq-bedrock2 coq-rewriter coq-fiat-core coq-fiat-parsers coq-fiat-crypto-with-bedrock coq-unimath coq-coquelicot coq-iris-examples coq-fourcolor coq-rewriter-perf-SuperFast coq-vst coq-category-theory coq-neural-net-interp-computed-lite}"
-: "${coq_native:=}"
+: "${coq_opam_packages:=rocq-stdlib rocq-bignums coq-hott coq-performance-tests-lite coq-engine-bench-lite rocq-elpi rocq-mathcomp-boot rocq-mathcomp-order rocq-mathcomp-ssreflect rocq-mathcomp-finite-group rocq-mathcomp-algebra rocq-mathcomp-solvable rocq-mathcomp-field rocq-mathcomp-group-representation coq-mathcomp-odd-order coq-mathcomp-analysis coq-math-classes coq-corn coq-compcert rocq-equations rocq-metarocq-utils rocq-metarocq-common rocq-metarocq-template rocq-metarocq-pcuic rocq-metarocq-safechecker rocq-metarocq-erasure rocq-metarocq-translations coq-color coq-coqprime coq-coqutil coq-bedrock2 coq-rewriter coq-fiat-core coq-fiat-parsers coq-fiat-crypto-with-bedrock coq-unimath coq-coquelicot coq-iris-examples coq-fourcolor coq-rewriter-perf-SuperFast coq-vst coq-category-theory coq-neural-net-interp-computed-lite}"
+: "${coq_native:=1}"
 : "${auto_overlays:=1}"
 
 # example: coq-hott.dev git+https://github.com/some-user/coq-hott#some-branch

From ac8a08ec6f76d5779837423494196efda901ec06 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 6 Jul 2026 15:13:35 +0200
Subject: [PATCH 071/110] now compiles with Oclassic

---
 kernel/nativelib.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 56104f8cf5f9..2236caa9f2aa 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -148,11 +148,11 @@ let call_compiler ?profile:(profile=false) mlf_filename =
     else
       []
   in
-  (* let flambda_args = if Sys.(backend_type = Native) then ["-Oclassic"] else [] in *)
+  let flambda_args = if Sys.(backend_type = Native) then ["-Oclassic"] else [] in
   let args =
       ["cmx"; mlf_filename] @
       profile_args @
-        (* flambda_args @ *)
+        flambda_args @
       ("-o"::link_filename
        ::"-rectypes"
        ::"-I"::(Filename.dirname mlf_filename)

From 7f3e2dd9e1ec203c637aa18c74c566d01020bd1f Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 7 Jul 2026 12:57:03 +0200
Subject: [PATCH 072/110] updated ci hash key

---
 .gitlab-ci.yml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index e3748259c968..13328fe26519 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -40,8 +40,8 @@ variables:
   # The $hash is the first 10 characters of the md5 of the Dockerfile. e.g.
   # echo $(md5sum dev/ci/docker/old_ubuntu_lts/Dockerfile | head -c 10)
   # echo $(md5sum dev/ci/docker/edge_ubuntu/Dockerfile | head -c 10)
-  BASE_CACHEKEY: "old_ubuntu_lts-V2026-06-17-3f4ccef838"
-  EDGE_CACHEKEY: "edge_ubuntu-V2026-06-17-d451657c63"
+  BASE_CACHEKEY: "old_ubuntu_lts-V2026-07-07-3f4ccef838"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-07-07-d451657c63"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 

From 15bc055226103550d6d043bc47c80e7e5879e06c Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 7 Jul 2026 16:40:36 +0200
Subject: [PATCH 073/110] updated Dockerfile

---
 .gitlab-ci.yml                          | 7 +++++--
 dev/ci/docker/edge_ubuntu/Dockerfile    | 2 +-
 dev/ci/docker/old_ubuntu_lts/Dockerfile | 4 ++--
 3 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 13328fe26519..2376a74ea40f 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -40,8 +40,8 @@ variables:
   # The $hash is the first 10 characters of the md5 of the Dockerfile. e.g.
   # echo $(md5sum dev/ci/docker/old_ubuntu_lts/Dockerfile | head -c 10)
   # echo $(md5sum dev/ci/docker/edge_ubuntu/Dockerfile | head -c 10)
-  BASE_CACHEKEY: "old_ubuntu_lts-V2026-07-07-3f4ccef838"
-  EDGE_CACHEKEY: "edge_ubuntu-V2026-07-07-d451657c63"
+  BASE_CACHEKEY: "old_ubuntu_lts-V2026-07-07-18e9f9da22"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-07-07-f4f3e1b64c"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 
@@ -329,6 +329,9 @@ build:base+32bit:
     OPAM_VARIANT: "+32bit"
     COQ_EXTRA_CONF: "-native-compiler yes"
     ROCQIDE: "no"
+  artifacts:
+    paths:
+      - _build
   only: *full-ci
 
 build:edge+flambda:
diff --git a/dev/ci/docker/edge_ubuntu/Dockerfile b/dev/ci/docker/edge_ubuntu/Dockerfile
index ec2e5d8c0698..8434435b9a7f 100644
--- a/dev/ci/docker/edge_ubuntu/Dockerfile
+++ b/dev/ci/docker/edge_ubuntu/Dockerfile
@@ -68,7 +68,7 @@ RUN opam init -a --disable-sandboxing --bare && eval $(opam env) && \
     opam repo add archive git+https://github.com/ocaml/opam-repository-archive && \
     opam update && \
     opam install $BASE_OPAM $BASE_OPAM_EDGE $COQIDE_OPAM_EDGE $CI_OPAM $CI_OPAM_EDGE && \
-    opam pin add git+https://github.com/IBBXEF/malfunction#recusive_types && \
+    opam pin add git+https://github.com/IBBXEF/malfunction#5b5b625cd98e7cbd60325cc2634ee6cbab033236 && \
     opam clean -a -c
 
 # set the locale for the benefit of Python
diff --git a/dev/ci/docker/old_ubuntu_lts/Dockerfile b/dev/ci/docker/old_ubuntu_lts/Dockerfile
index 670220c5aef6..7ca654e2d056 100644
--- a/dev/ci/docker/old_ubuntu_lts/Dockerfile
+++ b/dev/ci/docker/old_ubuntu_lts/Dockerfile
@@ -70,7 +70,7 @@ RUN opam init -a --disable-sandboxing --compiler="$COMPILER" default https://opa
     opam repo add archive git+https://github.com/ocaml/opam-repository-archive && \
     opam update && \
     opam install $BASE_OPAM $COQIDE_OPAM $CI_OPAM $BASE_ONLY_OPAM && \
-    opam pin add git+https://github.com/IBBXEF/malfunction#recusive_types && \
+    opam pin add git+https://github.com/IBBXEF/malfunction#5b5b625cd98e7cbd60325cc2634ee6cbab033236 && \
     opam clean -a -c && \
     find ~ '(' -name '*.cmt' -o -name '*.cmti' ')' -delete
 
@@ -82,7 +82,7 @@ RUN opam switch create "${COMPILER}+32bit" \
     opam update && \
     i386 env CC='gcc -m32' opam install zarith.1.11 && \
     opam install $BASE_OPAM && \
-    opam pin add git+https://github.com/IBBXEF/malfunction#recusive_types && \
+    opam pin add git+https://github.com/IBBXEF/malfunction#5b5b625cd98e7cbd60325cc2634ee6cbab033236 && \
     opam clean -a -c && \
     find ~ '(' -name '*.cmt' -o -name '*.cmti' ')' -delete
 

From de38b3526b11e95d2970a26269b64ea723070cc2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 10 Jul 2026 18:01:37 +0200
Subject: [PATCH 074/110] Avoid identity cast functions in native compilation.

---
 kernel/nativecode.ml | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index d76f94ff6e96..15e6331ed919 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -269,7 +269,6 @@ type primitive =
   | Mk_uint
   | Mk_float
   | Mk_string
-  | Mk_int
   | Val_to_int
   | Mk_evar
   | MLand
@@ -312,7 +311,6 @@ let eq_primitive p1 p2 =
   | Mk_uint, Mk_uint
   | Mk_float, Mk_float
   | Mk_string, Mk_string
-  | Mk_int, Mk_int
   | Val_to_int, Val_to_int
   | Mk_evar, Mk_evar
   | MLand, MLand
@@ -364,7 +362,6 @@ let eq_primitive p1 p2 =
     | Mk_uint
     | Mk_float
     | Mk_string
-    | Mk_int
     | Val_to_int
     | Mk_evar
     | MLand
@@ -410,7 +407,6 @@ let primitive_hash = function
   | Array_get -> 13
   | Force_cofix -> 14
   | Mk_uint -> 15
-  | Mk_int -> 16
   | Val_to_int -> 17
   | Mk_evar -> 18
   | MLand -> 19
@@ -1540,7 +1536,7 @@ let rec ml_of_lam env l t =
       let knot = push_global_cofix env.env_cenv knot fv_params (Array.mapi map t_norm_f) in
       MLprimitive (Array_get, [|MLint start; MLapp (MLglobal knot, fv_args)|]) (* in malfunction, the index is first *)
 
-  | Lint tag -> MLprimitive (Mk_int, [|MLint tag|])
+  | Lint tag -> MLint tag
 
   | Lmakeblock (cn,tag,args) ->
      let prefix = env.env_mind_prefix (fst cn) in
@@ -1964,7 +1960,6 @@ let pp_mllam fmt l =
     | Mk_uint -> Format.fprintf fmt "(global $Nativevalues $mk_uint)"
     | Mk_float -> Format.fprintf fmt "(global $Nativevalues $mk_float)"
     | Mk_string -> Format.fprintf fmt "(global $Nativevalues $mk_string)"
-    | Mk_int -> Format.fprintf fmt "(global $Nativevalues $mk_int)"
     | Val_to_int -> Format.fprintf fmt "(global $Nativevalues $val_to_int)"
     | Mk_evar -> Format.fprintf fmt "(global $Nativevalues $mk_evar_accu)"
     | MLsubst_instance_instance -> Format.fprintf fmt "(global $UVars $subst_instance_instance)"

From 04864ad9b4575934cb3d101198a3f173a13aa23e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pierre-Marie=20P=C3=A9drot?= <pierre-marie.pedrot@inria.fr>
Date: Fri, 10 Jul 2026 18:12:39 +0200
Subject: [PATCH 075/110] Updated dockerfile.

---
 .gitlab-ci.yml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 2376a74ea40f..535e65bee565 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -40,8 +40,8 @@ variables:
   # The $hash is the first 10 characters of the md5 of the Dockerfile. e.g.
   # echo $(md5sum dev/ci/docker/old_ubuntu_lts/Dockerfile | head -c 10)
   # echo $(md5sum dev/ci/docker/edge_ubuntu/Dockerfile | head -c 10)
-  BASE_CACHEKEY: "old_ubuntu_lts-V2026-07-07-18e9f9da22"
-  EDGE_CACHEKEY: "edge_ubuntu-V2026-07-07-f4f3e1b64c"
+  BASE_CACHEKEY: "old_ubuntu_lts-V2026-10-07-1c266a2665"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-10-07-e139ef8b6a"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 

From e4cbb61ebb4169522e6b43dd7597f2ddd158519f Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 11:40:32 +0200
Subject: [PATCH 076/110] added a MLmatch_noaccu contructor to mllambda, and

removed annotations from matches as they are no longer needed
---
 kernel/nativecode.ml | 56 ++++++++++++++++++++++++++++++++++++--------
 1 file changed, 46 insertions(+), 10 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 15e6331ed919..f9bc0ab706ce 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -448,6 +448,8 @@ type mllambda =
   | MLif           of mllambda * mllambda * mllambda
   | MLmatch        of mllambda * mllambda * mllam_branches
                               (* argument, prefix, accu branch, branches *)
+  | MLmatch_noaccu        of mllambda * mllam_branches
+                              (* argument, prefix, branches *)
   | MLconstruct    of string * inductive * int * mllambda array
                    (* prefix, inductive name, tag, arguments *)
   | MLint          of int
@@ -517,6 +519,9 @@ let rec eq_mllambda gn1 gn2 n env1 env2 t1 t2 =
       eq_mllambda gn1 gn2 n env1 env2 c1 c2 &&
       eq_mllambda gn1 gn2 n env1 env2 accu1 accu2 &&
       eq_mllam_branches gn1 gn2 n env1 env2 br1 br2
+  | MLmatch_noaccu (c1, br1), MLmatch_noaccu (c2, br2) ->
+      eq_mllambda gn1 gn2 n env1 env2 c1 c2 &&
+      eq_mllam_branches gn1 gn2 n env1 env2 br1 br2
   | MLconstruct (pf1, ind1, tag1, args1), MLconstruct (pf2, ind2, tag2, args2) ->
       String.equal pf1 pf2 &&
       Ind.UserOrd.equal ind1 ind2 &&
@@ -543,7 +548,7 @@ let rec eq_mllambda gn1 gn2 n env1 env2 t1 t2 =
     String.equal s1 s2 && Ind.UserOrd.equal ind1 ind2 &&
     eq_mllambda gn1 gn2 n env1 env2 ml1 ml2
   | (MLlocal _ | MLglobal _ | MLprimitive _ | MLlam _ | MLletrec _ | MLlet _ |
-    MLapp _ | MLif _ | MLmatch _ | MLconstruct _ | MLint _ | MLuint _ |
+    MLapp _ | MLif _ | MLmatch _ | MLmatch_noaccu _ | MLconstruct _ | MLint _ | MLuint _ |
     MLfloat _ | MLstring _ | MLsetref _ | MLsequence _ |
     MLarray _ | MLisaccu _), _ -> false
 
@@ -610,31 +615,34 @@ let rec hash_mllambda gn n env t =
       let hc = hash_mllambda gn n env c in
       let haccu = hash_mllambda gn n env accu in
       combinesmall 9 (hash_mllam_branches gn n env (combine hc haccu) br)
+  | MLmatch_noaccu (c, br) ->
+      let hc = hash_mllambda gn n env c in
+      combinesmall 10 (hash_mllam_branches gn n env hc br)
   | MLconstruct (pf, ind, tag, args) ->
       let hpf = String.hash pf in
       let hcs = Ind.UserOrd.hash ind in
       let htag = Int.hash tag in
-      combinesmall 10 (hash_mllambda_array gn n env (combine3 hpf hcs htag) args)
+      combinesmall 11 (hash_mllambda_array gn n env (combine3 hpf hcs htag) args)
   | MLint i ->
-      combinesmall 11 i
+      combinesmall 12 i
   | MLuint i ->
-      combinesmall 12 (Uint63.hash i)
+      combinesmall 13 (Uint63.hash i)
   | MLsetref (id, ml) ->
       let hid = String.hash id in
       let hml = hash_mllambda gn n env ml in
-      combinesmall 13 (combine hid hml)
+      combinesmall 14 (combine hid hml)
   | MLsequence (ml, ml') ->
       let hml = hash_mllambda gn n env ml in
       let hml' = hash_mllambda gn n env ml' in
-      combinesmall 14 (combine hml hml')
+      combinesmall 15 (combine hml hml')
   | MLarray arr ->
-      combinesmall 15 (hash_mllambda_array gn n env 1 arr)
+      combinesmall 16 (hash_mllambda_array gn n env 1 arr)
   | MLisaccu (s, ind, c) ->
-      combinesmall 16 (combine (String.hash s) (combine (Ind.UserOrd.hash ind) (hash_mllambda gn n env c)))
+      combinesmall 17 (combine (String.hash s) (combine (Ind.UserOrd.hash ind) (hash_mllambda gn n env c)))
   | MLfloat f ->
-      combinesmall 17 (Float64.hash f)
+      combinesmall 18 (Float64.hash f)
   | MLstring s ->
-      combinesmall 18 (Pstring.hash s)
+      combinesmall 19 (Pstring.hash s)
 
 and hash_mllambda_letrec gn n env init defs =
   let hash_def (_,args,ml) =
@@ -704,6 +712,21 @@ let fv_lam l =
             cargs bind in
         aux body bind fv in
       Array.fold_right fv_bs bs fv
+    | MLmatch_noaccu(p,bs) ->
+      let fv = aux p bind fv in
+      let fv_bs (cargs, body) fv =
+        let bind =
+          List.fold_right (fun pat bind ->
+              match pat with
+              | ConstPattern _ -> bind
+              | NonConstPattern(_,args) ->
+                Array.fold_right
+                  (fun o bind -> match o with
+                     | Some l -> LNset.add l bind
+                     | _ -> bind) args bind)
+            cargs bind in
+        aux body bind fv in
+      Array.fold_right fv_bs bs fv
     (* argument, accu branch, branches *)
     | MLconstruct (_,_,_,p) ->
         Array.fold_right (fun a fv -> aux a bind fv) p fv
@@ -1603,6 +1626,9 @@ let subst s l =
       | MLmatch(a,accu,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
           MLmatch(a,aux accu, Array.map auxb bs)
+      | MLmatch_noaccu(a,bs) ->
+          let auxb (cargs,body) = (cargs,aux body) in
+          MLmatch_noaccu(a, Array.map auxb bs)
       | MLconstruct(prefix,c,tag,args) -> MLconstruct(prefix,c,tag,Array.map aux args)
       | MLsetref(s,l1) -> MLsetref(s,aux l1)
       | MLsequence(l1,l2) -> MLsequence(aux l1, aux l2)
@@ -1714,6 +1740,9 @@ let optimize gdef l =
     | MLmatch(a,accu,bs) ->
         let opt_b (cargs,body) = (cargs,optimize s body) in
         MLmatch(optimize s a, subst s accu, Array.map opt_b bs)
+    | MLmatch_noaccu(a,bs) ->
+        let opt_b (cargs,body) = (cargs,optimize s body) in
+        MLmatch_noaccu(optimize s a, Array.map opt_b bs)
     | MLconstruct(prefix,c,tag,args) ->
         MLconstruct(prefix,c,tag,Array.map (optimize s) args)
     | MLsetref(r,l) -> MLsetref(r, optimize s l)
@@ -1893,6 +1922,10 @@ let pp_mllam fmt l =
       Format.fprintf fmt (* accumulator is always tag 0 *)
         "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 0)@\n    %a)@\n  @[%a@]))@]"
         pp_mllam c pp_mllam accu_br pp_branches br
+    | MLmatch_noaccu (c, br) ->
+      Format.fprintf fmt
+        "@[(let ($matched_value %a) (switch $matched_value @\n@ @ @[%a@]))@]"
+        pp_mllam c pp_branches br
     | MLconstruct(_,_,tag,[||]) -> (* not a construct but a constant *)
         Format.fprintf fmt "%i"
           tag
@@ -2010,6 +2043,9 @@ let pp_cofix fmt (gn, s) =
       | MLmatch(a,accu,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
           MLmatch(a,aux accu, Array.map auxb bs)
+      | MLmatch_noaccu(a,bs) ->
+          let auxb (cargs,body) = (cargs,aux body) in
+          MLmatch_noaccu(a, Array.map auxb bs)
       | MLconstruct(prefix,c,tag,args) -> MLconstruct(prefix,c,tag,Array.map aux args)
       | MLsetref(s,l1) -> MLsetref(s,aux l1)
       | MLsequence(l1,l2) -> MLsequence(aux l1, aux l2)

From 287653c97d004703962659169690e043dd5ad3f0 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 15:55:30 +0200
Subject: [PATCH 077/110] added a Gletcase_noaccu constructor to global and
 made optionnal accumulator compilation effective

(still buggy)
---
 kernel/nativecode.ml | 179 ++++++++++++++++++++++++++++---------------
 1 file changed, 116 insertions(+), 63 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index f9bc0ab706ce..985c9e624e50 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -28,6 +28,8 @@ let debug_native_flag, debug_native_compiler = CDebug.create_full ~name:"native-
 let keep_debug_files () =
   CDebug.get_flag debug_native_flag
 
+exception NeedsAccumulators
+
 (** Local names **)
 
 (* The first component is there for debugging purposes only *)
@@ -768,6 +770,8 @@ type global =
   | Glet of gname * mllambda
   | Gletcase of
       gname * lname array * mllambda * mllambda * mllam_branches
+  | Gletcase_noaccu of
+      gname * lname array * mllambda * mllam_branches
   | Gopen of string
   | Gtype of inductive * (tag * int) array
     (* ind name, tag and arities of constructors *)
@@ -828,6 +832,11 @@ let hash_global g =
       let env = push_lnames 0 LNmap.empty lns in
       let t = MLmatch (c,accu,br) in
       combinesmall 5 (combine nlns (hash_mllambda gn nlns env t))
+  | Gletcase_noaccu (gn,lns,c,br) ->
+      let nlns = Array.length lns in
+      let env = push_lnames 0 LNmap.empty lns in
+      let t = MLmatch_noaccu (c,br) in
+      combinesmall 5 (combine nlns (hash_mllambda gn nlns env t))
   | Gopen s -> combinesmall 5 (String.hash s)
   | Gtype (ind, arr) ->
     let hash_aux acc (tag,ar) =
@@ -892,13 +901,17 @@ let fresh_gnormtbl cenv l =
   let () = cenv.normtbl_ctr <- cenv.normtbl_ctr + 1 in
   Gnormtbl (l, cenv.normtbl_ctr)
 
-let mkForceCofix cenv prefix ind arg =
+let mkForceCofix consider_accs cenv prefix ind arg =
   let name = fresh_lname cenv Anonymous in
-  MLlet (name, arg,
-    MLif (
-      MLisaccu (prefix, ind, MLlocal name),
-      MLprimitive (Force_cofix, [|MLlocal name|]),
-      MLlocal name))
+  let v =
+    if consider_accs then
+      MLif (
+        MLisaccu (prefix, ind, MLlocal name),
+        MLprimitive (Force_cofix, [|MLlocal name|]),
+        MLlocal name)
+    else MLlocal name
+  in
+  MLlet (name, arg, v)
 
 let push_global cenv gn t =
   try HashtblGlobal.find cenv.global_tbl t
@@ -919,8 +932,13 @@ let push_global_norm cenv gn params body =
 let push_global_cofix cenv gn params self =
   push_global cenv gn (Gtblcofix (gn, params, self))
 
-let push_global_case cenv gn params a accu bs =
-  push_global cenv gn (Gletcase (gn, params, a, accu, bs))
+let push_global_case consider_accs cenv gn params a accu bs =
+  if consider_accs then
+    push_global cenv gn (Gletcase (gn, params, a, accu, bs))
+  else
+    match bs with
+    | [||] -> push_global cenv gn (Glet (gn, MLlam (params, MLint 0))) (* our switch has no valid branches, so no need to match, the branch cannot be explored *)
+    | _ -> push_global cenv gn (Gletcase_noaccu (gn, params, a, bs))
 
 let push_symbol cenv x =
   try HashtblSymbol.find cenv.symb_tbl x
@@ -1171,7 +1189,7 @@ let merge_branches t =
 
 let app_prim p args = MLprimitive (p, args)
 
-let ml_empty_instance = MLprimitive (Mk_empty_instance, [||])
+let ml_empty_instance = MLprimitive (Mk_empty_instance, [||]) (* TODOME: check *)
 
 type prim_aux =
   | PAprim of string * pconstant * CPrimitives.t * prim_aux array
@@ -1323,31 +1341,32 @@ let compile_prim env decl cond paux =
   else
     add_decl decl (compile_cond cond paux)
 
-let rec ml_of_lam env l t =
+let rec ml_of_lam consider_accs env l t =
   match node t with
   | Lrel(id ,i) -> get_rel env id i
   | Lvar id -> get_var env id
   | Levar(evk, args) ->
-     let i = push_symbol env.env_cenv (SymbEvar evk) in
-     (** Arguments are *not* reversed in evar instances in native compilation *)
-     let args = MLarray(Array.map (ml_of_lam env l) args) in
-     MLprimitive (Mk_evar, [|get_evar_code i; args|])
+    if not consider_accs then raise NeedsAccumulators else (* Mk_evar generates an accumulator *)
+    let i = push_symbol env.env_cenv (SymbEvar evk) in
+    (** Arguments are *not* reversed in evar instances in native compilation *)
+    let args = MLarray(Array.map (ml_of_lam consider_accs env l) args) in
+    MLprimitive (Mk_evar, [|get_evar_code i; args|])
   | Lprod(dom,codom) ->
-      let dom = ml_of_lam env l dom in
-      let codom = ml_of_lam env l codom in
-      let n = get_prod_name codom in
-      let i = push_symbol env.env_cenv (SymbName n) in
-      MLprimitive (Mk_prod, [|get_name_code i;dom;codom|])
+    let dom = ml_of_lam consider_accs env l dom in
+    let codom = ml_of_lam consider_accs env l codom in
+    let n = get_prod_name codom in
+    let i = push_symbol env.env_cenv (SymbName n) in
+    MLprimitive (Mk_prod, [|get_name_code i;dom;codom|])
   | Llam(ids,body) ->
     let lnames,env = push_rels env ids in
-    MLlam(lnames, ml_of_lam env l body)
+    MLlam(lnames, ml_of_lam consider_accs env l body)
   | Llet(id,def,body) ->
-      let def = ml_of_lam env l def in
+      let def = ml_of_lam consider_accs env l def in
       let lname, env = push_rel env id in
-      let body = ml_of_lam env l body in
+      let body = ml_of_lam consider_accs env l body in
       MLlet(lname,def,body)
   | Lapp(f,args) ->
-      MLapp(ml_of_lam env l f, Array.map (ml_of_lam env l) args)
+      MLapp(ml_of_lam consider_accs env l f, Array.map (ml_of_lam consider_accs env l) args)
   | Lconst (c, u) ->
      let prefix = env.env_const_prefix c in
      let args = ml_of_instance env u in
@@ -1358,9 +1377,9 @@ let rec ml_of_lam env l t =
     let ind = Projection.Repr.inductive p in
     let i = Projection.Repr.arg p in
     let prefix = env.env_mind_prefix (fst ind) in
-    MLapp (MLglobal(Gproj (prefix, ind, i)), [| ml_of_lam env l c |])
+    MLapp (MLglobal(Gproj (prefix, ind, i)), [| ml_of_lam consider_accs env l c |])
   | Lprim _ ->
-    let decl,cond,paux = extract_prim env (ml_of_lam env l) t in
+    let decl,cond,paux = extract_prim env (ml_of_lam consider_accs env l) t in
     compile_prim env decl cond paux
   | Lcase (annot,p,a,bs) ->
       (* let predicate_uid fv_pred = compilation of p
@@ -1381,7 +1400,7 @@ let rec ml_of_lam env l t =
       }, finite in
       let env_p = restart_env env in
       let pn = fresh_gpred env.env_cenv l in
-      let mlp = ml_of_lam env_p l p in
+      let mlp = ml_of_lam consider_accs env_p l p in
       let mlp = generalize_fv env_p mlp in
       let (pfvn,pfvr) = !(env_p.env_named), !(env_p.env_urel) in
       let pn = push_global_let env.env_cenv pn mlp in
@@ -1393,11 +1412,11 @@ let rec ml_of_lam env l t =
       let nbconst = Array.length bs.constant_branches in
       let nbtotal = nbconst + Array.length bs.nonconstant_branches in
       let br = Array.init nbtotal (fun i -> if i < Array.length bs.constant_branches then
-                                  (ConstPattern i, ml_of_lam env_c l bs.constant_branches.(i))
+                                  (ConstPattern i, ml_of_lam consider_accs env_c l bs.constant_branches.(i))
                                 else
                                   let (params, body) = bs.nonconstant_branches.(i-nbconst) in
                                   let lnames, env_c = push_rels env_c params in
-                                  (NonConstPattern (i-nbconst+1,lnames), ml_of_lam env_c l body)
+                                  (NonConstPattern (i-nbconst+1,lnames), ml_of_lam consider_accs env_c l body)
                               )
       in
       let cn = fresh_gcase env.env_cenv l in
@@ -1414,14 +1433,14 @@ let rec ml_of_lam env l t =
                  cn_fv |]) in
 (*      let body = MLlam([|a_uid|], MLmatch(annot, la_uid, accu, bs)) in
       let case = generalize_fv env_c body in *)
-      let cn = push_global_case env.env_cenv cn (Array.append (fv_params env_c) [|a_uid|])
+      let cn = push_global_case consider_accs env.env_cenv cn (Array.append (fv_params env_c) [|a_uid|])
         la_uid accu (merge_branches br)
       in
       (* Final result *)
-      let arg = ml_of_lam env l a in
+      let arg = ml_of_lam consider_accs env l a in
       let force =
         if finite <> CoFinite then arg
-        else mkForceCofix env.env_cenv annot.asw_prefix annot.asw_ind arg in
+        else mkForceCofix consider_accs env.env_cenv annot.asw_prefix annot.asw_ind arg in
       mkMLapp (MLapp (MLglobal cn, fv_args env fvn fvr)) [|force|]
   | Lfix ((rec_pos, inds, start), (ids, tt, tb)) ->
       (* let type_f fvt = [| type fix |]
@@ -1441,7 +1460,7 @@ let rec ml_of_lam env l t =
       *)
       (* Compilation of type *)
       let env_t = restart_env env in
-      let ml_t = Array.map (ml_of_lam env_t l) tt in
+      let ml_t = Array.map (ml_of_lam consider_accs env_t l) tt in
       let params_t = fv_params env_t in
       let args_t = fv_args env !(env_t.env_named) !(env_t.env_urel) in
       let gft = fresh_gfixtype env.env_cenv l in
@@ -1457,7 +1476,7 @@ let rec ml_of_lam env l t =
         let ln,env' = push_rel env id in
         match def with
         | None -> (ln::params,lets,env')
-        | Some lam -> (params, (ln,ml_of_lam env l lam)::lets,env')
+        | Some lam -> (params, (ln,ml_of_lam consider_accs env l lam)::lets,env')
       in
       let ml_of_fix i body =
         let varsi, bodyi = decompose_Llam_Llet body in
@@ -1468,7 +1487,7 @@ let rec ml_of_lam env l t =
           Array.of_list (List.rev paramsi), Array.of_list (List.rev letsi)
         in
         t_norm_f.(i) <- fresh_gnorm env.env_cenv l;
-        let bodyi = ml_of_lam envi l bodyi in
+        let bodyi = ml_of_lam consider_accs envi l bodyi in
         t_params.(i) <- paramsi;
         let bodyi = Array.fold_right (mk_let envi) letsi bodyi in
         mkMLlam paramsi bodyi
@@ -1508,7 +1527,7 @@ let rec ml_of_lam env l t =
   | Lcofix (start, (ids, tt, tb)) ->
       (* Compilation of type *)
       let env_t = restart_env env in
-      let ml_t = Array.map (ml_of_lam env_t l) tt in
+      let ml_t = Array.map (ml_of_lam consider_accs env_t l) tt in
       let params_t = fv_params env_t in
       let args_t = Array.map (fun id -> MLlocal id) params_t in
       let gft = fresh_gfixtype env.env_cenv l in
@@ -1522,7 +1541,7 @@ let rec ml_of_lam env l t =
       let ml_of_fix i body =
         let idsi,bodyi = decompose_Llam body in
         let paramsi, envi = push_rels env_n idsi in
-        let bodyi = ml_of_lam envi l bodyi in
+        let bodyi = ml_of_lam consider_accs envi l bodyi in
         t_params.(i) <- paramsi;
         mkMLlam paramsi bodyi
       in
@@ -1563,27 +1582,28 @@ let rec ml_of_lam env l t =
 
   | Lmakeblock (cn,tag,args) ->
      let prefix = env.env_mind_prefix (fst cn) in
-     let args = Array.map (ml_of_lam env l) args in
+     let args = Array.map (ml_of_lam consider_accs env l) args in
      MLconstruct(prefix,cn,tag,args)
   | Luint i -> MLprimitive (Mk_uint, [|MLuint i|])
   | Lfloat f -> MLprimitive (Mk_float, [|MLfloat f|])
   | Lstring s -> MLprimitive (Mk_string, [|MLstring s|])
   | Lparray (t,def) ->
-    let def = ml_of_lam env l def in
-    MLprimitive (MLparray_of_array, [| MLarray (Array.map (ml_of_lam env l) t); def |])
+    let def = ml_of_lam consider_accs env l def in
+    MLprimitive (MLparray_of_array, [| MLarray (Array.map (ml_of_lam consider_accs env l) t); def |])
   | Lval v ->
       let i = push_symbol env.env_cenv (SymbValue v) in get_value_code i
   | Lsort s ->
+    if not consider_accs then raise NeedsAccumulators else (* ml_of_sort generates an accumulator *)
     ml_of_sort env s
   | Lind (ind, u) ->
      let prefix = env.env_mind_prefix (fst ind) in
      let uargs = ml_of_instance env u in
      mkMLapp (MLglobal (Gind (prefix, ind))) uargs
 
-let mllambda_of_lambda cenv univ constpref constlazy mindpref auxdefs l t =
+let mllambda_of_lambda consider_accs cenv univ constpref constlazy mindpref auxdefs l t =
   let env = empty_env cenv univ constpref constlazy mindpref in
   let () = cenv.global_stack <- auxdefs in
-  let ml = ml_of_lam env l t in
+  let ml = ml_of_lam consider_accs env l t in
   let fv_rel = !(env.env_urel) in
   let fv_named = !(env.env_named) in
   (* build the free variables *)
@@ -1684,7 +1704,15 @@ let commutative_cut a accu bs args =
      | _ -> assert false in
   MLmatch( a, mkMLapp accu args, Array.map mkb bs)
 
-let optimize gdef l =
+let commutative_cut_noaccu a bs args =
+  let mkb (c,b) =
+     match b with
+     | MLlam(params, body) ->
+         (c, Array.fold_left2 (fun body x v -> MLlet(x,v,body)) body params args)
+     | _ -> assert false in
+  MLmatch_noaccu( a, Array.map mkb bs)
+
+let optimize  gdef l =
   let rec optimize s l =
     match l with
     | MLlocal id -> (try LNmap.find id s with Not_found -> l)
@@ -1723,6 +1751,10 @@ let optimize gdef l =
               if all_lam (Array.length args) bs then
                 commutative_cut a accu bs args
               else MLapp(f, args)
+            | MLmatch_noaccu (a,bs) ->
+              if all_lam (Array.length args) bs then
+                commutative_cut_noaccu a bs args
+              else MLapp(f, args)
             | _ -> MLapp(f, args)
 
         end
@@ -2107,6 +2139,16 @@ let pp_global fmt g =
       (hash_global g)
         pp_gname gn pp_ldecls params
         pp_mllam (MLmatch(a,accu,bs))
+  | Gletcase_noaccu(gn,[||],a,bs) -> (* simple biding and not a function *)
+      Format.fprintf fmt "@[; Hash = %i@\n(%a %a)@]@\n@." (* no need to be recursive as we are sane and do not create recursive values other than functions *)
+      (hash_global g)
+        pp_gname gn
+        pp_mllam (MLmatch_noaccu(a,bs))
+  | Gletcase_noaccu(gn,params,a,bs) -> (* a function *)
+      Format.fprintf fmt "@[; Hash = %i@\n(rec (%a (lambda (%a)@\n  %a)))@]@\n@."
+      (hash_global g)
+        pp_gname gn pp_ldecls params
+        pp_mllam (MLmatch_noaccu(a,bs))
   | Gtblfixtype (g, [||], t) -> (* not a function but a definition *)
       Format.fprintf fmt "@[<2>(%a %a)@]@\n@." pp_gname g
         pp_array t
@@ -2135,6 +2177,7 @@ let global_to_mlf_name g =
   | Gtblnorm (gn,_,_)
   | Gtblcofix (gn,_,_)
   | Gletcase(gn,_,_,_,_)
+  | Gletcase_noaccu(gn,_,_,_)
   | Glet (gn,_) ->
     let gn = string_of_gname gn in
     if gn = "_" || gn = "" then None else Some gn
@@ -2148,6 +2191,7 @@ let pp_global_interface fmt g =
   | Gtblcofix (_,_,_)
   | Gtblfixtype (_,_,_)
   | Gletcase (_,_,_,_,_)
+  | Gletcase_noaccu (_,_,_,_)
   | Glet (_,_) ->
     begin match global_to_mlf_name g with
     | None -> ()
@@ -2160,22 +2204,22 @@ let pp_global_interface fmt g =
   | Gtype (ind, lar) -> pp_type_decl fmt ind lar
 
 (** Compilation of elements in environment **)
-let rec compile_with_fv ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
+let rec compile_with_fv consider_accs ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
   let const_prefix c = get_const_prefix env c in
   let const_lazy = get_const_lazy env in
   let mind_prefix c = get_mind_prefix env c in
-  let (auxdefs,(fv_named,fv_rel),ml) = mllambda_of_lambda cenv univ const_prefix const_lazy mind_prefix auxdefs l t in
+  let (auxdefs,(fv_named,fv_rel),ml) = mllambda_of_lambda consider_accs cenv univ const_prefix const_lazy mind_prefix auxdefs l t in
   let ml = wrap ml in
   if List.is_empty fv_named && List.is_empty fv_rel then (auxdefs,ml)
-  else apply_fv cenv env sigma univ (fv_named,fv_rel) auxdefs ml
+  else apply_fv consider_accs cenv env sigma univ (fv_named,fv_rel) auxdefs ml
 
-and apply_fv cenv env sigma univ (fv_named,fv_rel) auxdefs ml =
+and apply_fv consider_accs cenv env sigma univ (fv_named,fv_rel) auxdefs ml =
   let get_rel_val (n,_) auxdefs =
     (*
     match !(lookup_rel_native_val n env) with
     | NVKnone ->
     *)
-        compile_rel cenv env sigma univ auxdefs n
+        compile_rel consider_accs cenv env sigma univ auxdefs n
 (*    | NVKvalue (v,d) -> assert false *)
   in
   let get_named_val (id,_) auxdefs =
@@ -2183,7 +2227,7 @@ and apply_fv cenv env sigma univ (fv_named,fv_rel) auxdefs ml =
     match !(lookup_named_native_val id env) with
     | NVKnone ->
         *)
-        compile_named cenv env sigma univ auxdefs id
+        compile_named consider_accs cenv env sigma univ auxdefs id
 (*    | NVKvalue (v,d) -> assert false *)
   in
   let auxdefs = List.fold_right get_rel_val fv_rel auxdefs in
@@ -2194,24 +2238,24 @@ and apply_fv cenv env sigma univ (fv_named,fv_rel) auxdefs ml =
   let aux_name = fresh_lname cenv Anonymous in
   auxdefs, MLlet(aux_name, ml, mkMLapp (MLlocal aux_name) (Array.of_list (fv_rel@fv_named)))
 
-and compile_rel cenv env sigma univ auxdefs n =
+and compile_rel consider_accs cenv env sigma univ auxdefs n =
   let open Context.Rel.Declaration in
   let decl = lookup_rel n env in
   let n = List.length (rel_context env) - n in
   match decl with
   | LocalDef (_,t,_) ->
       let code = lambda_of_constr env sigma t in
-      let auxdefs,code = compile_with_fv cenv env sigma univ auxdefs None code in
+      let auxdefs,code = compile_with_fv consider_accs cenv env sigma univ auxdefs None code in
       Glet(Grel n, code)::auxdefs
   | LocalAssum _ ->
       Glet(Grel n, MLprimitive (Mk_rel n, [||]))::auxdefs
 
-and compile_named cenv env sigma univ auxdefs id =
+and compile_named consider_accs cenv env sigma univ auxdefs id =
   let open Context.Named.Declaration in
   match lookup_named id env with
   | LocalDef (_,t,_) ->
       let code = lambda_of_constr env sigma t in
-      let auxdefs,code = compile_with_fv cenv env sigma univ auxdefs None code in
+      let auxdefs,code = compile_with_fv consider_accs cenv env sigma univ auxdefs None code in
       Glet(Gnamed id, code)::auxdefs
   | LocalAssum _ ->
       Glet(Gnamed id, MLprimitive (Mk_var id, [||]))::auxdefs
@@ -2225,12 +2269,13 @@ let compile_constant cenv env sigma con cb =
       let is_lazy = is_lazy_constant env cb in
       let wrap t = if is_lazy then MLprimitive (Lazy, [|t|]) else t in
       let l = Constant.label con in
+      (* we assume accumulators as this function is used to compile libraries *)
       let auxdefs,code =
         if no_univs then
-          compile_with_fv ~wrap cenv env sigma (ULocal None) [] (Some l) code
+          compile_with_fv true ~wrap cenv env sigma (ULocal None) [] (Some l) code
         else
           let univ = fresh_univ cenv in
-          let (auxdefs,code) = compile_with_fv ~wrap cenv env sigma (ULocal (Some univ)) [] (Some l) code in
+          let (auxdefs,code) = compile_with_fv true ~wrap cenv env sigma (ULocal (Some univ)) [] (Some l) code in
           (auxdefs,mkMLlam [|univ|] code)
       in
       debug_native_compiler (fun () -> Pp.str "Generated mllambda code");
@@ -2283,7 +2328,7 @@ let compile_mind cenv mb mind stack =
         else [|get_ind_code j|]
       in
       (* FIXME: pass universes here *)
-      Glet(name, MLprimitive (Mk_ind, args))
+      Glet(name, MLprimitive (Mk_ind, args)) (* TODOME: check if this accu is used *)
     in
     let add_proj proj_arg acc _pb =
       let tbl = ob.mind_reloc_tbl in
@@ -2303,7 +2348,7 @@ let compile_mind cenv mb mind stack =
       let force_c =
         if mb.mind_finite <> CoFinite
         then MLlocal c_uid
-        else mkForceCofix cenv "" ind (MLlocal c_uid)
+        else mkForceCofix true cenv "" ind (MLlocal c_uid) (* we need accumulators anyways *)
       in
       let code = MLlet(cf_uid, force_c, code) in
       let gn = Gproj ("", ind, proj_arg) in
@@ -2369,7 +2414,7 @@ let compile_deps cenv env sigma prefix init t =
            aux env lvl init t
         | _ -> init
       in
-      let code = compile_constant cenv env sigma c cb in
+      let code = compile_constant cenv env sigma c cb in (* compile_mind_deps uses accumulators anyways *)
       let upd = {
         upd_info = nameref;
         upd_prefix = prefix;
@@ -2406,8 +2451,8 @@ let compile_deps cenv env sigma prefix init t =
   aux env 0 init t
 
 let compile_constant_field cenv env con acc cb =
-    let gl = compile_constant cenv env (empty_evars env) con cb in
-    gl@acc
+  let gl = compile_constant cenv env (empty_evars env) con cb in
+  gl@acc
 
 let compile_mind_field cenv mp l acc mb =
   let mind = MutInd.make2 mp l in
@@ -2440,8 +2485,8 @@ let mk_conv_code env sigma prefix t1 t2 =
   in
   let code1 = lambda_of_constr env sigma t1 in
   let code2 = lambda_of_constr env sigma t2 in
-  let (gl,code1) = compile_with_fv cenv env sigma UGlobal gl None code1 in
-  let (gl,code2) = compile_with_fv cenv env sigma UGlobal gl None code2 in
+  let (gl,code1) = compile_with_fv true cenv env sigma UGlobal gl None code1 in (* we assume accumulators for conversion code *)
+  let (gl,code2) = compile_with_fv true cenv env sigma UGlobal gl None code2 in
   let t1 = mk_internal_let "$t1" code1 in
   let t2 = mk_internal_let "$t2" code2 in
   let g1 = MLglobal (Ginternal "$t1") in
@@ -2455,24 +2500,32 @@ let mk_conv_code env sigma prefix t1 t2 =
   let symbols = get_cenv_symbols cenv in
   header::gl, symbols, (mind_updates, const_updates)
 
-let mk_norm_code env sigma prefix t =
+let mk_norm_code consider_accs env sigma prefix t =
   let cenv = make_cenv () in
   let gl, (mind_updates, const_updates) =
     let init = ([], empty_updates) in
     compile_deps cenv env sigma prefix init t
   in
   let code = lambda_of_constr env sigma t in
-  let (gl,code) = compile_with_fv cenv env sigma UGlobal gl None code in
+  let (gl,code) = compile_with_fv true cenv env sigma UGlobal gl None code in (* compile_deps uses accumulators anyways *)
   let t1 = mk_internal_let "$t1" code in
   let g1 = MLglobal (Ginternal "$t1") in
   let setref = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt1)",g1)) in
   let gl = List.rev (setref :: t1 :: gl) in
+  let gl =
+    Gcomment (if consider_accs then "code generated with accumulators" else "code generated without accumulators")
+    :: gl in
   let header = Glet(Ginternal "$symbols_tbl",
     MLprimitive (Get_symbols,
       [|MLglobal (Ginternal "0")|])) in
   let symbols = get_cenv_symbols cenv in
   header::gl, symbols, (mind_updates, const_updates)
 
+(* wrapper for the function above *)
+let mk_norm_code env sigma prefix t =
+  try mk_norm_code false env sigma prefix t with
+  | NeedsAccumulators -> mk_norm_code true env sigma prefix t
+
 let mk_library_header (symbols : Nativevalues.symbols) =
   [Glet(Ginternal "$symbols_tbl", MLprimitive (Str_decode, [|MLglobal (Ginternal ("\"" ^ (str_encode symbols) ^ "\""))|]))]
 

From a4eb4dc7eaab1570d21edfcc01fb7123a3f99264 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 22 Jun 2026 14:18:14 +0200
Subject: [PATCH 078/110] the compilation of cases no longer declares unused
 variables when compiling without accumulators

---
 kernel/nativecode.ml | 112 ++++++++++++++++++++++++++++---------------
 1 file changed, 74 insertions(+), 38 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 985c9e624e50..0cb36addef86 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -901,15 +901,20 @@ let fresh_gnormtbl cenv l =
   let () = cenv.normtbl_ctr <- cenv.normtbl_ctr + 1 in
   Gnormtbl (l, cenv.normtbl_ctr)
 
-let mkForceCofix consider_accs cenv prefix ind arg =
+let mkForceCofix cenv prefix ind arg =
   let name = fresh_lname cenv Anonymous in
   let v =
-    if consider_accs then
-      MLif (
-        MLisaccu (prefix, ind, MLlocal name),
-        MLprimitive (Force_cofix, [|MLlocal name|]),
-        MLlocal name)
-    else MLlocal name
+    MLif (
+      MLisaccu (prefix, ind, MLlocal name),
+      MLprimitive (Force_cofix, [|MLlocal name|]),
+      MLlocal name)
+  in
+  MLlet (name, arg, v)
+
+let mkForceCofix_noaccu cenv arg =
+  let name = fresh_lname cenv Anonymous in
+  let v =
+    MLlocal name
   in
   MLlet (name, arg, v)
 
@@ -932,13 +937,13 @@ let push_global_norm cenv gn params body =
 let push_global_cofix cenv gn params self =
   push_global cenv gn (Gtblcofix (gn, params, self))
 
-let push_global_case consider_accs cenv gn params a accu bs =
-  if consider_accs then
-    push_global cenv gn (Gletcase (gn, params, a, accu, bs))
-  else
-    match bs with
-    | [||] -> push_global cenv gn (Glet (gn, MLlam (params, MLint 0))) (* our switch has no valid branches, so no need to match, the branch cannot be explored *)
-    | _ -> push_global cenv gn (Gletcase_noaccu (gn, params, a, bs))
+let push_global_case cenv gn params a accu bs =
+  push_global cenv gn (Gletcase (gn, params, a, accu, bs))
+
+let push_global_case_noaccu cenv gn params a bs =
+  match bs with
+  | [||] -> push_global cenv gn (Glet (gn, MLlam (params, MLint 0))) (* our switch has no valid branches, so no need to match, the branch cannot be explored *)
+  | _ -> push_global cenv gn (Gletcase_noaccu (gn, params, a, bs))
 
 let push_symbol cenv x =
   try HashtblSymbol.find cenv.symb_tbl x
@@ -1382,22 +1387,23 @@ let rec ml_of_lam consider_accs env l t =
     let decl,cond,paux = extract_prim env (ml_of_lam consider_accs env l) t in
     compile_prim env decl cond paux
   | Lcase (annot,p,a,bs) ->
-      (* let predicate_uid fv_pred = compilation of p
-         let rec case_uid fv a_uid =
-           match a_uid with
-           | Accu _ => mk_sw (predicate_uid fv_pred) (case_uid fv) a_uid
-           | Ci argsi => compilation of branches
-         compile case = case_uid fv (compilation of a) *)
-      (* Compilation of the predicate *)
-         (* Remark: if we do not want to compile the predicate we
-            should a least compute the fv, then store the lambda representation
-            of the predicate (not the mllambda) *)
-      let annot, finite =
-        let (ci, tbl, finite) = annot in {
-          asw_ind = ci.ci_ind;
-          asw_reloc = tbl;
-          asw_prefix = env.env_mind_prefix (fst ci.ci_ind);
-      }, finite in
+    (* let predicate_uid fv_pred = compilation of p
+        let rec case_uid fv a_uid =
+          match a_uid with
+          | Accu _ => mk_sw (predicate_uid fv_pred) (case_uid fv) a_uid
+          | Ci argsi => compilation of branches
+        compile case = case_uid fv (compilation of a) *)
+    (* Compilation of the predicate *)
+        (* Remark: if we do not want to compile the predicate we
+          should a least compute the fv, then store the lambda representation
+          of the predicate (not the mllambda) *)
+    let annot, finite =
+      let (ci, tbl, finite) = annot in {
+        asw_ind = ci.ci_ind;
+        asw_reloc = tbl;
+        asw_prefix = env.env_mind_prefix (fst ci.ci_ind);
+    }, finite in
+    if consider_accs then begin
       let env_p = restart_env env in
       let pn = fresh_gpred env.env_cenv l in
       let mlp = ml_of_lam consider_accs env_p l p in
@@ -1424,24 +1430,54 @@ let rec ml_of_lam consider_accs env l t =
       let pred = MLapp(MLglobal pn, fv_args env_c pfvn pfvr) in
       let (fvn, fvr) = !(env_c.env_named), !(env_c.env_urel) in
       let cn_fv = mkMLapp (MLglobal cn) (fv_args env_c fvn fvr) in
-         (* remark : the call to fv_args does not add free variables in env_c *)
+          (* remark : the call to fv_args does not add free variables in env_c *)
       let i = push_symbol env.env_cenv (SymbMatch annot) in
       let accu =
         MLprimitive (Mk_sw,
               [| get_match_code i; MLprimitive (Cast_accu, [|la_uid|]);
-                 pred;
-                 cn_fv |]) in
-(*      let body = MLlam([|a_uid|], MLmatch(annot, la_uid, accu, bs)) in
+                  pred;
+                  cn_fv |]) in
+  (*      let body = MLlam([|a_uid|], MLmatch(annot, la_uid, accu, bs)) in
       let case = generalize_fv env_c body in *)
-      let cn = push_global_case consider_accs env.env_cenv cn (Array.append (fv_params env_c) [|a_uid|])
+      let cn = push_global_case env.env_cenv cn (Array.append (fv_params env_c) [|a_uid|])
         la_uid accu (merge_branches br)
       in
       (* Final result *)
       let arg = ml_of_lam consider_accs env l a in
       let force =
         if finite <> CoFinite then arg
-        else mkForceCofix consider_accs env.env_cenv annot.asw_prefix annot.asw_ind arg in
+        else mkForceCofix env.env_cenv annot.asw_prefix annot.asw_ind arg in
+      mkMLapp (MLapp (MLglobal cn, fv_args env fvn fvr)) [|force|]
+    end else begin (* consider_accs is false *)
+      (* Compilation of the case *)
+      let env_c = restart_env env in
+      let a_uid = fresh_lname env.env_cenv Anonymous in
+      let la_uid = MLlocal a_uid in
+      (* compilation of branches *)
+      let nbconst = Array.length bs.constant_branches in
+      let nbtotal = nbconst + Array.length bs.nonconstant_branches in
+      let br = Array.init nbtotal (fun i -> if i < Array.length bs.constant_branches then
+                                  (ConstPattern i, ml_of_lam consider_accs env_c l bs.constant_branches.(i))
+                                else
+                                  let (params, body) = bs.nonconstant_branches.(i-nbconst) in
+                                  let lnames, env_c = push_rels env_c params in
+                                  (NonConstPattern (i-nbconst+1,lnames), ml_of_lam consider_accs env_c l body)
+                              )
+      in
+      let cn = fresh_gcase env.env_cenv l in
+      let (fvn, fvr) = !(env_c.env_named), !(env_c.env_urel) in
+  (*      let body = MLlam([|a_uid|], MLmatch(annot, la_uid, accu, bs)) in
+      let case = generalize_fv env_c body in *)
+      let cn = push_global_case_noaccu env.env_cenv cn (Array.append (fv_params env_c) [|a_uid|])
+        la_uid (merge_branches br)
+      in
+      (* Final result *)
+      let arg = ml_of_lam consider_accs env l a in
+      let force =
+        if finite <> CoFinite then arg
+        else mkForceCofix_noaccu env.env_cenv arg in
       mkMLapp (MLapp (MLglobal cn, fv_args env fvn fvr)) [|force|]
+    end
   | Lfix ((rec_pos, inds, start), (ids, tt, tb)) ->
       (* let type_f fvt = [| type fix |]
          let norm_f1 fv f1 .. fn params1 = body1
@@ -2328,7 +2364,7 @@ let compile_mind cenv mb mind stack =
         else [|get_ind_code j|]
       in
       (* FIXME: pass universes here *)
-      Glet(name, MLprimitive (Mk_ind, args)) (* TODOME: check if this accu is used *)
+      Glet(name, MLprimitive (Mk_ind, args))
     in
     let add_proj proj_arg acc _pb =
       let tbl = ob.mind_reloc_tbl in
@@ -2348,7 +2384,7 @@ let compile_mind cenv mb mind stack =
       let force_c =
         if mb.mind_finite <> CoFinite
         then MLlocal c_uid
-        else mkForceCofix true cenv "" ind (MLlocal c_uid) (* we need accumulators anyways *)
+        else mkForceCofix cenv "" ind (MLlocal c_uid)
       in
       let code = MLlet(cf_uid, force_c, code) in
       let gn = Gproj ("", ind, proj_arg) in

From 348c92b3dc1f17fc8907a78110c8771bf6351e1f Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 22 Jun 2026 14:54:19 +0200
Subject: [PATCH 079/110] refactored the compilation of fixpoint

---
 kernel/nativecode.ml | 79 +++++++++++++++++++++++++++-----------------
 1 file changed, 48 insertions(+), 31 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 0cb36addef86..cb4f567d507e 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1496,12 +1496,6 @@ let rec ml_of_lam consider_accs env l t =
       *)
       (* Compilation of type *)
       let env_t = restart_env env in
-      let ml_t = Array.map (ml_of_lam consider_accs env_t l) tt in
-      let params_t = fv_params env_t in
-      let args_t = fv_args env !(env_t.env_named) !(env_t.env_urel) in
-      let gft = fresh_gfixtype env.env_cenv l in
-      let gft = push_global_fixtype env.env_cenv gft params_t ml_t in
-      let mk_type = MLapp(MLglobal gft, args_t) in
       (* Compilation of norm_i *)
       let ndef = Array.length ids in
       let lf,env_n = push_rels (restart_env env) ids in
@@ -1530,35 +1524,58 @@ let rec ml_of_lam consider_accs env l t =
       in
       let tnorm = Array.mapi ml_of_fix tb in
       let fvn,fvr = !(env_n.env_named), !(env_n.env_urel) in
-      let fv_params = fv_params env_n in
-      let fv_args' = Array.map (fun id -> MLlocal id) fv_params in
-      let norm_params = Array.append fv_params lf in
+      let fv_params_n = fv_params env_n in
+      let norm_params = Array.append fv_params_n lf in
       let t_norm_f = Array.mapi (fun i body ->
         push_global_let env.env_cenv (t_norm_f.(i)) (mkMLlam norm_params body)) tnorm in
-      let norm = fresh_gnormtbl env.env_cenv l in
-      let norm = push_global_norm env.env_cenv norm fv_params
-         (Array.map (fun g -> mkMLapp (MLglobal g) fv_args') t_norm_f) in
-      (* Compilation of fix *)
-      let fv_args = fv_args env fvn fvr in
+      let fv_args_n = fv_args env fvn fvr in
       let lf, _env = push_rels env ids in
       let lf_args = Array.map (fun id -> MLlocal id) lf in
-      let mk_norm = MLapp(MLglobal norm, fv_args) in
-      let mkrec i lname =
-        let paramsi = t_params.(i) in
-        let reci = MLlocal (paramsi.(rec_pos.(i))) in
-        let pargsi = Array.map (fun id -> MLlocal id) paramsi in
-        let ind = inds.(i) in
-        let prefix = env.env_mind_prefix (fst ind) in
-        let body =
-          MLif(MLisaccu (prefix, ind, reci),
-               mkMLapp
-                 (MLprimitive ((Mk_fix(rec_pos,i)),
-                        [|mk_type; mk_norm|]))
-                 pargsi,
-               MLapp(MLglobal t_norm_f.(i),
-                     Array.concat [fv_args;lf_args;pargsi]))
-        in
-        (lname, paramsi, body) in
+      
+      let mkrec, lf, lf_args, start =
+      if consider_accs then begin
+        let ml_t = Array.map (ml_of_lam consider_accs env_t l) tt in
+        let params_t = fv_params env_t in
+        let args_t = fv_args env !(env_t.env_named) !(env_t.env_urel) in
+        let gft = fresh_gfixtype env.env_cenv l in
+        let gft = push_global_fixtype env.env_cenv gft params_t ml_t in
+        let mk_type = MLapp(MLglobal gft, args_t) in
+        (* Compilation of norm_i *)
+        let fv_args' = Array.map (fun id -> MLlocal id) fv_params_n in
+        let norm = fresh_gnormtbl env.env_cenv l in
+        let norm = push_global_norm env.env_cenv norm fv_params_n
+          (Array.map (fun g -> mkMLapp (MLglobal g) fv_args') t_norm_f) in
+        (* Compilation of fix *)
+        let mk_norm = MLapp(MLglobal norm, fv_args_n) in
+        let mkrec i lname =
+          let paramsi = t_params.(i) in
+          let reci = MLlocal (paramsi.(rec_pos.(i))) in
+          let pargsi = Array.map (fun id -> MLlocal id) paramsi in
+          let ind = inds.(i) in
+          let prefix = env.env_mind_prefix (fst ind) in
+          let body =
+            MLif(MLisaccu (prefix, ind, reci),
+                mkMLapp
+                  (MLprimitive ((Mk_fix(rec_pos,i)),
+                          [|mk_type; mk_norm|]))
+                  pargsi,
+                MLapp(MLglobal t_norm_f.(i),
+                      Array.concat [fv_args_n;lf_args;pargsi]))
+          in
+          (lname, paramsi, body) in
+        mkrec, lf, lf_args, start
+      end else begin (* consider_accs is false *)
+        (* Compilation of fix *)
+        let mkrec i lname =
+          let paramsi = t_params.(i) in
+          let pargsi = Array.map (fun id -> MLlocal id) paramsi in
+          let body =
+            MLapp(MLglobal t_norm_f.(i),
+              Array.concat [fv_args_n;lf_args;pargsi])
+          in
+          (lname, paramsi, body) in
+        mkrec, lf, lf_args, start
+      end in
       MLletrec(Array.mapi mkrec lf, lf_args.(start))
   | Lcofix (start, (ids, tt, tb)) ->
       (* Compilation of type *)

From 0b19c03e683a0b82557528c86c10c4f6998b2021 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 22 Jun 2026 16:52:11 +0200
Subject: [PATCH 080/110] The optionnal compilation has been extended to more
 functions and now works for dependencies in the same file

---
 kernel/nativecode.ml    | 70 +++++++++++++++++++++++------------------
 kernel/nativecode.mli   |  4 +--
 kernel/nativelibrary.ml |  4 +--
 3 files changed, 44 insertions(+), 34 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index cb4f567d507e..c6aca6198936 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2313,7 +2313,7 @@ and compile_named consider_accs cenv env sigma univ auxdefs id =
   | LocalAssum _ ->
       Glet(Gnamed id, MLprimitive (Mk_var id, [||]))::auxdefs
 
-let compile_constant cenv env sigma con cb =
+let compile_constant consider_accs cenv env sigma con cb =
     let no_univs = UVars.AbstractContext.is_constant (Declareops.constant_polymorphic_context cb) in
     begin match cb.const_body with
     | Def t ->
@@ -2322,13 +2322,12 @@ let compile_constant cenv env sigma con cb =
       let is_lazy = is_lazy_constant env cb in
       let wrap t = if is_lazy then MLprimitive (Lazy, [|t|]) else t in
       let l = Constant.label con in
-      (* we assume accumulators as this function is used to compile libraries *)
       let auxdefs,code =
         if no_univs then
-          compile_with_fv true ~wrap cenv env sigma (ULocal None) [] (Some l) code
+          compile_with_fv  consider_accs ~wrap cenv env sigma (ULocal None) [] (Some l) code
         else
           let univ = fresh_univ cenv in
-          let (auxdefs,code) = compile_with_fv true ~wrap cenv env sigma (ULocal (Some univ)) [] (Some l) code in
+          let (auxdefs,code) = compile_with_fv  consider_accs ~wrap cenv env sigma (ULocal (Some univ)) [] (Some l) code in
           (auxdefs,mkMLlam [|univ|] code)
       in
       debug_native_compiler (fun () -> Pp.str "Generated mllambda code");
@@ -2366,7 +2365,7 @@ let is_code_loaded name =
       if is_loaded_native_file s then true
       else (name := NotLinked; false)
 
-let compile_mind cenv mb mind stack =
+let compile_mind consider_accs cenv mb mind stack =
   let u = Declareops.inductive_polymorphic_context mb in
   (** Generate data for every block *)
   let f i stack ob =
@@ -2394,14 +2393,25 @@ let compile_mind cenv mb mind stack =
       let cargs = Array.init arity
         (fun i -> if Int.equal i proj_arg then Some ci_uid else None)
       in
-      let i = push_symbol cenv (SymbProj (ind, proj_arg)) in
-      let accu = MLprimitive (Cast_accu, [|MLlocal cf_uid|]) in
-      let accu_br = MLprimitive (Mk_proj, [|get_proj_code i;accu|]) in
-      let code = MLmatch(MLlocal cf_uid,accu_br,[|[NonConstPattern (tag,cargs)],MLlocal ci_uid|]) in
-      let force_c =
-        if mb.mind_finite <> CoFinite
-        then MLlocal c_uid
-        else mkForceCofix cenv "" ind (MLlocal c_uid)
+      let code, force_c = if consider_accs then
+        let i = push_symbol cenv (SymbProj (ind, proj_arg)) in
+        let accu = MLprimitive (Cast_accu, [|MLlocal cf_uid|]) in
+        let accu_br = MLprimitive (Mk_proj, [|get_proj_code i;accu|]) in
+        let code = MLmatch(MLlocal cf_uid,accu_br,[|[NonConstPattern (tag,cargs)],MLlocal ci_uid|]) in
+        let force_c =
+          if mb.mind_finite <> CoFinite
+          then MLlocal c_uid
+          else mkForceCofix cenv "" ind (MLlocal c_uid)
+        in
+        code, force_c
+      else (* consider_accs = false *)
+        let code = MLmatch_noaccu(MLlocal cf_uid,[|[NonConstPattern (tag,cargs)],MLlocal ci_uid|]) in
+        let force_c =
+          if mb.mind_finite <> CoFinite
+          then MLlocal c_uid
+          else mkForceCofix_noaccu cenv (MLlocal c_uid)
+        in
+        code, force_c
       in
       let code = MLlet(cf_uid, force_c, code) in
       let gn = Gproj ("", ind, proj_arg) in
@@ -2428,7 +2438,7 @@ type linkable_code = global list * symbols * code_location_updates
 
 let empty_updates = Mindmap_env.empty, Cmap_env.empty
 
-let compile_mind_deps cenv env prefix
+let compile_mind_deps consider_accs cenv env prefix
     (comp_stack, (mind_updates, const_updates) as init) mind =
   let mib = lookup_mind mind env in
   let nameref = lookup_mind_key mind env in
@@ -2437,7 +2447,7 @@ let compile_mind_deps cenv env prefix
   then init
   else
     let comp_stack =
-      compile_mind cenv mib mind comp_stack
+      compile_mind consider_accs cenv mib mind comp_stack
     in
     let upd = {
       upd_info = nameref;
@@ -2448,10 +2458,10 @@ let compile_mind_deps cenv env prefix
 
 (* This function compiles all necessary dependencies of t, and generates code in
    reverse order, as well as linking information updates *)
-let compile_deps cenv env sigma prefix init t =
+let compile_deps consider_accs cenv env sigma prefix init t =
   let rec aux env lvl init t =
   match kind t with
-  | Ind ((mind,_),_u) -> compile_mind_deps cenv env prefix init mind
+  | Ind ((mind,_),_u) -> compile_mind_deps consider_accs cenv env prefix init mind
   | Const (c, _u) ->
     let c, _ = get_alias env sigma c in
     let cb = lookup_constant c env in
@@ -2467,7 +2477,7 @@ let compile_deps cenv env sigma prefix init t =
            aux env lvl init t
         | _ -> init
       in
-      let code = compile_constant cenv env sigma c cb in (* compile_mind_deps uses accumulators anyways *)
+      let code = compile_constant consider_accs cenv env sigma c cb in
       let upd = {
         upd_info = nameref;
         upd_prefix = prefix;
@@ -2475,13 +2485,13 @@ let compile_deps cenv env sigma prefix init t =
       let comp_stack = code@comp_stack in
       let const_updates = Cmap_env.add c upd const_updates in
       comp_stack, (mind_updates, const_updates)
-  | Construct (((mind,_),_),_u) -> compile_mind_deps cenv env prefix init mind
+  | Construct (((mind,_),_),_u) -> compile_mind_deps consider_accs cenv env prefix init mind
   | Proj (p,_,c) ->
-    let init = compile_mind_deps cenv env prefix init (Projection.mind p) in
+    let init = compile_mind_deps consider_accs cenv env prefix init (Projection.mind p) in
     aux env lvl init c
   | Case (ci, _u, _pms, _p, _iv, _c, _ac) ->
       let mind = fst ci.ci_ind in
-      let init = compile_mind_deps cenv env prefix init mind in
+      let init = compile_mind_deps consider_accs cenv env prefix init mind in
       fold_constr_with_binders succ (aux env) lvl init t
   | Var id ->
     let open Context.Named.Declaration in
@@ -2503,13 +2513,13 @@ let compile_deps cenv env sigma prefix init t =
   in
   aux env 0 init t
 
-let compile_constant_field cenv env con acc cb =
-  let gl = compile_constant cenv env (empty_evars env) con cb in
+let compile_constant_field consider_accs cenv env con acc cb =
+  let gl = compile_constant consider_accs cenv env (empty_evars env) con cb in
   gl@acc
 
-let compile_mind_field cenv mp l acc mb =
+let compile_mind_field consider_accs cenv mp l acc mb =
   let mind = MutInd.make2 mp l in
-  compile_mind cenv mb mind acc
+  compile_mind consider_accs cenv mb mind acc
 
 let warn_native_rules =
   CWarnings.create ~name:"native-rewrite-rules"
@@ -2530,15 +2540,15 @@ let mk_conv_code env sigma prefix t1 t2 =
   let cenv = make_cenv () in
   let gl, (mind_updates, const_updates) =
     let init = ([], empty_updates) in
-    compile_deps cenv env sigma prefix init t1
+    compile_deps true cenv env sigma prefix init t1 (* we assume accumulators for the conversion code for the sake of simplicity *)
   in
   let gl, (mind_updates, const_updates) =
     let init = (gl, (mind_updates, const_updates)) in
-    compile_deps cenv env sigma prefix init t2
+    compile_deps true cenv env sigma prefix init t2
   in
   let code1 = lambda_of_constr env sigma t1 in
   let code2 = lambda_of_constr env sigma t2 in
-  let (gl,code1) = compile_with_fv true cenv env sigma UGlobal gl None code1 in (* we assume accumulators for conversion code *)
+  let (gl,code1) = compile_with_fv true cenv env sigma UGlobal gl None code1 in
   let (gl,code2) = compile_with_fv true cenv env sigma UGlobal gl None code2 in
   let t1 = mk_internal_let "$t1" code1 in
   let t2 = mk_internal_let "$t2" code2 in
@@ -2557,10 +2567,10 @@ let mk_norm_code consider_accs env sigma prefix t =
   let cenv = make_cenv () in
   let gl, (mind_updates, const_updates) =
     let init = ([], empty_updates) in
-    compile_deps cenv env sigma prefix init t
+    compile_deps consider_accs cenv env sigma prefix init t
   in
   let code = lambda_of_constr env sigma t in
-  let (gl,code) = compile_with_fv true cenv env sigma UGlobal gl None code in (* compile_deps uses accumulators anyways *)
+  let (gl,code) = compile_with_fv consider_accs cenv env sigma UGlobal gl None code in (* compile_deps uses accumulators anyways *)
   let t1 = mk_internal_let "$t1" code in
   let g1 = MLglobal (Ginternal "$t1") in
   let setref = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt1)",g1)) in
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index 7a5133c6a796..ffcf428aa75d 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -63,10 +63,10 @@ val register_native_file : string -> unit
 
 val is_loaded_native_file : string -> bool
 
-val compile_constant_field : cenv -> env -> Constant.t ->
+val compile_constant_field : bool -> cenv -> env -> Constant.t ->
   global list -> constant_body -> global list
 
-val compile_mind_field : cenv -> ModPath.t -> Id.t ->
+val compile_mind_field : bool -> cenv -> ModPath.t -> Id.t ->
   global list -> mutual_inductive_body -> global list
 
 val compile_rewrite_rules : env -> Id.t ->
diff --git a/kernel/nativelibrary.ml b/kernel/nativelibrary.ml
index c7b077496ac2..a795e9e538cd 100644
--- a/kernel/nativelibrary.ml
+++ b/kernel/nativelibrary.ml
@@ -38,13 +38,13 @@ and translate_field mp cenv env acc (l,x) =
      (debug_native_compiler (fun () ->
         let msg = Printf.sprintf "Compiling constant %s..." (Constant.to_string con) in
         Pp.str msg));
-     compile_constant_field cenv env con acc cb
+     compile_constant_field true cenv env con acc cb (* we consider accumulators when compiling general-purpose libraries *)
   | SFBmind mb ->
      (debug_native_compiler (fun () ->
         let id = mb.mind_packets.(0).mind_typename in
         let msg = Printf.sprintf "Compiling inductive %s..." (Id.to_string id) in
         Pp.str msg));
-     compile_mind_field cenv mp l acc mb
+     compile_mind_field true cenv mp l acc mb
   | SFBrules rrb ->
      (debug_native_compiler (fun () ->
         let msg = Printf.sprintf "Not Compiling rules %s..." (Id.to_string l) in

From 834c63a7d1170e2c8be0e02176e1461b2a35cf27 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 22 Jun 2026 17:43:13 +0200
Subject: [PATCH 081/110] Production now forces accumulators as they need one
 to be evaluated

---
 kernel/nativecode.ml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index c6aca6198936..9bea6e7c154e 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1357,6 +1357,7 @@ let rec ml_of_lam consider_accs env l t =
     let args = MLarray(Array.map (ml_of_lam consider_accs env l) args) in
     MLprimitive (Mk_evar, [|get_evar_code i; args|])
   | Lprod(dom,codom) ->
+    if not consider_accs then raise NeedsAccumulators else (* production need an accumulator to be evaluated TODOME: check this *)
     let dom = ml_of_lam consider_accs env l dom in
     let codom = ml_of_lam consider_accs env l codom in
     let n = get_prod_name codom in

From db4341fc5ba894a80d34cee434305d060663015c Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 23 Jun 2026 13:47:43 +0200
Subject: [PATCH 082/110] move the choice to compile with or without
 accumulators to allow to fallback to normal mode when interpreting the result
 of the computation

---
 kernel/nativecode.ml    | 21 ++++------
 kernel/nativecode.mli   |  6 ++-
 kernel/nativeconv.ml    | 88 +++++++++++++++++++++++------------------
 kernel/nativelib.ml     |  1 +
 pretyping/nativenorm.ml | 77 ++++++++++++++++++++----------------
 5 files changed, 106 insertions(+), 87 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 9bea6e7c154e..42d60adb177e 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1194,7 +1194,7 @@ let merge_branches t =
 
 let app_prim p args = MLprimitive (p, args)
 
-let ml_empty_instance = MLprimitive (Mk_empty_instance, [||]) (* TODOME: check *)
+let ml_empty_instance = MLprimitive (Mk_empty_instance, [||])
 
 type prim_aux =
   | PAprim of string * pconstant * CPrimitives.t * prim_aux array
@@ -1357,7 +1357,7 @@ let rec ml_of_lam consider_accs env l t =
     let args = MLarray(Array.map (ml_of_lam consider_accs env l) args) in
     MLprimitive (Mk_evar, [|get_evar_code i; args|])
   | Lprod(dom,codom) ->
-    if not consider_accs then raise NeedsAccumulators else (* production need an accumulator to be evaluated TODOME: check this *)
+    if not consider_accs then raise NeedsAccumulators else (* productions needs an accumulator to be evaluated TODOME: maybe remove ? (checked at runtime)*)
     let dom = ml_of_lam consider_accs env l dom in
     let codom = ml_of_lam consider_accs env l codom in
     let n = get_prod_name codom in
@@ -2537,20 +2537,20 @@ let mk_internal_let s code =
   Glet(Ginternal s, code)
 
 (* ML Code for conversion function *)
-let mk_conv_code env sigma prefix t1 t2 =
+let mk_conv_code consider_accs env sigma prefix t1 t2 =
   let cenv = make_cenv () in
   let gl, (mind_updates, const_updates) =
     let init = ([], empty_updates) in
-    compile_deps true cenv env sigma prefix init t1 (* we assume accumulators for the conversion code for the sake of simplicity *)
+    compile_deps consider_accs cenv env sigma prefix init t1
   in
   let gl, (mind_updates, const_updates) =
     let init = (gl, (mind_updates, const_updates)) in
-    compile_deps true cenv env sigma prefix init t2
+    compile_deps consider_accs cenv env sigma prefix init t2
   in
   let code1 = lambda_of_constr env sigma t1 in
   let code2 = lambda_of_constr env sigma t2 in
-  let (gl,code1) = compile_with_fv true cenv env sigma UGlobal gl None code1 in
-  let (gl,code2) = compile_with_fv true cenv env sigma UGlobal gl None code2 in
+  let (gl,code1) = compile_with_fv consider_accs cenv env sigma UGlobal gl None code1 in
+  let (gl,code2) = compile_with_fv consider_accs cenv env sigma UGlobal gl None code2 in
   let t1 = mk_internal_let "$t1" code1 in
   let t2 = mk_internal_let "$t2" code2 in
   let g1 = MLglobal (Ginternal "$t1") in
@@ -2571,7 +2571,7 @@ let mk_norm_code consider_accs env sigma prefix t =
     compile_deps consider_accs cenv env sigma prefix init t
   in
   let code = lambda_of_constr env sigma t in
-  let (gl,code) = compile_with_fv consider_accs cenv env sigma UGlobal gl None code in (* compile_deps uses accumulators anyways *)
+  let (gl,code) = compile_with_fv consider_accs cenv env sigma UGlobal gl None code in
   let t1 = mk_internal_let "$t1" code in
   let g1 = MLglobal (Ginternal "$t1") in
   let setref = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt1)",g1)) in
@@ -2585,11 +2585,6 @@ let mk_norm_code consider_accs env sigma prefix t =
   let symbols = get_cenv_symbols cenv in
   header::gl, symbols, (mind_updates, const_updates)
 
-(* wrapper for the function above *)
-let mk_norm_code env sigma prefix t =
-  try mk_norm_code false env sigma prefix t with
-  | NeedsAccumulators -> mk_norm_code true env sigma prefix t
-
 let mk_library_header (symbols : Nativevalues.symbols) =
   [Glet(Ginternal "$symbols_tbl", MLprimitive (Str_decode, [|MLglobal (Ginternal ("\"" ^ (str_encode symbols) ^ "\""))|]))]
 
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index ffcf428aa75d..db19cf2cf3b1 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -17,6 +17,8 @@ open Nativevalues
 compiler. mllambda represents a fragment of ML, and can easily be printed
 to OCaml code. *)
 
+exception NeedsAccumulators (* raise by functions that compile without accumulators when they are needed for correctness *)
+
 type cenv
 
 val make_cenv : unit -> cenv
@@ -72,8 +74,8 @@ val compile_mind_field : bool -> cenv -> ModPath.t -> Id.t ->
 val compile_rewrite_rules : env -> Id.t ->
   global list -> rewrite_rules_body -> global list
 
-val mk_conv_code : env -> Genlambda.evars -> string -> constr -> constr -> linkable_code
-val mk_norm_code : env -> Genlambda.evars -> string -> constr -> linkable_code
+val mk_conv_code : bool -> env -> Genlambda.evars -> string -> constr -> constr -> linkable_code
+val mk_norm_code : bool -> env -> Genlambda.evars -> string -> constr -> linkable_code
 
 val mk_library_header : Nativevalues.symbols -> global list
 
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 83216e242b01..f0f13acb34e3 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -42,23 +42,26 @@ let sort_cmp_universes pb s1 s2 (state, check, box) =
   let state, check = Conversion.sort_cmp_universes pb s1 s2 (state, check) in
   fail_check state check box
 
-let rec conv_val env pb lvl v1 v2 cu =
+let rec conv_val consider_accs env pb lvl v1 v2 cu =
   if v1 == v2 then cu
   else
     match kind_of_value v1, kind_of_value v2 with
     | Vfun f1, Vfun f2 ->
-        let v = mk_rel_accu lvl in
-        conv_val env CONV (lvl+1) (f1 v) (f2 v) cu
+      if not consider_accs then raise NeedsAccumulators else
+      let v = mk_rel_accu lvl in
+      conv_val consider_accs env CONV (lvl+1) (f1 v) (f2 v) cu
     | Vfun _f1, _ ->
-      conv_val env CONV lvl v1 (eta_expand v2) cu
+      conv_val consider_accs env CONV lvl v1 (eta_expand v2) cu
     | _, Vfun _f2 ->
-        conv_val env CONV lvl (eta_expand v1) v2 cu
+      conv_val consider_accs env CONV lvl (eta_expand v1) v2 cu
     | Vaccu k1, Vaccu k2 ->
-        conv_accu env pb lvl k1 k2 cu
+      (* if not consider_accs then failwith "accumulator mysteriously appeared in a accumulator-less execution" else *)
+      conv_accu env pb lvl k1 k2 cu
     | Vprod(_,d1,c1), Vprod(_,d2,c2) ->
-       let cu = conv_val env CONV lvl d1 d2 cu in
-       let v = mk_rel_accu lvl in
-       conv_val env pb (lvl + 1) (apply c1 v) (apply c2 v) cu
+      if not consider_accs then raise NeedsAccumulators else
+      let cu = conv_val consider_accs env CONV lvl d1 d2 cu in
+      let v = mk_rel_accu lvl in
+      conv_val consider_accs env pb (lvl + 1) (apply c1 v) (apply c2 v) cu
     | Vconst i1, Vconst i2 ->
         if Int.equal i1 i2 then cu else raise NotConvertible
     | Vint64 i1, Vint64 i2 ->
@@ -72,7 +75,7 @@ let rec conv_val env pb lvl v1 v2 cu =
     | Varray t1, Varray t2 ->
       let len = Parray.length_int t1 in
       if not (Int.equal len (Parray.length_int t2)) then raise NotConvertible;
-      Parray.fold_left2 (fun cu v1 v2 -> conv_val env CONV lvl v1 v2 cu) cu t1 t2
+      Parray.fold_left2 (fun cu v1 v2 -> conv_val consider_accs env CONV lvl v1 v2 cu) cu t1 t2
     | Vblock b1, Vblock b2 ->
         let n1 = block_size b1 in
         let n2 = block_size b2 in
@@ -80,9 +83,9 @@ let rec conv_val env pb lvl v1 v2 cu =
           raise NotConvertible;
         let rec aux lvl max b1 b2 i cu =
           if Int.equal i max then
-            conv_val env CONV lvl (block_field b1 i) (block_field b2 i) cu
+            conv_val consider_accs env CONV lvl (block_field b1 i) (block_field b2 i) cu
           else
-            let cu = conv_val env CONV lvl (block_field b1 i) (block_field b2 i) cu in
+            let cu = conv_val consider_accs env CONV lvl (block_field b1 i) (block_field b2 i) cu in
             aux lvl max b1 b2 (i+1) cu
         in
         aux lvl (n1-1) b1 b2 0 cu
@@ -97,7 +100,7 @@ and conv_accu env pb lvl k1 k2 cu =
     conv_atom env pb lvl (atom_of_accu k1) (atom_of_accu k2) cu
   else
     let cu = conv_atom env pb lvl (atom_of_accu k1) (atom_of_accu k2) cu in
-    List.fold_right2 (conv_val env CONV lvl) (args_of_accu k1) (args_of_accu k2) cu
+    List.fold_right2 (conv_val true env CONV lvl) (args_of_accu k1) (args_of_accu k2) cu
 
 and conv_atom env pb lvl a1 a2 cu =
   if a1 == a2 then cu
@@ -105,7 +108,7 @@ and conv_atom env pb lvl a1 a2 cu =
     match a1, a2 with
     | Aevar (ev1, args1), Aevar (ev2, args2) ->
       if Evar.equal ev1 ev2 then
-        Array.fold_right2 (conv_val env CONV lvl) args1 args2 cu
+        Array.fold_right2 (conv_val true env CONV lvl) args1 args2 cu
       else raise NotConvertible
     | Arel i1, Arel i2 ->
         if Int.equal i1 i2 then cu else raise NotConvertible
@@ -131,9 +134,9 @@ and conv_atom env pb lvl a1 a2 cu =
         let cu = conv_accu env CONV lvl ac1 ac2 cu in
         let tbl = a1.asw_reloc in
         let len = Array.length tbl in
-        if Int.equal len 0 then conv_val env CONV lvl p1 p2 cu
+        if Int.equal len 0 then conv_val true env CONV lvl p1 p2 cu
         else begin
-            let cu = conv_val env CONV lvl p1 p2 cu in
+            let cu = conv_val true env CONV lvl p1 p2 cu in
             let max = len - 1 in
             let rec aux i cu =
               let tag,arity = tbl.(i) in
@@ -141,8 +144,8 @@ and conv_atom env pb lvl a1 a2 cu =
                 if Int.equal arity 0 then mk_const tag
                 else mk_block tag (mk_rels_accu lvl arity) in
               let bi1 = apply bs1 ci and bi2 = apply bs2 ci in
-              if Int.equal i max then conv_val env CONV (lvl + arity) bi1 bi2 cu
-              else aux (i+1) (conv_val env CONV (lvl + arity) bi1 bi2 cu) in
+              if Int.equal i max then conv_val true env CONV (lvl + arity) bi1 bi2 cu
+              else aux (i+1) (conv_val true env CONV (lvl + arity) bi1 bi2 cu) in
             aux 0 cu
           end
     | Afix(t1,f1,rp1,s1), Afix(t2,f2,rp2,s2) ->
@@ -155,7 +158,7 @@ and conv_atom env pb lvl a1 a2 cu =
         else if not (Int.equal (Array.length f1) (Array.length f2) && Int.equal (Array.length args1) (Array.length args2)) then
           raise NotConvertible
         else
-          Array.fold_left2 (fun cu v1 v2 -> conv_val env CONV lvl v1 v2 cu) (conv_fix env lvl t1 f1 t2 f2 cu) args1 args2
+          Array.fold_left2 (fun cu v1 v2 -> conv_val true env CONV lvl v1 v2 cu) (conv_fix env lvl t1 f1 t2 f2 cu) args1 args2
     | Aproj((ind1, i1), ac1), Aproj((ind2, i2), ac2) ->
        if not (QInd.equal env ind1 ind2 && Int.equal i1 i2) then raise NotConvertible
        else conv_accu env CONV lvl ac1 ac2 cu
@@ -170,11 +173,11 @@ and conv_fix env lvl t1 f1 t2 f2 cu =
   let fargs = mk_rels_accu lvl len in
   let flvl = lvl + len in
   let rec aux i cu =
-    let cu = conv_val env CONV lvl t1.(i) t2.(i) cu in
+    let cu = conv_val true env CONV lvl t1.(i) t2.(i) cu in
     let fi1 = napply f1.(i) fargs in
     let fi2 = napply f2.(i) fargs in
-    if Int.equal i max then conv_val env CONV flvl fi1 fi2 cu
-    else aux (i+1) (conv_val env CONV flvl fi1 fi2 cu) in
+    if Int.equal i max then conv_val true env CONV flvl fi1 fi2 cu
+    else aux (i+1) (conv_val true env CONV flvl fi1 fi2 cu) in
   aux 0 cu
 
 let w_native_disabled = CWarnings.create_warning
@@ -190,22 +193,31 @@ let warn_no_native_compiler =
 let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
   Nativelib.link_libraries ();
   let ml_filename, prefix = Nativelib.get_mlf_filename () in
-  let code, symbols, upds = mk_conv_code env sigma prefix t1 t2 in
-  let fn = Nativelib.compile ml_filename code ~profile:false in
-  debug_native_compiler (fun () -> Pp.str "Running test...");
-  let t0 = Sys.time () in
-  let (rt1, rt2) = Nativelib.execute_library ~prefix fn symbols upds in
-  let rt1 = Option.get rt1 and rt2 = Option.get rt2 in
-  let t1 = Sys.time () in
-  let time_info = Format.sprintf "Evaluation done in %.5f@." (t1 -. t0) in
-  debug_native_compiler (fun () -> Pp.str time_info);
-  (* TODO change 0 when we can have de Bruijn *)
-  let exception Error of err in
-  let box = { fail = fun e -> raise (Error e) } in
-  try Result.Ok (pi1 (conv_val env pb 0 rt1 rt2 (state, check, box)))
-  with
-  | NotConvertible -> Result.Error None
-  | Error e -> Result.Error (Some e)
+  let aux consider_accs =
+    let code, symbols, upds = mk_conv_code consider_accs env sigma prefix t1 t2 in
+    let fn = Nativelib.compile ml_filename code ~profile:false in
+    if consider_accs then
+      debug_native_compiler (fun () -> Pp.str "Running test with accumulators...")
+    else
+      debug_native_compiler (fun () -> Pp.str "Running test without accumulators...");
+    let t0 = Sys.time () in
+    let (rt1, rt2) = Nativelib.execute_library ~prefix fn symbols upds in
+    let rt1 = Option.get rt1 and rt2 = Option.get rt2 in
+    let t1 = Sys.time () in
+    let time_info = Format.sprintf "Evaluation done in %.5f@." (t1 -. t0) in
+    debug_native_compiler (fun () -> Pp.str time_info);
+    (* TODO change 0 when we can have de Bruijn *)
+    let exception Error of err in
+    let box = { fail = fun e -> raise (Error e) } in
+    try Result.Ok (pi1 (conv_val consider_accs env pb 0 rt1 rt2 (state, check, box)))
+    with
+    | NotConvertible -> Result.Error None
+    | Error e -> Result.Error (Some e)
+  in
+  try aux false with
+  | NeedsAccumulators ->
+    debug_native_compiler (fun () -> Pp.str "Native-compute without accumulators failed, falling back to normal mode.");
+    aux true
 
 let native_conv_gen pb sigma env univs t1 t2 =
   if not (typing_flags env).Declarations.enable_native_compiler then
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 2236caa9f2aa..2a79c9d85101 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -96,6 +96,7 @@ let get_mlf_filename () =
   let temp_dir = force_temp_dir() in
   let filename = Filename.temp_file ~temp_dir "Coq_native" source_ext in
   let prefix = Filename.chop_extension (Filename.basename filename) ^ "." in
+  delay_cleanup_file filename;
   filename, prefix
 
 let write_code fn ?(header=[]) code =
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index d65d09c47f93..49e42c9b3f64 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -194,30 +194,35 @@ let get_proj env (ind, proj_arg) =
   let p, r = Environ.get_projection env ind ~proj_arg in
   Projection.make p true, r
 
-let rec nf_val env sigma v typ =
+let rec nf_val consider_accs env sigma v typ =
   match kind_of_value v with
-  | Vaccu accu -> nf_accu env sigma accu
-  | Vprod (na, dom, codom) -> fst @@ nf_prod env sigma (na, dom, codom)
+  | Vaccu accu ->
+    (* if not consider_accs then failwith "accumulator mysteriously appeared in a accumulator-less execution" else *)
+    nf_accu env sigma accu
+  | Vprod (na, dom, codom) ->
+    if not consider_accs then raise NeedsAccumulators else
+    fst @@ nf_prod env sigma (na, dom, codom)
   | Vfix e | Vcofix e -> Empty.abort e
   | Vfun f ->
-      let lvl = nb_rel env in
-      let name,dom,codom =
-        try decompose_prod env typ
-        with DestKO ->
-          CErrors.anomaly
-            (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
-      in
-      let env = push_rel (LocalAssum (name,dom)) env in
-      let body = nf_val env sigma (f (mk_rel_accu lvl)) codom in
-      mkLambda(name,dom,body)
+    if not consider_accs then raise NeedsAccumulators else
+    let lvl = nb_rel env in
+    let name,dom,codom =
+      try decompose_prod env typ
+      with DestKO ->
+        CErrors.anomaly
+          (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
+    in
+    let env = push_rel (LocalAssum (name,dom)) env in
+    let body = nf_val consider_accs env sigma (f (mk_rel_accu lvl)) codom in
+    mkLambda(name,dom,body)
   | Vconst n -> construct_of_constr_const env sigma n typ
   | Vint64 i -> i |> Uint63.of_int64 |> mkInt
   | Vfloat64 f -> f |> Float64.of_float |> mkFloat
   | Vstring s -> s |> mkString
-  | Varray t -> nf_array env sigma t typ
+  | Varray t -> nf_array consider_accs env sigma t typ
   | Vblock b ->
       let capp,ctyp = construct_of_constr_block env sigma (block_tag b) typ in
-      let args = nf_bargs env sigma b ctyp in
+      let args = nf_bargs consider_accs env sigma b ctyp in
       mkApp(capp,args)
 
 and nf_type env sigma v =
@@ -264,13 +269,13 @@ and nf_args env sigma args t =
         CErrors.anomaly
           (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
     in
-    let c = nf_val env sigma arg dom in
+    let c = nf_val true env sigma arg dom in
     (subst1 c codom, c::l)
   in
   let t,l = List.fold_right aux args (t,[]) in
   t, List.rev l
 
-and nf_bargs env sigma b t =
+and nf_bargs consider_accs env sigma b t =
   let t = ref t in
   let len = block_size b in
   Array.init len
@@ -281,7 +286,7 @@ and nf_bargs env sigma b t =
           CErrors.anomaly
             (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
       in
-      let c = nf_val env sigma (block_field b i) dom in
+      let c = nf_val consider_accs env sigma (block_field b i) dom in
       t := subst1 c codom; c)
 
 and nf_prod env sigma (na, dom, codom) =
@@ -311,16 +316,16 @@ and nf_atom env sigma atom =
 and nf_atom_type env sigma atom =
   match atom with
   | Arel i ->
-      let n = (nb_rel env - i) in
-      mkRel n, Typeops.type_of_relative env n
+    let n = (nb_rel env - i) in
+    mkRel n, Typeops.type_of_relative env n
   | Aconstant cst ->
-      mkConstU cst, Typeops.type_of_constant_in env cst
+    mkConstU cst, Typeops.type_of_constant_in env cst
   | Aind ind ->
-      mkIndU ind, EConstr.Unsafe.to_constr @@ Inductiveops.type_of_inductive env (on_snd EConstr.EInstance.make ind)
+    mkIndU ind, EConstr.Unsafe.to_constr @@ Inductiveops.type_of_inductive env (on_snd EConstr.EInstance.make ind)
   | Asort s ->
-      mkSort s, Typeops.type_of_sort s
+    mkSort s, Typeops.type_of_sort s
   | Avar id ->
-      mkVar id, Typeops.type_of_variable env id
+    mkVar id, Typeops.type_of_variable env id
   | Acase(ans,accu,p,bs) ->
       let a,ta = nf_accu_type env sigma accu in
       let ((mind, _ as ind), u),allargs = find_rectype_a env sigma (EConstr.of_constr ta) in
@@ -340,7 +345,7 @@ and nf_atom_type env sigma atom =
       let bsw = branch_of_switch (nb_rel env) ans bs in
       let mkbranch i v =
         let decl, nas, lft, codom = btypes.(i) in
-        let b = nf_val (Termops.push_rels_assum decl env) sigma v codom in
+        let b = nf_val true (Termops.push_rels_assum decl env) sigma v codom in
         nas, exliftn lft b
       in
       let branchs = Array.mapi mkbranch bsw in
@@ -364,7 +369,7 @@ and nf_atom_type env sigma atom =
       let env = push_rec_types (names,tt,[||]) env in
       (* We lift here because the types of arguments (in tt) will be evaluated
          in an environment where the fixpoints have been pushed *)
-      let norm_body i v = nf_val env sigma (napply v fargs) (lift nbfix tt.(i)) in
+      let norm_body i v = nf_val true env sigma (napply v fargs) (lift nbfix tt.(i)) in
       let ft = Array.mapi norm_body ft in
       mkFix((rp,s),(names,tt,ft)), tt.(s)
   | Acofix (tt, ft, s, args, _) ->
@@ -376,7 +381,7 @@ and nf_atom_type env sigma atom =
       let fargs = mk_rels_accu lvl (Array.length ft) in
       let _, args = nf_args env sigma (Array.rev_to_list args) tt.(s) in
       let env = push_rec_types (names,tt,[||]) env in
-      let ft = Array.mapi (fun i v -> nf_val env sigma (napply v fargs) tt.(i)) ft in
+      let ft = Array.mapi (fun i v -> nf_val true env sigma (napply v fargs) tt.(i)) ft in
       mkApp (mkCoFix(s,(names,tt,ft)), Array.of_list args), tt.(s)
   | Aevar(evk,args) ->
     nf_evar env sigma evk args
@@ -424,15 +429,15 @@ and nf_evar env sigma evk args =
        evar node *)
     EConstr.(Unsafe.to_constr @@ mkLEvar sigma (evk, List.rev_map of_constr args)), ty
 
-and nf_array env sigma t typ =
+and nf_array consider_accs env sigma t typ =
   let ty, allargs = app_type env sigma (EConstr.of_constr typ) in
   let typ_elem = allargs.(0) in
   let vdef = Parray.default t in
   (* Do not cast into an array out of fear that floats may sneak in *)
-  let init i = nf_val env sigma (Parray.get t (Uint63.of_int i)) typ_elem in
+  let init i = nf_val consider_accs env sigma (Parray.get t (Uint63.of_int i)) typ_elem in
   let t = Array.init (Parray.length_int t) init in
   let u = snd (destConst ty) in
-  mkArray(u, t, nf_val env sigma vdef typ_elem, typ_elem)
+  mkArray(u, t, nf_val consider_accs env sigma vdef typ_elem, typ_elem)
 
 let evars_of_evar_map sigma =
   { Genlambda.evars_val = Evd.evar_handler sigma }
@@ -495,11 +500,12 @@ let native_norm env sigma c ty =
   Nativelib.link_libraries ();
   let c = EConstr.Unsafe.to_constr c in
   let ty = EConstr.Unsafe.to_constr ty in
-    let profile = get_profiling_enabled () in
-    let print_timing = get_timing_enabled () in
+  let profile = get_profiling_enabled () in
+  let print_timing = get_timing_enabled () in
+  let aux consider_accs =
     let ml_filename, prefix = Nativelib.get_mlf_filename () in
     let tnc0 = Unix.gettimeofday () in
-    let code, symbols, upd = mk_norm_code env (evars_of_evar_map sigma) prefix c in
+    let code, symbols, upd = mk_norm_code consider_accs env (evars_of_evar_map sigma) prefix c in
     let tnc1 = Unix.gettimeofday () in
     let time_info = Format.sprintf "native_compute: Conversion to native code done in %.5f" (tnc1 -. tnc0) in
     if print_timing then Feedback.msg_info (Pp.str time_info);
@@ -516,11 +522,14 @@ let native_norm env sigma c ty =
     if profile then stop_profiler profiler_pid;
     let time_info = Format.sprintf "native_compute: Evaluation done in %.5f" (t1 -. t0) in
     if print_timing then Feedback.msg_info (Pp.str time_info);
-    let res = nf_val env sigma rt1 ty in
+    let res = nf_val consider_accs env sigma rt1 ty in
     let t2 = Unix.gettimeofday () in
     let time_info = Format.sprintf "native_compute: Reification done in %.5f" (t2 -. t1) in
     if print_timing then Feedback.msg_info (Pp.str time_info);
     EConstr.of_constr res
+  in
+  try aux false with
+  | NeedsAccumulators -> aux true
 
 let native_norm env sigma c ty =
   if not (Environ.typing_flags env).enable_native_compiler then

From b35e7921c296d22c1237b53c13d974c14562801a Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 23 Jun 2026 16:23:05 +0200
Subject: [PATCH 083/110] Fixed some cases where accumulators where not
 believed to be needed

---
 kernel/nativecode.ml | 20 +++++++++++---------
 kernel/nativeconv.ml |  2 ++
 2 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 42d60adb177e..81db70aa1889 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2308,11 +2308,12 @@ and compile_named consider_accs cenv env sigma univ auxdefs id =
   let open Context.Named.Declaration in
   match lookup_named id env with
   | LocalDef (_,t,_) ->
-      let code = lambda_of_constr env sigma t in
-      let auxdefs,code = compile_with_fv consider_accs cenv env sigma univ auxdefs None code in
-      Glet(Gnamed id, code)::auxdefs
+    let code = lambda_of_constr env sigma t in
+    let auxdefs,code = compile_with_fv consider_accs cenv env sigma univ auxdefs None code in
+    Glet(Gnamed id, code)::auxdefs
   | LocalAssum _ ->
-      Glet(Gnamed id, MLprimitive (Mk_var id, [||]))::auxdefs
+    if not consider_accs then raise NeedsAccumulators else
+    Glet(Gnamed id, MLprimitive (Mk_var id, [||]))::auxdefs
 
 let compile_constant consider_accs cenv env sigma con cb =
     let no_univs = UVars.AbstractContext.is_constant (Declareops.constant_polymorphic_context cb) in
@@ -2558,11 +2559,13 @@ let mk_conv_code consider_accs env sigma prefix t1 t2 =
   let setref1 = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt1)",g1)) in
   let setref2 = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt2)",g2)) in
   let gl = List.rev (setref2 :: setref1 :: t2 :: t1 :: gl) in
+  let compile_mode_comment =
+    Gcomment (if consider_accs then "code generated with accumulators" else "code generated without accumulators") in
   let header = Glet(Ginternal "$symbols_tbl",
     MLprimitive (Get_symbols,
       [|MLglobal (Ginternal "0")|])) in
   let symbols = get_cenv_symbols cenv in
-  header::gl, symbols, (mind_updates, const_updates)
+  compile_mode_comment::header::gl, symbols, (mind_updates, const_updates)
 
 let mk_norm_code consider_accs env sigma prefix t =
   let cenv = make_cenv () in
@@ -2576,14 +2579,13 @@ let mk_norm_code consider_accs env sigma prefix t =
   let g1 = MLglobal (Ginternal "$t1") in
   let setref = Glet(Ginternal "_", MLsetref("(global $Nativelib $rt1)",g1)) in
   let gl = List.rev (setref :: t1 :: gl) in
-  let gl =
-    Gcomment (if consider_accs then "code generated with accumulators" else "code generated without accumulators")
-    :: gl in
+  let compile_mode_comment =
+    Gcomment (if consider_accs then "code generated with accumulators" else "code generated without accumulators") in
   let header = Glet(Ginternal "$symbols_tbl",
     MLprimitive (Get_symbols,
       [|MLglobal (Ginternal "0")|])) in
   let symbols = get_cenv_symbols cenv in
-  header::gl, symbols, (mind_updates, const_updates)
+  compile_mode_comment::header::gl, symbols, (mind_updates, const_updates)
 
 let mk_library_header (symbols : Nativevalues.symbols) =
   [Glet(Ginternal "$symbols_tbl", MLprimitive (Str_decode, [|MLglobal (Ginternal ("\"" ^ (str_encode symbols) ^ "\""))|]))]
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index f0f13acb34e3..77592731e6fb 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -51,8 +51,10 @@ let rec conv_val consider_accs env pb lvl v1 v2 cu =
       let v = mk_rel_accu lvl in
       conv_val consider_accs env CONV (lvl+1) (f1 v) (f2 v) cu
     | Vfun _f1, _ ->
+      if not consider_accs then raise NeedsAccumulators else
       conv_val consider_accs env CONV lvl v1 (eta_expand v2) cu
     | _, Vfun _f2 ->
+      if not consider_accs then raise NeedsAccumulators else
       conv_val consider_accs env CONV lvl (eta_expand v1) v2 cu
     | Vaccu k1, Vaccu k2 ->
       (* if not consider_accs then failwith "accumulator mysteriously appeared in a accumulator-less execution" else *)

From f7ae5bb86395d3bbcd083edfd914c4a6330c10a6 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 23 Jun 2026 16:50:29 +0200
Subject: [PATCH 084/110] fixed cofix points not forcing the use of
 accumulators

---
 kernel/nativecode.ml | 103 ++++++++++++++++++++++---------------------
 1 file changed, 52 insertions(+), 51 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 81db70aa1889..7c62a9b9f881 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1579,58 +1579,59 @@ let rec ml_of_lam consider_accs env l t =
       end in
       MLletrec(Array.mapi mkrec lf, lf_args.(start))
   | Lcofix (start, (ids, tt, tb)) ->
-      (* Compilation of type *)
-      let env_t = restart_env env in
-      let ml_t = Array.map (ml_of_lam consider_accs env_t l) tt in
-      let params_t = fv_params env_t in
-      let args_t = Array.map (fun id -> MLlocal id) params_t in
-      let gft = fresh_gfixtype env.env_cenv l in
-      let gft = push_global_fixtype env.env_cenv gft params_t ml_t in
-      let mk_type = MLapp(MLglobal gft, args_t) in
-      (* Compilation of norm_i *)
-      let ndef = Array.length ids in
-      let lf,env_n = push_rels env_t ids in
-      let t_params = Array.make ndef [||] in
-      let t_norm_f = Array.init ndef (fun _i -> fresh_gnorm env.env_cenv l) in
-      let ml_of_fix i body =
-        let idsi,bodyi = decompose_Llam body in
-        let paramsi, envi = push_rels env_n idsi in
-        let bodyi = ml_of_lam consider_accs envi l bodyi in
-        t_params.(i) <- paramsi;
-        mkMLlam paramsi bodyi
-      in
-      let tnorm = Array.mapi ml_of_fix tb in
-      let fvn,fvr = !(env_n.env_named), !(env_n.env_urel) in
-      let fv_params = fv_params env_n in
-      let fv_args' = Array.map (fun id -> MLlocal id) fv_params in
-      let norm_params = Array.append fv_params lf in
-      let t_norm_f = Array.mapi (fun i body ->
-        push_global_let env.env_cenv (t_norm_f.(i)) (mkMLlam norm_params body)) tnorm in
-      let norm = fresh_gnormtbl env.env_cenv l in
-      let norm = push_global_norm env.env_cenv norm fv_params
-        (Array.map (fun g -> mkMLapp (MLglobal g) fv_args') t_norm_f) in
-      (* Compilation of cofix *)
-      let fv_args = fv_args env fvn fvr in
-      let mk_norm = MLapp(MLglobal norm, fv_args') in
-
-      let knot = fresh_gnormtbl env.env_cenv l in
-      let map i g =
-        (* fun args -> cofix (fun () -> tb_i fv tbl args) *)
-        let unit = fresh_lname env.env_cenv Anonymous in
-        let args = Array.map (fun id -> MLlocal id) t_params.(i) in
-        let mk_let i lname cont =
-          MLlet (lname, MLprimitive (Array_get, [|MLint i; MLglobal knot|]), cont) (* in malfunction, the index is first *)
-        in
-        let self = Array.map (fun id -> MLlocal id) lf in
-        let body = mkMLapp (MLglobal g) (Array.concat [fv_args'; self; args]) in
-        let body = MLlam ([|unit|], Array.fold_right_i mk_let lf body) in
-        let typs = mk_type in
-        let self = mk_norm in
-        mkMLlam t_params.(i) (MLprimitive ((Mk_cofix i), [| typs; self; body; MLarray args |]))
+    if not consider_accs then raise NeedsAccumulators else (* cofixpoint compilation uses an accumulator *)
+    (* Compilation of type *)
+    let env_t = restart_env env in
+    let ml_t = Array.map (ml_of_lam consider_accs env_t l) tt in
+    let params_t = fv_params env_t in
+    let args_t = Array.map (fun id -> MLlocal id) params_t in
+    let gft = fresh_gfixtype env.env_cenv l in
+    let gft = push_global_fixtype env.env_cenv gft params_t ml_t in
+    let mk_type = MLapp(MLglobal gft, args_t) in
+    (* Compilation of norm_i *)
+    let ndef = Array.length ids in
+    let lf,env_n = push_rels env_t ids in
+    let t_params = Array.make ndef [||] in
+    let t_norm_f = Array.init ndef (fun _i -> fresh_gnorm env.env_cenv l) in
+    let ml_of_fix i body =
+      let idsi,bodyi = decompose_Llam body in
+      let paramsi, envi = push_rels env_n idsi in
+      let bodyi = ml_of_lam consider_accs envi l bodyi in
+      t_params.(i) <- paramsi;
+      mkMLlam paramsi bodyi
+    in
+    let tnorm = Array.mapi ml_of_fix tb in
+    let fvn,fvr = !(env_n.env_named), !(env_n.env_urel) in
+    let fv_params = fv_params env_n in
+    let fv_args' = Array.map (fun id -> MLlocal id) fv_params in
+    let norm_params = Array.append fv_params lf in
+    let t_norm_f = Array.mapi (fun i body ->
+      push_global_let env.env_cenv (t_norm_f.(i)) (mkMLlam norm_params body)) tnorm in
+    let norm = fresh_gnormtbl env.env_cenv l in
+    let norm = push_global_norm env.env_cenv norm fv_params
+      (Array.map (fun g -> mkMLapp (MLglobal g) fv_args') t_norm_f) in
+    (* Compilation of cofix *)
+    let fv_args = fv_args env fvn fvr in
+    let mk_norm = MLapp(MLglobal norm, fv_args') in
+
+    let knot = fresh_gnormtbl env.env_cenv l in
+    let map i g =
+      (* fun args -> cofix (fun () -> tb_i fv tbl args) *)
+      let unit = fresh_lname env.env_cenv Anonymous in
+      let args = Array.map (fun id -> MLlocal id) t_params.(i) in
+      let mk_let i lname cont =
+        MLlet (lname, MLprimitive (Array_get, [|MLint i; MLglobal knot|]), cont) (* in malfunction, the index is first *)
       in
-      (* Tie the knot *)
-      let knot = push_global_cofix env.env_cenv knot fv_params (Array.mapi map t_norm_f) in
-      MLprimitive (Array_get, [|MLint start; MLapp (MLglobal knot, fv_args)|]) (* in malfunction, the index is first *)
+      let self = Array.map (fun id -> MLlocal id) lf in
+      let body = mkMLapp (MLglobal g) (Array.concat [fv_args'; self; args]) in
+      let body = MLlam ([|unit|], Array.fold_right_i mk_let lf body) in
+      let typs = mk_type in
+      let self = mk_norm in
+      mkMLlam t_params.(i) (MLprimitive ((Mk_cofix i), [| typs; self; body; MLarray args |]))
+    in
+    (* Tie the knot *)
+    let knot = push_global_cofix env.env_cenv knot fv_params (Array.mapi map t_norm_f) in
+    MLprimitive (Array_get, [|MLint start; MLapp (MLglobal knot, fv_args)|]) (* in malfunction, the index is first *)
 
   | Lint tag -> MLint tag
 

From b900ce0a13e34c55104d7b9fcb456134ac4d64bd Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 23 Jun 2026 17:20:14 +0200
Subject: [PATCH 085/110] fixed some comments that are no longer accurate

---
 kernel/nativecode.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 7c62a9b9f881..69c58ac955b7 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -449,9 +449,9 @@ type mllambda =
   | MLapp          of mllambda * mllambda array
   | MLif           of mllambda * mllambda * mllambda
   | MLmatch        of mllambda * mllambda * mllam_branches
-                              (* argument, prefix, accu branch, branches *)
+                              (* argument, accu branch, branches *)
   | MLmatch_noaccu        of mllambda * mllam_branches
-                              (* argument, prefix, branches *)
+                              (* argument, branches *)
   | MLconstruct    of string * inductive * int * mllambda array
                    (* prefix, inductive name, tag, arguments *)
   | MLint          of int

From 649408c03b3c8ff4078ec929b6c8897b0e1512e9 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 23 Jun 2026 19:12:49 +0200
Subject: [PATCH 086/110] accumulator removal now takes into account libraries
 that could need accumulators

---
 kernel/nativecode.ml    | 21 +++++++++++++++++----
 kernel/nativecode.mli   |  1 +
 kernel/nativeconv.ml    |  2 +-
 kernel/nativelib.ml     |  4 +++-
 kernel/nativelib.mli    |  2 +-
 pretyping/nativenorm.ml |  2 +-
 6 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 69c58ac955b7..f3daeee1df02 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2355,17 +2355,30 @@ module StringOrd = struct type t = string let compare = String.compare end
 module StringSet = Set.Make(StringOrd)
 
 let loaded_native_files = ref StringSet.empty
+let uses_accumulators_native_file = ref StringSet.empty
 
 let is_loaded_native_file s = StringSet.mem s !loaded_native_files
+let has_accus_native_file s = StringSet.mem s !loaded_native_files
 
 let register_native_file s =
   loaded_native_files := StringSet.add s !loaded_native_files
 
-let is_code_loaded name =
+let indicate_native_file_has_accus s =
+  uses_accumulators_native_file := StringSet.add s !uses_accumulators_native_file
+
+let is_code_loaded consider_accs name =
   match !name with
   | NotLinked -> false
   | Linked s ->
-      if is_loaded_native_file s then true
+      if is_loaded_native_file s then
+        (* the dependency needs accumulators to work, so we need them too.
+        We could also try to recompile them and hope that their accumulators were needed due to a parent file needing them, but this is costly and unlikely *)
+        let has_accs = has_accus_native_file s in
+        if not consider_accs && has_accs then raise NeedsAccumulators else
+        if consider_accs && not has_accs then
+          failwith ("library "^s^" does not support accumulators but we need them, help!")
+        else
+        true
       else (name := NotLinked; false)
 
 let compile_mind consider_accs cenv mb mind stack =
@@ -2445,7 +2458,7 @@ let compile_mind_deps consider_accs cenv env prefix
     (comp_stack, (mind_updates, const_updates) as init) mind =
   let mib = lookup_mind mind env in
   let nameref = lookup_mind_key mind env in
-  if is_code_loaded nameref
+  if is_code_loaded consider_accs nameref
     || Mindmap_env.mem mind mind_updates
   then init
   else
@@ -2470,7 +2483,7 @@ let compile_deps consider_accs cenv env sigma prefix init t =
     let cb = lookup_constant c env in
     let (nameref, _) = lookup_constant_key c env in
     let (_, (_, const_updates)) = init in
-    if is_code_loaded nameref
+    if is_code_loaded consider_accs nameref
     || (Cmap_env.mem c const_updates)
     then init
     else
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index db19cf2cf3b1..c7f9c8d2e264 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -62,6 +62,7 @@ type linkable_code = global list * symbols * code_location_updates
 val empty_updates : code_location_updates
 
 val register_native_file : string -> unit
+val indicate_native_file_has_accus : string -> unit
 
 val is_loaded_native_file : string -> bool
 
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 77592731e6fb..183894b94045 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -203,7 +203,7 @@ let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
     else
       debug_native_compiler (fun () -> Pp.str "Running test without accumulators...");
     let t0 = Sys.time () in
-    let (rt1, rt2) = Nativelib.execute_library ~prefix fn symbols upds in
+    let (rt1, rt2) = Nativelib.execute_library consider_accs ~prefix fn symbols upds in
     let rt1 = Option.get rt1 and rt2 = Option.get rt2 in
     let t1 = Sys.time () in
     let time_info = Format.sprintf "Evaluation done in %.5f@." (t1 -. t0) in
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 2a79c9d85101..caa0f5465f9a 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -217,7 +217,7 @@ let compile_library (code, symb) fn =
   let _ = call_compiler fn in
   delay_cleanup_file fn
 
-let execute_library ~prefix f symbols upds =
+let execute_library consider_accs ~prefix f symbols upds =
   let () = rt1 := None in
   let () = rt2 := None in
   let () = rsymbols := symbols in
@@ -225,6 +225,8 @@ let execute_library ~prefix f symbols upds =
     CErrors.user_err Pp.(str "Cannot find native compiler file " ++ str f);
   if Dynlink.is_native then Dynlink.loadfile f else !load_obj f;
   register_native_file prefix;
+  if consider_accs then indicate_native_file_has_accus prefix;
+  (* the file cannot be marked and then recompiled with another setting because we only mark it when using accumulators, which is already our fallback *)
   update_locations upds;
   (!rt1, !rt2)
 
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index b58c414d31a6..23029a49d56b 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -39,7 +39,7 @@ val compile_library : native_library -> string -> unit
     updates the library locations [upds], and returns the values stored
     in [rt1] and [rt2] *)
 val execute_library :
-  prefix:string -> string -> Nativevalues.symbols -> Nativecode.code_location_updates ->
+  bool -> prefix:string -> string -> Nativevalues.symbols -> Nativecode.code_location_updates ->
   Nativevalues.t option * Nativevalues.t option
 
 (** [enable_library] marks the given library for dynamic loading
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index 49e42c9b3f64..2309af61a186 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -516,7 +516,7 @@ let native_norm env sigma c ty =
     if print_timing then Feedback.msg_info (Pp.str time_info);
     let profiler_pid = if profile then start_profiler () else None in
     let t0 = Unix.gettimeofday () in
-    let (rt1, _) = Nativelib.execute_library ~prefix fn symbols upd in
+    let (rt1, _) = Nativelib.execute_library consider_accs ~prefix fn symbols upd in
     let rt1 = Option.get rt1 in
     let t1 = Unix.gettimeofday () in
     if profile then stop_profiler profiler_pid;

From 516a3a32489c9154171379c327954efb8d5700c1 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 24 Jun 2026 13:07:56 +0200
Subject: [PATCH 087/110] fixed has_accus_native_file wrongly always returning
 true

---
 kernel/nativecode.ml | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index f3daeee1df02..6f9faadb67fb 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2358,7 +2358,7 @@ let loaded_native_files = ref StringSet.empty
 let uses_accumulators_native_file = ref StringSet.empty
 
 let is_loaded_native_file s = StringSet.mem s !loaded_native_files
-let has_accus_native_file s = StringSet.mem s !loaded_native_files
+let has_accus_native_file s = StringSet.mem s !uses_accumulators_native_file
 
 let register_native_file s =
   loaded_native_files := StringSet.add s !loaded_native_files
@@ -2370,16 +2370,16 @@ let is_code_loaded consider_accs name =
   match !name with
   | NotLinked -> false
   | Linked s ->
-      if is_loaded_native_file s then
-        (* the dependency needs accumulators to work, so we need them too.
-        We could also try to recompile them and hope that their accumulators were needed due to a parent file needing them, but this is costly and unlikely *)
-        let has_accs = has_accus_native_file s in
-        if not consider_accs && has_accs then raise NeedsAccumulators else
-        if consider_accs && not has_accs then
-          failwith ("library "^s^" does not support accumulators but we need them, help!")
-        else
-        true
-      else (name := NotLinked; false)
+    if is_loaded_native_file s then
+      (* the dependency needs accumulators to work, so we need them too.
+      We could also try to recompile them and hope that their accumulators were needed due to a parent file needing them, but this is costly and unlikely *)
+      let has_accs = has_accus_native_file s in
+      if not consider_accs && has_accs then raise NeedsAccumulators else
+      if consider_accs && not has_accs then
+        failwith ("library "^s^" does not support accumulators but we need them, help!")
+      else
+      true
+    else (name := NotLinked; false)
 
 let compile_mind consider_accs cenv mb mind stack =
   let u = Declareops.inductive_polymorphic_context mb in

From f5a95138c13f2e43f81c185cfd9c9a80b4fe9801 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 24 Jun 2026 17:36:51 +0200
Subject: [PATCH 088/110] Libraries mli interfaces now indicate if they use
 accumulators, and this information is used when compiling

---
 kernel/nativecode.ml    | 45 ++++++++++++++++++++++++++++++++++++-----
 kernel/nativecode.mli   | 10 +++++++--
 kernel/nativeconv.ml    |  4 ++--
 kernel/nativelib.ml     | 19 +++++++++--------
 kernel/nativelib.mli    |  6 +++---
 pretyping/nativenorm.ml |  4 ++--
 topbin/rocqnative.ml    |  4 ++--
 vernac/library.ml       |  2 +-
 8 files changed, 67 insertions(+), 27 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 6f9faadb67fb..bc566934bef7 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2258,6 +2258,25 @@ let pp_global_interface fmt g =
   | Gopen _ -> ()
   | Gtype (ind, lar) -> pp_type_decl fmt ind lar
 
+type compiled_library_flag =
+  | Uses_accumulators
+
+let compiled_library_flag_to_string flag =
+  match flag with
+  | Uses_accumulators -> "flag_uses_accumulators"
+
+let pp_custom_flag fmt name value =
+  Format.fprintf fmt "(*%s:%b*) (* this comment is used internally and should not be moved or modified *)@\n" (compiled_library_flag_to_string name) value
+
+let get_custom_flag_value line name =
+  let prefix = Format.sprintf "(*%s:" (compiled_library_flag_to_string name) in
+  if String.starts_with ~prefix line then
+    let end_pos = String.index_from line 2 '*' in (* if this fail, someone tampered our comment and it's their fault *)
+    let start_pos = String.length prefix in
+    let value = String.sub line start_pos (end_pos-start_pos) in
+    Some (bool_of_string value)
+  else None
+
 (** Compilation of elements in environment **)
 let rec compile_with_fv consider_accs ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
   let const_prefix c = get_const_prefix env c in
@@ -2360,11 +2379,27 @@ let uses_accumulators_native_file = ref StringSet.empty
 let is_loaded_native_file s = StringSet.mem s !loaded_native_files
 let has_accus_native_file s = StringSet.mem s !uses_accumulators_native_file
 
-let register_native_file s =
-  loaded_native_files := StringSet.add s !loaded_native_files
-
-let indicate_native_file_has_accus s =
-  uses_accumulators_native_file := StringSet.add s !uses_accumulators_native_file
+let register_native_file libpath ~prefix =
+  let uses_accumulators  =
+    try
+      let lib_mli_path = (Filename.chop_extension libpath)^".mli" in
+      let lib_mli = open_in lib_mli_path in
+      let rec aux lib_mli =
+        let line =
+          try input_line lib_mli
+          with | End_of_file -> failwith ("impossible to find the "^(compiled_library_flag_to_string Uses_accumulators)^" flag in "^lib_mli_path)
+        in
+        match get_custom_flag_value line Uses_accumulators with
+        | None -> aux lib_mli
+        | Some v -> v in
+      let uses_accs = aux lib_mli in
+      close_in lib_mli;
+      uses_accs
+    with
+    | Sys_error _ -> true in (* TODOME: This should not happen but we'll let it slide for now *)
+  if uses_accumulators then
+    uses_accumulators_native_file := StringSet.add prefix !uses_accumulators_native_file;
+  loaded_native_files := StringSet.add prefix !loaded_native_files
 
 let is_code_loaded consider_accs name =
   match !name with
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index c7f9c8d2e264..e68ee25b765c 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -36,6 +36,13 @@ val global_to_mlf_name : global -> string option
 
 val pp_global_interface : Format.formatter -> global -> unit
 
+type compiled_library_flag =
+  | Uses_accumulators
+
+val pp_custom_flag : Format.formatter -> compiled_library_flag -> bool -> unit
+
+val get_custom_flag_value : string -> compiled_library_flag -> bool option
+
 val mk_open : string -> global
 
 val get_value : symbols -> int -> Nativevalues.t
@@ -61,8 +68,7 @@ type linkable_code = global list * symbols * code_location_updates
 
 val empty_updates : code_location_updates
 
-val register_native_file : string -> unit
-val indicate_native_file_has_accus : string -> unit
+val register_native_file : string -> prefix:string -> unit
 
 val is_loaded_native_file : string -> bool
 
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 183894b94045..2233be3ebde3 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -197,13 +197,13 @@ let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
   let ml_filename, prefix = Nativelib.get_mlf_filename () in
   let aux consider_accs =
     let code, symbols, upds = mk_conv_code consider_accs env sigma prefix t1 t2 in
-    let fn = Nativelib.compile ml_filename code ~profile:false in
+    let fn = Nativelib.compile consider_accs ml_filename code ~profile:false in
     if consider_accs then
       debug_native_compiler (fun () -> Pp.str "Running test with accumulators...")
     else
       debug_native_compiler (fun () -> Pp.str "Running test without accumulators...");
     let t0 = Sys.time () in
-    let (rt1, rt2) = Nativelib.execute_library consider_accs ~prefix fn symbols upds in
+    let (rt1, rt2) = Nativelib.execute_library ~prefix fn symbols upds in
     let rt1 = Option.get rt1 and rt2 = Option.get rt2 in
     let t1 = Sys.time () in
     let time_info = Format.sprintf "Evaluation done in %.5f@." (t1 -. t0) in
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index caa0f5465f9a..00e2b26be615 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -99,7 +99,7 @@ let get_mlf_filename () =
   delay_cleanup_file filename;
   filename, prefix
 
-let write_code fn ?(header=[]) code =
+let write_code consider_accs fn ?(header=[]) code =
   let header = open_header@header in
   let ch_out = open_out fn in
   let fmt = Format.formatter_of_out_channel ch_out in
@@ -111,6 +111,7 @@ let write_code fn ?(header=[]) code =
   close_out ch_out;
   let ch_mli_out = open_out ((Filename.chop_extension fn)^".mli") in
   let fmt = Format.formatter_of_out_channel ch_mli_out in
+  pp_custom_flag fmt Uses_accumulators consider_accs;
   Format.fprintf fmt "type t\n";
   List.iter (pp_global_interface fmt) code;
   close_out ch_mli_out
@@ -192,8 +193,8 @@ let call_compiler ?profile:(profile=false) mlf_filename =
     error_native_compiler_failed (Inr e) "During .cmxs generation"
   end
 
-let compile fn code ~profile:profile =
-  write_code fn code;
+let compile consider_accs fn code ~profile:profile =
+  write_code consider_accs fn code;
   let r = call_compiler ~profile fn in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
@@ -202,7 +203,7 @@ let compile fn code ~profile:profile =
 
 type native_library = Nativecode.global list * Nativevalues.symbols
 
-let compile_library (code, symb) fn =
+let compile_library consider_accs (code, symb) fn =
   let header = mk_library_header symb in
   let fn = fn ^ source_ext in
   let basename = Filename.basename fn in
@@ -213,20 +214,18 @@ let compile_library (code, symb) fn =
     with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
   in
   let fn = dirname / basename in
-  write_code fn ~header code;
+  write_code consider_accs fn ~header code;
   let _ = call_compiler fn in
   delay_cleanup_file fn
 
-let execute_library consider_accs ~prefix f symbols upds =
+let execute_library ~prefix f symbols upds =
   let () = rt1 := None in
   let () = rt2 := None in
   let () = rsymbols := symbols in
   if not (Sys.file_exists f) then
     CErrors.user_err Pp.(str "Cannot find native compiler file " ++ str f);
   if Dynlink.is_native then Dynlink.loadfile f else !load_obj f;
-  register_native_file prefix;
-  if consider_accs then indicate_native_file_has_accus prefix;
-  (* the file cannot be marked and then recompiled with another setting because we only mark it when using accumulators, which is already our fallback *)
+  register_native_file f ~prefix;
   update_locations upds;
   (!rt1, !rt2)
 
@@ -240,7 +239,7 @@ let link_library dirname prefix =
   let f = if Sys.file_exists build_location then build_location else install_location in
   try
     if Dynlink.is_native then Dynlink.loadfile f else !load_obj f;
-    register_native_file prefix
+    register_native_file f ~prefix
   with
   | Dynlink.Error _ as exn ->
       debug_native_compiler (fun () -> CErrors.iprint (Exninfo.capture exn))
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index 23029a49d56b..9ac742885b7e 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -27,19 +27,19 @@ val get_mlf_filename : unit -> string * string
 (** [compile file code ~profile] will compile native [code] to [file],
    and return the name of the object file; this name depends on
    whether are in byte mode or not; file is expected to be .ml file *)
-val compile : string -> Nativecode.global list -> profile:bool -> string
+val compile : bool -> string -> Nativecode.global list -> profile:bool -> string
 
 type native_library = Nativecode.global list * Nativevalues.symbols
 
 (** [compile_library (code, _) file] is similar to [compile file code]
    but will perform some extra tweaks to handle [code] as a Rocq lib. *)
-val compile_library : native_library -> string -> unit
+val compile_library : bool -> native_library -> string -> unit
 
 (** [execute_library file upds] dynamically loads library [file],
     updates the library locations [upds], and returns the values stored
     in [rt1] and [rt2] *)
 val execute_library :
-  bool -> prefix:string -> string -> Nativevalues.symbols -> Nativecode.code_location_updates ->
+  prefix:string -> string -> Nativevalues.symbols -> Nativecode.code_location_updates ->
   Nativevalues.t option * Nativevalues.t option
 
 (** [enable_library] marks the given library for dynamic loading
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index 2309af61a186..f90c65af0d04 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -510,13 +510,13 @@ let native_norm env sigma c ty =
     let time_info = Format.sprintf "native_compute: Conversion to native code done in %.5f" (tnc1 -. tnc0) in
     if print_timing then Feedback.msg_info (Pp.str time_info);
     let tc0 = Unix.gettimeofday () in
-    let fn = Nativelib.compile ml_filename code ~profile:profile in
+    let fn = Nativelib.compile consider_accs ml_filename code ~profile:profile in
     let tc1 = Unix.gettimeofday () in
     let time_info = Format.sprintf "native_compute: Compilation done in %.5f" (tc1 -. tc0) in
     if print_timing then Feedback.msg_info (Pp.str time_info);
     let profiler_pid = if profile then start_profiler () else None in
     let t0 = Unix.gettimeofday () in
-    let (rt1, _) = Nativelib.execute_library consider_accs ~prefix fn symbols upd in
+    let (rt1, _) = Nativelib.execute_library ~prefix fn symbols upd in
     let rt1 = Option.get rt1 in
     let t1 = Unix.gettimeofday () in
     if profile then stop_profiler profiler_pid;
diff --git a/topbin/rocqnative.ml b/topbin/rocqnative.ml
index b3e2d52734fa..abdf044e9b05 100644
--- a/topbin/rocqnative.ml
+++ b/topbin/rocqnative.ml
@@ -116,7 +116,7 @@ let register_loaded_library senv libname file =
   let () = assert (not @@ DirPath.Map.mem libname !libraries_table) in
   let () = libraries_table := DirPath.Map.add libname file !libraries_table in
   let prefix = Nativecode.mod_uid_of_dirpath libname ^ "." in
-  let () = Nativecode.register_native_file prefix in
+  let () = Nativecode.register_native_file (DirPath.to_string libname) ~prefix in
   senv
 
 let mk_library sd f md digests vm =
@@ -181,7 +181,7 @@ let save_library_to env dir f lib =
   let mp = MPfile dir in
   let ast = Nativelibrary.dump_library mp env lib in
   let fn = Filename.dirname f ^"/"^ Nativecode.mod_uid_of_dirpath dir in
-  Nativelib.compile_library ast fn
+  Nativelib.compile_library true ast fn (* we consider accumulators when compiling general-purpose libraries. TODOME: check which libraries create accumulators *)
 
 let get_used_load_paths () =
   String.Set.elements
diff --git a/vernac/library.ml b/vernac/library.ml
index b8184f98e3cb..b461866f5d90 100644
--- a/vernac/library.ml
+++ b/vernac/library.ml
@@ -549,7 +549,7 @@ let save_library_to todo_proofs ~output_native_objects dir f =
   (* Writing native code files *)
   if output_native_objects then
     let fn = Filename.dirname f ^"/"^ Nativecode.mod_uid_of_dirpath dir in
-    Nativelib.compile_library ast fn
+    Nativelib.compile_library true ast fn (* we consider accumulators when compiling general-purpose libraries TODOME: indicate which libraries generate accumulators *)
 
 let get_used_load_paths () =
   String.Set.elements

From 2c08084ebcd9b25c940fa361792a75c7ae15638e Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 24 Jun 2026 19:07:47 +0200
Subject: [PATCH 089/110] made a temporary fix to mli files being in the wrong
 location

---
 kernel/nativecode.ml | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index bc566934bef7..bc9521077ccf 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2379,10 +2379,20 @@ let uses_accumulators_native_file = ref StringSet.empty
 let is_loaded_native_file s = StringSet.mem s !loaded_native_files
 let has_accus_native_file s = StringSet.mem s !uses_accumulators_native_file
 
+let warn_no_interface_found =
+  CWarnings.create ~name:"native-no-interface-found"
+    (fun path -> Pp.(str "unable to find the mli interface: " ++ str path ++ str " when trying to find if it uses accumulators or not."))
+
 let register_native_file libpath ~prefix =
   let uses_accumulators  =
+    let lib_mli_path = Filename.chop_extension libpath in
+    let libdir, libfile = Filename.dirname lib_mli_path, Filename.basename lib_mli_path in
+    let libdir = if String.ends_with ~suffix:".coq-native" libdir then (* this is an awful fix to correct some library files being in a different place than their .mli interface *)
+      let libdir = String.sub libdir 0 (String.length libdir - String.length ".coq-native") in
+      Str.replace_first (Str.regexp_string "install/default/lib/coq/theories/") "default/theories/Corelib/" libdir
+      else libdir in
+    let lib_mli_path = Filename.concat libdir (libfile^".mli") in
     try
-      let lib_mli_path = (Filename.chop_extension libpath)^".mli" in
       let lib_mli = open_in lib_mli_path in
       let rec aux lib_mli =
         let line =
@@ -2396,7 +2406,7 @@ let register_native_file libpath ~prefix =
       close_in lib_mli;
       uses_accs
     with
-    | Sys_error _ -> true in (* TODOME: This should not happen but we'll let it slide for now *)
+    | Sys_error _ -> warn_no_interface_found lib_mli_path; false in
   if uses_accumulators then
     uses_accumulators_native_file := StringSet.add prefix !uses_accumulators_native_file;
   loaded_native_files := StringSet.add prefix !loaded_native_files

From df20cb1856a57ed101cb294f41d9daa8af3ffab0 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 25 Jun 2026 10:13:11 +0200
Subject: [PATCH 090/110] When a library does not support accumulators but we
 do, we recompile it instead of crashing

---
 kernel/nativecode.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index bc9521077ccf..4667802665a9 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2421,7 +2421,7 @@ let is_code_loaded consider_accs name =
       let has_accs = has_accus_native_file s in
       if not consider_accs && has_accs then raise NeedsAccumulators else
       if consider_accs && not has_accs then
-        failwith ("library "^s^" does not support accumulators but we need them, help!")
+        (name := NotLinked; false) (* we need to recompile the library code to support accumulators *)
       else
       true
     else (name := NotLinked; false)

From 60e294c5d2906fc8de8f5911db15c0658d1cc655 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 25 Jun 2026 15:19:43 +0200
Subject: [PATCH 091/110] Libraries now indicate if they do not generate
 accumulators, and this info is used to avoid unecessary accumulator use.

---
 kernel/nativecode.ml     |  2 ++
 kernel/nativecode.mli    |  1 +
 kernel/nativelib.ml      | 11 ++++++-----
 kernel/nativelib.mli     |  4 ++--
 kernel/nativelibrary.ml  | 26 +++++++++++++++-----------
 kernel/nativelibrary.mli |  2 +-
 kernel/safe_typing.ml    |  6 +++---
 topbin/rocqnative.ml     |  4 ++--
 vernac/library.ml        |  4 ++--
 9 files changed, 34 insertions(+), 26 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 4667802665a9..d9edb6751978 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2260,10 +2260,12 @@ let pp_global_interface fmt g =
 
 type compiled_library_flag =
   | Uses_accumulators
+  | Generates_accumulators
 
 let compiled_library_flag_to_string flag =
   match flag with
   | Uses_accumulators -> "flag_uses_accumulators"
+  | Generates_accumulators -> "flag_generates_accumulators"
 
 let pp_custom_flag fmt name value =
   Format.fprintf fmt "(*%s:%b*) (* this comment is used internally and should not be moved or modified *)@\n" (compiled_library_flag_to_string name) value
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index e68ee25b765c..025ae98e3bfb 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -38,6 +38,7 @@ val pp_global_interface : Format.formatter -> global -> unit
 
 type compiled_library_flag =
   | Uses_accumulators
+  | Generates_accumulators
 
 val pp_custom_flag : Format.formatter -> compiled_library_flag -> bool -> unit
 
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 00e2b26be615..9f89f03c7609 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -99,7 +99,7 @@ let get_mlf_filename () =
   delay_cleanup_file filename;
   filename, prefix
 
-let write_code consider_accs fn ?(header=[]) code =
+let write_code (consider_accs, generates_accs) fn ?(header=[]) code =
   let header = open_header@header in
   let ch_out = open_out fn in
   let fmt = Format.formatter_of_out_channel ch_out in
@@ -112,6 +112,7 @@ let write_code consider_accs fn ?(header=[]) code =
   let ch_mli_out = open_out ((Filename.chop_extension fn)^".mli") in
   let fmt = Format.formatter_of_out_channel ch_mli_out in
   pp_custom_flag fmt Uses_accumulators consider_accs;
+  pp_custom_flag fmt Generates_accumulators generates_accs;
   Format.fprintf fmt "type t\n";
   List.iter (pp_global_interface fmt) code;
   close_out ch_mli_out
@@ -194,16 +195,16 @@ let call_compiler ?profile:(profile=false) mlf_filename =
   end
 
 let compile consider_accs fn code ~profile:profile =
-  write_code consider_accs fn code;
+  write_code (consider_accs, consider_accs) fn code; (* we consider as a simplification that if we need accumulators, it is probably because we generate some. TODOME: make more accurate assumptions *)
   let r = call_compiler ~profile fn in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
   delay_cleanup_file fn;
   r
 
-type native_library = Nativecode.global list * Nativevalues.symbols
+type native_library = Nativecode.global list * Nativevalues.symbols * bool
 
-let compile_library consider_accs (code, symb) fn =
+let compile_library (code, symb, generates_accs) fn =
   let header = mk_library_header symb in
   let fn = fn ^ source_ext in
   let basename = Filename.basename fn in
@@ -214,7 +215,7 @@ let compile_library consider_accs (code, symb) fn =
     with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
   in
   let fn = dirname / basename in
-  write_code consider_accs fn ~header code;
+  write_code (true, generates_accs) fn ~header code; (* we always consider accumulators but we indicate if we generate some ourselves or not *)
   let _ = call_compiler fn in
   delay_cleanup_file fn
 
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index 9ac742885b7e..b87e4c103f3c 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -29,11 +29,11 @@ val get_mlf_filename : unit -> string * string
    whether are in byte mode or not; file is expected to be .ml file *)
 val compile : bool -> string -> Nativecode.global list -> profile:bool -> string
 
-type native_library = Nativecode.global list * Nativevalues.symbols
+type native_library = Nativecode.global list * Nativevalues.symbols * bool (* the bool is true if the library generates accumulators *)
 
 (** [compile_library (code, _) file] is similar to [compile file code]
    but will perform some extra tweaks to handle [code] as a Rocq lib. *)
-val compile_library : bool -> native_library -> string -> unit
+val compile_library : native_library -> string -> unit
 
 (** [execute_library file upds] dynamically loads library [file],
     updates the library locations [upds], and returns the values stored
diff --git a/kernel/nativelibrary.ml b/kernel/nativelibrary.ml
index a795e9e538cd..f0c83b61b842 100644
--- a/kernel/nativelibrary.ml
+++ b/kernel/nativelibrary.ml
@@ -17,34 +17,34 @@ open Nativecode
 (** This file implements separate compilation for libraries in the native
 compiler *)
 
-let rec translate_mod mp cenv env mod_expr acc =
+let rec translate_mod consider_accs mp cenv env mod_expr acc =
   match mod_expr with
   | NoFunctor struc ->
-    List.fold_left (translate_field mp cenv env) acc struc
+    List.fold_left (translate_field consider_accs mp cenv env) acc struc
   | MoreFunctor _ -> acc
 
 (* XXX I believe it makes no sense to extract module types *)
-and translate_modtype mp cenv env mod_expr reso acc =
+and translate_modtype consider_accs mp cenv env mod_expr reso acc =
   match mod_expr with
   | NoFunctor struc ->
     let env' = add_structure mp struc reso env in
-    List.fold_left (translate_field mp cenv env') acc struc
+    List.fold_left (translate_field consider_accs mp cenv env') acc struc
   | MoreFunctor _ -> acc
 
-and translate_field mp cenv env acc (l,x) =
+and translate_field consider_accs mp cenv env acc (l,x) =
   match x with
   | SFBconst cb ->
      let con = Constant.make2 mp l in
      (debug_native_compiler (fun () ->
         let msg = Printf.sprintf "Compiling constant %s..." (Constant.to_string con) in
         Pp.str msg));
-     compile_constant_field true cenv env con acc cb (* we consider accumulators when compiling general-purpose libraries *)
+     compile_constant_field consider_accs cenv env con acc cb (* we consider accumulators when compiling general-purpose libraries *)
   | SFBmind mb ->
      (debug_native_compiler (fun () ->
         let id = mb.mind_packets.(0).mind_typename in
         let msg = Printf.sprintf "Compiling inductive %s..." (Id.to_string id) in
         Pp.str msg));
-     compile_mind_field true cenv mp l acc mb
+     compile_mind_field consider_accs cenv mp l acc mb
   | SFBrules rrb ->
      (debug_native_compiler (fun () ->
         let msg = Printf.sprintf "Not Compiling rules %s..." (Id.to_string l) in
@@ -57,7 +57,7 @@ and translate_field mp cenv env acc (l,x) =
           Printf.sprintf "Compiling module %s..." (ModPath.to_string mp)
         in
         Pp.str msg));
-     translate_mod mp cenv env (mod_type md) acc
+     translate_mod consider_accs mp cenv env (mod_type md) acc
   | SFBmodtype mdtyp ->
      let mp = MPdot (mp, l) in
      (debug_native_compiler (fun () ->
@@ -65,7 +65,7 @@ and translate_field mp cenv env acc (l,x) =
           Printf.sprintf "Compiling module type %s..." (ModPath.to_string mp)
         in
         Pp.str msg));
-     translate_modtype mp cenv env (mod_type mdtyp) (mod_delta mdtyp) acc
+     translate_modtype consider_accs mp cenv env (mod_type mdtyp) (mod_delta mdtyp) acc
 
 (* This function expects the contents of the module to be part of [env] already *)
 let dump_library mp env mod_expr =
@@ -74,12 +74,16 @@ let dump_library mp env mod_expr =
   | NoFunctor struc ->
       let t0 = Sys.time () in
       let cenv = Nativecode.make_cenv () in
+      let generates_accs =
+         try (* we compile with accumulators anyway, but if the code does not generate any we mark it compatible with accumulator-less programs *)
+            let _ = List.fold_left (translate_field false mp cenv env) [] struc in false
+         with NeedsAccumulators -> true in
       let mlcode =
-        List.fold_left (translate_field mp cenv env) [] struc
+        List.fold_left (translate_field true mp cenv env) [] struc
       in
       let t1 = Sys.time () in
       let time_info = Format.sprintf "Time spent generating this code: %.5fs" (t1-.t0) in
       let mlcode = add_header_comment (List.rev mlcode) time_info in
       let symbols = Nativecode.get_cenv_symbols cenv in
-      mlcode, symbols
+      mlcode, symbols, generates_accs
   | _ -> assert false
diff --git a/kernel/nativelibrary.mli b/kernel/nativelibrary.mli
index fda84f0b7f4d..525a00f687fd 100644
--- a/kernel/nativelibrary.mli
+++ b/kernel/nativelibrary.mli
@@ -17,4 +17,4 @@ open Nativecode
 compiler *)
 
 val dump_library : ModPath.t -> env -> module_signature ->
-  global list * Nativevalues.symbols
+  (global list * Nativevalues.symbols * bool)
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index dbcbecf77cf5..8f4414907c56 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -1646,10 +1646,10 @@ let export ~output_native_objects senv dir =
   let mp = senv.modpath in
   let str = NoFunctor (List.rev senv.revstruct) in
   let mb = Mod_declarations.make_module_body str senv.modresolver in
-  let ast, symbols =
+  let nativelib =
     if output_native_objects then
       Nativelibrary.dump_library mp senv.env str
-    else [], Nativevalues.empty_symbols
+    else [], Nativevalues.empty_symbols, false
   in
   let permanent_flags = {
     rewrite_rules_allowed = Environ.rewrite_rules_allowed senv.env;
@@ -1668,7 +1668,7 @@ let export ~output_native_objects senv dir =
     comp_retro = senv.local_retroknowledge;
   } in
   let vmlib = Vmlibrary.export @@ Environ.vm_library senv.env in
-  mp, lib, vmlib, (ast, symbols)
+  mp, lib, vmlib, nativelib
 
 let import lib vmtab vodigest senv =
   let senv = check_flags_for_library lib senv in
diff --git a/topbin/rocqnative.ml b/topbin/rocqnative.ml
index abdf044e9b05..4d6317435e05 100644
--- a/topbin/rocqnative.ml
+++ b/topbin/rocqnative.ml
@@ -179,9 +179,9 @@ let register_library senv m =
 
 let save_library_to env dir f lib =
   let mp = MPfile dir in
-  let ast = Nativelibrary.dump_library mp env lib in
+  let lib = Nativelibrary.dump_library mp env lib in
   let fn = Filename.dirname f ^"/"^ Nativecode.mod_uid_of_dirpath dir in
-  Nativelib.compile_library true ast fn (* we consider accumulators when compiling general-purpose libraries. TODOME: check which libraries create accumulators *)
+  Nativelib.compile_library lib fn
 
 let get_used_load_paths () =
   String.Set.elements
diff --git a/vernac/library.ml b/vernac/library.ml
index b461866f5d90..99f34cdc1999 100644
--- a/vernac/library.ml
+++ b/vernac/library.ml
@@ -543,13 +543,13 @@ let save_library_to todo_proofs ~output_native_objects dir f =
   let () = assert (not (Future.UUIDSet.is_empty except) ||
     Safe_typing.is_joined_environment (Global.safe_env ()))
   in
-  let sd, md, vmlib, ast = save_library_struct ~output_native_objects dir in
+  let sd, md, vmlib, nativelib = save_library_struct ~output_native_objects dir in
   (* Writing vo payload *)
   save_library_base f sd md opaque_table vmlib;
   (* Writing native code files *)
   if output_native_objects then
     let fn = Filename.dirname f ^"/"^ Nativecode.mod_uid_of_dirpath dir in
-    Nativelib.compile_library true ast fn (* we consider accumulators when compiling general-purpose libraries TODOME: indicate which libraries generate accumulators *)
+    Nativelib.compile_library nativelib fn
 
 let get_used_load_paths () =
   String.Set.elements

From 1c40dbc5ff546feb40ef7ff4c675cd33e41d4e96 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 25 Jun 2026 15:56:19 +0200
Subject: [PATCH 092/110] custom flags are now stored in the compiled interface
 and are retrieved using ocaml-print-intf.

---
 clib/cUnix.ml           |  4 +-
 clib/cUnix.mli          |  2 +-
 kernel/nativecode.ml    | 95 ++++++++++++++++++++---------------------
 kernel/nativecode.mli   |  4 +-
 kernel/nativelib.ml     |  2 +-
 kernel/nativelibrary.ml |  3 +-
 6 files changed, 55 insertions(+), 55 deletions(-)

diff --git a/clib/cUnix.ml b/clib/cUnix.ml
index c681047c1d83..03c4e04dfda3 100644
--- a/clib/cUnix.ml
+++ b/clib/cUnix.ml
@@ -113,9 +113,9 @@ let run_command ?(hook=(fun _ ->())) c =
     (against whitespace or other funny chars in paths), hence no need
     to care about the different quoting conventions of /bin/sh and cmd.exe. *)
 
-let sys_command prog args =
+let sys_command ?(out_file_descr=Unix.stdout) prog args =
   let argv = Array.of_list (prog::args) in
-  let pid = Unix.create_process prog argv Unix.stdin Unix.stdout Unix.stderr in
+  let pid = Unix.create_process prog argv Unix.stdin out_file_descr Unix.stderr in
   waitpid_non_intr pid
 
 (*
diff --git a/clib/cUnix.mli b/clib/cUnix.mli
index d49565769081..37fd5f3f7ece 100644
--- a/clib/cUnix.mli
+++ b/clib/cUnix.mli
@@ -56,7 +56,7 @@ val run_command :
     (against whitespace or other funny chars in paths), hence no need
     to care about the different quoting conventions of /bin/sh and cmd.exe. *)
 
-val sys_command : string -> string list -> Unix.process_status
+val sys_command : ?out_file_descr:(Unix.file_descr) -> string -> string list -> Unix.process_status
 
 (** A version of [Unix.waitpid] immune to EINTR exceptions *)
 
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index d9edb6751978..a8d47fcd9b6c 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2259,25 +2259,42 @@ let pp_global_interface fmt g =
   | Gtype (ind, lar) -> pp_type_decl fmt ind lar
 
 type compiled_library_flag =
-  | Uses_accumulators
+  | Supports_accumulators
   | Generates_accumulators
 
 let compiled_library_flag_to_string flag =
   match flag with
-  | Uses_accumulators -> "flag_uses_accumulators"
+  | Supports_accumulators -> "flag_supports_accumulators"
   | Generates_accumulators -> "flag_generates_accumulators"
 
 let pp_custom_flag fmt name value =
-  Format.fprintf fmt "(*%s:%b*) (* this comment is used internally and should not be moved or modified *)@\n" (compiled_library_flag_to_string name) value
-
-let get_custom_flag_value line name =
-  let prefix = Format.sprintf "(*%s:" (compiled_library_flag_to_string name) in
-  if String.starts_with ~prefix line then
-    let end_pos = String.index_from line 2 '*' in (* if this fail, someone tampered our comment and it's their fault *)
-    let start_pos = String.length prefix in
-    let value = String.sub line start_pos (end_pos-start_pos) in
-    Some (bool_of_string value)
-  else None
+  Format.fprintf fmt "type %s'%b@\n" (compiled_library_flag_to_string name) value (* we write custom flags as abstract types so that they will appear in the compile interface *)
+
+let get_custom_flag_value cmi_file_path flag =
+  let piperead, pipewrite = Unix.pipe () in
+  let _ = let res = CUnix.sys_command ~out_file_descr:pipewrite "ocaml-print-intf" [cmi_file_path] in
+    match res with
+    | Unix.WEXITED 0 -> ()
+    | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n -> assert false
+  in
+  let piperead = Unix.in_channel_of_descr piperead in
+  let search_line line =
+    let prefix = Format.sprintf "type %s'" (compiled_library_flag_to_string flag) in
+    if String.starts_with ~prefix line then
+      let end_pos = String.length line in
+      let start_pos = String.length prefix in
+      let value = String.sub line start_pos (end_pos-start_pos) in
+      Some (bool_of_string value)
+    else None in
+  let rec aux () =
+    let line =
+      try input_line piperead
+      with | End_of_file -> failwith ("impossible to find the "^(compiled_library_flag_to_string flag)^" flag in "^cmi_file_path)
+    in
+    match search_line line with
+    | None -> aux ()
+    | Some v -> v
+  in aux ()
 
 (** Compilation of elements in environment **)
 let rec compile_with_fv consider_accs ?(wrap = fun t -> t) cenv env sigma univ auxdefs l t =
@@ -2376,41 +2393,23 @@ module StringOrd = struct type t = string let compare = String.compare end
 module StringSet = Set.Make(StringOrd)
 
 let loaded_native_files = ref StringSet.empty
-let uses_accumulators_native_file = ref StringSet.empty
+let supports_accus_native_file = ref StringSet.empty
+let generate_accus_native_file = ref StringSet.empty
 
 let is_loaded_native_file s = StringSet.mem s !loaded_native_files
-let has_accus_native_file s = StringSet.mem s !uses_accumulators_native_file
-
-let warn_no_interface_found =
-  CWarnings.create ~name:"native-no-interface-found"
-    (fun path -> Pp.(str "unable to find the mli interface: " ++ str path ++ str " when trying to find if it uses accumulators or not."))
+let does_supports_accus_native_file s = StringSet.mem s !supports_accus_native_file
+let does_generate_accus_native_file s = StringSet.mem s !generate_accus_native_file
 
 let register_native_file libpath ~prefix =
-  let uses_accumulators  =
-    let lib_mli_path = Filename.chop_extension libpath in
-    let libdir, libfile = Filename.dirname lib_mli_path, Filename.basename lib_mli_path in
-    let libdir = if String.ends_with ~suffix:".coq-native" libdir then (* this is an awful fix to correct some library files being in a different place than their .mli interface *)
-      let libdir = String.sub libdir 0 (String.length libdir - String.length ".coq-native") in
-      Str.replace_first (Str.regexp_string "install/default/lib/coq/theories/") "default/theories/Corelib/" libdir
-      else libdir in
-    let lib_mli_path = Filename.concat libdir (libfile^".mli") in
-    try
-      let lib_mli = open_in lib_mli_path in
-      let rec aux lib_mli =
-        let line =
-          try input_line lib_mli
-          with | End_of_file -> failwith ("impossible to find the "^(compiled_library_flag_to_string Uses_accumulators)^" flag in "^lib_mli_path)
-        in
-        match get_custom_flag_value line Uses_accumulators with
-        | None -> aux lib_mli
-        | Some v -> v in
-      let uses_accs = aux lib_mli in
-      close_in lib_mli;
-      uses_accs
-    with
-    | Sys_error _ -> warn_no_interface_found lib_mli_path; false in
-  if uses_accumulators then
-    uses_accumulators_native_file := StringSet.add prefix !uses_accumulators_native_file;
+  let supports_accs, gen_accs =
+    let libpath = Filename.remove_extension libpath in
+    let lib_cmi_path = libpath^".cmi" in
+    (get_custom_flag_value lib_cmi_path Supports_accumulators),
+    (get_custom_flag_value lib_cmi_path Generates_accumulators) in
+  if supports_accs then
+    supports_accus_native_file := StringSet.add prefix !supports_accus_native_file;
+  if gen_accs then
+    generate_accus_native_file := StringSet.add prefix !generate_accus_native_file;
   loaded_native_files := StringSet.add prefix !loaded_native_files
 
 let is_code_loaded consider_accs name =
@@ -2420,12 +2419,12 @@ let is_code_loaded consider_accs name =
     if is_loaded_native_file s then
       (* the dependency needs accumulators to work, so we need them too.
       We could also try to recompile them and hope that their accumulators were needed due to a parent file needing them, but this is costly and unlikely *)
-      let has_accs = has_accus_native_file s in
-      if not consider_accs && has_accs then raise NeedsAccumulators else
-      if consider_accs && not has_accs then
+      let supp_accs = does_supports_accus_native_file s in
+      let gen_accs = does_generate_accus_native_file s in
+      if not consider_accs && gen_accs then raise NeedsAccumulators else
+      if consider_accs && not supp_accs then
         (name := NotLinked; false) (* we need to recompile the library code to support accumulators *)
-      else
-      true
+      else true
     else (name := NotLinked; false)
 
 let compile_mind consider_accs cenv mb mind stack =
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index 025ae98e3bfb..0dc06facceb2 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -37,12 +37,12 @@ val global_to_mlf_name : global -> string option
 val pp_global_interface : Format.formatter -> global -> unit
 
 type compiled_library_flag =
-  | Uses_accumulators
+  | Supports_accumulators
   | Generates_accumulators
 
 val pp_custom_flag : Format.formatter -> compiled_library_flag -> bool -> unit
 
-val get_custom_flag_value : string -> compiled_library_flag -> bool option
+val get_custom_flag_value : string -> compiled_library_flag -> bool
 
 val mk_open : string -> global
 
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 9f89f03c7609..98b5bcac0264 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -111,7 +111,7 @@ let write_code (consider_accs, generates_accs) fn ?(header=[]) code =
   close_out ch_out;
   let ch_mli_out = open_out ((Filename.chop_extension fn)^".mli") in
   let fmt = Format.formatter_of_out_channel ch_mli_out in
-  pp_custom_flag fmt Uses_accumulators consider_accs;
+  pp_custom_flag fmt Supports_accumulators consider_accs;
   pp_custom_flag fmt Generates_accumulators generates_accs;
   Format.fprintf fmt "type t\n";
   List.iter (pp_global_interface fmt) code;
diff --git a/kernel/nativelibrary.ml b/kernel/nativelibrary.ml
index f0c83b61b842..6017f2c25108 100644
--- a/kernel/nativelibrary.ml
+++ b/kernel/nativelibrary.ml
@@ -73,11 +73,12 @@ let dump_library mp env mod_expr =
   match mod_expr with
   | NoFunctor struc ->
       let t0 = Sys.time () in
-      let cenv = Nativecode.make_cenv () in
       let generates_accs =
          try (* we compile with accumulators anyway, but if the code does not generate any we mark it compatible with accumulator-less programs *)
+            let cenv = Nativecode.make_cenv () in (* we need to create a temporary cenv as it is a mutable data structure *)
             let _ = List.fold_left (translate_field false mp cenv env) [] struc in false
          with NeedsAccumulators -> true in
+      let cenv = Nativecode.make_cenv () in
       let mlcode =
         List.fold_left (translate_field true mp cenv env) [] struc
       in

From 5f46da5a89703fdf499d5198f3febf3820483744 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 25 Jun 2026 18:50:20 +0200
Subject: [PATCH 093/110] fixed library file being wrong when registering
 native libraries

---
 kernel/nativecode.ml | 2 +-
 topbin/rocqnative.ml | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index a8d47fcd9b6c..a4dfa3836c21 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2268,7 +2268,7 @@ let compiled_library_flag_to_string flag =
   | Generates_accumulators -> "flag_generates_accumulators"
 
 let pp_custom_flag fmt name value =
-  Format.fprintf fmt "type %s'%b@\n" (compiled_library_flag_to_string name) value (* we write custom flags as abstract types so that they will appear in the compile interface *)
+  Format.fprintf fmt "type %s'%b@\n" (compiled_library_flag_to_string name) value (* we write custom flags as abstract types so that they will appear in the compiled interface *)
 
 let get_custom_flag_value cmi_file_path flag =
   let piperead, pipewrite = Unix.pipe () in
diff --git a/topbin/rocqnative.ml b/topbin/rocqnative.ml
index 4d6317435e05..911efee537eb 100644
--- a/topbin/rocqnative.ml
+++ b/topbin/rocqnative.ml
@@ -116,7 +116,8 @@ let register_loaded_library senv libname file =
   let () = assert (not @@ DirPath.Map.mem libname !libraries_table) in
   let () = libraries_table := DirPath.Map.add libname file !libraries_table in
   let prefix = Nativecode.mod_uid_of_dirpath libname ^ "." in
-  let () = Nativecode.register_native_file (DirPath.to_string libname) ~prefix in
+  let fn = (Filename.dirname file) ^"/.coq-native/"^ Nativecode.mod_uid_of_dirpath libname in (* TODOME: this is a bit ugly and could maybe be cleaned ? *)
+  let () = Nativecode.register_native_file fn ~prefix in
   senv
 
 let mk_library sd f md digests vm =

From 7294f1552f74e84f12f0d7aea4ffa41fec2d769a Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 26 Jun 2026 11:10:44 +0200
Subject: [PATCH 094/110] removed global type declaration as they are no longer
 needed

---
 kernel/nativecode.ml | 62 +++-----------------------------------------
 1 file changed, 3 insertions(+), 59 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index a4dfa3836c21..dc868cc39a29 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -773,8 +773,6 @@ type global =
   | Gletcase_noaccu of
       gname * lname array * mllambda * mllam_branches
   | Gopen of string
-  | Gtype of inductive * (tag * int) array
-    (* ind name, tag and arities of constructors *)
   | Gcomment of string
 
 (* Alpha-equivalence on globals *)
@@ -799,9 +797,6 @@ let eq_global g1 g2 =
       let t2 = MLmatch (c2,accu2,br2) in
       eq_mllambda gn1 gn2 (Array.length lns1) env1 env2 t1 t2
   | Gopen s1, Gopen s2 -> String.equal s1 s2
-  | Gtype (ind1, arr1), Gtype (ind2, arr2) ->
-    Ind.UserOrd.equal ind1 ind2 &&
-    Array.equal (fun (tag1,ar1) (tag2,ar2) -> Int.equal tag1 tag2 && Int.equal ar1 ar2) arr1 arr2
   | Gcomment s1, Gcomment s2 -> String.equal s1 s2
   | _, _ -> false
 
@@ -836,13 +831,8 @@ let hash_global g =
       let nlns = Array.length lns in
       let env = push_lnames 0 LNmap.empty lns in
       let t = MLmatch_noaccu (c,br) in
-      combinesmall 5 (combine nlns (hash_mllambda gn nlns env t))
-  | Gopen s -> combinesmall 5 (String.hash s)
-  | Gtype (ind, arr) ->
-    let hash_aux acc (tag,ar) =
-      combine3 acc (Int.hash tag) (Int.hash ar)
-    in
-    combinesmall 7 (combine (Ind.UserOrd.hash ind) (Array.fold_left hash_aux 0 arr))
+      combinesmall 6 (combine nlns (hash_mllambda gn nlns env t))
+  | Gopen s -> combinesmall 7 (String.hash s)
   | Gcomment s -> combinesmall 8 (String.hash s)
 
 module HashedTypeGlobal = struct
@@ -1903,7 +1893,6 @@ let string_of_kn kn =
 
 let string_of_con c = string_of_kn (Constant.user c)
 let string_of_mind mind = string_of_kn (MutInd.user mind)
-let string_of_ind (mind,i) = string_of_kn (MutInd.user mind) ^ "_" ^ string_of_int i
 
 let string_of_gname g =
   let ret = match g with
@@ -1947,13 +1936,6 @@ let pp_ldecls fmt ids =
     Format.fprintf fmt " %a" pp_lname ids.(i)
   done
 
-let string_of_construct prefix ~constant ind tag =
-  let base = if constant then "Int" else "Construct" in
-  Format.sprintf "%s%s_%s_%i" prefix base (string_of_ind ind) tag
-
-let string_of_accu_construct prefix ind =
-  Format.sprintf "%sAccu_%s" prefix (string_of_ind ind)
-
 let pp_mllam fmt l =
 
   let rec pp_mllam fmt l =
@@ -2143,45 +2125,10 @@ let pp_cofix fmt (gn, s) =
   in let s = Array.map (subst_gname gn (MLprimitive(Force, [|MLglobal gn|])) ) s in
   Format.fprintf fmt "@[(let (rec (%a (lazy %a))) (force %a))@]" pp_gname gn pp_array s pp_gname gn
 
-let pp_type_decl fmt ind lar =
-  let rec aux s arity =
-    if Int.equal arity 0 then s else aux (s^" * t") (arity-1) in
-  let pp_const_sig fmt (tag,arity) =
-    if arity > 0 then
-      let sig_str = aux "of t" (arity-1) in
-      let cstr = string_of_construct "" ~constant:false ind tag in
-      Format.fprintf fmt "  | %s %s@\n" cstr sig_str
-    else
-      let cstr = string_of_construct "" ~constant:true ind tag in
-      Format.fprintf fmt "  | %s@\n" cstr
-  in
-  let pp_const_sigs fmt lar =
-    Format.fprintf fmt "  | %s of t@\n" (string_of_accu_construct "" ind);
-    Array.iter (pp_const_sig fmt) lar
-  in
-  Format.fprintf fmt "@[type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
-
 let pp_global fmt g =
   match g with
   | Glet (gn, c) ->
       Format.fprintf fmt "@[( %a  %a )@]@\n@." pp_gname gn pp_mllam c
-  | Gtype (ind, lar) -> (* types are not needed in malfunction, we will leave them as comments *)
-    let rec aux s arity =
-      if Int.equal arity 0 then s else aux (s^" * Nativevalues.t") (arity-1) in
-    let pp_const_sig fmt (tag,arity) =
-      if arity > 0 then
-        let sig_str = aux "of Nativevalues.t" (arity-1) in
-        let cstr = string_of_construct "" ~constant:false ind tag in
-        Format.fprintf fmt ";  | %s %s@\n" cstr sig_str
-      else
-        let cstr = string_of_construct "" ~constant:true ind tag in
-        Format.fprintf fmt ";  | %s@\n" cstr
-    in
-    let pp_const_sigs fmt lar =
-      Format.fprintf fmt ";  | %s of Nativevalues.t@\n" (string_of_accu_construct "" ind);
-      Array.iter (pp_const_sig fmt) lar
-    in
-    Format.fprintf fmt "@[;type ind_%s =@\n%a@]@\n@." (string_of_ind ind) pp_const_sigs lar
   | Gopen _ ->
       () (* open do not exist in malfunction, and there is no interest in leaving them as comments *)
   | Gletcase(gn,[||],a,accu,bs) -> (* simple biding and not a function *)
@@ -2236,7 +2183,6 @@ let global_to_mlf_name g =
   | Glet (gn,_) ->
     let gn = string_of_gname gn in
     if gn = "_" || gn = "" then None else Some gn
-  | Gtype _
   | Gcomment _
   | Gopen _ -> None
 
@@ -2256,7 +2202,6 @@ let pp_global_interface fmt g =
     end
   | Gcomment _
   | Gopen _ -> ()
-  | Gtype (ind, lar) -> pp_type_decl fmt ind lar
 
 type compiled_library_flag =
   | Supports_accumulators
@@ -2432,7 +2377,6 @@ let compile_mind consider_accs cenv mb mind stack =
   (** Generate data for every block *)
   let f i stack ob =
     let ind = (mind, i) in
-    let gtype = Gtype(ind, ob.mind_reloc_tbl) in
     let j = push_symbol cenv (SymbInd ind) in
     let name = Gind ("", ind) in
     let accu =
@@ -2484,7 +2428,7 @@ let compile_mind consider_accs cenv mb mind stack =
     | PrimRecord { tys ; _ } ->
       Array.fold_left_i add_proj [] tys
     in
-    projs @ gtype :: accu :: stack
+    projs @ accu :: stack
   in
   Array.fold_left_i f stack mb.mind_packets
 

From f5ab538f419178a7e8bbad4d4afca45699361f45 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 26 Jun 2026 11:30:55 +0200
Subject: [PATCH 095/110] Removed prefix and inductive name from MLconstruct as
 they are no longer needed, and removed the useless import of Constructs

---
 kernel/nativecode.ml | 35 +++++++++++++++--------------------
 1 file changed, 15 insertions(+), 20 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index dc868cc39a29..11f09f7893fe 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -452,8 +452,8 @@ type mllambda =
                               (* argument, accu branch, branches *)
   | MLmatch_noaccu        of mllambda * mllam_branches
                               (* argument, branches *)
-  | MLconstruct    of string * inductive * int * mllambda array
-                   (* prefix, inductive name, tag, arguments *)
+  | MLconstruct    of int * mllambda array
+                   (* tag, arguments *)
   | MLint          of int
   | MLuint         of Uint63.t
   | MLfloat        of Float64.t
@@ -524,9 +524,7 @@ let rec eq_mllambda gn1 gn2 n env1 env2 t1 t2 =
   | MLmatch_noaccu (c1, br1), MLmatch_noaccu (c2, br2) ->
       eq_mllambda gn1 gn2 n env1 env2 c1 c2 &&
       eq_mllam_branches gn1 gn2 n env1 env2 br1 br2
-  | MLconstruct (pf1, ind1, tag1, args1), MLconstruct (pf2, ind2, tag2, args2) ->
-      String.equal pf1 pf2 &&
-      Ind.UserOrd.equal ind1 ind2 &&
+  | MLconstruct (tag1, args1), MLconstruct (tag2, args2) ->
       Int.equal tag1 tag2 &&
       Array.equal (eq_mllambda gn1 gn2 n env1 env2) args1 args2
   | MLint i1, MLint i2 ->
@@ -620,11 +618,9 @@ let rec hash_mllambda gn n env t =
   | MLmatch_noaccu (c, br) ->
       let hc = hash_mllambda gn n env c in
       combinesmall 10 (hash_mllam_branches gn n env hc br)
-  | MLconstruct (pf, ind, tag, args) ->
-      let hpf = String.hash pf in
-      let hcs = Ind.UserOrd.hash ind in
+  | MLconstruct (tag, args) ->
       let htag = Int.hash tag in
-      combinesmall 11 (hash_mllambda_array gn n env (combine3 hpf hcs htag) args)
+      combinesmall 11 (hash_mllambda_array gn n env htag args)
   | MLint i ->
       combinesmall 12 i
   | MLuint i ->
@@ -730,7 +726,7 @@ let fv_lam l =
         aux body bind fv in
       Array.fold_right fv_bs bs fv
     (* argument, accu branch, branches *)
-    | MLconstruct (_,_,_,p) ->
+    | MLconstruct (_,p) ->
         Array.fold_right (fun a fv -> aux a bind fv) p fv
     | MLsetref(_,l) -> aux l bind fv
     | MLsequence(l1,l2) -> aux l1 bind (aux l2 bind fv)
@@ -1625,10 +1621,9 @@ let rec ml_of_lam consider_accs env l t =
 
   | Lint tag -> MLint tag
 
-  | Lmakeblock (cn,tag,args) ->
-     let prefix = env.env_mind_prefix (fst cn) in
+  | Lmakeblock (_,tag,args) ->
      let args = Array.map (ml_of_lam consider_accs env l) args in
-     MLconstruct(prefix,cn,tag,args)
+     MLconstruct(tag,args)
   | Luint i -> MLprimitive (Mk_uint, [|MLuint i|])
   | Lfloat f -> MLprimitive (Mk_float, [|MLfloat f|])
   | Lstring s -> MLprimitive (Mk_string, [|MLstring s|])
@@ -1694,7 +1689,7 @@ let subst s l =
       | MLmatch_noaccu(a,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
           MLmatch_noaccu(a, Array.map auxb bs)
-      | MLconstruct(prefix,c,tag,args) -> MLconstruct(prefix,c,tag,Array.map aux args)
+      | MLconstruct(tag,args) -> MLconstruct(tag,Array.map aux args)
       | MLsetref(s,l1) -> MLsetref(s,aux l1)
       | MLsequence(l1,l2) -> MLsequence(aux l1, aux l2)
       | MLarray arr -> MLarray (Array.map aux arr)
@@ -1820,8 +1815,8 @@ let optimize  gdef l =
     | MLmatch_noaccu(a,bs) ->
         let opt_b (cargs,body) = (cargs,optimize s body) in
         MLmatch_noaccu(optimize s a, Array.map opt_b bs)
-    | MLconstruct(prefix,c,tag,args) ->
-        MLconstruct(prefix,c,tag,Array.map (optimize s) args)
+    | MLconstruct(tag,args) ->
+        MLconstruct(tag,Array.map (optimize s) args)
     | MLsetref(r,l) -> MLsetref(r, optimize s l)
     | MLsequence(l1,l2) -> MLsequence(optimize s l1, optimize s l2)
     | MLarray arr -> MLarray (Array.map (optimize s) arr)
@@ -1995,10 +1990,10 @@ let pp_mllam fmt l =
       Format.fprintf fmt
         "@[(let ($matched_value %a) (switch $matched_value @\n@ @ @[%a@]))@]"
         pp_mllam c pp_branches br
-    | MLconstruct(_,_,tag,[||]) -> (* not a construct but a constant *)
+    | MLconstruct(tag,[||]) -> (* not a construct but a constant *)
         Format.fprintf fmt "%i"
           tag
-    | MLconstruct(_,_,tag,args) ->
+    | MLconstruct(tag,args) ->
         Format.fprintf fmt "@[<2>(block (tag %i)%a)@]"
           tag pp_args args
     | MLisaccu (_, _, c) ->
@@ -2115,7 +2110,7 @@ let pp_cofix fmt (gn, s) =
       | MLmatch_noaccu(a,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
           MLmatch_noaccu(a, Array.map auxb bs)
-      | MLconstruct(prefix,c,tag,args) -> MLconstruct(prefix,c,tag,Array.map aux args)
+      | MLconstruct(tag,args) -> MLconstruct(tag,Array.map aux args)
       | MLsetref(s,l1) -> MLsetref(s,aux l1)
       | MLsequence(l1,l2) -> MLsequence(aux l1, aux l2)
       | MLarray arr -> MLarray (Array.map aux arr)
@@ -2491,7 +2486,7 @@ let compile_deps consider_accs cenv env sigma prefix init t =
       let comp_stack = code@comp_stack in
       let const_updates = Cmap_env.add c upd const_updates in
       comp_stack, (mind_updates, const_updates)
-  | Construct (((mind,_),_),_u) -> compile_mind_deps consider_accs cenv env prefix init mind
+  | Construct _ -> init (* constructs are directly built using their tag and arguments, no need to import them *)
   | Proj (p,_,c) ->
     let init = compile_mind_deps consider_accs cenv env prefix init (Projection.mind p) in
     aux env lvl init c

From aa91e6f4f4dcfbe978650ce8d7bdfd3ef566671c Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 26 Jun 2026 13:15:24 +0200
Subject: [PATCH 096/110] Now longer forces accumulators by needing an
 inductive defined in another library that uses them (recompiles it instead).

---
 kernel/nativecode.ml | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 11f09f7893fe..73cdb4d83699 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2352,17 +2352,20 @@ let register_native_file libpath ~prefix =
     generate_accus_native_file := StringSet.add prefix !generate_accus_native_file;
   loaded_native_files := StringSet.add prefix !loaded_native_files
 
-let is_code_loaded consider_accs name =
+let is_code_loaded consider_accs ?(recompile_if_incompatible=false) name =
   match !name with
   | NotLinked -> false
   | Linked s ->
     if is_loaded_native_file s then
       (* the dependency needs accumulators to work, so we need them too.
-      We could also try to recompile them and hope that their accumulators were needed due to a parent file needing them, but this is costly and unlikely *)
+      We could also try to recompile them and hope that their accumulators were needed due to a parent file needing them, but this is costly and unlikely (TODOME : use a heuristic ?) *)
       let supp_accs = does_supports_accus_native_file s in
       let gen_accs = does_generate_accus_native_file s in
-      if not consider_accs && gen_accs then raise NeedsAccumulators else
-      if consider_accs && not supp_accs then
+      if not consider_accs && gen_accs then
+        if recompile_if_incompatible then
+          (name := NotLinked; false) (* we recompile the dependency we need in the hope that it doesn't generate accumulators *)
+        else raise NeedsAccumulators
+      else if consider_accs && not supp_accs then
         (name := NotLinked; false) (* we need to recompile the library code to support accumulators *)
       else true
     else (name := NotLinked; false)
@@ -2443,7 +2446,7 @@ let compile_mind_deps consider_accs cenv env prefix
     (comp_stack, (mind_updates, const_updates) as init) mind =
   let mib = lookup_mind mind env in
   let nameref = lookup_mind_key mind env in
-  if is_code_loaded consider_accs nameref
+  if is_code_loaded consider_accs ~recompile_if_incompatible:true nameref (* we choose to recompile because the object we need is just an inductive and thus is very unlikely to generate accumulators *)
     || Mindmap_env.mem mind mind_updates
   then init
   else

From ae8a00841eb529a7c6d4e459241b062db08d7d85 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 26 Jun 2026 14:11:10 +0200
Subject: [PATCH 097/110] fixed a comment

---
 kernel/nativelib.mli | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index b87e4c103f3c..5f0aa4c2456c 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -24,9 +24,9 @@ val load_obj : (string -> unit) ref
 
 val get_mlf_filename : unit -> string * string
 
-(** [compile file code ~profile] will compile native [code] to [file],
+(** [compile consider_accs file code ~profile] will compile native [code] to [file],
    and return the name of the object file; this name depends on
-   whether are in byte mode or not; file is expected to be .ml file *)
+   whether are in byte mode or not.*)
 val compile : bool -> string -> Nativecode.global list -> profile:bool -> string
 
 type native_library = Nativecode.global list * Nativevalues.symbols * bool (* the bool is true if the library generates accumulators *)

From 0d7ccdde0e51afdb166b4ff0b3cc9b758fe687cb Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 30 Jun 2026 15:20:25 +0200
Subject: [PATCH 098/110] fixed most TODOs, and non-library files now also have
 a dinstinction between supporting accumulators and generating them

---
 kernel/nativecode.ml    | 10 ++++------
 kernel/nativecode.mli   |  2 ++
 kernel/nativeconv.ml    |  7 +++++--
 kernel/nativelib.ml     |  4 ++--
 kernel/nativelib.mli    |  4 ++--
 pretyping/nativenorm.ml |  7 +++++--
 topbin/rocqnative.ml    |  2 +-
 7 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 73cdb4d83699..ebae53736c4f 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1343,7 +1343,7 @@ let rec ml_of_lam consider_accs env l t =
     let args = MLarray(Array.map (ml_of_lam consider_accs env l) args) in
     MLprimitive (Mk_evar, [|get_evar_code i; args|])
   | Lprod(dom,codom) ->
-    if not consider_accs then raise NeedsAccumulators else (* productions needs an accumulator to be evaluated TODOME: maybe remove ? (checked at runtime)*)
+    (* productions need accumulators to be evaluated, but this is checked at runtime, and ignoring it for now may allow us to flag more libraries as not generating accumulators *)
     let dom = ml_of_lam consider_accs env l dom in
     let codom = ml_of_lam consider_accs env l codom in
     let n = get_prod_name codom in
@@ -2352,19 +2352,17 @@ let register_native_file libpath ~prefix =
     generate_accus_native_file := StringSet.add prefix !generate_accus_native_file;
   loaded_native_files := StringSet.add prefix !loaded_native_files
 
-let is_code_loaded consider_accs ?(recompile_if_incompatible=false) name =
+let is_code_loaded consider_accs ~recompile_if_incompatible name =
   match !name with
   | NotLinked -> false
   | Linked s ->
     if is_loaded_native_file s then
-      (* the dependency needs accumulators to work, so we need them too.
-      We could also try to recompile them and hope that their accumulators were needed due to a parent file needing them, but this is costly and unlikely (TODOME : use a heuristic ?) *)
       let supp_accs = does_supports_accus_native_file s in
       let gen_accs = does_generate_accus_native_file s in
       if not consider_accs && gen_accs then
         if recompile_if_incompatible then
           (name := NotLinked; false) (* we recompile the dependency we need in the hope that it doesn't generate accumulators *)
-        else raise NeedsAccumulators
+        else raise NeedsAccumulators (* we fail and will recompile with accumulators *)
       else if consider_accs && not supp_accs then
         (name := NotLinked; false) (* we need to recompile the library code to support accumulators *)
       else true
@@ -2471,7 +2469,7 @@ let compile_deps consider_accs cenv env sigma prefix init t =
     let cb = lookup_constant c env in
     let (nameref, _) = lookup_constant_key c env in
     let (_, (_, const_updates)) = init in
-    if is_code_loaded consider_accs nameref
+    if is_code_loaded consider_accs ~recompile_if_incompatible:false nameref (* We could try to recompile the dependency and hope that its accumulators were needed due to a parent needing them, but this is costly and unlikely *)
     || (Cmap_env.mem c const_updates)
     then init
     else
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index 0dc06facceb2..92f18bc3f1b2 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -82,7 +82,9 @@ val compile_mind_field : bool -> cenv -> ModPath.t -> Id.t ->
 val compile_rewrite_rules : env -> Id.t ->
   global list -> rewrite_rules_body -> global list
 
+(** this function may raise the errror NeedsAccumulators when compiling without them *)
 val mk_conv_code : bool -> env -> Genlambda.evars -> string -> constr -> constr -> linkable_code
+(** this function may raise the errror NeedsAccumulators when compiling without them *)
 val mk_norm_code : bool -> env -> Genlambda.evars -> string -> constr -> linkable_code
 
 val mk_library_header : Nativevalues.symbols -> global list
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index 2233be3ebde3..ecf33977c12c 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -195,9 +195,12 @@ let warn_no_native_compiler =
 let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
   Nativelib.link_libraries ();
   let ml_filename, prefix = Nativelib.get_mlf_filename () in
+  let generates_accs = ref false in
   let aux consider_accs =
-    let code, symbols, upds = mk_conv_code consider_accs env sigma prefix t1 t2 in
-    let fn = Nativelib.compile consider_accs ml_filename code ~profile:false in
+    let code, symbols, upds =
+      try mk_conv_code consider_accs env sigma prefix t1 t2
+      with | NeedsAccumulators -> generates_accs := true; raise NeedsAccumulators in
+    let fn = Nativelib.compile (consider_accs, !generates_accs) ml_filename code ~profile:false in
     if consider_accs then
       debug_native_compiler (fun () -> Pp.str "Running test with accumulators...")
     else
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 98b5bcac0264..069fed3d1b43 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -194,8 +194,8 @@ let call_compiler ?profile:(profile=false) mlf_filename =
     error_native_compiler_failed (Inr e) "During .cmxs generation"
   end
 
-let compile consider_accs fn code ~profile:profile =
-  write_code (consider_accs, consider_accs) fn code; (* we consider as a simplification that if we need accumulators, it is probably because we generate some. TODOME: make more accurate assumptions *)
+let compile (consider_accs, generates_accs) fn code ~profile:profile =
+  write_code (consider_accs, generates_accs) fn code;
   let r = call_compiler ~profile fn in
   (* NB: to prevent reusing the same filename we MUST NOT remove the file until exit
      cf #15263 *)
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index 5f0aa4c2456c..2f522f198576 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -24,10 +24,10 @@ val load_obj : (string -> unit) ref
 
 val get_mlf_filename : unit -> string * string
 
-(** [compile consider_accs file code ~profile] will compile native [code] to [file],
+(** [compile (consider_accs, generates_accs) file code ~profile] will compile native [code] to [file],
    and return the name of the object file; this name depends on
    whether are in byte mode or not.*)
-val compile : bool -> string -> Nativecode.global list -> profile:bool -> string
+val compile : (bool * bool) -> string -> Nativecode.global list -> profile:bool -> string
 
 type native_library = Nativecode.global list * Nativevalues.symbols * bool (* the bool is true if the library generates accumulators *)
 
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index f90c65af0d04..0920c4422909 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -502,15 +502,18 @@ let native_norm env sigma c ty =
   let ty = EConstr.Unsafe.to_constr ty in
   let profile = get_profiling_enabled () in
   let print_timing = get_timing_enabled () in
+  let generates_accs = ref false in
   let aux consider_accs =
     let ml_filename, prefix = Nativelib.get_mlf_filename () in
     let tnc0 = Unix.gettimeofday () in
-    let code, symbols, upd = mk_norm_code consider_accs env (evars_of_evar_map sigma) prefix c in
+    let code, symbols, upd =
+      try mk_norm_code consider_accs env (evars_of_evar_map sigma) prefix c with
+      | NeedsAccumulators -> generates_accs := true; raise NeedsAccumulators in
     let tnc1 = Unix.gettimeofday () in
     let time_info = Format.sprintf "native_compute: Conversion to native code done in %.5f" (tnc1 -. tnc0) in
     if print_timing then Feedback.msg_info (Pp.str time_info);
     let tc0 = Unix.gettimeofday () in
-    let fn = Nativelib.compile consider_accs ml_filename code ~profile:profile in
+    let fn = Nativelib.compile (consider_accs, !generates_accs) ml_filename code ~profile:profile in
     let tc1 = Unix.gettimeofday () in
     let time_info = Format.sprintf "native_compute: Compilation done in %.5f" (tc1 -. tc0) in
     if print_timing then Feedback.msg_info (Pp.str time_info);
diff --git a/topbin/rocqnative.ml b/topbin/rocqnative.ml
index 911efee537eb..006304a5bb1f 100644
--- a/topbin/rocqnative.ml
+++ b/topbin/rocqnative.ml
@@ -116,7 +116,7 @@ let register_loaded_library senv libname file =
   let () = assert (not @@ DirPath.Map.mem libname !libraries_table) in
   let () = libraries_table := DirPath.Map.add libname file !libraries_table in
   let prefix = Nativecode.mod_uid_of_dirpath libname ^ "." in
-  let fn = (Filename.dirname file) ^"/.coq-native/"^ Nativecode.mod_uid_of_dirpath libname in (* TODOME: this is a bit ugly and could maybe be cleaned ? *)
+  let fn = (Filename.dirname file) ^"/.coq-native/"^ Nativecode.mod_uid_of_dirpath libname in (* TODOME: this may not work in the general case if the target directory for native is changed *)
   let () = Nativecode.register_native_file fn ~prefix in
   senv
 

From ef77ee3392662289ca9ec5caa3dac80a6bfc8610 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 30 Jun 2026 15:32:51 +0200
Subject: [PATCH 099/110] Fixed an old bug made visible by the last commit :
 native_conv_gen would reuse the previous file when switching to an
 accumulator representation late

---
 kernel/nativeconv.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index ecf33977c12c..d27602114f29 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -194,13 +194,13 @@ let warn_no_native_compiler =
 
 let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
   Nativelib.link_libraries ();
-  let ml_filename, prefix = Nativelib.get_mlf_filename () in
   let generates_accs = ref false in
   let aux consider_accs =
+    let mlf_filename, prefix = Nativelib.get_mlf_filename () in
     let code, symbols, upds =
       try mk_conv_code consider_accs env sigma prefix t1 t2
       with | NeedsAccumulators -> generates_accs := true; raise NeedsAccumulators in
-    let fn = Nativelib.compile (consider_accs, !generates_accs) ml_filename code ~profile:false in
+    let fn = Nativelib.compile (consider_accs, !generates_accs) mlf_filename code ~profile:false in
     if consider_accs then
       debug_native_compiler (fun () -> Pp.str "Running test with accumulators...")
     else

From 1839a60c3fbdb1ab97436d4acdc6c6c4d797acd3 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 6 Jul 2026 15:58:55 +0200
Subject: [PATCH 100/110] fixed an important bug where functions (and
 productions) would not cause recompilation with accumulators if inside an
 inductive type

---
 pretyping/nativenorm.ml | 85 ++++++++++++++++++++++-------------------
 1 file changed, 46 insertions(+), 39 deletions(-)

diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index 0920c4422909..b85e2b28609c 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -197,8 +197,7 @@ let get_proj env (ind, proj_arg) =
 let rec nf_val consider_accs env sigma v typ =
   match kind_of_value v with
   | Vaccu accu ->
-    (* if not consider_accs then failwith "accumulator mysteriously appeared in a accumulator-less execution" else *)
-    nf_accu env sigma accu
+    nf_accu consider_accs env sigma accu
   | Vprod (na, dom, codom) ->
     if not consider_accs then raise NeedsAccumulators else
     fst @@ nf_prod env sigma (na, dom, codom)
@@ -225,16 +224,18 @@ let rec nf_val consider_accs env sigma v typ =
       let args = nf_bargs consider_accs env sigma b ctyp in
       mkApp(capp,args)
 
-and nf_type env sigma v =
+and nf_type consider_accs env sigma v =
   match kind_of_value v with
-  | Vaccu accu -> nf_accu env sigma accu
-  | Vprod (na, dom, codom) -> fst @@ nf_prod env sigma (na, dom, codom)
+  | Vaccu accu -> nf_accu consider_accs env sigma accu
+  | Vprod (na, dom, codom) ->
+    if not consider_accs then raise NeedsAccumulators else
+    fst @@ nf_prod env sigma (na, dom, codom)
   | _ -> assert false
 
-and nf_type_sort env sigma v =
+and nf_type_sort consider_accs env sigma v =
   match kind_of_value v with
   | Vaccu accu ->
-      let t,s = nf_accu_type env sigma accu in
+      let t,s = nf_accu_type consider_accs env sigma accu in
       let s =
         try
           destSort (whd_all env s)
@@ -242,26 +243,28 @@ and nf_type_sort env sigma v =
           CErrors.anomaly (Pp.str "Value should be a sort")
       in
       t, s
-  | Vprod (na, dom, codom) -> nf_prod env sigma (na, dom, codom)
+  | Vprod (na, dom, codom) ->
+    if not consider_accs then raise NeedsAccumulators else
+    nf_prod env sigma (na, dom, codom)
   | _ -> assert false
 
-and nf_accu env sigma accu =
+and nf_accu consider_accs env sigma accu =
   let atom = atom_of_accu accu in
-  if Int.equal (accu_nargs accu) 0 then nf_atom env sigma atom
+  if Int.equal (accu_nargs accu) 0 then nf_atom consider_accs env sigma atom
   else
-    let a,typ = nf_atom_type env sigma atom in
-    let _, args = nf_args env sigma (args_of_accu accu) typ in
+    let a,typ = nf_atom_type consider_accs env sigma atom in
+    let _, args = nf_args consider_accs env sigma (args_of_accu accu) typ in
     mkApp(a,Array.of_list args)
 
-and nf_accu_type env sigma accu =
+and nf_accu_type consider_accs env sigma accu =
   let atom = atom_of_accu accu in
-  if Int.equal (accu_nargs accu) 0 then nf_atom_type env sigma atom
+  if Int.equal (accu_nargs accu) 0 then nf_atom_type consider_accs env sigma atom
   else
-    let a,typ = nf_atom_type env sigma atom in
-    let t, args = nf_args env sigma (args_of_accu accu) typ in
+    let a,typ = nf_atom_type consider_accs env sigma atom in
+    let t, args = nf_args consider_accs env sigma (args_of_accu accu) typ in
     mkApp(a,Array.of_list args), t
 
-and nf_args env sigma args t =
+and nf_args consider_accs env sigma args t =
   let aux arg (t,l) =
     let _,dom,codom =
       try decompose_prod env t with
@@ -269,7 +272,7 @@ and nf_args env sigma args t =
         CErrors.anomaly
           (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
     in
-    let c = nf_val true env sigma arg dom in
+    let c = nf_val consider_accs env sigma arg dom in
     (subst1 c codom, c::l)
   in
   let t,l = List.fold_right aux args (t,[]) in
@@ -290,15 +293,15 @@ and nf_bargs consider_accs env sigma b t =
       t := subst1 c codom; c)
 
 and nf_prod env sigma (na, dom, codom) =
-  let dom, sdom = nf_type_sort env sigma dom in
+  let dom, sdom = nf_type_sort true env sigma dom in
   let rdom = Sorts.relevance_of_sort sdom in
   let na = make_annot na rdom in
   let vn = mk_rel_accu (nb_rel env) in
   let env = push_rel (LocalAssum (na, dom)) env in
-  let codom, scodom = nf_type_sort env sigma (apply codom vn) in
+  let codom, scodom = nf_type_sort true env sigma (apply codom vn) in
   mkProd (na, dom, codom), Typeops.sort_of_product env sdom scodom
 
-and nf_atom env sigma atom =
+and nf_atom consider_accs env sigma atom =
   match atom with
   | Arel i -> mkRel (nb_rel env - i)
   | Aconstant cst -> mkConstU cst
@@ -306,14 +309,14 @@ and nf_atom env sigma atom =
   | Asort s -> mkSort s
   | Avar id -> mkVar id
   | Aproj (p, c) ->
-      let c, cty = nf_accu_type env sigma c in
+      let c, cty = nf_accu_type consider_accs env sigma c in
       let p, r = get_proj env p in
       let (_, u), _ = find_rectype_a env sigma (EConstr.of_constr cty) in
       let r = UVars.subst_instance_relevance u r in
       mkProj(p, r, c)
-  | _ -> fst (nf_atom_type env sigma atom)
+  | _ -> fst (nf_atom_type consider_accs env sigma atom)
 
-and nf_atom_type env sigma atom =
+and nf_atom_type consider_accs env sigma atom =
   match atom with
   | Arel i ->
     let n = (nb_rel env - i) in
@@ -327,7 +330,7 @@ and nf_atom_type env sigma atom =
   | Avar id ->
     mkVar id, Typeops.type_of_variable env id
   | Acase(ans,accu,p,bs) ->
-      let a,ta = nf_accu_type env sigma accu in
+      let a,ta = nf_accu_type consider_accs env sigma accu in
       let ((mind, _ as ind), u),allargs = find_rectype_a env sigma (EConstr.of_constr ta) in
       let (mib,mip) = Inductive.lookup_mind_specif env ind in
       let nparams = mib.mind_nparams in
@@ -338,14 +341,14 @@ and nf_atom_type env sigma atom =
         let nas = List.rev_map get_annot realdecls @ [nameR (Id.of_string "c")] in
         expand_arity (mib, mip) (ind, u) params (Array.of_list nas)
       in
-      let p, relevance = nf_predicate env sigma ind mip params p pctx in
+      let p, relevance = nf_predicate consider_accs env sigma ind mip params p pctx in
       (* Calcul du type des branches *)
       let btypes = build_branches_type env sigma mib mip (ind, EConstr.EInstance.make u) params (pctx, p) in
       (* calcul des branches *)
       let bsw = branch_of_switch (nb_rel env) ans bs in
       let mkbranch i v =
         let decl, nas, lft, codom = btypes.(i) in
-        let b = nf_val true (Termops.push_rels_assum decl env) sigma v codom in
+        let b = nf_val consider_accs (Termops.push_rels_assum decl env) sigma v codom in
         nas, exliftn lft b
       in
       let branchs = Array.mapi mkbranch bsw in
@@ -358,7 +361,8 @@ and nf_atom_type env sigma atom =
       in
       mkCase (ci, u, params, (p,relevance), iv, a, branchs), tcase
   | Afix(tt,ft,rp,s) ->
-      let tt = Array.map (fun t -> nf_type_sort env sigma t) tt in
+      if not consider_accs then raise NeedsAccumulators else
+      let tt = Array.map (fun t -> nf_type_sort consider_accs env sigma t) tt in
       let tt = Array.map fst tt and rt = Array.map snd tt in
       let name = Name (Id.of_string "Ffix") in
       let names = Array.map (fun s -> make_annot name (Sorts.relevance_of_sort s)) rt in
@@ -369,45 +373,48 @@ and nf_atom_type env sigma atom =
       let env = push_rec_types (names,tt,[||]) env in
       (* We lift here because the types of arguments (in tt) will be evaluated
          in an environment where the fixpoints have been pushed *)
-      let norm_body i v = nf_val true env sigma (napply v fargs) (lift nbfix tt.(i)) in
+      let norm_body i v = nf_val consider_accs env sigma (napply v fargs) (lift nbfix tt.(i)) in
       let ft = Array.mapi norm_body ft in
       mkFix((rp,s),(names,tt,ft)), tt.(s)
   | Acofix (tt, ft, s, args, _) ->
-      let tt = Array.map (fun t -> nf_type_sort env sigma t) tt in
+      if not consider_accs then raise NeedsAccumulators else
+      let tt = Array.map (fun t -> nf_type_sort consider_accs env sigma t) tt in
       let tt = Array.map fst tt and rt = Array.map snd tt in
       let name = Name (Id.of_string "Fcofix") in
       let lvl = nb_rel env in
       let names = Array.map (fun s -> make_annot name (Sorts.relevance_of_sort s)) rt in
       let fargs = mk_rels_accu lvl (Array.length ft) in
-      let _, args = nf_args env sigma (Array.rev_to_list args) tt.(s) in
+      let _, args = nf_args consider_accs env sigma (Array.rev_to_list args) tt.(s) in
       let env = push_rec_types (names,tt,[||]) env in
-      let ft = Array.mapi (fun i v -> nf_val true env sigma (napply v fargs) tt.(i)) ft in
+      let ft = Array.mapi (fun i v -> nf_val consider_accs env sigma (napply v fargs) tt.(i)) ft in
       mkApp (mkCoFix(s,(names,tt,ft)), Array.of_list args), tt.(s)
   | Aevar(evk,args) ->
-    nf_evar env sigma evk args
+    nf_evar consider_accs env sigma evk args
   | Aproj(p,c) ->
-      let c,tc = nf_accu_type env sigma c in
+      let c,tc = nf_accu_type consider_accs env sigma c in
       let cj = make_judge c tc in
       let p, _ = get_proj env p in
       let r, ty = Typeops.type_of_projection env p cj.uj_val cj.uj_type in
       mkProj (p, r, cj.uj_val), ty
 
 
-and nf_predicate env sigma ind mip params v pctx =
+and nf_predicate consider_accs env sigma ind mip params v pctx =
   let fold decl (k, v) = match decl with
   | LocalDef _ -> (k + 1, v)
   | LocalAssum _ ->
     match kind_of_value v with
-    | Vfun f -> (k + 1, f (mk_rel_accu k))
+    | Vfun f ->
+      if not consider_accs then raise NeedsAccumulators else
+      (k + 1, f (mk_rel_accu k))
     | _ -> assert false
   in
   let (_, v) = List.fold_right fold pctx (nb_rel env, v) in
   let env = push_rel_context pctx env in
-  let body = nf_type env sigma v in
+  let body = nf_type consider_accs env sigma v in
   let rel = Retyping.relevance_of_type env sigma (EConstr.of_constr body) in
   body, EConstr.Unsafe.to_relevance rel
 
-and nf_evar env sigma evk args =
+and nf_evar consider_accs env sigma evk args =
   let evi = try Evd.find_undefined sigma evk with Not_found -> assert false in
   let hyps = EConstr.named_context_of_val (Evd.evar_filtered_hyps evi) in
   if List.is_empty hyps then begin
@@ -423,7 +430,7 @@ and nf_evar env sigma evk args =
     let fold accu d = EConstr.mkNamedProd_or_LetIn sigma d accu in
     let t = List.fold_left fold ty hyps in
     let t = EConstr.to_constr ~abort_on_undefined_evars:false sigma t in
-    let ty, args = nf_args env sigma (Array.to_list args) t in
+    let ty, args = nf_args consider_accs env sigma (Array.to_list args) t in
     (* nf_args takes arguments in the reverse order but produces them
        in the correct one, so we have to reverse them again for the
        evar node *)

From 155d3b038f98bf5627796c8f0f9af880cf2b5745 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 13 Jul 2026 21:17:04 +0200
Subject: [PATCH 101/110] Now make simple checks to avoid recompiling
 everything when an accumulator is needed to interpret the return value

---
 kernel/nativecode.ml    | 74 +++++++++++++++++++++++++++++++++++++++++
 kernel/nativecode.mli   |  3 ++
 kernel/nativeconv.ml    |  1 +
 pretyping/nativenorm.ml |  1 +
 4 files changed, 79 insertions(+)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index ebae53736c4f..88337b74912f 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -47,6 +47,7 @@ module LNord =
   end
 module LNmap = Map.Make(LNord)
 module LNset = Set.Make(LNord)
+module Strset = Set.Make(String)
 
 let rec is_lazy env t =
   match Constr.kind t with
@@ -2537,6 +2538,79 @@ let mk_open s = Gopen s
 let mk_internal_let s code =
   Glet(Ginternal s, code)
 
+let check_accu_need_for_evaluation g =
+  let g = List.rev g in (* now the dependencies are after the dependent *)
+
+  let rec check_lambda returned l =
+    match l with
+    | MLmatch_noaccu (v, br) ->
+      let returned = check_lambda returned v in
+      Array.fold_left
+      (fun acc br ->
+        check_lambda acc (snd br)
+      )
+      returned br
+    | MLlet (_, br1, br2)
+    | MLif (_, br1, br2) ->
+      let returned = check_lambda returned br1 in
+      check_lambda returned br2 
+    | MLsetref (_, l)
+    | MLsequence (_, l) -> check_lambda returned l
+    | MLapp (_, args) -> (* we currently do not inverstigate closure creation from curryfication for the sake of simplicity *)
+      Array.fold_left check_lambda returned args
+    | MLconstruct (_, arr)
+    | MLarray arr -> Array.fold_left check_lambda returned arr
+    | MLprimitive (Mk_prod, _)
+    | MLletrec _
+    | MLisaccu _
+    | MLmatch _
+    | MLlam _ -> raise NeedsAccumulators
+    | MLglobal g -> Strset.add (string_of_gname g) returned
+    | MLlocal _
+    | MLfloat _
+    | MLuint _
+    | MLprimitive _
+    | MLstring _
+    | MLint _ -> returned
+  in
+  let rec check_globals g returned =
+    match g with
+    | [] -> ()
+    | x::q ->
+      let returned = match x with
+      | Gtblfixtype (n, [||], arr)
+      | Gtblnorm (n, [||], arr) ->
+        let n = string_of_gname n in
+        if Strset.mem n returned then
+          Array.fold_left check_lambda returned arr
+        else returned
+      | Gletcase_noaccu (n, [||], v, brs) ->
+        let n = string_of_gname n in
+        if Strset.mem n returned then
+          let returned = check_lambda returned v in
+          Array.fold_left
+          (fun acc br ->
+            check_lambda acc (snd br)
+          )
+          returned brs
+        else returned
+      | Gtblnorm _
+      | Gtblfixtype _
+      | Gletcase _
+      | Gtblcofix _
+      | Gletcase_noaccu _ -> raise NeedsAccumulators (* is a function *)
+      | Glet (n, v) ->
+        let n = string_of_gname n in
+        if Strset.mem n returned then
+          check_lambda returned v
+        else returned
+      | Gopen _
+      | Gcomment _ -> returned
+      in
+      check_globals q returned
+  in
+  check_globals g Strset.empty
+
 (* ML Code for conversion function *)
 let mk_conv_code consider_accs env sigma prefix t1 t2 =
   let cenv = make_cenv () in
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index 92f18bc3f1b2..56198223dba3 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -82,6 +82,9 @@ val compile_mind_field : bool -> cenv -> ModPath.t -> Id.t ->
 val compile_rewrite_rules : env -> Id.t ->
   global list -> rewrite_rules_body -> global list
 
+(** this function may raise the errror NeedsAccumulators when accumulators are needed*)
+val check_accu_need_for_evaluation: global list -> unit
+
 (** this function may raise the errror NeedsAccumulators when compiling without them *)
 val mk_conv_code : bool -> env -> Genlambda.evars -> string -> constr -> constr -> linkable_code
 (** this function may raise the errror NeedsAccumulators when compiling without them *)
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index d27602114f29..d64ae537a3b7 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -200,6 +200,7 @@ let native_conv_gen (type err) pb sigma env (state, check) t1 t2 =
     let code, symbols, upds =
       try mk_conv_code consider_accs env sigma prefix t1 t2
       with | NeedsAccumulators -> generates_accs := true; raise NeedsAccumulators in
+    if not consider_accs then check_accu_need_for_evaluation code;
     let fn = Nativelib.compile (consider_accs, !generates_accs) mlf_filename code ~profile:false in
     if consider_accs then
       debug_native_compiler (fun () -> Pp.str "Running test with accumulators...")
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index b85e2b28609c..60d781fdd54f 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -516,6 +516,7 @@ let native_norm env sigma c ty =
     let code, symbols, upd =
       try mk_norm_code consider_accs env (evars_of_evar_map sigma) prefix c with
       | NeedsAccumulators -> generates_accs := true; raise NeedsAccumulators in
+    if not consider_accs then check_accu_need_for_evaluation code;
     let tnc1 = Unix.gettimeofday () in
     let time_info = Format.sprintf "native_compute: Conversion to native code done in %.5f" (tnc1 -. tnc0) in
     if print_timing then Feedback.msg_info (Pp.str time_info);

From 8945ff083cc4dc09537b2faeb737067505911977 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 14 Aug 2026 16:57:05 +0200
Subject: [PATCH 102/110] updated gitlab ci

---
 .gitlab-ci.yml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 535e65bee565..0c697c508960 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -40,8 +40,8 @@ variables:
   # The $hash is the first 10 characters of the md5 of the Dockerfile. e.g.
   # echo $(md5sum dev/ci/docker/old_ubuntu_lts/Dockerfile | head -c 10)
   # echo $(md5sum dev/ci/docker/edge_ubuntu/Dockerfile | head -c 10)
-  BASE_CACHEKEY: "old_ubuntu_lts-V2026-10-07-1c266a2665"
-  EDGE_CACHEKEY: "edge_ubuntu-V2026-10-07-e139ef8b6a"
+  BASE_CACHEKEY: "old_ubuntu_lts-V2026-14-08-1c266a2665"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-14-08-e139ef8b6a"
   BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY"
   EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY"
 

From e7ec5e5f5f714cea79bf0dd0a81a417400febd14 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 29 Jun 2026 10:52:40 +0200
Subject: [PATCH 103/110] changed the representation of accumulators to be a
 closure

---
 kernel/nativecode.ml   |  6 +++---
 kernel/nativevalues.ml | 25 ++++++++++++++++++-------
 2 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 88337b74912f..f5aad7938c96 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1984,8 +1984,8 @@ let pp_mllam fmt l =
     | MLsetref (s, body) ->
         Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam body
     | MLmatch (c, accu_br, br) ->
-      Format.fprintf fmt (* accumulator is always tag 0 *)
-        "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 0)@\n    %a)@\n  @[%a@]))@]"
+      Format.fprintf fmt (* accumulator is a function, so tag 247 or 249 *)
+        "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 247) (tag 249)@\n    %a)@\n  @[%a@]))@]"
         pp_mllam c pp_mllam accu_br pp_branches br
     | MLmatch_noaccu (c, br) ->
       Format.fprintf fmt
@@ -1999,7 +1999,7 @@ let pp_mllam fmt l =
           tag pp_args args
     | MLisaccu (_, _, c) ->
         Format.fprintf fmt
-          "@[(switch %a@\n  ((tag 0) 1)@\n  (_ (tag _) 0))@]"
+          "@[(switch %a@\n  ((tag 247) (tag 249) 1)@\n  (_ (tag _) 0))@]"
         pp_mllam c
   and pp_cparams fmt params =
     let len = Array.length params in
diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml
index fd3a06d759f6..0551cccee6fc 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -102,7 +102,7 @@ type symbols = symbol array
 let empty_symbols = [| |]
 
 
-let accumulate_tag = 0
+let accumulate_tag = 247 (* TODOME: maybe 249 and more ? *)
 
 (** Unique pointer used to drive the accumulator function *)
 let ret_accu = Obj.repr (ref ())
@@ -110,21 +110,30 @@ let ret_accu = Obj.repr (ref ())
 type accu_val = { acc_atm : atom; acc_arg : t list }
 
 (** Return a pointer to [caml_curry2_1] that is also recognized as an unscannable block *)
-external get_curry2_1 : unit -> Obj.t = "rocq_curry2_1_addr"
+(* external get_curry2_1 : unit -> Obj.t = "rocq_curry2_1_addr" *)
 
-type _ curry2_1_clos = Curry2_1 : Obj.t * int * 'a * ('a -> 'b -> 'c) -> ('b -> 'c) curry2_1_clos
+(* type _ curry2_1_clos = Curry2_1 : Obj.t * int * accu_val * (accu_val -> t -> Obj.t) -> (t -> Obj.t) curry2_1_clos *)
+(* an object like this is similar to a function, with:
+  Curry2_1 (curry2_1, 2, data, accumulate) being a function where:
+  - curry2_1 is the currified function pointer that will do all the work
+  - 2 indicates that the environment of the closure starts at data (offset 2) and an arity of 0 (TODOME:?)
+  - data is the first argument that curry2_1 will give to our accumulate function
+  - accumulate is a function that will be called when trying to apply the accumulator, with as first argument data and second the value it is applied to
+ *)
 
 let mk_accu =
-  let curry2_1 = get_curry2_1 () in
+  (* let curry2_1 = get_curry2_1 () in *)
   let rec accumulate data x =
     if Obj.repr x == ret_accu then Obj.repr data
     else
       let data = { data with acc_arg = x :: data.acc_arg } in
-      let ans = Curry2_1 (curry2_1, 2, data, accumulate) in
+      (* let ans = Curry2_1 (curry2_1, 2, data, accumulate) in *)
+      let ans = accumulate data in
       Obj.repr ans in
   fun (a : atom) ->
   let data = { acc_atm = a; acc_arg = [] } in
-  let ans = Curry2_1 (curry2_1, 2, data, accumulate) in
+  (* let ans = Curry2_1 (curry2_1, 2, data, accumulate) in *)
+  let ans = accumulate data in
   (Obj.magic ans : t)
 
 let get_accu (k : accumulator) =
@@ -258,12 +267,14 @@ let kind_of_value (v:t) =
   else
     let tag = Obj.tag o in
     if Int.equal tag accumulate_tag then
+      Vaccu (Obj.magic v)
+    else if Int.equal tag 0 then
       if Int.equal (Obj.size o) 1 then
         let w = Obj.field o 0 in
         let tag = Obj.tag w in
         if Int.equal tag prod_tag then Obj.magic w
         else Varray (Obj.magic v)
-      else Vaccu (Obj.magic v)
+      else assert false
     else if Int.equal tag Obj.custom_tag then Vint64 (Obj.magic v)
     else if Int.equal tag Obj.double_tag then Vfloat64 (Obj.magic v)
     else if Int.equal tag Obj.string_tag then Vstring (Obj.magic v)

From 9dbd0e26cc92193136935b37463c6fe9cb853042 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 29 Jun 2026 16:33:25 +0200
Subject: [PATCH 104/110] Fixed closures and accumulators being
 undistinguishable

---
 kernel/nativevalues.ml | 39 ++++++++++++++++++---------------------
 1 file changed, 18 insertions(+), 21 deletions(-)

diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml
index 0551cccee6fc..252884008329 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -102,7 +102,7 @@ type symbols = symbol array
 let empty_symbols = [| |]
 
 
-let accumulate_tag = 247 (* TODOME: maybe 249 and more ? *)
+let accumulate_tag = 247
 
 (** Unique pointer used to drive the accumulator function *)
 let ret_accu = Obj.repr (ref ())
@@ -110,30 +110,27 @@ let ret_accu = Obj.repr (ref ())
 type accu_val = { acc_atm : atom; acc_arg : t list }
 
 (** Return a pointer to [caml_curry2_1] that is also recognized as an unscannable block *)
-(* external get_curry2_1 : unit -> Obj.t = "rocq_curry2_1_addr" *)
+external get_curry2_1 : unit -> Obj.t = "rocq_curry2_1_addr"
 
-(* type _ curry2_1_clos = Curry2_1 : Obj.t * int * accu_val * (accu_val -> t -> Obj.t) -> (t -> Obj.t) curry2_1_clos *)
-(* an object like this is similar to a function, with:
-  Curry2_1 (curry2_1, 2, data, accumulate) being a function where:
+(* an accumulator is similar to a function, with:
+  Obj.with_tag accumulate_tag @@ Obj.repr (curry2_1, 2, data, accumulate, ret_accu) being a cloture where:
   - curry2_1 is the currified function pointer that will do all the work
   - 2 indicates that the environment of the closure starts at data (offset 2) and an arity of 0 (TODOME:?)
   - data is the first argument that curry2_1 will give to our accumulate function
   - accumulate is a function that will be called when trying to apply the accumulator, with as first argument data and second the value it is applied to
+  - ret_accu is a special value that is only present on accumulators (to distinguish them from regular closures)
  *)
-
 let mk_accu =
-  (* let curry2_1 = get_curry2_1 () in *)
+  let curry2_1 = get_curry2_1 () in
   let rec accumulate data x =
     if Obj.repr x == ret_accu then Obj.repr data
     else
       let data = { data with acc_arg = x :: data.acc_arg } in
-      (* let ans = Curry2_1 (curry2_1, 2, data, accumulate) in *)
-      let ans = accumulate data in
+      let ans = Obj.with_tag accumulate_tag @@ Obj.repr (curry2_1, 2, data, accumulate, ret_accu) in
       Obj.repr ans in
   fun (a : atom) ->
   let data = { acc_atm = a; acc_arg = [] } in
-  (* let ans = Curry2_1 (curry2_1, 2, data, accumulate) in *)
-  let ans = accumulate data in
+  let ans = Obj.with_tag accumulate_tag @@ Obj.repr (curry2_1, 2, data, accumulate, ret_accu) in
   (Obj.magic ans : t)
 
 let get_accu (k : accumulator) =
@@ -266,22 +263,22 @@ let kind_of_value (v:t) =
   if Obj.is_int o then Vconst (Obj.magic v)
   else
     let tag = Obj.tag o in
-    if Int.equal tag accumulate_tag then
-      Vaccu (Obj.magic v)
-    else if Int.equal tag 0 then
-      if Int.equal (Obj.size o) 1 then
-        let w = Obj.field o 0 in
-        let tag = Obj.tag w in
-        if Int.equal tag prod_tag then Obj.magic w
-        else Varray (Obj.magic v)
-      else assert false
+    if Int.equal tag 0 then
+      let w = Obj.field o 0 in
+      let tag = Obj.tag w in
+      if Int.equal tag prod_tag then Obj.magic w
+      else Varray (Obj.magic v)
     else if Int.equal tag Obj.custom_tag then Vint64 (Obj.magic v)
     else if Int.equal tag Obj.double_tag then Vfloat64 (Obj.magic v)
     else if Int.equal tag Obj.string_tag then Vstring (Obj.magic v)
     else if (tag < Obj.lazy_tag) then Vblock (Obj.magic v)
+    else (* value is either a function or an accumulator *)
+      let vo = Obj.repr v in
+      if Obj.size vo = 5 && Obj.field vo 4 == ret_accu then
+        Vaccu (Obj.magic v)
       else
         (* assert (tag = Obj.closure_tag || tag = Obj.infix_tag);
-           or ??? what is 1002*)
+            or ??? what is 1002*)
         Vfun (apply v)
 
 (** Support for machine integers *)

From 81ffacb10b251800a5d482ddb2d023bfeecd119a Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 30 Jun 2026 13:00:04 +0200
Subject: [PATCH 105/110] removed the main hack in the handling of accumulators

---
 kernel/byterun/rocq_values.c | 22 ++--------------------
 1 file changed, 2 insertions(+), 20 deletions(-)

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 1a58b2cc9322..2af12bcc20a8 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -135,27 +135,9 @@ void caml_curry2_1() {
   abort();
 }
 
-#if defined(__GNUC__) && defined(__amd64__)
-
-asm(".align 8\n\t"
-    ".quad 2043\n"
-    "rocq_curry2_1:\n\t"
-    "jmp caml_curry2_1\n");
-
-#elif defined(__GNUC__) && defined(__i386__)
-
-asm(".align 4\n\t"
-    ".long 2043\n"
-    "rocq_curry2_1:\n\t"
-    "jmp caml_curry2_1\n");
-
-#else
-#error "Unsupported architecture for native_compute."
-#endif
-
 value rocq_curry2_1_addr(value v) {
-  extern void rocq_curry2_1();
-  return (value)&rocq_curry2_1;
+  extern void caml_curry2_1() __attribute__((weak));
+  return (value)&caml_curry2_1;
 }
 
 #else // not NO_NAKED_POINTERS

From 7ae588279068b5907dc8901c79b3ace297aa6e10 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 30 Jun 2026 14:11:09 +0200
Subject: [PATCH 106/110] cleaned code and simplified the hack used to
 differentiate functions from closures

---
 kernel/byterun/rocq_values.c | 13 +---------
 kernel/nativevalues.ml       | 49 ++++++++++++++++++------------------
 2 files changed, 25 insertions(+), 37 deletions(-)

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 2af12bcc20a8..93423e86a8f6 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -109,18 +109,7 @@ value rocq_tcode_array(value tcodes) {
   CAMLreturn(res);
 }
 
-/* The rocq_curry2_1 function returns a pointer to some code that
-   immediately branches to caml_curry2_1. It can be used as field 0 of
-   an OCaml closure, as long as field 3 contains a closure whose code
-   pointer accepts exactly two arguments (the first argument is stored
-   in field 2).
-
-   Since the word before the branch indicates to the garbage collector
-   that this block should be ignored, the code pointer can be used
-   inside blocks that do not have tag 247. This 2043 value is the
-   result of Caml_out_of_heap_header(2, Abstract_tag).
-
-   Keep the compile-time checks in sync with rocq_configure.c */
+/* Keep the compile-time checks in sync with rocq_configure.c */
 
 #ifdef NO_NATIVE_COMPUTE
 
diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml
index 252884008329..e890abb0d22c 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -102,8 +102,6 @@ type symbols = symbol array
 let empty_symbols = [| |]
 
 
-let accumulate_tag = 247
-
 (** Unique pointer used to drive the accumulator function *)
 let ret_accu = Obj.repr (ref ())
 
@@ -112,26 +110,30 @@ type accu_val = { acc_atm : atom; acc_arg : t list }
 (** Return a pointer to [caml_curry2_1] that is also recognized as an unscannable block *)
 external get_curry2_1 : unit -> Obj.t = "rocq_curry2_1_addr"
 
-(* an accumulator is similar to a function, with:
-  Obj.with_tag accumulate_tag @@ Obj.repr (curry2_1, 2, data, accumulate, ret_accu) being a cloture where:
+(* an accumulator is a handcrafted closure, with:
+  Obj.with_tag Obj.closure_tag @@ Obj.repr (curry2_1, 2, data, accumulate) being a closure where:
   - curry2_1 is the currified function pointer that will do all the work
-  - 2 indicates that the environment of the closure starts at data (offset 2) and an arity of 0 (TODOME:?)
+  - 2 indicates where the environment of the closure starts and its arity
   - data is the first argument that curry2_1 will give to our accumulate function
-  - accumulate is a function that will be called when trying to apply the accumulator, with as first argument data and second the value it is applied to
-  - ret_accu is a special value that is only present on accumulators (to distinguish them from regular closures)
+  - accumulate is a function that will be called when trying to apply the accumulator, with as first argument data and second the value it is applied to.
+    It is also unique to accumulators, allowing us to distinguish them from regular closures
+  
+  It is created manually so that we have guarantees on its layout (writing "accumulate data" would allow the compiler to do optimisations that would break everything)
  *)
-let mk_accu =
-  let curry2_1 = get_curry2_1 () in
-  let rec accumulate data x =
-    if Obj.repr x == ret_accu then Obj.repr data
-    else
-      let data = { data with acc_arg = x :: data.acc_arg } in
-      let ans = Obj.with_tag accumulate_tag @@ Obj.repr (curry2_1, 2, data, accumulate, ret_accu) in
-      Obj.repr ans in
-  fun (a : atom) ->
+let curry2_1 = get_curry2_1 ()
+let rec accumulate data x =
+  if Obj.repr x == ret_accu then Obj.repr data
+  else
+    let data = { data with acc_arg = x :: data.acc_arg } in
+    let ans = Obj.with_tag Obj.closure_tag @@ Obj.repr (curry2_1, 2, data, accumulate) in
+    Obj.repr ans
+let mk_accu (a : atom) =
   let data = { acc_atm = a; acc_arg = [] } in
-  let ans = Obj.with_tag accumulate_tag @@ Obj.repr (curry2_1, 2, data, accumulate, ret_accu) in
+  let ans = Obj.with_tag Obj.closure_tag @@ Obj.repr (curry2_1, 2, data, accumulate) in
   (Obj.magic ans : t)
+(** differentiates an accumulator from a closure. Should only be used on memory blocks. *)
+let is_accu v =
+  Obj.size v = 4 && Obj.field v 3 == Obj.repr accumulate
 
 let get_accu (k : accumulator) =
   (Obj.magic k : Obj.t -> accu_val) ret_accu
@@ -272,14 +274,11 @@ let kind_of_value (v:t) =
     else if Int.equal tag Obj.double_tag then Vfloat64 (Obj.magic v)
     else if Int.equal tag Obj.string_tag then Vstring (Obj.magic v)
     else if (tag < Obj.lazy_tag) then Vblock (Obj.magic v)
-    else (* value is either a function or an accumulator *)
-      let vo = Obj.repr v in
-      if Obj.size vo = 5 && Obj.field vo 4 == ret_accu then
-        Vaccu (Obj.magic v)
-      else
-        (* assert (tag = Obj.closure_tag || tag = Obj.infix_tag);
-            or ??? what is 1002*)
-        Vfun (apply v)
+    else if is_accu @@ Obj.repr v then Vaccu (Obj.magic v)
+    else
+      (* assert (tag = Obj.closure_tag || tag = Obj.infix_tag);
+          or ??? what is 1002*)
+      Vfun (apply v)
 
 (** Support for machine integers *)
 

From 8cd6c05ad251b5cf3a0264009febf0c572c2b5b5 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 30 Jun 2026 16:00:20 +0200
Subject: [PATCH 107/110] removed magic numbers

---
 kernel/nativecode.ml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index f5aad7938c96..fb2e46821457 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1984,9 +1984,9 @@ let pp_mllam fmt l =
     | MLsetref (s, body) ->
         Format.fprintf fmt "@[(store %s@ 0 @ @\n (apply (global $Option $some) %a ) )@]" s pp_mllam body
     | MLmatch (c, accu_br, br) ->
-      Format.fprintf fmt (* accumulator is a function, so tag 247 or 249 *)
-        "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag 247) (tag 249)@\n    %a)@\n  @[%a@]))@]"
-        pp_mllam c pp_mllam accu_br pp_branches br
+      Format.fprintf fmt (* an accumulator is a closure *)
+        "@[(let ($matched_value %a) (switch $matched_value @\n@ @ ((tag %i)@\n    %a)@\n  @[%a@]))@]"
+        pp_mllam c Obj.closure_tag pp_mllam accu_br pp_branches br
     | MLmatch_noaccu (c, br) ->
       Format.fprintf fmt
         "@[(let ($matched_value %a) (switch $matched_value @\n@ @ @[%a@]))@]"
@@ -1999,8 +1999,8 @@ let pp_mllam fmt l =
           tag pp_args args
     | MLisaccu (_, _, c) ->
         Format.fprintf fmt
-          "@[(switch %a@\n  ((tag 247) (tag 249) 1)@\n  (_ (tag _) 0))@]"
-        pp_mllam c
+          "@[(switch %a@\n  ((tag %i) 1)@\n  (_ (tag _) 0))@]"
+        pp_mllam c Obj.closure_tag
   and pp_cparams fmt params =
     let len = Array.length params in
     for i = 0 to len - 1 do

From 28362fc2d1e58aeee755726b2ef5f781f3d76ed7 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 9 Jul 2026 13:37:16 +0200
Subject: [PATCH 108/110] changed accumulator contruction and check to not use
 Obj.with_tag

---
 kernel/nativelib.ml    |  4 ++--
 kernel/nativevalues.ml | 45 ++++++++++++++++++++----------------------
 2 files changed, 23 insertions(+), 26 deletions(-)

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 069fed3d1b43..27fa97d47884 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -180,9 +180,9 @@ let call_compiler ?profile:(profile=false) mlf_filename =
     match res with
     | Unix.WEXITED 0 -> ()
     | Unix.WEXITED _n | Unix.WSIGNALED _n | Unix.WSTOPPED _n ->
-      error_native_compiler_failed (Inl res) "During .mlf compilation: "
+      error_native_compiler_failed (Inl res) "During .native compilation: "
   with Unix.Unix_error (e,_,_) ->
-    error_native_compiler_failed (Inr e) "During .mlf compilation: "
+    error_native_compiler_failed (Inr e) "During .native compilation: "
   end; begin try
     debug_native_compiler (fun () -> Pp.str (ocamlfind ^ " " ^ (String.concat " " ocamlopt_args)));
     let res = if Dynlink.is_native then CUnix.sys_command ocamlfind ocamlopt_args else Unix.WEXITED 0 in
diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml
index e890abb0d22c..37af7fba9ed7 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -107,33 +107,30 @@ let ret_accu = Obj.repr (ref ())
 
 type accu_val = { acc_atm : atom; acc_arg : t list }
 
-(** Return a pointer to [caml_curry2_1] that is also recognized as an unscannable block *)
-external get_curry2_1 : unit -> Obj.t = "rocq_curry2_1_addr"
-
-(* an accumulator is a handcrafted closure, with:
-  Obj.with_tag Obj.closure_tag @@ Obj.repr (curry2_1, 2, data, accumulate) being a closure where:
-  - curry2_1 is the currified function pointer that will do all the work
-  - 2 indicates where the environment of the closure starts and its arity
-  - data is the first argument that curry2_1 will give to our accumulate function
-  - accumulate is a function that will be called when trying to apply the accumulator, with as first argument data and second the value it is applied to.
-    It is also unique to accumulators, allowing us to distinguish them from regular closures
-  
-  It is created manually so that we have guarantees on its layout (writing "accumulate data" would allow the compiler to do optimisations that would break everything)
- *)
-let curry2_1 = get_curry2_1 ()
-let rec accumulate data x =
-  if Obj.repr x == ret_accu then Obj.repr data
-  else
-    let data = { data with acc_arg = x :: data.acc_arg } in
-    let ans = Obj.with_tag Obj.closure_tag @@ Obj.repr (curry2_1, 2, data, accumulate) in
-    Obj.repr ans
-let mk_accu (a : atom) =
+(** an accumulator is a closure of the [accumulate] function created by the [build_accu] function. *)
+
+(** it is important to always use this function and never directly [accumulate] to prevent inlining of the accumulate function (which would mess up accumulator recognition) *)
+let rec build_accu dat =
+  let [@inline never] [@local never]
+    accumulate data x =
+    if Obj.repr x == ret_accu then Obj.repr data
+    else
+      let data = { data with acc_arg = x :: data.acc_arg } in
+      let ans = build_accu data in
+      assert (is_accu ans);
+      ans
+  in
+  Obj.repr @@ accumulate dat
+and mk_accu (a : atom) =
   let data = { acc_atm = a; acc_arg = [] } in
-  let ans = Obj.with_tag Obj.closure_tag @@ Obj.repr (curry2_1, 2, data, accumulate) in
+  let ans =  Obj.repr @@ build_accu data in
+  assert (is_accu ans);
   (Obj.magic ans : t)
+
 (** differentiates an accumulator from a closure. Should only be used on memory blocks. *)
-let is_accu v =
-  Obj.size v = 4 && Obj.field v 3 == Obj.repr accumulate
+and is_accu v =
+  let reference = Obj.repr @@ build_accu (Obj.magic 0) in (* we assume Ocaml will build all accumulators similarly *)
+  Obj.size v = Obj.size reference && Obj.field v 0 == Obj.field reference 0 (* we check the equality of the function pointer *)
 
 let get_accu (k : accumulator) =
   (Obj.magic k : Obj.t -> accu_val) ret_accu

From 79b43fca36838bf958a1e566941841a402f8dd36 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 9 Jul 2026 13:51:09 +0200
Subject: [PATCH 109/110] removed architectures checks as native_compute no
 longer uses inline assembly

---
 kernel/byterun/rocq_values.c     | 29 -----------------------------
 tools/configure/configure.ml     | 10 +---------
 tools/configure/dune             |  6 +-----
 tools/configure/rocq_configure.c | 17 -----------------
 4 files changed, 2 insertions(+), 60 deletions(-)
 delete mode 100644 tools/configure/rocq_configure.c

diff --git a/kernel/byterun/rocq_values.c b/kernel/byterun/rocq_values.c
index 93423e86a8f6..ffe2b6bbda4b 100644
--- a/kernel/byterun/rocq_values.c
+++ b/kernel/byterun/rocq_values.c
@@ -108,32 +108,3 @@ value rocq_tcode_array(value tcodes) {
   }
   CAMLreturn(res);
 }
-
-/* Keep the compile-time checks in sync with rocq_configure.c */
-
-#ifdef NO_NATIVE_COMPUTE
-
-value rocq_curry2_1_addr(value v) {
-  return Val_unit;
-}
-
-#elif defined(NO_NAKED_POINTERS)
-
-__attribute__((weak))
-void caml_curry2_1() {
-  abort();
-}
-
-value rocq_curry2_1_addr(value v) {
-  extern void caml_curry2_1() __attribute__((weak));
-  return (value)&caml_curry2_1;
-}
-
-#else // not NO_NAKED_POINTERS
-
-value rocq_curry2_1_addr(value v) {
-  extern void caml_curry2_1() __attribute__((weak));
-  return (value)&caml_curry2_1;
-}
-
-#endif
diff --git a/tools/configure/configure.ml b/tools/configure/configure.ml
index be0cf9f152e8..96789d869fb4 100644
--- a/tools/configure/configure.ml
+++ b/tools/configure/configure.ml
@@ -122,16 +122,8 @@ let resolve_caml () =
 let caml_version_nums { CamlConf.caml_version; _ } =
   generic_version_nums ~name:"the OCaml compiler" caml_version
 
-external native_available : unit -> bool = "rocq_native_available"
-
 let check_caml_version prefs caml_version caml_version_nums =
-  if prefs.nativecompiler <> NativeNo && not (native_available ()) then
-    let () = cprintf prefs "Your version of OCaml is %s." caml_version in
-    if caml_version_nums >= [5;0;0] then
-      die "You have enabled Rocq's native compiler, however it is not compatible with OCaml >= 5.0.0 on this architecture"
-    else
-      die "You have enabled Rocq's native compiler, however it is not compatible with your OCaml compiler"
-  else if caml_version_nums >= [4;14;0] then
+  if caml_version_nums >= [4;14;0] then
     cprintf prefs "You have OCaml %s. Good!" caml_version
   else
     let () = cprintf prefs "Your version of OCaml is %s." caml_version in
diff --git a/tools/configure/dune b/tools/configure/dune
index d6a97c5dcd2c..3e560be6e43d 100644
--- a/tools/configure/dune
+++ b/tools/configure/dune
@@ -1,11 +1,7 @@
 (library
  (name conf)
  (modules :standard \ configure)
- (libraries unix str)
- (foreign_stubs
-  (language c)
-  (names rocq_configure)
-  (flags :standard)))
+ (libraries unix str))
 
 (executable
  (name configure)
diff --git a/tools/configure/rocq_configure.c b/tools/configure/rocq_configure.c
deleted file mode 100644
index 05290dbf97e2..000000000000
--- a/tools/configure/rocq_configure.c
+++ /dev/null
@@ -1,17 +0,0 @@
-#include <caml/memory.h>
-
-/* Keep in sync with rocq_values.c */
-
-#if defined(__GNUC__) && defined(__amd64__)
-#elif defined(__GNUC__) && defined(__i386__)
-#elif defined(NO_NAKED_POINTERS)
-#define no_native_compute
-#endif
-
-value rocq_native_available(value dummy) {
-#ifdef no_native_compute
-  return Val_int(0);
-#else
-  return Val_int(1);
-#endif
-}

From 390c58641cc50eea6545be618ea2d76f78cfef9d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 13 Jul 2026 11:21:09 +0200
Subject: [PATCH 110/110] added more guardrails to the build_accu function to
 avoid optimisations that would break our accumulator detection

---
 kernel/nativevalues.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml
index 37af7fba9ed7..830de7c9df0c 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -110,7 +110,7 @@ type accu_val = { acc_atm : atom; acc_arg : t list }
 (** an accumulator is a closure of the [accumulate] function created by the [build_accu] function. *)
 
 (** it is important to always use this function and never directly [accumulate] to prevent inlining of the accumulate function (which would mess up accumulator recognition) *)
-let rec build_accu dat =
+let [@inline never] [@local never] rec build_accu dat =
   let [@inline never] [@local never]
     accumulate data x =
     if Obj.repr x == ret_accu then Obj.repr data