From b9d8ed6089b436306e5e5a3e525f0de980644e35 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 13:43:41 +0200
Subject: [PATCH 01/76] 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 33e6df32b18c910075a55857f8400f84c74d971e Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 13:46:41 +0200
Subject: [PATCH 02/76] Created placeholder functions for compiling to mlf

---
 kernel/nativecode.ml  | 245 ++++++++++++++++++++++++++++++++++++++++++
 kernel/nativecode.mli |   2 +
 kernel/nativeconv.ml  |   2 +
 kernel/nativelib.ml   |  26 +++++
 kernel/nativelib.mli  |   7 ++
 kernel/uint63.mli     |   2 +
 kernel/uint63_31.ml   |   3 +
 kernel/uint63_63.ml   |   3 +
 8 files changed, 290 insertions(+)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 4d3abb6a5900..04c5664ef015 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 i)
+    (* | MLfloat f -> Format.fprintf fmt "(%s)" (Float64.compile f)
+    | MLstring s -> Format.fprintf fmt "(%s)" (Pstring.compile s) *)
+    | _ -> ()
+    (* | 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
+    | 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" *)
+  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,52 @@ let pp_global fmt g =
   | Gcomment s ->
       Format.fprintf fmt "@[(* %s *)@]@." s
 
+let pp_global_mlf fmt g =
+  match g with
+  | Glet (gn, c) ->
+      let _ = c in
+      Format.fprintf fmt "@[($%a 0)@]@\n@." pp_gname gn
+      (* 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 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
+  | 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..427762aa1677 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 "@[(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/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 a8e57bdb118d513e5862f056fad35df7e647e1fc Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 13:59:01 +0200
Subject: [PATCH 03/76] 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      | 10 +++++-----
 kernel/pstring.ml         |  3 +++
 kernel/pstring.mli        |  3 +++
 6 files changed, 19 insertions(+), 5 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 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 04c5664ef015..b462e1d0adaf 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2039,9 +2039,11 @@ 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 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)
+    | MLsequence(l1,l2) ->
+        Format.fprintf fmt "@[(seq (%a) (%a))@]" pp_mllam l1 pp_mllam l2
     | _ -> ()
     (* | MLlocal ln -> Format.fprintf fmt "@[%a@]" pp_lname ln
     | MLglobal g -> Format.fprintf fmt "@[%a@]" pp_gname g
@@ -2074,8 +2076,6 @@ let pp_mllam_mlf fmt l =
           (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
-    | 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 *)
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

From 94ae0655bf0c6e417bf521841619735529d9529f Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 16:55:37 +0200
Subject: [PATCH 04/76] the generated mlf code is now syntaxically correct

---
 kernel/nativecode.ml | 23 +++++++++--------------
 kernel/nativelib.ml  |  4 ++--
 2 files changed, 11 insertions(+), 16 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index b462e1d0adaf..e36dd9c34176 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -2044,7 +2044,7 @@ let pp_mllam_mlf fmt l =
     | 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) ->
@@ -2309,31 +2309,26 @@ let pp_global fmt g =
 let pp_global_mlf fmt g =
   match g with
   | Glet (gn, c) ->
-      let _ = c in
-      Format.fprintf fmt "@[($%a 0)@]@\n@." pp_gname gn
-      (* 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) ->
+      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
+        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 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
+    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
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 427762aa1677..788e5880025e 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -115,9 +115,9 @@ 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";
+  Format.fprintf fmt "@[(module@]@\n";
   List.iter (pp_global_mlf fmt) (header@code);
-  Format.fprintf fmt "@[(export))]@.";
+  Format.fprintf fmt "@[(_ 0) (export))@]@.";
   close_out ch_out
 
 let error_native_compiler_failed e =

From cb7f59769ea8a2b0f7f766c7afc15c68e2689489 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 17:23:56 +0200
Subject: [PATCH 05/76] 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 032618daf6b129f7a72a66d6e05c44f123255e3e Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 5 Jun 2026 18:06:14 +0200
Subject: [PATCH 06/76] 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 90d59b16c6689f3f0367a15c181fcc28ba333fa4 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 10:23:08 +0200
Subject: [PATCH 07/76] 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 cb50f17340894a46c76be507de77c7337da332c6 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 10:38:28 +0200
Subject: [PATCH 08/76] 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 8371873659d4f236f7cddb3937a49daff68db8de Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 11:16:13 +0200
Subject: [PATCH 09/76] 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 016f56be3fcd1491558a4fcd4a5bd5c6af25d979 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 14:33:43 +0200
Subject: [PATCH 10/76] 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 b7b2e58d4a7777e2a4ad89aa60bbfeaa318fa973 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 14:54:31 +0200
Subject: [PATCH 11/76] 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 71ce8887fb7fa1fe8af8fb9b4d102393f16eb336 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 15:15:10 +0200
Subject: [PATCH 12/76] 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 3c82ab50f536c4e242f468f41625655ff6d113b2 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 15:33:12 +0200
Subject: [PATCH 13/76] 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 30968882253b11d5f6efa49147313416bffb47c4 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 15:41:19 +0200
Subject: [PATCH 14/76] 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 e44f3fa88bd30374089ec6a29f7c93d2e87d8ac3 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:04:00 +0200
Subject: [PATCH 15/76] 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 986d9099def141852d94912abeb5e54142a87bd0 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:12:48 +0200
Subject: [PATCH 16/76] 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 3cb4324d30b25f74a09c5b21307eb7eb709ca152 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:15:58 +0200
Subject: [PATCH 17/76] 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 ae5d9df68ec98702487e32eed1d7c0de20123c64 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:28:08 +0200
Subject: [PATCH 18/76] 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 9758486406f61ba2a66c34b283e6abee35611325 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 16:42:37 +0200
Subject: [PATCH 19/76] 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 8c7d09048764d966288a3c49bde85f53921b2ca3 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 8 Jun 2026 17:04:13 +0200
Subject: [PATCH 20/76] 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 65bcffb9685500b644b449c756d80fae420acfb1 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:09:42 +0200
Subject: [PATCH 21/76] 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 4958f1c38c1b68181e113589971e00652736a010 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:10:08 +0200
Subject: [PATCH 22/76] 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 4418d867d749db9971620ad2aea5b02f9ec768a6 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:23:12 +0200
Subject: [PATCH 23/76] 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 a69e51a526abfc6037effd90c3e9c45cc40d050e Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:35:48 +0200
Subject: [PATCH 24/76] 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 75dac4f0ac538a0b145141a6a7ff4466bf7577a0 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 10:53:37 +0200
Subject: [PATCH 25/76] 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 8b53077165341a755af76207250fe86742ca2205 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 11:13:59 +0200
Subject: [PATCH 26/76] 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 cbfbc6566dbadc7159c7b3182175deb238e0be56 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 11:49:47 +0200
Subject: [PATCH 27/76] 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 9b61c4f582fa5998250b17a8f6c085c8cd37ac59 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 14:09:12 +0200
Subject: [PATCH 28/76] 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 ca7c35715dc75bfc4dc89e74a6760a1d6308c1e1 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 14:56:50 +0200
Subject: [PATCH 29/76] 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 373d76d4d5e55b8c239a12777cb3cbde6978fc45 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 15:30:01 +0200
Subject: [PATCH 30/76] 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 a1da20feda39c0bf91faa981f388fc76aa295e3b Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 15:31:38 +0200
Subject: [PATCH 31/76] 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 a79869130323fa7fef739eb75610f8c3e6274676 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 16:20:36 +0200
Subject: [PATCH 32/76] 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 e51d2a4ee569e2778c8896e0844023308a37451a Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 9 Jun 2026 18:37:23 +0200
Subject: [PATCH 33/76] 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 5e0e06e3029e1bd39b3d4993526d3f9a3d80bd54 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 10:16:16 +0200
Subject: [PATCH 34/76] 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 ae06017380f717405eac38170841c1a40eddb881 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 10:21:41 +0200
Subject: [PATCH 35/76] 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 be19eed3a5152c08fc478069963ecb77f4f3c9c8 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 10:22:01 +0200
Subject: [PATCH 36/76] 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 8d8948b40ee2a6e700f7acaf57b838d8b380f086 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 10:37:05 +0200
Subject: [PATCH 37/76] 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 87256637e94052fc7ae080d3a0244e04a9b9eab7 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 13:52:24 +0200
Subject: [PATCH 38/76] imports from generated ml file now imports from the
 equivalent mlf file

---
 kernel/nativecode.ml | 24 ++++++++++++++++++++++--
 1 file changed, 22 insertions(+), 2 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

From 1363bea2b42e7ba96362758f944dcc53084a4ab0 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 15:26:00 +0200
Subject: [PATCH 39/76] writing a mlf program now also generate a .mli file
 specifying its interface

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

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..de68b1c7ba67 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

From 7c6ad823b1892ee6607f3ac3a33a2a41674a516c Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 15:28:03 +0200
Subject: [PATCH 40/76] The mlf compilation now works

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

diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index de68b1c7ba67..3e30befbd41c 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -206,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
@@ -233,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
@@ -254,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 47d769d80ff5f409571362b4ab35787e52407cec Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 16:08:52 +0200
Subject: [PATCH 41/76] 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 78386063f7653cd559b290b220102658f2787697 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 16:31:16 +0200
Subject: [PATCH 42/76] 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 ce8db18dc5c6c77ef2e251c99048662b605a7b10 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 10 Jun 2026 17:30:37 +0200
Subject: [PATCH 43/76] 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 5fdd3d69389c3ddf7e9847af77acf16c95f3d295 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 11:28:02 +0200
Subject: [PATCH 44/76] 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 edf6f4ef9040b01d7d0de40f6b281e05f0e5857a Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 13:22:09 +0200
Subject: [PATCH 45/76] 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 34c00eeebc01c5310a8e7408b0d11a80413ba884 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 13:44:54 +0200
Subject: [PATCH 46/76] 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 f8b276ee2ee6de961951b4b5992cbdf906970d43 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 15:58:23 +0200
Subject: [PATCH 47/76] 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 30775d3c33929443c335e489a50880a966b42c0d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Thu, 11 Jun 2026 16:31:57 +0200
Subject: [PATCH 48/76] .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 6bfea201e30f93b8d6c7c29549612b5b4efcd284 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 12 Jun 2026 10:02:58 +0200
Subject: [PATCH 49/76] 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 6f9b70fcbe97d20622a5c183f2440677daf128b0 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 12 Jun 2026 14:01:41 +0200
Subject: [PATCH 50/76] 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 984529bd24051842cb908946b635898f9f7d2157 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Sat, 13 Jun 2026 14:13:50 +0200
Subject: [PATCH 51/76] 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 ca19c09ac8b86e01882acd258f944f1e83275924 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 15 Jun 2026 10:16:35 +0200
Subject: [PATCH 52/76] 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 de0fe9628dec37267c547f371254fa489eb2f9b1 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 15 Jun 2026 14:26:01 +0200
Subject: [PATCH 53/76] 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 f888a51f006631a12a3e6f863236f67f83ff75b9 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 15 Jun 2026 14:29:16 +0200
Subject: [PATCH 54/76] 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 c731fa390355ae205cf63489886f4a715759c31f Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Mon, 15 Jun 2026 15:31:22 +0200
Subject: [PATCH 55/76] 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 fb1135e49c9e7391e7b41ee71a1d173a7e682c04 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 10:04:20 +0200
Subject: [PATCH 56/76] 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 20f7b060f6d0ef21ee2f8edc24a54f4feff7d359 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 10:17:44 +0200
Subject: [PATCH 57/76] 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 5da2bc1add347648821ab4a01d1997cf48d1ffac Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 10:22:52 +0200
Subject: [PATCH 58/76] 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 69ba091eeed59bdd68d3dd480737c252cd476831 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 11:22:15 +0200
Subject: [PATCH 59/76] 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 6e46e6290edda7eb9e5d80e707ae85d81d4057fa Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 11:27:05 +0200
Subject: [PATCH 60/76] 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 f0f9fbdbac6705768ccad90deef9911e4fda8cf8 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 11:30:36 +0200
Subject: [PATCH 61/76] 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 4f54bc514bfa17f519b133c876b894751adf7257 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 11:35:36 +0200
Subject: [PATCH 62/76] 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 456c5d5adecf5044160e5460d97b8d2f57e1342d Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 13:33:17 +0200
Subject: [PATCH 63/76] 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 46f71913489123583993be606879b67591e75b3a Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:09:18 +0200
Subject: [PATCH 64/76] 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 490074af939f86ccbae00a53d27ad31e779efd66 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:26:26 +0200
Subject: [PATCH 65/76] 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 2fc7811bb682f9076ed38fe173f0713ac8d47aef Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:40:05 +0200
Subject: [PATCH 66/76] 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 6863127ab810b80caa09f7e5aca9c57ca42fd09c Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:42:27 +0200
Subject: [PATCH 67/76] 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 958a00605742eb2354fecc3f3ebc341311d29a91 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Tue, 16 Jun 2026 15:54:23 +0200
Subject: [PATCH 68/76] 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 f5bd3148f60462b5024f7c7f0f5b705eeb15e294 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 11:40:32 +0200
Subject: [PATCH 69/76] added a MLmatch_noaccu contructor to mllambda

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

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index b52c2601b839..ee2538a84403 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -452,6 +452,8 @@ type mllambda =
   | MLif           of mllambda * mllambda * mllambda
   | MLmatch        of annot_sw * mllambda * mllambda * mllam_branches
                               (* argument, prefix, accu branch, branches *)
+  | MLmatch_noaccu        of annot_sw * mllambda * mllam_branches
+                              (* argument, prefix, branches *)
   | MLconstruct    of string * inductive * int * mllambda array
                    (* prefix, inductive name, tag, arguments *)
   | MLint          of int
@@ -522,6 +524,10 @@ 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 (annot1, c1, br1), MLmatch_noaccu (annot2, c2, br2) ->
+      eq_annot_sw annot1 annot2 &&
+      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 &&
@@ -548,7 +554,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
 
@@ -616,31 +622,35 @@ 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 (combine3 hannot hc haccu) br)
+  | MLmatch_noaccu (annot, c, br) ->
+      let hannot = hash_annot_sw annot in
+      let hc = hash_mllambda gn n env c in
+      combinesmall 10 (hash_mllam_branches gn n env (combine hannot 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) =
@@ -710,6 +720,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
@@ -1609,6 +1634,9 @@ let subst s l =
       | MLmatch(annot,a,accu,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
           MLmatch(annot,a,aux accu, Array.map auxb bs)
+      | MLmatch_noaccu(annot,a,bs) ->
+          let auxb (cargs,body) = (cargs,aux body) in
+          MLmatch_noaccu(annot,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)
@@ -1720,6 +1748,9 @@ let optimize gdef l =
     | MLmatch(annot,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_noaccu(annot,a,bs) ->
+        let opt_b (cargs,body) = (cargs,optimize s body) in
+        MLmatch_noaccu(annot, 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)
@@ -1899,6 +1930,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
@@ -2017,6 +2052,9 @@ let pp_cofix fmt (gn, s) =
       | MLmatch(annot,a,accu,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
           MLmatch(annot,a,aux accu, Array.map auxb bs)
+      | MLmatch_noaccu(annot,a,bs) ->
+          let auxb (cargs,body) = (cargs,aux body) in
+          MLmatch_noaccu(annot,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 9ddba0a26edd91fd0ae88fbbe8f8919e033e94c5 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 11:48:33 +0200
Subject: [PATCH 70/76] removed annotations from matches as they are no longer
 needed

---
 kernel/nativecode.ml | 92 +++++++++++++++++++++-----------------------
 1 file changed, 43 insertions(+), 49 deletions(-)

diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index ee2538a84403..5043917c68fe 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -450,9 +450,9 @@ 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 *)
-  | MLmatch_noaccu        of annot_sw * mllambda * mllam_branches
+  | MLmatch_noaccu        of mllambda * mllam_branches
                               (* argument, prefix, branches *)
   | MLconstruct    of string * inductive * int * mllambda array
                    (* prefix, inductive name, tag, arguments *)
@@ -519,13 +519,11 @@ 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
-  | MLmatch_noaccu (annot1, c1, br1), MLmatch_noaccu (annot2, c2, br2) ->
-      eq_annot_sw annot1 annot2 &&
+  | 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) ->
@@ -617,15 +615,13 @@ 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)
-  | MLmatch_noaccu (annot, c, br) ->
-      let hannot = hash_annot_sw annot 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 (combine hannot hc) br)
+      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
@@ -705,7 +701,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 =
@@ -720,7 +716,7 @@ let fv_lam l =
             cargs bind in
         aux body bind fv in
       Array.fold_right fv_bs bs fv
-    | MLmatch_noaccu(_,p,bs) ->
+    | MLmatch_noaccu(p,bs) ->
       let fv = aux p bind fv in
       let fv_bs (cargs, body) fv =
         let bind =
@@ -794,13 +790,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) ->
@@ -831,10 +827,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) ->
@@ -1631,12 +1627,12 @@ 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_noaccu(annot,a,bs) ->
+          MLmatch(a,aux accu, Array.map auxb bs)
+      | MLmatch_noaccu(a,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
-          MLmatch_noaccu(annot,a, Array.map auxb bs)
+          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)
@@ -1684,13 +1680,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 =
@@ -1727,9 +1723,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)
 
@@ -1741,16 +1737,16 @@ 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_noaccu(annot,a,bs) ->
+        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(annot, optimize s a, Array.map opt_b bs)
+        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)
@@ -1766,9 +1762,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
@@ -1926,11 +1922,11 @@ 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
-    | MLmatch_noaccu (_, c, br) ->
+    | MLmatch_noaccu (c, br) ->
       Format.fprintf fmt
         "@[(let ($matched_value %a) (switch $matched_value @\n@ @ @[%a@]))@]"
         pp_mllam c pp_branches br
@@ -2049,12 +2045,12 @@ 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_noaccu(annot,a,bs) ->
+          MLmatch(a,aux accu, Array.map auxb bs)
+      | MLmatch_noaccu(a,bs) ->
           let auxb (cargs,body) = (cargs,aux body) in
-          MLmatch_noaccu(annot,a, Array.map auxb bs)
+          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)
@@ -2106,16 +2102,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
@@ -2297,8 +2293,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
@@ -2310,7 +2304,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 b293a835c955663fa9a5434607b2355eb4c7125f Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 11:53:23 +0200
Subject: [PATCH 71/76] 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 5043917c68fe..761e2017e661 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -771,7 +771,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 *)
@@ -790,8 +790,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
@@ -827,7 +827,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
@@ -923,8 +923,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
@@ -1419,7 +1419,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
@@ -1762,7 +1762,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
@@ -2102,12 +2102,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
@@ -2139,7 +2139,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
@@ -2152,7 +2152,7 @@ let pp_global_interface fmt g =
   | Gtblnorm (_,_,_)
   | Gtblcofix (_,_,_)
   | Gtblfixtype (_,_,_)
-  | Gletcase (_,_,_,_,_,_)
+  | Gletcase (_,_,_,_,_)
   | Glet (_,_) ->
     begin match global_to_mlf_name g with
     | None -> ()

From 580cd79c5d1c9fe1f7784829a946ab8dcfccb3f1 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 14:13:10 +0200
Subject: [PATCH 72/76] vendor malfunction

---
 malfunction/.gitignore                       |   3 +
 malfunction/.travis-ci.sh                    |   1 +
 malfunction/.travis.yml                      |  10 +
 malfunction/CHANGES.md                       |  51 +
 malfunction/LICENSE.md                       | 212 ++++
 malfunction/README.md                        |  46 +
 malfunction/docs/helloworld.mlf              |   3 +
 malfunction/docs/print_args.mlf              |  24 +
 malfunction/docs/spec.md                     | 376 +++++++
 malfunction/dune-project                     |   2 +
 malfunction/dune-workspace.all               |  24 +
 malfunction/dune-workspace.quick             |   5 +
 malfunction/examples/.gitignore              |   4 +
 malfunction/examples/dune                    |   8 +
 malfunction/examples/helloworld.mlf          |   7 +
 malfunction/examples/primrec.ml              | 154 +++
 malfunction/malfunction.opam                 |  24 +
 malfunction/src/dune                         |  21 +
 malfunction/src/malfunction.ml               | 128 +++
 malfunction/src/malfunction.mli              | 101 ++
 malfunction/src/malfunction_compat.cppo.ml   | 208 ++++
 malfunction/src/malfunction_compiler.ml      | 987 +++++++++++++++++++
 malfunction/src/malfunction_compiler.mli     |  18 +
 malfunction/src/malfunction_interpreter.ml   | 286 ++++++
 malfunction/src/malfunction_interpreter.mli  |  14 +
 malfunction/src/malfunction_main.ml          | 110 +++
 malfunction/src/malfunction_parser.ml        | 285 ++++++
 malfunction/src/malfunction_parser.mli       |  12 +
 malfunction/src/malfunction_sexp.mli         |  14 +
 malfunction/src/malfunction_sexp.mll         |  93 ++
 malfunction/test/basic.test                  |  20 +
 malfunction/test/conversions.test            |  25 +
 malfunction/test/dune                        |  10 +
 malfunction/test/evalorder.test              |  27 +
 malfunction/test/factorial.test              |  10 +
 malfunction/test/float.test                  |  32 +
 malfunction/test/issue36/dune                |  10 +
 malfunction/test/issue36/expected.txt        |   3 +
 malfunction/test/issue36/main.ml             |  55 ++
 malfunction/test/issue36/run.sh              |   6 +
 malfunction/test/issue36/test_bytestring.mlf |  20 +
 malfunction/test/issue36/test_bytestring.mli |   5 +
 malfunction/test/lazy.test                   |  37 +
 malfunction/test/prim.test                   |  13 +
 malfunction/test/shifts.test                 |  30 +
 malfunction/test/test.ml                     | 243 +++++
 malfunction/test/vector.test                 |  15 +
 malfunction/test_cli/dune                    |   8 +
 malfunction/test_cli/helloworld.mlf          |   3 +
 malfunction/test_cli/main.ml                 |   4 +
 malfunction/test_cli/module.mlf              |  14 +
 malfunction/test_cli/module.mli              |   5 +
 malfunction/test_cli/test.sh                 |  63 ++
 malfunction/test_cli/test.t                  |  28 +
 54 files changed, 3917 insertions(+)
 create mode 100644 malfunction/.gitignore
 create mode 100644 malfunction/.travis-ci.sh
 create mode 100644 malfunction/.travis.yml
 create mode 100644 malfunction/CHANGES.md
 create mode 100644 malfunction/LICENSE.md
 create mode 100644 malfunction/README.md
 create mode 100644 malfunction/docs/helloworld.mlf
 create mode 100644 malfunction/docs/print_args.mlf
 create mode 100644 malfunction/docs/spec.md
 create mode 100644 malfunction/dune-project
 create mode 100644 malfunction/dune-workspace.all
 create mode 100644 malfunction/dune-workspace.quick
 create mode 100644 malfunction/examples/.gitignore
 create mode 100644 malfunction/examples/dune
 create mode 100644 malfunction/examples/helloworld.mlf
 create mode 100644 malfunction/examples/primrec.ml
 create mode 100644 malfunction/malfunction.opam
 create mode 100644 malfunction/src/dune
 create mode 100644 malfunction/src/malfunction.ml
 create mode 100644 malfunction/src/malfunction.mli
 create mode 100644 malfunction/src/malfunction_compat.cppo.ml
 create mode 100644 malfunction/src/malfunction_compiler.ml
 create mode 100644 malfunction/src/malfunction_compiler.mli
 create mode 100644 malfunction/src/malfunction_interpreter.ml
 create mode 100644 malfunction/src/malfunction_interpreter.mli
 create mode 100644 malfunction/src/malfunction_main.ml
 create mode 100644 malfunction/src/malfunction_parser.ml
 create mode 100644 malfunction/src/malfunction_parser.mli
 create mode 100644 malfunction/src/malfunction_sexp.mli
 create mode 100644 malfunction/src/malfunction_sexp.mll
 create mode 100644 malfunction/test/basic.test
 create mode 100644 malfunction/test/conversions.test
 create mode 100644 malfunction/test/dune
 create mode 100644 malfunction/test/evalorder.test
 create mode 100644 malfunction/test/factorial.test
 create mode 100644 malfunction/test/float.test
 create mode 100644 malfunction/test/issue36/dune
 create mode 100644 malfunction/test/issue36/expected.txt
 create mode 100644 malfunction/test/issue36/main.ml
 create mode 100755 malfunction/test/issue36/run.sh
 create mode 100644 malfunction/test/issue36/test_bytestring.mlf
 create mode 100644 malfunction/test/issue36/test_bytestring.mli
 create mode 100644 malfunction/test/lazy.test
 create mode 100644 malfunction/test/prim.test
 create mode 100644 malfunction/test/shifts.test
 create mode 100644 malfunction/test/test.ml
 create mode 100644 malfunction/test/vector.test
 create mode 100644 malfunction/test_cli/dune
 create mode 100644 malfunction/test_cli/helloworld.mlf
 create mode 100644 malfunction/test_cli/main.ml
 create mode 100644 malfunction/test_cli/module.mlf
 create mode 100644 malfunction/test_cli/module.mli
 create mode 100755 malfunction/test_cli/test.sh
 create mode 100644 malfunction/test_cli/test.t

diff --git a/malfunction/.gitignore b/malfunction/.gitignore
new file mode 100644
index 000000000000..b55377bc64f5
--- /dev/null
+++ b/malfunction/.gitignore
@@ -0,0 +1,3 @@
+_build
+malfunction.install
+.merlin
diff --git a/malfunction/.travis-ci.sh b/malfunction/.travis-ci.sh
new file mode 100644
index 000000000000..4ac9a7a02169
--- /dev/null
+++ b/malfunction/.travis-ci.sh
@@ -0,0 +1 @@
+bash -ex .travis-opam.sh
diff --git a/malfunction/.travis.yml b/malfunction/.travis.yml
new file mode 100644
index 000000000000..1198db5c6c1f
--- /dev/null
+++ b/malfunction/.travis.yml
@@ -0,0 +1,10 @@
+language: c
+sudo: required
+install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh
+script: bash -ex .travis-ci.sh
+env:
+  global:
+  - PACKAGE=malfunction
+  matrix:
+  - OCAML_VERSION=4.03.0+flambda
+  - OCAML_VERSION=4.04.0+flambda
diff --git a/malfunction/CHANGES.md b/malfunction/CHANGES.md
new file mode 100644
index 000000000000..f2bcf0e7a320
--- /dev/null
+++ b/malfunction/CHANGES.md
@@ -0,0 +1,51 @@
+v0.7 (10th November 2024)
+---------------------
+
+Support for OCaml 5.3
+Bytecode compilation mode (to cmo files)
+
+v0.6 (23rd June 2024)
+---------------------
+
+Support for OCaml 5.2
+Bugfix for an invalid optimisation on OCaml >= 4.14
+New options for using ocamlfind packages
+
+v0.5 (22nd May 2023)
+--------------------
+
+Support for OCaml 5.0.0
+Dropped support for OCaml < 4.08
+
+v0.4 (23rd September 2022)
+--------------------------
+
+Support for OCaml 4.09 to 4.14
+Recursive lazy bindings now supported
+
+v0.3 (24th April 2019)
+---------------------
+
+Support for OCaml 4.06, 4.07 and 4.08+beta2
+Support for non-Flambda builds
+Dune support (replacing jbuilder)
+Lazy evaluation (lazy E and force E)
+Floating-point numbers
+
+v0.2.1 (3rd October 2017)
+---------------------
+
+Fix build bug with OCaml 4.04.2
+
+
+v0.2 (12th September 2017)
+---------------------
+
+Support for OCaml 4.05.0
+Now builds with jbuilder
+
+
+v0.1 (20th June 2016)
+---------------------
+
+Initial release
diff --git a/malfunction/LICENSE.md b/malfunction/LICENSE.md
new file mode 100644
index 000000000000..d0ab1ba1c08f
--- /dev/null
+++ b/malfunction/LICENSE.md
@@ -0,0 +1,212 @@
+Copyright (c) 2016 Stephen Dolan
+
+Malfunction is released under the same terms as OCaml.
+
+The OCaml license is reproduced verbatim below. The exception
+referring to the "OCaml Core System" also applies to Malfunction.
+
+----------------------------------------------------------------------
+
+In the following, "the OCaml Core System" refers to all files marked
+"Copyright INRIA" in this distribution.
+
+The OCaml Core System is distributed under the terms of the
+GNU Lesser General Public License (LGPL) version 2.1 (included below).
+
+As a special exception to the GNU Lesser General Public License, you
+may link, statically or dynamically, a "work that uses the OCaml Core
+System" with a publicly distributed version of the OCaml Core System
+to produce an executable file containing portions of the OCaml Core
+System, and distribute that executable file under terms of your
+choice, without any of the additional requirements listed in clause 6
+of the GNU Lesser General Public License.  By "a publicly distributed
+version of the OCaml Core System", we mean either the unmodified OCaml
+Core System as distributed by INRIA, or a modified version of the
+OCaml Core System that is distributed under the conditions defined in
+clause 2 of the GNU Lesser General Public License.  This exception
+does not however invalidate any other reasons why the executable file
+might be covered by the GNU Lesser General Public License.
+
+----------------------------------------------------------------------
+
+GNU LESSER GENERAL PUBLIC LICENSE
+
+Version 2.1, February 1999
+
+Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL.  It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+Preamble
+
+The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users.
+
+This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below.
+
+When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things.
+
+To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it.
+
+For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights.
+
+We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library.
+
+To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others.
+
+Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license.
+
+Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs.
+
+When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library.
+
+We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances.
+
+For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License.
+
+In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system.
+
+Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library.
+
+The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run.
+
+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you".
+
+A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables.
+
+The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".)
+
+"Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library.
+
+Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does.
+
+1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library.
+
+You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee.
+
+2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+    b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change.
+    c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License.
+    d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License.
+
+3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices.
+
+Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy.
+
+This option is useful when you wish to copy part of the code of the Library into a program that is not a library.
+
+4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange.
+
+If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code.
+
+5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License.
+
+However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables.
+
+When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law.
+
+If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.)
+
+Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself.
+
+6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications.
+
+You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things:
+
+    a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.)
+    b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with.
+    c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution.
+    d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place.
+    e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy.
+
+For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable.
+
+It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute.
+
+7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above.
+    b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work.
+
+8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance.
+
+9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it.
+
+10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License.
+
+11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice.
+
+This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License.
+
+12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License.
+
+13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation.
+
+14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally.
+
+NO WARRANTY
+
+15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+END OF TERMS AND CONDITIONS
+
+How to Apply These Terms to Your New Libraries
+
+If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License).
+
+To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found.
+
+one line to give the library's name and an idea of what it does.
+Copyright (C) year  name of author
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names:
+
+Yoyodyne, Inc., hereby disclaims all copyright interest in
+the library `Frob' (a library for tweaking knobs) written
+by James Random Hacker.
+
+signature of Ty Coon, 1 April 1990
+Ty Coon, President of Vice
+
+That's all there is to it!
+
+--------------------------------------------------
diff --git a/malfunction/README.md b/malfunction/README.md
new file mode 100644
index 000000000000..2940bfaeed08
--- /dev/null
+++ b/malfunction/README.md
@@ -0,0 +1,46 @@
+**Malfunction** is a high-performance, low-level untyped program
+representation, designed as a target for compilers of functional
+programming languages.
+
+**Malfunction** is a revolting hack, exposing bits of the OCaml
+compiler's guts that were never meant to see the light of day.
+
+"Hello, World" looks like this:
+
+    (module
+      (_ (apply (global $Stdlib $print_string) "Hello, world!\n"))
+      (export))
+
+Malfunction requires OCaml (at least version 4.04.0, and you may see
+better performance with flambda enabled), which you should install
+using [OPAM](https://opam.ocaml.org). Then, install malfunction using:
+
+    opam pin add malfunction git://github.com/stedolan/malfunction.git
+
+You can then compile and run the above example with:
+
+    malfunction compile docs/helloworld.mlf -o hello
+    ./hello
+
+The syntax is based on s-expressions, and is designed to be easy to
+correctly generate, rather than to be particularly beautiful. For
+instance, there are no reserved words: all user-defined identifiers
+must be prefixed with `$`.
+
+Files are compiled as OCaml modules, and may import values from OCaml
+(e.g. `Stdlib.print_string` in the example above) and export
+values to OCaml (using the `export` form). Modules written in
+malfunction may be combined with an `mli` file written in OCaml.
+
+Malfunction makes no effort to check types. Typical programs do go
+wrong. Compilers targeting Malfunction need to convince themselves
+that their output won't go wrong, but don't need to explain
+their reasoning.
+
+For more, read the [spec](./docs/spec.md), or the
+[abstract submitted to the ML Workshop](https://stedolan.net/talks/2016/malfunction/malfunction.pdf),
+or [some examples](./docs)
+
+There's also an
+[experimental backend](https://github.com/stedolan/idris-malfunction)
+for the dependently typed language [Idris](http://idris-lang.org).
diff --git a/malfunction/docs/helloworld.mlf b/malfunction/docs/helloworld.mlf
new file mode 100644
index 000000000000..4ed219b97502
--- /dev/null
+++ b/malfunction/docs/helloworld.mlf
@@ -0,0 +1,3 @@
+(module
+  (_ (apply (global $Stdlib $print_string) "Hello, world!\n"))
+  (export))
diff --git a/malfunction/docs/print_args.mlf b/malfunction/docs/print_args.mlf
new file mode 100644
index 000000000000..a15dc4d7ad94
--- /dev/null
+++ b/malfunction/docs/print_args.mlf
@@ -0,0 +1,24 @@
+; This program prints its command-line arguments to stdout
+(module
+
+  ($argv (global $Sys $argv))
+
+  ; $argv is a vector, turn it into a list
+  ; lists are either the integer 0 (nil) or a block of tag 0 (cons)
+  ($argc (length $argv))
+  (rec
+    ($argv_to_list (lambda ($i)
+      (if (== $i $argc)
+        0
+        (block (tag 0) (load $argv $i)
+          (apply $argv_to_list (+ $i 1)))))))
+  ($argv_list (apply $argv_to_list 1)) ; Start at 1 to skip argv[0]
+
+  ; Since this is the standard OCaml list representation, we may
+  ; use standard library functions
+
+  ($print (lambda ($s)
+    (apply (global $Stdlib $print_endline) $s)))
+  (_ (apply (global $List $iter) $print $argv_list))
+
+  (export))
\ No newline at end of file
diff --git a/malfunction/docs/spec.md b/malfunction/docs/spec.md
new file mode 100644
index 000000000000..6c7275aa4554
--- /dev/null
+++ b/malfunction/docs/spec.md
@@ -0,0 +1,376 @@
+# Syntax and semantics of Malfunction
+
+**Note**: This "specification" is preliminary at best, and subject to
+  change when bugs are found, features are added, or I'm bored.
+
+Malfunction does only very basic checking of syntax when loading a
+program. For any program which passes the syntax checker, Malfunction
+should do one of the following:
+
+  - Produce exactly the same result in the intepreter (`malfunction eval`) and compiler (`malfunction compile`)
+  - Report it as having undefined behaviour in the interpreter (`malfunction eval`)
+  - Fail to terminate in both the interpreter and the compiler
+
+The behaviour of the interpreter and compiler should agree with the
+text below, although for a more precise specification you should look
+at the
+[definition of the interpreter](../src/malfunction_interpreter.ml),
+which is straightforward (no bytecode or other efficiency tricks, just
+syntax-directed execution).
+
+It's not necessarily a bug in Malfunction if a program compiles with
+`malfunction compile` and then crashes at runtime. This specification
+intentionally leaves much behaviour undefined, so you should count
+yourself lucky if a program like `(field 0 0)` is well-behaved enough
+to merely crash.
+
+However, the interpreter should detect *all* undefined behaviour
+(Malfunction's semantics are kept quite simple to ensure that this is
+easy). If a program runs to completion in the intepreter producing a
+result, it is a bug in Malfunction if the compiled version of the same
+program either crashes or produces a different value, and
+[should be reported](https://github.com/stedolan/malfunction/issues).
+
+This doesn't apply to programs which link with OCaml code: if you use
+`(global ...)` to call an OCaml function, it's up to you to ensure
+that you pass inputs that won't make it crash, and the interpreter
+will (currently) be of no help checking this.
+
+This file contains various examples of expected output of sample
+programs. These are run as part of the testsuite, as are the other
+programs in the [test directory](../test).
+
+## Basic syntax
+
+Comments begin with `;` and continue to the end of the line.
+
+A Malfunction input file consists of a single
+s-expression. S-expressions (or "sexps") consist of `(`, a sequence of
+whitespace-separated elements, and `)`, where elements are:
+  - *Atoms*: sequences of ASCII letters, digits, or symbols (the exact set of allowed symbols isn't quite nailed down yet)
+  - *Variables*: `\$` followed by an atom
+  - *Strings*: double-quoted, with embedded `\` or `"` backslash-escaped
+  - *s-expressions*: nested arbitrarily
+
+The top-level sexp must begin with the atom `module`, followed
+by a list of bindings (described under `let`, below), followed by an
+sexp beginning with the atom `export`.
+
+For inputs compiled with `malfunction compile` (that is, whole
+programs), the `export` sexp must be empty. For instance, a program
+which evaluates the single sexp `E` ignoring its result has this form:
+
+    (module
+      (_ E)
+      (export))
+
+Inputs compiled with `malfunction cmx` (that is, modules that are
+later linked with other modules) may specify any number of values in
+the `export` sexp, which must be in the same order as they are listed
+in the corresponding `.mli` file.
+
+
+## Numbers and arithmetic
+
+There are several numeric types, and associated constant syntax:
+  - int, e.g. `42`
+  - int32, e.g. `42.i32`
+  - int64, e.g. `42.i64`
+  - bigint, e.g. `42.ibig`
+  - float, e.g. `42.0`
+
+`int32` and `int64` use 32-bit and 64-bit two's complement arithmetic,
+with wrap on overflow. `int` uses either 31- or 63- bit two's
+complement arithmetic (depending on system word size, and also
+wrapping on overflow), and is generally fastest. `bigint` has
+arbitrary precision. `float` uses IEEE754 double-precision (64-bit)
+arithmetic.
+
+Various numeric operations are defined:
+
+  - *Arithmetic operations*: `+`, `-`, `*`, `/`, `%` (modulo), `neg` (unary negation)
+  - *Bitwise operations*: `&`, `|`, `^`, `<<`, `>>` (zero-shifting), `a>>` (sign extending)
+  - *Numeric comparisons*: `<`, `>`, `<=`, `>=`, `==`
+
+All of these operations take one or two `int`s and return an `int`:
+
+```test
+(+ 10 (* 20 3))
+=> 70
+```
+
+```test
+(<< 1 5)
+=> 32
+```
+
+These operations come in `int32`, `int64`, `bigint` and `float`
+varieties, which may be used by suffixing `.i32`, `.i64`, `.big` or `.f64`
+to the operation name. The bitwise operations are not available for
+`float`s. The suffixed operations all take and return values of the
+specified numeric type, except:
+
+  - the shift operators (`<<`, `>>`, `a>>`) whose second argument (shift count) is always `int`
+  - the comparison operators, whose result is always `int` (in fact, always `0` or `1`)
+
+For example,
+
+```test
+(*.ibig 948324329804.ibig 8493208402394.ibig)
+=> 8054316166085991599150776.ibig
+```
+
+```test
+(>>.i32 32.i32 5)
+=> 1.i32
+```
+
+```test
+(+.f64 0.1 0.2)
+=> 0.30000000000000004
+```
+
+As well as ordinary finite values, floats support infinite and NaN
+values, available as the literals `infinity`, `neg_infinity` and
+`nan`. Note that `nan` is unordered with respect to other floats, so
+comparisons with it always return false.
+
+Integer types are not automatically coerced, and behaviour is
+undefined if the wrong types are passed to an operation. Explicit
+conversions are done with `convert.FROM.TO`. When converting between
+integer types, conversions from smaller to larger types sign-extend
+and conversions from larger to smaller truncate. Conversions from an
+integer type to float round to the nearest float, which may not be
+exactly equal to the specified integer.
+
+Conversions from float to integer type truncate the fractional
+part. Currently, their behaviour is undefined if the input is outside
+the representable range of the target type, although this might change
+in the future.
+
+```test
+(convert.i32.i64 42.i32)
+=> 42.i64
+```
+
+```test
+(convert.f64.int 3.9)
+=> 3
+```
+
+## Functions
+
+Functions are defined using the following syntax, and close over all
+bindings in scope:
+
+    (lambda ($arg1 $arg2 $arg3) BODY)
+
+Functions are applied using the following syntax:
+
+    (apply FUNC ARG ARG ARG)
+
+Multiple-argument functions are implicitly curried, and may be
+partially applied (resulting in a closure) or applied to too many
+arguments (resulting in an application of the returned value). For
+instance,
+
+```test
+(apply (apply (lambda ($a $b) (+ $a $b)) 20) 22)
+=> 42
+```
+
+```test
+(apply (lambda ($a) (lambda ($b) (+ $a $b))) 20 22)
+=> 42
+```
+
+However, performance will be higher if functions are applied to
+exactly the right number of arguments.
+
+Evaluation is eager: functions and arguments are evaluated before
+their bodies. The function is evaluated before the arguments, and
+arguments are evaluated left to right.
+
+## Bindings
+
+The atom `let` introduces a sequence of bindings:
+
+    (let BINDING BINDING BINDING ... BODY)
+
+Each binding is of one of the forms:
+
+  - `($var EXP)`: binds `$var` to the result of evaluating `EXP`. `$var` scopes over subsequent bindings and the body.
+  - `(_ EXP)`: evaluates `EXP` and ignores the result
+  - `(rec ($VAR1 EXP1) ($VAR2 EXP2) ...)`: binds each `$VAR` mutually
+    recursively. Each `EXP` must be of the form `(lambda
+    ...)` or `(lazy ...)`. Bindings scope over themselves,
+    each other, subsequent bindings, and the body.
+
+For example, here is a definition of the "even" and "odd" predicates
+on `int`s, and an application of them to check whether 42 is even (see
+below for `if`):
+
+```test
+(let
+  (rec
+    ($even (lambda ($n) (if (<= $n 1) (== $n 0) (apply $odd (- $n 1)))))
+    ($odd (lambda ($n) (if (<= $n 1) (== $n 1) (apply $even (- $n 1))))))
+  ($res (apply $even 42))
+  $res)
+=> 1
+```
+
+The syntax `(seq EXP EXP...)` is equivalent to `(let (_ EXP) (_
+EXP)... EXP)`, and can be used to write sequences of imperative
+actions whose results are ignored.
+
+## Blocks and fields
+
+Blocks (tuples) are constructed using `(block (tag N) EXP EXP EXP
+...)`, where `N` is a constant integer called the "tag" (an integer in
+the range 0-199 which may be used with `switch` below) and each `EXP`
+is a field of the resulting block.
+
+Fields are projected from a block using `(field N EXP)`, where `N` is
+an integer between 0 and one less than the length of the block.
+
+```test
+(let
+  ($a (block (tag 0) 1 2 (block (tag 1) 0) 3))
+  ($b (block (tag 0) (field 2 $a) (field 0 $a)))
+  $b)
+=> (block (tag 0) (block (tag 1) 0) 1)
+```
+
+Fields of blocks can only be accessed at constant, compile-time-known
+offsets. For random access into a structure, see "Vectors" below.
+
+## Conditionals
+
+The general conditional expression is `switch`, of the form:
+
+    (switch EXP
+      (SEL SEL... EXP)
+      (SEL SEL... EXP)
+      ...)
+
+The first `EXP` is evaluated, and matched against each case in the
+order they appear. A case (of the form `(SEL SEL... EXP)`) matches if
+any of its selectors (`SEL`) match. The result of the switch is the
+result of evaluating the `EXP` of the first matching case. Selectors may be:
+
+  - `42`: integers, matching themselves. Only `int`, not `int32`,
+    `int64` or `bigint` may be matched. Use comparison operators,
+    which always return ints, to switch on other integer types.
+  - `(10 20)`: integer ranges, matching (in this example) any `n` where `10 <= n <= 20`
+  - `_`: default case, matching any *integer*
+  - `(tag 10)`: matches blocks with tag 10
+  - `(tag _)`: matches any block.
+
+Note that `_` matches only integers. To have a case handle all
+integers and all blocks, write `(_ (tag _) EXP)`.
+
+Selectors must be literal constants. To compare against runtime
+values, use comparison operators.
+
+For instance,
+
+```test
+(let
+  ($sw (lambda ($n)
+    (switch $n
+      (5 (10 20) 100)
+      ((15 50) 200)
+      (_ 300)
+      ((tag 10) 400))))
+  ($a (apply $sw 5))
+  ($b (apply $sw 10))
+  ($c (apply $sw 50))
+  ($d (apply $sw 60))
+  ($e (apply $sw (block (tag 10))))
+  (block (tag 0) $a $b $c $d $e))
+=> (block (tag 0) 100 100 200 300 400)
+```
+
+Behaviour is undefined if no cases match. If you are compiling a
+conditional statement to Malfunction and cannot prove that all cases
+are handled, you must add an explicit default case.
+
+The expression `(if A B C)` is equivalent to:
+
+    (switch A
+      (0 C)
+      (_ (tag _) B))
+
+That is, `C` is executed if `A` evaluates to zero, and `C` otherwise.
+
+Complex mixtures of conditions in `switch` expressions perform well -
+the OCaml compiler generates good code for pattern-matching.
+
+## Vectors
+
+Vectors are mutable, fixed-length sequences of slots. The slots are
+numbered from 0 to one less than the length of the vector, and support
+random access.
+
+  - `(makevec LEN VAL)`: creates a vector of length `LEN` (must evaluate to a
+    nonnegative integer) initially containing the result of evaluating `VAL` in all slots.
+  - `(load VEC IDX)`: evaluates `VEC` (which must evaluate to a
+    vector) and `IDX` (which must evaluate to an integer), and returns
+    the value of the `IDX`'th slot (which must be in bounds).
+  - `(store VEC IDX VAL)`: evaluates `VEC` (a vector), `IDX` (an
+    in-bounds index) and `VAL`, and stores `VAL` in the `IDX`'th slot.
+  - `(length VEC)`: evaluates `VEC` (a vector) and returns its length.
+
+As well as standard vectors, byte vectors are also available. They
+have the same semantics as vectors, except that the operations are
+suffixed `.byte` (`makevec.byte`, etc.) and they may only be used to
+store integers in the range 0-255.
+
+Behaviour is undefined if byte vector operations are used on standard
+vectors, or vice versa.
+
+String literals (`"hello"`) return byte vectors.
+
+## Lazy evaluation
+
+A *lazily-evaluated* expression is one that's not computed until it's
+needed. The expression `(lazy E)` constructs a lazy value that wraps
+the expression `E` but does not evaluate it immediately. When the lazy
+value is examined using `(force $lazyval)`, `E` will be computed.
+
+`E` is evaluated at most once for a given `(lazy E)`. If the resulting
+value is `force`d twice, then the value computed by `E` is cached.
+
+If evaluating `E` produces side effects, these occur at the time that
+`E` is first forced. For instance:
+
+```test
+(let
+  ($box (makevec 1 42))
+  ($thunk
+    (lazy (let
+      ($val (load $box 0))
+      (_ (store $box 0 (+ $val 1)))
+      $val)))
+  (block (tag 0)
+    (load $box 0)
+    (force $thunk)
+    (load $box 0)
+    (force $thunk)))
+=> (block (tag 0) 42 42 43 42)
+```
+
+## Accessing OCaml values
+
+OCaml values can be accessed from Malfunction programs by specifying a
+module path using `global`. For instance, the OCaml function
+`Stdlib.print_string` is referred to as `(global $Stdlib $print_string)`.
+
+As well as calling OCaml functions, certain OCaml values can be
+directly manipulated. The integer types `int`, `int32` and `int64`
+correspond to the OCaml types `int`, `Int32.t` and `Int64.t`, OCaml
+tuples are blocks with tag 0, and OCaml algebraic data types are
+represented as a combination of ints and blocks as described in
+section
+[19.3.4 of the OCaml manual, "Concrete data types"](https://v2.ocaml.org/manual/intfc.html#ss:c-concrete-datatypes).
diff --git a/malfunction/dune-project b/malfunction/dune-project
new file mode 100644
index 000000000000..3da63ea49033
--- /dev/null
+++ b/malfunction/dune-project
@@ -0,0 +1,2 @@
+(lang dune 1.11)
+(name malfunction)
diff --git a/malfunction/dune-workspace.all b/malfunction/dune-workspace.all
new file mode 100644
index 000000000000..9bffbb2f414d
--- /dev/null
+++ b/malfunction/dune-workspace.all
@@ -0,0 +1,24 @@
+(lang dune 1.0)
+(context (opam (switch default) (merlin)))
+(context (opam (switch 4.08.1)))
+(context (opam (switch 4.08.1+flambda)))
+(context (opam (switch 4.09.1)))
+(context (opam (switch 4.09.1+flambda)))
+(context (opam (switch 4.10.2)))
+(context (opam (switch 4.10.2+flambda)))
+(context (opam (switch 4.11.1)))
+(context (opam (switch 4.11.1+flambda)))
+(context (opam (switch 4.12.1)))
+(context (opam (switch 4.12.1+flambda)))
+(context (opam (switch 4.13.1) ))
+(context (opam (switch 4.13.1+flambda)))
+(context (opam (switch 4.14.0) ))
+(context (opam (switch 4.14.0+flambda)))
+(context (opam (switch 5.0.0)))
+(context (opam (switch 5.0.0+flambda)))
+(context (opam (switch 5.1.0)))
+(context (opam (switch 5.1.0+flambda)))
+(context (opam (switch 5.2.0)))
+(context (opam (switch 5.2.0+flambda)))
+(context (opam (switch 5.3.0~alpha1)))
+(context (opam (switch 5.3.0~alpha1+flambda)))
diff --git a/malfunction/dune-workspace.quick b/malfunction/dune-workspace.quick
new file mode 100644
index 000000000000..3d30db11f72f
--- /dev/null
+++ b/malfunction/dune-workspace.quick
@@ -0,0 +1,5 @@
+(lang dune 1.0)
+(context (opam (switch 4.14.0) (merlin)) )
+(context (opam (switch 5.0.0) ))
+(context (opam (switch 5.1.0)))
+(context (opam (switch 5.2.0~beta1)))
diff --git a/malfunction/examples/.gitignore b/malfunction/examples/.gitignore
new file mode 100644
index 000000000000..1a1bfe92d94d
--- /dev/null
+++ b/malfunction/examples/.gitignore
@@ -0,0 +1,4 @@
+*.inlining.org
+*.cm[iox]
+*.s
+*.o
diff --git a/malfunction/examples/dune b/malfunction/examples/dune
new file mode 100644
index 000000000000..01d20bd404fb
--- /dev/null
+++ b/malfunction/examples/dune
@@ -0,0 +1,8 @@
+(executable
+ (name primrec)
+ (modes native)
+ (libraries malfunction))
+
+(alias
+ (name runtest)
+ (action (run ./primrec.exe)))
\ No newline at end of file
diff --git a/malfunction/examples/helloworld.mlf b/malfunction/examples/helloworld.mlf
new file mode 100644
index 000000000000..b282993d30f3
--- /dev/null
+++ b/malfunction/examples/helloworld.mlf
@@ -0,0 +1,7 @@
+(module
+  (_ (apply (global $Stdlib $print_string) "Hello, world!\n"))
+  ($prt (global $Stdlib $print_int))
+  ($p2 
+    (lambda ($arg1) (lambda ($arg2) (+ $arg1 $arg2))))
+  (_ (apply $prt (apply $p2 2 40)))
+  (export))
diff --git a/malfunction/examples/primrec.ml b/malfunction/examples/primrec.ml
new file mode 100644
index 000000000000..010946655fbf
--- /dev/null
+++ b/malfunction/examples/primrec.ml
@@ -0,0 +1,154 @@
+(* Staged compilation of primitive-recursive arithmetic. *)
+
+(* Natural numbers (at type level) *)
+type zero = [`Zero]
+type 'a suc = [`Suc of 'a]
+
+(* Variables, indexed by the size of the context
+  (i.e. number of variables in scope) *)
+type _ v =
+| ZV : ('a suc) v
+| SV : 'a v -> ('a suc) v
+
+(* Well-scoped terms of PRA, with variables as de Bruijn indices.
+
+   PRA includes constants, successor, variables, let, and recursion.
+   Recursion defines a function on naturals by giving f 0, and
+   f (n + 1) in terms of both n and f n. *)
+type 'a t =
+| K : int -> 'a t
+| S : 'a t -> 'a t
+| V : 'a v -> 'a t
+| Let : 'a t * ('a suc) t -> 'a t
+| Rec : {name : string; ifzero : 'a t; ifsuc : ('a suc suc) t; n : 'a t} -> 'a t
+
+
+(* less horrible ways of writing de Bruijn indices *)
+
+let v0 = V ZV
+let v1 = V (SV ZV)
+let v2 = V (SV (SV ZV))
+let v3 = V (SV (SV (SV ZV)))
+let v4 = V (SV (SV (SV (SV ZV))))
+
+(* Addition, multiplication and exponentiation.
+   Bonus points if you can figure out why 'v4' and 'v1' are correct.
+   (de Bruijn indices are awful)
+
+   These are eta-expanded with () to get around the value restriction.
+   We want them to be polymorphic so that they work in any environment.
+   (i.e. we want add () to require at least two variables, not exactly two) *)
+let (%) f x = Let(x, f)
+let add () = Rec {name = "+"; ifzero = v1; ifsuc = S v1; n = v0}
+let mul () = Rec {name = "*"; ifzero = K 0; ifsuc = add () % v4 % v1; n = v0}
+let exp () = Rec {name = "^"; ifzero = K 1; ifsuc = mul () % v4 % v1; n = v0}
+
+
+(* Interpreter for PRA.
+   Takes as input a term, and an environment,
+   both with the same number of free variables *)
+
+(* Environments, mapping each variable to an integer *)
+type _ env =
+| Eps : zero env
+| Cons : 'a env * int -> ('a suc) env
+
+let rec interpret : type k . k t -> k env -> int =
+  fun t env -> match t with
+  | K n ->
+     n
+  | S t ->
+     interpret t env + 1
+  | V v ->
+     let rec lookup : type k . k env -> k v -> int =
+       fun env var -> match var, env with
+       | ZV, Cons (_env, n) -> n
+       | SV v, Cons (env, _) -> lookup env v in
+     lookup env v
+  | Let (e, body) ->
+     let v = interpret e env in
+     interpret body (Cons (env, v))
+  | Rec {name = _; ifzero; ifsuc; n} ->
+     let n = interpret n env in
+     let rec go n' fn' =
+       if n = n' then fn' else
+         let env = Cons (Cons (env, fn'), n') in
+         go (n' + 1) (interpret ifsuc env) in
+     go 0 (interpret ifzero env)
+
+
+(* Compiler for PRA. Compare to the interpreter above. *)
+
+(* Environments are split in two:
+     Params (variables passed as arguments to the program)
+     Locals (variables defined locally with Let) *)
+type 'a menv =
+| Params : Malfunction.t -> 'a menv
+| Local : 'a menv * Malfunction.t -> ('a suc) menv
+
+module I = Malfunction.IntArith
+let rec compile : type k . k t -> k menv -> Malfunction.t =
+  fun t env -> let open Malfunction in match t with
+  | K n ->
+     I.of_int n
+  | S t ->
+     I.(compile t env + one)
+  | V v ->
+     let rec lookup : type k . k menv -> k v -> Malfunction.t =
+       fun env var -> match var, env with
+       | ZV, Params env -> Mfield(1, env)
+       | SV v, Params env -> lookup (Params (Mfield (0, env))) v
+       | ZV, Local (_env, v) -> v
+       | SV v, Local (env, _) -> lookup env v in
+     lookup env v
+  | Let (e, body) ->
+     bind_val (compile e env) @@ fun v ->
+     compile body (Local (env, v))
+  | Rec {name = _; ifzero; ifsuc; n} ->
+     bind_val (compile n env) @@ fun n ->
+     bind_rec (fun go -> lambda2 @@ fun n' fn' ->
+       if_ I.(n = n')
+         fn'
+         I.(let env = Local(Local(env, fn'), n') in
+            Mapply(go, [n' + one; compile ifsuc env]))) @@ fun go ->
+     Mapply(go, [I.zero; compile ifzero env])
+
+(* Note that the type of this function is the same as that of 'interpret'
+   but partially applying this function will do the compilation work *)
+
+let run_compiled : type k . k t -> k env -> int =
+  fun t ->
+    let code = Malfunction.(lambda @@ fun v -> compile t (Params v)) in
+    let e = Malfunction_compiler.compile_and_load code in
+    fun env -> Obj.magic e env
+
+
+(* testcase: compute 16^4 *)
+let _ =
+  let env = Cons(Cons(Eps, 16), 4) in
+  assert (interpret (exp ()) env = 65536);
+  assert (run_compiled (exp ()) env = 65536)
+
+(* benchmark: calculate a bunch of exponents *)
+let benchmark name exec =
+  let env a b = Cons(Cons(Eps, a), b) in
+  (* to ensure same data for both implementations *)
+  Random.init 432789;
+  let tstart = Unix.gettimeofday () in
+  for _ = 1 to 50 do
+    let a = Random.int 100 and b = Random.int 5 in
+    assert (exec (env a b) = Z.(to_int (pow (of_int a) b)))
+  done;
+  let tend = Unix.gettimeofday () in
+  Printf.printf "%12s: %.2f secs\n%!" name (tend -. tstart)
+
+let _ =
+  benchmark "interpreted" (interpret (exp ()));
+  benchmark "compiled" (run_compiled (exp ()))
+
+(*
+  Results, on my machine:
+
+    interpreted: 5.69 secs
+       compiled: 0.18 secs
+*)
diff --git a/malfunction/malfunction.opam b/malfunction/malfunction.opam
new file mode 100644
index 000000000000..2315288eb667
--- /dev/null
+++ b/malfunction/malfunction.opam
@@ -0,0 +1,24 @@
+opam-version: "2.0"
+maintainer: "stephen.dolan@cl.cam.ac.uk"
+authors: ["Stephen Dolan"]
+homepage: "https://github.com/stedolan/malfunction"
+bug-reports: "https://github.com/stedolan/malfunction/issues"
+dev-repo: "git+https://github.com/stedolan/malfunction.git"
+license: "LGPL-2.0-or-later"
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+  [ "dune" "runtest" "-p" name "-j" jobs ] {with-test}
+]
+depends: [
+  "ocaml" {>= "4.08" & < "5.0.0"}
+  "ocamlfind"
+  "dune"
+  "cppo" {build}
+  "omd" {with-test & >= "2.0.0~"}
+  "zarith"
+]
+synopsis: "Compiler back-end for functional languages, based on OCaml"
+description: """
+Malfunction is a high-performance, low-level untyped program
+representation, designed as a target for compilers of functional
+programming languages."""
diff --git a/malfunction/src/dune b/malfunction/src/dune
new file mode 100644
index 000000000000..fa4016601787
--- /dev/null
+++ b/malfunction/src/dune
@@ -0,0 +1,21 @@
+(ocamllex (modules malfunction_sexp))
+
+(rule
+ (targets malfunction_compat.ml)
+ (deps malfunction_compat.cppo.ml)
+ (action (run %{bin:cppo} %{deps} -V OCAML:%{ocaml_version} -o %{targets})))
+
+(executable
+ (name malfunction_main)
+ (modes native)
+ (libraries malfunction)
+ (modules malfunction_main)
+ (public_name malfunction))
+
+(library
+ (name malfunction)
+ (public_name malfunction)
+ (libraries compiler-libs.optcomp compiler-libs.bytecomp str zarith findlib dynlink unix)
+ (wrapped false)
+ (modes native)
+ (modules (:standard \ malfunction_main)))
diff --git a/malfunction/src/malfunction.ml b/malfunction/src/malfunction.ml
new file mode 100644
index 000000000000..b26032189b1e
--- /dev/null
+++ b/malfunction/src/malfunction.ml
@@ -0,0 +1,128 @@
+type inttype = [`Int | `Int32 | `Int64 | `Bigint]
+type numtype = [inttype | `Float64]
+type numconst = [`Int of int | `Int32 of Int32.t | `Int64 of Int64.t | `Bigint of Z.t | `Float64 of float]
+type unary_num_op =
+  [`Neg | `Not]
+type binary_arith_op = [ `Add | `Sub | `Mul | `Div | `Mod ]
+type binary_bitwise_op = [ `And | `Or | `Xor | `Lsl | `Lsr | `Asr ]
+type binary_comparison = [ `Lt | `Gt | `Lte | `Gte | `Eq ]
+type binary_num_op =
+  [ binary_arith_op | binary_bitwise_op | binary_comparison ]
+
+type vector_type =
+  [`Array | `Bytevec]
+type mutability =
+  [ `Imm | `Mut ]
+
+type block_tag = int
+
+type case = [`Tag of int | `Deftag | `Intrange of int * int]
+
+
+let max_tag = 200
+let tag_of_int n =
+  if 0 <= n && n < max_tag then
+    n
+  else
+    invalid_arg "tag out of range"
+
+
+
+type t =
+| Mvar of Ident.t
+| Mlambda of Ident.t list * t
+| Mapply of t * t list
+| Mlet of binding list * t
+| Mnum of numconst
+| Mstring of string
+| Mglobal of Longident.t
+| Mswitch of t * (case list * t) list
+
+(* Numbers *)
+| Mnumop1 of unary_num_op * numtype * t
+| Mnumop2 of binary_num_op * numtype * t * t
+| Mconvert of numtype * numtype * t
+
+(* Vectors *)
+| Mvecnew of vector_type * t * t
+| Mvecget of vector_type * t * t
+| Mvecset of vector_type * t * t * t
+| Mveclen of vector_type * t
+
+(* Lazy *)
+| Mlazy of t
+| Mforce of t
+
+(* Blocks *)
+| Mblock of int * t list
+| Mfield of int * t
+
+and binding =
+  [ `Unnamed of t | `Named of Ident.t * t | `Recursive of (Ident.t * t) list ]
+
+
+type var = Ident.t
+
+let fresh = Ident.create_local
+
+let bind_val e body =
+  let v = fresh "x" in
+  Mlet ([`Named (v, e)], body (Mvar v))
+
+let bind_rec e body =
+  let v = fresh "x" in
+  Mlet ([`Recursive [v, e (Mvar v)]], body (Mvar v))
+
+let tuple xs = Mblock(0, xs)
+
+let lambda f =
+  let v = fresh "x" in
+  Mlambda ([v], f (Mvar v))
+
+let lambda2 f =
+  let vx = fresh "x" and vy = fresh "y" in
+  Mlambda ([vx; vy], f (Mvar vx) (Mvar vy))
+
+let if_ c tt ff =
+  Mswitch (c, [[`Intrange(0,0)], ff; [`Intrange(min_int,max_int);`Deftag], tt])
+
+module IntArith = struct
+  let of_int n = Mnum (`Int n)
+  let zero = of_int 0
+  let one = of_int 1
+  let (~-) a = Mnumop1(`Neg, `Int, a)
+  let lnot a = Mnumop1(`Not, `Int, a)
+  let (+) a b = Mnumop2(`Add, `Int, a, b)
+  let (-) a b = Mnumop2(`Sub, `Int, a, b)
+  let ( * ) a b = Mnumop2(`Mul, `Int, a, b)
+  let (/) a b = Mnumop2(`Div, `Int, a, b)
+  let (mod) a b = Mnumop2(`Mod, `Int, a, b)
+  let (land) a b = Mnumop2(`And, `Int, a, b)
+  let (lor) a b = Mnumop2(`Or, `Int, a, b)
+  let (lxor) a b = Mnumop2(`Xor, `Int, a, b)
+  let (lsl) a b = Mnumop2(`Lsl, `Int, a, b)
+  let (lsr) a b = Mnumop2(`Lsr, `Int, a, b)
+  let (asr) a b = Mnumop2(`Asr, `Int, a, b)
+  let (<) a b = Mnumop2(`Lt, `Int, a, b)
+  let (>) a b = Mnumop2(`Gt, `Int, a, b)
+  let (<=) a b = Mnumop2(`Lte, `Int, a, b)
+  let (>=) a b = Mnumop2(`Gte, `Int, a, b)
+  let (=) a b = Mnumop2(`Eq, `Int, a, b)
+end
+
+let with_error_reporting ppf def f =
+  try f () with
+  | Malfunction_sexp.SyntaxError ((locstart, locend), msg) ->
+     let open Lexing in
+     if locstart.pos_lnum = locend.pos_lnum then
+       Format.fprintf ppf "%s:%d:%d-%d: %s\n%!"
+         locstart.pos_fname locstart.pos_lnum (locstart.pos_cnum - locstart.pos_bol) (locend.pos_cnum - locend.pos_bol) msg
+     else
+       Format.fprintf ppf "%s:%d:%d-%d:%d %s\n%!"
+         locstart.pos_fname locstart.pos_lnum (locstart.pos_cnum - locstart.pos_bol) locend.pos_lnum (locend.pos_cnum - locend.pos_bol) msg;
+     def
+  | x ->
+     Printexc.print_backtrace stdout;
+     Location.report_exception ppf x;
+    def
+
diff --git a/malfunction/src/malfunction.mli b/malfunction/src/malfunction.mli
new file mode 100644
index 000000000000..a4b5d570850e
--- /dev/null
+++ b/malfunction/src/malfunction.mli
@@ -0,0 +1,101 @@
+type inttype = [`Int | `Int32 | `Int64 | `Bigint]
+type numtype = [inttype | `Float64]
+type numconst = [`Int of int | `Int32 of Int32.t | `Int64 of Int64.t | `Bigint of Z.t | `Float64 of float]
+type unary_num_op =
+  [`Neg | `Not]
+type binary_arith_op = [ `Add | `Sub | `Mul | `Div | `Mod ]
+type binary_bitwise_op = [ `And | `Or | `Xor | `Lsl | `Lsr | `Asr ]
+type binary_comparison = [ `Lt | `Gt | `Lte | `Gte | `Eq ]
+type binary_num_op =
+  [ binary_arith_op | binary_bitwise_op | binary_comparison ]
+
+type vector_type =
+  [`Array | `Bytevec]
+type mutability =
+  [ `Imm | `Mut ]
+
+type block_tag = private int
+
+type case = [`Tag of int | `Deftag | `Intrange of int * int]
+
+val max_tag : block_tag
+val tag_of_int : int -> block_tag
+
+
+type var = Ident.t
+
+(* the argument to fresh does not affect semantics, but can be useful for debugging *)
+val fresh : string -> var
+
+type t =
+| Mvar of var
+| Mlambda of var list * t
+| Mapply of t * t list
+| Mlet of binding list * t
+| Mnum of numconst
+| Mstring of string
+| Mglobal of Longident.t
+| Mswitch of t * (case list * t) list
+
+(* Numbers *)
+| Mnumop1 of unary_num_op * numtype * t
+| Mnumop2 of binary_num_op * numtype * t * t
+| Mconvert of numtype * numtype * t
+
+(* Vectors *)
+| Mvecnew of vector_type * t * t
+| Mvecget of vector_type * t * t
+| Mvecset of vector_type * t * t * t
+| Mveclen of vector_type * t
+
+(* Lazy *)
+| Mlazy of t
+| Mforce of t
+
+(* Blocks *)
+| Mblock of int * t list
+| Mfield of int * t
+
+and binding =
+  [ `Unnamed of t | `Named of var * t | `Recursive of (var * t) list ]
+
+(* generate 'let' and 'let rec' in HOAS style *)
+val bind_val : t -> (t -> t) -> t
+val bind_rec : (t -> t) -> (t -> t) -> t
+
+(* create a block of tag 0 *)
+val tuple : t list -> t
+
+val lambda : (t -> t) -> t
+val lambda2 : (t -> t -> t) -> t
+
+val if_ : t -> t -> t -> t
+
+module IntArith : sig
+  val zero : t
+  val one : t
+  val of_int : int -> t
+  val (~-) : t -> t
+  val lnot : t -> t
+  val (+) : t -> t -> t
+  val (-) : t -> t -> t
+  val ( * ) : t -> t -> t
+  val (/) : t -> t -> t
+  val (mod) : t -> t -> t
+  val (land) : t -> t -> t
+  val (lor) : t -> t -> t
+  val (lxor) : t -> t -> t
+  val (lsl) : t -> t -> t
+  val (lsr) : t -> t -> t
+  val (asr) : t -> t -> t
+  val (<) : t -> t -> t
+  val (>) : t -> t -> t
+  val (<=) : t -> t -> t
+  val (>=) : t -> t -> t
+  val (=) : t -> t -> t
+end
+
+(* utility function to catch errors from parsing and compilation *)
+val with_error_reporting : Format.formatter -> 'a -> (unit -> 'a) -> 'a
+
+
diff --git a/malfunction/src/malfunction_compat.cppo.ml b/malfunction/src/malfunction_compat.cppo.ml
new file mode 100644
index 000000000000..71cb6f77904b
--- /dev/null
+++ b/malfunction/src/malfunction_compat.cppo.ml
@@ -0,0 +1,208 @@
+open Lambda
+
+let loc_none =
+#if OCAML_VERSION < (4, 11, 0)
+  Location.none
+#else
+  Debuginfo.Scoped_location.Loc_unknown
+#endif
+
+let lswitch (scr : lambda) (swi : lambda_switch) =
+  Lswitch(scr, swi, loc_none)
+
+let lfunction params body =
+  let params = List.map (fun x -> x, Pgenval) params in
+  let attr = {
+    inline = Default_inline;
+    specialise = Default_specialise;
+    is_a_functor = false;
+    stub = false;
+    local = Default_local;
+#if OCAML_VERSION >= (4, 14, 0)
+    poll = Default_poll;
+    tmc_candidate = false;
+#endif
+#if OCAML_VERSION >= (5, 2, 0)
+    may_fuse_arity = true;
+#endif
+  } in
+#if OCAML_VERSION >= (4, 14, 0)
+  lfunction
+    ~kind:Curried
+    ~params
+    ~return:Pgenval
+    ~body
+    ~attr
+    ~loc:loc_none
+#else
+  Lfunction {
+     kind = Curried;
+     params;
+     body;
+     loc = loc_none;
+     attr;
+     return = Pgenval;
+   }
+#endif
+
+let lapply fn args =
+  Lapply {
+    ap_func = fn;
+    ap_args = args;
+    ap_loc = loc_none; (* FIXME *)
+#if OCAML_VERSION < (4, 12, 0)
+    ap_should_be_tailcall = false;
+#else
+    ap_tailcall = Default_tailcall;
+#endif
+    ap_inlined = Default_inline;
+    ap_specialised = Default_specialise
+  }
+
+let lletrec bindings body =
+#if OCAML_VERSION < (5, 2, 0)
+  Lletrec (bindings, body)
+#else
+  let bindings = List.map (fun (id, v) -> id, Value_rec_types.Static, v) bindings in
+  Value_rec_compiler.compile_letrec bindings body
+#endif
+
+let pfield ix =
+#if OCAML_VERSION < (5, 0, 0)
+  Pfield ix
+#else
+  Pfield (ix, Pointer, Mutable)
+#endif
+
+module Subst : sig
+  type t
+  val empty : t
+  val add : Ident.t -> Lambda.lambda -> t -> t
+  val apply : t -> Lambda.lambda -> Lambda.lambda
+end = struct
+  type t = Lambda.lambda Ident.Map.t
+  let empty = Ident.Map.empty
+  let add = Ident.Map.add
+  let apply t x = 
+    Lambda.subst (fun _ _ e -> e) t x
+end
+
+let compmisc_init_path () =
+#if OCAML_VERSION < (4, 09, 0)
+  Compmisc.init_path true
+#else
+  Compmisc.init_path ()
+#endif
+
+let simplify_lambda lam =
+#if OCAML_VERSION < (4, 09, 0)
+  Simplif.simplify_lambda "malfunction" lam
+#else
+  Simplif.simplify_lambda lam
+#endif
+
+let load_path_find_uncap =
+#if OCAML_VERSION < (5, 2, 0)
+  Load_path.find_uncap
+#else
+  Load_path.find_normalized
+#endif
+
+let flambda_middle_end =
+#if OCAML_VERSION < (4, 09, 0)
+  Middle_end.middle_end
+#elif OCAML_VERSION < (4, 10, 0)
+  Flambda_middle_end.middle_end
+#else
+  Flambda_middle_end.lambda_to_clambda
+#endif
+
+let asmgen_compile_implementation_clambda ~backend =
+#if OCAML_VERSION < (4, 09, 0)
+  ignore backend;
+  Asmgen.compile_implementation_clambda ?toplevel:None
+#elif OCAML_VERSION < (4, 10, 0)
+  Asmgen.compile_implementation_clambda ?toplevel:None ~backend
+#else
+  Asmgen.compile_implementation ?toplevel:None ~backend
+    ~middle_end:Closure_middle_end.lambda_to_clambda
+#endif
+
+let env_read_signature ~module_name ~file =
+#if OCAML_VERSION < (5, 2, 0)
+  Env.read_signature module_name file
+#else
+  let a = Unit_info.Artifact.from_filename file in
+  assert (Unit_info.Artifact.modname a = module_name);
+  Env.read_signature a
+#endif
+
+let is_unit_name name =
+#if OCAML_VERSION < (5, 2, 0)
+  Compenv.is_unit_name name
+#else
+  Unit_info.is_unit_name name
+#endif
+
+let env_set_unit_name ~filename ~prefixname ~module_name =
+#if OCAML_VERSION < (5, 3, 0)
+  ignore (filename, prefixname);
+  Env.set_unit_name module_name
+#else
+  ignore module_name;
+  let info = Unit_info.make ~source_file:filename Impl prefixname in
+  Env.set_current_unit info
+#endif
+
+let emit_bytecode_to_file oc module_name cmofile ~required_globals bc =
+#if OCAML_VERSION < (5, 2, 0)
+  Emitcode.to_file oc module_name cmofile ~required_globals bc
+#else
+  let a = Unit_info.Artifact.from_filename cmofile in
+  assert (Unit_info.Artifact.modname a = module_name);
+  Emitcode.to_file oc a ~required_globals bc
+#endif
+
+let compile_implementation
+  ~prefixname ~filename ~module_id ~backend ~required_globals ~ppf (size, code) =
+#if OCAML_VERSION < (4,10,0)
+  if Config.flambda then begin
+    code
+    |> (fun lam ->
+      flambda_middle_end
+        ~ppf_dump:ppf
+        ~prefixname
+        ~backend
+        ~size
+        ~filename
+        ~module_ident:module_id
+        ~module_initializer:lam)
+    |> Asmgen.compile_implementation_flambda ?toplevel:None ~ppf_dump:ppf
+        prefixname
+        ~required_globals
+        ~backend
+  end else begin
+    (* FIXME: main_module_block_size is wrong *)
+    code
+    |> (fun code -> Lambda.{ module_ident = module_id; required_globals;
+                             code; main_module_block_size = size })
+    |> (asmgen_compile_implementation_clambda ~backend ~ppf_dump:ppf
+         prefixname);
+  end;
+#else
+  let program = Lambda.{code; main_module_block_size = size; module_ident = module_id; required_globals } in
+  let middle_end =
+    if Config.flambda then Flambda_middle_end.lambda_to_clambda
+    else Closure_middle_end.lambda_to_clambda
+  in
+#if OCAML_VERSION >= (4, 13, 0)
+  ignore filename;
+  Asmgen.compile_implementation
+    ?toplevel:None ~backend ~prefixname ~middle_end ~ppf_dump:ppf
+    program
+#else
+  Asmgen.compile_implementation
+    ?toplevel:None ~backend ~filename ~prefixname ~middle_end ~ppf_dump:ppf
+    program
+#endif
+#endif
diff --git a/malfunction/src/malfunction_compiler.ml b/malfunction/src/malfunction_compiler.ml
new file mode 100644
index 000000000000..b69094c0b210
--- /dev/null
+++ b/malfunction/src/malfunction_compiler.ml
@@ -0,0 +1,987 @@
+open Lambda
+open Asttypes
+
+open Malfunction
+open Malfunction_parser
+open Malfunction_compat
+
+(* List.map, but guarantees left-to-right evaluation *)
+let rec lrmap f = function
+| [] -> []
+| (x :: xs) -> let r = f x in r :: lrmap f xs
+
+let lprim p args = Lprim (p, args, loc_none)
+let lbind n exp body =
+  let id = fresh n in
+  Llet (Strict, Pgenval, id, exp, body (Lvar id))
+
+(* Enforce left-to-right evaluation order by introducing 'let' bindings *)
+
+let rec reorder = function
+| Mvar _
+| Mnum _
+| Mstring _
+| Mglobal _ as t -> `Pure, t
+
+| Mlambda (params, body) ->
+  `Pure, Mlambda (params, snd (reorder body))
+
+| Mapply (f, xs) ->
+   reorder_sub `Impure (fun ev ->
+     let f = ev f in
+     let xs = lrmap ev xs in
+     Mapply (f, xs))
+
+| Mlet (bindings, body) ->
+   let bindings = reorder_bindings bindings in
+   let _, body = reorder body in
+   `Impure, Mlet (bindings, body)
+
+| Mswitch (e, cases) ->
+   `Impure, Mswitch (snd (reorder e), List.map (fun (c, e) -> c, snd (reorder e)) cases)
+
+| Mnumop1(op, ty, t) ->
+   reorder_sub `Pure (fun ev ->
+     Mnumop1(op, ty, ev t))
+
+| Mnumop2(op, ty, t1, t2) ->
+   reorder_sub `Pure (fun ev ->
+     let t1 = ev t1 in
+     let t2 = ev t2 in
+     Mnumop2(op, ty, t1, t2))
+
+| Mconvert(src, dst, t) -> 
+   reorder_sub `Pure (fun ev ->
+     Mconvert(src, dst, ev t))
+
+| Mvecnew(ty, len, def) ->
+   reorder_sub `Pure (fun ev ->
+     let len = ev len in
+     let def = ev def in
+     Mvecnew(ty, len, def))
+
+| Mvecget(ty, vec, idx) ->
+   reorder_sub `Impure (fun ev ->
+     let vec = ev vec in
+     let idx = ev idx in
+     Mvecget(ty, vec, idx))
+
+| Mvecset(ty, vec, idx, v) ->
+   reorder_sub `Impure (fun ev ->
+     let vec = ev vec in
+     let idx = ev idx in
+     let v = ev v in
+     Mvecset(ty, vec, idx, v))
+
+| Mveclen(ty, vec) ->
+   reorder_sub `Pure (fun ev ->
+     let vec = ev vec in
+     Mveclen(ty, vec))
+
+| Mblock (n, ts) ->
+   reorder_sub `Pure (fun ev ->
+     Mblock(n, lrmap ev ts))
+
+| Mfield (n, t) ->
+   reorder_sub `Impure (fun ev ->
+     Mfield (n, ev t))
+
+| Mlazy e ->
+  `Pure, Mlazy (snd (reorder e))
+
+| Mforce e ->
+   reorder_sub `Impure (fun ev ->
+     Mforce (ev e))
+
+and reorder_bindings bindings =
+  bindings
+  |> lrmap (function
+    | `Unnamed t -> `Unnamed (snd (reorder t))
+    | `Named (v, t) -> `Named (v, snd (reorder t))
+    | `Recursive _ as ts -> ts (* must be functions *))
+
+and reorder_sub p f =
+  let bindings = ref [] in
+  let r = f (fun e ->
+    match reorder e with
+    | `Pure, e -> e
+    | `Impure, e ->
+       let id = fresh "tmp" in
+       bindings := (`Named (id, e)) :: !bindings;
+       Mvar id) in
+  match List.rev !bindings with
+  | [] -> p, r
+  | bindings -> `Impure, (Mlet (bindings, r))
+
+module IntSwitch = struct
+
+  (* Convert a list of possibly-overlapping intervals to a list of disjoint intervals *)
+
+  type action = int (* lower numbers more important *)
+
+  (* cases is a sorted list
+     cases that begin lower appear first
+     when two cases begin together, more important appears first *)
+
+  type case = int * int * action (* start position, end position, priority *)
+  type cases = case list (* sorted by start position then priority *)
+
+  (* the inactive list is a list of (endpoint, priority) pairs representing
+     intervals that we are currently inside, but are overridden by a more important one.
+     subsequent elements of the list have strictly higher priorities and strictly later endpoints *)
+  type inactive = (int * action) list
+
+  let rec insert_inactive max act = function
+    | [] -> [(max, act)]
+    | (max', act') as i' :: rest when act' < act ->
+       (* this interval should appear before the new one *)
+       i' ::
+         (if max' <= max then
+             (* new interval will never be active *)
+             rest
+          else
+             insert_inactive max act rest)
+
+    | (max', act') :: rest when max' <= max ->
+       assert (act < act');
+       (* this interval will is contained by the new one, so never becomes active *)
+       insert_inactive max act rest
+
+    | ov ->
+       (* new interval both more important and ends sooner, so prepend *)
+       (max, act) :: ov
+
+  type state =
+    | Hole (* not currently in any interval *)
+    | Interval of (* in an interval... *)
+      int (* since this position *)
+      * int (* until here *)
+      * action (* with this action *)
+      * inactive (* overriding these inactive intervals *)
+
+  let state_suc = function
+    | Hole -> failwith "state_suc of Hole undefined"
+    | Interval (_, _, _, []) -> Hole
+    | Interval (_, s_max, _, (max', act') :: rest) ->
+       assert (s_max < max');
+       (* can compute s_max + 1 without overflow, because inactive interval ends later *)
+       Interval (s_max + 1, max', act', rest)
+
+  type result = case list (* may have duplicate actions, disjoint, sorted by position *)
+  let rec to_disjoint_intervals c_state (c_cases : cases) : result =
+    match c_state, c_cases with
+    | Hole, [] -> []
+
+    | Hole, ((min, max, act) :: cases) ->
+       to_disjoint_intervals (Interval (min, max, act, [])) cases
+
+    | Interval (entered, max, act, _) as state, [] ->
+       (entered, max, act) :: to_disjoint_intervals (state_suc state) []
+
+    | Interval (s_entered, s_max, s_act, _) as state,
+      (((min, _max, _act) :: _) as cases) when s_max < min ->
+       (* active interval ends before this case begins *)
+       (s_entered, s_max, s_act) :: to_disjoint_intervals (state_suc state) cases
+
+    (* below here, we can assume min <= i.s_max: active interval overlaps current case *)
+    | Interval (s_entered, s_max, s_act, s_inactive), ((_min, max, act) :: cases) when s_act < act ->
+       (* no change to active interval, but this case may become an inactive one *)
+       to_disjoint_intervals (Interval (s_entered, s_max, s_act, insert_inactive max act s_inactive)) cases
+
+    | Interval (s_entered, s_max, s_act, s_inactive), ((min, max, act) :: cases) ->
+       (* new active interval, so old one becomes inactive *)
+       assert (s_entered <= min); assert (min <= s_max); assert (act < s_act);
+       let r =
+         if s_entered = min then
+           (* old interval was not active long enough to produce output *)
+           []
+         else
+           [(s_entered, min - 1, s_act)] in
+       r @ to_disjoint_intervals
+         (Interval (min, max, act, insert_inactive s_max s_act s_inactive)) cases
+
+
+  (* unfortunately, this is not exposed from matching.ml, so copy-paste *)
+  module Switcher = Switch.Make (struct
+    type primitive = Lambda.primitive
+    type loc = Location.t
+    let _unused : loc option = None
+
+    let eqint = Pintcomp Ceq
+    let neint = Pintcomp Cne
+    let leint = Pintcomp Cle
+    let ltint = Pintcomp Clt
+    let geint = Pintcomp Cge
+    let gtint = Pintcomp Cgt
+
+    type arg = Lambda.lambda
+    type test = Lambda.lambda
+    type act = Lambda.lambda
+
+    let make_is_nonzero arg =
+      (* https://github.com/ocaml/ocaml/pull/10681 *)
+      Lprim (Pintcomp Cne,
+             [arg; Lconst (Const_base (Const_int 0))],
+             loc_none)
+
+    let arg_as_test (arg : arg) : test = arg
+
+    (* these are unused on some OCaml versions *)
+    let _ = make_is_nonzero, arg_as_test
+
+    let make_prim p args = lprim p args
+    let make_offset arg n = match n with
+    | 0 -> arg
+    | _ -> lprim (Poffsetint n) [arg]
+
+    let bind arg body =
+      let newvar,newarg = match arg with
+      | Lvar v -> v,arg
+      | _      ->
+          let newvar = fresh "switcher" in
+          newvar,Lvar newvar in
+      bind Alias newvar arg (body newarg)
+    let make_const i = Lconst (Const_base (Const_int i))
+    let make_isout h arg = lprim Pisout [h ; arg]
+    let make_isin h arg = lprim Pnot [make_isout h arg]
+    let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
+    let make_switch arg cases acts =
+      let l = ref [] in
+      for i = Array.length cases-1 downto 0 do
+        l := (i,acts.(cases.(i))) ::  !l
+      done ;
+      lswitch arg
+        {sw_numconsts = Array.length cases ; sw_consts = !l ;
+         sw_numblocks = 0 ; sw_blocks =  []  ;
+         sw_failaction = None}
+    let make_switch _loc = make_switch
+    let make_catch d =
+      match d with
+      | Lstaticraise (i, []) -> i, (fun e -> e)
+      | _ ->
+         let i = next_raise_count () in
+         i, fun e -> Lstaticcatch(e, (i, []), d)
+    let make_exit i = Lstaticraise (i,[])
+  end)
+
+  let compile_int_switch scr overlapped_cases =
+    assert (overlapped_cases <> []);
+    let actions = Array.of_list (overlapped_cases |> List.map snd) in
+    let cases = overlapped_cases
+      |> List.mapi (fun idx (`Intrange (min, max), _) -> (min, max, idx))
+      |> List.stable_sort (fun (min, _max, _idx) (min', _max', _idx') -> compare min min')
+      |> to_disjoint_intervals Hole in
+    let occurrences = Array.make (Array.length actions) 0 in
+    let rec count_occurrences = function
+      | [] -> assert false
+      | [(_min, _max, act)] ->
+         occurrences.(act) <- occurrences.(act) + 1
+      | (_min, max, act) :: (((min', _max', _act') :: _) as rest) ->
+         occurrences.(act) <- occurrences.(act) + 1;
+         begin if max + 1 <> min' then
+           (* When the interval list contains a hole, jump tables generated by
+              switch.ml may contain spurious references to action 0.
+              See PR#6805 *)
+           occurrences.(0) <- occurrences.(0) + 1
+         end;
+         count_occurrences rest in
+    count_occurrences cases;
+    let open Switch in
+    let store (*: Lambda.lambda t_store*) =
+      { act_get = (fun () ->
+          Array.copy actions);
+        act_get_shared = (fun () ->
+          actions |> Array.mapi (fun i act ->
+            if occurrences.(i) > 1 then Shared act else Single act));
+        act_store = (fun _ -> failwith "store unimplemented");
+        act_store_shared = (fun _ -> failwith "store_shared unimplemented") } in
+    let cases = Array.of_list cases in
+    let (low, _, _) = cases.(0) and (_, high, _) = cases.(Array.length cases - 1) in
+    Switcher.zyva Location.none (low, high) scr cases store
+end
+
+type global_value =
+  | Glob_val of lambda
+  | Glob_prim of Primitive.description
+  | Identity
+
+let lookup env v =
+  let open Types in
+  let open Primitive in
+  let (path, descr) =
+    try
+      Env.lookup_value ~loc:Location.none (*parse_loc loc*) v env
+    with Not_found ->
+      let rec try_stdlib = let open Longident in function
+        | Lident s -> Ldot (Lident "Stdlib", s)
+        | Ldot (id, s) -> Ldot (try_stdlib id, s)
+        | Lapply _ as l -> l in
+      try Env.lookup_value ~loc:Location.none (try_stdlib v) env
+      with Not_found ->
+        failwith ("global not found: " ^ String.concat "." (Longident.flatten v)) in
+  match descr.val_kind with
+  | Val_reg -> Glob_val (transl_value_path loc_none env path)
+  | Val_prim(p) ->
+     (match p.prim_name with
+     | "%equal" ->
+        Glob_prim (Primitive.simple ~name:"caml_equal" ~arity:2 ~alloc:true)
+     | "%compare" ->
+        Glob_prim (Primitive.simple ~name:"caml_compare" ~arity:2 ~alloc:true)
+     | "%identity" ->
+        Identity
+     | s when s.[0] = '%' ->
+        failwith ("unimplemented primitive " ^ p.prim_name);
+     | _ ->
+        Glob_prim p)
+  | _ -> failwith "unexpected kind of value"
+
+
+let identity_to_lambda args =
+  match args with
+  | [] ->
+     let param = fresh "prim" in
+     lfunction [param] (Lvar param)
+  | [x] -> x
+  | fn :: args -> lapply fn args
+
+let builtin env path args =
+  let p = match path with
+    | path1 :: pathrest ->
+       List.fold_left (fun id s -> Longident.Ldot (id, s))
+         (Longident.Lident path1) pathrest
+    | _ -> assert false in
+  match lookup env p with
+  | Glob_val v ->
+     lapply v args
+  | Glob_prim p ->
+     assert (p.prim_arity = List.length args);
+     lprim (Pccall p) args
+  | Identity ->
+     identity_to_lambda args
+
+
+let global_to_lambda = function
+  | Glob_val v -> v
+  | Glob_prim p ->
+     (* Eta-expand this primitive. See translprim.ml. *)
+     let rec make_params n =
+       if n <= 0 then []
+       else fresh "prim" :: make_params (n-1) in
+     let params = make_params p.prim_arity in
+     let body = lprim (Pccall p) (List.map (fun x -> Lvar x) params) in
+     lfunction params body
+  | Identity -> identity_to_lambda []
+
+let rec to_lambda env = function
+  | Mvar v ->
+     Lvar v
+  | Mlambda (params, e) ->
+     if List.length params > max_arity () then
+        (* we have to split the function *)
+        let rec extractk k xs = match k, xs with
+         | 0, xs -> [], xs
+         | _, [] -> failwith "extractk"
+         | k, x::xs ->
+            let first, last = extractk (k-1) xs in
+            x::first, last in
+        let params1, params2 = extractk (max_arity ()) params in
+        let e = Mlambda (params2, e) in
+        lfunction params1 (to_lambda env e)
+     else
+        lfunction params (to_lambda env e)
+  | Mapply (fn, args) ->
+     let ap_func fn = lapply fn (List.map (to_lambda env) args) in
+     (match fn with
+     | Mglobal v ->
+        (match lookup env v with
+        | Glob_prim p when p.prim_arity = List.length args ->
+           lprim (Pccall p) (List.map (to_lambda env) args)
+        | Identity -> identity_to_lambda (List.map (to_lambda env) args)
+        | g -> ap_func (global_to_lambda g))
+     | fn ->
+        ap_func (to_lambda env fn))
+  | Mlet (bindings, body) ->
+     bindings_to_lambda env bindings (to_lambda env body)
+  | Mnum (`Int n) ->
+     Lconst (Const_base (Const_int n))
+  | Mnum (`Int32 n) ->
+     Lconst (Const_base (Const_int32 n))
+  | Mnum (`Int64 n) ->
+     Lconst (Const_base (Const_int64 n))
+  | Mnum (`Bigint n) ->
+     (match Z.to_int n with
+     | n' ->
+        assert (Obj.repr n = Obj.repr n');
+        Lconst (Const_base (Const_int n'))
+     | exception Z.Overflow ->
+        builtin env ["Z"; "of_string"] [Lconst (Const_immstring (Z.to_string n))])
+  | Mnum (`Float64 f) ->
+     Lconst (Const_base (Const_float (string_of_float f)))
+  | Mstring s ->
+     Lconst (Const_immstring s)
+  | Mglobal v ->
+     global_to_lambda (lookup env v)
+  | Mswitch (scr, cases) ->
+     let scr = to_lambda env scr in
+     let rec flatten acc = function
+       | ([], _) :: _ -> assert false
+       | ([sel], e) :: rest -> flatten ((sel, to_lambda env e) :: acc) rest
+       | (sels, e) :: rest ->
+          let i = next_raise_count () in
+          let cases = List.map (fun s -> s, Lstaticraise(i, [])) sels in
+          Lstaticcatch (flatten (cases @ acc) rest, (i, []), to_lambda env e)
+       | [] ->
+          let rec partition (ints, tags, deftag) = function
+            | [] -> (List.rev ints, List.rev tags, deftag)
+            | (`Tag _, _) as c :: cases -> partition (ints, c :: tags, deftag) cases
+            | (`Deftag, _) as c :: cases -> partition (ints, tags, Some c) cases
+            | (`Intrange _, _) as c :: cases -> partition (c :: ints, tags, deftag) cases in
+          let (intcases, tagcases, deftag) = partition ([],[],None) (List.rev acc) in
+          lbind "switch" scr (fun scr ->
+            let tagswitch = match tagcases, deftag with
+              | [], None -> None
+              | [_,e], None | [], Some (_, e) -> Some e
+              | tags, def ->
+                 let numtags = match def with
+                   | Some _ -> (max_tag :> int)
+                   | None -> 1 + List.fold_left (fun s (`Tag i, _) -> max s (i :> int)) (-1) tags in
+                 Some (lswitch scr {
+                   sw_numconsts = 0; sw_consts = []; sw_numblocks = numtags;
+                   sw_blocks = List.map (fun (`Tag i, e) -> i, e) tags;
+                   sw_failaction = match def with None -> None | Some (`Deftag,e) -> Some e
+                 }) in
+            let intswitch = match intcases with
+              | [] -> None
+              | [_,e] -> Some e
+              | ints -> Some (IntSwitch.compile_int_switch scr ints) in
+            match intswitch, tagswitch with
+            | None, None -> assert false
+            | None, Some e | Some e, None -> e
+            | Some eint, Some etag ->
+               Lifthenelse (lprim Pisint [scr], eint, etag)) in
+     flatten [] cases
+  | Mnumop1 (op, ty, e) ->
+     let e = to_lambda env e in
+     let ones32 = Const_base (Asttypes.Const_int32 (Int32.of_int (-1))) in
+     let ones64 = Const_base (Asttypes.Const_int64 (Int64.of_int (-1))) in
+     let code = match op, ty with
+       | `Neg, `Int -> lprim Pnegint [e]
+       | `Neg, `Int32 -> lprim (Pnegbint Pint32) [e]
+       | `Neg, `Int64 -> lprim (Pnegbint Pint64) [e]
+       | `Neg, `Bigint -> builtin env ["Z"; "neg"] [e]
+       | `Neg, `Float64 -> lprim Pnegfloat [e]
+       | `Not, `Int -> lprim Pnot [e]
+       | `Not, `Int32 ->
+          lprim (Pxorbint Pint32) [e; Lconst ones32]
+       | `Not, `Int64 ->
+          lprim (Pxorbint Pint64) [e; Lconst ones64]
+       | `Not, `Bigint -> builtin env ["Z"; "lognot"] [e] 
+       | `Not, `Float64 -> assert false in
+     code
+  | Mnumop2 (op, ((`Int|`Int32|`Int64) as ty), e1, e2) ->
+     let e1 = to_lambda env e1 in
+     let e2 = to_lambda env e2 in
+     let prim = match ty with
+       | `Int ->
+          (match op with
+            `Add -> Paddint | `Sub -> Psubint | `Mul -> Pmulint
+          | `Div -> Pdivint Safe | `Mod -> Pmodint Safe
+          | `And -> Pandint | `Or -> Porint | `Xor -> Pxorint
+          | `Lsl -> Plslint | `Lsr -> Plsrint | `Asr -> Pasrint
+          | `Lt -> Pintcomp Clt | `Gt -> Pintcomp Cgt
+          | `Lte -> Pintcomp Cle | `Gte -> Pintcomp Cge
+          | `Eq -> Pintcomp Ceq)
+       | (`Int32 | `Int64) as ty ->
+          let t = match ty with `Int32 -> Pint32  | `Int64 -> Pint64 in
+          (match op with
+            `Add -> Paddbint t | `Sub -> Psubbint t | `Mul -> Pmulbint t
+          | `Div -> Pdivbint { size = t; is_safe = Safe }
+          | `Mod -> Pmodbint { size = t; is_safe = Safe }
+          | `And -> Pandbint t | `Or -> Porbint t | `Xor -> Pxorbint t
+          | `Lsl -> Plslbint t | `Lsr -> Plsrbint t | `Asr -> Pasrbint t
+          | `Lt -> Pbintcomp (t, Clt) | `Gt -> Pbintcomp (t, Cgt)
+          | `Lte -> Pbintcomp (t, Cle) | `Gte -> Pbintcomp (t, Cge)
+          | `Eq -> Pbintcomp (t, Ceq)) in
+     lprim prim [e1; e2]
+  | Mnumop2 (op, `Bigint, e1, e2) ->
+     let e1 = to_lambda env e1 in
+     let e2 = to_lambda env e2 in
+     let fn = match op with
+       | `Add -> "add" | `Sub -> "sub"
+       | `Mul -> "mul" | `Div -> "div" | `Mod -> "rem"
+       | `And -> "logand" | `Or -> "logor" | `Xor -> "logxor"
+       | `Lsl -> "shift_left" | `Lsr -> "shift_right" | `Asr -> "shift_right"
+       | `Lt -> "lt" | `Gt -> "gt"
+       | `Lte -> "leq" | `Gte -> "geq" | `Eq -> "equal" in
+     builtin env ["Z"; fn] [e1; e2]
+  | Mnumop2 (op, `Float64, e1, e2) ->
+     let e1 = to_lambda env e1 in
+     let e2 = to_lambda env e2 in
+     begin match op with
+     | #binary_bitwise_op -> assert false
+     | `Add -> lprim Paddfloat [e1; e2]
+     | `Sub -> lprim Psubfloat [e1; e2]
+     | `Mul -> lprim Pmulfloat [e1; e2]
+     | `Div -> lprim Pdivfloat [e1; e2]
+     | `Mod -> builtin env ["Stdlib"; "mod_float"] [e1; e2]
+     | #binary_comparison as op ->
+        let cmp_to_float_comparison op = 
+          match op with
+          | `Lt -> CFlt
+          | `Gt -> CFgt
+          | `Lte -> CFle
+          | `Gte -> CFge
+          | `Eq -> CFeq
+        in
+        let cmp = cmp_to_float_comparison op in
+        lprim (Pfloatcomp cmp) [e1; e2]
+     end
+  | Mconvert (src, dst, e) ->
+     let e = to_lambda env e in
+     begin match src, dst with
+       | `Bigint, `Bigint
+       | `Int, `Int
+       | `Int32, `Int32
+       | `Int64, `Int64
+       | `Float64, `Float64 -> e
+       | `Bigint, ((`Int|`Int32|`Int64) as dst) ->
+          (* Zarith raises exceptions on overflow, but we truncate conversions. Not fast. *)
+          let width = match dst with 
+            | `Int -> Sys.word_size - 1
+            | `Int32 -> 32
+            | `Int64 -> 64 in
+          let range = Z.(shift_left (of_int 1) width) in
+          let truncated =
+            lbind "range"
+             (builtin env ["Z"; "of_string"] [Lconst (Const_immstring (Z.to_string range))])
+             (fun range ->
+               lbind "masked"
+                 (builtin env ["Z"; "logand"] [e;
+                      builtin env ["Z"; "sub"] [range;
+                                                Lconst (Const_base (Const_int 1))]])
+                 (fun masked ->
+                   Lifthenelse (builtin env ["Z"; "testbit"] 
+                                  [masked; Lconst (Const_base (Const_int (width - 1)))],
+                                builtin env ["Z"; "sub"] [masked; range],
+                                masked))) in
+          let fn = match dst with
+            | `Int -> "to_int"
+            | `Int32 -> "to_int32"
+            | `Int64 -> "to_int64" in
+          builtin env ["Z"; fn] [truncated]
+       | ((`Int|`Int32|`Int64) as src), `Bigint ->
+          let fn = match src with
+            | `Int -> "of_int"
+            | `Int32 -> "of_int32"
+            | `Int64 -> "of_int64" in
+          builtin env ["Z"; fn] [e]
+       | `Int, `Int32 ->
+          lprim (Pbintofint Pint32) [e]
+       | `Int, `Int64 ->
+          lprim (Pbintofint Pint64) [e]
+       | `Int32, `Int ->
+          lprim (Pintofbint Pint32) [e]
+       | `Int64, `Int ->
+          lprim (Pintofbint Pint64) [e]
+       | `Int32, `Int64 ->
+          lprim (Pcvtbint(Pint32, Pint64)) [e]
+       | `Int64, `Int32 ->
+          lprim (Pcvtbint(Pint64, Pint32)) [e]
+       | `Int, `Float64 ->
+          lprim Pfloatofint [e]
+       | `Int32, `Float64 ->
+          builtin env ["Int32"; "to_float"] [e]
+       | `Int64, `Float64 ->
+          builtin env ["Int64"; "to_float"] [e]
+       | `Bigint, `Float64 ->
+          builtin env ["Z"; "to_float"] [e]
+       (* FIXME: error handling on overflow *)
+       | `Float64, `Int ->
+          lprim Pintoffloat [e]
+       | `Float64, `Int32 ->
+          builtin env ["Int32"; "of_float"] [e]
+       | `Float64, `Int64 ->
+          builtin env ["Int64"; "of_float"] [e]
+       | `Float64, `Bigint ->
+          builtin env ["Z"; "of_float"] [e]
+     end
+  | Mvecnew (`Array, len, def) ->
+     builtin env ["Array"; "make"] [to_lambda env len; to_lambda env def]
+  | Mvecnew (`Bytevec, len, def) ->
+     builtin env ["String"; "make"] [to_lambda env len; to_lambda env def]
+  | Mvecget (ty, vec, idx) ->
+     let prim = match ty with
+       | `Array -> Parrayrefs Paddrarray
+       | `Bytevec -> Pbytesrefs
+(*       | `Floatvec -> Parrayrefs Pfloatarray *) in
+     lprim prim [to_lambda env vec; to_lambda env idx]
+  | Mvecset (ty, vec, idx, v) ->
+     let prim = match ty with
+       | `Array -> Parraysets Paddrarray
+       | `Bytevec -> Pbytessets
+(*       | `Floatvec -> Parraysets Pfloatarray *) in
+     lprim prim [to_lambda env vec; to_lambda env idx; to_lambda env v]
+  | Mveclen (ty, vec) ->
+     let prim = match ty with
+       | `Array -> Parraylength Paddrarray
+       | `Bytevec -> Pbyteslength
+(*       | `Floatvec -> Parraylength Pfloatarray *) in
+     lprim prim [to_lambda env vec]
+  | Mblock (tag, vals) ->
+     lprim (Pmakeblock (tag, Immutable, None)) (List.map (to_lambda env) vals)
+  | Mfield (idx, e) ->
+      lprim (pfield idx) [to_lambda env e]
+  | Mlazy e ->
+     let fn = lfunction [fresh "param"] (to_lambda env e) in
+     lprim (Pmakeblock (Config.lazy_tag, Mutable, None)) [fn]
+  | Mforce e ->
+     Matching.inline_lazy_force (to_lambda env e) loc_none
+
+and bindings_to_lambda env bindings body =
+  List.fold_right (fun b rest -> match b with
+  | `Unnamed e ->
+     Lsequence (to_lambda env e, rest)
+  | `Named (n, e) ->
+     Llet (Strict, Pgenval, n, to_lambda env e, rest)
+  | `Recursive bs ->
+     lletrec (List.map (fun (n, e) -> (n, to_lambda env e)) bs) rest)
+    bindings body
+
+let setup_options options =
+  Clflags.native_code := true;
+  Clflags.flambda_invariant_checks := true;
+  Clflags.nopervasives := false;
+  Clflags.dump_lambda := false;
+  Clflags.dump_cmm := false;
+  Clflags.keep_asm_file := false;
+  Clflags.include_dirs := [Findlib.package_directory "zarith"];
+  Clflags.inlining_report := false;
+  Clflags.dlcode := true;
+  Clflags.shared := false;
+  Clflags.(default_simplify_rounds := 0);
+  (* FIXME: should we use classic_arguments for non-flambda builds? *)
+
+
+  (* Hack: disable the "no cmx" warning for zarith *)
+  let _ = Warnings.parse_options false "-58" in
+  assert (not (Warnings.is_active (Warnings.No_cmx_file "asdf")));
+
+  (options |> List.iter @@ function
+  | `Verbose ->
+     Clflags.dump_lambda := true;
+     Clflags.dump_cmm := true;
+     Clflags.keep_asm_file := true;
+     Clflags.inlining_report := true
+     (*
+       If anyone wants to keep these, there should probably be another option for where to put them.
+       (rather than leaving stale temporary directories around)
+      *)
+  | `Shared ->
+     Clflags.shared := true
+  | `Include dir ->
+     Clflags.include_dirs := dir :: !Clflags.include_dirs
+  | `Package s -> 
+     let packages = String.split_on_char ',' s in
+     let dirs = List.map Findlib.package_directory packages in
+     Clflags.include_dirs := dirs @ !Clflags.include_dirs
+  | `ForPack s -> Clflags.for_package := Some s
+  | `Dontlink _ -> ()
+  | `Linkpkg -> ()
+  | `Debug -> Clflags.debug := true
+  | `Rectypes -> Clflags.recursive_types := true
+  | `Thread -> ()
+  | `Optimize ->   Clflags.(
+    default_simplify_rounds := 2;
+    use_inlining_arguments_set o2_arguments;
+    use_inlining_arguments_set ~round:0 o1_arguments);
+  | `Bytecode -> Clflags.native_code := false
+   );
+  (* FIXME: should we use classic_arguments for non-flambda builds? *)
+
+  Compenv.(readenv Format.std_formatter (Before_compile "malfunction"));
+  compmisc_init_path ()
+
+let module_to_lambda ?options ~module_name:_ ~module_id (Mmod (bindings, exports)) =
+  setup_options (match options with Some o -> o | None -> []);
+  let print_if flag printer arg =
+    if !flag then Format.printf "%a@." printer arg;
+    arg in
+
+  let env = Compmisc.initial_env () in
+  let module_size, code =
+    let bindings = reorder_bindings bindings in
+    let exports = List.map (fun e -> snd (reorder e)) exports in
+    if Config.flambda || not !Clflags.native_code then
+      List.length exports,
+      bindings_to_lambda env bindings
+        (lprim (Pmakeblock (0, Immutable, None)) (List.map (to_lambda env) exports))
+    else begin
+      let loc = loc_none (* FIXME *) in
+      let num_exports = List.length exports in
+      (* Compile all of the bindings, store at positions num_exports + i,
+         then compile the exports. See Translmod.transl_store_gen. *)
+      let module_length = ref (-1) in
+      let mod_store pos e =
+        Lprim (Psetfield (pos, Pointer, Root_initialization),
+               [Lprim (Pgetglobal module_id, [], loc); e], loc) in
+      let mod_load pos =
+        Lprim (pfield pos,
+               [Lprim (Pgetglobal module_id, [], loc)], loc) in
+      let transl_exports subst =
+        let exps = List.mapi (fun i e -> mod_store i (Subst.apply subst (to_lambda env e))) exports in
+        List.fold_right (fun x xs -> Lsequence (x, xs)) exps (Lconst Lambda.const_unit) in
+      let rec transl_toplevel_bindings pos subst = function
+        | `Unnamed e :: rest ->
+           Lsequence (Subst.apply subst (to_lambda env e),
+                      transl_toplevel_bindings pos subst rest)
+        | `Named (n, e) :: rest ->
+           let lam =
+             Llet (Strict, Pgenval, n, Subst.apply subst (to_lambda env e), mod_store pos (Lvar n)) in
+           Lsequence (lam,
+                      transl_toplevel_bindings
+                        (pos + 1)
+                        (Subst.add n (mod_load pos) subst)
+                        rest)
+        | `Recursive bs :: rest ->
+           let ids = List.map fst bs in
+           let stores = ids |> List.mapi (fun i n -> mod_store (pos + i) (Lvar n)) in
+           let stores = List.fold_right (fun x xs -> Lsequence (x, xs))
+                          stores (Lconst Lambda.const_unit) in
+           let lam =
+             lletrec (bs |> List.map (fun (n, e) ->
+                                (n, Subst.apply subst (to_lambda env e))))
+                      stores in
+           let id_load = ids |> List.mapi (fun i n -> (n, mod_load (pos + i))) in
+           let subst = List.fold_left (fun subst (n, l) -> Subst.add n l subst) subst id_load in
+           Lsequence (lam, transl_toplevel_bindings (pos + List.length ids) subst rest)
+
+        | [] -> module_length := pos; transl_exports subst in
+      let r = transl_toplevel_bindings num_exports Subst.empty bindings in
+      !module_length, r
+    end in
+
+  let lambda = code
+  |> print_if Clflags.dump_rawlambda Printlambda.lambda
+  |> simplify_lambda
+  |> print_if Clflags.dump_lambda Printlambda.lambda in
+
+  (module_size, lambda)
+
+
+
+let backend = (module struct
+  include Compilenv
+  include Import_approx
+  include Arch
+  let max_sensible_number_of_arguments =
+    Proc.max_arguments_for_tailcalls - 1
+end : Backend_intf.S)
+
+type outfiles =
+  | Out_native of {cmxfile: string; rest: string list}
+  | Out_bytecode of {cmofile: string; rest: string list}
+
+let delete_temps outfiles =
+  let temps =
+    match outfiles with
+    | Out_native {cmxfile; rest} -> cmxfile::rest
+    | Out_bytecode {cmofile; rest} -> cmofile::rest
+  in
+  List.iter Misc.remove_file temps
+
+type options = [`Verbose | `Shared | `ForPack of string | `Include of string | `Package of string | `Dontlink of string | `Linkpkg | `Debug | `Rectypes | `Thread | `Optimize | `Bytecode] list
+
+let ensure_cmi ~module_name ~filename =
+  let cmi = module_name ^ ".cmi" in
+  Compilenv.reset ?packname:!Clflags.for_package module_name;
+  match load_path_find_uncap cmi with
+  | file -> env_read_signature ~module_name ~file, None
+  | exception Not_found ->
+     let chop_ext =
+         Misc.chop_extensions
+       in
+     let mlifile = chop_ext filename ^ !Config.interface_suffix in
+     if Sys.file_exists mlifile then
+       Typemod.(raise(Error(Location.in_file filename,
+                            Env.empty,
+                            Interface_not_compiled cmi)))
+     else
+       (* hackily generate an empty cmi file *)
+       let cmifile = String.uncapitalize_ascii cmi in
+       let mlifile = String.uncapitalize_ascii (module_name ^ ".mli") in
+       let ch = open_out mlifile in
+       output_string ch "(* autogenerated mli for malfunction *)\n";
+       close_out ch;
+       ignore (Sys.command ("ocamlc -c " ^ mlifile));
+       Misc.remove_file mlifile;
+       if not (Sys.file_exists cmifile) then failwith "Failed to generate empty cmi file";
+       env_read_signature ~module_name ~file:cmifile, Some cmifile
+
+
+let lambda_to_cmx ~options ~filename ~prefixname ~module_name ~module_id lmod =
+  let ppf = Format.std_formatter in
+  let cmxfile = prefixname ^ ".cmx" in
+  let objfile = prefixname ^ Config.ext_obj in
+  let outfiles = ref [objfile] in
+  setup_options options;
+  try
+    env_set_unit_name ~filename ~prefixname ~module_name;
+    let _, cmifile = ensure_cmi ~module_name ~filename in
+    outfiles := Option.to_list cmifile @ !outfiles;
+    (* FIXME: may need to add modules referenced only by "external" to this.
+       See Translmod.primitive_declarations and its use in Asmgen. *)
+    (* FIXME: Translprim.get_used_primitives (see translmod.ml)? *)
+    (* FIXME: Translmod.required_globals? Env.reset_required_globals? Should this be in to_lambda? *)
+    let required_globals = Ident.Set.of_list (Env.get_required_globals ()) in
+    compile_implementation ~prefixname ~filename ~module_id ~backend ~required_globals ~ppf lmod;
+    Compilenv.save_unit_info cmxfile;
+    Warnings.check_fatal ();
+    Out_native {cmxfile; rest = !outfiles}
+  with e ->
+    let bt = Printexc.get_raw_backtrace () in
+    delete_temps (Out_native {cmxfile; rest = !outfiles});
+    Printexc.raise_with_backtrace e bt
+
+let lambda_to_cmo ~options ~filename ~prefixname ~module_name ~module_id (_size, lambda) =
+  let cmofile = prefixname ^ ".cmo" in
+  let outfiles = ref [] in
+  setup_options options;
+  try
+    env_set_unit_name ~filename ~prefixname ~module_name;
+    let _, cmifile = ensure_cmi ~module_name ~filename in
+    outfiles := Option.to_list cmifile @ !outfiles;
+    (* FIXME: may need to add modules referenced only by "external" to this.
+       See Translmod.primitive_declarations and its use in Asmgen. *)
+    (* FIXME: Translprim.get_used_primitives (see translmod.ml)? *)
+    (* FIXME: Translmod.required_globals? Env.reset_required_globals? Should this be in to_lambda? *)
+    let lambda = lprim (Psetglobal module_id) [lambda] in
+    let required_globals = Ident.Set.of_list (Env.get_required_globals ()) in
+    let bytecode = Bytegen.compile_implementation module_name lambda in
+    let oc = open_out_bin cmofile in
+    Fun.protect ~finally:(fun () -> close_out oc) (fun () ->
+      emit_bytecode_to_file oc module_name cmofile ~required_globals bytecode);
+    Warnings.check_fatal ();
+    Out_bytecode {cmofile; rest = !outfiles}
+  with e ->
+    delete_temps (Out_bytecode {cmofile; rest = !outfiles});
+    raise e
+
+let compile_module ?(options=[]) ~filename modl =
+  (* FIXME: do we really want to go through Clflags here? See Compenv.output_prefix *)
+  let prefixname = Compenv.output_prefix filename in
+  let module_name =
+    prefixname
+    |> Filename.basename
+    |> Filename.remove_extension
+    |> String.capitalize_ascii in
+  let lambda_to_output =
+    if List.mem `Bytecode options
+    then lambda_to_cmo
+    else lambda_to_cmx
+  in
+  if not (is_unit_name module_name) then
+    raise (Invalid_argument ("Invalid module name " ^ module_name));
+  let module_id = Ident.create_persistent module_name in
+  modl
+  |> module_to_lambda ~module_name ~module_id ~options
+  |> lambda_to_output ~options ~filename ~prefixname ~module_name ~module_id
+
+let compile_file ~options filename =
+  let lexbuf = Lexing.from_channel (open_in filename) in
+  Lexing.(lexbuf.lex_curr_p <-
+            { lexbuf.lex_curr_p with pos_fname = filename });
+  let modl = Malfunction_parser.read_module lexbuf in
+  compile_module ~options ~filename modl
+
+let compile_cmx ?(options=[]) filename =
+  compile_file ~options filename
+
+let compile_cmo ?(options=[]) filename =
+  compile_file ~options:(`Bytecode :: options) filename
+
+(* copied from opttoploop.ml *)
+external ndl_run_toplevel: string -> string -> (Obj.t, string) result
+  = "caml_natdynlink_run_toplevel"
+external ndl_loadsym: string -> Obj.t = "caml_natdynlink_loadsym"
+
+let code_id = ref 0
+
+let compile_and_load ?(options : options =[]) e =
+  if not Dynlink.is_native then
+    failwith "Loading malfunction values works only in native code";
+  let tmpdir = Filename.temp_file "malfunction" ".tmp" in
+  (* more than a little horrible *)
+  Unix.unlink tmpdir;
+  Unix.mkdir tmpdir 0o700;
+  let old_cwd = Sys.getcwd () in
+  Sys.chdir tmpdir;
+  incr code_id;
+  let modname = "Malfunction_Code_" ^ string_of_int (!code_id) in
+  let modname_uncap = String.uncapitalize_ascii modname in
+  let options = `Shared :: options in
+  let tmpfiles = compile_module ~options ~filename:modname_uncap (Mmod ([], [e])) in
+  let cmxfile =
+    match tmpfiles with
+    | Out_native o -> o.cmxfile
+    | Out_bytecode _ -> failwith "Bytecode loading unsupported"
+  in
+  setup_options options;  (* rescan load path *)
+  begin try
+    Asmlink.link_shared ~ppf_dump:Format.err_formatter [cmxfile] (modname_uncap ^ ".cmxs")
+  with
+  | Asmlink.Error e ->
+     let msg = Format.asprintf "Asmlink error: %a" Asmlink.report_error e in
+     failwith msg
+  end;
+  let cmxs = tmpdir ^ Filename.dir_sep ^ modname_uncap ^ ".cmxs" in
+  (match ndl_run_toplevel cmxs modname with
+  | Ok _ -> ()
+  | Error s -> failwith ("loading failed: " ^ s));
+  let res = Obj.field (ndl_loadsym (Compilenv.symbol_for_global (Ident.create_persistent modname))) 0 in
+  delete_temps tmpfiles;
+  Misc.remove_file cmxs;
+  Sys.chdir old_cwd;
+  Unix.rmdir tmpdir;
+  res
+
+
+
+let link_executable ?(options=[]) output tmpfiles =
+   let cmxfile =
+     match tmpfiles with
+     | Out_native o -> o.cmxfile
+     | Out_bytecode _ -> failwith "Bytecode linking unsupported"
+   in
+   let pkgs =
+      options |> (List.filter_map @@ 
+      function
+      | `Package s -> Some s
+      | _ -> None)
+   in
+   let linkpkg = options |> (List.exists @@ (function `Linkpkg -> true | _ -> false)) in
+   let dontlink =
+      options |> (List.filter_map @@ 
+      function
+      | `Dontlink s -> Some s
+      | _ -> None)
+   in
+   let thread =
+      options |> (List.exists @@ 
+      function
+      | `Thread -> true
+      | _ -> false)
+   in
+   let pkgs =
+     match pkgs with
+     | [] -> []
+     | pkgs -> ["-package"; String.concat "," pkgs] in
+   let dontlink = 
+      if dontlink = [] then []
+      else ["-dontlink"; String.concat "," dontlink]
+   in
+   let linkpkg = if linkpkg then ["-linkpkg"] else [] in
+   let thread = if thread then ["-thread"] else [] in
+   let opts = String.concat " " (thread @ linkpkg @ pkgs @ dontlink) in
+   (* urgh *)
+   Sys.command (Printf.sprintf "ocamlfind ocamlopt %s '%s' -o '%s'"
+                 opts cmxfile output)
diff --git a/malfunction/src/malfunction_compiler.mli b/malfunction/src/malfunction_compiler.mli
new file mode 100644
index 000000000000..591fd035acf6
--- /dev/null
+++ b/malfunction/src/malfunction_compiler.mli
@@ -0,0 +1,18 @@
+
+type outfiles
+val delete_temps : outfiles -> unit 
+
+type options = [`Verbose | `Shared | `ForPack of string | `Include of string | `Package of string | `Dontlink of string | `Linkpkg | `Debug | `Rectypes | `Thread | `Optimize | `Bytecode] list
+
+val compile_module :
+  ?options:options ->
+  filename:string ->
+  Malfunction_parser.moduleexp ->
+  outfiles
+
+val compile_cmx : ?options:options -> string -> outfiles
+val compile_cmo : ?options:options -> string -> outfiles
+
+val link_executable : ?options:options -> string -> outfiles -> int
+
+val compile_and_load : ?options:options -> Malfunction.t -> Obj.t
diff --git a/malfunction/src/malfunction_interpreter.ml b/malfunction/src/malfunction_interpreter.ml
new file mode 100644
index 000000000000..7eb071d34d6e
--- /dev/null
+++ b/malfunction/src/malfunction_interpreter.ml
@@ -0,0 +1,286 @@
+open Malfunction
+
+type value =
+| Block of int * value array
+| Vec of vector_type * value array
+| Func of (value -> value)
+| Int of inttype * Z.t
+| Float of float
+| Thunk of value Lazy.t
+
+exception Error of string
+
+let fail fmt =
+  let k _ppf =
+    raise (Error (Format.flush_str_formatter ())) in
+  Format.kfprintf k Format.str_formatter ("@[" ^^ fmt ^^ "@]")
+
+type op_normal = [`Add|`Sub|`Mul|`Div|`Mod|`And|`Or|`Xor]
+type op_shift = [`Lsl|`Lsr|`Asr]
+type op_cmp = [`Lt|`Gt|`Lte|`Gte|`Eq]
+
+let bitwidth = function
+  | `Int -> Sys.word_size - 1
+  | `Int32 -> 32
+  | `Int64 -> 64
+
+let truncate ty n =
+  Int (ty, match ty with
+  | `Bigint -> n
+  | (`Int|`Int32|`Int64) as ty ->
+     let width = bitwidth ty in
+     let range = Z.(shift_left (of_int 1) width) in
+     let masked = Z.(logand n (sub range (of_int 1))) in
+     let min_int = Z.(shift_right range 1) in
+     if Z.lt masked min_int then masked else
+       Z.(sub masked range)) (* two's complement *)
+
+let as_ty ty = function
+  | Int (ty', n) ->
+     if ty = ty' then n else fail "integer type mismatch"
+  | _ -> fail "expected integer"
+
+let as_float = function
+  | Float f -> f
+  | _ -> fail "expected float64"
+
+let rec interpret locals env : t -> value = function
+  | Mvar v -> Ident.Map.find v locals
+  | Mlambda (xs, e) ->
+     let (x, e) = match xs with
+       | [] -> assert false
+       | [x] -> x, e
+       | (x :: xs) -> x, Mlambda (xs, e) in
+     Func (fun v -> interpret (Ident.Map.add x v locals) env e)
+  | Mapply (f, vs) ->
+     List.fold_left (fun f v -> match f with
+     | Func f -> f (interpret locals env v)
+     | _ -> fail "not a function") (interpret locals env f) vs
+  | Mlet (bindings, body) ->
+     let rec bind locals = function
+       | [] ->
+          interpret locals env body
+       | `Unnamed e :: bindings ->
+          ignore (interpret locals env e);
+          bind locals bindings
+       | `Named (x, e) :: bindings ->
+          let locals = Ident.Map.add x (interpret locals env e) locals in
+          bind locals bindings
+       | `Recursive recs :: bindings ->
+          let n = List.length recs in
+          let values = Array.make n None in
+          let locals = List.fold_right
+            (fun (x, e) locals -> Ident.Map.add x e locals)
+            (List.mapi (fun i (x, e) ->
+              let v = match e with
+                | Mlambda _ -> Func (fun arg ->
+                    match values.(i) with
+                    | Some (Func f) -> f arg
+                    | _ -> fail "bad recursive function binding")
+                | Mlazy _ -> Thunk (lazy (
+                    match values.(i) with
+                    | Some (Thunk t) -> Lazy.force t
+                    | _ -> fail "bad recursive lazy binding"))
+                | _ -> fail "recursive values must be functions or lazy" in
+              (x, v)) recs)
+            locals in
+          recs |> List.iteri (fun i (_, e) ->
+            values.(i) <- Some (interpret locals env e));
+          bind locals bindings in
+     bind locals bindings
+  | Mnum (`Int n) -> Int (`Int, Z.of_int n)
+  | Mnum (`Int32 n) -> Int (`Int32, Z.of_int32 n)
+  | Mnum (`Int64 n) -> Int (`Int64, Z.of_int64 n)
+  | Mnum (`Bigint n) -> Int (`Bigint, n)
+  | Mnum (`Float64 f) -> Float f
+  | Mstring s ->
+     Vec (`Bytevec,
+          Array.init (String.length s) (fun i -> Int (`Int, Z.of_int (Char.code (String.get s i)))))
+  (* These primitives are supported as a hack for testing. See prim.test *)
+  | Mglobal (Ldot (Lident "Stdlib", "**")) ->
+     Func (function Float a -> Func (function Float b -> Float (a ** b)
+                                            | _ -> fail "**: expected float")
+                  | _ -> fail "**: expected float")
+  | Mglobal (Ldot (Lident "Obj", "magic")) ->
+     Func (fun x -> x)
+  | Mglobal _v -> fail "globals unsupported"
+     (*
+     let (path, _descr) = Env.lookup_value v env in
+     let path = Env.normalize_path None env path in
+     let rec lookup = let open Path in function
+       | Pident id -> Symtable.get_global_value id
+       | Pdot (path, _, i) -> Obj.field (lookup path) i
+       | Papply _ -> fail "functor application in global reference" in
+     lookup path
+     *)
+  | Mswitch (scr, cases) ->
+     let scr = interpret locals env scr in
+     let rec find_match = function
+       | (cases, e) :: rest ->
+          if List.exists (fun case -> match case, scr with
+          | `Tag n, Block (n', _) -> n = n'
+          | `Deftag, Block _ -> true
+          | `Intrange (min, max), Int (`Int, n) -> min <= Z.to_int n && Z.to_int n <= max
+          | _, _ -> false) cases then
+            interpret locals env e
+          else
+            find_match rest
+       | [] -> fail "no case matches" in
+     find_match cases
+  | Mnumop1 (op, (#inttype as ty), e) ->
+     let n = as_ty ty (interpret locals env e) in
+     truncate ty (match op with `Neg -> Z.neg n | `Not -> Z.lognot n)
+  | Mnumop2 (op, (#inttype as ty), e1, e2) ->
+     let e1 = interpret locals env e1 in
+     let e2 = interpret locals env e2 in
+     begin match op with
+     | #op_normal as op ->
+        let f = Z.(match op with
+          | `Add -> add | `Sub -> sub
+          | `Mul -> mul | `Div -> div | `Mod -> rem
+          | `And -> logand | `Or -> logor | `Xor -> logxor) in
+        truncate ty (f (as_ty ty e1) (as_ty ty e2))
+     | #op_shift as op ->
+        let n = as_ty ty e1 in
+        let c = Z.to_int (as_ty `Int e2) in
+        let () = match ty with
+          | `Bigint -> ()
+          | (`Int|`Int32|`Int64) as ty ->
+             let w = bitwidth ty in
+             if c < 0 || c >= w then
+               fail "invalid shift count %d" c in
+        truncate ty Z.(match op with
+        | `Lsl -> shift_left n c
+        | `Asr -> shift_right n c
+        | `Lsr ->
+           let n = match ty with
+             | `Bigint -> n
+             | (`Int|`Int32|`Int64) as ty ->
+                let w = bitwidth ty in
+                Z.(logand n (sub (shift_left one w) one)) in
+           shift_right n c)
+     | #op_cmp as op ->
+        let cmp = Z.compare (as_ty ty e1) (as_ty ty e2) in
+        let res = match op with
+          | `Lt -> cmp < 0
+          | `Gt -> cmp > 0
+          | `Lte -> cmp <= 0
+          | `Gte -> cmp >= 0
+          | `Eq -> cmp = 0 in
+        Int (`Int, if res then Z.one else Z.zero)
+     end
+  | Mnumop1 (`Neg, `Float64, e) ->
+     Float (-. (as_float (interpret locals env e)))
+  | Mnumop1 (`Not, `Float64, _)
+  | Mnumop2 (#binary_bitwise_op, `Float64, _, _) ->
+     failwith "invalid bitwise float operation"
+  | Mnumop2 ((#binary_arith_op | #binary_comparison as op),
+             `Float64, e1, e2) ->
+     let e1 = as_float (interpret locals env e1) in
+     let e2 = as_float (interpret locals env e2) in
+     begin match op with
+     | #binary_arith_op as op ->
+        Float (match op with
+          | `Add -> e1 +. e2
+          | `Sub -> e1 -. e2
+          | `Mul -> e1 *. e2
+          | `Div -> e1 /. e2
+          | `Mod -> mod_float e1 e2)
+     | #binary_comparison as op ->
+        let res = match op with
+          | `Lt -> e1 < e2
+          | `Gt -> e1 > e2
+          | `Lte -> e1 <= e2
+          | `Gte -> e1 <= e2
+          | `Eq -> e1 = e2 in
+        Int (`Int, if res then Z.one else Z.zero)
+     end
+  | Mconvert ((#inttype as src), (#inttype as dst), e) ->
+     truncate dst (as_ty src (interpret locals env e))
+  | Mconvert ((#inttype as src), `Float64, e) ->
+     Float (Z.to_float (as_ty src (interpret locals env e)))
+  | Mconvert (`Float64, (#inttype as dst), e) ->
+     (* FIMXE: ? *)
+     truncate dst (Z.of_float (as_float (interpret locals env e)))
+  | Mconvert (`Float64, `Float64, e) ->
+     Float (as_float (interpret locals env e))
+  | Mvecnew (ty, len, def) ->
+     (match ty, interpret locals env len, interpret locals env def with
+     | `Array, Int (`Int, len), v ->
+        Vec (`Array, Array.make (Z.to_int len) v)
+     | `Bytevec, Int (`Int, len), (Int (`Int, k) as v) when 0 <= (Z.to_int k) && (Z.to_int k) < 256 ->
+        Vec (`Bytevec, Array.make (Z.to_int len) v)
+     | _, _, _ -> fail "bad vector creation")
+  | Mvecget (ty, vec, idx) ->
+     (match interpret locals env vec, interpret locals env idx with
+     | Vec (ty', vals), Int (`Int, i) when ty = ty' ->
+        let i = Z.to_int i in
+        if 0 <= i && i < Array.length vals then
+          vals.(i)
+        else
+          fail "index out of bounds: %d" i
+     | _ -> fail "wrong vector type")
+  | Mvecset (ty, vec, idx, e) ->
+     (match interpret locals env vec,
+            interpret locals env idx,
+            interpret locals env e with
+     | Vec (ty', vals), Int (`Int, i), v when ty = ty' ->
+        let i = Z.to_int i in
+        if 0 <= i && i < Array.length vals then begin
+          (match ty, v with
+          |  `Array, _ -> ()
+          | `Bytevec, Int (`Int, i) when 0 <= Z.to_int i && Z.to_int i < 256 -> ()
+          | `Bytevec, _v -> fail "not a byte");
+          vals.(i) <- v; Int (`Int, Z.of_int 0)
+        end else
+          fail "index out of bounds: %d" i
+     | _ -> fail "wrong vector type")
+  | Mveclen (ty, vec) ->
+     (match interpret locals env vec with
+     | Vec (ty', vals) when ty = ty' -> Int (`Int, Z.of_int (Array.length vals))
+     | _ -> fail "wrong vector type")
+  | Mblock (tag, vals) ->
+     Block (tag, Array.of_list (List.map (interpret locals env) vals))
+  | Mfield (idx, b) ->
+     (match interpret locals env b with
+     | Block (_, vals) -> vals.(idx)
+     | _ -> fail "not a block")
+  | Mlazy e ->
+    Thunk (lazy (interpret locals env e))
+  | Mforce e ->
+     (match interpret locals env e with
+      | Thunk (lazy v) -> v
+      | _ -> fail "not a lazy value")
+
+let eval exp =
+  interpret Ident.Map.empty () exp
+
+let loc =
+  let l = Lexing.{pos_fname="<value>"; pos_lnum=0; pos_cnum=0; pos_bol=0} in
+  l,l
+
+let rec render_value = let open Malfunction_sexp in function
+| Block (tag, elems) -> loc, List (
+  (loc, Atom "block")::
+  (loc, List [loc, Atom "tag"; loc, Atom (string_of_int tag)])::
+  List.map render_value (Array.to_list elems))
+| Vec (ty, vals) ->
+  loc, List ((loc, Atom (match ty with `Array -> "vector" | `Bytevec -> "vector.byte"))::
+              List.map render_value (Array.to_list vals))
+| Func _ ->
+  loc, Atom "<function>"
+| Thunk _ ->
+  loc, Atom "<lazy value>"
+| Int (ty, n) ->
+   let ty = match ty with
+     | `Int -> ""
+     | `Int32 -> ".i32"
+     | `Int64 -> ".i64"
+     | `Bigint -> ".ibig" in
+   loc, Atom (Z.to_string n ^ ty)
+| Float f ->
+   let s = match classify_float f with
+     | FP_nan -> "nan"
+     | FP_infinite -> if f < 0. then "neg_infinity" else "infinity"
+     | _ -> string_of_float f in
+   loc, Atom s
diff --git a/malfunction/src/malfunction_interpreter.mli b/malfunction/src/malfunction_interpreter.mli
new file mode 100644
index 000000000000..3097a9302e82
--- /dev/null
+++ b/malfunction/src/malfunction_interpreter.mli
@@ -0,0 +1,14 @@
+open Malfunction
+
+exception Error of string
+
+type value =
+| Block of int * value array
+| Vec of vector_type * value array
+| Func of (value -> value)
+| Int of inttype * Z.t
+| Float of float
+| Thunk of value Lazy.t
+
+val eval : t -> value
+val render_value : value -> Malfunction_sexp.sexp
diff --git a/malfunction/src/malfunction_main.ml b/malfunction/src/malfunction_main.ml
new file mode 100644
index 000000000000..5ef837b09d76
--- /dev/null
+++ b/malfunction/src/malfunction_main.ml
@@ -0,0 +1,110 @@
+open Malfunction
+
+
+let usage () =
+  Printf.fprintf stderr "%s" @@
+    "Malfunction v0.1. Usage:\n"^
+    "   malfunction compile [-v] [-thread] [-linkpkg] [-dontlink pack1,...,packn] [-package pack1,...packn] [-o output] input.mlf\n" ^
+    "     Compile input.mlf to an executable using ocamlfind\n" ^
+    "   malfunction cmx [-v] [-shared] [-package pack1,...,packn] [-for-pack s] input.mlf\n" ^
+    "     Compile input.mlf to input.cmx, for linking with ocamlopt.\n"^
+    "   malfunction cmo [-v] [-shared] [-package pack1,...,packn] [-for-pack s] input.mlf\n" ^
+    "     Compile input.mlf to input.cmo (bytecode), for linking with ocamlc.\n" ^
+    "   malfunction eval\n" ^
+    "     Run a REPL to evaluate expressions with the interpreter\n\n" ^
+    "   malfunction fmt\n" ^
+    "     Reindent the s-expression on standard input\n";
+  2
+
+let repl () =
+  let lexbuf = Lexing.from_channel stdin in
+  let rec loop () =
+    Printf.printf "# %!";
+    with_error_reporting Format.std_formatter () (fun () ->
+      let exp = Malfunction_parser.read_expression lexbuf in
+      match Malfunction_interpreter.eval exp with
+      | v -> Format.printf "%a\n%!" Malfunction_sexp.print 
+         (Malfunction_interpreter.render_value v);
+         loop ()
+      | exception (Malfunction_interpreter.Error s) ->
+         Format.printf "Undefined behaviour: %s\n%!" s);
+    loop () in
+  try loop () with End_of_file -> ()
+
+let run mode options impl output =
+  Findlib.init ();
+  match mode, impl with
+  | `Cmx, Some file ->
+     with_error_reporting Format.std_formatter 1 (fun () ->
+       let _ = Malfunction_compiler.compile_cmx ~options file in
+       0)
+  | `Cmo, Some file ->
+     with_error_reporting Format.std_formatter 1 (fun () ->
+       let _ = Malfunction_compiler.compile_cmo ~options file in
+       0)
+  | `Compile, Some file ->
+     with_error_reporting Format.std_formatter 1 (fun () ->
+       let tmpfiles = Malfunction_compiler.compile_cmx ~options file in
+       let output = match output with
+         | None -> Compenv.output_prefix file
+         | Some out -> out in
+       let res = Malfunction_compiler.link_executable ~options output tmpfiles in
+       Malfunction_compiler.delete_temps tmpfiles;
+       res)
+  | `Eval, Some _file ->
+     0
+  | `Eval, None ->
+     repl (); 0
+  | `Fmt, impl ->
+     let lexbuf = Lexing.from_channel (match impl with Some f -> open_in f | None -> stdin) in
+     Malfunction_sexp.(read_only_sexp lexbuf |> print Format.std_formatter);
+     Format.printf "\n%!";
+     0
+  | _ -> usage ()
+
+
+let parse_args args =
+  let impl = ref None in
+  let output = ref None in
+  let opts = ref [] in
+  let rec parse_opts mode = function
+    | "-v" :: rest -> opts := `Verbose :: !opts; parse_opts mode rest
+    | "-o" :: o :: rest -> output := Some o; parse_opts mode rest
+    | "-shared" :: rest -> opts := `Shared :: !opts; parse_opts mode rest
+    | "-for-pack" :: o :: rest -> opts := `ForPack o :: !opts; parse_opts mode rest
+    | "-I" :: s :: rest -> opts := `Include s :: !opts; parse_opts mode rest
+    | "-package" :: s :: rest -> opts := `Package s :: !opts; parse_opts mode rest
+    | "-dontlink" :: s :: rest -> 
+      if mode = `Compile then (opts := `Dontlink s :: !opts; parse_opts mode rest)
+      else usage ()
+    | "-linkpkg" :: rest -> 
+      if mode = `Compile then (opts := `Linkpkg :: !opts; parse_opts mode rest)
+      else usage ()
+    | "-g" :: rest -> opts := `Debug :: !opts; parse_opts mode rest
+    | "-rectypes" :: rest -> opts := `Rectypes :: !opts; parse_opts mode rest
+    | "-thread" :: rest -> 
+        if mode = `Compile then (opts := `Thread :: !opts; parse_opts mode rest)
+        else usage ()
+    | "-O2" :: rest -> opts := `Optimize :: !opts; parse_opts mode rest
+    | i :: rest ->
+       (match !impl with None -> (impl := Some i; parse_opts mode rest) | _ -> usage ())
+    | [] -> run mode !opts !impl !output in
+  match args with
+  | "cmx" :: rest -> parse_opts `Cmx rest
+  | "cmo" :: rest -> parse_opts `Cmo rest
+  | "compile" :: rest -> parse_opts `Compile rest
+  | "eval" :: rest -> parse_opts `Eval rest
+  | "fmt" :: rest -> parse_opts `Fmt rest
+  | _ -> usage ()
+
+(*
+let () =
+  if not Config.flambda then begin
+    Format.fprintf Format.err_formatter 
+      "Malfunction requires a version of OCaml with Flambda enabled\n\
+       Try \"opam switch 4.03.0+flambda\"\n";
+    exit 1
+  end
+ *)
+
+let _ = exit (parse_args (List.tl (Array.to_list Sys.argv)))
diff --git a/malfunction/src/malfunction_parser.ml b/malfunction/src/malfunction_parser.ml
new file mode 100644
index 000000000000..5f66be460fa9
--- /dev/null
+++ b/malfunction/src/malfunction_parser.ml
@@ -0,0 +1,285 @@
+open Malfunction
+open Malfunction_sexp
+
+type moduleexp =
+| Mmod of binding list * t list
+
+(* Compiling from sexps *)
+
+let fail loc fmt =
+  let k _ppf =
+    raise (SyntaxError (loc, Format.flush_str_formatter ())) in
+  Format.kfprintf k Format.str_formatter ("@[" ^^ fmt ^^ "@]")
+
+module StrMap = Map.Make (struct type t = string let compare = compare end)
+
+let bind_local _loc locals s ident =
+  StrMap.add s ident locals
+
+let parse_arglist = function
+  | loc, List [] ->
+     fail loc "a nonempty argument list is required"
+  | loc, List args ->
+     let idents = args |> List.map (function
+       | _loc, Var s ->
+          s, fresh s
+       | loc, _ -> fail loc "Expected a list of variables") in
+     let env = List.fold_left (fun env (s, ident) ->
+       if StrMap.mem s env then
+         fail loc "Parameter %s bound multiple times" s
+       else
+         bind_local loc env s ident) StrMap.empty idents in
+     List.map snd idents, env
+  | loc, _ -> fail loc "Expected a list of atoms"
+
+let parse_tag = function
+| loc, List [_, Atom "tag"; _, Atom n] ->
+   begin match int_of_string n with
+   | n when 0 <= n && n < (max_tag :> int) -> n
+   | n -> fail loc "tag %d out of range [0,%d]" n ((max_tag :> int)-1)
+   | exception (Failure _) -> fail loc "invalid tag %s" n end
+| loc, _ -> fail loc "invalid tag"
+
+let inttypes = [`Int, ".int" ; `Int32, ".i32" ; `Int64, ".i64" ; `Bigint, ".ibig"]
+let numtypes = inttypes @ [`Float64, ".f64"]
+
+let (unary_intops_by_name : (unary_num_op * numtype) StrMap.t),
+    (binary_intops_by_name : (binary_num_op * numtype) StrMap.t),
+    (conversions_by_name : (numtype * numtype) StrMap.t),
+    (numtypes_by_name : numtype StrMap.t) =
+  let unary_ops = [ `Neg, "neg"; `Not, "not" ] in
+  let binarith_ops = [ `Add, "+" ; `Sub, "-" ; `Mul, "*" ; `Div, "/" ; `Mod, "%" ] in
+  let bitwise_ops = [ `And, "&" ; `Or, "|" ; `Xor, "^" ; `Lsl, "<<" ; `Lsr, ">>"  ; `Asr, "a>>" ] in
+  let comparison_ops = [ `Lt, "<" ; `Gt, ">" ; `Lte, "<=" ; `Gte, ">=" ; `Eq, "==" ] in
+  let binary_ops =
+    binarith_ops @ bitwise_ops @ comparison_ops in
+  let deftypes = (`Int, "") :: numtypes in
+  let () = (* check that all cases are handled here *)
+    List.iter (function #unary_num_op, _ -> () | _ -> assert false) unary_ops;
+    List.iter (function #binary_num_op, _ -> () | _ -> assert false) binary_ops;
+    List.iter (function #numtype, _ -> () | _ -> assert false) numtypes in
+  List.fold_right (fun (ty,tyname) ->
+    List.fold_right (fun (op,opname) ->
+      StrMap.add (opname ^ tyname) (op, ty)) unary_ops) deftypes StrMap.empty,
+  (List.fold_right (fun (ty,tyname) ->
+     List.fold_right (fun (op,opname) ->
+       StrMap.add (opname ^ tyname) (op, ty)) binary_ops) deftypes StrMap.empty
+   |> List.fold_right (fun (_ty,tyname) ->
+        List.fold_right (fun (_op, opname) ->
+          StrMap.remove (opname ^ tyname)) bitwise_ops) [`Float64, ".f64"]),
+  List.fold_right (fun (op1, opname1) ->
+    List.fold_right (fun (op2, opname2) ->
+      StrMap.add ("convert" ^ opname1 ^ opname2) (op1, op2)) numtypes) numtypes StrMap.empty,
+  List.fold_right (fun (ty, name) ->
+      StrMap.add name ty) numtypes StrMap.empty
+
+
+let vecops_by_name op =
+  List.fold_right (fun (ty,tyname) ->
+    StrMap.add (op ^ tyname) ty)
+    [`Array, ""; `Bytevec, ".byte"]
+    StrMap.empty
+let vec_new_by_name = vecops_by_name "makevec"
+let vec_get_by_name = vecops_by_name "load"
+let vec_set_by_name = vecops_by_name "store"
+let vec_len_by_name = vecops_by_name "length"
+
+(*
+(let
+  (a 42)
+  (b 17)
+  (_ 421)
+  (rec (a (lambda)))
+
+*)
+
+let rec parse_bindings loc env acc = function
+  | [e] ->
+     List.rev acc, env, e
+  | (loc, List [_, Atom "_"; e]) :: bindings ->
+     parse_bindings loc env (`Unnamed (parse_exp env e) :: acc) bindings
+  | (loc, List [_, Var s; e]) :: bindings ->
+     let ident = fresh s in
+     let env' = bind_local loc env s ident in
+     parse_bindings loc env' (`Named (ident, parse_exp env e) :: acc) bindings
+  | (loc, List ((_, Atom "rec") :: recs)) :: bindings ->
+     let recs = recs |> List.map (function
+       | _, List [_, Var s; _, List ((_, Atom ("lambda"|"lazy")) :: _) as e] ->
+          (s, fresh s, e)
+       | _, List [_, Var _; _] ->
+          fail loc "all members of a recursive binding must be functions or lazy"
+       | loc, _ ->
+          fail loc "expected recursive bindings") in
+     let env' = List.fold_left (fun env (s, id, _) ->
+       bind_local loc env s id) env recs in
+     let recs = recs |> List.map (fun (_, id, e) ->
+       (id, parse_exp env' e)) in
+     parse_bindings loc env' (`Recursive recs :: acc) bindings
+  | _ -> fail loc "no bindings?"
+
+and parse_exp env (loc, sexp) = match sexp with
+  | Var s when StrMap.mem s env ->
+     Mvar (StrMap.find s env)
+
+  | Var s ->
+     fail loc "'%s' is unbound" s
+
+  | List [_, Atom "lambda"; args; exp] ->
+     let (params, newenv) = parse_arglist args in
+     let env = StrMap.fold StrMap.add newenv env in
+     Mlambda (params, parse_exp env exp)
+
+  | List ((_loc, Atom "apply") :: func :: args) ->
+     if args = [] then fail loc "Expected a nonempty parameter list";
+     Mapply (parse_exp env func, List.map (parse_exp env) args)
+
+  | List ((loc, Atom "let") :: bindings) ->
+     let (bindings, env, e) = parse_bindings loc env [] bindings in
+     Mlet (bindings, parse_exp env e)
+
+  | List ((_loc, Atom "seq") :: ((_ :: _) as exps)) ->
+     let rec to_let acc = function
+       | [] -> assert false
+       | [e] -> Mlet (List.rev acc, parse_exp env e)
+       | e :: es -> to_let (`Unnamed (parse_exp env e) :: acc) es in
+     to_let [] exps
+
+  | List ((_, Atom "switch") :: exp :: cases) ->
+     let parse_selector s = try match s with
+       | _, List [_, Atom "tag"; _, Atom "_"] -> `Deftag
+       | _, List ([_, Atom "tag"; _]) as t -> `Tag (parse_tag t)
+       | _, List [_, Atom min; _, Atom max] -> `Intrange (int_of_string min, int_of_string max)
+       | _, Atom "_" -> `Intrange (min_int, max_int)
+       | _, Atom n -> `Intrange (int_of_string n, int_of_string n)
+       | loc, _ -> fail loc "invalid selector"
+       with Failure _ -> fail loc "invalid selector" in
+
+     let rec parse_case loc acc = function
+       | [s; e] -> List.rev (parse_selector s :: acc), parse_exp env e
+       | (s :: c) -> parse_case loc (parse_selector s :: acc) c
+       | _ -> fail loc "invalid case" in
+
+     let cases = List.map (function
+       | loc, List c -> parse_case loc [] c
+       | loc, _ -> fail loc "invalid case") cases in
+
+     if (List.length (List.sort_uniq compare cases) <> List.length cases) then
+       fail loc "duplicate cases";
+
+     Mswitch (parse_exp env exp, cases)
+
+  | List [_, Atom "if"; cond; tt; ff] ->
+     Mswitch (parse_exp env cond, 
+              [[`Intrange (0, 0)], parse_exp env ff;
+               [`Intrange (min_int, max_int); `Deftag], parse_exp env tt])
+
+  | List [_, Atom s; e] when StrMap.mem s unary_intops_by_name ->
+     let (op, ty) = StrMap.find s unary_intops_by_name in
+     Mnumop1 (op, ty, parse_exp env e)
+
+  | List [_, Atom s; e1; e2] when StrMap.mem s binary_intops_by_name ->
+     let (op, ty) = StrMap.find s binary_intops_by_name in
+     Mnumop2 (op, ty, parse_exp env e1, parse_exp env e2)
+
+  | List [_, Atom s; e1] when StrMap.mem s conversions_by_name ->
+     let (ty1, ty2) = StrMap.find s conversions_by_name in
+     Mconvert (ty1, ty2, parse_exp env e1)
+
+  | List [_, Atom op; len; def] when StrMap.mem op vec_new_by_name ->
+     Mvecnew (StrMap.find op vec_new_by_name, parse_exp env len, parse_exp env def)
+
+  | List [_, Atom op; vec; idx] when StrMap.mem op vec_get_by_name ->
+     Mvecget (StrMap.find op vec_get_by_name, parse_exp env vec, parse_exp env idx)
+
+  | List [_, Atom op; vec; idx; v] when StrMap.mem op vec_set_by_name ->
+     Mvecset (StrMap.find op vec_set_by_name, parse_exp env vec, parse_exp env idx, parse_exp env v)
+
+  | List [_, Atom op; vec] when StrMap.mem op vec_len_by_name ->
+     Mveclen (StrMap.find op vec_len_by_name, parse_exp env vec)
+
+  | List ((_, Atom "block") :: tag :: fields) ->
+     Mblock (parse_tag tag, List.map (parse_exp env) fields)
+
+  | List [_, Atom "field"; _, Atom n; e] ->
+     let n = match int_of_string n with
+       | n -> n
+       | exception (Failure _) -> fail loc "invalid field number" in
+     Mfield (n, parse_exp env e)
+
+  | String s ->
+     Mstring s
+
+  | List [_, Atom "lazy"; e] ->
+     Mlazy (parse_exp env e)
+
+  | List [_, Atom "force"; e] ->
+     Mforce (parse_exp env e)
+
+  | List ((_, Atom "global") :: path) ->
+     Mglobal (path
+       |> (function
+           | (l, Var "Pervasives")::p ->
+              Printf.fprintf stderr "Warning: global $Pervasives is deprecated, use $Stdlib instead.\n";
+              (l, Var "Stdlib")::p
+           | p -> p)
+       |> List.map (function
+         | _, Var s -> s
+         | _, _ -> fail loc "module path required")
+       |> function
+         | [] -> fail loc "empty global path"
+         | path1 :: pathrest ->
+            List.fold_left (fun id s ->
+              Longident.Ldot (id, s)) (Longident.Lident path1) pathrest)
+
+  | List ((_, Atom s) :: rest) ->
+     fail loc "Unknown %d-ary operation %s" (List.length rest) s
+
+  | Atom "nan" -> Mnum (`Float64 nan)
+  | Atom "infinity" -> Mnum (`Float64 infinity)
+  | Atom "neg_infinity" -> Mnum (`Float64 neg_infinity)
+
+  | Atom s ->
+     let orig = s in
+     let s, ext = match String.rindex s '.' with
+       | i ->
+          String.sub s 0 i,
+          String.sub s i (String.length s - i)
+       | exception Not_found ->
+          s, ".int" in
+     begin
+       try match StrMap.find ext numtypes_by_name with
+       | `Int -> Mnum (`Int (int_of_string s))
+       | `Int32 -> Mnum (`Int32 (Int32.of_string s))
+       | `Int64 -> Mnum (`Int64 (Int64.of_string s))
+       | `Bigint -> Mnum (`Bigint (Z.of_string s))
+       | `Float64 -> Mnum (`Float64 (float_of_string s))
+       with
+       | Not_found ->
+          (try Mnum (`Float64 (float_of_string orig))
+           with Invalid_argument _ ->
+             fail loc "unknown constant type: '%s'" ext)
+       | Invalid_argument _ | Failure _ ->
+          fail loc "constant '%s' out of bounds for '%s'" s ext
+     end
+
+  | _ -> fail loc "syntax error"
+
+
+let parse_mod (loc, sexp) = match sexp with
+  | List ((_, Atom "module") :: rest) ->
+     let (bindings, env, exports) = parse_bindings loc StrMap.empty [] rest in
+     let exports = match exports with
+       | _, List ((_, Atom "export") :: exports) ->
+          List.map (parse_exp env) exports
+       | _ -> fail loc "export list?" in
+     Mmod (bindings, exports)
+  | _ -> fail loc "mod?"
+
+let read_expression lexbuf =
+  parse_exp StrMap.empty (Malfunction_sexp.read_next_sexp lexbuf)
+
+let parse_expression t =
+  parse_exp StrMap.empty t
+
+let read_module lexbuf =
+  parse_mod (Malfunction_sexp.read_only_sexp lexbuf)
diff --git a/malfunction/src/malfunction_parser.mli b/malfunction/src/malfunction_parser.mli
new file mode 100644
index 000000000000..55d341966ac3
--- /dev/null
+++ b/malfunction/src/malfunction_parser.mli
@@ -0,0 +1,12 @@
+open Malfunction
+
+type moduleexp =
+| Mmod of binding list * t list
+
+(* Read the next expression from a lexbuf *)
+val read_expression : Lexing.lexbuf -> t
+
+val parse_expression : Malfunction_sexp.sexp -> t
+
+(* Read an entire module from a lexbuf (must be followed by EOF) *)
+val read_module : Lexing.lexbuf -> moduleexp
diff --git a/malfunction/src/malfunction_sexp.mli b/malfunction/src/malfunction_sexp.mli
new file mode 100644
index 000000000000..f4f4d5cc7c35
--- /dev/null
+++ b/malfunction/src/malfunction_sexp.mli
@@ -0,0 +1,14 @@
+exception SyntaxError of (Lexing.position * Lexing.position) * string
+
+type sexp =
+  (Lexing.position * Lexing.position) * rawsexp
+and rawsexp =
+| Atom of string
+| Var of string
+| String of string
+| List of sexp list
+
+val read_next_sexp : Lexing.lexbuf -> sexp
+val read_only_sexp : Lexing.lexbuf -> sexp
+
+val print : Format.formatter -> sexp -> unit
diff --git a/malfunction/src/malfunction_sexp.mll b/malfunction/src/malfunction_sexp.mll
new file mode 100644
index 000000000000..82f490179d8c
--- /dev/null
+++ b/malfunction/src/malfunction_sexp.mll
@@ -0,0 +1,93 @@
+{
+exception SyntaxError of (Lexing.position * Lexing.position) * string
+type sexp =
+  (Lexing.position * Lexing.position) * rawsexp
+and rawsexp =
+| Atom of string
+| Var of string
+| String of string
+| List of sexp list
+
+let loc lexbuf f =
+  let open Lexing in
+  let start = lexbuf.lex_start_p in
+  let r = f () in
+  ((start, lexbuf.lex_curr_p), r)
+
+let fail lexbuf s = raise (SyntaxError ((lexbuf.Lexing.lex_start_p, lexbuf.Lexing.lex_curr_p), s))
+
+let var s =
+  assert (s.[0] = '$');
+  Var (String.sub s 1 (String.length s - 1))
+
+let rec print ppf (_, s) = let open Format in match s with
+  | Atom s -> fprintf ppf "%s" s
+  | Var s -> fprintf ppf "$%s" s
+  | String s -> fprintf ppf "%S" s
+  | List l ->
+     fprintf ppf "@[<2>(%a)@]" (pp_print_list ~pp_sep:pp_print_space print) l
+}
+
+let space = [' ' '\t' '\r']*
+
+let symbol = ['.' '&' '|' '+' '/' '-' '!' '@' '#' '%' '^' '*' '~' '?' '{' '}' '<' '>' '=']
+
+let atomsymbol = ['+' '-' '<' '>']
+let letter = ['a'-'z' 'A'-'Z' '_']
+let digit = ['0' - '9']
+
+let atom = (letter | digit | symbol)*
+let var = (['a'-'z' 'A'-'Z' '_' '0'-'9' '$' '\''] | symbol)+
+
+let string = '"' ([^ '\\' '"']* | ('\\' _))* '"'
+
+let comment = ';' [^ '\n']*
+
+(* FIXME: exceptions in int and str cases *)
+rule sexps acc = parse
+| ')'
+  { List.rev acc }
+| '('
+  { sexps (loc lexbuf (fun () -> List (sexps [] lexbuf)) :: acc) lexbuf }
+| string
+  { sexps (loc lexbuf (fun () -> String (Scanf.sscanf (Lexing.lexeme lexbuf) "%S%!" (fun x -> x))) :: acc) lexbuf }
+| '$' var
+  { sexps (loc lexbuf (fun () -> var (Lexing.lexeme lexbuf)) :: acc) lexbuf }
+| atom
+  { sexps (loc lexbuf (fun () -> Atom (Lexing.lexeme lexbuf)) :: acc) lexbuf }
+| '\n'
+  { Lexing.new_line lexbuf; sexps acc lexbuf }
+| comment
+  { sexps acc lexbuf }
+| space
+  { sexps acc lexbuf }
+| eof
+  { fail lexbuf "Unexpected end of file" }
+| _
+  { fail lexbuf ("Lexical error on " ^ (Lexing.lexeme lexbuf)) }
+
+and read_next_sexp = parse
+| '\n'
+  { Lexing.new_line lexbuf; read_next_sexp lexbuf }
+| comment
+  { read_next_sexp lexbuf }
+| space
+  { read_next_sexp lexbuf }
+| '('
+  { loc lexbuf (fun () -> List (sexps [] lexbuf)) }
+| atom
+  { loc lexbuf (fun () -> Atom (Lexing.lexeme lexbuf)) }
+| eof
+  { raise End_of_file }
+| _
+  { fail lexbuf "Sexp must start with '('" }
+
+{
+
+let read_only_sexp lexbuf =
+  let s = read_next_sexp lexbuf in
+  match read_next_sexp lexbuf with
+  | _ -> fail lexbuf "File must contain only one sexp"
+  | exception End_of_file -> s
+
+}
diff --git a/malfunction/test/basic.test b/malfunction/test/basic.test
new file mode 100644
index 000000000000..2b49a4bfbbb8
--- /dev/null
+++ b/malfunction/test/basic.test
@@ -0,0 +1,20 @@
+(test-undefined
+  (field 0 0))
+
+; a comment
+
+(test-differ ; another comment
+  1 2)
+
+(test
+  4983259873495873495734895.ibig 4983259873495873495734895.ibig)
+
+(test
+  0 0)
+
+(test-differ
+  0 (block (tag 0) 42))
+
+(test
+  (block (tag 0) 42)
+  (block (tag 0) 42))
\ No newline at end of file
diff --git a/malfunction/test/conversions.test b/malfunction/test/conversions.test
new file mode 100644
index 000000000000..5a3779c21fa3
--- /dev/null
+++ b/malfunction/test/conversions.test
@@ -0,0 +1,25 @@
+(test-undefined
+  (convert.i32.ibig 420))
+
+(test
+  (convert.i32.i64 49832.i32)
+  49832.i64)
+
+(test
+  (convert.i64.i32 9223372036854775807.i64)
+  -1.i32)
+
+(test
+  (convert.ibig.i32 -1.ibig)
+  -1.i32)
+
+
+(test
+  (convert.ibig.i64 9223372036854775807.ibig)
+  9223372036854775807.i64)
+
+(test
+  (convert.ibig.i64 9223372036854775808.ibig)
+  -9223372036854775808.i64)
+
+
diff --git a/malfunction/test/dune b/malfunction/test/dune
new file mode 100644
index 000000000000..57cdf9eebe29
--- /dev/null
+++ b/malfunction/test/dune
@@ -0,0 +1,10 @@
+(executable
+ (name test)
+ (modes native)
+ (libraries malfunction omd)
+ (modules test))
+
+(alias
+ (name runtest)
+ (deps (:prog test.exe) ../docs/spec.md (glob_files ../test/*.test))
+ (action (run %{prog} ../docs/spec.md ../test)))
diff --git a/malfunction/test/evalorder.test b/malfunction/test/evalorder.test
new file mode 100644
index 000000000000..d7ea5228f6c5
--- /dev/null
+++ b/malfunction/test/evalorder.test
@@ -0,0 +1,27 @@
+(test
+  (let
+    ($a (makevec 1 0))
+    ($f (lambda ($x $y) (load $a 0)))
+    (- (apply $f (store $a 0 10) (store $a 0 20)) (apply $f (store $a 0 1) (store $a 0 2))))
+  18)
+
+(test
+  (let
+    ($fn (lambda ($arg)
+      (let
+        ($a (makevec 1 0))
+        ($f (lambda ($x $y) (load $a 0)))
+        (- (apply $f (store $a 0 10) (store $a 0 20)) (apply $f (store $a 0 1) (store $a 0 2))))))
+    (apply $fn 1))
+  18)
+
+
+(test
+  (let
+    ($th (lazy
+      (let
+        ($a (makevec 1 0))
+        ($f (lambda ($x $y) (load $a 0)))
+        (- (apply $f (store $a 0 10) (store $a 0 20)) (apply $f (store $a 0 1) (store $a 0 2))))))
+    (force $th))
+  18)
diff --git a/malfunction/test/factorial.test b/malfunction/test/factorial.test
new file mode 100644
index 000000000000..0336cb3eced0
--- /dev/null
+++ b/malfunction/test/factorial.test
@@ -0,0 +1,10 @@
+;; Recursive factorial on bigints
+
+(test
+  (let
+    (rec
+      ($fact (lambda ($n)
+        (if (==.ibig $n 0.ibig) 1.ibig (*.ibig (apply $fact (-.ibig $n 1.ibig)) $n)))))
+    (apply $fact 42.ibig))
+  1405006117752879898543142606244511569936384000000000.ibig)
+
diff --git a/malfunction/test/float.test b/malfunction/test/float.test
new file mode 100644
index 000000000000..7226f34d3f2b
--- /dev/null
+++ b/malfunction/test/float.test
@@ -0,0 +1,32 @@
+(test 
+  (block (tag 0) 
+    (+.f64 10. 2.)
+    (-.f64 10. 2.)
+    (*.f64 10. 2.)
+    (/.f64 10. 2.)
+    (%.f64 10. 2.))
+  (block (tag 0) 12. 8. 20. 5. 0.))
+
+(test (%.f64 96.5 5.) 1.5)
+
+(test (/.f64 1. 0.) infinity)
+(test (/.f64 -1. 0.) neg_infinity)
+(test (*.f64 0. infinity) nan)
+(test (==.f64 nan nan) 0)
+
+(test
+  (block (tag 0)
+    (convert.int.f64 100)
+    (convert.i32.f64 100.i32)
+    (convert.i64.f64 100.i64)
+    (convert.ibig.f64 100.ibig))
+  (block (tag 0) 100. 100. 100. 100.))
+
+(test
+  (block (tag 0)
+    (convert.f64.int 100.)
+    (convert.f64.i32 100.)
+    (convert.f64.i64 100.)
+    (convert.f64.ibig 100.))
+  (block (tag 0) 100 100.i32 100.i64 100.ibig))
+
diff --git a/malfunction/test/issue36/dune b/malfunction/test/issue36/dune
new file mode 100644
index 000000000000..ac7125f33d98
--- /dev/null
+++ b/malfunction/test/issue36/dune
@@ -0,0 +1,10 @@
+(rule
+  (target output.txt)
+  (deps run.sh main.ml test_bytestring.mlf test_bytestring.mli %{bin:malfunction})
+  (action (with-stdout-to output.txt (run ./run.sh))))
+
+(alias
+ (name runtest)
+ (deps output.txt)
+ (action (diff expected.txt output.txt)))
+
diff --git a/malfunction/test/issue36/expected.txt b/malfunction/test/issue36/expected.txt
new file mode 100644
index 000000000000..540bae9eb16f
--- /dev/null
+++ b/malfunction/test/issue36/expected.txt
@@ -0,0 +1,3 @@
+Malfunction result: 1 
+Malfunction result, printed as string: 1
+interpreted by OCaml as: Lt
diff --git a/malfunction/test/issue36/main.ml b/malfunction/test/issue36/main.ml
new file mode 100644
index 000000000000..c7fc3eedf891
--- /dev/null
+++ b/malfunction/test/issue36/main.ml
@@ -0,0 +1,55 @@
+open Printf
+
+let oc_compare xs ys =
+  let tmp =
+    let rec compare xs0 ys =
+      match xs with
+      | [] ->
+         (match ys with
+          | [] -> Test_bytestring.Eq
+          | _ -> Test_bytestring.Lt)
+      | _ -> compare xs0 ys
+    in
+    compare
+  in
+  tmp xs ys
+
+
+let go () =
+  Test_bytestring.compare
+    []
+    [100]
+
+let rec print_obj x =
+  let x = Obj.magic x in
+  if Obj.is_block x then let size = Obj.size x in
+                           if Obj.tag x = 247 then
+                              Printf.printf "POINTER%!"
+                           else
+                           (Printf.printf ("(block[%i] (tag %i) %!") (Obj.size x) (Obj.tag x) ;
+                           for i = 0 to size - 1 do
+                             print_obj (Obj.field x i)
+                           done;
+                           Printf.printf ")")
+  else  Printf.printf ("%i %!") x
+
+let rec print_obj' x =
+  let x = Obj.magic x in
+  if Obj.is_block x then for i = 0 to Obj.size x - 1 do
+                             print_obj' (Obj.field x i)
+                           done
+  else  Printf.printf ("%x%!") x
+
+let main =
+  let x = go () in
+  Printf.printf "Malfunction result: ";
+  print_obj (Obj.magic x) ;
+  Printf.printf "\n";
+  Printf.printf "Malfunction result, printed as string: ";
+  print_obj' (Obj.magic x) ;
+  Printf.printf "\n";
+  Printf.printf "interpreted by OCaml as: ";
+  match x with
+  | Eq -> Printf.printf "Eq\n%!"
+  | Lt -> Printf.printf "Lt\n%!"
+  | Gt -> Printf.printf "Gt\n%!"
diff --git a/malfunction/test/issue36/run.sh b/malfunction/test/issue36/run.sh
new file mode 100755
index 000000000000..b2334b394907
--- /dev/null
+++ b/malfunction/test/issue36/run.sh
@@ -0,0 +1,6 @@
+#!/bin/sh
+ocamlopt -c test_bytestring.mli
+malfunction cmx test_bytestring.mlf
+ocamlopt -c main.ml
+ocamlopt -o main test_bytestring.cmx main.cmx
+./main
diff --git a/malfunction/test/issue36/test_bytestring.mlf b/malfunction/test/issue36/test_bytestring.mlf
new file mode 100644
index 000000000000..7fad475be1d3
--- /dev/null
+++ b/malfunction/test/issue36/test_bytestring.mlf
@@ -0,0 +1,20 @@
+(module
+  ($def_MetaCoq_Utils_bytestring_String_compare
+    (lambda ($xs $ys)
+      (apply
+        (let
+          (rec
+            ($compare
+              (lambda ($xs0 $ys)
+                  (switch $xs0
+                    (0
+                      (switch $ys
+                        (0 0)
+                        ((tag _) _ 1)))
+                    ((tag _) _
+                      (apply $compare $xs $ys)
+                        )))))
+          $compare)
+        $xs $ys)))
+
+  (export $def_MetaCoq_Utils_bytestring_String_compare))
diff --git a/malfunction/test/issue36/test_bytestring.mli b/malfunction/test/issue36/test_bytestring.mli
new file mode 100644
index 000000000000..657c2634668c
--- /dev/null
+++ b/malfunction/test/issue36/test_bytestring.mli
@@ -0,0 +1,5 @@
+
+type comparison = Eq | Lt | Gt
+type bytestr = int list
+
+val compare : bytestr -> bytestr -> comparison
diff --git a/malfunction/test/lazy.test b/malfunction/test/lazy.test
new file mode 100644
index 000000000000..7af700541fb1
--- /dev/null
+++ b/malfunction/test/lazy.test
@@ -0,0 +1,37 @@
+(test
+  (let
+    (rec
+      ($a (lazy (apply $f 42)))
+      ($f (lambda ($x) (if (== $x 42) 100 (force $a)))))
+    (apply $f 17))
+  100)
+
+(test
+  (let
+    (rec
+      ($a (lazy (apply $f 42)))
+      ($f (lambda ($x) (if (== $x 42) 100 (force $a)))))
+    (force $a))
+  100)
+
+
+(test
+  (let
+    (rec
+      ($a (lazy (field 0 (force $b))))
+      ($b (lazy (block (tag 0) 42 (lazy (force $a))))))
+    (block (tag 0) (force $a) (force (field 1 (force $b)))))
+  (block (tag 0) 42 42))
+
+(test
+  (let
+    (rec
+      ($a (lazy (field 0 (force $b))))
+      ($b (lazy (block (tag 0) 42 (lazy (force $a))))))
+    (block (tag 0) (force (field 1 (force $b))) (force $a)))
+  (block (tag 0) 42 42))
+
+(test
+  (let (rec ($a (lazy (block (tag 0) 42 $a))))
+    (block (tag 0) (field 0 (force $a)) (field 0 (force (field 1 (force $a))))))
+  (block (tag 0) 42 42))
diff --git a/malfunction/test/prim.test b/malfunction/test/prim.test
new file mode 100644
index 000000000000..df3dcf5c7cac
--- /dev/null
+++ b/malfunction/test/prim.test
@@ -0,0 +1,13 @@
+(test
+  (let
+    ($pow (global $Stdlib $**))
+    ($pow2 (apply (global $Stdlib $**) 2.))
+    ($magic (global $Obj $magic))
+    ($magic2 (apply (global $Obj $magic) (global $Obj $magic)))
+    (block (tag 0)
+      (apply $pow 2. 5.)
+      (apply $pow2 5.)
+      (apply (global $Stdlib $**) 2. 5.)
+      (apply $magic 42)
+      (apply $magic2 42)))
+  (block (tag 0) 32. 32. 32. 42 42))
diff --git a/malfunction/test/shifts.test b/malfunction/test/shifts.test
new file mode 100644
index 000000000000..51aefef13915
--- /dev/null
+++ b/malfunction/test/shifts.test
@@ -0,0 +1,30 @@
+(test (<< 3 5) 96)
+(test (>> 96 5) 3)
+(test (a>> 96 5) 3)
+
+; this test requires 2s-complement arithmetic,
+; but is independent of word size
+(test
+  (+ 1 (>> (neg 1) 1))
+  (^ (- 0 1) (>> (neg 1) 1)))
+
+(test (a>> (neg 96) 5) (neg 3))
+
+(test (a>> (neg 1) 5) (neg 1))
+(test (a>> 42 3) 5)
+(test (a>> (neg 42) 3) (neg 6))
+
+; shifting by negative numbers is undefined
+(test-undefined (<< 1 (neg 1)))
+(test-undefined (>> 1 (neg 1)))
+(test-undefined (a>> 1 (neg 1)))
+
+; shifting by large numbers is undefined
+(test-undefined (<< 1 113455345))
+(test-undefined (>> 1 113455345))
+(test-undefined (a>> 1 113455345))
+
+(test (<<.i32 1.i32 31) -2147483648.i32)
+(test-undefined (<<.i32 1.i32 32))
+(test (>>.i32 (neg.i32 1.i32) 31) 1.i32)
+(test-undefined (>>.i32 (neg.i32 1.i32) 32))
diff --git a/malfunction/test/test.ml b/malfunction/test/test.ml
new file mode 100644
index 000000000000..863461aab621
--- /dev/null
+++ b/malfunction/test/test.ml
@@ -0,0 +1,243 @@
+open Malfunction
+open Malfunction_parser
+open Malfunction_interpreter
+
+exception ReifyFailure of string
+let rec reify = function
+| Block (n, xs) -> reify_block n xs
+| Vec (`Array, xs) -> reify_block 0 xs
+| Vec (`Bytevec, xs) ->
+   let to_char = function
+     | Int (`Int, n) when 0 <= Z.to_int n && Z.to_int n < 256 ->
+        String.make 1 (Char.chr (Z.to_int n))
+     | _ -> raise (ReifyFailure "reify: noncharacter in string") in
+   Obj.repr (String.concat "" (List.map to_char (Array.to_list xs)))
+| Int (ty, n) -> Obj.(match ty with
+  | `Int -> repr (Z.to_int n)
+  | `Int32 -> repr (Z.to_int32 n)
+  | `Int64 -> repr (Z.to_int64 n)
+  | `Bigint -> repr n)
+| Float f -> Obj.repr f
+| Func _ -> raise (ReifyFailure "reify: functional value")
+| Thunk _ -> raise (ReifyFailure "reify: lazy value")
+
+and reify_block n xs =
+  let o = Obj.new_block n (Array.length xs) in
+  for i = 0 to Array.length xs - 1 do
+    Obj.set_field o i (reify xs.(i))
+  done;
+  o
+
+let check xs =
+  Array.iter (fun a ->
+  Stdlib.print_char
+    (if Stdlib.(=) (Marshal.from_channel Stdlib.stdin) a then
+        'Y'
+     else
+        'N')) xs;
+  Stdlib.flush_all ()
+
+let check_stub = "
+  (lambda ($xs)
+    (seq
+      (apply (global $Z $of_string) \"42\") ; ensure zarith loaded for unmarshalling
+      (apply (global $Array $iter) (lambda ($x)
+        (apply (global $Stdlib $print_char)
+          (if (== 0
+                (apply (global $Stdlib $compare)
+                       $x
+                       (apply (global $Marshal $from_channel) (global $Stdlib $stdin))))
+              89
+              78))) $xs)
+      (apply (global $Stdlib $print_newline) 0)))"
+
+type test_result =
+  [ `Bad_test of string (* expected output had undefined behaviour or was a function *)
+  | `Undefined of string (* testcase had undefined behaviour *)
+  | `Crash of string (* compiled executable failed to run or crashed, even though testcase had defined behaviour *)
+  | `Different (* interpreter and compiler agree that testcase does not match expected output *)
+  | `Inconsistent (* interpreter and compiler disagree whether testcase matches expected output *)
+  | `Match ] (* interpreter and compiler agree that testcase matches expected output *)
+
+
+exception HarnessFailed of string
+
+let exec_name = "malfunction_test_exec"
+
+let try_run_tests cases =
+  if Sys.file_exists exec_name then
+    raise (HarnessFailed ("file exists: "^exec_name));
+  let checker = Malfunction_parser.read_expression
+    (Lexing.from_string check_stub) in
+  let testcases = cases |> List.map @@ function
+    | `Bad_test _ | `Undefined _ -> Mnum (`Int 0)
+    | `Match (test, _) | `NoMatch (test, _) -> test in
+
+  let temps = ref None in
+  let delete_temps () =
+    Misc.remove_file exec_name;
+    match !temps with Some t -> Malfunction_compiler.delete_temps t | None -> () in
+
+  let options = [`Package "zarith"; `Linkpkg] in
+  begin match
+    Mmod ([`Unnamed (Mapply (checker, [Mblock (0, testcases)]))], [])
+    |> Malfunction_compiler.compile_module ~options ~filename:exec_name
+    |> (fun t -> temps := Some t; t)
+    |> Malfunction_compiler.link_executable ~options exec_name
+  with
+  | 0 -> ()
+  | _ -> delete_temps (); raise (HarnessFailed "Link error")
+  | exception e ->
+      Location.report_exception Format.str_formatter e;
+      delete_temps ();
+      raise (HarnessFailed (Format.flush_str_formatter ())) end;
+  let (rd, wr) = Unix.open_process ("./" ^ exec_name) in
+  cases
+  |> List.map (function
+    | `Bad_test _ | `Undefined _ -> Obj.repr 0
+    | `Match (_, obj) | `NoMatch (_, obj) -> obj)
+  |> List.iter (fun x -> Marshal.to_channel wr x []);
+  flush wr;
+  let answer = try input_line rd with End_of_file -> "" in
+  let result = Unix.close_process (rd, wr) in
+  delete_temps ();
+  match result with
+  | Unix.WEXITED 0 when String.length answer = List.length cases ->
+     cases |> List.mapi (fun i c -> match c, answer.[i] with
+     | (`Bad_test _ | `Undefined _) as x, _ -> x
+     | `Match _, 'Y' -> `Match
+     | `NoMatch _, 'N' -> `Different
+     | `Match _, 'N' -> `Inconsistent
+     | `NoMatch _, 'Y' -> `Inconsistent
+     | _, c -> `Crash ("output produced '" ^ String.make 1 c ^ "'"))
+  | _ -> raise (HarnessFailed "executable failed")
+
+let run_tests cases =
+  try
+    try_run_tests cases
+  with
+    (* failed to run all at once, run them one at a time to isolate crashing case *)
+    HarnessFailed _ ->
+      cases |> List.map @@ fun x ->
+        try List.hd (try_run_tests [x]) with
+          HarnessFailed s -> `Crash s
+
+let load_testcases filename =
+  let lexbuf = Lexing.from_channel (open_in filename) in
+  Lexing.(lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = filename});
+  let rec read_testcases acc =
+    let open Malfunction_sexp in
+    match read_next_sexp lexbuf with
+    | loc, List [_, Atom "test"; test; exp] ->
+       read_testcases ((`Test, loc,
+                        Malfunction_parser.parse_expression test,
+                        Malfunction_parser.parse_expression exp) :: acc)
+    | loc, List [_, Atom "test-differ"; test; exp] ->
+       read_testcases ((`TestDiffer, loc,
+                        Malfunction_parser.parse_expression test,
+                        Malfunction_parser.parse_expression exp) :: acc)
+    | loc, List [_, Atom "test-undefined"; test] ->
+       read_testcases ((`TestUndef, loc,
+                        Malfunction_parser.parse_expression test,
+                        Malfunction_parser.parse_expression (loc, Atom "0")) :: acc)
+    | loc, _ -> raise (SyntaxError (loc, "Bad test"))
+    | exception End_of_file -> List.rev acc in
+  read_testcases []
+
+let load_testcases_markdown filename =
+  let chan = open_in filename in
+  let buflen = 1000 in
+  let rec read_all () =
+    let buf = Bytes.create buflen in
+    match input chan buf 0 buflen with
+    | 0 -> []
+    | n -> Bytes.sub_string buf 0 n :: read_all () in
+  let contents = String.concat "" (read_all ()) in
+  let parse_string s =
+    s |> Lexing.from_string |> Malfunction_sexp.read_only_sexp |> Malfunction_parser.parse_expression in
+  let dummy_loc =
+    let l = Lexing.{pos_fname = filename; pos_lnum = 0; pos_cnum = 0; pos_bol = 0} in
+    l,l in
+  let open Omd in
+  let testcases = ref [] in
+  let _ = Omd.of_string contents |> List.iter @@ function
+    | Code_block (_, ("test" | " test"), s) ->
+       let open Str in
+       let (test, expect) = match split (regexp "\n=>") s with
+         | [t; e] -> (parse_string t, parse_string e)
+         | _ -> failwith @@ "Cannot parse testcase " ^ s in
+       testcases := (`Test, dummy_loc, test, expect) :: !testcases;
+       ()
+    | _ -> ()
+  in
+  List.rev !testcases
+
+let run_file parser filename =
+  Format.printf "%s: %!" filename;
+  match Malfunction.with_error_reporting (Format.std_formatter) None
+    (fun () -> Some (parser filename))
+  with
+  | None -> Format.printf "parse error\n%!"; `SomeFailed
+  | Some cases ->
+     let results = cases
+     |> List.map (fun (_ty, _loc, test, expect) ->
+       match eval expect with
+       | exception (Error s) -> `Bad_test s
+       | expectRes -> match eval test, reify expectRes with
+         | exception (Error s) -> `Undefined s
+         | exception (ReifyFailure s) -> `Bad_test s
+         | testRes, expectObj ->
+            if compare testRes expectRes = 0 then
+              `Match (test, expectObj)
+            else
+              `NoMatch (test, expectObj))
+     |> run_tests in
+     let passed = ref 0 in
+     let describe (ty, ({Lexing.pos_lnum = line; _}, _), _, _) result =
+       let say fmt =
+         Format.printf "\n%s:%d: " filename line;
+         let endline ppf =
+           Format.fprintf ppf "\n%!" in
+         Format.kfprintf endline Format.std_formatter fmt in
+       begin match ty, result with
+       | _, `Bad_test s -> say "bad test: %s" s
+       | _, `Crash s -> say "crash: %s" s
+       | _, `Inconsistent -> say "inconsistent results"
+       | `Test, `Match
+       | `TestUndef, `Undefined _
+       | `TestDiffer, `Different -> incr passed
+       | (`Test|`TestDiffer), `Undefined s -> say "undefined behaviour: %s" s
+       | `TestUndef, (`Match|`Different) -> say "undefined behaviour not detected"
+       | `Test, `Different -> say "values don't match"
+       | `TestDiffer, `Match -> say "values match when not expected to" end;
+     in
+     List.iter2 describe cases results;
+     Format.printf "\r%-25s [%d/%d] tests passed\n%!" (filename ^ ":") !passed (List.length cases);
+     if !passed = List.length cases then `AllPassed else `SomeFailed
+
+let rec run_all testfiles =
+  let combine a b = match a, b with `AllPassed, `AllPassed -> `AllPassed | _ -> `SomeFailed in
+  let result = ref `AllPassed in
+  for i = 0 to Array.length testfiles - 1 do
+    let file = testfiles.(i) in
+    let res =
+      if Sys.is_directory file then
+        run_all (Array.map (fun x -> file ^ Filename.dir_sep ^ x) (Sys.readdir file))
+      else if Filename.check_suffix file ".md" then
+        run_file load_testcases_markdown file
+      else if Filename.check_suffix file ".test" then
+        run_file load_testcases file
+      else
+        `AllPassed in
+    result := combine res !result
+  done;
+  !result
+
+
+let () =
+  match Sys.argv with
+  | [| me |] -> Format.printf "Usage: %s <test files>\n" me; exit 1
+  | _ ->
+     match run_all (Array.sub Sys.argv 1 (Array.length Sys.argv - 1)) with
+     | `SomeFailed -> Format.printf "Some tests failed\n%!"; exit 1
+     | `AllPassed -> Format.printf "All tests passed\n%!"; exit 0
diff --git a/malfunction/test/vector.test b/malfunction/test/vector.test
new file mode 100644
index 000000000000..0cb561580f5d
--- /dev/null
+++ b/malfunction/test/vector.test
@@ -0,0 +1,15 @@
+(test
+  (let
+    ($arr (makevec 10 42))
+    ($a (load $arr 0))
+    ($b (load $arr 8))
+    (_ (store $arr 8 (block (tag 0) 1 2 3)))
+    ($c (load $arr 8))
+    (block (tag 0) $a $b $c))
+  (block (tag 0) 42 42 (block (tag 0) 1 2 3)))
+    
+(test-undefined
+  (load (makevec 10 10) 10))
+
+(test-undefined
+  (load (makevec 10 10) (- 0 1)))
diff --git a/malfunction/test_cli/dune b/malfunction/test_cli/dune
new file mode 100644
index 000000000000..0c89fe2d8b39
--- /dev/null
+++ b/malfunction/test_cli/dune
@@ -0,0 +1,8 @@
+(rule
+ (targets test.log test.expect)
+ (deps test.sh (source_tree .) (package malfunction))
+ (action (run ./test.sh)))
+
+(alias
+ (name runtest)
+ (action (diff test.expect test.log)))
diff --git a/malfunction/test_cli/helloworld.mlf b/malfunction/test_cli/helloworld.mlf
new file mode 100644
index 000000000000..4ed219b97502
--- /dev/null
+++ b/malfunction/test_cli/helloworld.mlf
@@ -0,0 +1,3 @@
+(module
+  (_ (apply (global $Stdlib $print_string) "Hello, world!\n"))
+  (export))
diff --git a/malfunction/test_cli/main.ml b/malfunction/test_cli/main.ml
new file mode 100644
index 000000000000..b927d1a992db
--- /dev/null
+++ b/malfunction/test_cli/main.ml
@@ -0,0 +1,4 @@
+List.iter (Printf.printf "%d\n") Module.x;;
+List.iter (Printf.printf "%d\n") Module.y;;
+Printf.printf "%b %b\n" (Module.even 42) (Module.odd 42);;
+Printf.printf "%d\n" Module.s;;
diff --git a/malfunction/test_cli/module.mlf b/malfunction/test_cli/module.mlf
new file mode 100644
index 000000000000..e495bdca71a5
--- /dev/null
+++ b/malfunction/test_cli/module.mlf
@@ -0,0 +1,14 @@
+(module
+  (rec
+    ($even (lambda ($n) (if (<= $n 1) (== $n 0) (apply $odd (- $n 1)))))
+    ($odd (lambda ($n) (if (<= $n 1) (== $n 1) (apply $even (- $n 1))))))
+  ($foo 100)
+  ($bar 10)
+  ($baz 1)
+  ($y (block (tag 0) 10 0))
+  (export
+    $odd
+    (block (tag 0) 42 0)
+    $y
+    $even
+    (+ $foo (+ $bar $baz))))
diff --git a/malfunction/test_cli/module.mli b/malfunction/test_cli/module.mli
new file mode 100644
index 000000000000..44649d1026b1
--- /dev/null
+++ b/malfunction/test_cli/module.mli
@@ -0,0 +1,5 @@
+val odd : int -> bool
+val x : int list
+val y : int list
+val even : int -> bool
+val s : int
diff --git a/malfunction/test_cli/test.sh b/malfunction/test_cli/test.sh
new file mode 100755
index 000000000000..22010cb5b2bb
--- /dev/null
+++ b/malfunction/test_cli/test.sh
@@ -0,0 +1,63 @@
+#!/bin/sh
+
+> test.expect
+> test.log
+exec >test.log 2>&1
+expect () { echo '=== TEST ==='; ( echo "$@"; echo '=== TEST ===' ) >> test.expect; }
+expect_ () { cat >> test.expect; echo '=== TEST ==='; echo '=== TEST ===' >> test.expect; }
+
+ignore_linker_warnings () {
+  # 32-bit debian and some osx versions issue spurious linker warnings
+  # see https://github.com/ocaml/opam-repository/issues/3000 and 9728
+  grep -v 'ld:.* warning:'
+}
+
+clean () {
+  rm -f *.o *.cm*
+}
+
+clean
+malfunction compile helloworld.mlf 2>&1 | ignore_linker_warnings
+./helloworld
+expect 'Hello, world!'
+
+clean
+malfunction compile -o foo helloworld.mlf 2>&1 | ignore_linker_warnings
+./foo
+expect 'Hello, world!'
+
+clean
+malfunction cmx helloworld.mlf
+ocamlopt helloworld.cmx -o exec 2>&1 | ignore_linker_warnings
+./exec
+expect 'Hello, world!'
+
+clean
+malfunction cmo helloworld.mlf
+ocamlc helloworld.cmo -o exec.byte
+./exec
+expect 'Hello, world!'
+
+clean
+ocamlc -opaque -c module.mli
+malfunction cmx module.mlf
+ocamlopt module.cmx main.ml -o main 2>&1 | ignore_linker_warnings
+./main
+expect_ <<EOF
+42
+10
+true false
+111
+EOF
+
+clean
+ocamlc -opaque -c module.mli
+malfunction cmo module.mlf
+ocamlc module.cmo main.ml -o main.byte
+./main.byte
+expect_ <<EOF
+42
+10
+true false
+111
+EOF
diff --git a/malfunction/test_cli/test.t b/malfunction/test_cli/test.t
new file mode 100644
index 000000000000..e534780199a0
--- /dev/null
+++ b/malfunction/test_cli/test.t
@@ -0,0 +1,28 @@
+#!/bin/sh
+
+expect () { echo "$@" >> test.log; }
+expect_ () { cat >> test.log; }
+
+malfunction compile helloworld.mlf
+./helloworld
+expect 'Hello, world!'
+
+malfunction compile -o foo helloworld.mlf
+./foo
+expect 'Hello, world!'
+
+malfunction cmx helloworld.mlf
+ocamlopt helloworld.cmx -o exec
+./exec
+expect 'Hello, world!'
+
+ocamlc -opaque -c module.mli
+malfunction cmx module.mlf
+ocamlopt module.cmx main.ml -o main
+./main
+expect_ <<EOF
+42
+10
+true false
+111
+EOF

From 6f83b24a7c1cb1dca91c6c468cc68a08a977708f Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 14:17:02 +0200
Subject: [PATCH 73/76] updated docker files

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

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 46b59c94de64..d131602e85e8 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-10-d4125f9d9e"
-  EDGE_CACHEKEY: "edge_ubuntu-V2026-06-10-0c389ac2f4"
+  BASE_CACHEKEY: "old_ubuntu_lts-V2026-06-17-f12e94ebd1"
+  EDGE_CACHEKEY: "edge_ubuntu-V2026-06-17-af8eb43efd"
   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 44797ac4e68d..a665c4ee98c0 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" \
diff --git a/dev/ci/docker/old_ubuntu_lts/Dockerfile b/dev/ci/docker/old_ubuntu_lts/Dockerfile
index cf915236ea7e..6724ed739eb9 100644
--- a/dev/ci/docker/old_ubuntu_lts/Dockerfile
+++ b/dev/ci/docker/old_ubuntu_lts/Dockerfile
@@ -50,7 +50,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"
 

From 11b44963e9815250954e4fcc6813d585d50ce9c9 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 15:11:27 +0200
Subject: [PATCH 74/76] removed malfunction vendor

---
 malfunction/.gitignore                       |   3 -
 malfunction/.travis-ci.sh                    |   1 -
 malfunction/.travis.yml                      |  10 -
 malfunction/CHANGES.md                       |  51 -
 malfunction/LICENSE.md                       | 212 ----
 malfunction/README.md                        |  46 -
 malfunction/docs/helloworld.mlf              |   3 -
 malfunction/docs/print_args.mlf              |  24 -
 malfunction/docs/spec.md                     | 376 -------
 malfunction/dune-project                     |   2 -
 malfunction/dune-workspace.all               |  24 -
 malfunction/dune-workspace.quick             |   5 -
 malfunction/examples/.gitignore              |   4 -
 malfunction/examples/dune                    |   8 -
 malfunction/examples/helloworld.mlf          |   7 -
 malfunction/examples/primrec.ml              | 154 ---
 malfunction/malfunction.opam                 |  24 -
 malfunction/src/dune                         |  21 -
 malfunction/src/malfunction.ml               | 128 ---
 malfunction/src/malfunction.mli              | 101 --
 malfunction/src/malfunction_compat.cppo.ml   | 208 ----
 malfunction/src/malfunction_compiler.ml      | 987 -------------------
 malfunction/src/malfunction_compiler.mli     |  18 -
 malfunction/src/malfunction_interpreter.ml   | 286 ------
 malfunction/src/malfunction_interpreter.mli  |  14 -
 malfunction/src/malfunction_main.ml          | 110 ---
 malfunction/src/malfunction_parser.ml        | 285 ------
 malfunction/src/malfunction_parser.mli       |  12 -
 malfunction/src/malfunction_sexp.mli         |  14 -
 malfunction/src/malfunction_sexp.mll         |  93 --
 malfunction/test/basic.test                  |  20 -
 malfunction/test/conversions.test            |  25 -
 malfunction/test/dune                        |  10 -
 malfunction/test/evalorder.test              |  27 -
 malfunction/test/factorial.test              |  10 -
 malfunction/test/float.test                  |  32 -
 malfunction/test/issue36/dune                |  10 -
 malfunction/test/issue36/expected.txt        |   3 -
 malfunction/test/issue36/main.ml             |  55 --
 malfunction/test/issue36/run.sh              |   6 -
 malfunction/test/issue36/test_bytestring.mlf |  20 -
 malfunction/test/issue36/test_bytestring.mli |   5 -
 malfunction/test/lazy.test                   |  37 -
 malfunction/test/prim.test                   |  13 -
 malfunction/test/shifts.test                 |  30 -
 malfunction/test/test.ml                     | 243 -----
 malfunction/test/vector.test                 |  15 -
 malfunction/test_cli/dune                    |   8 -
 malfunction/test_cli/helloworld.mlf          |   3 -
 malfunction/test_cli/main.ml                 |   4 -
 malfunction/test_cli/module.mlf              |  14 -
 malfunction/test_cli/module.mli              |   5 -
 malfunction/test_cli/test.sh                 |  63 --
 malfunction/test_cli/test.t                  |  28 -
 54 files changed, 3917 deletions(-)
 delete mode 100644 malfunction/.gitignore
 delete mode 100644 malfunction/.travis-ci.sh
 delete mode 100644 malfunction/.travis.yml
 delete mode 100644 malfunction/CHANGES.md
 delete mode 100644 malfunction/LICENSE.md
 delete mode 100644 malfunction/README.md
 delete mode 100644 malfunction/docs/helloworld.mlf
 delete mode 100644 malfunction/docs/print_args.mlf
 delete mode 100644 malfunction/docs/spec.md
 delete mode 100644 malfunction/dune-project
 delete mode 100644 malfunction/dune-workspace.all
 delete mode 100644 malfunction/dune-workspace.quick
 delete mode 100644 malfunction/examples/.gitignore
 delete mode 100644 malfunction/examples/dune
 delete mode 100644 malfunction/examples/helloworld.mlf
 delete mode 100644 malfunction/examples/primrec.ml
 delete mode 100644 malfunction/malfunction.opam
 delete mode 100644 malfunction/src/dune
 delete mode 100644 malfunction/src/malfunction.ml
 delete mode 100644 malfunction/src/malfunction.mli
 delete mode 100644 malfunction/src/malfunction_compat.cppo.ml
 delete mode 100644 malfunction/src/malfunction_compiler.ml
 delete mode 100644 malfunction/src/malfunction_compiler.mli
 delete mode 100644 malfunction/src/malfunction_interpreter.ml
 delete mode 100644 malfunction/src/malfunction_interpreter.mli
 delete mode 100644 malfunction/src/malfunction_main.ml
 delete mode 100644 malfunction/src/malfunction_parser.ml
 delete mode 100644 malfunction/src/malfunction_parser.mli
 delete mode 100644 malfunction/src/malfunction_sexp.mli
 delete mode 100644 malfunction/src/malfunction_sexp.mll
 delete mode 100644 malfunction/test/basic.test
 delete mode 100644 malfunction/test/conversions.test
 delete mode 100644 malfunction/test/dune
 delete mode 100644 malfunction/test/evalorder.test
 delete mode 100644 malfunction/test/factorial.test
 delete mode 100644 malfunction/test/float.test
 delete mode 100644 malfunction/test/issue36/dune
 delete mode 100644 malfunction/test/issue36/expected.txt
 delete mode 100644 malfunction/test/issue36/main.ml
 delete mode 100755 malfunction/test/issue36/run.sh
 delete mode 100644 malfunction/test/issue36/test_bytestring.mlf
 delete mode 100644 malfunction/test/issue36/test_bytestring.mli
 delete mode 100644 malfunction/test/lazy.test
 delete mode 100644 malfunction/test/prim.test
 delete mode 100644 malfunction/test/shifts.test
 delete mode 100644 malfunction/test/test.ml
 delete mode 100644 malfunction/test/vector.test
 delete mode 100644 malfunction/test_cli/dune
 delete mode 100644 malfunction/test_cli/helloworld.mlf
 delete mode 100644 malfunction/test_cli/main.ml
 delete mode 100644 malfunction/test_cli/module.mlf
 delete mode 100644 malfunction/test_cli/module.mli
 delete mode 100755 malfunction/test_cli/test.sh
 delete mode 100644 malfunction/test_cli/test.t

diff --git a/malfunction/.gitignore b/malfunction/.gitignore
deleted file mode 100644
index b55377bc64f5..000000000000
--- a/malfunction/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-_build
-malfunction.install
-.merlin
diff --git a/malfunction/.travis-ci.sh b/malfunction/.travis-ci.sh
deleted file mode 100644
index 4ac9a7a02169..000000000000
--- a/malfunction/.travis-ci.sh
+++ /dev/null
@@ -1 +0,0 @@
-bash -ex .travis-opam.sh
diff --git a/malfunction/.travis.yml b/malfunction/.travis.yml
deleted file mode 100644
index 1198db5c6c1f..000000000000
--- a/malfunction/.travis.yml
+++ /dev/null
@@ -1,10 +0,0 @@
-language: c
-sudo: required
-install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh
-script: bash -ex .travis-ci.sh
-env:
-  global:
-  - PACKAGE=malfunction
-  matrix:
-  - OCAML_VERSION=4.03.0+flambda
-  - OCAML_VERSION=4.04.0+flambda
diff --git a/malfunction/CHANGES.md b/malfunction/CHANGES.md
deleted file mode 100644
index f2bcf0e7a320..000000000000
--- a/malfunction/CHANGES.md
+++ /dev/null
@@ -1,51 +0,0 @@
-v0.7 (10th November 2024)
----------------------
-
-Support for OCaml 5.3
-Bytecode compilation mode (to cmo files)
-
-v0.6 (23rd June 2024)
----------------------
-
-Support for OCaml 5.2
-Bugfix for an invalid optimisation on OCaml >= 4.14
-New options for using ocamlfind packages
-
-v0.5 (22nd May 2023)
---------------------
-
-Support for OCaml 5.0.0
-Dropped support for OCaml < 4.08
-
-v0.4 (23rd September 2022)
---------------------------
-
-Support for OCaml 4.09 to 4.14
-Recursive lazy bindings now supported
-
-v0.3 (24th April 2019)
----------------------
-
-Support for OCaml 4.06, 4.07 and 4.08+beta2
-Support for non-Flambda builds
-Dune support (replacing jbuilder)
-Lazy evaluation (lazy E and force E)
-Floating-point numbers
-
-v0.2.1 (3rd October 2017)
----------------------
-
-Fix build bug with OCaml 4.04.2
-
-
-v0.2 (12th September 2017)
----------------------
-
-Support for OCaml 4.05.0
-Now builds with jbuilder
-
-
-v0.1 (20th June 2016)
----------------------
-
-Initial release
diff --git a/malfunction/LICENSE.md b/malfunction/LICENSE.md
deleted file mode 100644
index d0ab1ba1c08f..000000000000
--- a/malfunction/LICENSE.md
+++ /dev/null
@@ -1,212 +0,0 @@
-Copyright (c) 2016 Stephen Dolan
-
-Malfunction is released under the same terms as OCaml.
-
-The OCaml license is reproduced verbatim below. The exception
-referring to the "OCaml Core System" also applies to Malfunction.
-
-----------------------------------------------------------------------
-
-In the following, "the OCaml Core System" refers to all files marked
-"Copyright INRIA" in this distribution.
-
-The OCaml Core System is distributed under the terms of the
-GNU Lesser General Public License (LGPL) version 2.1 (included below).
-
-As a special exception to the GNU Lesser General Public License, you
-may link, statically or dynamically, a "work that uses the OCaml Core
-System" with a publicly distributed version of the OCaml Core System
-to produce an executable file containing portions of the OCaml Core
-System, and distribute that executable file under terms of your
-choice, without any of the additional requirements listed in clause 6
-of the GNU Lesser General Public License.  By "a publicly distributed
-version of the OCaml Core System", we mean either the unmodified OCaml
-Core System as distributed by INRIA, or a modified version of the
-OCaml Core System that is distributed under the conditions defined in
-clause 2 of the GNU Lesser General Public License.  This exception
-does not however invalidate any other reasons why the executable file
-might be covered by the GNU Lesser General Public License.
-
-----------------------------------------------------------------------
-
-GNU LESSER GENERAL PUBLIC LICENSE
-
-Version 2.1, February 1999
-
-Copyright (C) 1991, 1999 Free Software Foundation, Inc.
-51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-
-[This is the first released version of the Lesser GPL.  It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
-Preamble
-
-The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users.
-
-This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below.
-
-When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things.
-
-To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it.
-
-For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights.
-
-We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library.
-
-To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others.
-
-Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license.
-
-Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs.
-
-When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library.
-
-We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances.
-
-For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License.
-
-In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system.
-
-Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library.
-
-The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run.
-
-TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you".
-
-A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables.
-
-The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".)
-
-"Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library.
-
-Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does.
-
-1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library.
-
-You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee.
-
-2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions:
-
-    a) The modified work must itself be a software library.
-    b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change.
-    c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License.
-    d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful.
-
-    (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.)
-
-These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library.
-
-In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License.
-
-3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices.
-
-Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy.
-
-This option is useful when you wish to copy part of the code of the Library into a program that is not a library.
-
-4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange.
-
-If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code.
-
-5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License.
-
-However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables.
-
-When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law.
-
-If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.)
-
-Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself.
-
-6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications.
-
-You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things:
-
-    a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.)
-    b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with.
-    c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution.
-    d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place.
-    e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy.
-
-For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable.
-
-It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute.
-
-7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things:
-
-    a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above.
-    b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work.
-
-8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance.
-
-9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it.
-
-10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License.
-
-11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library.
-
-If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances.
-
-It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice.
-
-This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License.
-
-12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License.
-
-13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation.
-
-14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally.
-
-NO WARRANTY
-
-15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
-16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
-END OF TERMS AND CONDITIONS
-
-How to Apply These Terms to Your New Libraries
-
-If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License).
-
-To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found.
-
-one line to give the library's name and an idea of what it does.
-Copyright (C) year  name of author
-
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
-
-Also add information on how to contact you by electronic and paper mail.
-
-You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names:
-
-Yoyodyne, Inc., hereby disclaims all copyright interest in
-the library `Frob' (a library for tweaking knobs) written
-by James Random Hacker.
-
-signature of Ty Coon, 1 April 1990
-Ty Coon, President of Vice
-
-That's all there is to it!
-
---------------------------------------------------
diff --git a/malfunction/README.md b/malfunction/README.md
deleted file mode 100644
index 2940bfaeed08..000000000000
--- a/malfunction/README.md
+++ /dev/null
@@ -1,46 +0,0 @@
-**Malfunction** is a high-performance, low-level untyped program
-representation, designed as a target for compilers of functional
-programming languages.
-
-**Malfunction** is a revolting hack, exposing bits of the OCaml
-compiler's guts that were never meant to see the light of day.
-
-"Hello, World" looks like this:
-
-    (module
-      (_ (apply (global $Stdlib $print_string) "Hello, world!\n"))
-      (export))
-
-Malfunction requires OCaml (at least version 4.04.0, and you may see
-better performance with flambda enabled), which you should install
-using [OPAM](https://opam.ocaml.org). Then, install malfunction using:
-
-    opam pin add malfunction git://github.com/stedolan/malfunction.git
-
-You can then compile and run the above example with:
-
-    malfunction compile docs/helloworld.mlf -o hello
-    ./hello
-
-The syntax is based on s-expressions, and is designed to be easy to
-correctly generate, rather than to be particularly beautiful. For
-instance, there are no reserved words: all user-defined identifiers
-must be prefixed with `$`.
-
-Files are compiled as OCaml modules, and may import values from OCaml
-(e.g. `Stdlib.print_string` in the example above) and export
-values to OCaml (using the `export` form). Modules written in
-malfunction may be combined with an `mli` file written in OCaml.
-
-Malfunction makes no effort to check types. Typical programs do go
-wrong. Compilers targeting Malfunction need to convince themselves
-that their output won't go wrong, but don't need to explain
-their reasoning.
-
-For more, read the [spec](./docs/spec.md), or the
-[abstract submitted to the ML Workshop](https://stedolan.net/talks/2016/malfunction/malfunction.pdf),
-or [some examples](./docs)
-
-There's also an
-[experimental backend](https://github.com/stedolan/idris-malfunction)
-for the dependently typed language [Idris](http://idris-lang.org).
diff --git a/malfunction/docs/helloworld.mlf b/malfunction/docs/helloworld.mlf
deleted file mode 100644
index 4ed219b97502..000000000000
--- a/malfunction/docs/helloworld.mlf
+++ /dev/null
@@ -1,3 +0,0 @@
-(module
-  (_ (apply (global $Stdlib $print_string) "Hello, world!\n"))
-  (export))
diff --git a/malfunction/docs/print_args.mlf b/malfunction/docs/print_args.mlf
deleted file mode 100644
index a15dc4d7ad94..000000000000
--- a/malfunction/docs/print_args.mlf
+++ /dev/null
@@ -1,24 +0,0 @@
-; This program prints its command-line arguments to stdout
-(module
-
-  ($argv (global $Sys $argv))
-
-  ; $argv is a vector, turn it into a list
-  ; lists are either the integer 0 (nil) or a block of tag 0 (cons)
-  ($argc (length $argv))
-  (rec
-    ($argv_to_list (lambda ($i)
-      (if (== $i $argc)
-        0
-        (block (tag 0) (load $argv $i)
-          (apply $argv_to_list (+ $i 1)))))))
-  ($argv_list (apply $argv_to_list 1)) ; Start at 1 to skip argv[0]
-
-  ; Since this is the standard OCaml list representation, we may
-  ; use standard library functions
-
-  ($print (lambda ($s)
-    (apply (global $Stdlib $print_endline) $s)))
-  (_ (apply (global $List $iter) $print $argv_list))
-
-  (export))
\ No newline at end of file
diff --git a/malfunction/docs/spec.md b/malfunction/docs/spec.md
deleted file mode 100644
index 6c7275aa4554..000000000000
--- a/malfunction/docs/spec.md
+++ /dev/null
@@ -1,376 +0,0 @@
-# Syntax and semantics of Malfunction
-
-**Note**: This "specification" is preliminary at best, and subject to
-  change when bugs are found, features are added, or I'm bored.
-
-Malfunction does only very basic checking of syntax when loading a
-program. For any program which passes the syntax checker, Malfunction
-should do one of the following:
-
-  - Produce exactly the same result in the intepreter (`malfunction eval`) and compiler (`malfunction compile`)
-  - Report it as having undefined behaviour in the interpreter (`malfunction eval`)
-  - Fail to terminate in both the interpreter and the compiler
-
-The behaviour of the interpreter and compiler should agree with the
-text below, although for a more precise specification you should look
-at the
-[definition of the interpreter](../src/malfunction_interpreter.ml),
-which is straightforward (no bytecode or other efficiency tricks, just
-syntax-directed execution).
-
-It's not necessarily a bug in Malfunction if a program compiles with
-`malfunction compile` and then crashes at runtime. This specification
-intentionally leaves much behaviour undefined, so you should count
-yourself lucky if a program like `(field 0 0)` is well-behaved enough
-to merely crash.
-
-However, the interpreter should detect *all* undefined behaviour
-(Malfunction's semantics are kept quite simple to ensure that this is
-easy). If a program runs to completion in the intepreter producing a
-result, it is a bug in Malfunction if the compiled version of the same
-program either crashes or produces a different value, and
-[should be reported](https://github.com/stedolan/malfunction/issues).
-
-This doesn't apply to programs which link with OCaml code: if you use
-`(global ...)` to call an OCaml function, it's up to you to ensure
-that you pass inputs that won't make it crash, and the interpreter
-will (currently) be of no help checking this.
-
-This file contains various examples of expected output of sample
-programs. These are run as part of the testsuite, as are the other
-programs in the [test directory](../test).
-
-## Basic syntax
-
-Comments begin with `;` and continue to the end of the line.
-
-A Malfunction input file consists of a single
-s-expression. S-expressions (or "sexps") consist of `(`, a sequence of
-whitespace-separated elements, and `)`, where elements are:
-  - *Atoms*: sequences of ASCII letters, digits, or symbols (the exact set of allowed symbols isn't quite nailed down yet)
-  - *Variables*: `\$` followed by an atom
-  - *Strings*: double-quoted, with embedded `\` or `"` backslash-escaped
-  - *s-expressions*: nested arbitrarily
-
-The top-level sexp must begin with the atom `module`, followed
-by a list of bindings (described under `let`, below), followed by an
-sexp beginning with the atom `export`.
-
-For inputs compiled with `malfunction compile` (that is, whole
-programs), the `export` sexp must be empty. For instance, a program
-which evaluates the single sexp `E` ignoring its result has this form:
-
-    (module
-      (_ E)
-      (export))
-
-Inputs compiled with `malfunction cmx` (that is, modules that are
-later linked with other modules) may specify any number of values in
-the `export` sexp, which must be in the same order as they are listed
-in the corresponding `.mli` file.
-
-
-## Numbers and arithmetic
-
-There are several numeric types, and associated constant syntax:
-  - int, e.g. `42`
-  - int32, e.g. `42.i32`
-  - int64, e.g. `42.i64`
-  - bigint, e.g. `42.ibig`
-  - float, e.g. `42.0`
-
-`int32` and `int64` use 32-bit and 64-bit two's complement arithmetic,
-with wrap on overflow. `int` uses either 31- or 63- bit two's
-complement arithmetic (depending on system word size, and also
-wrapping on overflow), and is generally fastest. `bigint` has
-arbitrary precision. `float` uses IEEE754 double-precision (64-bit)
-arithmetic.
-
-Various numeric operations are defined:
-
-  - *Arithmetic operations*: `+`, `-`, `*`, `/`, `%` (modulo), `neg` (unary negation)
-  - *Bitwise operations*: `&`, `|`, `^`, `<<`, `>>` (zero-shifting), `a>>` (sign extending)
-  - *Numeric comparisons*: `<`, `>`, `<=`, `>=`, `==`
-
-All of these operations take one or two `int`s and return an `int`:
-
-```test
-(+ 10 (* 20 3))
-=> 70
-```
-
-```test
-(<< 1 5)
-=> 32
-```
-
-These operations come in `int32`, `int64`, `bigint` and `float`
-varieties, which may be used by suffixing `.i32`, `.i64`, `.big` or `.f64`
-to the operation name. The bitwise operations are not available for
-`float`s. The suffixed operations all take and return values of the
-specified numeric type, except:
-
-  - the shift operators (`<<`, `>>`, `a>>`) whose second argument (shift count) is always `int`
-  - the comparison operators, whose result is always `int` (in fact, always `0` or `1`)
-
-For example,
-
-```test
-(*.ibig 948324329804.ibig 8493208402394.ibig)
-=> 8054316166085991599150776.ibig
-```
-
-```test
-(>>.i32 32.i32 5)
-=> 1.i32
-```
-
-```test
-(+.f64 0.1 0.2)
-=> 0.30000000000000004
-```
-
-As well as ordinary finite values, floats support infinite and NaN
-values, available as the literals `infinity`, `neg_infinity` and
-`nan`. Note that `nan` is unordered with respect to other floats, so
-comparisons with it always return false.
-
-Integer types are not automatically coerced, and behaviour is
-undefined if the wrong types are passed to an operation. Explicit
-conversions are done with `convert.FROM.TO`. When converting between
-integer types, conversions from smaller to larger types sign-extend
-and conversions from larger to smaller truncate. Conversions from an
-integer type to float round to the nearest float, which may not be
-exactly equal to the specified integer.
-
-Conversions from float to integer type truncate the fractional
-part. Currently, their behaviour is undefined if the input is outside
-the representable range of the target type, although this might change
-in the future.
-
-```test
-(convert.i32.i64 42.i32)
-=> 42.i64
-```
-
-```test
-(convert.f64.int 3.9)
-=> 3
-```
-
-## Functions
-
-Functions are defined using the following syntax, and close over all
-bindings in scope:
-
-    (lambda ($arg1 $arg2 $arg3) BODY)
-
-Functions are applied using the following syntax:
-
-    (apply FUNC ARG ARG ARG)
-
-Multiple-argument functions are implicitly curried, and may be
-partially applied (resulting in a closure) or applied to too many
-arguments (resulting in an application of the returned value). For
-instance,
-
-```test
-(apply (apply (lambda ($a $b) (+ $a $b)) 20) 22)
-=> 42
-```
-
-```test
-(apply (lambda ($a) (lambda ($b) (+ $a $b))) 20 22)
-=> 42
-```
-
-However, performance will be higher if functions are applied to
-exactly the right number of arguments.
-
-Evaluation is eager: functions and arguments are evaluated before
-their bodies. The function is evaluated before the arguments, and
-arguments are evaluated left to right.
-
-## Bindings
-
-The atom `let` introduces a sequence of bindings:
-
-    (let BINDING BINDING BINDING ... BODY)
-
-Each binding is of one of the forms:
-
-  - `($var EXP)`: binds `$var` to the result of evaluating `EXP`. `$var` scopes over subsequent bindings and the body.
-  - `(_ EXP)`: evaluates `EXP` and ignores the result
-  - `(rec ($VAR1 EXP1) ($VAR2 EXP2) ...)`: binds each `$VAR` mutually
-    recursively. Each `EXP` must be of the form `(lambda
-    ...)` or `(lazy ...)`. Bindings scope over themselves,
-    each other, subsequent bindings, and the body.
-
-For example, here is a definition of the "even" and "odd" predicates
-on `int`s, and an application of them to check whether 42 is even (see
-below for `if`):
-
-```test
-(let
-  (rec
-    ($even (lambda ($n) (if (<= $n 1) (== $n 0) (apply $odd (- $n 1)))))
-    ($odd (lambda ($n) (if (<= $n 1) (== $n 1) (apply $even (- $n 1))))))
-  ($res (apply $even 42))
-  $res)
-=> 1
-```
-
-The syntax `(seq EXP EXP...)` is equivalent to `(let (_ EXP) (_
-EXP)... EXP)`, and can be used to write sequences of imperative
-actions whose results are ignored.
-
-## Blocks and fields
-
-Blocks (tuples) are constructed using `(block (tag N) EXP EXP EXP
-...)`, where `N` is a constant integer called the "tag" (an integer in
-the range 0-199 which may be used with `switch` below) and each `EXP`
-is a field of the resulting block.
-
-Fields are projected from a block using `(field N EXP)`, where `N` is
-an integer between 0 and one less than the length of the block.
-
-```test
-(let
-  ($a (block (tag 0) 1 2 (block (tag 1) 0) 3))
-  ($b (block (tag 0) (field 2 $a) (field 0 $a)))
-  $b)
-=> (block (tag 0) (block (tag 1) 0) 1)
-```
-
-Fields of blocks can only be accessed at constant, compile-time-known
-offsets. For random access into a structure, see "Vectors" below.
-
-## Conditionals
-
-The general conditional expression is `switch`, of the form:
-
-    (switch EXP
-      (SEL SEL... EXP)
-      (SEL SEL... EXP)
-      ...)
-
-The first `EXP` is evaluated, and matched against each case in the
-order they appear. A case (of the form `(SEL SEL... EXP)`) matches if
-any of its selectors (`SEL`) match. The result of the switch is the
-result of evaluating the `EXP` of the first matching case. Selectors may be:
-
-  - `42`: integers, matching themselves. Only `int`, not `int32`,
-    `int64` or `bigint` may be matched. Use comparison operators,
-    which always return ints, to switch on other integer types.
-  - `(10 20)`: integer ranges, matching (in this example) any `n` where `10 <= n <= 20`
-  - `_`: default case, matching any *integer*
-  - `(tag 10)`: matches blocks with tag 10
-  - `(tag _)`: matches any block.
-
-Note that `_` matches only integers. To have a case handle all
-integers and all blocks, write `(_ (tag _) EXP)`.
-
-Selectors must be literal constants. To compare against runtime
-values, use comparison operators.
-
-For instance,
-
-```test
-(let
-  ($sw (lambda ($n)
-    (switch $n
-      (5 (10 20) 100)
-      ((15 50) 200)
-      (_ 300)
-      ((tag 10) 400))))
-  ($a (apply $sw 5))
-  ($b (apply $sw 10))
-  ($c (apply $sw 50))
-  ($d (apply $sw 60))
-  ($e (apply $sw (block (tag 10))))
-  (block (tag 0) $a $b $c $d $e))
-=> (block (tag 0) 100 100 200 300 400)
-```
-
-Behaviour is undefined if no cases match. If you are compiling a
-conditional statement to Malfunction and cannot prove that all cases
-are handled, you must add an explicit default case.
-
-The expression `(if A B C)` is equivalent to:
-
-    (switch A
-      (0 C)
-      (_ (tag _) B))
-
-That is, `C` is executed if `A` evaluates to zero, and `C` otherwise.
-
-Complex mixtures of conditions in `switch` expressions perform well -
-the OCaml compiler generates good code for pattern-matching.
-
-## Vectors
-
-Vectors are mutable, fixed-length sequences of slots. The slots are
-numbered from 0 to one less than the length of the vector, and support
-random access.
-
-  - `(makevec LEN VAL)`: creates a vector of length `LEN` (must evaluate to a
-    nonnegative integer) initially containing the result of evaluating `VAL` in all slots.
-  - `(load VEC IDX)`: evaluates `VEC` (which must evaluate to a
-    vector) and `IDX` (which must evaluate to an integer), and returns
-    the value of the `IDX`'th slot (which must be in bounds).
-  - `(store VEC IDX VAL)`: evaluates `VEC` (a vector), `IDX` (an
-    in-bounds index) and `VAL`, and stores `VAL` in the `IDX`'th slot.
-  - `(length VEC)`: evaluates `VEC` (a vector) and returns its length.
-
-As well as standard vectors, byte vectors are also available. They
-have the same semantics as vectors, except that the operations are
-suffixed `.byte` (`makevec.byte`, etc.) and they may only be used to
-store integers in the range 0-255.
-
-Behaviour is undefined if byte vector operations are used on standard
-vectors, or vice versa.
-
-String literals (`"hello"`) return byte vectors.
-
-## Lazy evaluation
-
-A *lazily-evaluated* expression is one that's not computed until it's
-needed. The expression `(lazy E)` constructs a lazy value that wraps
-the expression `E` but does not evaluate it immediately. When the lazy
-value is examined using `(force $lazyval)`, `E` will be computed.
-
-`E` is evaluated at most once for a given `(lazy E)`. If the resulting
-value is `force`d twice, then the value computed by `E` is cached.
-
-If evaluating `E` produces side effects, these occur at the time that
-`E` is first forced. For instance:
-
-```test
-(let
-  ($box (makevec 1 42))
-  ($thunk
-    (lazy (let
-      ($val (load $box 0))
-      (_ (store $box 0 (+ $val 1)))
-      $val)))
-  (block (tag 0)
-    (load $box 0)
-    (force $thunk)
-    (load $box 0)
-    (force $thunk)))
-=> (block (tag 0) 42 42 43 42)
-```
-
-## Accessing OCaml values
-
-OCaml values can be accessed from Malfunction programs by specifying a
-module path using `global`. For instance, the OCaml function
-`Stdlib.print_string` is referred to as `(global $Stdlib $print_string)`.
-
-As well as calling OCaml functions, certain OCaml values can be
-directly manipulated. The integer types `int`, `int32` and `int64`
-correspond to the OCaml types `int`, `Int32.t` and `Int64.t`, OCaml
-tuples are blocks with tag 0, and OCaml algebraic data types are
-represented as a combination of ints and blocks as described in
-section
-[19.3.4 of the OCaml manual, "Concrete data types"](https://v2.ocaml.org/manual/intfc.html#ss:c-concrete-datatypes).
diff --git a/malfunction/dune-project b/malfunction/dune-project
deleted file mode 100644
index 3da63ea49033..000000000000
--- a/malfunction/dune-project
+++ /dev/null
@@ -1,2 +0,0 @@
-(lang dune 1.11)
-(name malfunction)
diff --git a/malfunction/dune-workspace.all b/malfunction/dune-workspace.all
deleted file mode 100644
index 9bffbb2f414d..000000000000
--- a/malfunction/dune-workspace.all
+++ /dev/null
@@ -1,24 +0,0 @@
-(lang dune 1.0)
-(context (opam (switch default) (merlin)))
-(context (opam (switch 4.08.1)))
-(context (opam (switch 4.08.1+flambda)))
-(context (opam (switch 4.09.1)))
-(context (opam (switch 4.09.1+flambda)))
-(context (opam (switch 4.10.2)))
-(context (opam (switch 4.10.2+flambda)))
-(context (opam (switch 4.11.1)))
-(context (opam (switch 4.11.1+flambda)))
-(context (opam (switch 4.12.1)))
-(context (opam (switch 4.12.1+flambda)))
-(context (opam (switch 4.13.1) ))
-(context (opam (switch 4.13.1+flambda)))
-(context (opam (switch 4.14.0) ))
-(context (opam (switch 4.14.0+flambda)))
-(context (opam (switch 5.0.0)))
-(context (opam (switch 5.0.0+flambda)))
-(context (opam (switch 5.1.0)))
-(context (opam (switch 5.1.0+flambda)))
-(context (opam (switch 5.2.0)))
-(context (opam (switch 5.2.0+flambda)))
-(context (opam (switch 5.3.0~alpha1)))
-(context (opam (switch 5.3.0~alpha1+flambda)))
diff --git a/malfunction/dune-workspace.quick b/malfunction/dune-workspace.quick
deleted file mode 100644
index 3d30db11f72f..000000000000
--- a/malfunction/dune-workspace.quick
+++ /dev/null
@@ -1,5 +0,0 @@
-(lang dune 1.0)
-(context (opam (switch 4.14.0) (merlin)) )
-(context (opam (switch 5.0.0) ))
-(context (opam (switch 5.1.0)))
-(context (opam (switch 5.2.0~beta1)))
diff --git a/malfunction/examples/.gitignore b/malfunction/examples/.gitignore
deleted file mode 100644
index 1a1bfe92d94d..000000000000
--- a/malfunction/examples/.gitignore
+++ /dev/null
@@ -1,4 +0,0 @@
-*.inlining.org
-*.cm[iox]
-*.s
-*.o
diff --git a/malfunction/examples/dune b/malfunction/examples/dune
deleted file mode 100644
index 01d20bd404fb..000000000000
--- a/malfunction/examples/dune
+++ /dev/null
@@ -1,8 +0,0 @@
-(executable
- (name primrec)
- (modes native)
- (libraries malfunction))
-
-(alias
- (name runtest)
- (action (run ./primrec.exe)))
\ No newline at end of file
diff --git a/malfunction/examples/helloworld.mlf b/malfunction/examples/helloworld.mlf
deleted file mode 100644
index b282993d30f3..000000000000
--- a/malfunction/examples/helloworld.mlf
+++ /dev/null
@@ -1,7 +0,0 @@
-(module
-  (_ (apply (global $Stdlib $print_string) "Hello, world!\n"))
-  ($prt (global $Stdlib $print_int))
-  ($p2 
-    (lambda ($arg1) (lambda ($arg2) (+ $arg1 $arg2))))
-  (_ (apply $prt (apply $p2 2 40)))
-  (export))
diff --git a/malfunction/examples/primrec.ml b/malfunction/examples/primrec.ml
deleted file mode 100644
index 010946655fbf..000000000000
--- a/malfunction/examples/primrec.ml
+++ /dev/null
@@ -1,154 +0,0 @@
-(* Staged compilation of primitive-recursive arithmetic. *)
-
-(* Natural numbers (at type level) *)
-type zero = [`Zero]
-type 'a suc = [`Suc of 'a]
-
-(* Variables, indexed by the size of the context
-  (i.e. number of variables in scope) *)
-type _ v =
-| ZV : ('a suc) v
-| SV : 'a v -> ('a suc) v
-
-(* Well-scoped terms of PRA, with variables as de Bruijn indices.
-
-   PRA includes constants, successor, variables, let, and recursion.
-   Recursion defines a function on naturals by giving f 0, and
-   f (n + 1) in terms of both n and f n. *)
-type 'a t =
-| K : int -> 'a t
-| S : 'a t -> 'a t
-| V : 'a v -> 'a t
-| Let : 'a t * ('a suc) t -> 'a t
-| Rec : {name : string; ifzero : 'a t; ifsuc : ('a suc suc) t; n : 'a t} -> 'a t
-
-
-(* less horrible ways of writing de Bruijn indices *)
-
-let v0 = V ZV
-let v1 = V (SV ZV)
-let v2 = V (SV (SV ZV))
-let v3 = V (SV (SV (SV ZV)))
-let v4 = V (SV (SV (SV (SV ZV))))
-
-(* Addition, multiplication and exponentiation.
-   Bonus points if you can figure out why 'v4' and 'v1' are correct.
-   (de Bruijn indices are awful)
-
-   These are eta-expanded with () to get around the value restriction.
-   We want them to be polymorphic so that they work in any environment.
-   (i.e. we want add () to require at least two variables, not exactly two) *)
-let (%) f x = Let(x, f)
-let add () = Rec {name = "+"; ifzero = v1; ifsuc = S v1; n = v0}
-let mul () = Rec {name = "*"; ifzero = K 0; ifsuc = add () % v4 % v1; n = v0}
-let exp () = Rec {name = "^"; ifzero = K 1; ifsuc = mul () % v4 % v1; n = v0}
-
-
-(* Interpreter for PRA.
-   Takes as input a term, and an environment,
-   both with the same number of free variables *)
-
-(* Environments, mapping each variable to an integer *)
-type _ env =
-| Eps : zero env
-| Cons : 'a env * int -> ('a suc) env
-
-let rec interpret : type k . k t -> k env -> int =
-  fun t env -> match t with
-  | K n ->
-     n
-  | S t ->
-     interpret t env + 1
-  | V v ->
-     let rec lookup : type k . k env -> k v -> int =
-       fun env var -> match var, env with
-       | ZV, Cons (_env, n) -> n
-       | SV v, Cons (env, _) -> lookup env v in
-     lookup env v
-  | Let (e, body) ->
-     let v = interpret e env in
-     interpret body (Cons (env, v))
-  | Rec {name = _; ifzero; ifsuc; n} ->
-     let n = interpret n env in
-     let rec go n' fn' =
-       if n = n' then fn' else
-         let env = Cons (Cons (env, fn'), n') in
-         go (n' + 1) (interpret ifsuc env) in
-     go 0 (interpret ifzero env)
-
-
-(* Compiler for PRA. Compare to the interpreter above. *)
-
-(* Environments are split in two:
-     Params (variables passed as arguments to the program)
-     Locals (variables defined locally with Let) *)
-type 'a menv =
-| Params : Malfunction.t -> 'a menv
-| Local : 'a menv * Malfunction.t -> ('a suc) menv
-
-module I = Malfunction.IntArith
-let rec compile : type k . k t -> k menv -> Malfunction.t =
-  fun t env -> let open Malfunction in match t with
-  | K n ->
-     I.of_int n
-  | S t ->
-     I.(compile t env + one)
-  | V v ->
-     let rec lookup : type k . k menv -> k v -> Malfunction.t =
-       fun env var -> match var, env with
-       | ZV, Params env -> Mfield(1, env)
-       | SV v, Params env -> lookup (Params (Mfield (0, env))) v
-       | ZV, Local (_env, v) -> v
-       | SV v, Local (env, _) -> lookup env v in
-     lookup env v
-  | Let (e, body) ->
-     bind_val (compile e env) @@ fun v ->
-     compile body (Local (env, v))
-  | Rec {name = _; ifzero; ifsuc; n} ->
-     bind_val (compile n env) @@ fun n ->
-     bind_rec (fun go -> lambda2 @@ fun n' fn' ->
-       if_ I.(n = n')
-         fn'
-         I.(let env = Local(Local(env, fn'), n') in
-            Mapply(go, [n' + one; compile ifsuc env]))) @@ fun go ->
-     Mapply(go, [I.zero; compile ifzero env])
-
-(* Note that the type of this function is the same as that of 'interpret'
-   but partially applying this function will do the compilation work *)
-
-let run_compiled : type k . k t -> k env -> int =
-  fun t ->
-    let code = Malfunction.(lambda @@ fun v -> compile t (Params v)) in
-    let e = Malfunction_compiler.compile_and_load code in
-    fun env -> Obj.magic e env
-
-
-(* testcase: compute 16^4 *)
-let _ =
-  let env = Cons(Cons(Eps, 16), 4) in
-  assert (interpret (exp ()) env = 65536);
-  assert (run_compiled (exp ()) env = 65536)
-
-(* benchmark: calculate a bunch of exponents *)
-let benchmark name exec =
-  let env a b = Cons(Cons(Eps, a), b) in
-  (* to ensure same data for both implementations *)
-  Random.init 432789;
-  let tstart = Unix.gettimeofday () in
-  for _ = 1 to 50 do
-    let a = Random.int 100 and b = Random.int 5 in
-    assert (exec (env a b) = Z.(to_int (pow (of_int a) b)))
-  done;
-  let tend = Unix.gettimeofday () in
-  Printf.printf "%12s: %.2f secs\n%!" name (tend -. tstart)
-
-let _ =
-  benchmark "interpreted" (interpret (exp ()));
-  benchmark "compiled" (run_compiled (exp ()))
-
-(*
-  Results, on my machine:
-
-    interpreted: 5.69 secs
-       compiled: 0.18 secs
-*)
diff --git a/malfunction/malfunction.opam b/malfunction/malfunction.opam
deleted file mode 100644
index 2315288eb667..000000000000
--- a/malfunction/malfunction.opam
+++ /dev/null
@@ -1,24 +0,0 @@
-opam-version: "2.0"
-maintainer: "stephen.dolan@cl.cam.ac.uk"
-authors: ["Stephen Dolan"]
-homepage: "https://github.com/stedolan/malfunction"
-bug-reports: "https://github.com/stedolan/malfunction/issues"
-dev-repo: "git+https://github.com/stedolan/malfunction.git"
-license: "LGPL-2.0-or-later"
-build: [
-  [ "dune" "build" "-p" name "-j" jobs ]
-  [ "dune" "runtest" "-p" name "-j" jobs ] {with-test}
-]
-depends: [
-  "ocaml" {>= "4.08" & < "5.0.0"}
-  "ocamlfind"
-  "dune"
-  "cppo" {build}
-  "omd" {with-test & >= "2.0.0~"}
-  "zarith"
-]
-synopsis: "Compiler back-end for functional languages, based on OCaml"
-description: """
-Malfunction is a high-performance, low-level untyped program
-representation, designed as a target for compilers of functional
-programming languages."""
diff --git a/malfunction/src/dune b/malfunction/src/dune
deleted file mode 100644
index fa4016601787..000000000000
--- a/malfunction/src/dune
+++ /dev/null
@@ -1,21 +0,0 @@
-(ocamllex (modules malfunction_sexp))
-
-(rule
- (targets malfunction_compat.ml)
- (deps malfunction_compat.cppo.ml)
- (action (run %{bin:cppo} %{deps} -V OCAML:%{ocaml_version} -o %{targets})))
-
-(executable
- (name malfunction_main)
- (modes native)
- (libraries malfunction)
- (modules malfunction_main)
- (public_name malfunction))
-
-(library
- (name malfunction)
- (public_name malfunction)
- (libraries compiler-libs.optcomp compiler-libs.bytecomp str zarith findlib dynlink unix)
- (wrapped false)
- (modes native)
- (modules (:standard \ malfunction_main)))
diff --git a/malfunction/src/malfunction.ml b/malfunction/src/malfunction.ml
deleted file mode 100644
index b26032189b1e..000000000000
--- a/malfunction/src/malfunction.ml
+++ /dev/null
@@ -1,128 +0,0 @@
-type inttype = [`Int | `Int32 | `Int64 | `Bigint]
-type numtype = [inttype | `Float64]
-type numconst = [`Int of int | `Int32 of Int32.t | `Int64 of Int64.t | `Bigint of Z.t | `Float64 of float]
-type unary_num_op =
-  [`Neg | `Not]
-type binary_arith_op = [ `Add | `Sub | `Mul | `Div | `Mod ]
-type binary_bitwise_op = [ `And | `Or | `Xor | `Lsl | `Lsr | `Asr ]
-type binary_comparison = [ `Lt | `Gt | `Lte | `Gte | `Eq ]
-type binary_num_op =
-  [ binary_arith_op | binary_bitwise_op | binary_comparison ]
-
-type vector_type =
-  [`Array | `Bytevec]
-type mutability =
-  [ `Imm | `Mut ]
-
-type block_tag = int
-
-type case = [`Tag of int | `Deftag | `Intrange of int * int]
-
-
-let max_tag = 200
-let tag_of_int n =
-  if 0 <= n && n < max_tag then
-    n
-  else
-    invalid_arg "tag out of range"
-
-
-
-type t =
-| Mvar of Ident.t
-| Mlambda of Ident.t list * t
-| Mapply of t * t list
-| Mlet of binding list * t
-| Mnum of numconst
-| Mstring of string
-| Mglobal of Longident.t
-| Mswitch of t * (case list * t) list
-
-(* Numbers *)
-| Mnumop1 of unary_num_op * numtype * t
-| Mnumop2 of binary_num_op * numtype * t * t
-| Mconvert of numtype * numtype * t
-
-(* Vectors *)
-| Mvecnew of vector_type * t * t
-| Mvecget of vector_type * t * t
-| Mvecset of vector_type * t * t * t
-| Mveclen of vector_type * t
-
-(* Lazy *)
-| Mlazy of t
-| Mforce of t
-
-(* Blocks *)
-| Mblock of int * t list
-| Mfield of int * t
-
-and binding =
-  [ `Unnamed of t | `Named of Ident.t * t | `Recursive of (Ident.t * t) list ]
-
-
-type var = Ident.t
-
-let fresh = Ident.create_local
-
-let bind_val e body =
-  let v = fresh "x" in
-  Mlet ([`Named (v, e)], body (Mvar v))
-
-let bind_rec e body =
-  let v = fresh "x" in
-  Mlet ([`Recursive [v, e (Mvar v)]], body (Mvar v))
-
-let tuple xs = Mblock(0, xs)
-
-let lambda f =
-  let v = fresh "x" in
-  Mlambda ([v], f (Mvar v))
-
-let lambda2 f =
-  let vx = fresh "x" and vy = fresh "y" in
-  Mlambda ([vx; vy], f (Mvar vx) (Mvar vy))
-
-let if_ c tt ff =
-  Mswitch (c, [[`Intrange(0,0)], ff; [`Intrange(min_int,max_int);`Deftag], tt])
-
-module IntArith = struct
-  let of_int n = Mnum (`Int n)
-  let zero = of_int 0
-  let one = of_int 1
-  let (~-) a = Mnumop1(`Neg, `Int, a)
-  let lnot a = Mnumop1(`Not, `Int, a)
-  let (+) a b = Mnumop2(`Add, `Int, a, b)
-  let (-) a b = Mnumop2(`Sub, `Int, a, b)
-  let ( * ) a b = Mnumop2(`Mul, `Int, a, b)
-  let (/) a b = Mnumop2(`Div, `Int, a, b)
-  let (mod) a b = Mnumop2(`Mod, `Int, a, b)
-  let (land) a b = Mnumop2(`And, `Int, a, b)
-  let (lor) a b = Mnumop2(`Or, `Int, a, b)
-  let (lxor) a b = Mnumop2(`Xor, `Int, a, b)
-  let (lsl) a b = Mnumop2(`Lsl, `Int, a, b)
-  let (lsr) a b = Mnumop2(`Lsr, `Int, a, b)
-  let (asr) a b = Mnumop2(`Asr, `Int, a, b)
-  let (<) a b = Mnumop2(`Lt, `Int, a, b)
-  let (>) a b = Mnumop2(`Gt, `Int, a, b)
-  let (<=) a b = Mnumop2(`Lte, `Int, a, b)
-  let (>=) a b = Mnumop2(`Gte, `Int, a, b)
-  let (=) a b = Mnumop2(`Eq, `Int, a, b)
-end
-
-let with_error_reporting ppf def f =
-  try f () with
-  | Malfunction_sexp.SyntaxError ((locstart, locend), msg) ->
-     let open Lexing in
-     if locstart.pos_lnum = locend.pos_lnum then
-       Format.fprintf ppf "%s:%d:%d-%d: %s\n%!"
-         locstart.pos_fname locstart.pos_lnum (locstart.pos_cnum - locstart.pos_bol) (locend.pos_cnum - locend.pos_bol) msg
-     else
-       Format.fprintf ppf "%s:%d:%d-%d:%d %s\n%!"
-         locstart.pos_fname locstart.pos_lnum (locstart.pos_cnum - locstart.pos_bol) locend.pos_lnum (locend.pos_cnum - locend.pos_bol) msg;
-     def
-  | x ->
-     Printexc.print_backtrace stdout;
-     Location.report_exception ppf x;
-    def
-
diff --git a/malfunction/src/malfunction.mli b/malfunction/src/malfunction.mli
deleted file mode 100644
index a4b5d570850e..000000000000
--- a/malfunction/src/malfunction.mli
+++ /dev/null
@@ -1,101 +0,0 @@
-type inttype = [`Int | `Int32 | `Int64 | `Bigint]
-type numtype = [inttype | `Float64]
-type numconst = [`Int of int | `Int32 of Int32.t | `Int64 of Int64.t | `Bigint of Z.t | `Float64 of float]
-type unary_num_op =
-  [`Neg | `Not]
-type binary_arith_op = [ `Add | `Sub | `Mul | `Div | `Mod ]
-type binary_bitwise_op = [ `And | `Or | `Xor | `Lsl | `Lsr | `Asr ]
-type binary_comparison = [ `Lt | `Gt | `Lte | `Gte | `Eq ]
-type binary_num_op =
-  [ binary_arith_op | binary_bitwise_op | binary_comparison ]
-
-type vector_type =
-  [`Array | `Bytevec]
-type mutability =
-  [ `Imm | `Mut ]
-
-type block_tag = private int
-
-type case = [`Tag of int | `Deftag | `Intrange of int * int]
-
-val max_tag : block_tag
-val tag_of_int : int -> block_tag
-
-
-type var = Ident.t
-
-(* the argument to fresh does not affect semantics, but can be useful for debugging *)
-val fresh : string -> var
-
-type t =
-| Mvar of var
-| Mlambda of var list * t
-| Mapply of t * t list
-| Mlet of binding list * t
-| Mnum of numconst
-| Mstring of string
-| Mglobal of Longident.t
-| Mswitch of t * (case list * t) list
-
-(* Numbers *)
-| Mnumop1 of unary_num_op * numtype * t
-| Mnumop2 of binary_num_op * numtype * t * t
-| Mconvert of numtype * numtype * t
-
-(* Vectors *)
-| Mvecnew of vector_type * t * t
-| Mvecget of vector_type * t * t
-| Mvecset of vector_type * t * t * t
-| Mveclen of vector_type * t
-
-(* Lazy *)
-| Mlazy of t
-| Mforce of t
-
-(* Blocks *)
-| Mblock of int * t list
-| Mfield of int * t
-
-and binding =
-  [ `Unnamed of t | `Named of var * t | `Recursive of (var * t) list ]
-
-(* generate 'let' and 'let rec' in HOAS style *)
-val bind_val : t -> (t -> t) -> t
-val bind_rec : (t -> t) -> (t -> t) -> t
-
-(* create a block of tag 0 *)
-val tuple : t list -> t
-
-val lambda : (t -> t) -> t
-val lambda2 : (t -> t -> t) -> t
-
-val if_ : t -> t -> t -> t
-
-module IntArith : sig
-  val zero : t
-  val one : t
-  val of_int : int -> t
-  val (~-) : t -> t
-  val lnot : t -> t
-  val (+) : t -> t -> t
-  val (-) : t -> t -> t
-  val ( * ) : t -> t -> t
-  val (/) : t -> t -> t
-  val (mod) : t -> t -> t
-  val (land) : t -> t -> t
-  val (lor) : t -> t -> t
-  val (lxor) : t -> t -> t
-  val (lsl) : t -> t -> t
-  val (lsr) : t -> t -> t
-  val (asr) : t -> t -> t
-  val (<) : t -> t -> t
-  val (>) : t -> t -> t
-  val (<=) : t -> t -> t
-  val (>=) : t -> t -> t
-  val (=) : t -> t -> t
-end
-
-(* utility function to catch errors from parsing and compilation *)
-val with_error_reporting : Format.formatter -> 'a -> (unit -> 'a) -> 'a
-
-
diff --git a/malfunction/src/malfunction_compat.cppo.ml b/malfunction/src/malfunction_compat.cppo.ml
deleted file mode 100644
index 71cb6f77904b..000000000000
--- a/malfunction/src/malfunction_compat.cppo.ml
+++ /dev/null
@@ -1,208 +0,0 @@
-open Lambda
-
-let loc_none =
-#if OCAML_VERSION < (4, 11, 0)
-  Location.none
-#else
-  Debuginfo.Scoped_location.Loc_unknown
-#endif
-
-let lswitch (scr : lambda) (swi : lambda_switch) =
-  Lswitch(scr, swi, loc_none)
-
-let lfunction params body =
-  let params = List.map (fun x -> x, Pgenval) params in
-  let attr = {
-    inline = Default_inline;
-    specialise = Default_specialise;
-    is_a_functor = false;
-    stub = false;
-    local = Default_local;
-#if OCAML_VERSION >= (4, 14, 0)
-    poll = Default_poll;
-    tmc_candidate = false;
-#endif
-#if OCAML_VERSION >= (5, 2, 0)
-    may_fuse_arity = true;
-#endif
-  } in
-#if OCAML_VERSION >= (4, 14, 0)
-  lfunction
-    ~kind:Curried
-    ~params
-    ~return:Pgenval
-    ~body
-    ~attr
-    ~loc:loc_none
-#else
-  Lfunction {
-     kind = Curried;
-     params;
-     body;
-     loc = loc_none;
-     attr;
-     return = Pgenval;
-   }
-#endif
-
-let lapply fn args =
-  Lapply {
-    ap_func = fn;
-    ap_args = args;
-    ap_loc = loc_none; (* FIXME *)
-#if OCAML_VERSION < (4, 12, 0)
-    ap_should_be_tailcall = false;
-#else
-    ap_tailcall = Default_tailcall;
-#endif
-    ap_inlined = Default_inline;
-    ap_specialised = Default_specialise
-  }
-
-let lletrec bindings body =
-#if OCAML_VERSION < (5, 2, 0)
-  Lletrec (bindings, body)
-#else
-  let bindings = List.map (fun (id, v) -> id, Value_rec_types.Static, v) bindings in
-  Value_rec_compiler.compile_letrec bindings body
-#endif
-
-let pfield ix =
-#if OCAML_VERSION < (5, 0, 0)
-  Pfield ix
-#else
-  Pfield (ix, Pointer, Mutable)
-#endif
-
-module Subst : sig
-  type t
-  val empty : t
-  val add : Ident.t -> Lambda.lambda -> t -> t
-  val apply : t -> Lambda.lambda -> Lambda.lambda
-end = struct
-  type t = Lambda.lambda Ident.Map.t
-  let empty = Ident.Map.empty
-  let add = Ident.Map.add
-  let apply t x = 
-    Lambda.subst (fun _ _ e -> e) t x
-end
-
-let compmisc_init_path () =
-#if OCAML_VERSION < (4, 09, 0)
-  Compmisc.init_path true
-#else
-  Compmisc.init_path ()
-#endif
-
-let simplify_lambda lam =
-#if OCAML_VERSION < (4, 09, 0)
-  Simplif.simplify_lambda "malfunction" lam
-#else
-  Simplif.simplify_lambda lam
-#endif
-
-let load_path_find_uncap =
-#if OCAML_VERSION < (5, 2, 0)
-  Load_path.find_uncap
-#else
-  Load_path.find_normalized
-#endif
-
-let flambda_middle_end =
-#if OCAML_VERSION < (4, 09, 0)
-  Middle_end.middle_end
-#elif OCAML_VERSION < (4, 10, 0)
-  Flambda_middle_end.middle_end
-#else
-  Flambda_middle_end.lambda_to_clambda
-#endif
-
-let asmgen_compile_implementation_clambda ~backend =
-#if OCAML_VERSION < (4, 09, 0)
-  ignore backend;
-  Asmgen.compile_implementation_clambda ?toplevel:None
-#elif OCAML_VERSION < (4, 10, 0)
-  Asmgen.compile_implementation_clambda ?toplevel:None ~backend
-#else
-  Asmgen.compile_implementation ?toplevel:None ~backend
-    ~middle_end:Closure_middle_end.lambda_to_clambda
-#endif
-
-let env_read_signature ~module_name ~file =
-#if OCAML_VERSION < (5, 2, 0)
-  Env.read_signature module_name file
-#else
-  let a = Unit_info.Artifact.from_filename file in
-  assert (Unit_info.Artifact.modname a = module_name);
-  Env.read_signature a
-#endif
-
-let is_unit_name name =
-#if OCAML_VERSION < (5, 2, 0)
-  Compenv.is_unit_name name
-#else
-  Unit_info.is_unit_name name
-#endif
-
-let env_set_unit_name ~filename ~prefixname ~module_name =
-#if OCAML_VERSION < (5, 3, 0)
-  ignore (filename, prefixname);
-  Env.set_unit_name module_name
-#else
-  ignore module_name;
-  let info = Unit_info.make ~source_file:filename Impl prefixname in
-  Env.set_current_unit info
-#endif
-
-let emit_bytecode_to_file oc module_name cmofile ~required_globals bc =
-#if OCAML_VERSION < (5, 2, 0)
-  Emitcode.to_file oc module_name cmofile ~required_globals bc
-#else
-  let a = Unit_info.Artifact.from_filename cmofile in
-  assert (Unit_info.Artifact.modname a = module_name);
-  Emitcode.to_file oc a ~required_globals bc
-#endif
-
-let compile_implementation
-  ~prefixname ~filename ~module_id ~backend ~required_globals ~ppf (size, code) =
-#if OCAML_VERSION < (4,10,0)
-  if Config.flambda then begin
-    code
-    |> (fun lam ->
-      flambda_middle_end
-        ~ppf_dump:ppf
-        ~prefixname
-        ~backend
-        ~size
-        ~filename
-        ~module_ident:module_id
-        ~module_initializer:lam)
-    |> Asmgen.compile_implementation_flambda ?toplevel:None ~ppf_dump:ppf
-        prefixname
-        ~required_globals
-        ~backend
-  end else begin
-    (* FIXME: main_module_block_size is wrong *)
-    code
-    |> (fun code -> Lambda.{ module_ident = module_id; required_globals;
-                             code; main_module_block_size = size })
-    |> (asmgen_compile_implementation_clambda ~backend ~ppf_dump:ppf
-         prefixname);
-  end;
-#else
-  let program = Lambda.{code; main_module_block_size = size; module_ident = module_id; required_globals } in
-  let middle_end =
-    if Config.flambda then Flambda_middle_end.lambda_to_clambda
-    else Closure_middle_end.lambda_to_clambda
-  in
-#if OCAML_VERSION >= (4, 13, 0)
-  ignore filename;
-  Asmgen.compile_implementation
-    ?toplevel:None ~backend ~prefixname ~middle_end ~ppf_dump:ppf
-    program
-#else
-  Asmgen.compile_implementation
-    ?toplevel:None ~backend ~filename ~prefixname ~middle_end ~ppf_dump:ppf
-    program
-#endif
-#endif
diff --git a/malfunction/src/malfunction_compiler.ml b/malfunction/src/malfunction_compiler.ml
deleted file mode 100644
index b69094c0b210..000000000000
--- a/malfunction/src/malfunction_compiler.ml
+++ /dev/null
@@ -1,987 +0,0 @@
-open Lambda
-open Asttypes
-
-open Malfunction
-open Malfunction_parser
-open Malfunction_compat
-
-(* List.map, but guarantees left-to-right evaluation *)
-let rec lrmap f = function
-| [] -> []
-| (x :: xs) -> let r = f x in r :: lrmap f xs
-
-let lprim p args = Lprim (p, args, loc_none)
-let lbind n exp body =
-  let id = fresh n in
-  Llet (Strict, Pgenval, id, exp, body (Lvar id))
-
-(* Enforce left-to-right evaluation order by introducing 'let' bindings *)
-
-let rec reorder = function
-| Mvar _
-| Mnum _
-| Mstring _
-| Mglobal _ as t -> `Pure, t
-
-| Mlambda (params, body) ->
-  `Pure, Mlambda (params, snd (reorder body))
-
-| Mapply (f, xs) ->
-   reorder_sub `Impure (fun ev ->
-     let f = ev f in
-     let xs = lrmap ev xs in
-     Mapply (f, xs))
-
-| Mlet (bindings, body) ->
-   let bindings = reorder_bindings bindings in
-   let _, body = reorder body in
-   `Impure, Mlet (bindings, body)
-
-| Mswitch (e, cases) ->
-   `Impure, Mswitch (snd (reorder e), List.map (fun (c, e) -> c, snd (reorder e)) cases)
-
-| Mnumop1(op, ty, t) ->
-   reorder_sub `Pure (fun ev ->
-     Mnumop1(op, ty, ev t))
-
-| Mnumop2(op, ty, t1, t2) ->
-   reorder_sub `Pure (fun ev ->
-     let t1 = ev t1 in
-     let t2 = ev t2 in
-     Mnumop2(op, ty, t1, t2))
-
-| Mconvert(src, dst, t) -> 
-   reorder_sub `Pure (fun ev ->
-     Mconvert(src, dst, ev t))
-
-| Mvecnew(ty, len, def) ->
-   reorder_sub `Pure (fun ev ->
-     let len = ev len in
-     let def = ev def in
-     Mvecnew(ty, len, def))
-
-| Mvecget(ty, vec, idx) ->
-   reorder_sub `Impure (fun ev ->
-     let vec = ev vec in
-     let idx = ev idx in
-     Mvecget(ty, vec, idx))
-
-| Mvecset(ty, vec, idx, v) ->
-   reorder_sub `Impure (fun ev ->
-     let vec = ev vec in
-     let idx = ev idx in
-     let v = ev v in
-     Mvecset(ty, vec, idx, v))
-
-| Mveclen(ty, vec) ->
-   reorder_sub `Pure (fun ev ->
-     let vec = ev vec in
-     Mveclen(ty, vec))
-
-| Mblock (n, ts) ->
-   reorder_sub `Pure (fun ev ->
-     Mblock(n, lrmap ev ts))
-
-| Mfield (n, t) ->
-   reorder_sub `Impure (fun ev ->
-     Mfield (n, ev t))
-
-| Mlazy e ->
-  `Pure, Mlazy (snd (reorder e))
-
-| Mforce e ->
-   reorder_sub `Impure (fun ev ->
-     Mforce (ev e))
-
-and reorder_bindings bindings =
-  bindings
-  |> lrmap (function
-    | `Unnamed t -> `Unnamed (snd (reorder t))
-    | `Named (v, t) -> `Named (v, snd (reorder t))
-    | `Recursive _ as ts -> ts (* must be functions *))
-
-and reorder_sub p f =
-  let bindings = ref [] in
-  let r = f (fun e ->
-    match reorder e with
-    | `Pure, e -> e
-    | `Impure, e ->
-       let id = fresh "tmp" in
-       bindings := (`Named (id, e)) :: !bindings;
-       Mvar id) in
-  match List.rev !bindings with
-  | [] -> p, r
-  | bindings -> `Impure, (Mlet (bindings, r))
-
-module IntSwitch = struct
-
-  (* Convert a list of possibly-overlapping intervals to a list of disjoint intervals *)
-
-  type action = int (* lower numbers more important *)
-
-  (* cases is a sorted list
-     cases that begin lower appear first
-     when two cases begin together, more important appears first *)
-
-  type case = int * int * action (* start position, end position, priority *)
-  type cases = case list (* sorted by start position then priority *)
-
-  (* the inactive list is a list of (endpoint, priority) pairs representing
-     intervals that we are currently inside, but are overridden by a more important one.
-     subsequent elements of the list have strictly higher priorities and strictly later endpoints *)
-  type inactive = (int * action) list
-
-  let rec insert_inactive max act = function
-    | [] -> [(max, act)]
-    | (max', act') as i' :: rest when act' < act ->
-       (* this interval should appear before the new one *)
-       i' ::
-         (if max' <= max then
-             (* new interval will never be active *)
-             rest
-          else
-             insert_inactive max act rest)
-
-    | (max', act') :: rest when max' <= max ->
-       assert (act < act');
-       (* this interval will is contained by the new one, so never becomes active *)
-       insert_inactive max act rest
-
-    | ov ->
-       (* new interval both more important and ends sooner, so prepend *)
-       (max, act) :: ov
-
-  type state =
-    | Hole (* not currently in any interval *)
-    | Interval of (* in an interval... *)
-      int (* since this position *)
-      * int (* until here *)
-      * action (* with this action *)
-      * inactive (* overriding these inactive intervals *)
-
-  let state_suc = function
-    | Hole -> failwith "state_suc of Hole undefined"
-    | Interval (_, _, _, []) -> Hole
-    | Interval (_, s_max, _, (max', act') :: rest) ->
-       assert (s_max < max');
-       (* can compute s_max + 1 without overflow, because inactive interval ends later *)
-       Interval (s_max + 1, max', act', rest)
-
-  type result = case list (* may have duplicate actions, disjoint, sorted by position *)
-  let rec to_disjoint_intervals c_state (c_cases : cases) : result =
-    match c_state, c_cases with
-    | Hole, [] -> []
-
-    | Hole, ((min, max, act) :: cases) ->
-       to_disjoint_intervals (Interval (min, max, act, [])) cases
-
-    | Interval (entered, max, act, _) as state, [] ->
-       (entered, max, act) :: to_disjoint_intervals (state_suc state) []
-
-    | Interval (s_entered, s_max, s_act, _) as state,
-      (((min, _max, _act) :: _) as cases) when s_max < min ->
-       (* active interval ends before this case begins *)
-       (s_entered, s_max, s_act) :: to_disjoint_intervals (state_suc state) cases
-
-    (* below here, we can assume min <= i.s_max: active interval overlaps current case *)
-    | Interval (s_entered, s_max, s_act, s_inactive), ((_min, max, act) :: cases) when s_act < act ->
-       (* no change to active interval, but this case may become an inactive one *)
-       to_disjoint_intervals (Interval (s_entered, s_max, s_act, insert_inactive max act s_inactive)) cases
-
-    | Interval (s_entered, s_max, s_act, s_inactive), ((min, max, act) :: cases) ->
-       (* new active interval, so old one becomes inactive *)
-       assert (s_entered <= min); assert (min <= s_max); assert (act < s_act);
-       let r =
-         if s_entered = min then
-           (* old interval was not active long enough to produce output *)
-           []
-         else
-           [(s_entered, min - 1, s_act)] in
-       r @ to_disjoint_intervals
-         (Interval (min, max, act, insert_inactive s_max s_act s_inactive)) cases
-
-
-  (* unfortunately, this is not exposed from matching.ml, so copy-paste *)
-  module Switcher = Switch.Make (struct
-    type primitive = Lambda.primitive
-    type loc = Location.t
-    let _unused : loc option = None
-
-    let eqint = Pintcomp Ceq
-    let neint = Pintcomp Cne
-    let leint = Pintcomp Cle
-    let ltint = Pintcomp Clt
-    let geint = Pintcomp Cge
-    let gtint = Pintcomp Cgt
-
-    type arg = Lambda.lambda
-    type test = Lambda.lambda
-    type act = Lambda.lambda
-
-    let make_is_nonzero arg =
-      (* https://github.com/ocaml/ocaml/pull/10681 *)
-      Lprim (Pintcomp Cne,
-             [arg; Lconst (Const_base (Const_int 0))],
-             loc_none)
-
-    let arg_as_test (arg : arg) : test = arg
-
-    (* these are unused on some OCaml versions *)
-    let _ = make_is_nonzero, arg_as_test
-
-    let make_prim p args = lprim p args
-    let make_offset arg n = match n with
-    | 0 -> arg
-    | _ -> lprim (Poffsetint n) [arg]
-
-    let bind arg body =
-      let newvar,newarg = match arg with
-      | Lvar v -> v,arg
-      | _      ->
-          let newvar = fresh "switcher" in
-          newvar,Lvar newvar in
-      bind Alias newvar arg (body newarg)
-    let make_const i = Lconst (Const_base (Const_int i))
-    let make_isout h arg = lprim Pisout [h ; arg]
-    let make_isin h arg = lprim Pnot [make_isout h arg]
-    let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
-    let make_switch arg cases acts =
-      let l = ref [] in
-      for i = Array.length cases-1 downto 0 do
-        l := (i,acts.(cases.(i))) ::  !l
-      done ;
-      lswitch arg
-        {sw_numconsts = Array.length cases ; sw_consts = !l ;
-         sw_numblocks = 0 ; sw_blocks =  []  ;
-         sw_failaction = None}
-    let make_switch _loc = make_switch
-    let make_catch d =
-      match d with
-      | Lstaticraise (i, []) -> i, (fun e -> e)
-      | _ ->
-         let i = next_raise_count () in
-         i, fun e -> Lstaticcatch(e, (i, []), d)
-    let make_exit i = Lstaticraise (i,[])
-  end)
-
-  let compile_int_switch scr overlapped_cases =
-    assert (overlapped_cases <> []);
-    let actions = Array.of_list (overlapped_cases |> List.map snd) in
-    let cases = overlapped_cases
-      |> List.mapi (fun idx (`Intrange (min, max), _) -> (min, max, idx))
-      |> List.stable_sort (fun (min, _max, _idx) (min', _max', _idx') -> compare min min')
-      |> to_disjoint_intervals Hole in
-    let occurrences = Array.make (Array.length actions) 0 in
-    let rec count_occurrences = function
-      | [] -> assert false
-      | [(_min, _max, act)] ->
-         occurrences.(act) <- occurrences.(act) + 1
-      | (_min, max, act) :: (((min', _max', _act') :: _) as rest) ->
-         occurrences.(act) <- occurrences.(act) + 1;
-         begin if max + 1 <> min' then
-           (* When the interval list contains a hole, jump tables generated by
-              switch.ml may contain spurious references to action 0.
-              See PR#6805 *)
-           occurrences.(0) <- occurrences.(0) + 1
-         end;
-         count_occurrences rest in
-    count_occurrences cases;
-    let open Switch in
-    let store (*: Lambda.lambda t_store*) =
-      { act_get = (fun () ->
-          Array.copy actions);
-        act_get_shared = (fun () ->
-          actions |> Array.mapi (fun i act ->
-            if occurrences.(i) > 1 then Shared act else Single act));
-        act_store = (fun _ -> failwith "store unimplemented");
-        act_store_shared = (fun _ -> failwith "store_shared unimplemented") } in
-    let cases = Array.of_list cases in
-    let (low, _, _) = cases.(0) and (_, high, _) = cases.(Array.length cases - 1) in
-    Switcher.zyva Location.none (low, high) scr cases store
-end
-
-type global_value =
-  | Glob_val of lambda
-  | Glob_prim of Primitive.description
-  | Identity
-
-let lookup env v =
-  let open Types in
-  let open Primitive in
-  let (path, descr) =
-    try
-      Env.lookup_value ~loc:Location.none (*parse_loc loc*) v env
-    with Not_found ->
-      let rec try_stdlib = let open Longident in function
-        | Lident s -> Ldot (Lident "Stdlib", s)
-        | Ldot (id, s) -> Ldot (try_stdlib id, s)
-        | Lapply _ as l -> l in
-      try Env.lookup_value ~loc:Location.none (try_stdlib v) env
-      with Not_found ->
-        failwith ("global not found: " ^ String.concat "." (Longident.flatten v)) in
-  match descr.val_kind with
-  | Val_reg -> Glob_val (transl_value_path loc_none env path)
-  | Val_prim(p) ->
-     (match p.prim_name with
-     | "%equal" ->
-        Glob_prim (Primitive.simple ~name:"caml_equal" ~arity:2 ~alloc:true)
-     | "%compare" ->
-        Glob_prim (Primitive.simple ~name:"caml_compare" ~arity:2 ~alloc:true)
-     | "%identity" ->
-        Identity
-     | s when s.[0] = '%' ->
-        failwith ("unimplemented primitive " ^ p.prim_name);
-     | _ ->
-        Glob_prim p)
-  | _ -> failwith "unexpected kind of value"
-
-
-let identity_to_lambda args =
-  match args with
-  | [] ->
-     let param = fresh "prim" in
-     lfunction [param] (Lvar param)
-  | [x] -> x
-  | fn :: args -> lapply fn args
-
-let builtin env path args =
-  let p = match path with
-    | path1 :: pathrest ->
-       List.fold_left (fun id s -> Longident.Ldot (id, s))
-         (Longident.Lident path1) pathrest
-    | _ -> assert false in
-  match lookup env p with
-  | Glob_val v ->
-     lapply v args
-  | Glob_prim p ->
-     assert (p.prim_arity = List.length args);
-     lprim (Pccall p) args
-  | Identity ->
-     identity_to_lambda args
-
-
-let global_to_lambda = function
-  | Glob_val v -> v
-  | Glob_prim p ->
-     (* Eta-expand this primitive. See translprim.ml. *)
-     let rec make_params n =
-       if n <= 0 then []
-       else fresh "prim" :: make_params (n-1) in
-     let params = make_params p.prim_arity in
-     let body = lprim (Pccall p) (List.map (fun x -> Lvar x) params) in
-     lfunction params body
-  | Identity -> identity_to_lambda []
-
-let rec to_lambda env = function
-  | Mvar v ->
-     Lvar v
-  | Mlambda (params, e) ->
-     if List.length params > max_arity () then
-        (* we have to split the function *)
-        let rec extractk k xs = match k, xs with
-         | 0, xs -> [], xs
-         | _, [] -> failwith "extractk"
-         | k, x::xs ->
-            let first, last = extractk (k-1) xs in
-            x::first, last in
-        let params1, params2 = extractk (max_arity ()) params in
-        let e = Mlambda (params2, e) in
-        lfunction params1 (to_lambda env e)
-     else
-        lfunction params (to_lambda env e)
-  | Mapply (fn, args) ->
-     let ap_func fn = lapply fn (List.map (to_lambda env) args) in
-     (match fn with
-     | Mglobal v ->
-        (match lookup env v with
-        | Glob_prim p when p.prim_arity = List.length args ->
-           lprim (Pccall p) (List.map (to_lambda env) args)
-        | Identity -> identity_to_lambda (List.map (to_lambda env) args)
-        | g -> ap_func (global_to_lambda g))
-     | fn ->
-        ap_func (to_lambda env fn))
-  | Mlet (bindings, body) ->
-     bindings_to_lambda env bindings (to_lambda env body)
-  | Mnum (`Int n) ->
-     Lconst (Const_base (Const_int n))
-  | Mnum (`Int32 n) ->
-     Lconst (Const_base (Const_int32 n))
-  | Mnum (`Int64 n) ->
-     Lconst (Const_base (Const_int64 n))
-  | Mnum (`Bigint n) ->
-     (match Z.to_int n with
-     | n' ->
-        assert (Obj.repr n = Obj.repr n');
-        Lconst (Const_base (Const_int n'))
-     | exception Z.Overflow ->
-        builtin env ["Z"; "of_string"] [Lconst (Const_immstring (Z.to_string n))])
-  | Mnum (`Float64 f) ->
-     Lconst (Const_base (Const_float (string_of_float f)))
-  | Mstring s ->
-     Lconst (Const_immstring s)
-  | Mglobal v ->
-     global_to_lambda (lookup env v)
-  | Mswitch (scr, cases) ->
-     let scr = to_lambda env scr in
-     let rec flatten acc = function
-       | ([], _) :: _ -> assert false
-       | ([sel], e) :: rest -> flatten ((sel, to_lambda env e) :: acc) rest
-       | (sels, e) :: rest ->
-          let i = next_raise_count () in
-          let cases = List.map (fun s -> s, Lstaticraise(i, [])) sels in
-          Lstaticcatch (flatten (cases @ acc) rest, (i, []), to_lambda env e)
-       | [] ->
-          let rec partition (ints, tags, deftag) = function
-            | [] -> (List.rev ints, List.rev tags, deftag)
-            | (`Tag _, _) as c :: cases -> partition (ints, c :: tags, deftag) cases
-            | (`Deftag, _) as c :: cases -> partition (ints, tags, Some c) cases
-            | (`Intrange _, _) as c :: cases -> partition (c :: ints, tags, deftag) cases in
-          let (intcases, tagcases, deftag) = partition ([],[],None) (List.rev acc) in
-          lbind "switch" scr (fun scr ->
-            let tagswitch = match tagcases, deftag with
-              | [], None -> None
-              | [_,e], None | [], Some (_, e) -> Some e
-              | tags, def ->
-                 let numtags = match def with
-                   | Some _ -> (max_tag :> int)
-                   | None -> 1 + List.fold_left (fun s (`Tag i, _) -> max s (i :> int)) (-1) tags in
-                 Some (lswitch scr {
-                   sw_numconsts = 0; sw_consts = []; sw_numblocks = numtags;
-                   sw_blocks = List.map (fun (`Tag i, e) -> i, e) tags;
-                   sw_failaction = match def with None -> None | Some (`Deftag,e) -> Some e
-                 }) in
-            let intswitch = match intcases with
-              | [] -> None
-              | [_,e] -> Some e
-              | ints -> Some (IntSwitch.compile_int_switch scr ints) in
-            match intswitch, tagswitch with
-            | None, None -> assert false
-            | None, Some e | Some e, None -> e
-            | Some eint, Some etag ->
-               Lifthenelse (lprim Pisint [scr], eint, etag)) in
-     flatten [] cases
-  | Mnumop1 (op, ty, e) ->
-     let e = to_lambda env e in
-     let ones32 = Const_base (Asttypes.Const_int32 (Int32.of_int (-1))) in
-     let ones64 = Const_base (Asttypes.Const_int64 (Int64.of_int (-1))) in
-     let code = match op, ty with
-       | `Neg, `Int -> lprim Pnegint [e]
-       | `Neg, `Int32 -> lprim (Pnegbint Pint32) [e]
-       | `Neg, `Int64 -> lprim (Pnegbint Pint64) [e]
-       | `Neg, `Bigint -> builtin env ["Z"; "neg"] [e]
-       | `Neg, `Float64 -> lprim Pnegfloat [e]
-       | `Not, `Int -> lprim Pnot [e]
-       | `Not, `Int32 ->
-          lprim (Pxorbint Pint32) [e; Lconst ones32]
-       | `Not, `Int64 ->
-          lprim (Pxorbint Pint64) [e; Lconst ones64]
-       | `Not, `Bigint -> builtin env ["Z"; "lognot"] [e] 
-       | `Not, `Float64 -> assert false in
-     code
-  | Mnumop2 (op, ((`Int|`Int32|`Int64) as ty), e1, e2) ->
-     let e1 = to_lambda env e1 in
-     let e2 = to_lambda env e2 in
-     let prim = match ty with
-       | `Int ->
-          (match op with
-            `Add -> Paddint | `Sub -> Psubint | `Mul -> Pmulint
-          | `Div -> Pdivint Safe | `Mod -> Pmodint Safe
-          | `And -> Pandint | `Or -> Porint | `Xor -> Pxorint
-          | `Lsl -> Plslint | `Lsr -> Plsrint | `Asr -> Pasrint
-          | `Lt -> Pintcomp Clt | `Gt -> Pintcomp Cgt
-          | `Lte -> Pintcomp Cle | `Gte -> Pintcomp Cge
-          | `Eq -> Pintcomp Ceq)
-       | (`Int32 | `Int64) as ty ->
-          let t = match ty with `Int32 -> Pint32  | `Int64 -> Pint64 in
-          (match op with
-            `Add -> Paddbint t | `Sub -> Psubbint t | `Mul -> Pmulbint t
-          | `Div -> Pdivbint { size = t; is_safe = Safe }
-          | `Mod -> Pmodbint { size = t; is_safe = Safe }
-          | `And -> Pandbint t | `Or -> Porbint t | `Xor -> Pxorbint t
-          | `Lsl -> Plslbint t | `Lsr -> Plsrbint t | `Asr -> Pasrbint t
-          | `Lt -> Pbintcomp (t, Clt) | `Gt -> Pbintcomp (t, Cgt)
-          | `Lte -> Pbintcomp (t, Cle) | `Gte -> Pbintcomp (t, Cge)
-          | `Eq -> Pbintcomp (t, Ceq)) in
-     lprim prim [e1; e2]
-  | Mnumop2 (op, `Bigint, e1, e2) ->
-     let e1 = to_lambda env e1 in
-     let e2 = to_lambda env e2 in
-     let fn = match op with
-       | `Add -> "add" | `Sub -> "sub"
-       | `Mul -> "mul" | `Div -> "div" | `Mod -> "rem"
-       | `And -> "logand" | `Or -> "logor" | `Xor -> "logxor"
-       | `Lsl -> "shift_left" | `Lsr -> "shift_right" | `Asr -> "shift_right"
-       | `Lt -> "lt" | `Gt -> "gt"
-       | `Lte -> "leq" | `Gte -> "geq" | `Eq -> "equal" in
-     builtin env ["Z"; fn] [e1; e2]
-  | Mnumop2 (op, `Float64, e1, e2) ->
-     let e1 = to_lambda env e1 in
-     let e2 = to_lambda env e2 in
-     begin match op with
-     | #binary_bitwise_op -> assert false
-     | `Add -> lprim Paddfloat [e1; e2]
-     | `Sub -> lprim Psubfloat [e1; e2]
-     | `Mul -> lprim Pmulfloat [e1; e2]
-     | `Div -> lprim Pdivfloat [e1; e2]
-     | `Mod -> builtin env ["Stdlib"; "mod_float"] [e1; e2]
-     | #binary_comparison as op ->
-        let cmp_to_float_comparison op = 
-          match op with
-          | `Lt -> CFlt
-          | `Gt -> CFgt
-          | `Lte -> CFle
-          | `Gte -> CFge
-          | `Eq -> CFeq
-        in
-        let cmp = cmp_to_float_comparison op in
-        lprim (Pfloatcomp cmp) [e1; e2]
-     end
-  | Mconvert (src, dst, e) ->
-     let e = to_lambda env e in
-     begin match src, dst with
-       | `Bigint, `Bigint
-       | `Int, `Int
-       | `Int32, `Int32
-       | `Int64, `Int64
-       | `Float64, `Float64 -> e
-       | `Bigint, ((`Int|`Int32|`Int64) as dst) ->
-          (* Zarith raises exceptions on overflow, but we truncate conversions. Not fast. *)
-          let width = match dst with 
-            | `Int -> Sys.word_size - 1
-            | `Int32 -> 32
-            | `Int64 -> 64 in
-          let range = Z.(shift_left (of_int 1) width) in
-          let truncated =
-            lbind "range"
-             (builtin env ["Z"; "of_string"] [Lconst (Const_immstring (Z.to_string range))])
-             (fun range ->
-               lbind "masked"
-                 (builtin env ["Z"; "logand"] [e;
-                      builtin env ["Z"; "sub"] [range;
-                                                Lconst (Const_base (Const_int 1))]])
-                 (fun masked ->
-                   Lifthenelse (builtin env ["Z"; "testbit"] 
-                                  [masked; Lconst (Const_base (Const_int (width - 1)))],
-                                builtin env ["Z"; "sub"] [masked; range],
-                                masked))) in
-          let fn = match dst with
-            | `Int -> "to_int"
-            | `Int32 -> "to_int32"
-            | `Int64 -> "to_int64" in
-          builtin env ["Z"; fn] [truncated]
-       | ((`Int|`Int32|`Int64) as src), `Bigint ->
-          let fn = match src with
-            | `Int -> "of_int"
-            | `Int32 -> "of_int32"
-            | `Int64 -> "of_int64" in
-          builtin env ["Z"; fn] [e]
-       | `Int, `Int32 ->
-          lprim (Pbintofint Pint32) [e]
-       | `Int, `Int64 ->
-          lprim (Pbintofint Pint64) [e]
-       | `Int32, `Int ->
-          lprim (Pintofbint Pint32) [e]
-       | `Int64, `Int ->
-          lprim (Pintofbint Pint64) [e]
-       | `Int32, `Int64 ->
-          lprim (Pcvtbint(Pint32, Pint64)) [e]
-       | `Int64, `Int32 ->
-          lprim (Pcvtbint(Pint64, Pint32)) [e]
-       | `Int, `Float64 ->
-          lprim Pfloatofint [e]
-       | `Int32, `Float64 ->
-          builtin env ["Int32"; "to_float"] [e]
-       | `Int64, `Float64 ->
-          builtin env ["Int64"; "to_float"] [e]
-       | `Bigint, `Float64 ->
-          builtin env ["Z"; "to_float"] [e]
-       (* FIXME: error handling on overflow *)
-       | `Float64, `Int ->
-          lprim Pintoffloat [e]
-       | `Float64, `Int32 ->
-          builtin env ["Int32"; "of_float"] [e]
-       | `Float64, `Int64 ->
-          builtin env ["Int64"; "of_float"] [e]
-       | `Float64, `Bigint ->
-          builtin env ["Z"; "of_float"] [e]
-     end
-  | Mvecnew (`Array, len, def) ->
-     builtin env ["Array"; "make"] [to_lambda env len; to_lambda env def]
-  | Mvecnew (`Bytevec, len, def) ->
-     builtin env ["String"; "make"] [to_lambda env len; to_lambda env def]
-  | Mvecget (ty, vec, idx) ->
-     let prim = match ty with
-       | `Array -> Parrayrefs Paddrarray
-       | `Bytevec -> Pbytesrefs
-(*       | `Floatvec -> Parrayrefs Pfloatarray *) in
-     lprim prim [to_lambda env vec; to_lambda env idx]
-  | Mvecset (ty, vec, idx, v) ->
-     let prim = match ty with
-       | `Array -> Parraysets Paddrarray
-       | `Bytevec -> Pbytessets
-(*       | `Floatvec -> Parraysets Pfloatarray *) in
-     lprim prim [to_lambda env vec; to_lambda env idx; to_lambda env v]
-  | Mveclen (ty, vec) ->
-     let prim = match ty with
-       | `Array -> Parraylength Paddrarray
-       | `Bytevec -> Pbyteslength
-(*       | `Floatvec -> Parraylength Pfloatarray *) in
-     lprim prim [to_lambda env vec]
-  | Mblock (tag, vals) ->
-     lprim (Pmakeblock (tag, Immutable, None)) (List.map (to_lambda env) vals)
-  | Mfield (idx, e) ->
-      lprim (pfield idx) [to_lambda env e]
-  | Mlazy e ->
-     let fn = lfunction [fresh "param"] (to_lambda env e) in
-     lprim (Pmakeblock (Config.lazy_tag, Mutable, None)) [fn]
-  | Mforce e ->
-     Matching.inline_lazy_force (to_lambda env e) loc_none
-
-and bindings_to_lambda env bindings body =
-  List.fold_right (fun b rest -> match b with
-  | `Unnamed e ->
-     Lsequence (to_lambda env e, rest)
-  | `Named (n, e) ->
-     Llet (Strict, Pgenval, n, to_lambda env e, rest)
-  | `Recursive bs ->
-     lletrec (List.map (fun (n, e) -> (n, to_lambda env e)) bs) rest)
-    bindings body
-
-let setup_options options =
-  Clflags.native_code := true;
-  Clflags.flambda_invariant_checks := true;
-  Clflags.nopervasives := false;
-  Clflags.dump_lambda := false;
-  Clflags.dump_cmm := false;
-  Clflags.keep_asm_file := false;
-  Clflags.include_dirs := [Findlib.package_directory "zarith"];
-  Clflags.inlining_report := false;
-  Clflags.dlcode := true;
-  Clflags.shared := false;
-  Clflags.(default_simplify_rounds := 0);
-  (* FIXME: should we use classic_arguments for non-flambda builds? *)
-
-
-  (* Hack: disable the "no cmx" warning for zarith *)
-  let _ = Warnings.parse_options false "-58" in
-  assert (not (Warnings.is_active (Warnings.No_cmx_file "asdf")));
-
-  (options |> List.iter @@ function
-  | `Verbose ->
-     Clflags.dump_lambda := true;
-     Clflags.dump_cmm := true;
-     Clflags.keep_asm_file := true;
-     Clflags.inlining_report := true
-     (*
-       If anyone wants to keep these, there should probably be another option for where to put them.
-       (rather than leaving stale temporary directories around)
-      *)
-  | `Shared ->
-     Clflags.shared := true
-  | `Include dir ->
-     Clflags.include_dirs := dir :: !Clflags.include_dirs
-  | `Package s -> 
-     let packages = String.split_on_char ',' s in
-     let dirs = List.map Findlib.package_directory packages in
-     Clflags.include_dirs := dirs @ !Clflags.include_dirs
-  | `ForPack s -> Clflags.for_package := Some s
-  | `Dontlink _ -> ()
-  | `Linkpkg -> ()
-  | `Debug -> Clflags.debug := true
-  | `Rectypes -> Clflags.recursive_types := true
-  | `Thread -> ()
-  | `Optimize ->   Clflags.(
-    default_simplify_rounds := 2;
-    use_inlining_arguments_set o2_arguments;
-    use_inlining_arguments_set ~round:0 o1_arguments);
-  | `Bytecode -> Clflags.native_code := false
-   );
-  (* FIXME: should we use classic_arguments for non-flambda builds? *)
-
-  Compenv.(readenv Format.std_formatter (Before_compile "malfunction"));
-  compmisc_init_path ()
-
-let module_to_lambda ?options ~module_name:_ ~module_id (Mmod (bindings, exports)) =
-  setup_options (match options with Some o -> o | None -> []);
-  let print_if flag printer arg =
-    if !flag then Format.printf "%a@." printer arg;
-    arg in
-
-  let env = Compmisc.initial_env () in
-  let module_size, code =
-    let bindings = reorder_bindings bindings in
-    let exports = List.map (fun e -> snd (reorder e)) exports in
-    if Config.flambda || not !Clflags.native_code then
-      List.length exports,
-      bindings_to_lambda env bindings
-        (lprim (Pmakeblock (0, Immutable, None)) (List.map (to_lambda env) exports))
-    else begin
-      let loc = loc_none (* FIXME *) in
-      let num_exports = List.length exports in
-      (* Compile all of the bindings, store at positions num_exports + i,
-         then compile the exports. See Translmod.transl_store_gen. *)
-      let module_length = ref (-1) in
-      let mod_store pos e =
-        Lprim (Psetfield (pos, Pointer, Root_initialization),
-               [Lprim (Pgetglobal module_id, [], loc); e], loc) in
-      let mod_load pos =
-        Lprim (pfield pos,
-               [Lprim (Pgetglobal module_id, [], loc)], loc) in
-      let transl_exports subst =
-        let exps = List.mapi (fun i e -> mod_store i (Subst.apply subst (to_lambda env e))) exports in
-        List.fold_right (fun x xs -> Lsequence (x, xs)) exps (Lconst Lambda.const_unit) in
-      let rec transl_toplevel_bindings pos subst = function
-        | `Unnamed e :: rest ->
-           Lsequence (Subst.apply subst (to_lambda env e),
-                      transl_toplevel_bindings pos subst rest)
-        | `Named (n, e) :: rest ->
-           let lam =
-             Llet (Strict, Pgenval, n, Subst.apply subst (to_lambda env e), mod_store pos (Lvar n)) in
-           Lsequence (lam,
-                      transl_toplevel_bindings
-                        (pos + 1)
-                        (Subst.add n (mod_load pos) subst)
-                        rest)
-        | `Recursive bs :: rest ->
-           let ids = List.map fst bs in
-           let stores = ids |> List.mapi (fun i n -> mod_store (pos + i) (Lvar n)) in
-           let stores = List.fold_right (fun x xs -> Lsequence (x, xs))
-                          stores (Lconst Lambda.const_unit) in
-           let lam =
-             lletrec (bs |> List.map (fun (n, e) ->
-                                (n, Subst.apply subst (to_lambda env e))))
-                      stores in
-           let id_load = ids |> List.mapi (fun i n -> (n, mod_load (pos + i))) in
-           let subst = List.fold_left (fun subst (n, l) -> Subst.add n l subst) subst id_load in
-           Lsequence (lam, transl_toplevel_bindings (pos + List.length ids) subst rest)
-
-        | [] -> module_length := pos; transl_exports subst in
-      let r = transl_toplevel_bindings num_exports Subst.empty bindings in
-      !module_length, r
-    end in
-
-  let lambda = code
-  |> print_if Clflags.dump_rawlambda Printlambda.lambda
-  |> simplify_lambda
-  |> print_if Clflags.dump_lambda Printlambda.lambda in
-
-  (module_size, lambda)
-
-
-
-let backend = (module struct
-  include Compilenv
-  include Import_approx
-  include Arch
-  let max_sensible_number_of_arguments =
-    Proc.max_arguments_for_tailcalls - 1
-end : Backend_intf.S)
-
-type outfiles =
-  | Out_native of {cmxfile: string; rest: string list}
-  | Out_bytecode of {cmofile: string; rest: string list}
-
-let delete_temps outfiles =
-  let temps =
-    match outfiles with
-    | Out_native {cmxfile; rest} -> cmxfile::rest
-    | Out_bytecode {cmofile; rest} -> cmofile::rest
-  in
-  List.iter Misc.remove_file temps
-
-type options = [`Verbose | `Shared | `ForPack of string | `Include of string | `Package of string | `Dontlink of string | `Linkpkg | `Debug | `Rectypes | `Thread | `Optimize | `Bytecode] list
-
-let ensure_cmi ~module_name ~filename =
-  let cmi = module_name ^ ".cmi" in
-  Compilenv.reset ?packname:!Clflags.for_package module_name;
-  match load_path_find_uncap cmi with
-  | file -> env_read_signature ~module_name ~file, None
-  | exception Not_found ->
-     let chop_ext =
-         Misc.chop_extensions
-       in
-     let mlifile = chop_ext filename ^ !Config.interface_suffix in
-     if Sys.file_exists mlifile then
-       Typemod.(raise(Error(Location.in_file filename,
-                            Env.empty,
-                            Interface_not_compiled cmi)))
-     else
-       (* hackily generate an empty cmi file *)
-       let cmifile = String.uncapitalize_ascii cmi in
-       let mlifile = String.uncapitalize_ascii (module_name ^ ".mli") in
-       let ch = open_out mlifile in
-       output_string ch "(* autogenerated mli for malfunction *)\n";
-       close_out ch;
-       ignore (Sys.command ("ocamlc -c " ^ mlifile));
-       Misc.remove_file mlifile;
-       if not (Sys.file_exists cmifile) then failwith "Failed to generate empty cmi file";
-       env_read_signature ~module_name ~file:cmifile, Some cmifile
-
-
-let lambda_to_cmx ~options ~filename ~prefixname ~module_name ~module_id lmod =
-  let ppf = Format.std_formatter in
-  let cmxfile = prefixname ^ ".cmx" in
-  let objfile = prefixname ^ Config.ext_obj in
-  let outfiles = ref [objfile] in
-  setup_options options;
-  try
-    env_set_unit_name ~filename ~prefixname ~module_name;
-    let _, cmifile = ensure_cmi ~module_name ~filename in
-    outfiles := Option.to_list cmifile @ !outfiles;
-    (* FIXME: may need to add modules referenced only by "external" to this.
-       See Translmod.primitive_declarations and its use in Asmgen. *)
-    (* FIXME: Translprim.get_used_primitives (see translmod.ml)? *)
-    (* FIXME: Translmod.required_globals? Env.reset_required_globals? Should this be in to_lambda? *)
-    let required_globals = Ident.Set.of_list (Env.get_required_globals ()) in
-    compile_implementation ~prefixname ~filename ~module_id ~backend ~required_globals ~ppf lmod;
-    Compilenv.save_unit_info cmxfile;
-    Warnings.check_fatal ();
-    Out_native {cmxfile; rest = !outfiles}
-  with e ->
-    let bt = Printexc.get_raw_backtrace () in
-    delete_temps (Out_native {cmxfile; rest = !outfiles});
-    Printexc.raise_with_backtrace e bt
-
-let lambda_to_cmo ~options ~filename ~prefixname ~module_name ~module_id (_size, lambda) =
-  let cmofile = prefixname ^ ".cmo" in
-  let outfiles = ref [] in
-  setup_options options;
-  try
-    env_set_unit_name ~filename ~prefixname ~module_name;
-    let _, cmifile = ensure_cmi ~module_name ~filename in
-    outfiles := Option.to_list cmifile @ !outfiles;
-    (* FIXME: may need to add modules referenced only by "external" to this.
-       See Translmod.primitive_declarations and its use in Asmgen. *)
-    (* FIXME: Translprim.get_used_primitives (see translmod.ml)? *)
-    (* FIXME: Translmod.required_globals? Env.reset_required_globals? Should this be in to_lambda? *)
-    let lambda = lprim (Psetglobal module_id) [lambda] in
-    let required_globals = Ident.Set.of_list (Env.get_required_globals ()) in
-    let bytecode = Bytegen.compile_implementation module_name lambda in
-    let oc = open_out_bin cmofile in
-    Fun.protect ~finally:(fun () -> close_out oc) (fun () ->
-      emit_bytecode_to_file oc module_name cmofile ~required_globals bytecode);
-    Warnings.check_fatal ();
-    Out_bytecode {cmofile; rest = !outfiles}
-  with e ->
-    delete_temps (Out_bytecode {cmofile; rest = !outfiles});
-    raise e
-
-let compile_module ?(options=[]) ~filename modl =
-  (* FIXME: do we really want to go through Clflags here? See Compenv.output_prefix *)
-  let prefixname = Compenv.output_prefix filename in
-  let module_name =
-    prefixname
-    |> Filename.basename
-    |> Filename.remove_extension
-    |> String.capitalize_ascii in
-  let lambda_to_output =
-    if List.mem `Bytecode options
-    then lambda_to_cmo
-    else lambda_to_cmx
-  in
-  if not (is_unit_name module_name) then
-    raise (Invalid_argument ("Invalid module name " ^ module_name));
-  let module_id = Ident.create_persistent module_name in
-  modl
-  |> module_to_lambda ~module_name ~module_id ~options
-  |> lambda_to_output ~options ~filename ~prefixname ~module_name ~module_id
-
-let compile_file ~options filename =
-  let lexbuf = Lexing.from_channel (open_in filename) in
-  Lexing.(lexbuf.lex_curr_p <-
-            { lexbuf.lex_curr_p with pos_fname = filename });
-  let modl = Malfunction_parser.read_module lexbuf in
-  compile_module ~options ~filename modl
-
-let compile_cmx ?(options=[]) filename =
-  compile_file ~options filename
-
-let compile_cmo ?(options=[]) filename =
-  compile_file ~options:(`Bytecode :: options) filename
-
-(* copied from opttoploop.ml *)
-external ndl_run_toplevel: string -> string -> (Obj.t, string) result
-  = "caml_natdynlink_run_toplevel"
-external ndl_loadsym: string -> Obj.t = "caml_natdynlink_loadsym"
-
-let code_id = ref 0
-
-let compile_and_load ?(options : options =[]) e =
-  if not Dynlink.is_native then
-    failwith "Loading malfunction values works only in native code";
-  let tmpdir = Filename.temp_file "malfunction" ".tmp" in
-  (* more than a little horrible *)
-  Unix.unlink tmpdir;
-  Unix.mkdir tmpdir 0o700;
-  let old_cwd = Sys.getcwd () in
-  Sys.chdir tmpdir;
-  incr code_id;
-  let modname = "Malfunction_Code_" ^ string_of_int (!code_id) in
-  let modname_uncap = String.uncapitalize_ascii modname in
-  let options = `Shared :: options in
-  let tmpfiles = compile_module ~options ~filename:modname_uncap (Mmod ([], [e])) in
-  let cmxfile =
-    match tmpfiles with
-    | Out_native o -> o.cmxfile
-    | Out_bytecode _ -> failwith "Bytecode loading unsupported"
-  in
-  setup_options options;  (* rescan load path *)
-  begin try
-    Asmlink.link_shared ~ppf_dump:Format.err_formatter [cmxfile] (modname_uncap ^ ".cmxs")
-  with
-  | Asmlink.Error e ->
-     let msg = Format.asprintf "Asmlink error: %a" Asmlink.report_error e in
-     failwith msg
-  end;
-  let cmxs = tmpdir ^ Filename.dir_sep ^ modname_uncap ^ ".cmxs" in
-  (match ndl_run_toplevel cmxs modname with
-  | Ok _ -> ()
-  | Error s -> failwith ("loading failed: " ^ s));
-  let res = Obj.field (ndl_loadsym (Compilenv.symbol_for_global (Ident.create_persistent modname))) 0 in
-  delete_temps tmpfiles;
-  Misc.remove_file cmxs;
-  Sys.chdir old_cwd;
-  Unix.rmdir tmpdir;
-  res
-
-
-
-let link_executable ?(options=[]) output tmpfiles =
-   let cmxfile =
-     match tmpfiles with
-     | Out_native o -> o.cmxfile
-     | Out_bytecode _ -> failwith "Bytecode linking unsupported"
-   in
-   let pkgs =
-      options |> (List.filter_map @@ 
-      function
-      | `Package s -> Some s
-      | _ -> None)
-   in
-   let linkpkg = options |> (List.exists @@ (function `Linkpkg -> true | _ -> false)) in
-   let dontlink =
-      options |> (List.filter_map @@ 
-      function
-      | `Dontlink s -> Some s
-      | _ -> None)
-   in
-   let thread =
-      options |> (List.exists @@ 
-      function
-      | `Thread -> true
-      | _ -> false)
-   in
-   let pkgs =
-     match pkgs with
-     | [] -> []
-     | pkgs -> ["-package"; String.concat "," pkgs] in
-   let dontlink = 
-      if dontlink = [] then []
-      else ["-dontlink"; String.concat "," dontlink]
-   in
-   let linkpkg = if linkpkg then ["-linkpkg"] else [] in
-   let thread = if thread then ["-thread"] else [] in
-   let opts = String.concat " " (thread @ linkpkg @ pkgs @ dontlink) in
-   (* urgh *)
-   Sys.command (Printf.sprintf "ocamlfind ocamlopt %s '%s' -o '%s'"
-                 opts cmxfile output)
diff --git a/malfunction/src/malfunction_compiler.mli b/malfunction/src/malfunction_compiler.mli
deleted file mode 100644
index 591fd035acf6..000000000000
--- a/malfunction/src/malfunction_compiler.mli
+++ /dev/null
@@ -1,18 +0,0 @@
-
-type outfiles
-val delete_temps : outfiles -> unit 
-
-type options = [`Verbose | `Shared | `ForPack of string | `Include of string | `Package of string | `Dontlink of string | `Linkpkg | `Debug | `Rectypes | `Thread | `Optimize | `Bytecode] list
-
-val compile_module :
-  ?options:options ->
-  filename:string ->
-  Malfunction_parser.moduleexp ->
-  outfiles
-
-val compile_cmx : ?options:options -> string -> outfiles
-val compile_cmo : ?options:options -> string -> outfiles
-
-val link_executable : ?options:options -> string -> outfiles -> int
-
-val compile_and_load : ?options:options -> Malfunction.t -> Obj.t
diff --git a/malfunction/src/malfunction_interpreter.ml b/malfunction/src/malfunction_interpreter.ml
deleted file mode 100644
index 7eb071d34d6e..000000000000
--- a/malfunction/src/malfunction_interpreter.ml
+++ /dev/null
@@ -1,286 +0,0 @@
-open Malfunction
-
-type value =
-| Block of int * value array
-| Vec of vector_type * value array
-| Func of (value -> value)
-| Int of inttype * Z.t
-| Float of float
-| Thunk of value Lazy.t
-
-exception Error of string
-
-let fail fmt =
-  let k _ppf =
-    raise (Error (Format.flush_str_formatter ())) in
-  Format.kfprintf k Format.str_formatter ("@[" ^^ fmt ^^ "@]")
-
-type op_normal = [`Add|`Sub|`Mul|`Div|`Mod|`And|`Or|`Xor]
-type op_shift = [`Lsl|`Lsr|`Asr]
-type op_cmp = [`Lt|`Gt|`Lte|`Gte|`Eq]
-
-let bitwidth = function
-  | `Int -> Sys.word_size - 1
-  | `Int32 -> 32
-  | `Int64 -> 64
-
-let truncate ty n =
-  Int (ty, match ty with
-  | `Bigint -> n
-  | (`Int|`Int32|`Int64) as ty ->
-     let width = bitwidth ty in
-     let range = Z.(shift_left (of_int 1) width) in
-     let masked = Z.(logand n (sub range (of_int 1))) in
-     let min_int = Z.(shift_right range 1) in
-     if Z.lt masked min_int then masked else
-       Z.(sub masked range)) (* two's complement *)
-
-let as_ty ty = function
-  | Int (ty', n) ->
-     if ty = ty' then n else fail "integer type mismatch"
-  | _ -> fail "expected integer"
-
-let as_float = function
-  | Float f -> f
-  | _ -> fail "expected float64"
-
-let rec interpret locals env : t -> value = function
-  | Mvar v -> Ident.Map.find v locals
-  | Mlambda (xs, e) ->
-     let (x, e) = match xs with
-       | [] -> assert false
-       | [x] -> x, e
-       | (x :: xs) -> x, Mlambda (xs, e) in
-     Func (fun v -> interpret (Ident.Map.add x v locals) env e)
-  | Mapply (f, vs) ->
-     List.fold_left (fun f v -> match f with
-     | Func f -> f (interpret locals env v)
-     | _ -> fail "not a function") (interpret locals env f) vs
-  | Mlet (bindings, body) ->
-     let rec bind locals = function
-       | [] ->
-          interpret locals env body
-       | `Unnamed e :: bindings ->
-          ignore (interpret locals env e);
-          bind locals bindings
-       | `Named (x, e) :: bindings ->
-          let locals = Ident.Map.add x (interpret locals env e) locals in
-          bind locals bindings
-       | `Recursive recs :: bindings ->
-          let n = List.length recs in
-          let values = Array.make n None in
-          let locals = List.fold_right
-            (fun (x, e) locals -> Ident.Map.add x e locals)
-            (List.mapi (fun i (x, e) ->
-              let v = match e with
-                | Mlambda _ -> Func (fun arg ->
-                    match values.(i) with
-                    | Some (Func f) -> f arg
-                    | _ -> fail "bad recursive function binding")
-                | Mlazy _ -> Thunk (lazy (
-                    match values.(i) with
-                    | Some (Thunk t) -> Lazy.force t
-                    | _ -> fail "bad recursive lazy binding"))
-                | _ -> fail "recursive values must be functions or lazy" in
-              (x, v)) recs)
-            locals in
-          recs |> List.iteri (fun i (_, e) ->
-            values.(i) <- Some (interpret locals env e));
-          bind locals bindings in
-     bind locals bindings
-  | Mnum (`Int n) -> Int (`Int, Z.of_int n)
-  | Mnum (`Int32 n) -> Int (`Int32, Z.of_int32 n)
-  | Mnum (`Int64 n) -> Int (`Int64, Z.of_int64 n)
-  | Mnum (`Bigint n) -> Int (`Bigint, n)
-  | Mnum (`Float64 f) -> Float f
-  | Mstring s ->
-     Vec (`Bytevec,
-          Array.init (String.length s) (fun i -> Int (`Int, Z.of_int (Char.code (String.get s i)))))
-  (* These primitives are supported as a hack for testing. See prim.test *)
-  | Mglobal (Ldot (Lident "Stdlib", "**")) ->
-     Func (function Float a -> Func (function Float b -> Float (a ** b)
-                                            | _ -> fail "**: expected float")
-                  | _ -> fail "**: expected float")
-  | Mglobal (Ldot (Lident "Obj", "magic")) ->
-     Func (fun x -> x)
-  | Mglobal _v -> fail "globals unsupported"
-     (*
-     let (path, _descr) = Env.lookup_value v env in
-     let path = Env.normalize_path None env path in
-     let rec lookup = let open Path in function
-       | Pident id -> Symtable.get_global_value id
-       | Pdot (path, _, i) -> Obj.field (lookup path) i
-       | Papply _ -> fail "functor application in global reference" in
-     lookup path
-     *)
-  | Mswitch (scr, cases) ->
-     let scr = interpret locals env scr in
-     let rec find_match = function
-       | (cases, e) :: rest ->
-          if List.exists (fun case -> match case, scr with
-          | `Tag n, Block (n', _) -> n = n'
-          | `Deftag, Block _ -> true
-          | `Intrange (min, max), Int (`Int, n) -> min <= Z.to_int n && Z.to_int n <= max
-          | _, _ -> false) cases then
-            interpret locals env e
-          else
-            find_match rest
-       | [] -> fail "no case matches" in
-     find_match cases
-  | Mnumop1 (op, (#inttype as ty), e) ->
-     let n = as_ty ty (interpret locals env e) in
-     truncate ty (match op with `Neg -> Z.neg n | `Not -> Z.lognot n)
-  | Mnumop2 (op, (#inttype as ty), e1, e2) ->
-     let e1 = interpret locals env e1 in
-     let e2 = interpret locals env e2 in
-     begin match op with
-     | #op_normal as op ->
-        let f = Z.(match op with
-          | `Add -> add | `Sub -> sub
-          | `Mul -> mul | `Div -> div | `Mod -> rem
-          | `And -> logand | `Or -> logor | `Xor -> logxor) in
-        truncate ty (f (as_ty ty e1) (as_ty ty e2))
-     | #op_shift as op ->
-        let n = as_ty ty e1 in
-        let c = Z.to_int (as_ty `Int e2) in
-        let () = match ty with
-          | `Bigint -> ()
-          | (`Int|`Int32|`Int64) as ty ->
-             let w = bitwidth ty in
-             if c < 0 || c >= w then
-               fail "invalid shift count %d" c in
-        truncate ty Z.(match op with
-        | `Lsl -> shift_left n c
-        | `Asr -> shift_right n c
-        | `Lsr ->
-           let n = match ty with
-             | `Bigint -> n
-             | (`Int|`Int32|`Int64) as ty ->
-                let w = bitwidth ty in
-                Z.(logand n (sub (shift_left one w) one)) in
-           shift_right n c)
-     | #op_cmp as op ->
-        let cmp = Z.compare (as_ty ty e1) (as_ty ty e2) in
-        let res = match op with
-          | `Lt -> cmp < 0
-          | `Gt -> cmp > 0
-          | `Lte -> cmp <= 0
-          | `Gte -> cmp >= 0
-          | `Eq -> cmp = 0 in
-        Int (`Int, if res then Z.one else Z.zero)
-     end
-  | Mnumop1 (`Neg, `Float64, e) ->
-     Float (-. (as_float (interpret locals env e)))
-  | Mnumop1 (`Not, `Float64, _)
-  | Mnumop2 (#binary_bitwise_op, `Float64, _, _) ->
-     failwith "invalid bitwise float operation"
-  | Mnumop2 ((#binary_arith_op | #binary_comparison as op),
-             `Float64, e1, e2) ->
-     let e1 = as_float (interpret locals env e1) in
-     let e2 = as_float (interpret locals env e2) in
-     begin match op with
-     | #binary_arith_op as op ->
-        Float (match op with
-          | `Add -> e1 +. e2
-          | `Sub -> e1 -. e2
-          | `Mul -> e1 *. e2
-          | `Div -> e1 /. e2
-          | `Mod -> mod_float e1 e2)
-     | #binary_comparison as op ->
-        let res = match op with
-          | `Lt -> e1 < e2
-          | `Gt -> e1 > e2
-          | `Lte -> e1 <= e2
-          | `Gte -> e1 <= e2
-          | `Eq -> e1 = e2 in
-        Int (`Int, if res then Z.one else Z.zero)
-     end
-  | Mconvert ((#inttype as src), (#inttype as dst), e) ->
-     truncate dst (as_ty src (interpret locals env e))
-  | Mconvert ((#inttype as src), `Float64, e) ->
-     Float (Z.to_float (as_ty src (interpret locals env e)))
-  | Mconvert (`Float64, (#inttype as dst), e) ->
-     (* FIMXE: ? *)
-     truncate dst (Z.of_float (as_float (interpret locals env e)))
-  | Mconvert (`Float64, `Float64, e) ->
-     Float (as_float (interpret locals env e))
-  | Mvecnew (ty, len, def) ->
-     (match ty, interpret locals env len, interpret locals env def with
-     | `Array, Int (`Int, len), v ->
-        Vec (`Array, Array.make (Z.to_int len) v)
-     | `Bytevec, Int (`Int, len), (Int (`Int, k) as v) when 0 <= (Z.to_int k) && (Z.to_int k) < 256 ->
-        Vec (`Bytevec, Array.make (Z.to_int len) v)
-     | _, _, _ -> fail "bad vector creation")
-  | Mvecget (ty, vec, idx) ->
-     (match interpret locals env vec, interpret locals env idx with
-     | Vec (ty', vals), Int (`Int, i) when ty = ty' ->
-        let i = Z.to_int i in
-        if 0 <= i && i < Array.length vals then
-          vals.(i)
-        else
-          fail "index out of bounds: %d" i
-     | _ -> fail "wrong vector type")
-  | Mvecset (ty, vec, idx, e) ->
-     (match interpret locals env vec,
-            interpret locals env idx,
-            interpret locals env e with
-     | Vec (ty', vals), Int (`Int, i), v when ty = ty' ->
-        let i = Z.to_int i in
-        if 0 <= i && i < Array.length vals then begin
-          (match ty, v with
-          |  `Array, _ -> ()
-          | `Bytevec, Int (`Int, i) when 0 <= Z.to_int i && Z.to_int i < 256 -> ()
-          | `Bytevec, _v -> fail "not a byte");
-          vals.(i) <- v; Int (`Int, Z.of_int 0)
-        end else
-          fail "index out of bounds: %d" i
-     | _ -> fail "wrong vector type")
-  | Mveclen (ty, vec) ->
-     (match interpret locals env vec with
-     | Vec (ty', vals) when ty = ty' -> Int (`Int, Z.of_int (Array.length vals))
-     | _ -> fail "wrong vector type")
-  | Mblock (tag, vals) ->
-     Block (tag, Array.of_list (List.map (interpret locals env) vals))
-  | Mfield (idx, b) ->
-     (match interpret locals env b with
-     | Block (_, vals) -> vals.(idx)
-     | _ -> fail "not a block")
-  | Mlazy e ->
-    Thunk (lazy (interpret locals env e))
-  | Mforce e ->
-     (match interpret locals env e with
-      | Thunk (lazy v) -> v
-      | _ -> fail "not a lazy value")
-
-let eval exp =
-  interpret Ident.Map.empty () exp
-
-let loc =
-  let l = Lexing.{pos_fname="<value>"; pos_lnum=0; pos_cnum=0; pos_bol=0} in
-  l,l
-
-let rec render_value = let open Malfunction_sexp in function
-| Block (tag, elems) -> loc, List (
-  (loc, Atom "block")::
-  (loc, List [loc, Atom "tag"; loc, Atom (string_of_int tag)])::
-  List.map render_value (Array.to_list elems))
-| Vec (ty, vals) ->
-  loc, List ((loc, Atom (match ty with `Array -> "vector" | `Bytevec -> "vector.byte"))::
-              List.map render_value (Array.to_list vals))
-| Func _ ->
-  loc, Atom "<function>"
-| Thunk _ ->
-  loc, Atom "<lazy value>"
-| Int (ty, n) ->
-   let ty = match ty with
-     | `Int -> ""
-     | `Int32 -> ".i32"
-     | `Int64 -> ".i64"
-     | `Bigint -> ".ibig" in
-   loc, Atom (Z.to_string n ^ ty)
-| Float f ->
-   let s = match classify_float f with
-     | FP_nan -> "nan"
-     | FP_infinite -> if f < 0. then "neg_infinity" else "infinity"
-     | _ -> string_of_float f in
-   loc, Atom s
diff --git a/malfunction/src/malfunction_interpreter.mli b/malfunction/src/malfunction_interpreter.mli
deleted file mode 100644
index 3097a9302e82..000000000000
--- a/malfunction/src/malfunction_interpreter.mli
+++ /dev/null
@@ -1,14 +0,0 @@
-open Malfunction
-
-exception Error of string
-
-type value =
-| Block of int * value array
-| Vec of vector_type * value array
-| Func of (value -> value)
-| Int of inttype * Z.t
-| Float of float
-| Thunk of value Lazy.t
-
-val eval : t -> value
-val render_value : value -> Malfunction_sexp.sexp
diff --git a/malfunction/src/malfunction_main.ml b/malfunction/src/malfunction_main.ml
deleted file mode 100644
index 5ef837b09d76..000000000000
--- a/malfunction/src/malfunction_main.ml
+++ /dev/null
@@ -1,110 +0,0 @@
-open Malfunction
-
-
-let usage () =
-  Printf.fprintf stderr "%s" @@
-    "Malfunction v0.1. Usage:\n"^
-    "   malfunction compile [-v] [-thread] [-linkpkg] [-dontlink pack1,...,packn] [-package pack1,...packn] [-o output] input.mlf\n" ^
-    "     Compile input.mlf to an executable using ocamlfind\n" ^
-    "   malfunction cmx [-v] [-shared] [-package pack1,...,packn] [-for-pack s] input.mlf\n" ^
-    "     Compile input.mlf to input.cmx, for linking with ocamlopt.\n"^
-    "   malfunction cmo [-v] [-shared] [-package pack1,...,packn] [-for-pack s] input.mlf\n" ^
-    "     Compile input.mlf to input.cmo (bytecode), for linking with ocamlc.\n" ^
-    "   malfunction eval\n" ^
-    "     Run a REPL to evaluate expressions with the interpreter\n\n" ^
-    "   malfunction fmt\n" ^
-    "     Reindent the s-expression on standard input\n";
-  2
-
-let repl () =
-  let lexbuf = Lexing.from_channel stdin in
-  let rec loop () =
-    Printf.printf "# %!";
-    with_error_reporting Format.std_formatter () (fun () ->
-      let exp = Malfunction_parser.read_expression lexbuf in
-      match Malfunction_interpreter.eval exp with
-      | v -> Format.printf "%a\n%!" Malfunction_sexp.print 
-         (Malfunction_interpreter.render_value v);
-         loop ()
-      | exception (Malfunction_interpreter.Error s) ->
-         Format.printf "Undefined behaviour: %s\n%!" s);
-    loop () in
-  try loop () with End_of_file -> ()
-
-let run mode options impl output =
-  Findlib.init ();
-  match mode, impl with
-  | `Cmx, Some file ->
-     with_error_reporting Format.std_formatter 1 (fun () ->
-       let _ = Malfunction_compiler.compile_cmx ~options file in
-       0)
-  | `Cmo, Some file ->
-     with_error_reporting Format.std_formatter 1 (fun () ->
-       let _ = Malfunction_compiler.compile_cmo ~options file in
-       0)
-  | `Compile, Some file ->
-     with_error_reporting Format.std_formatter 1 (fun () ->
-       let tmpfiles = Malfunction_compiler.compile_cmx ~options file in
-       let output = match output with
-         | None -> Compenv.output_prefix file
-         | Some out -> out in
-       let res = Malfunction_compiler.link_executable ~options output tmpfiles in
-       Malfunction_compiler.delete_temps tmpfiles;
-       res)
-  | `Eval, Some _file ->
-     0
-  | `Eval, None ->
-     repl (); 0
-  | `Fmt, impl ->
-     let lexbuf = Lexing.from_channel (match impl with Some f -> open_in f | None -> stdin) in
-     Malfunction_sexp.(read_only_sexp lexbuf |> print Format.std_formatter);
-     Format.printf "\n%!";
-     0
-  | _ -> usage ()
-
-
-let parse_args args =
-  let impl = ref None in
-  let output = ref None in
-  let opts = ref [] in
-  let rec parse_opts mode = function
-    | "-v" :: rest -> opts := `Verbose :: !opts; parse_opts mode rest
-    | "-o" :: o :: rest -> output := Some o; parse_opts mode rest
-    | "-shared" :: rest -> opts := `Shared :: !opts; parse_opts mode rest
-    | "-for-pack" :: o :: rest -> opts := `ForPack o :: !opts; parse_opts mode rest
-    | "-I" :: s :: rest -> opts := `Include s :: !opts; parse_opts mode rest
-    | "-package" :: s :: rest -> opts := `Package s :: !opts; parse_opts mode rest
-    | "-dontlink" :: s :: rest -> 
-      if mode = `Compile then (opts := `Dontlink s :: !opts; parse_opts mode rest)
-      else usage ()
-    | "-linkpkg" :: rest -> 
-      if mode = `Compile then (opts := `Linkpkg :: !opts; parse_opts mode rest)
-      else usage ()
-    | "-g" :: rest -> opts := `Debug :: !opts; parse_opts mode rest
-    | "-rectypes" :: rest -> opts := `Rectypes :: !opts; parse_opts mode rest
-    | "-thread" :: rest -> 
-        if mode = `Compile then (opts := `Thread :: !opts; parse_opts mode rest)
-        else usage ()
-    | "-O2" :: rest -> opts := `Optimize :: !opts; parse_opts mode rest
-    | i :: rest ->
-       (match !impl with None -> (impl := Some i; parse_opts mode rest) | _ -> usage ())
-    | [] -> run mode !opts !impl !output in
-  match args with
-  | "cmx" :: rest -> parse_opts `Cmx rest
-  | "cmo" :: rest -> parse_opts `Cmo rest
-  | "compile" :: rest -> parse_opts `Compile rest
-  | "eval" :: rest -> parse_opts `Eval rest
-  | "fmt" :: rest -> parse_opts `Fmt rest
-  | _ -> usage ()
-
-(*
-let () =
-  if not Config.flambda then begin
-    Format.fprintf Format.err_formatter 
-      "Malfunction requires a version of OCaml with Flambda enabled\n\
-       Try \"opam switch 4.03.0+flambda\"\n";
-    exit 1
-  end
- *)
-
-let _ = exit (parse_args (List.tl (Array.to_list Sys.argv)))
diff --git a/malfunction/src/malfunction_parser.ml b/malfunction/src/malfunction_parser.ml
deleted file mode 100644
index 5f66be460fa9..000000000000
--- a/malfunction/src/malfunction_parser.ml
+++ /dev/null
@@ -1,285 +0,0 @@
-open Malfunction
-open Malfunction_sexp
-
-type moduleexp =
-| Mmod of binding list * t list
-
-(* Compiling from sexps *)
-
-let fail loc fmt =
-  let k _ppf =
-    raise (SyntaxError (loc, Format.flush_str_formatter ())) in
-  Format.kfprintf k Format.str_formatter ("@[" ^^ fmt ^^ "@]")
-
-module StrMap = Map.Make (struct type t = string let compare = compare end)
-
-let bind_local _loc locals s ident =
-  StrMap.add s ident locals
-
-let parse_arglist = function
-  | loc, List [] ->
-     fail loc "a nonempty argument list is required"
-  | loc, List args ->
-     let idents = args |> List.map (function
-       | _loc, Var s ->
-          s, fresh s
-       | loc, _ -> fail loc "Expected a list of variables") in
-     let env = List.fold_left (fun env (s, ident) ->
-       if StrMap.mem s env then
-         fail loc "Parameter %s bound multiple times" s
-       else
-         bind_local loc env s ident) StrMap.empty idents in
-     List.map snd idents, env
-  | loc, _ -> fail loc "Expected a list of atoms"
-
-let parse_tag = function
-| loc, List [_, Atom "tag"; _, Atom n] ->
-   begin match int_of_string n with
-   | n when 0 <= n && n < (max_tag :> int) -> n
-   | n -> fail loc "tag %d out of range [0,%d]" n ((max_tag :> int)-1)
-   | exception (Failure _) -> fail loc "invalid tag %s" n end
-| loc, _ -> fail loc "invalid tag"
-
-let inttypes = [`Int, ".int" ; `Int32, ".i32" ; `Int64, ".i64" ; `Bigint, ".ibig"]
-let numtypes = inttypes @ [`Float64, ".f64"]
-
-let (unary_intops_by_name : (unary_num_op * numtype) StrMap.t),
-    (binary_intops_by_name : (binary_num_op * numtype) StrMap.t),
-    (conversions_by_name : (numtype * numtype) StrMap.t),
-    (numtypes_by_name : numtype StrMap.t) =
-  let unary_ops = [ `Neg, "neg"; `Not, "not" ] in
-  let binarith_ops = [ `Add, "+" ; `Sub, "-" ; `Mul, "*" ; `Div, "/" ; `Mod, "%" ] in
-  let bitwise_ops = [ `And, "&" ; `Or, "|" ; `Xor, "^" ; `Lsl, "<<" ; `Lsr, ">>"  ; `Asr, "a>>" ] in
-  let comparison_ops = [ `Lt, "<" ; `Gt, ">" ; `Lte, "<=" ; `Gte, ">=" ; `Eq, "==" ] in
-  let binary_ops =
-    binarith_ops @ bitwise_ops @ comparison_ops in
-  let deftypes = (`Int, "") :: numtypes in
-  let () = (* check that all cases are handled here *)
-    List.iter (function #unary_num_op, _ -> () | _ -> assert false) unary_ops;
-    List.iter (function #binary_num_op, _ -> () | _ -> assert false) binary_ops;
-    List.iter (function #numtype, _ -> () | _ -> assert false) numtypes in
-  List.fold_right (fun (ty,tyname) ->
-    List.fold_right (fun (op,opname) ->
-      StrMap.add (opname ^ tyname) (op, ty)) unary_ops) deftypes StrMap.empty,
-  (List.fold_right (fun (ty,tyname) ->
-     List.fold_right (fun (op,opname) ->
-       StrMap.add (opname ^ tyname) (op, ty)) binary_ops) deftypes StrMap.empty
-   |> List.fold_right (fun (_ty,tyname) ->
-        List.fold_right (fun (_op, opname) ->
-          StrMap.remove (opname ^ tyname)) bitwise_ops) [`Float64, ".f64"]),
-  List.fold_right (fun (op1, opname1) ->
-    List.fold_right (fun (op2, opname2) ->
-      StrMap.add ("convert" ^ opname1 ^ opname2) (op1, op2)) numtypes) numtypes StrMap.empty,
-  List.fold_right (fun (ty, name) ->
-      StrMap.add name ty) numtypes StrMap.empty
-
-
-let vecops_by_name op =
-  List.fold_right (fun (ty,tyname) ->
-    StrMap.add (op ^ tyname) ty)
-    [`Array, ""; `Bytevec, ".byte"]
-    StrMap.empty
-let vec_new_by_name = vecops_by_name "makevec"
-let vec_get_by_name = vecops_by_name "load"
-let vec_set_by_name = vecops_by_name "store"
-let vec_len_by_name = vecops_by_name "length"
-
-(*
-(let
-  (a 42)
-  (b 17)
-  (_ 421)
-  (rec (a (lambda)))
-
-*)
-
-let rec parse_bindings loc env acc = function
-  | [e] ->
-     List.rev acc, env, e
-  | (loc, List [_, Atom "_"; e]) :: bindings ->
-     parse_bindings loc env (`Unnamed (parse_exp env e) :: acc) bindings
-  | (loc, List [_, Var s; e]) :: bindings ->
-     let ident = fresh s in
-     let env' = bind_local loc env s ident in
-     parse_bindings loc env' (`Named (ident, parse_exp env e) :: acc) bindings
-  | (loc, List ((_, Atom "rec") :: recs)) :: bindings ->
-     let recs = recs |> List.map (function
-       | _, List [_, Var s; _, List ((_, Atom ("lambda"|"lazy")) :: _) as e] ->
-          (s, fresh s, e)
-       | _, List [_, Var _; _] ->
-          fail loc "all members of a recursive binding must be functions or lazy"
-       | loc, _ ->
-          fail loc "expected recursive bindings") in
-     let env' = List.fold_left (fun env (s, id, _) ->
-       bind_local loc env s id) env recs in
-     let recs = recs |> List.map (fun (_, id, e) ->
-       (id, parse_exp env' e)) in
-     parse_bindings loc env' (`Recursive recs :: acc) bindings
-  | _ -> fail loc "no bindings?"
-
-and parse_exp env (loc, sexp) = match sexp with
-  | Var s when StrMap.mem s env ->
-     Mvar (StrMap.find s env)
-
-  | Var s ->
-     fail loc "'%s' is unbound" s
-
-  | List [_, Atom "lambda"; args; exp] ->
-     let (params, newenv) = parse_arglist args in
-     let env = StrMap.fold StrMap.add newenv env in
-     Mlambda (params, parse_exp env exp)
-
-  | List ((_loc, Atom "apply") :: func :: args) ->
-     if args = [] then fail loc "Expected a nonempty parameter list";
-     Mapply (parse_exp env func, List.map (parse_exp env) args)
-
-  | List ((loc, Atom "let") :: bindings) ->
-     let (bindings, env, e) = parse_bindings loc env [] bindings in
-     Mlet (bindings, parse_exp env e)
-
-  | List ((_loc, Atom "seq") :: ((_ :: _) as exps)) ->
-     let rec to_let acc = function
-       | [] -> assert false
-       | [e] -> Mlet (List.rev acc, parse_exp env e)
-       | e :: es -> to_let (`Unnamed (parse_exp env e) :: acc) es in
-     to_let [] exps
-
-  | List ((_, Atom "switch") :: exp :: cases) ->
-     let parse_selector s = try match s with
-       | _, List [_, Atom "tag"; _, Atom "_"] -> `Deftag
-       | _, List ([_, Atom "tag"; _]) as t -> `Tag (parse_tag t)
-       | _, List [_, Atom min; _, Atom max] -> `Intrange (int_of_string min, int_of_string max)
-       | _, Atom "_" -> `Intrange (min_int, max_int)
-       | _, Atom n -> `Intrange (int_of_string n, int_of_string n)
-       | loc, _ -> fail loc "invalid selector"
-       with Failure _ -> fail loc "invalid selector" in
-
-     let rec parse_case loc acc = function
-       | [s; e] -> List.rev (parse_selector s :: acc), parse_exp env e
-       | (s :: c) -> parse_case loc (parse_selector s :: acc) c
-       | _ -> fail loc "invalid case" in
-
-     let cases = List.map (function
-       | loc, List c -> parse_case loc [] c
-       | loc, _ -> fail loc "invalid case") cases in
-
-     if (List.length (List.sort_uniq compare cases) <> List.length cases) then
-       fail loc "duplicate cases";
-
-     Mswitch (parse_exp env exp, cases)
-
-  | List [_, Atom "if"; cond; tt; ff] ->
-     Mswitch (parse_exp env cond, 
-              [[`Intrange (0, 0)], parse_exp env ff;
-               [`Intrange (min_int, max_int); `Deftag], parse_exp env tt])
-
-  | List [_, Atom s; e] when StrMap.mem s unary_intops_by_name ->
-     let (op, ty) = StrMap.find s unary_intops_by_name in
-     Mnumop1 (op, ty, parse_exp env e)
-
-  | List [_, Atom s; e1; e2] when StrMap.mem s binary_intops_by_name ->
-     let (op, ty) = StrMap.find s binary_intops_by_name in
-     Mnumop2 (op, ty, parse_exp env e1, parse_exp env e2)
-
-  | List [_, Atom s; e1] when StrMap.mem s conversions_by_name ->
-     let (ty1, ty2) = StrMap.find s conversions_by_name in
-     Mconvert (ty1, ty2, parse_exp env e1)
-
-  | List [_, Atom op; len; def] when StrMap.mem op vec_new_by_name ->
-     Mvecnew (StrMap.find op vec_new_by_name, parse_exp env len, parse_exp env def)
-
-  | List [_, Atom op; vec; idx] when StrMap.mem op vec_get_by_name ->
-     Mvecget (StrMap.find op vec_get_by_name, parse_exp env vec, parse_exp env idx)
-
-  | List [_, Atom op; vec; idx; v] when StrMap.mem op vec_set_by_name ->
-     Mvecset (StrMap.find op vec_set_by_name, parse_exp env vec, parse_exp env idx, parse_exp env v)
-
-  | List [_, Atom op; vec] when StrMap.mem op vec_len_by_name ->
-     Mveclen (StrMap.find op vec_len_by_name, parse_exp env vec)
-
-  | List ((_, Atom "block") :: tag :: fields) ->
-     Mblock (parse_tag tag, List.map (parse_exp env) fields)
-
-  | List [_, Atom "field"; _, Atom n; e] ->
-     let n = match int_of_string n with
-       | n -> n
-       | exception (Failure _) -> fail loc "invalid field number" in
-     Mfield (n, parse_exp env e)
-
-  | String s ->
-     Mstring s
-
-  | List [_, Atom "lazy"; e] ->
-     Mlazy (parse_exp env e)
-
-  | List [_, Atom "force"; e] ->
-     Mforce (parse_exp env e)
-
-  | List ((_, Atom "global") :: path) ->
-     Mglobal (path
-       |> (function
-           | (l, Var "Pervasives")::p ->
-              Printf.fprintf stderr "Warning: global $Pervasives is deprecated, use $Stdlib instead.\n";
-              (l, Var "Stdlib")::p
-           | p -> p)
-       |> List.map (function
-         | _, Var s -> s
-         | _, _ -> fail loc "module path required")
-       |> function
-         | [] -> fail loc "empty global path"
-         | path1 :: pathrest ->
-            List.fold_left (fun id s ->
-              Longident.Ldot (id, s)) (Longident.Lident path1) pathrest)
-
-  | List ((_, Atom s) :: rest) ->
-     fail loc "Unknown %d-ary operation %s" (List.length rest) s
-
-  | Atom "nan" -> Mnum (`Float64 nan)
-  | Atom "infinity" -> Mnum (`Float64 infinity)
-  | Atom "neg_infinity" -> Mnum (`Float64 neg_infinity)
-
-  | Atom s ->
-     let orig = s in
-     let s, ext = match String.rindex s '.' with
-       | i ->
-          String.sub s 0 i,
-          String.sub s i (String.length s - i)
-       | exception Not_found ->
-          s, ".int" in
-     begin
-       try match StrMap.find ext numtypes_by_name with
-       | `Int -> Mnum (`Int (int_of_string s))
-       | `Int32 -> Mnum (`Int32 (Int32.of_string s))
-       | `Int64 -> Mnum (`Int64 (Int64.of_string s))
-       | `Bigint -> Mnum (`Bigint (Z.of_string s))
-       | `Float64 -> Mnum (`Float64 (float_of_string s))
-       with
-       | Not_found ->
-          (try Mnum (`Float64 (float_of_string orig))
-           with Invalid_argument _ ->
-             fail loc "unknown constant type: '%s'" ext)
-       | Invalid_argument _ | Failure _ ->
-          fail loc "constant '%s' out of bounds for '%s'" s ext
-     end
-
-  | _ -> fail loc "syntax error"
-
-
-let parse_mod (loc, sexp) = match sexp with
-  | List ((_, Atom "module") :: rest) ->
-     let (bindings, env, exports) = parse_bindings loc StrMap.empty [] rest in
-     let exports = match exports with
-       | _, List ((_, Atom "export") :: exports) ->
-          List.map (parse_exp env) exports
-       | _ -> fail loc "export list?" in
-     Mmod (bindings, exports)
-  | _ -> fail loc "mod?"
-
-let read_expression lexbuf =
-  parse_exp StrMap.empty (Malfunction_sexp.read_next_sexp lexbuf)
-
-let parse_expression t =
-  parse_exp StrMap.empty t
-
-let read_module lexbuf =
-  parse_mod (Malfunction_sexp.read_only_sexp lexbuf)
diff --git a/malfunction/src/malfunction_parser.mli b/malfunction/src/malfunction_parser.mli
deleted file mode 100644
index 55d341966ac3..000000000000
--- a/malfunction/src/malfunction_parser.mli
+++ /dev/null
@@ -1,12 +0,0 @@
-open Malfunction
-
-type moduleexp =
-| Mmod of binding list * t list
-
-(* Read the next expression from a lexbuf *)
-val read_expression : Lexing.lexbuf -> t
-
-val parse_expression : Malfunction_sexp.sexp -> t
-
-(* Read an entire module from a lexbuf (must be followed by EOF) *)
-val read_module : Lexing.lexbuf -> moduleexp
diff --git a/malfunction/src/malfunction_sexp.mli b/malfunction/src/malfunction_sexp.mli
deleted file mode 100644
index f4f4d5cc7c35..000000000000
--- a/malfunction/src/malfunction_sexp.mli
+++ /dev/null
@@ -1,14 +0,0 @@
-exception SyntaxError of (Lexing.position * Lexing.position) * string
-
-type sexp =
-  (Lexing.position * Lexing.position) * rawsexp
-and rawsexp =
-| Atom of string
-| Var of string
-| String of string
-| List of sexp list
-
-val read_next_sexp : Lexing.lexbuf -> sexp
-val read_only_sexp : Lexing.lexbuf -> sexp
-
-val print : Format.formatter -> sexp -> unit
diff --git a/malfunction/src/malfunction_sexp.mll b/malfunction/src/malfunction_sexp.mll
deleted file mode 100644
index 82f490179d8c..000000000000
--- a/malfunction/src/malfunction_sexp.mll
+++ /dev/null
@@ -1,93 +0,0 @@
-{
-exception SyntaxError of (Lexing.position * Lexing.position) * string
-type sexp =
-  (Lexing.position * Lexing.position) * rawsexp
-and rawsexp =
-| Atom of string
-| Var of string
-| String of string
-| List of sexp list
-
-let loc lexbuf f =
-  let open Lexing in
-  let start = lexbuf.lex_start_p in
-  let r = f () in
-  ((start, lexbuf.lex_curr_p), r)
-
-let fail lexbuf s = raise (SyntaxError ((lexbuf.Lexing.lex_start_p, lexbuf.Lexing.lex_curr_p), s))
-
-let var s =
-  assert (s.[0] = '$');
-  Var (String.sub s 1 (String.length s - 1))
-
-let rec print ppf (_, s) = let open Format in match s with
-  | Atom s -> fprintf ppf "%s" s
-  | Var s -> fprintf ppf "$%s" s
-  | String s -> fprintf ppf "%S" s
-  | List l ->
-     fprintf ppf "@[<2>(%a)@]" (pp_print_list ~pp_sep:pp_print_space print) l
-}
-
-let space = [' ' '\t' '\r']*
-
-let symbol = ['.' '&' '|' '+' '/' '-' '!' '@' '#' '%' '^' '*' '~' '?' '{' '}' '<' '>' '=']
-
-let atomsymbol = ['+' '-' '<' '>']
-let letter = ['a'-'z' 'A'-'Z' '_']
-let digit = ['0' - '9']
-
-let atom = (letter | digit | symbol)*
-let var = (['a'-'z' 'A'-'Z' '_' '0'-'9' '$' '\''] | symbol)+
-
-let string = '"' ([^ '\\' '"']* | ('\\' _))* '"'
-
-let comment = ';' [^ '\n']*
-
-(* FIXME: exceptions in int and str cases *)
-rule sexps acc = parse
-| ')'
-  { List.rev acc }
-| '('
-  { sexps (loc lexbuf (fun () -> List (sexps [] lexbuf)) :: acc) lexbuf }
-| string
-  { sexps (loc lexbuf (fun () -> String (Scanf.sscanf (Lexing.lexeme lexbuf) "%S%!" (fun x -> x))) :: acc) lexbuf }
-| '$' var
-  { sexps (loc lexbuf (fun () -> var (Lexing.lexeme lexbuf)) :: acc) lexbuf }
-| atom
-  { sexps (loc lexbuf (fun () -> Atom (Lexing.lexeme lexbuf)) :: acc) lexbuf }
-| '\n'
-  { Lexing.new_line lexbuf; sexps acc lexbuf }
-| comment
-  { sexps acc lexbuf }
-| space
-  { sexps acc lexbuf }
-| eof
-  { fail lexbuf "Unexpected end of file" }
-| _
-  { fail lexbuf ("Lexical error on " ^ (Lexing.lexeme lexbuf)) }
-
-and read_next_sexp = parse
-| '\n'
-  { Lexing.new_line lexbuf; read_next_sexp lexbuf }
-| comment
-  { read_next_sexp lexbuf }
-| space
-  { read_next_sexp lexbuf }
-| '('
-  { loc lexbuf (fun () -> List (sexps [] lexbuf)) }
-| atom
-  { loc lexbuf (fun () -> Atom (Lexing.lexeme lexbuf)) }
-| eof
-  { raise End_of_file }
-| _
-  { fail lexbuf "Sexp must start with '('" }
-
-{
-
-let read_only_sexp lexbuf =
-  let s = read_next_sexp lexbuf in
-  match read_next_sexp lexbuf with
-  | _ -> fail lexbuf "File must contain only one sexp"
-  | exception End_of_file -> s
-
-}
diff --git a/malfunction/test/basic.test b/malfunction/test/basic.test
deleted file mode 100644
index 2b49a4bfbbb8..000000000000
--- a/malfunction/test/basic.test
+++ /dev/null
@@ -1,20 +0,0 @@
-(test-undefined
-  (field 0 0))
-
-; a comment
-
-(test-differ ; another comment
-  1 2)
-
-(test
-  4983259873495873495734895.ibig 4983259873495873495734895.ibig)
-
-(test
-  0 0)
-
-(test-differ
-  0 (block (tag 0) 42))
-
-(test
-  (block (tag 0) 42)
-  (block (tag 0) 42))
\ No newline at end of file
diff --git a/malfunction/test/conversions.test b/malfunction/test/conversions.test
deleted file mode 100644
index 5a3779c21fa3..000000000000
--- a/malfunction/test/conversions.test
+++ /dev/null
@@ -1,25 +0,0 @@
-(test-undefined
-  (convert.i32.ibig 420))
-
-(test
-  (convert.i32.i64 49832.i32)
-  49832.i64)
-
-(test
-  (convert.i64.i32 9223372036854775807.i64)
-  -1.i32)
-
-(test
-  (convert.ibig.i32 -1.ibig)
-  -1.i32)
-
-
-(test
-  (convert.ibig.i64 9223372036854775807.ibig)
-  9223372036854775807.i64)
-
-(test
-  (convert.ibig.i64 9223372036854775808.ibig)
-  -9223372036854775808.i64)
-
-
diff --git a/malfunction/test/dune b/malfunction/test/dune
deleted file mode 100644
index 57cdf9eebe29..000000000000
--- a/malfunction/test/dune
+++ /dev/null
@@ -1,10 +0,0 @@
-(executable
- (name test)
- (modes native)
- (libraries malfunction omd)
- (modules test))
-
-(alias
- (name runtest)
- (deps (:prog test.exe) ../docs/spec.md (glob_files ../test/*.test))
- (action (run %{prog} ../docs/spec.md ../test)))
diff --git a/malfunction/test/evalorder.test b/malfunction/test/evalorder.test
deleted file mode 100644
index d7ea5228f6c5..000000000000
--- a/malfunction/test/evalorder.test
+++ /dev/null
@@ -1,27 +0,0 @@
-(test
-  (let
-    ($a (makevec 1 0))
-    ($f (lambda ($x $y) (load $a 0)))
-    (- (apply $f (store $a 0 10) (store $a 0 20)) (apply $f (store $a 0 1) (store $a 0 2))))
-  18)
-
-(test
-  (let
-    ($fn (lambda ($arg)
-      (let
-        ($a (makevec 1 0))
-        ($f (lambda ($x $y) (load $a 0)))
-        (- (apply $f (store $a 0 10) (store $a 0 20)) (apply $f (store $a 0 1) (store $a 0 2))))))
-    (apply $fn 1))
-  18)
-
-
-(test
-  (let
-    ($th (lazy
-      (let
-        ($a (makevec 1 0))
-        ($f (lambda ($x $y) (load $a 0)))
-        (- (apply $f (store $a 0 10) (store $a 0 20)) (apply $f (store $a 0 1) (store $a 0 2))))))
-    (force $th))
-  18)
diff --git a/malfunction/test/factorial.test b/malfunction/test/factorial.test
deleted file mode 100644
index 0336cb3eced0..000000000000
--- a/malfunction/test/factorial.test
+++ /dev/null
@@ -1,10 +0,0 @@
-;; Recursive factorial on bigints
-
-(test
-  (let
-    (rec
-      ($fact (lambda ($n)
-        (if (==.ibig $n 0.ibig) 1.ibig (*.ibig (apply $fact (-.ibig $n 1.ibig)) $n)))))
-    (apply $fact 42.ibig))
-  1405006117752879898543142606244511569936384000000000.ibig)
-
diff --git a/malfunction/test/float.test b/malfunction/test/float.test
deleted file mode 100644
index 7226f34d3f2b..000000000000
--- a/malfunction/test/float.test
+++ /dev/null
@@ -1,32 +0,0 @@
-(test 
-  (block (tag 0) 
-    (+.f64 10. 2.)
-    (-.f64 10. 2.)
-    (*.f64 10. 2.)
-    (/.f64 10. 2.)
-    (%.f64 10. 2.))
-  (block (tag 0) 12. 8. 20. 5. 0.))
-
-(test (%.f64 96.5 5.) 1.5)
-
-(test (/.f64 1. 0.) infinity)
-(test (/.f64 -1. 0.) neg_infinity)
-(test (*.f64 0. infinity) nan)
-(test (==.f64 nan nan) 0)
-
-(test
-  (block (tag 0)
-    (convert.int.f64 100)
-    (convert.i32.f64 100.i32)
-    (convert.i64.f64 100.i64)
-    (convert.ibig.f64 100.ibig))
-  (block (tag 0) 100. 100. 100. 100.))
-
-(test
-  (block (tag 0)
-    (convert.f64.int 100.)
-    (convert.f64.i32 100.)
-    (convert.f64.i64 100.)
-    (convert.f64.ibig 100.))
-  (block (tag 0) 100 100.i32 100.i64 100.ibig))
-
diff --git a/malfunction/test/issue36/dune b/malfunction/test/issue36/dune
deleted file mode 100644
index ac7125f33d98..000000000000
--- a/malfunction/test/issue36/dune
+++ /dev/null
@@ -1,10 +0,0 @@
-(rule
-  (target output.txt)
-  (deps run.sh main.ml test_bytestring.mlf test_bytestring.mli %{bin:malfunction})
-  (action (with-stdout-to output.txt (run ./run.sh))))
-
-(alias
- (name runtest)
- (deps output.txt)
- (action (diff expected.txt output.txt)))
-
diff --git a/malfunction/test/issue36/expected.txt b/malfunction/test/issue36/expected.txt
deleted file mode 100644
index 540bae9eb16f..000000000000
--- a/malfunction/test/issue36/expected.txt
+++ /dev/null
@@ -1,3 +0,0 @@
-Malfunction result: 1 
-Malfunction result, printed as string: 1
-interpreted by OCaml as: Lt
diff --git a/malfunction/test/issue36/main.ml b/malfunction/test/issue36/main.ml
deleted file mode 100644
index c7fc3eedf891..000000000000
--- a/malfunction/test/issue36/main.ml
+++ /dev/null
@@ -1,55 +0,0 @@
-open Printf
-
-let oc_compare xs ys =
-  let tmp =
-    let rec compare xs0 ys =
-      match xs with
-      | [] ->
-         (match ys with
-          | [] -> Test_bytestring.Eq
-          | _ -> Test_bytestring.Lt)
-      | _ -> compare xs0 ys
-    in
-    compare
-  in
-  tmp xs ys
-
-
-let go () =
-  Test_bytestring.compare
-    []
-    [100]
-
-let rec print_obj x =
-  let x = Obj.magic x in
-  if Obj.is_block x then let size = Obj.size x in
-                           if Obj.tag x = 247 then
-                              Printf.printf "POINTER%!"
-                           else
-                           (Printf.printf ("(block[%i] (tag %i) %!") (Obj.size x) (Obj.tag x) ;
-                           for i = 0 to size - 1 do
-                             print_obj (Obj.field x i)
-                           done;
-                           Printf.printf ")")
-  else  Printf.printf ("%i %!") x
-
-let rec print_obj' x =
-  let x = Obj.magic x in
-  if Obj.is_block x then for i = 0 to Obj.size x - 1 do
-                             print_obj' (Obj.field x i)
-                           done
-  else  Printf.printf ("%x%!") x
-
-let main =
-  let x = go () in
-  Printf.printf "Malfunction result: ";
-  print_obj (Obj.magic x) ;
-  Printf.printf "\n";
-  Printf.printf "Malfunction result, printed as string: ";
-  print_obj' (Obj.magic x) ;
-  Printf.printf "\n";
-  Printf.printf "interpreted by OCaml as: ";
-  match x with
-  | Eq -> Printf.printf "Eq\n%!"
-  | Lt -> Printf.printf "Lt\n%!"
-  | Gt -> Printf.printf "Gt\n%!"
diff --git a/malfunction/test/issue36/run.sh b/malfunction/test/issue36/run.sh
deleted file mode 100755
index b2334b394907..000000000000
--- a/malfunction/test/issue36/run.sh
+++ /dev/null
@@ -1,6 +0,0 @@
-#!/bin/sh
-ocamlopt -c test_bytestring.mli
-malfunction cmx test_bytestring.mlf
-ocamlopt -c main.ml
-ocamlopt -o main test_bytestring.cmx main.cmx
-./main
diff --git a/malfunction/test/issue36/test_bytestring.mlf b/malfunction/test/issue36/test_bytestring.mlf
deleted file mode 100644
index 7fad475be1d3..000000000000
--- a/malfunction/test/issue36/test_bytestring.mlf
+++ /dev/null
@@ -1,20 +0,0 @@
-(module
-  ($def_MetaCoq_Utils_bytestring_String_compare
-    (lambda ($xs $ys)
-      (apply
-        (let
-          (rec
-            ($compare
-              (lambda ($xs0 $ys)
-                  (switch $xs0
-                    (0
-                      (switch $ys
-                        (0 0)
-                        ((tag _) _ 1)))
-                    ((tag _) _
-                      (apply $compare $xs $ys)
-                        )))))
-          $compare)
-        $xs $ys)))
-
-  (export $def_MetaCoq_Utils_bytestring_String_compare))
diff --git a/malfunction/test/issue36/test_bytestring.mli b/malfunction/test/issue36/test_bytestring.mli
deleted file mode 100644
index 657c2634668c..000000000000
--- a/malfunction/test/issue36/test_bytestring.mli
+++ /dev/null
@@ -1,5 +0,0 @@
-
-type comparison = Eq | Lt | Gt
-type bytestr = int list
-
-val compare : bytestr -> bytestr -> comparison
diff --git a/malfunction/test/lazy.test b/malfunction/test/lazy.test
deleted file mode 100644
index 7af700541fb1..000000000000
--- a/malfunction/test/lazy.test
+++ /dev/null
@@ -1,37 +0,0 @@
-(test
-  (let
-    (rec
-      ($a (lazy (apply $f 42)))
-      ($f (lambda ($x) (if (== $x 42) 100 (force $a)))))
-    (apply $f 17))
-  100)
-
-(test
-  (let
-    (rec
-      ($a (lazy (apply $f 42)))
-      ($f (lambda ($x) (if (== $x 42) 100 (force $a)))))
-    (force $a))
-  100)
-
-
-(test
-  (let
-    (rec
-      ($a (lazy (field 0 (force $b))))
-      ($b (lazy (block (tag 0) 42 (lazy (force $a))))))
-    (block (tag 0) (force $a) (force (field 1 (force $b)))))
-  (block (tag 0) 42 42))
-
-(test
-  (let
-    (rec
-      ($a (lazy (field 0 (force $b))))
-      ($b (lazy (block (tag 0) 42 (lazy (force $a))))))
-    (block (tag 0) (force (field 1 (force $b))) (force $a)))
-  (block (tag 0) 42 42))
-
-(test
-  (let (rec ($a (lazy (block (tag 0) 42 $a))))
-    (block (tag 0) (field 0 (force $a)) (field 0 (force (field 1 (force $a))))))
-  (block (tag 0) 42 42))
diff --git a/malfunction/test/prim.test b/malfunction/test/prim.test
deleted file mode 100644
index df3dcf5c7cac..000000000000
--- a/malfunction/test/prim.test
+++ /dev/null
@@ -1,13 +0,0 @@
-(test
-  (let
-    ($pow (global $Stdlib $**))
-    ($pow2 (apply (global $Stdlib $**) 2.))
-    ($magic (global $Obj $magic))
-    ($magic2 (apply (global $Obj $magic) (global $Obj $magic)))
-    (block (tag 0)
-      (apply $pow 2. 5.)
-      (apply $pow2 5.)
-      (apply (global $Stdlib $**) 2. 5.)
-      (apply $magic 42)
-      (apply $magic2 42)))
-  (block (tag 0) 32. 32. 32. 42 42))
diff --git a/malfunction/test/shifts.test b/malfunction/test/shifts.test
deleted file mode 100644
index 51aefef13915..000000000000
--- a/malfunction/test/shifts.test
+++ /dev/null
@@ -1,30 +0,0 @@
-(test (<< 3 5) 96)
-(test (>> 96 5) 3)
-(test (a>> 96 5) 3)
-
-; this test requires 2s-complement arithmetic,
-; but is independent of word size
-(test
-  (+ 1 (>> (neg 1) 1))
-  (^ (- 0 1) (>> (neg 1) 1)))
-
-(test (a>> (neg 96) 5) (neg 3))
-
-(test (a>> (neg 1) 5) (neg 1))
-(test (a>> 42 3) 5)
-(test (a>> (neg 42) 3) (neg 6))
-
-; shifting by negative numbers is undefined
-(test-undefined (<< 1 (neg 1)))
-(test-undefined (>> 1 (neg 1)))
-(test-undefined (a>> 1 (neg 1)))
-
-; shifting by large numbers is undefined
-(test-undefined (<< 1 113455345))
-(test-undefined (>> 1 113455345))
-(test-undefined (a>> 1 113455345))
-
-(test (<<.i32 1.i32 31) -2147483648.i32)
-(test-undefined (<<.i32 1.i32 32))
-(test (>>.i32 (neg.i32 1.i32) 31) 1.i32)
-(test-undefined (>>.i32 (neg.i32 1.i32) 32))
diff --git a/malfunction/test/test.ml b/malfunction/test/test.ml
deleted file mode 100644
index 863461aab621..000000000000
--- a/malfunction/test/test.ml
+++ /dev/null
@@ -1,243 +0,0 @@
-open Malfunction
-open Malfunction_parser
-open Malfunction_interpreter
-
-exception ReifyFailure of string
-let rec reify = function
-| Block (n, xs) -> reify_block n xs
-| Vec (`Array, xs) -> reify_block 0 xs
-| Vec (`Bytevec, xs) ->
-   let to_char = function
-     | Int (`Int, n) when 0 <= Z.to_int n && Z.to_int n < 256 ->
-        String.make 1 (Char.chr (Z.to_int n))
-     | _ -> raise (ReifyFailure "reify: noncharacter in string") in
-   Obj.repr (String.concat "" (List.map to_char (Array.to_list xs)))
-| Int (ty, n) -> Obj.(match ty with
-  | `Int -> repr (Z.to_int n)
-  | `Int32 -> repr (Z.to_int32 n)
-  | `Int64 -> repr (Z.to_int64 n)
-  | `Bigint -> repr n)
-| Float f -> Obj.repr f
-| Func _ -> raise (ReifyFailure "reify: functional value")
-| Thunk _ -> raise (ReifyFailure "reify: lazy value")
-
-and reify_block n xs =
-  let o = Obj.new_block n (Array.length xs) in
-  for i = 0 to Array.length xs - 1 do
-    Obj.set_field o i (reify xs.(i))
-  done;
-  o
-
-let check xs =
-  Array.iter (fun a ->
-  Stdlib.print_char
-    (if Stdlib.(=) (Marshal.from_channel Stdlib.stdin) a then
-        'Y'
-     else
-        'N')) xs;
-  Stdlib.flush_all ()
-
-let check_stub = "
-  (lambda ($xs)
-    (seq
-      (apply (global $Z $of_string) \"42\") ; ensure zarith loaded for unmarshalling
-      (apply (global $Array $iter) (lambda ($x)
-        (apply (global $Stdlib $print_char)
-          (if (== 0
-                (apply (global $Stdlib $compare)
-                       $x
-                       (apply (global $Marshal $from_channel) (global $Stdlib $stdin))))
-              89
-              78))) $xs)
-      (apply (global $Stdlib $print_newline) 0)))"
-
-type test_result =
-  [ `Bad_test of string (* expected output had undefined behaviour or was a function *)
-  | `Undefined of string (* testcase had undefined behaviour *)
-  | `Crash of string (* compiled executable failed to run or crashed, even though testcase had defined behaviour *)
-  | `Different (* interpreter and compiler agree that testcase does not match expected output *)
-  | `Inconsistent (* interpreter and compiler disagree whether testcase matches expected output *)
-  | `Match ] (* interpreter and compiler agree that testcase matches expected output *)
-
-
-exception HarnessFailed of string
-
-let exec_name = "malfunction_test_exec"
-
-let try_run_tests cases =
-  if Sys.file_exists exec_name then
-    raise (HarnessFailed ("file exists: "^exec_name));
-  let checker = Malfunction_parser.read_expression
-    (Lexing.from_string check_stub) in
-  let testcases = cases |> List.map @@ function
-    | `Bad_test _ | `Undefined _ -> Mnum (`Int 0)
-    | `Match (test, _) | `NoMatch (test, _) -> test in
-
-  let temps = ref None in
-  let delete_temps () =
-    Misc.remove_file exec_name;
-    match !temps with Some t -> Malfunction_compiler.delete_temps t | None -> () in
-
-  let options = [`Package "zarith"; `Linkpkg] in
-  begin match
-    Mmod ([`Unnamed (Mapply (checker, [Mblock (0, testcases)]))], [])
-    |> Malfunction_compiler.compile_module ~options ~filename:exec_name
-    |> (fun t -> temps := Some t; t)
-    |> Malfunction_compiler.link_executable ~options exec_name
-  with
-  | 0 -> ()
-  | _ -> delete_temps (); raise (HarnessFailed "Link error")
-  | exception e ->
-      Location.report_exception Format.str_formatter e;
-      delete_temps ();
-      raise (HarnessFailed (Format.flush_str_formatter ())) end;
-  let (rd, wr) = Unix.open_process ("./" ^ exec_name) in
-  cases
-  |> List.map (function
-    | `Bad_test _ | `Undefined _ -> Obj.repr 0
-    | `Match (_, obj) | `NoMatch (_, obj) -> obj)
-  |> List.iter (fun x -> Marshal.to_channel wr x []);
-  flush wr;
-  let answer = try input_line rd with End_of_file -> "" in
-  let result = Unix.close_process (rd, wr) in
-  delete_temps ();
-  match result with
-  | Unix.WEXITED 0 when String.length answer = List.length cases ->
-     cases |> List.mapi (fun i c -> match c, answer.[i] with
-     | (`Bad_test _ | `Undefined _) as x, _ -> x
-     | `Match _, 'Y' -> `Match
-     | `NoMatch _, 'N' -> `Different
-     | `Match _, 'N' -> `Inconsistent
-     | `NoMatch _, 'Y' -> `Inconsistent
-     | _, c -> `Crash ("output produced '" ^ String.make 1 c ^ "'"))
-  | _ -> raise (HarnessFailed "executable failed")
-
-let run_tests cases =
-  try
-    try_run_tests cases
-  with
-    (* failed to run all at once, run them one at a time to isolate crashing case *)
-    HarnessFailed _ ->
-      cases |> List.map @@ fun x ->
-        try List.hd (try_run_tests [x]) with
-          HarnessFailed s -> `Crash s
-
-let load_testcases filename =
-  let lexbuf = Lexing.from_channel (open_in filename) in
-  Lexing.(lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = filename});
-  let rec read_testcases acc =
-    let open Malfunction_sexp in
-    match read_next_sexp lexbuf with
-    | loc, List [_, Atom "test"; test; exp] ->
-       read_testcases ((`Test, loc,
-                        Malfunction_parser.parse_expression test,
-                        Malfunction_parser.parse_expression exp) :: acc)
-    | loc, List [_, Atom "test-differ"; test; exp] ->
-       read_testcases ((`TestDiffer, loc,
-                        Malfunction_parser.parse_expression test,
-                        Malfunction_parser.parse_expression exp) :: acc)
-    | loc, List [_, Atom "test-undefined"; test] ->
-       read_testcases ((`TestUndef, loc,
-                        Malfunction_parser.parse_expression test,
-                        Malfunction_parser.parse_expression (loc, Atom "0")) :: acc)
-    | loc, _ -> raise (SyntaxError (loc, "Bad test"))
-    | exception End_of_file -> List.rev acc in
-  read_testcases []
-
-let load_testcases_markdown filename =
-  let chan = open_in filename in
-  let buflen = 1000 in
-  let rec read_all () =
-    let buf = Bytes.create buflen in
-    match input chan buf 0 buflen with
-    | 0 -> []
-    | n -> Bytes.sub_string buf 0 n :: read_all () in
-  let contents = String.concat "" (read_all ()) in
-  let parse_string s =
-    s |> Lexing.from_string |> Malfunction_sexp.read_only_sexp |> Malfunction_parser.parse_expression in
-  let dummy_loc =
-    let l = Lexing.{pos_fname = filename; pos_lnum = 0; pos_cnum = 0; pos_bol = 0} in
-    l,l in
-  let open Omd in
-  let testcases = ref [] in
-  let _ = Omd.of_string contents |> List.iter @@ function
-    | Code_block (_, ("test" | " test"), s) ->
-       let open Str in
-       let (test, expect) = match split (regexp "\n=>") s with
-         | [t; e] -> (parse_string t, parse_string e)
-         | _ -> failwith @@ "Cannot parse testcase " ^ s in
-       testcases := (`Test, dummy_loc, test, expect) :: !testcases;
-       ()
-    | _ -> ()
-  in
-  List.rev !testcases
-
-let run_file parser filename =
-  Format.printf "%s: %!" filename;
-  match Malfunction.with_error_reporting (Format.std_formatter) None
-    (fun () -> Some (parser filename))
-  with
-  | None -> Format.printf "parse error\n%!"; `SomeFailed
-  | Some cases ->
-     let results = cases
-     |> List.map (fun (_ty, _loc, test, expect) ->
-       match eval expect with
-       | exception (Error s) -> `Bad_test s
-       | expectRes -> match eval test, reify expectRes with
-         | exception (Error s) -> `Undefined s
-         | exception (ReifyFailure s) -> `Bad_test s
-         | testRes, expectObj ->
-            if compare testRes expectRes = 0 then
-              `Match (test, expectObj)
-            else
-              `NoMatch (test, expectObj))
-     |> run_tests in
-     let passed = ref 0 in
-     let describe (ty, ({Lexing.pos_lnum = line; _}, _), _, _) result =
-       let say fmt =
-         Format.printf "\n%s:%d: " filename line;
-         let endline ppf =
-           Format.fprintf ppf "\n%!" in
-         Format.kfprintf endline Format.std_formatter fmt in
-       begin match ty, result with
-       | _, `Bad_test s -> say "bad test: %s" s
-       | _, `Crash s -> say "crash: %s" s
-       | _, `Inconsistent -> say "inconsistent results"
-       | `Test, `Match
-       | `TestUndef, `Undefined _
-       | `TestDiffer, `Different -> incr passed
-       | (`Test|`TestDiffer), `Undefined s -> say "undefined behaviour: %s" s
-       | `TestUndef, (`Match|`Different) -> say "undefined behaviour not detected"
-       | `Test, `Different -> say "values don't match"
-       | `TestDiffer, `Match -> say "values match when not expected to" end;
-     in
-     List.iter2 describe cases results;
-     Format.printf "\r%-25s [%d/%d] tests passed\n%!" (filename ^ ":") !passed (List.length cases);
-     if !passed = List.length cases then `AllPassed else `SomeFailed
-
-let rec run_all testfiles =
-  let combine a b = match a, b with `AllPassed, `AllPassed -> `AllPassed | _ -> `SomeFailed in
-  let result = ref `AllPassed in
-  for i = 0 to Array.length testfiles - 1 do
-    let file = testfiles.(i) in
-    let res =
-      if Sys.is_directory file then
-        run_all (Array.map (fun x -> file ^ Filename.dir_sep ^ x) (Sys.readdir file))
-      else if Filename.check_suffix file ".md" then
-        run_file load_testcases_markdown file
-      else if Filename.check_suffix file ".test" then
-        run_file load_testcases file
-      else
-        `AllPassed in
-    result := combine res !result
-  done;
-  !result
-
-
-let () =
-  match Sys.argv with
-  | [| me |] -> Format.printf "Usage: %s <test files>\n" me; exit 1
-  | _ ->
-     match run_all (Array.sub Sys.argv 1 (Array.length Sys.argv - 1)) with
-     | `SomeFailed -> Format.printf "Some tests failed\n%!"; exit 1
-     | `AllPassed -> Format.printf "All tests passed\n%!"; exit 0
diff --git a/malfunction/test/vector.test b/malfunction/test/vector.test
deleted file mode 100644
index 0cb561580f5d..000000000000
--- a/malfunction/test/vector.test
+++ /dev/null
@@ -1,15 +0,0 @@
-(test
-  (let
-    ($arr (makevec 10 42))
-    ($a (load $arr 0))
-    ($b (load $arr 8))
-    (_ (store $arr 8 (block (tag 0) 1 2 3)))
-    ($c (load $arr 8))
-    (block (tag 0) $a $b $c))
-  (block (tag 0) 42 42 (block (tag 0) 1 2 3)))
-    
-(test-undefined
-  (load (makevec 10 10) 10))
-
-(test-undefined
-  (load (makevec 10 10) (- 0 1)))
diff --git a/malfunction/test_cli/dune b/malfunction/test_cli/dune
deleted file mode 100644
index 0c89fe2d8b39..000000000000
--- a/malfunction/test_cli/dune
+++ /dev/null
@@ -1,8 +0,0 @@
-(rule
- (targets test.log test.expect)
- (deps test.sh (source_tree .) (package malfunction))
- (action (run ./test.sh)))
-
-(alias
- (name runtest)
- (action (diff test.expect test.log)))
diff --git a/malfunction/test_cli/helloworld.mlf b/malfunction/test_cli/helloworld.mlf
deleted file mode 100644
index 4ed219b97502..000000000000
--- a/malfunction/test_cli/helloworld.mlf
+++ /dev/null
@@ -1,3 +0,0 @@
-(module
-  (_ (apply (global $Stdlib $print_string) "Hello, world!\n"))
-  (export))
diff --git a/malfunction/test_cli/main.ml b/malfunction/test_cli/main.ml
deleted file mode 100644
index b927d1a992db..000000000000
--- a/malfunction/test_cli/main.ml
+++ /dev/null
@@ -1,4 +0,0 @@
-List.iter (Printf.printf "%d\n") Module.x;;
-List.iter (Printf.printf "%d\n") Module.y;;
-Printf.printf "%b %b\n" (Module.even 42) (Module.odd 42);;
-Printf.printf "%d\n" Module.s;;
diff --git a/malfunction/test_cli/module.mlf b/malfunction/test_cli/module.mlf
deleted file mode 100644
index e495bdca71a5..000000000000
--- a/malfunction/test_cli/module.mlf
+++ /dev/null
@@ -1,14 +0,0 @@
-(module
-  (rec
-    ($even (lambda ($n) (if (<= $n 1) (== $n 0) (apply $odd (- $n 1)))))
-    ($odd (lambda ($n) (if (<= $n 1) (== $n 1) (apply $even (- $n 1))))))
-  ($foo 100)
-  ($bar 10)
-  ($baz 1)
-  ($y (block (tag 0) 10 0))
-  (export
-    $odd
-    (block (tag 0) 42 0)
-    $y
-    $even
-    (+ $foo (+ $bar $baz))))
diff --git a/malfunction/test_cli/module.mli b/malfunction/test_cli/module.mli
deleted file mode 100644
index 44649d1026b1..000000000000
--- a/malfunction/test_cli/module.mli
+++ /dev/null
@@ -1,5 +0,0 @@
-val odd : int -> bool
-val x : int list
-val y : int list
-val even : int -> bool
-val s : int
diff --git a/malfunction/test_cli/test.sh b/malfunction/test_cli/test.sh
deleted file mode 100755
index 22010cb5b2bb..000000000000
--- a/malfunction/test_cli/test.sh
+++ /dev/null
@@ -1,63 +0,0 @@
-#!/bin/sh
-
-> test.expect
-> test.log
-exec >test.log 2>&1
-expect () { echo '=== TEST ==='; ( echo "$@"; echo '=== TEST ===' ) >> test.expect; }
-expect_ () { cat >> test.expect; echo '=== TEST ==='; echo '=== TEST ===' >> test.expect; }
-
-ignore_linker_warnings () {
-  # 32-bit debian and some osx versions issue spurious linker warnings
-  # see https://github.com/ocaml/opam-repository/issues/3000 and 9728
-  grep -v 'ld:.* warning:'
-}
-
-clean () {
-  rm -f *.o *.cm*
-}
-
-clean
-malfunction compile helloworld.mlf 2>&1 | ignore_linker_warnings
-./helloworld
-expect 'Hello, world!'
-
-clean
-malfunction compile -o foo helloworld.mlf 2>&1 | ignore_linker_warnings
-./foo
-expect 'Hello, world!'
-
-clean
-malfunction cmx helloworld.mlf
-ocamlopt helloworld.cmx -o exec 2>&1 | ignore_linker_warnings
-./exec
-expect 'Hello, world!'
-
-clean
-malfunction cmo helloworld.mlf
-ocamlc helloworld.cmo -o exec.byte
-./exec
-expect 'Hello, world!'
-
-clean
-ocamlc -opaque -c module.mli
-malfunction cmx module.mlf
-ocamlopt module.cmx main.ml -o main 2>&1 | ignore_linker_warnings
-./main
-expect_ <<EOF
-42
-10
-true false
-111
-EOF
-
-clean
-ocamlc -opaque -c module.mli
-malfunction cmo module.mlf
-ocamlc module.cmo main.ml -o main.byte
-./main.byte
-expect_ <<EOF
-42
-10
-true false
-111
-EOF
diff --git a/malfunction/test_cli/test.t b/malfunction/test_cli/test.t
deleted file mode 100644
index e534780199a0..000000000000
--- a/malfunction/test_cli/test.t
+++ /dev/null
@@ -1,28 +0,0 @@
-#!/bin/sh
-
-expect () { echo "$@" >> test.log; }
-expect_ () { cat >> test.log; }
-
-malfunction compile helloworld.mlf
-./helloworld
-expect 'Hello, world!'
-
-malfunction compile -o foo helloworld.mlf
-./foo
-expect 'Hello, world!'
-
-malfunction cmx helloworld.mlf
-ocamlopt helloworld.cmx -o exec
-./exec
-expect 'Hello, world!'
-
-ocamlc -opaque -c module.mli
-malfunction cmx module.mlf
-ocamlopt module.cmx main.ml -o main
-./main
-expect_ <<EOF
-42
-10
-true false
-111
-EOF

From 0a5442005b3b3dc264f71f03d858657356512cf8 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Wed, 17 Jun 2026 15:17:26 +0200
Subject: [PATCH 75/76] updated Dockerfile

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

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index d131602e85e8..c2b470bdd278 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-f12e94ebd1"
-  EDGE_CACHEKEY: "edge_ubuntu-V2026-06-17-af8eb43efd"
+  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 a665c4ee98c0..5d56fcf98470 100644
--- a/dev/ci/docker/edge_ubuntu/Dockerfile
+++ b/dev/ci/docker/edge_ubuntu/Dockerfile
@@ -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 6724ed739eb9..82369a0b5ac8 100644
--- a/dev/ci/docker/old_ubuntu_lts/Dockerfile
+++ b/dev/ci/docker/old_ubuntu_lts/Dockerfile
@@ -65,6 +65,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
 
@@ -76,6 +77,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 2a5652916ddcb5ca3350ad19e9ebe6d3dd1f72d2 Mon Sep 17 00:00:00 2001
From: Elliott <elliottranvier@gmail.com>
Date: Fri, 19 Jun 2026 13:04:26 +0200
Subject: [PATCH 76/76] 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 761e2017e661..2b284ee914a8 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -1877,9 +1877,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)