From 6f22190cba92a44b6c74bfcce8f5ed142a68e195 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 31 Aug 2023 12:47:43 +0200
Subject: Start adding support for traits

---
 compiler/Translate.ml | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 70ef5e3d..ca661108 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -280,9 +280,7 @@ let translate_crate_to_pure (crate : A.crate) :
   log#ldebug (lazy "translate_crate_to_pure");
 
   (* Compute the type and function contexts *)
-  let type_context, fun_context, global_context =
-    compute_type_fun_global_contexts crate
-  in
+  let type_context, fun_context, global_context = compute_contexts crate in
   let fun_infos =
     FA.analyze_module crate fun_context.C.fun_decls
       global_context.C.global_decls !Config.use_state
-- 
cgit v1.3.1


From b42c0a8fa4708d6bf8424d63b6a7fe4964ba0e3d Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 15:18:36 +0200
Subject: Make progress on the extraction

---
 compiler/Extract.ml         |  13 +++++-
 compiler/Pure.ml            |  44 ++++++++++++++++++
 compiler/PureMicroPasses.ml |   8 +++-
 compiler/SymbolicToPure.ml  | 110 +++++++++++++++++++++++++++++++++++++++++++-
 compiler/Translate.ml       | 109 ++++++++++++++++++++++++++++++++++++-------
 compiler/TranslateCore.ml   |   1 +
 6 files changed, 264 insertions(+), 21 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index ad89a59e..e07305f1 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -1301,7 +1301,8 @@ and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter)
       let name = ctx_get_trait_item_clause decl_id item_name clause_id ctx in
       extract_trait_instance_id ctx fmt no_params_tys true inst_id;
       F.pp_print_string fmt ("." ^ name)
-  | TraitRef trait_ref -> extract_trait_ref ctx fmt no_params_tys true trait_ref
+  | TraitRef trait_ref ->
+      extract_trait_ref ctx fmt no_params_tys inside trait_ref
   | UnknownTrait _ ->
       (* This is an error case *)
       raise (Failure "Unexpected")
@@ -3774,6 +3775,16 @@ let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter)
       (* Add a break to insert lines between declarations *)
       F.pp_print_break fmt 0 0
 
+(** Extract a trait declaration *)
+let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
+    (trait_decl : trait_decl) : unit =
+  raise (Failure "TODO")
+
+(** Extract a trait implementation *)
+let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
+    (trait_impl : trait_impl) : unit =
+  raise (Failure "TODO")
+
 (** Extract a unit test, if the function is a unit function (takes no
     parameters, returns unit).
 
diff --git a/compiler/Pure.ml b/compiler/Pure.ml
index 725f71ad..6c9f41f1 100644
--- a/compiler/Pure.ml
+++ b/compiler/Pure.ml
@@ -45,6 +45,8 @@ type trait_decl_id = T.trait_decl_id [@@deriving show, ord]
 type trait_impl_id = T.trait_impl_id [@@deriving show, ord]
 type trait_clause_id = T.trait_clause_id [@@deriving show, ord]
 type trait_item_name = T.trait_item_name [@@deriving show, ord]
+type global_decl_id = T.global_decl_id [@@deriving show, ord]
+type fun_decl_id = A.fun_decl_id [@@deriving show, ord]
 
 (** The assumed types for the pure AST.
 
@@ -361,11 +363,23 @@ type generic_params = {
 }
 [@@deriving show]
 
+type trait_type_constraint = {
+  trait_ref : trait_ref;
+  generics : generic_args;
+  type_name : trait_item_name;
+  ty : ty;
+}
+[@@deriving show]
+
+type predicates = { trait_type_constraints : trait_type_constraint list }
+[@@deriving show]
+
 type type_decl = {
   def_id : TypeDeclId.id;
   name : name;
   generics : generic_params;
   kind : type_decl_kind;
+  preds : predicates;
 }
 [@@deriving show]
 
@@ -881,6 +895,7 @@ type fun_sig_info = {
 type fun_sig = {
   generics : generic_params;
       (** TODO: we should analyse the signature to make the type parameters implicit whenever possible *)
+  preds : predicates;
   inputs : ty list;
       (** The types of the inputs.
 
@@ -952,8 +967,11 @@ type fun_body = {
 }
 [@@deriving show]
 
+type fun_kind = A.fun_kind [@@deriving show]
+
 type fun_decl = {
   def_id : FunDeclId.id;
+  kind : fun_kind;
   num_loops : int;
       (** The number of loops in the parent forward function (basically the number
           of loops appearing in the original Rust functions, unless some loops are
@@ -973,3 +991,29 @@ type fun_decl = {
   body : fun_body option;
 }
 [@@deriving show]
+
+type trait_decl = {
+  def_id : trait_decl_id;
+  name : name;
+  generics : generic_params;
+  preds : predicates;
+  all_trait_clauses : trait_clause list;
+  consts : (trait_item_name * (ty * global_decl_id option)) list;
+  types : (trait_item_name * (trait_clause list * ty option)) list;
+  required_methods : (trait_item_name * fun_decl_id) list;
+  provided_methods : trait_item_name list;
+}
+[@@deriving show]
+
+type trait_impl = {
+  def_id : trait_impl_id;
+  name : name;
+  impl_trait : trait_decl_ref;
+  generics : generic_params;
+  preds : predicates;
+  consts : (trait_item_name * (ty * global_decl_id)) list;
+  types : (trait_item_name * (trait_ref list * ty)) list;
+  required_methods : (trait_item_name * fun_decl_id) list;
+  provided_methods : (trait_item_name * fun_decl_id) list;
+}
+[@@deriving show]
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index 45e4ea98..93609695 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -1355,6 +1355,7 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list =
             let loop_sig =
               {
                 generics = fun_sig.generics;
+                preds = fun_sig.preds;
                 inputs = inputs_tys;
                 output;
                 doutputs;
@@ -1419,6 +1420,7 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list =
             let loop_def =
               {
                 def_id = def.def_id;
+                kind = def.kind;
                 num_loops;
                 loop_id = Some loop.loop_id;
                 back_id = def.back_id;
@@ -2135,7 +2137,9 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
           let num_filtered =
             List.length (List.filter (fun b -> not b) used_info)
           in
-          let { generics; inputs; output; doutputs; info } = decl.signature in
+          let { generics; preds; inputs; output; doutputs; info } =
+            decl.signature
+          in
           let {
             has_fuel;
             num_fwd_inputs_with_fuel_no_state;
@@ -2161,7 +2165,7 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
               effect_info;
             }
           in
-          let signature = { generics; inputs; output; doutputs; info } in
+          let signature = { generics; preds; inputs; output; doutputs; info } in
 
           { decl with signature }
     in
diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index 166f08a0..1a981de1 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -4,6 +4,7 @@ open Pure
 open PureUtils
 module Id = Identifiers
 module C = Contexts
+module A = LlbcAst
 module S = SymbolicAst
 module TA = TypesAnalysis
 module L = Logging
@@ -473,6 +474,20 @@ let translate_trait_clause (clause : T.trait_clause) : trait_clause =
   let generics = translate_sgeneric_args generics in
   { clause_id; trait_id; generics }
 
+let translate_strait_type_constraint (ttc : T.strait_type_constraint) :
+    trait_type_constraint =
+  let { T.trait_ref; generics; type_name; ty } = ttc in
+  let trait_ref = translate_strait_ref trait_ref in
+  let generics = translate_sgeneric_args generics in
+  let ty = translate_sty ty in
+  { trait_ref; generics; type_name; ty }
+
+let translate_predicates (preds : T.predicates) : predicates =
+  let trait_type_constraints =
+    List.map translate_strait_type_constraint preds.trait_type_constraints
+  in
+  { trait_type_constraints }
+
 let translate_generic_params (generics : T.generic_params) : generic_params =
   let { T.regions = _; types; const_generics; trait_clauses } = generics in
   let trait_clauses = List.map translate_trait_clause trait_clauses in
@@ -515,7 +530,8 @@ let translate_type_decl (def : T.type_decl) : type_decl =
   let trait_clauses = List.map translate_trait_clause trait_clauses in
   let generics = { types; const_generics; trait_clauses } in
   let kind = translate_type_decl_kind def.T.kind in
-  { def_id; name; generics; kind }
+  let preds = translate_predicates def.preds in
+  { def_id; name; generics; kind; preds }
 
 let translate_type_id (id : T.type_id) : type_id =
   match id with
@@ -952,7 +968,8 @@ let translate_fun_sig (fun_infos : FA.fun_info A.FunDeclId.Map.t)
       effect_info;
     }
   in
-  let sg = { generics; inputs; output; doutputs; info } in
+  let preds = translate_predicates sg.A.preds in
+  let sg = { generics; preds; inputs; output; doutputs; info } in
   { sg; output_names }
 
 let bs_ctx_fresh_state_var (ctx : bs_ctx) : bs_ctx * typed_pattern =
@@ -2932,6 +2949,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl =
   let def =
     {
       def_id;
+      kind = def.kind;
       num_loops;
       loop_id;
       back_id = bid;
@@ -3002,3 +3020,91 @@ let translate_fun_signatures (fun_infos : FA.fun_info A.FunDeclId.Map.t)
   List.fold_left
     (fun m (id, sg) -> RegularFunIdNotLoopMap.add id sg m)
     RegularFunIdNotLoopMap.empty translated
+
+let translate_trait_decl (type_infos : TA.type_infos)
+    (trait_decl : A.trait_decl) : trait_decl =
+  let {
+    A.def_id;
+    name;
+    generics;
+    preds;
+    all_trait_clauses;
+    consts;
+    types;
+    required_methods;
+    provided_methods;
+  } =
+    trait_decl
+  in
+  let generics = translate_generic_params generics in
+  let preds = translate_predicates preds in
+  let all_trait_clauses = List.map translate_trait_clause all_trait_clauses in
+  let consts =
+    List.map
+      (fun (name, (ty, id)) -> (name, (translate_fwd_ty type_infos ty, id)))
+      consts
+  in
+  let types =
+    List.map
+      (fun (name, (trait_clauses, ty)) ->
+        ( name,
+          ( List.map translate_trait_clause trait_clauses,
+            Option.map (translate_fwd_ty type_infos) ty ) ))
+      types
+  in
+  {
+    def_id;
+    name;
+    generics;
+    preds;
+    all_trait_clauses;
+    consts;
+    types;
+    required_methods;
+    provided_methods;
+  }
+
+let translate_trait_impl (type_infos : TA.type_infos)
+    (trait_impl : A.trait_impl) : trait_impl =
+  let {
+    A.def_id;
+    name;
+    impl_trait;
+    generics;
+    preds;
+    consts;
+    types;
+    required_methods;
+    provided_methods;
+  } =
+    trait_impl
+  in
+  let impl_trait =
+    translate_trait_decl_ref (translate_fwd_ty type_infos) impl_trait
+  in
+  let generics = translate_generic_params generics in
+  let preds = translate_predicates preds in
+  let consts =
+    List.map
+      (fun (name, (ty, id)) -> (name, (translate_fwd_ty type_infos ty, id)))
+      consts
+  in
+  let types =
+    List.map
+      (fun (name, (trait_refs, ty)) ->
+        ( name,
+          ( List.map (translate_fwd_trait_ref type_infos) trait_refs,
+            translate_fwd_ty type_infos ty ) ))
+      types
+  in
+  {
+    def_id;
+    name;
+    impl_trait;
+    generics;
+    preds;
+    consts;
+    types;
+    required_methods;
+    provided_methods;
+  }
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index ca661108..f4f59187 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -5,6 +5,7 @@ module T = Types
 module A = LlbcAst
 module SA = SymbolicAst
 module Micro = PureMicroPasses
+module C = Contexts
 open PureUtils
 open TranslateCore
 
@@ -28,18 +29,34 @@ let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : A.fun_decl)
       ("translate_function_to_symbolics: "
       ^ Print.fun_name_to_string fdef.A.name));
 
-  let { type_context; fun_context; global_context } = trans_ctx in
+  let {
+    type_context;
+    fun_context;
+    global_context;
+    trait_decls_context;
+    trait_impls_context;
+  } =
+    trans_ctx
+  in
   let fun_context = { C.fun_decls = fun_context.fun_decls } in
 
+  (* TODO: we should merge trans_ctx and decls_ctx *)
+  let decls_ctx : C.decls_ctx =
+    {
+      C.type_ctx = type_context;
+      fun_ctx = fun_context;
+      global_ctx = global_context;
+      trait_decls_ctx = trait_decls_context;
+      trait_impls_ctx = trait_impls_context;
+    }
+  in
+
   match fdef.body with
   | None -> None
   | Some _ ->
       (* Evaluate *)
       let synthesize = true in
-      let inputs, symb =
-        evaluate_function_symbolic synthesize type_context fun_context
-          global_context fdef
-      in
+      let inputs, symb = evaluate_function_symbolic synthesize decls_ctx fdef in
       Some (inputs, Option.get symb)
 
 (** Translate a function, by generating its forward and backward translations.
@@ -57,7 +74,15 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
     (lazy
       ("translate_function_to_pure: " ^ Print.fun_name_to_string fdef.A.name));
 
-  let { type_context; fun_context; global_context } = trans_ctx in
+  let {
+    type_context;
+    fun_context;
+    global_context;
+    trait_decls_context;
+    trait_impls_context;
+  } =
+    trans_ctx
+  in
   let def_id = fdef.def_id in
 
   (* Compute the symbolic ASTs, if the function is transparent *)
@@ -148,6 +173,8 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
       type_context;
       fun_context;
       global_context;
+      trait_decls_ctx = trait_decls_context.trait_decls;
+      trait_impls_ctx = trait_impls_context.trait_impls;
       fun_decl = fdef;
       forward_inputs = [];
       (* Empty for now *)
@@ -280,13 +307,21 @@ let translate_crate_to_pure (crate : A.crate) :
   log#ldebug (lazy "translate_crate_to_pure");
 
   (* Compute the type and function contexts *)
-  let type_context, fun_context, global_context = compute_contexts crate in
+  let decls_ctx = compute_contexts crate in
   let fun_infos =
-    FA.analyze_module crate fun_context.C.fun_decls
-      global_context.C.global_decls !Config.use_state
+    FA.analyze_module crate decls_ctx.fun_ctx.C.fun_decls
+      decls_ctx.global_ctx.C.global_decls !Config.use_state
+  in
+  let fun_context = { fun_decls = decls_ctx.fun_ctx.fun_decls; fun_infos } in
+  let trans_ctx =
+    {
+      type_context = decls_ctx.type_ctx;
+      fun_context;
+      global_context = decls_ctx.global_ctx;
+      trait_decls_context = decls_ctx.trait_decls_ctx;
+      trait_impls_context = decls_ctx.trait_impls_ctx;
+    }
   in
-  let fun_context = { fun_decls = fun_context.fun_decls; fun_infos } in
-  let trans_ctx = { type_context; fun_context; global_context } in
 
   (* Translate all the type definitions *)
   let type_decls =
@@ -323,7 +358,7 @@ let translate_crate_to_pure (crate : A.crate) :
   let sigs = List.append assumed_sigs local_sigs in
   let fun_sigs =
     SymbolicToPure.translate_fun_signatures fun_context.fun_infos
-      type_context.type_infos sigs
+      decls_ctx.type_ctx.type_infos sigs
   in
 
   (* Translate all the *transparent* functions *)
@@ -696,6 +731,36 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
           Extract.extract_unit_test_if_unit_fun ctx.extract_ctx fmt fwd)
       pure_ls
 
+(** Export a trait declaration. *)
+let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
+    (ctx : gen_ctx) (trait_decl_id : Pure.trait_decl_id) : unit =
+  let trait_decl =
+    T.TraitDeclId.Map.find trait_decl_id
+      ctx.extract_ctx.trans_ctx.trait_decls_context.trait_decls
+  in
+  (* We translate the trait declaration on the fly (note that
+     trait declarations do not directly contain functions, constants,
+     etc.: they simply refer to them). *)
+  let type_infos = ctx.extract_ctx.trans_ctx.type_context.type_infos in
+  let trait_decl = SymbolicToPure.translate_trait_decl type_infos trait_decl in
+  let ctx = ctx.extract_ctx in
+  let ctx = { ctx with trait_decl_id = Some trait_decl.def_id } in
+  Extract.extract_trait_decl ctx fmt trait_decl
+
+(** Export a trait implementation. *)
+let export_trait_impl (fmt : Format.formatter) (_config : gen_config)
+    (ctx : gen_ctx) (trait_impl_id : Pure.trait_impl_id) : unit =
+  let trait_impl =
+    T.TraitImplId.Map.find trait_impl_id
+      ctx.extract_ctx.trans_ctx.trait_impls_context.trait_impls
+  in
+  (* We translate the trait implementation on the fly (note that
+     trait implementations do not directly contain functions, constants,
+     etc.: they simply refer to them). *)
+  let type_infos = ctx.extract_ctx.trans_ctx.type_context.type_infos in
+  let trait_impl = SymbolicToPure.translate_trait_impl type_infos trait_impl in
+  Extract.extract_trait_impl ctx.extract_ctx fmt trait_impl
+
 (** A generic utility to generate the extracted definitions: as we may want to
     split the definitions between different files (or not), we can control
     what is precisely extracted.
@@ -710,6 +775,8 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
   let export_functions_group = export_functions_group fmt config ctx in
   let export_global = export_global fmt config ctx in
   let export_types_group = export_types_group fmt config ctx in
+  let export_trait_decl = export_trait_decl fmt config ctx in
+  let export_trait_impl = export_trait_impl fmt config ctx in
 
   let export_state_type () : unit =
     let kind =
@@ -723,11 +790,18 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
     | Type (NonRec id) ->
         if config.extract_types then export_types_group false [ id ]
     | Type (Rec ids) -> if config.extract_types then export_types_group true ids
-    | Fun (NonRec id) ->
+    | Fun (NonRec id) -> (
         (* Lookup *)
         let pure_fun = A.FunDeclId.Map.find id ctx.trans_funs in
-        (* Translate *)
-        export_functions_group [ pure_fun ]
+        (* Special case: we skip trait method *declarations* (we will
+           extract their type directly in the records we generate for
+           the trait declarations themselves, there is no point in having
+           separate type definitions) *)
+        match (fst (fst (snd pure_fun))).Pure.kind with
+        | TraitMethodDecl _ -> ()
+        | _ ->
+            (* Translate *)
+            export_functions_group [ pure_fun ])
     | Fun (Rec ids) ->
         (* General case of mutually recursive functions *)
         (* Lookup *)
@@ -737,11 +811,13 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
         (* Translate *)
         export_functions_group pure_funs
     | Global id -> export_global id
+    | TraitDecl id -> export_trait_decl id
+    | TraitImpl id -> export_trait_impl id
   in
 
   (* If we need to export the state type: we try to export it after we defined
    * the type definitions, because if the user wants to define a model for the
-   * type, he might want to reuse those in the state type.
+   * type, they might want to reuse those in the state type.
    * More specifically: if we extract functions in the same file as the type,
    * we have no choice but to define the state type before the functions,
    * because they may reuse this state type: in this case, we define/declare
@@ -930,6 +1006,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       use_opaque_pre = !Config.split_files;
       use_dep_ite = !Config.backend = Lean && !Config.extract_decreases_clauses;
       fun_name_info = PureUtils.RegularFunIdMap.empty;
+      trait_decl_id = None (* None by default *);
     }
   in
 
diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml
index 1b1572d6..34a6434f 100644
--- a/compiler/TranslateCore.ml
+++ b/compiler/TranslateCore.ml
@@ -22,6 +22,7 @@ type trait_decls_context = C.trait_decls_context [@@deriving show]
 type trait_impls_context = C.trait_impls_context [@@deriving show]
 type global_context = C.global_context [@@deriving show]
 
+(* TODO: we should use Contexts.decls_ctx *)
 type trans_ctx = {
   type_context : type_context;
   fun_context : fun_context;
-- 
cgit v1.3.1


From a2f19257651df3c8473e17ef73a5389b9cb89bbf Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 16:35:05 +0200
Subject: Make progress on the extraction

---
 compiler/Extract.ml     | 218 ++++++++++++++++++++++++++++++++++++------------
 compiler/ExtractBase.ml |  63 ++++++++++++--
 compiler/Translate.ml   |   1 +
 3 files changed, 221 insertions(+), 61 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index e07305f1..e140ea1c 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -841,6 +841,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     (* TODO: actually use the clause to derive the name *)
     "cl"
   in
+  let trait_self_clause_basename = "self_clause" in
   let append_index (basename : string) (i : int) : string =
     basename ^ string_of_int i
   in
@@ -936,6 +937,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     var_basename;
     type_var_basename;
     const_generic_var_basename;
+    trait_self_clause_basename;
     trait_clause_basename;
     append_index;
     extract_literal;
@@ -1237,15 +1239,26 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
         if use_brackets then F.pp_print_string fmt ")";
         F.pp_print_string fmt ("." ^ name))
       else
-        (* Can only happen when extracting the signature of a trait method
-           *declaration* or a provided trait method (for a declaration).
-           If extracting items for a trait method implementation,
-           the type should have been normalized. For trait method declarations
-           we directly reference the item. *)
-        assert (ctx.trait_decl_id <> None);
-      assert (generics = empty_generic_args);
-      let name = ctx_get_local_trait_assoc_type type_name ctx in
-      F.pp_print_string fmt name
+        (* There are two situations:
+           - we are extracting a declared item (typically a function signature)
+             for a trait declaration. We directly refer to the item (we extract
+             trait declarations as structures, so we can refer to their fields)
+           - we are extracting a provided method for a trait declaration. We
+             refer to the item in the self trait clause (see {!SelfTraitClauseId}).
+
+           Remark: we can't get there for trait *implementations* because then the
+           types should have been normalized.
+        *)
+        let trait_decl_id = Option.get ctx.trait_decl_id in
+        let item_name = ctx_get_trait_assoc_type trait_decl_id type_name ctx in
+        assert (generics = empty_generic_args);
+        if ctx.is_provided_method then
+          (* Provided method: use the trait self clause *)
+          let self_clause = ctx_get_trait_self_clause ctx in
+          F.pp_print_string fmt (self_clause ^ "." ^ item_name)
+        else
+          (* Declaration: directly refer to the item *)
+          F.pp_print_string fmt item_name
 
 and extract_trait_ref (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_ref) : unit =
@@ -1632,11 +1645,37 @@ let extract_trait_clause_type (ctx : extraction_ctx) (fmt : F.formatter)
 let insert_req_space (fmt : F.formatter) (space : bool ref) : unit =
   if !space then space := false else F.pp_print_space fmt ()
 
+(** Extract the trait self clause.
+
+    We add the trait self clause for provided methods (see {!TraitSelfClauseId}).
+ *)
+let extract_trait_self_clause (insert_req_space : unit -> unit)
+    (ctx : extraction_ctx) (fmt : F.formatter) (trait_decl : A.trait_decl)
+    (params : string list) : unit =
+  insert_req_space ();
+  F.pp_print_string fmt "(";
+  let self_clause = ctx_get_trait_self_clause ctx in
+  F.pp_print_string fmt self_clause;
+  F.pp_print_string fmt ":";
+  let with_opaque_pre = false in
+  let trait_id = ctx_get_trait_decl with_opaque_pre trait_decl.def_id ctx in
+  F.pp_print_string fmt trait_id;
+  List.iter
+    (fun p ->
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt p)
+    params;
+  F.pp_print_string fmt ")"
+
+(**
+ - [trait_decl]: if [Some], it means we are extracting the generics for a provided
+   method and need to insert a trait self clause (see {!TraitSelfClauseId}).
+ *)
 let extract_generic_params (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (use_forall : bool) (as_implicits : bool)
-    (space : bool ref option) (generics : generic_params)
-    (type_params : string list) (cg_params : string list)
-    (trait_clauses : string list) : unit =
+    (space : bool ref option) (trait_decl : A.trait_decl option)
+    (generics : generic_params) (type_params : string list)
+    (cg_params : string list) (trait_clauses : string list) : unit =
   let all_params = List.concat [ type_params; cg_params; trait_clauses ] in
   (* HOL4 doesn't support const generics *)
   assert (cg_params = [] || !backend <> HOL4);
@@ -1660,53 +1699,102 @@ let extract_generic_params (ctx : extraction_ctx) (fmt : F.formatter)
       F.pp_print_string fmt ":";
       F.pp_print_space fmt ();
       F.pp_print_string fmt "forall");
-    (* Note that in HOL4 we don't print the type parameters. *)
-    if !backend <> HOL4 then (
-      (* Print the type parameters *)
-      if type_params <> [] then (
-        insert_req_space ();
-        (* ( *)
-        left_bracket ();
+    (* Small helper - we may need to split the parameters *)
+    let print_generics (type_params : string list)
+        (const_generics : const_generic_var list)
+        (trait_clauses : trait_clause list) : unit =
+      (* Note that in HOL4 we don't print the type parameters. *)
+      if !backend <> HOL4 then (
+        (* Print the type parameters *)
+        if type_params <> [] then (
+          insert_req_space ();
+          (* ( *)
+          left_bracket ();
+          List.iter
+            (fun s ->
+              F.pp_print_string fmt s;
+              F.pp_print_space fmt ())
+            type_params;
+          F.pp_print_string fmt ":";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt (type_keyword ());
+          (* ) *)
+          right_bracket ());
+        (* Print the const generic parameters *)
         List.iter
-          (fun s ->
-            F.pp_print_string fmt s;
-            F.pp_print_space fmt ())
-          type_params;
-        F.pp_print_string fmt ":";
-        F.pp_print_space fmt ();
-        F.pp_print_string fmt (type_keyword ());
-        (* ) *)
-        right_bracket ());
-      (* Print the const generic parameters *)
+          (fun (var : const_generic_var) ->
+            insert_req_space ();
+            (* ( *)
+            left_bracket ();
+            let n = ctx_get_const_generic_var var.index ctx in
+            F.pp_print_string fmt n;
+            F.pp_print_space fmt ();
+            F.pp_print_string fmt ":";
+            F.pp_print_space fmt ();
+            extract_literal_type ctx fmt var.ty;
+            (* ) *)
+            right_bracket ())
+          const_generics);
+      (* Print the trait clauses *)
       List.iter
-        (fun (var : const_generic_var) ->
+        (fun (clause : trait_clause) ->
           insert_req_space ();
           (* ( *)
           left_bracket ();
-          let n = ctx_get_const_generic_var var.index ctx in
+          let n = ctx_get_local_trait_clause clause.clause_id ctx in
           F.pp_print_string fmt n;
           F.pp_print_space fmt ();
           F.pp_print_string fmt ":";
           F.pp_print_space fmt ();
-          extract_literal_type ctx fmt var.ty;
+          extract_trait_clause_type ctx fmt no_params_tys clause;
           (* ) *)
           right_bracket ())
-        generics.const_generics);
-    (* Print the trait clauses *)
-    List.iter
-      (fun (clause : trait_clause) ->
-        insert_req_space ();
-        (* ( *)
-        left_bracket ();
-        let n = ctx_get_local_trait_clause clause.clause_id ctx in
-        F.pp_print_string fmt n;
-        F.pp_print_space fmt ();
-        F.pp_print_string fmt ":";
-        F.pp_print_space fmt ();
-        extract_trait_clause_type ctx fmt no_params_tys clause;
-        (* ) *)
-        right_bracket ())
-      generics.trait_clauses)
+        trait_clauses
+    in
+    (* If we extract the generics for a provided method for a trait declaration
+       (indicated by the trait decl given as input), we need to split the generics:
+       - we print the generics for the trait decl
+       - we print the trait self clause
+       - we print the generics for the trait method
+    *)
+    match trait_decl with
+    | None ->
+        print_generics type_params generics.const_generics
+          generics.trait_clauses
+    | Some trait_decl ->
+        (* Split the generics between the generics specific to the trait decl
+           and those specific to the trait method *)
+        let open Collections.List in
+        let dtype_params, mtype_params =
+          split_at type_params (length trait_decl.generics.types)
+        in
+        let dcgs, mcgs =
+          split_at generics.const_generics
+            (length trait_decl.generics.const_generics)
+        in
+        let dtrait_clauses, mtrait_clauses =
+          split_at generics.trait_clauses
+            (length trait_decl.generics.trait_clauses)
+        in
+        (* Extract the trait decl generics *)
+        print_generics dtype_params dcgs dtrait_clauses;
+        (* Extract the trait self clause *)
+        let params =
+          concat
+            [
+              dtype_params;
+              map
+                (fun (cg : const_generic_var) ->
+                  ctx_get_const_generic_var cg.index ctx)
+                dcgs;
+              map
+                (fun c -> ctx_get_local_trait_clause c.clause_id ctx)
+                dtrait_clauses;
+            ]
+        in
+        extract_trait_self_clause insert_req_space ctx fmt trait_decl params;
+        (* Extract the method generics *)
+        print_generics mtype_params mcgs mtrait_clauses)
 
 (** Extract a type declaration.
 
@@ -1769,7 +1857,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
   (* Print the generic parameters *)
   let as_implicits = false in
   extract_generic_params ctx_body fmt type_decl_group use_forall as_implicits
-    None def.generics type_params cg_params trait_clauses;
+    None None def.generics type_params cg_params trait_clauses;
   (* Print the "=" if we extract the body*)
   if extract_body then (
     F.pp_print_space fmt ();
@@ -2002,7 +2090,8 @@ let extract_type_decl_record_field_projectors (ctx : extraction_ctx)
           let use_forall = false in
           let as_implicits = true in
           extract_generic_params ctx fmt TypeDeclId.Set.empty use_forall
-            as_implicits None decl.generics type_params cg_params trait_clauses;
+            as_implicits None None decl.generics type_params cg_params
+            trait_clauses;
           (* Print the record parameter *)
           F.pp_print_space fmt ();
           F.pp_print_string fmt "(";
@@ -2994,8 +3083,8 @@ and extract_StructUpdate (ctx : extraction_ctx) (fmt : F.formatter)
 (** A small utility to print the parameters of a function signature.
 
     We return two contexts:
-    - the context augmented with bindings for the type parameters
-    - the context augmented with bindings for the type parameters *and*
+    - the context augmented with bindings for the generics
+    - the context augmented with bindings for the generics *and*
       bindings for the input values
 
     We also return names for the type parameters, const generics, etc.
@@ -3009,6 +3098,28 @@ and extract_StructUpdate (ctx : extraction_ctx) (fmt : F.formatter)
 let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx)
     (fmt : F.formatter) (def : fun_decl) :
     extraction_ctx * extraction_ctx * string list =
+  (* First, add the associated types and constants if the function is a method
+     in a trait declaration.
+
+     About the order: we want to make sure the names are reserved for
+     those (variable names might collide with them but it is ok, we will add
+     suffixes to the variables).
+
+     TODO: micro-pass to update what happens when calling trait provided
+     functions.
+  *)
+  let ctx, trait_decl =
+    match def.kind with
+    | TraitMethodProvided (decl_id, _) ->
+        let trait_decl =
+          T.TraitDeclId.Map.find decl_id
+            ctx.trans_ctx.trait_decls_context.trait_decls
+        in
+        let ctx, _ = ctx_add_trait_self_clause ctx in
+        let ctx = { ctx with is_provided_method = true } in
+        (ctx, Some trait_decl)
+    | _ -> (ctx, None)
+  in
   (* Add the type parameters - note that we need those bindings only for the
    * body translation (they are not top-level) *)
   let ctx, type_params, cg_params, trait_clauses =
@@ -3020,7 +3131,8 @@ let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx)
   let use_forall = false in
   let as_implicits = false in
   extract_generic_params ctx fmt TypeDeclId.Set.empty use_forall as_implicits
-    (Some space) def.signature.generics type_params cg_params trait_clauses;
+    (Some space) trait_decl def.signature.generics type_params cg_params
+    trait_clauses;
   (* Close the box for the generics *)
   F.pp_close_box fmt ();
   (* The input parameters - note that doing this adds bindings to the context *)
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 697b1027..251d8b36 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -291,6 +291,7 @@ type formatter = {
       (** Generates a type variable basename. *)
   const_generic_var_basename : StringSet.t -> string -> string;
       (** Generates a const generic variable basename. *)
+  trait_self_clause_basename : string;
   trait_clause_basename : StringSet.t -> trait_clause -> string;
       (** Return a base name for a trait clause. We might add a suffix to prevent
           collisions.
@@ -409,10 +410,44 @@ type id =
   | TraitDeclId of TraitDeclId.id
   | TraitImplId of TraitImplId.id
   | LocalTraitClauseId of TraitClauseId.id
-  | LocalTraitAssocTypeId of string  (** Specifically for: [Self::Ty] *)
   | TraitAssocTypeId of TraitDeclId.id * string  (** A trait associated type *)
   | TraitParentClauseId of TraitDeclId.id * TraitClauseId.id
   | TraitItemClauseId of TraitDeclId.id * string * TraitClauseId.id
+  | TraitSelfClauseId
+      (** Specifically for the clause: [Self : Trait].
+
+          For now, we forbid provided methods (methods in trait declarations
+          with a default implementation) from being overriden in trait implementations.
+          We extract trait provided methods such that they take an instance of
+          the trait as input: this instance is given by the trait self clause.
+
+          For instance:
+          {[
+            //
+            // Rust
+            //
+            trait ToU64 {
+              fn to_u64(&self) -> u64;
+
+              // Provided method
+              fn is_pos(&self) -> bool {
+                self.to_u64() > 0
+              }
+            }
+
+            //
+            // Generated code
+            //
+            struct ToU64 (T : Type) {
+              to_u64 : T -> u64;
+            }
+
+            //                    The trait self clause
+            //                    vvvvvvvvvvvvvvvvvvvvvv
+            let is_pos (T : Type) (trait_self : ToU64 T) (self : T) : bool =
+              trait_self.to_u64 self > 0
+          ]}
+       *)
   | UnknownId
       (** Used for stored various strings like keywords, definitions which
           should always be in context, etc. and which can't be linked to one
@@ -618,6 +653,7 @@ type extraction_ctx = {
         *)
   trait_decl_id : trait_decl_id option;
       (** If we are extracting a trait declaration, identifies it *)
+  is_provided_method : bool;
 }
 
 (** Debugging function, used when communicating name collisions to the user,
@@ -752,7 +788,6 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | TraitImplId id -> "trait_impl_id: " ^ TraitImplId.to_string id
   | LocalTraitClauseId id ->
       "local_trait_clause_id: " ^ TraitClauseId.to_string id
-  | LocalTraitAssocTypeId type_name -> "local_trait_assoc_type_id: " ^ type_name
   | TraitParentClauseId (id, clause_id) ->
       "trait_parent_clause_id: decl_id:" ^ TraitDeclId.to_string id
       ^ ", clause_id: "
@@ -764,11 +799,14 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | TraitAssocTypeId (id, type_name) ->
       "trait_assoc_type_id: decl_id:" ^ TraitDeclId.to_string id
       ^ ", type name: " ^ type_name
+  | TraitSelfClauseId -> "trait_self_clause"
 
 (** We might not check for collisions for some specific ids (ex.: field names) *)
 let allow_collisions (id : id) : bool =
   match id with
-  | FieldId (_, _) -> !Config.record_fields_short_names
+  | FieldId _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitAssocTypeId _
+    ->
+      !Config.record_fields_short_names
   | _ -> false
 
 let ctx_add (is_opaque : bool) (id : id) (name : string) (ctx : extraction_ctx)
@@ -858,6 +896,10 @@ let ctx_get_assumed_type (id : assumed_ty) (ctx : extraction_ctx) : string =
   let is_opaque = false in
   ctx_get_type is_opaque (Assumed id) ctx
 
+let ctx_get_trait_self_clause (ctx : extraction_ctx) : string =
+  let with_opaque_pre = false in
+  ctx_get with_opaque_pre TraitSelfClauseId ctx
+
 let ctx_get_trait_decl (with_opaque_pre : bool) (id : trait_decl_id)
     (ctx : extraction_ctx) : string =
   ctx_get with_opaque_pre (TraitDeclId id) ctx
@@ -871,11 +913,6 @@ let ctx_get_trait_assoc_type (id : trait_decl_id) (type_name : string)
   let is_opaque = false in
   ctx_get is_opaque (TraitAssocTypeId (id, type_name)) ctx
 
-let ctx_get_local_trait_assoc_type (type_name : string) (ctx : extraction_ctx) :
-    string =
-  let is_opaque = false in
-  ctx_get is_opaque (LocalTraitAssocTypeId type_name) ctx
-
 let ctx_get_trait_parent_clause (id : trait_decl_id) (clause : trait_clause_id)
     (ctx : extraction_ctx) : string =
   let with_opaque_pre = false in
@@ -969,6 +1006,16 @@ let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) :
   let ctx = ctx_add is_opaque (VarId id) name ctx in
   (ctx, name)
 
+(** Generate a unique variable name for the trait self clause and add it to the context *)
+let ctx_add_trait_self_clause (ctx : extraction_ctx) : extraction_ctx * string =
+  let is_opaque = false in
+  let basename = ctx.fmt.trait_self_clause_basename in
+  let name =
+    basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename
+  in
+  let ctx = ctx_add is_opaque TraitSelfClauseId name ctx in
+  (ctx, name)
+
 (** Generate a unique trait clause name and add it to the context *)
 let ctx_add_local_trait_clause (basename : string) (id : TraitClauseId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index f4f59187..790dbe14 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -1007,6 +1007,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       use_dep_ite = !Config.backend = Lean && !Config.extract_decreases_clauses;
       fun_name_info = PureUtils.RegularFunIdMap.empty;
       trait_decl_id = None (* None by default *);
+      is_provided_method = false (* false by default *);
     }
   in
 
-- 
cgit v1.3.1


From 0e0f3d586e7e74003ebff129a1e91b87602467e7 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 16:51:36 +0200
Subject: Make more progress

---
 compiler/Extract.ml     | 19 +++++++++-----
 compiler/ExtractBase.ml |  2 ++
 compiler/Translate.ml   | 70 ++++++++++++++++++++++++++++++++++++-------------
 3 files changed, 67 insertions(+), 24 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index e140ea1c..17f850a3 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -1650,7 +1650,7 @@ let insert_req_space (fmt : F.formatter) (space : bool ref) : unit =
     We add the trait self clause for provided methods (see {!TraitSelfClauseId}).
  *)
 let extract_trait_self_clause (insert_req_space : unit -> unit)
-    (ctx : extraction_ctx) (fmt : F.formatter) (trait_decl : A.trait_decl)
+    (ctx : extraction_ctx) (fmt : F.formatter) (trait_decl : trait_decl)
     (params : string list) : unit =
   insert_req_space ();
   F.pp_print_string fmt "(";
@@ -1673,7 +1673,7 @@ let extract_trait_self_clause (insert_req_space : unit -> unit)
  *)
 let extract_generic_params (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (use_forall : bool) (as_implicits : bool)
-    (space : bool ref option) (trait_decl : A.trait_decl option)
+    (space : bool ref option) (trait_decl : trait_decl option)
     (generics : generic_params) (type_params : string list)
     (cg_params : string list) (trait_clauses : string list) : unit =
   let all_params = List.concat [ type_params; cg_params; trait_clauses ] in
@@ -3111,10 +3111,7 @@ let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx)
   let ctx, trait_decl =
     match def.kind with
     | TraitMethodProvided (decl_id, _) ->
-        let trait_decl =
-          T.TraitDeclId.Map.find decl_id
-            ctx.trans_ctx.trait_decls_context.trait_decls
-        in
+        let trait_decl = T.TraitDeclId.Map.find decl_id ctx.trans_trait_decls in
         let ctx, _ = ctx_add_trait_self_clause ctx in
         let ctx = { ctx with is_provided_method = true } in
         (ctx, Some trait_decl)
@@ -3887,6 +3884,16 @@ let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter)
       (* Add a break to insert lines between declarations *)
       F.pp_print_break fmt 0 0
 
+(** Similar to {!extract_type_decl_register_names} *)
+let extract_trait_decl_register_names (ctx : extraction_ctx) (d : trait_decl) :
+    extraction_ctx =
+  raise (Failure "TODO")
+
+(** Similar to {!extract_type_decl_register_names} *)
+let extract_trait_impl_register_names (ctx : extraction_ctx) (d : trait_impl) :
+    extraction_ctx =
+  raise (Failure "TODO")
+
 (** Extract a trait declaration *)
 let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
     (trait_decl : trait_decl) : unit =
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 251d8b36..2855b3b9 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -654,6 +654,8 @@ type extraction_ctx = {
   trait_decl_id : trait_decl_id option;
       (** If we are extracting a trait declaration, identifies it *)
   is_provided_method : bool;
+  trans_trait_decls : Pure.trait_decl Pure.TraitDeclId.Map.t;
+  trans_trait_impls : Pure.trait_impl Pure.TraitImplId.Map.t;
 }
 
 (** Debugging function, used when communicating name collisions to the user,
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 790dbe14..8df69961 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -301,8 +301,13 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
   (* Return *)
   (pure_forward, pure_backwards)
 
+(* TODO: factor out the return type *)
 let translate_crate_to_pure (crate : A.crate) :
-    trans_ctx * Pure.type_decl list * (bool * pure_fun_translation) list =
+    trans_ctx
+    * Pure.type_decl list
+    * (bool * pure_fun_translation) list
+    * Pure.trait_decl list
+    * Pure.trait_impl list =
   (* Debug *)
   log#ldebug (lazy "translate_crate_to_pure");
 
@@ -368,13 +373,28 @@ let translate_crate_to_pure (crate : A.crate) :
       (A.FunDeclId.Map.values crate.functions)
   in
 
+  (* Translate the trait declarations *)
+  let type_infos = trans_ctx.type_context.type_infos in
+  let trait_decls =
+    List.map
+      (SymbolicToPure.translate_trait_decl type_infos)
+      (T.TraitDeclId.Map.values trans_ctx.trait_decls_context.trait_decls)
+  in
+
+  (* Translate the trait implementations *)
+  let trait_impls =
+    List.map
+      (SymbolicToPure.translate_trait_impl type_infos)
+      (T.TraitImplId.Map.values trans_ctx.trait_impls_context.trait_impls)
+  in
+
   (* Apply the micro-passes *)
   let pure_translations =
     Micro.apply_passes_to_pure_fun_translations trans_ctx pure_translations
   in
 
   (* Return *)
-  (trans_ctx, type_decls, pure_translations)
+  (trans_ctx, type_decls, pure_translations, trait_decls, trait_impls)
 
 (** Extraction context *)
 type gen_ctx = {
@@ -735,14 +755,8 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
 let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
     (ctx : gen_ctx) (trait_decl_id : Pure.trait_decl_id) : unit =
   let trait_decl =
-    T.TraitDeclId.Map.find trait_decl_id
-      ctx.extract_ctx.trans_ctx.trait_decls_context.trait_decls
+    T.TraitDeclId.Map.find trait_decl_id ctx.extract_ctx.trans_trait_decls
   in
-  (* We translate the trait declaration on the fly (note that
-     trait declarations do not directly contain functions, constants,
-     etc.: they simply refer to them). *)
-  let type_infos = ctx.extract_ctx.trans_ctx.type_context.type_infos in
-  let trait_decl = SymbolicToPure.translate_trait_decl type_infos trait_decl in
   let ctx = ctx.extract_ctx in
   let ctx = { ctx with trait_decl_id = Some trait_decl.def_id } in
   Extract.extract_trait_decl ctx fmt trait_decl
@@ -751,14 +765,8 @@ let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
 let export_trait_impl (fmt : Format.formatter) (_config : gen_config)
     (ctx : gen_ctx) (trait_impl_id : Pure.trait_impl_id) : unit =
   let trait_impl =
-    T.TraitImplId.Map.find trait_impl_id
-      ctx.extract_ctx.trans_ctx.trait_impls_context.trait_impls
+    T.TraitImplId.Map.find trait_impl_id ctx.extract_ctx.trans_trait_impls
   in
-  (* We translate the trait implementation on the fly (note that
-     trait implementations do not directly contain functions, constants,
-     etc.: they simply refer to them). *)
-  let type_infos = ctx.extract_ctx.trans_ctx.type_context.type_infos in
-  let trait_impl = SymbolicToPure.translate_trait_impl type_infos trait_impl in
   Extract.extract_trait_impl ctx.extract_ctx fmt trait_impl
 
 (** A generic utility to generate the extracted definitions: as we may want to
@@ -978,7 +986,9 @@ let extract_file (config : gen_config) (ctx : gen_ctx) (fi : extract_file_info)
 let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
     unit =
   (* Translate the module to the pure AST *)
-  let trans_ctx, trans_types, trans_funs = translate_crate_to_pure crate in
+  let trans_ctx, trans_types, trans_funs, trans_trait_decls, trans_trait_impls =
+    translate_crate_to_pure crate
+  in
 
   (* Initialize the extraction context - for now we extract only to F*.
    * We initialize the names map by registering the keywords used in the
@@ -997,6 +1007,18 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
   in
   (* Put everything in the context *)
   let ctx =
+    let trans_trait_decls =
+      T.TraitDeclId.Map.of_list
+        (List.map
+           (fun (d : Pure.trait_decl) -> (d.def_id, d))
+           trans_trait_decls)
+    in
+    let trans_trait_impls =
+      T.TraitImplId.Map.of_list
+        (List.map
+           (fun (d : Pure.trait_impl) -> (d.def_id, d))
+           trans_trait_impls)
+    in
     {
       ExtractBase.trans_ctx;
       names_map;
@@ -1008,6 +1030,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       fun_name_info = PureUtils.RegularFunIdMap.empty;
       trait_decl_id = None (* None by default *);
       is_provided_method = false (* false by default *);
+      trans_trait_decls;
+      trans_trait_impls;
     }
   in
 
@@ -1034,7 +1058,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
   in
   let rec_functions = PureUtils.FunLoopIdSet.of_list rec_functions in
 
-  (* Register unique names for all the top-level types, globals and functions.
+  (* Register unique names for all the top-level types, globals, functions...
    * Note that the order in which we generate the names doesn't matter:
    * we just need to generate a mapping from identifier to name, and make
    * sure there are no name clashes. *)
@@ -1071,6 +1095,16 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       (A.GlobalDeclId.Map.values crate.globals)
   in
 
+  let ctx =
+    List.fold_left Extract.extract_trait_decl_register_names ctx
+      trans_trait_decls
+  in
+
+  let ctx =
+    List.fold_left Extract.extract_trait_impl_register_names ctx
+      trans_trait_impls
+  in
+
   (* Open the output file *)
   (* First compute the filename by replacing the extension and converting the
    * case (rust module names are snake case) *)
-- 
cgit v1.3.1


From 9fe9fc0ab70b8629722d60748bbede554017172c Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 18:59:19 +0200
Subject: Make progress on extracting trait decls and merge gen_ctx and
 extraction_ctx

---
 compiler/Extract.ml     | 150 ++++++++++++++++++++++++++++++++++++++++++--
 compiler/ExtractBase.ml |   4 ++
 compiler/Translate.ml   | 163 +++++++++++++++++++++---------------------------
 3 files changed, 219 insertions(+), 98 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 5eb30daa..f911290e 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -3943,16 +3943,19 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
     trait_decl
   in
   let ctx = ctx_add_trait_decl trait_decl ctx in
+  (* Parent clauses *)
   let ctx =
     List.fold_left
       (fun ctx clause -> ctx_add_trait_parent_clause trait_decl clause ctx)
       ctx generics.trait_clauses
   in
+  (* Constants *)
   let ctx =
     List.fold_left
       (fun ctx (name, (_, _)) -> ctx_add_trait_const trait_decl name ctx)
       ctx consts
   in
+  (* Types *)
   let ctx =
     List.fold_left
       (fun ctx (name, (clauses, _)) ->
@@ -3963,19 +3966,156 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
           ctx clauses)
       ctx types
   in
+  (* Required methods *)
+  (* TODO: for the methods, we need to add fields for the forward/backward functions *)
+  raise (Failure "TODO");
   List.fold_left
-    (fun ctx (name, _) -> ctx_add_trait_method trait_decl name ctx)
+    (fun ctx (name, id) -> ctx_add_trait_method trait_decl name ctx)
     ctx required_methods
 
 (** Similar to {!extract_type_decl_register_names} *)
-let extract_trait_impl_register_names (ctx : extraction_ctx) (d : trait_impl) :
-    extraction_ctx =
+let extract_trait_impl_register_names (ctx : extraction_ctx)
+    (trait_impl : trait_impl) : extraction_ctx =
+  (* For now we do not support overriding provided methods *)
+  assert (trait_impl.provided_methods = []);
+  (* Everything is actually taken care of by {!extract_trait_decl_register_names} *)
+  ctx
+
+(** Small helper.
+
+    The type `ty` is to be understood in a very general sense.
+ *)
+let extract_trait_decl_item (ctx : extraction_ctx) (fmt : F.formatter)
+    (item_name : string) (ty : unit -> unit) : unit =
+  F.pp_print_space fmt ();
+  F.pp_open_vbox fmt ctx.indent_incr;
+  F.pp_print_string fmt item_name;
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt ":";
+  F.pp_print_space fmt ();
+  ty ();
+  F.pp_print_string fmt ";";
+  F.pp_close_box fmt ()
+
+(** Small helper.
+
+    Extract the items for a method in a trait decl.
+ *)
+let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter)
+    (decl : trait_decl) (name : string) (id : fun_decl_id) : unit =
+  let item_name = ctx_get_trait_const decl.def_id name ctx in
+  (* Lookup the definition *)
+  (* let def =
+     FunDeclId.Map.find ctx.
+     in *)
   raise (Failure "TODO")
 
 (** Extract a trait declaration *)
 let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
-    (trait_decl : trait_decl) : unit =
-  raise (Failure "TODO")
+    (decl : trait_decl) : unit =
+  (* Retrieve the trait name *)
+  let with_opaque_pre = false in
+  let decl_name = ctx_get_trait_decl with_opaque_pre decl.def_id ctx in
+  (* Add a break before *)
+  F.pp_print_break fmt 0 0;
+  (* Print a comment to link the extracted type to its original rust definition *)
+  extract_comment fmt [ "[" ^ Print.name_to_string decl.name ^ "]" ];
+  F.pp_print_break fmt 0 0;
+  (* Open two boxes for the definition, so that whenever possible it gets printed on
+   * one line and indents are correct *)
+  F.pp_open_hvbox fmt 0;
+  F.pp_open_vbox fmt ctx.indent_incr;
+
+  (* `struct Trait (....) =` *)
+  (* Open the box for the name + generics *)
+  F.pp_open_vbox fmt ctx.indent_incr;
+  let qualif =
+    Option.get (ctx.fmt.type_decl_kind_to_qualif SingleNonRec (Some Struct))
+  in
+  F.pp_print_string fmt qualif;
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt decl_name;
+
+  (* Print the generics *)
+  (* We ignore the trait clauses, which we extract as *fields* *)
+  let generics = { decl.generics with trait_clauses = [] } in
+  (* Add the type and const generic params - note that we need those bindings only for the
+   * body translation (they are not top-level) *)
+  let ctx, type_params, cg_params, trait_clauses =
+    ctx_add_generic_params generics ctx
+  in
+  let use_forall = false in
+  let as_implicits = false in
+  extract_generic_params ctx fmt TypeDeclId.Set.empty use_forall as_implicits
+    None None decl.generics type_params cg_params trait_clauses;
+
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt "{";
+
+  (* Close the box for the name + generics *)
+  F.pp_close_box fmt ();
+
+  (*
+   * Extract the items
+   *)
+
+  (* The parent clauses *)
+  List.iter
+    (fun clause ->
+      let item_name =
+        ctx_get_trait_parent_clause decl.def_id clause.clause_id ctx
+      in
+      let ty () =
+        extract_trait_clause_type ctx fmt TypeDeclId.Set.empty clause
+      in
+      extract_trait_decl_item ctx fmt item_name ty)
+    decl.generics.trait_clauses;
+
+  (* The constants *)
+  List.iter
+    (fun (name, (ty, _)) ->
+      let item_name = ctx_get_trait_const decl.def_id name ctx in
+      let ty () =
+        let inside = false in
+        extract_ty ctx fmt TypeDeclId.Set.empty inside ty
+      in
+      extract_trait_decl_item ctx fmt item_name ty)
+    decl.consts;
+
+  (* The types *)
+  List.iter
+    (fun (name, (clauses, _)) ->
+      (* Extract the type *)
+      let item_name = ctx_get_trait_type decl.def_id name ctx in
+      let ty () = F.pp_print_string fmt (type_keyword ()) in
+      extract_trait_decl_item ctx fmt item_name ty;
+      (* Extract the clauses *)
+      List.iter
+        (fun clause ->
+          let item_name =
+            ctx_get_trait_item_clause decl.def_id name clause.clause_id ctx
+          in
+          let ty () =
+            extract_trait_clause_type ctx fmt TypeDeclId.Set.empty clause
+          in
+          extract_trait_decl_item ctx fmt item_name ty)
+        clauses)
+    decl.types;
+
+  (* The required methods *)
+  List.iter
+    (fun (name, id) -> extract_trait_decl_method_items ctx fmt decl name id)
+    decl.required_methods;
+
+  (* Close the brackets *)
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt "}";
+
+  (* Close the two outer boxes for the definition *)
+  F.pp_close_box fmt ();
+  F.pp_close_box fmt ();
+  (* Add breaks to insert new lines between definitions *)
+  F.pp_print_break fmt 0 0
 
 (** Extract a trait implementation *)
 let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 7e6a2d40..26940c0c 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -621,6 +621,7 @@ type fun_name_info = { keep_fwd : bool; num_backs : int }
     functions, etc.
  *)
 type extraction_ctx = {
+  crate : A.crate;
   trans_ctx : trans_ctx;
   names_map : names_map;
       (** The map for id to names, where we forbid name collisions
@@ -661,6 +662,9 @@ type extraction_ctx = {
   trait_decl_id : trait_decl_id option;
       (** If we are extracting a trait declaration, identifies it *)
   is_provided_method : bool;
+  trans_types : Pure.type_decl Pure.TypeDeclId.Map.t;
+  trans_funs : (bool * pure_fun_translation) A.FunDeclId.Map.t;
+  functions_with_decreases_clause : PureUtils.FunLoopIdSet.t;
   trans_trait_decls : Pure.trait_decl Pure.TraitDeclId.Map.t;
   trans_trait_impls : Pure.trait_impl Pure.TraitImplId.Map.t;
 }
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 8df69961..b26ce23b 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -396,14 +396,7 @@ let translate_crate_to_pure (crate : A.crate) :
   (* Return *)
   (trans_ctx, type_decls, pure_translations, trait_decls, trait_impls)
 
-(** Extraction context *)
-type gen_ctx = {
-  crate : A.crate;
-  extract_ctx : ExtractBase.extraction_ctx;
-  trans_types : Pure.type_decl Pure.TypeDeclId.Map.t;
-  trans_funs : (bool * pure_fun_translation) A.FunDeclId.Map.t;
-  functions_with_decreases_clause : PureUtils.FunLoopIdSet.t;
-}
+type gen_ctx = ExtractBase.extraction_ctx
 
 type gen_config = {
   extract_types : bool;
@@ -482,9 +475,9 @@ let export_type (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
     || ((not is_opaque) && config.extract_transparent)
   then (
     if extract_decl then
-      Extract.extract_type_decl ctx.extract_ctx fmt type_decl_group kind def;
+      Extract.extract_type_decl ctx fmt type_decl_group kind def;
     if extract_extra_info then
-      Extract.extract_type_decl_extra_info ctx.extract_ctx fmt kind def)
+      Extract.extract_type_decl_extra_info ctx fmt kind def)
 
 (** Export a group of types.
 
@@ -536,7 +529,7 @@ let export_types_group (fmt : Format.formatter) (config : gen_config)
        End
      ]}
   *)
-  Extract.start_type_decl_group ctx.extract_ctx fmt is_rec defs;
+  Extract.start_type_decl_group ctx fmt is_rec defs;
   List.iteri
     (fun i def ->
       let kind = kind_from_index i in
@@ -557,7 +550,7 @@ let export_types_group (fmt : Format.formatter) (config : gen_config)
  *)
 let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
     (id : A.GlobalDeclId.id) : unit =
-  let global_decls = ctx.extract_ctx.trans_ctx.global_context.global_decls in
+  let global_decls = ctx.trans_ctx.global_context.global_decls in
   let global = A.GlobalDeclId.Map.find id global_decls in
   let _, ((body, loop_fwds), body_backs) =
     A.FunDeclId.Map.find global.body_id ctx.trans_funs
@@ -576,7 +569,7 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
        groups are always singletons, so the [extract_global_decl] function
        takes care of generating the delimiters.
     *)
-    Extract.extract_global_decl ctx.extract_ctx fmt global body config.interface
+    Extract.extract_global_decl ctx fmt global body config.interface
 
 (** Utility.
 
@@ -657,14 +650,13 @@ let export_functions_group_scc (fmt : Format.formatter) (config : gen_config)
         then
           Some
             (fun () ->
-              Extract.extract_fun_decl ctx.extract_ctx fmt kind has_decr_clause
-                def)
+              Extract.extract_fun_decl ctx fmt kind has_decr_clause def)
         else None)
       decls
   in
   let extract_defs = List.filter_map (fun x -> x) extract_defs in
   if extract_defs <> [] then (
-    Extract.start_fun_decl_group ctx.extract_ctx fmt is_rec decls;
+    Extract.start_fun_decl_group ctx fmt is_rec decls;
     List.iter (fun f -> f ()) extract_defs;
     Extract.end_fun_decl_group fmt is_rec decls)
 
@@ -700,11 +692,10 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
           if has_decr_clause then
             match !Config.backend with
             | Lean ->
-                Extract.extract_template_lean_termination_and_decreasing
-                  ctx.extract_ctx fmt decl
+                Extract.extract_template_lean_termination_and_decreasing ctx fmt
+                  decl
             | FStar ->
-                Extract.extract_template_fstar_decreases_clause ctx.extract_ctx
-                  fmt decl
+                Extract.extract_template_fstar_decreases_clause ctx fmt decl
             | Coq ->
                 raise (Failure "Coq doesn't have decreases/termination clauses")
             | HOL4 ->
@@ -747,27 +738,21 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   if config.test_trans_unit_functions then
     List.iter
       (fun (keep_fwd, ((fwd, _), _)) ->
-        if keep_fwd then
-          Extract.extract_unit_test_if_unit_fun ctx.extract_ctx fmt fwd)
+        if keep_fwd then Extract.extract_unit_test_if_unit_fun ctx fmt fwd)
       pure_ls
 
 (** Export a trait declaration. *)
 let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
     (ctx : gen_ctx) (trait_decl_id : Pure.trait_decl_id) : unit =
-  let trait_decl =
-    T.TraitDeclId.Map.find trait_decl_id ctx.extract_ctx.trans_trait_decls
-  in
-  let ctx = ctx.extract_ctx in
+  let trait_decl = T.TraitDeclId.Map.find trait_decl_id ctx.trans_trait_decls in
   let ctx = { ctx with trait_decl_id = Some trait_decl.def_id } in
   Extract.extract_trait_decl ctx fmt trait_decl
 
 (** Export a trait implementation. *)
 let export_trait_impl (fmt : Format.formatter) (_config : gen_config)
     (ctx : gen_ctx) (trait_impl_id : Pure.trait_impl_id) : unit =
-  let trait_impl =
-    T.TraitImplId.Map.find trait_impl_id ctx.extract_ctx.trans_trait_impls
-  in
-  Extract.extract_trait_impl ctx.extract_ctx fmt trait_impl
+  let trait_impl = T.TraitImplId.Map.find trait_impl_id ctx.trans_trait_impls in
+  Extract.extract_trait_impl ctx fmt trait_impl
 
 (** A generic utility to generate the extracted definitions: as we may want to
     split the definitions between different files (or not), we can control
@@ -790,7 +775,7 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
     let kind =
       if config.interface then ExtractBase.Declared else ExtractBase.Assumed
     in
-    Extract.extract_state_type fmt ctx.extract_ctx kind
+    Extract.extract_state_type fmt ctx kind
   in
 
   let export_decl_group (dg : A.declaration_group) : unit =
@@ -856,7 +841,7 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
       if config.extract_transparent then "Definitions" else "OpaqueDefs"
     in
     Format.pp_print_break fmt 0 0;
-    Format.pp_open_vbox fmt ctx.extract_ctx.indent_incr;
+    Format.pp_open_vbox fmt ctx.indent_incr;
     Format.pp_print_string fmt ("structure " ^ struct_name ^ " where");
     Format.pp_print_break fmt 0 0);
   List.iter export_decl_group ctx.crate.declarations;
@@ -1005,6 +990,43 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
     mk_formatter_and_names_map trans_ctx crate.name
       variant_concatenate_type_name
   in
+
+  (* We need to compute which functions are recursive, in order to know
+   * whether we should generate a decrease clause or not. *)
+  let rec_functions =
+    List.map
+      (fun (_, ((fwd, loop_fwds), _)) ->
+        let fwd =
+          if fwd.Pure.signature.info.effect_info.is_rec then
+            [ (fwd.def_id, None) ]
+          else []
+        in
+        let loop_fwds =
+          List.map
+            (fun (def : Pure.fun_decl) -> [ (def.def_id, def.loop_id) ])
+            loop_fwds
+        in
+        fwd :: loop_fwds)
+      trans_funs
+  in
+  let rec_functions : PureUtils.fun_loop_id list =
+    List.concat (List.concat rec_functions)
+  in
+  let rec_functions = PureUtils.FunLoopIdSet.of_list rec_functions in
+
+  (* Put the translated definitions in maps *)
+  let trans_types =
+    Pure.TypeDeclId.Map.of_list
+      (List.map (fun (d : Pure.type_decl) -> (d.def_id, d)) trans_types)
+  in
+  let trans_funs =
+    A.FunDeclId.Map.of_list
+      (List.map
+         (fun ((keep_fwd, (fd, bdl)) : bool * pure_fun_translation) ->
+           ((fst fd).def_id, (keep_fwd, (fd, bdl))))
+         trans_funs)
+  in
+
   (* Put everything in the context *)
   let ctx =
     let trans_trait_decls =
@@ -1020,7 +1042,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
            trans_trait_impls)
     in
     {
-      ExtractBase.trans_ctx;
+      ExtractBase.crate;
+      trans_ctx;
       names_map;
       unsafe_names_map = { id_to_name = ExtractBase.IdMap.empty };
       fmt;
@@ -1032,32 +1055,12 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       is_provided_method = false (* false by default *);
       trans_trait_decls;
       trans_trait_impls;
+      trans_types;
+      trans_funs;
+      functions_with_decreases_clause = rec_functions;
     }
   in
 
-  (* We need to compute which functions are recursive, in order to know
-   * whether we should generate a decrease clause or not. *)
-  let rec_functions =
-    List.map
-      (fun (_, ((fwd, loop_fwds), _)) ->
-        let fwd =
-          if fwd.Pure.signature.info.effect_info.is_rec then
-            [ (fwd.def_id, None) ]
-          else []
-        in
-        let loop_fwds =
-          List.map
-            (fun (def : Pure.fun_decl) -> [ (def.def_id, def.loop_id) ])
-            loop_fwds
-        in
-        fwd :: loop_fwds)
-      trans_funs
-  in
-  let rec_functions : PureUtils.fun_loop_id list =
-    List.concat (List.concat rec_functions)
-  in
-  let rec_functions = PureUtils.FunLoopIdSet.of_list rec_functions in
-
   (* Register unique names for all the top-level types, globals, functions...
    * Note that the order in which we generate the names doesn't matter:
    * we just need to generate a mapping from identifier to name, and make
@@ -1065,7 +1068,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
   let ctx =
     List.fold_left
       (fun ctx def -> Extract.extract_type_decl_register_names ctx def)
-      ctx trans_types
+      ctx
+      (Pure.TypeDeclId.Map.values trans_types)
   in
 
   let ctx =
@@ -1087,7 +1091,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
         else
           Extract.extract_fun_decl_register_names ctx keep_fwd gen_decr_clause
             defs)
-      ctx trans_funs
+      ctx
+      (A.FunDeclId.Map.values trans_funs)
   in
 
   let ctx =
@@ -1133,19 +1138,6 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
         (namespace, crate_name, Filename.concat dest_dir crate_name)
   in
 
-  (* Put the translated definitions in maps *)
-  let trans_types =
-    Pure.TypeDeclId.Map.of_list
-      (List.map (fun (d : Pure.type_decl) -> (d.def_id, d)) trans_types)
-  in
-  let trans_funs =
-    A.FunDeclId.Map.of_list
-      (List.map
-         (fun ((keep_fwd, (fd, bdl)) : bool * pure_fun_translation) ->
-           ((fst fd).def_id, (keep_fwd, (fd, bdl))))
-         trans_funs)
-  in
-
   let mkdir_if dest_dir =
     if not (Sys.file_exists dest_dir) then (
       log#linfo (lazy ("Creating missing directory: " ^ dest_dir));
@@ -1201,16 +1193,6 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
   in
 
   (* Extract the file(s) *)
-  let gen_ctx =
-    {
-      crate;
-      extract_ctx = ctx;
-      trans_types;
-      trans_funs;
-      functions_with_decreases_clause = rec_functions;
-    }
-  in
-
   let module_delimiter =
     match !Config.backend with
     | FStar -> "."
@@ -1257,7 +1239,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
 
      (* Check if there are opaque types and functions - in which case we need
       * to split *)
-     let has_opaque_types, has_opaque_funs = module_has_opaque_decls gen_ctx in
+     let has_opaque_types, has_opaque_funs = module_has_opaque_decls ctx in
      let has_opaque_types = has_opaque_types || !Config.use_state in
 
      (* Extract the types *)
@@ -1296,7 +1278,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
          custom_includes = [];
        }
      in
-     extract_file types_config gen_ctx file_info;
+     extract_file types_config ctx file_info;
 
      (* Extract the template clauses *)
      (if needs_clauses_module && !Config.extract_template_decreases_clauses then
@@ -1324,7 +1306,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
             custom_includes = [];
           }
         in
-        extract_file template_clauses_config gen_ctx file_info);
+        extract_file template_clauses_config ctx file_info);
 
      (* Extract the opaque functions, if needed *)
      let opaque_funs_module =
@@ -1359,12 +1341,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
              interface = true;
            }
          in
-         let gen_ctx =
-           {
-             gen_ctx with
-             extract_ctx = { gen_ctx.extract_ctx with use_opaque_pre = false };
-           }
-         in
+         let ctx = { ctx with use_opaque_pre = false } in
          let file_info =
            {
              filename = opaque_filename;
@@ -1378,7 +1355,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
              custom_includes = [ types_module ];
            }
          in
-         extract_file opaque_config gen_ctx file_info;
+         extract_file opaque_config ctx file_info;
          (* Return the additional dependencies *)
          [ opaque_imported_module ])
        else []
@@ -1417,7 +1394,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
            [ types_module ] @ opaque_funs_module @ clauses_module;
        }
      in
-     extract_file fun_config gen_ctx file_info)
+     extract_file fun_config ctx file_info)
    else
      let gen_config =
        {
@@ -1447,7 +1424,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
          custom_includes = [];
        }
      in
-     extract_file gen_config gen_ctx file_info);
+     extract_file gen_config ctx file_info);
 
   (* Generate the build file *)
   match !Config.backend with
-- 
cgit v1.3.1


From 9fb4886f9003f75e8d3aafaf51586ab5f9001744 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 19:18:25 +0200
Subject: Update the type TranslateCore.fun_and_loops

---
 compiler/Extract.ml         |  4 ++--
 compiler/PureMicroPasses.ml | 17 +++++++++--------
 compiler/Translate.ml       | 46 ++++++++++++++++++++++-----------------------
 compiler/TranslateCore.ml   |  2 +-
 4 files changed, 35 insertions(+), 34 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index f911290e..73a081a7 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -2329,7 +2329,7 @@ let extract_state_type (fmt : F.formatter) (ctx : extraction_ctx)
 let extract_fun_decl_register_names (ctx : extraction_ctx) (keep_fwd : bool)
     (has_decreases_clause : fun_decl -> bool) (def : pure_fun_translation) :
     extraction_ctx =
-  let (fwd, loop_fwds), back_ls = def in
+  let { f = fwd; loops = loop_fwds }, back_ls = def in
   (* Register the decrease clauses, if necessary *)
   let register_decreases ctx def =
     if has_decreases_clause def then
@@ -2350,7 +2350,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) (keep_fwd : bool)
   (* Register the backward functions' names *)
   let ctx =
     List.fold_left
-      (fun ctx (back, loop_backs) ->
+      (fun ctx { f = back; loops = loop_backs } ->
         let ctx = register_fun ctx back in
         register_funs ctx loop_backs)
       ctx back_ls
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index 93609695..72e3d05e 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -1461,7 +1461,7 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list =
     altogether.
   *)
 let keep_forward (trans : pure_fun_translation) : bool =
-  let (fwd, _), backs = trans in
+  let { f = fwd; _ }, backs = trans in
   (* Note that at this point, the output types are no longer seen as tuples:
    * they should be lists of length 1. *)
   if
@@ -1908,7 +1908,7 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl =
     [ctx]: used only for printing.
  *)
 let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) :
-    (fun_decl * fun_decl list) option =
+    fun_and_loops option =
   (* Debug *)
   log#ldebug
     (lazy
@@ -1949,9 +1949,9 @@ let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) :
       let def, loops = decompose_loops def in
 
       (* Apply the remaining passes *)
-      let def = apply_end_passes_to_def ctx def in
+      let f = apply_end_passes_to_def ctx def in
       let loops = List.map (apply_end_passes_to_def ctx) loops in
-      Some (def, loops)
+      Some { f; loops }
 
 (** Small utility for {!filter_loop_inputs} *)
 let filter_prefix (keep : bool list) (ls : 'a list) : 'a list =
@@ -1996,10 +1996,11 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
       (List.concat
          (List.concat
             (List.map
-               (fun (_, ((fwd, loops_fwd), backs)) ->
+               (fun (_, ({ f = fwd; loops = loops_fwd }, backs)) ->
                  [ fwd :: loops_fwd ]
                  :: List.map
-                      (fun (back, loops_back) -> [ back :: loops_back ])
+                      (fun { f = back; loops = loops_back } ->
+                        [ back :: loops_back ])
                       backs)
                transl)))
   in
@@ -2246,8 +2247,8 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
   let transl =
     List.map
       (fun (b, (fwd, backs)) ->
-        let filter_fun_and_loops (f, fl) =
-          (filter_in_one f, List.map filter_in_one fl)
+        let filter_fun_and_loops f =
+          { f = filter_in_one f.f; loops = List.map filter_in_one f.loops }
         in
         let fwd = filter_fun_and_loops fwd in
         let backs = List.map filter_fun_and_loops backs in
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index b26ce23b..2f751693 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -439,8 +439,8 @@ let module_has_opaque_decls (ctx : gen_ctx) : bool * bool =
   in
   let has_opaque_funs =
     A.FunDeclId.Map.exists
-      (fun _ ((_, ((t_fwd, _), _)) : bool * pure_fun_translation) ->
-        Option.is_none t_fwd.body)
+      (fun _ ((_, (fwd, _)) : bool * pure_fun_translation) ->
+        Option.is_none fwd.f.body)
       ctx.trans_funs
   in
   (has_opaque_types, has_opaque_funs)
@@ -552,7 +552,7 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
     (id : A.GlobalDeclId.id) : unit =
   let global_decls = ctx.trans_ctx.global_context.global_decls in
   let global = A.GlobalDeclId.Map.find id global_decls in
-  let _, ((body, loop_fwds), body_backs) =
+  let _, ({ f = body; loops = loop_fwds }, body_backs) =
     A.FunDeclId.Map.find global.body_id ctx.trans_funs
   in
   assert (body_backs = []);
@@ -676,7 +676,7 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   (* Extract the decrease clauses template bodies *)
   if config.extract_template_decreases_clauses then
     List.iter
-      (fun (_, ((fwd, loop_fwds), _)) ->
+      (fun (_, (fwd, _)) ->
         (* We only generate decreases clauses for the forward functions, because
            the termination argument should only depend on the forward inputs.
            The backward functions thus use the same decreases clauses as the
@@ -702,8 +702,8 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
                 raise
                   (Failure "HOL4 doesn't have decreases/termination clauses")
         in
-        extract_decrease fwd;
-        List.iter extract_decrease loop_fwds)
+        extract_decrease fwd.f;
+        List.iter extract_decrease fwd.loops)
       pure_ls;
 
   (* Concatenate the function definitions, filtering the useless forward
@@ -711,12 +711,12 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   let decls =
     List.concat
       (List.map
-         (fun (keep_fwd, ((fwd, fwd_loops), (back_ls : fun_and_loops list))) ->
-           let fwd = if keep_fwd then List.append fwd_loops [ fwd ] else [] in
+         (fun (keep_fwd, (fwd, (back_ls : fun_and_loops list))) ->
+           let fwd = if keep_fwd then List.append fwd.loops [ fwd.f ] else [] in
            let back : Pure.fun_decl list =
              List.concat
                (List.map
-                  (fun (back, loop_backs) -> List.append loop_backs [ back ])
+                  (fun back -> List.append back.loops [ back.f ])
                   back_ls)
            in
            List.append fwd back)
@@ -737,8 +737,8 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   (* Insert unit tests if necessary *)
   if config.test_trans_unit_functions then
     List.iter
-      (fun (keep_fwd, ((fwd, _), _)) ->
-        if keep_fwd then Extract.extract_unit_test_if_unit_fun ctx fmt fwd)
+      (fun (keep_fwd, (fwd, _)) ->
+        if keep_fwd then Extract.extract_unit_test_if_unit_fun ctx fmt fwd.f)
       pure_ls
 
 (** Export a trait declaration. *)
@@ -790,7 +790,7 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
            extract their type directly in the records we generate for
            the trait declarations themselves, there is no point in having
            separate type definitions) *)
-        match (fst (fst (snd pure_fun))).Pure.kind with
+        match (fst (snd pure_fun)).f.Pure.kind with
         | TraitMethodDecl _ -> ()
         | _ ->
             (* Translate *)
@@ -995,18 +995,18 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
    * whether we should generate a decrease clause or not. *)
   let rec_functions =
     List.map
-      (fun (_, ((fwd, loop_fwds), _)) ->
-        let fwd =
-          if fwd.Pure.signature.info.effect_info.is_rec then
-            [ (fwd.def_id, None) ]
+      (fun (_, (fwd, _)) ->
+        let fwd_f =
+          if fwd.f.Pure.signature.info.effect_info.is_rec then
+            [ (fwd.f.def_id, None) ]
           else []
         in
         let loop_fwds =
           List.map
             (fun (def : Pure.fun_decl) -> [ (def.def_id, def.loop_id) ])
-            loop_fwds
+            fwd.loops
         in
-        fwd :: loop_fwds)
+        fwd_f :: loop_fwds)
       trans_funs
   in
   let rec_functions : PureUtils.fun_loop_id list =
@@ -1019,11 +1019,11 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
     Pure.TypeDeclId.Map.of_list
       (List.map (fun (d : Pure.type_decl) -> (d.def_id, d)) trans_types)
   in
-  let trans_funs =
+  let trans_funs : (bool * pure_fun_translation) A.FunDeclId.Map.t =
     A.FunDeclId.Map.of_list
       (List.map
-         (fun ((keep_fwd, (fd, bdl)) : bool * pure_fun_translation) ->
-           ((fst fd).def_id, (keep_fwd, (fd, bdl))))
+         (fun ((keep_fwd, (fwd, bdl)) : bool * pure_fun_translation) ->
+           (fwd.f.def_id, (keep_fwd, (fwd, bdl))))
          trans_funs)
   in
 
@@ -1074,10 +1074,10 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
 
   let ctx =
     List.fold_left
-      (fun ctx (keep_fwd, defs) ->
+      (fun ctx ((keep_fwd, defs) : bool * pure_fun_translation) ->
         (* If requested by the user, register termination measures and decreases
            proofs for all the recursive functions *)
-        let fwd_def = fst (fst defs) in
+        let fwd_def = (fst defs).f in
         let gen_decr_clause (def : Pure.fun_decl) =
           !Config.extract_decreases_clauses
           && PureUtils.FunLoopIdSet.mem
diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml
index 34a6434f..9694c95e 100644
--- a/compiler/TranslateCore.ml
+++ b/compiler/TranslateCore.ml
@@ -31,7 +31,7 @@ type trans_ctx = {
   trait_impls_context : trait_impls_context;
 }
 
-type fun_and_loops = Pure.fun_decl * Pure.fun_decl list
+type fun_and_loops = { f : Pure.fun_decl; loops : Pure.fun_decl list }
 type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list
 type pure_fun_translation = fun_and_loops * fun_and_loops list
 
-- 
cgit v1.3.1


From cce09bb0fb64b07b07613d7db59857651e040c20 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 19:29:11 +0200
Subject: Update TranslateCore.pure_fun_translation

---
 compiler/Extract.ml         |  3 ++-
 compiler/ExtractBase.ml     |  2 +-
 compiler/PureMicroPasses.ml | 20 ++++++++++----------
 compiler/Translate.ml       | 40 +++++++++++++++++++---------------------
 compiler/TranslateCore.ml   |  2 +-
 5 files changed, 33 insertions(+), 34 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 73a081a7..5c0a08ad 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -2329,7 +2329,8 @@ let extract_state_type (fmt : F.formatter) (ctx : extraction_ctx)
 let extract_fun_decl_register_names (ctx : extraction_ctx) (keep_fwd : bool)
     (has_decreases_clause : fun_decl -> bool) (def : pure_fun_translation) :
     extraction_ctx =
-  let { f = fwd; loops = loop_fwds }, back_ls = def in
+  let { f = fwd; loops = loop_fwds } = def.fwd in
+  let back_ls = def.backs in
   (* Register the decrease clauses, if necessary *)
   let register_decreases ctx def =
     if has_decreases_clause def then
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 26940c0c..7a21d42d 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1197,7 +1197,7 @@ let ctx_add_fun_decl (trans_group : bool * pure_fun_translation)
   in
   let sg = llbc_def.signature in
   let num_rgs = List.length sg.regions_hierarchy in
-  let keep_fwd, (_, backs) = trans_group in
+  let keep_fwd, { fwd = _; backs } = trans_group in
   let num_backs = List.length backs in
   let rg_info =
     match def.back_id with
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index 72e3d05e..e97a9cd7 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -1461,12 +1461,12 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list =
     altogether.
   *)
 let keep_forward (trans : pure_fun_translation) : bool =
-  let { f = fwd; _ }, backs = trans in
+  let { fwd; backs } = trans in
   (* Note that at this point, the output types are no longer seen as tuples:
    * they should be lists of length 1. *)
   if
     !Config.filter_useless_functions
-    && fwd.signature.output = mk_result_ty mk_unit_ty
+    && fwd.f.signature.output = mk_result_ty mk_unit_ty
     && backs <> []
   then false
   else true
@@ -1996,8 +1996,8 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
       (List.concat
          (List.concat
             (List.map
-               (fun (_, ({ f = fwd; loops = loops_fwd }, backs)) ->
-                 [ fwd :: loops_fwd ]
+               (fun (_, { fwd; backs }) ->
+                 [ fwd.f :: fwd.loops ]
                  :: List.map
                       (fun { f = back; loops = loops_back } ->
                         [ back :: loops_back ])
@@ -2246,13 +2246,13 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
   in
   let transl =
     List.map
-      (fun (b, (fwd, backs)) ->
+      (fun (b, { fwd; backs }) ->
         let filter_fun_and_loops f =
           { f = filter_in_one f.f; loops = List.map filter_in_one f.loops }
         in
         let fwd = filter_fun_and_loops fwd in
         let backs = List.map filter_fun_and_loops backs in
-        (b, (fwd, backs)))
+        (b, { fwd; backs }))
       transl
   in
 
@@ -2278,10 +2278,10 @@ let apply_passes_to_pure_fun_translations (ctx : trans_ctx)
   let apply_to_one (trans : fun_decl * fun_decl list) :
       bool * pure_fun_translation =
     (* Apply the passes to the individual functions *)
-    let forward, backwards = trans in
-    let forward = Option.get (apply_passes_to_def ctx forward) in
-    let backwards = List.filter_map (apply_passes_to_def ctx) backwards in
-    let trans = (forward, backwards) in
+    let fwd, backs = trans in
+    let fwd = Option.get (apply_passes_to_def ctx fwd) in
+    let backs = List.filter_map (apply_passes_to_def ctx) backs in
+    let trans = { fwd; backs } in
     (* Compute whether we need to filter the forward function or not *)
     (keep_forward trans, trans)
   in
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 2f751693..7122e462 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -439,8 +439,8 @@ let module_has_opaque_decls (ctx : gen_ctx) : bool * bool =
   in
   let has_opaque_funs =
     A.FunDeclId.Map.exists
-      (fun _ ((_, (fwd, _)) : bool * pure_fun_translation) ->
-        Option.is_none fwd.f.body)
+      (fun _ ((_, trans) : bool * pure_fun_translation) ->
+        Option.is_none trans.fwd.f.body)
       ctx.trans_funs
   in
   (has_opaque_types, has_opaque_funs)
@@ -552,11 +552,10 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
     (id : A.GlobalDeclId.id) : unit =
   let global_decls = ctx.trans_ctx.global_context.global_decls in
   let global = A.GlobalDeclId.Map.find id global_decls in
-  let _, ({ f = body; loops = loop_fwds }, body_backs) =
-    A.FunDeclId.Map.find global.body_id ctx.trans_funs
-  in
-  assert (body_backs = []);
-  assert (loop_fwds = []);
+  let _, trans = A.FunDeclId.Map.find global.body_id ctx.trans_funs in
+  assert (trans.fwd.loops = []);
+  assert (trans.backs = []);
+  let body = trans.fwd.f in
 
   let is_opaque = Option.is_none body.Pure.body in
   if
@@ -676,7 +675,7 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   (* Extract the decrease clauses template bodies *)
   if config.extract_template_decreases_clauses then
     List.iter
-      (fun (_, (fwd, _)) ->
+      (fun (_, { fwd; _ }) ->
         (* We only generate decreases clauses for the forward functions, because
            the termination argument should only depend on the forward inputs.
            The backward functions thus use the same decreases clauses as the
@@ -711,15 +710,13 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   let decls =
     List.concat
       (List.map
-         (fun (keep_fwd, (fwd, (back_ls : fun_and_loops list))) ->
+         (fun (keep_fwd, { fwd; backs }) ->
            let fwd = if keep_fwd then List.append fwd.loops [ fwd.f ] else [] in
-           let back : Pure.fun_decl list =
+           let backs : Pure.fun_decl list =
              List.concat
-               (List.map
-                  (fun back -> List.append back.loops [ back.f ])
-                  back_ls)
+               (List.map (fun back -> List.append back.loops [ back.f ]) backs)
            in
-           List.append fwd back)
+           List.append fwd backs)
          pure_ls)
   in
 
@@ -737,8 +734,9 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   (* Insert unit tests if necessary *)
   if config.test_trans_unit_functions then
     List.iter
-      (fun (keep_fwd, (fwd, _)) ->
-        if keep_fwd then Extract.extract_unit_test_if_unit_fun ctx fmt fwd.f)
+      (fun (keep_fwd, trans) ->
+        if keep_fwd then
+          Extract.extract_unit_test_if_unit_fun ctx fmt trans.fwd.f)
       pure_ls
 
 (** Export a trait declaration. *)
@@ -790,7 +788,7 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
            extract their type directly in the records we generate for
            the trait declarations themselves, there is no point in having
            separate type definitions) *)
-        match (fst (snd pure_fun)).f.Pure.kind with
+        match (snd pure_fun).fwd.f.Pure.kind with
         | TraitMethodDecl _ -> ()
         | _ ->
             (* Translate *)
@@ -995,7 +993,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
    * whether we should generate a decrease clause or not. *)
   let rec_functions =
     List.map
-      (fun (_, (fwd, _)) ->
+      (fun (_, { fwd; _ }) ->
         let fwd_f =
           if fwd.f.Pure.signature.info.effect_info.is_rec then
             [ (fwd.f.def_id, None) ]
@@ -1022,8 +1020,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
   let trans_funs : (bool * pure_fun_translation) A.FunDeclId.Map.t =
     A.FunDeclId.Map.of_list
       (List.map
-         (fun ((keep_fwd, (fwd, bdl)) : bool * pure_fun_translation) ->
-           (fwd.f.def_id, (keep_fwd, (fwd, bdl))))
+         (fun ((keep_fwd, { fwd; backs }) : bool * pure_fun_translation) ->
+           (fwd.f.def_id, (keep_fwd, { fwd; backs })))
          trans_funs)
   in
 
@@ -1077,7 +1075,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       (fun ctx ((keep_fwd, defs) : bool * pure_fun_translation) ->
         (* If requested by the user, register termination measures and decreases
            proofs for all the recursive functions *)
-        let fwd_def = (fst defs).f in
+        let fwd_def = defs.fwd.f in
         let gen_decr_clause (def : Pure.fun_decl) =
           !Config.extract_decreases_clauses
           && PureUtils.FunLoopIdSet.mem
diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml
index 9694c95e..9fd27c59 100644
--- a/compiler/TranslateCore.ml
+++ b/compiler/TranslateCore.ml
@@ -33,7 +33,7 @@ type trans_ctx = {
 
 type fun_and_loops = { f : Pure.fun_decl; loops : Pure.fun_decl list }
 type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list
-type pure_fun_translation = fun_and_loops * fun_and_loops list
+type pure_fun_translation = { fwd : fun_and_loops; backs : fun_and_loops list }
 
 let trans_ctx_to_type_formatter (ctx : trans_ctx)
     (type_params : Pure.type_var list)
-- 
cgit v1.3.1


From dfcbfab4030be2f03b159a4b298ed75ac2f236ae Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 19:41:03 +0200
Subject: Add the keep_fwd field in TranslateCore.pure_fun_translation

---
 compiler/ExtractBase.ml     |  2 +-
 compiler/PureMicroPasses.ml | 28 +++++++++++++---------------
 compiler/Translate.ml       | 34 ++++++++++++++++------------------
 compiler/TranslateCore.ml   | 13 ++++++++++++-
 4 files changed, 42 insertions(+), 35 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 7a21d42d..885467c2 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -663,7 +663,7 @@ type extraction_ctx = {
       (** If we are extracting a trait declaration, identifies it *)
   is_provided_method : bool;
   trans_types : Pure.type_decl Pure.TypeDeclId.Map.t;
-  trans_funs : (bool * pure_fun_translation) A.FunDeclId.Map.t;
+  trans_funs : pure_fun_translation A.FunDeclId.Map.t;
   functions_with_decreases_clause : PureUtils.FunLoopIdSet.t;
   trans_trait_decls : Pure.trait_decl Pure.TraitDeclId.Map.t;
   trans_trait_impls : Pure.trait_impl Pure.TraitImplId.Map.t;
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index e97a9cd7..6c9c3a91 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -1460,8 +1460,7 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list =
     In such situation, we can remove the forward function definition
     altogether.
   *)
-let keep_forward (trans : pure_fun_translation) : bool =
-  let { fwd; backs } = trans in
+let keep_forward (fwd : fun_and_loops) (backs : fun_and_loops list) : bool =
   (* Note that at this point, the output types are no longer seen as tuples:
    * they should be lists of length 1. *)
   if
@@ -1977,8 +1976,8 @@ end
 module FunLoopIdMap = Collections.MakeMap (FunLoopIdOrderedType)
 
 (** Filter the useless loop input parameters. *)
-let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
-    (bool * pure_fun_translation) list =
+let filter_loop_inputs (transl : pure_fun_translation list) :
+    pure_fun_translation list =
   (* We need to explore groups of mutually recursive functions. In order
      to compute which parameters are useless, we need to explore the
      functions by groups of mutually recursive definitions.
@@ -1996,7 +1995,7 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
       (List.concat
          (List.concat
             (List.map
-               (fun (_, { fwd; backs }) ->
+               (fun { fwd; backs; _ } ->
                  [ fwd.f :: fwd.loops ]
                  :: List.map
                       (fun { f = back; loops = loops_back } ->
@@ -2246,13 +2245,13 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
   in
   let transl =
     List.map
-      (fun (b, { fwd; backs }) ->
+      (fun trans ->
         let filter_fun_and_loops f =
           { f = filter_in_one f.f; loops = List.map filter_in_one f.loops }
         in
-        let fwd = filter_fun_and_loops fwd in
-        let backs = List.map filter_fun_and_loops backs in
-        (b, { fwd; backs }))
+        let fwd = filter_fun_and_loops trans.fwd in
+        let backs = List.map filter_fun_and_loops trans.backs in
+        { trans with fwd; backs })
       transl
   in
 
@@ -2273,18 +2272,17 @@ let filter_loop_inputs (transl : (bool * pure_fun_translation) list) :
     but convenient.
  *)
 let apply_passes_to_pure_fun_translations (ctx : trans_ctx)
-    (transl : (fun_decl * fun_decl list) list) :
-    (bool * pure_fun_translation) list =
-  let apply_to_one (trans : fun_decl * fun_decl list) :
-      bool * pure_fun_translation =
+    (transl : (fun_decl * fun_decl list) list) : pure_fun_translation list =
+  let apply_to_one (trans : fun_decl * fun_decl list) : pure_fun_translation =
     (* Apply the passes to the individual functions *)
     let fwd, backs = trans in
     let fwd = Option.get (apply_passes_to_def ctx fwd) in
     let backs = List.filter_map (apply_passes_to_def ctx) backs in
-    let trans = { fwd; backs } in
     (* Compute whether we need to filter the forward function or not *)
-    (keep_forward trans, trans)
+    let keep_fwd = keep_forward fwd backs in
+    { keep_fwd; fwd; backs }
   in
+
   let transl = List.map apply_to_one transl in
 
   (* Filter the useless inputs in the loop functions *)
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 7122e462..835edd46 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -305,7 +305,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
 let translate_crate_to_pure (crate : A.crate) :
     trans_ctx
     * Pure.type_decl list
-    * (bool * pure_fun_translation) list
+    * pure_fun_translation list
     * Pure.trait_decl list
     * Pure.trait_impl list =
   (* Debug *)
@@ -439,8 +439,7 @@ let module_has_opaque_decls (ctx : gen_ctx) : bool * bool =
   in
   let has_opaque_funs =
     A.FunDeclId.Map.exists
-      (fun _ ((_, trans) : bool * pure_fun_translation) ->
-        Option.is_none trans.fwd.f.body)
+      (fun _ (trans : pure_fun_translation) -> Option.is_none trans.fwd.f.body)
       ctx.trans_funs
   in
   (has_opaque_types, has_opaque_funs)
@@ -552,7 +551,7 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
     (id : A.GlobalDeclId.id) : unit =
   let global_decls = ctx.trans_ctx.global_context.global_decls in
   let global = A.GlobalDeclId.Map.find id global_decls in
-  let _, trans = A.FunDeclId.Map.find global.body_id ctx.trans_funs in
+  let trans = A.FunDeclId.Map.find global.body_id ctx.trans_funs in
   assert (trans.fwd.loops = []);
   assert (trans.backs = []);
   let body = trans.fwd.f in
@@ -665,7 +664,7 @@ let export_functions_group_scc (fmt : Format.formatter) (config : gen_config)
     check if the forward and backward functions are mutually recursive.
  *)
 let export_functions_group (fmt : Format.formatter) (config : gen_config)
-    (ctx : gen_ctx) (pure_ls : (bool * pure_fun_translation) list) : unit =
+    (ctx : gen_ctx) (pure_ls : pure_fun_translation list) : unit =
   (* Utility to check a function has a decrease clause *)
   let has_decreases_clause (def : Pure.fun_decl) : bool =
     PureUtils.FunLoopIdSet.mem (def.def_id, def.loop_id)
@@ -675,7 +674,7 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   (* Extract the decrease clauses template bodies *)
   if config.extract_template_decreases_clauses then
     List.iter
-      (fun (_, { fwd; _ }) ->
+      (fun { fwd; _ } ->
         (* We only generate decreases clauses for the forward functions, because
            the termination argument should only depend on the forward inputs.
            The backward functions thus use the same decreases clauses as the
@@ -710,7 +709,7 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   let decls =
     List.concat
       (List.map
-         (fun (keep_fwd, { fwd; backs }) ->
+         (fun { keep_fwd; fwd; backs } ->
            let fwd = if keep_fwd then List.append fwd.loops [ fwd.f ] else [] in
            let backs : Pure.fun_decl list =
              List.concat
@@ -734,8 +733,8 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
   (* Insert unit tests if necessary *)
   if config.test_trans_unit_functions then
     List.iter
-      (fun (keep_fwd, trans) ->
-        if keep_fwd then
+      (fun trans ->
+        if trans.keep_fwd then
           Extract.extract_unit_test_if_unit_fun ctx fmt trans.fwd.f)
       pure_ls
 
@@ -788,7 +787,7 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
            extract their type directly in the records we generate for
            the trait declarations themselves, there is no point in having
            separate type definitions) *)
-        match (snd pure_fun).fwd.f.Pure.kind with
+        match pure_fun.fwd.f.Pure.kind with
         | TraitMethodDecl _ -> ()
         | _ ->
             (* Translate *)
@@ -993,7 +992,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
    * whether we should generate a decrease clause or not. *)
   let rec_functions =
     List.map
-      (fun (_, { fwd; _ }) ->
+      (fun { fwd; _ } ->
         let fwd_f =
           if fwd.f.Pure.signature.info.effect_info.is_rec then
             [ (fwd.f.def_id, None) ]
@@ -1017,11 +1016,10 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
     Pure.TypeDeclId.Map.of_list
       (List.map (fun (d : Pure.type_decl) -> (d.def_id, d)) trans_types)
   in
-  let trans_funs : (bool * pure_fun_translation) A.FunDeclId.Map.t =
+  let trans_funs : pure_fun_translation A.FunDeclId.Map.t =
     A.FunDeclId.Map.of_list
       (List.map
-         (fun ((keep_fwd, { fwd; backs }) : bool * pure_fun_translation) ->
-           (fwd.f.def_id, (keep_fwd, { fwd; backs })))
+         (fun (trans : pure_fun_translation) -> (trans.fwd.f.def_id, trans))
          trans_funs)
   in
 
@@ -1072,10 +1070,10 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
 
   let ctx =
     List.fold_left
-      (fun ctx ((keep_fwd, defs) : bool * pure_fun_translation) ->
+      (fun ctx (trans : pure_fun_translation) ->
         (* If requested by the user, register termination measures and decreases
            proofs for all the recursive functions *)
-        let fwd_def = defs.fwd.f in
+        let fwd_def = trans.fwd.f in
         let gen_decr_clause (def : Pure.fun_decl) =
           !Config.extract_decreases_clauses
           && PureUtils.FunLoopIdSet.mem
@@ -1087,8 +1085,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
         let is_global = fwd_def.Pure.is_global_decl_body in
         if is_global then ctx
         else
-          Extract.extract_fun_decl_register_names ctx keep_fwd gen_decr_clause
-            defs)
+          Extract.extract_fun_decl_register_names ctx trans.keep_fwd
+            gen_decr_clause trans)
       ctx
       (A.FunDeclId.Map.values trans_funs)
   in
diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml
index 9fd27c59..f31dc458 100644
--- a/compiler/TranslateCore.ml
+++ b/compiler/TranslateCore.ml
@@ -33,7 +33,18 @@ type trans_ctx = {
 
 type fun_and_loops = { f : Pure.fun_decl; loops : Pure.fun_decl list }
 type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list
-type pure_fun_translation = { fwd : fun_and_loops; backs : fun_and_loops list }
+
+type pure_fun_translation = {
+  keep_fwd : bool;
+      (** Should we extract the forward function?
+
+          If the forward function returns `()` and there is exactly one
+          backward function, we may merge the forward into the backward
+          function and thus don't extract the forward function)?
+       *)
+  fwd : fun_and_loops;
+  backs : fun_and_loops list;
+}
 
 let trans_ctx_to_type_formatter (ctx : trans_ctx)
     (type_params : Pure.type_var list)
-- 
cgit v1.3.1


From e090e09725e3fd5c7f2a92813955ce2d81560227 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 19:44:39 +0200
Subject: Do more cleanup

---
 compiler/Extract.ml     | 8 +++++---
 compiler/ExtractBase.ml | 6 +++---
 compiler/Translate.ml   | 4 +---
 3 files changed, 9 insertions(+), 9 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 5c0a08ad..204fee04 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -2326,7 +2326,7 @@ let extract_state_type (fmt : F.formatter) (ctx : extraction_ctx)
 (** Compute the names for all the pure functions generated from a rust function
     (forward function and backward functions).
  *)
-let extract_fun_decl_register_names (ctx : extraction_ctx) (keep_fwd : bool)
+let extract_fun_decl_register_names (ctx : extraction_ctx)
     (has_decreases_clause : fun_decl -> bool) (def : pure_fun_translation) :
     extraction_ctx =
   let { f = fwd; loops = loop_fwds } = def.fwd in
@@ -2344,7 +2344,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) (keep_fwd : bool)
     else ctx
   in
   let ctx = List.fold_left register_decreases ctx (fwd :: loop_fwds) in
-  let register_fun ctx f = ctx_add_fun_decl (keep_fwd, def) f ctx in
+  let register_fun ctx f = ctx_add_fun_decl def f ctx in
   let register_funs ctx fl = List.fold_left register_fun ctx fl in
   (* Register the forward functions' names *)
   let ctx = register_funs ctx (fwd :: loop_fwds) in
@@ -3971,7 +3971,9 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
   (* TODO: for the methods, we need to add fields for the forward/backward functions *)
   raise (Failure "TODO");
   List.fold_left
-    (fun ctx (name, id) -> ctx_add_trait_method trait_decl name ctx)
+    (fun ctx (name, id) ->
+      (* We add one field per required forward/backward function *)
+      ctx_add_trait_method trait_decl name ctx)
     ctx required_methods
 
 (** Similar to {!extract_type_decl_register_names} *)
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 885467c2..17f5b693 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1185,8 +1185,8 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
   let ctx = ctx_add is_opaque body (name ^ "_body") ctx in
   ctx
 
-let ctx_add_fun_decl (trans_group : bool * pure_fun_translation)
-    (def : fun_decl) (ctx : extraction_ctx) : extraction_ctx =
+let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
+    (ctx : extraction_ctx) : extraction_ctx =
   (* Sanity check: the function should not be a global body - those are handled
    * separately *)
   assert (not def.is_global_decl_body);
@@ -1197,7 +1197,7 @@ let ctx_add_fun_decl (trans_group : bool * pure_fun_translation)
   in
   let sg = llbc_def.signature in
   let num_rgs = List.length sg.regions_hierarchy in
-  let keep_fwd, { fwd = _; backs } = trans_group in
+  let { keep_fwd; fwd = _; backs } = trans_group in
   let num_backs = List.length backs in
   let rg_info =
     match def.back_id with
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 835edd46..a4041751 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -1084,9 +1084,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
          * those are handled later *)
         let is_global = fwd_def.Pure.is_global_decl_body in
         if is_global then ctx
-        else
-          Extract.extract_fun_decl_register_names ctx trans.keep_fwd
-            gen_decr_clause trans)
+        else Extract.extract_fun_decl_register_names ctx gen_decr_clause trans)
       ctx
       (A.FunDeclId.Map.values trans_funs)
   in
-- 
cgit v1.3.1


From 8b18c0da053e069b5a2d9fbf06f45eae2f05a029 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 7 Sep 2023 15:28:06 +0200
Subject: Map some globals like u32::MAX to standard definitions

---
 backends/lean/Base/Primitives/Scalar.lean | 42 ++++++++++++++++++++++++++
 compiler/Driver.ml                        | 14 ---------
 compiler/Extract.ml                       |  8 ++++-
 compiler/ExtractAssumed.ml                | 49 +++++++++++++++++++++++++++++++
 compiler/ExtractBase.ml                   | 22 ++++++++++----
 compiler/LlbcAstUtils.ml                  | 20 +++++++++++++
 compiler/Translate.ml                     | 36 +++++++++++------------
 compiler/dune                             |  1 +
 8 files changed, 154 insertions(+), 38 deletions(-)
 create mode 100644 compiler/ExtractAssumed.ml

(limited to 'compiler/Translate.ml')

diff --git a/backends/lean/Base/Primitives/Scalar.lean b/backends/lean/Base/Primitives/Scalar.lean
index ffc969f3..fa5a63cd 100644
--- a/backends/lean/Base/Primitives/Scalar.lean
+++ b/backends/lean/Base/Primitives/Scalar.lean
@@ -230,6 +230,20 @@ def Scalar.cMax (ty : ScalarTy) : Int :=
   | .Usize => Scalar.max .U32
   | _ => Scalar.max ty
 
+theorem Scalar.min_lt_max (ty : ScalarTy) : Scalar.min ty < Scalar.max ty := by
+  cases ty <;> simp [Scalar.min, Scalar.max]
+  . simp [Isize.min, Isize.max]
+    have h1 := Isize.refined_min.property
+    have h2 := Isize.refined_max.property
+    cases h1 <;> cases h2 <;> simp [*]
+  . simp [Usize.max]
+    have h := Usize.refined_max.property
+    cases h <;> simp [*]
+
+theorem Scalar.min_le_max (ty : ScalarTy) : Scalar.min ty ≤ Scalar.max ty := by
+  have := Scalar.min_lt_max ty
+  int_tac
+
 theorem Scalar.cMin_bound ty : Scalar.min ty ≤ Scalar.cMin ty := by
   cases ty <;> simp [Scalar.min, Scalar.max, Scalar.cMin, Scalar.cMax] at *
   have h := Isize.refined_min.property
@@ -395,6 +409,34 @@ def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Re
 @[reducible] def U64   := Scalar .U64
 @[reducible] def U128  := Scalar .U128
 
+-- TODO: reducible?
+@[reducible] def isize_min : Isize := Scalar.ofInt Isize.min (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Isize))
+@[reducible] def isize_max : Isize := Scalar.ofInt Isize.max (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Isize))
+@[reducible] def i8_min : I8 := Scalar.ofInt I8.min
+@[reducible] def i8_max : I8 := Scalar.ofInt I8.max
+@[reducible] def i16_min : I16 := Scalar.ofInt I16.min
+@[reducible] def i16_max : I16 := Scalar.ofInt I16.max
+@[reducible] def i32_min : I32 := Scalar.ofInt I32.min
+@[reducible] def i32_max : I32 := Scalar.ofInt I32.max
+@[reducible] def i64_min : I64 := Scalar.ofInt I64.min
+@[reducible] def i64_max : I64 := Scalar.ofInt I64.max
+@[reducible] def i128_min : I128 := Scalar.ofInt I128.min
+@[reducible] def i128_max : I128 := Scalar.ofInt I128.max
+
+-- TODO: reducible?
+@[reducible] def usize_min : Usize := Scalar.ofInt Usize.min
+@[reducible] def usize_max : Usize := Scalar.ofInt Usize.max (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Usize))
+@[reducible] def u8_min : U8 := Scalar.ofInt U8.min
+@[reducible] def u8_max : U8 := Scalar.ofInt U8.max
+@[reducible] def u16_min : U16 := Scalar.ofInt U16.min
+@[reducible] def u16_max : U16 := Scalar.ofInt U16.max
+@[reducible] def u32_min : U32 := Scalar.ofInt U32.min
+@[reducible] def u32_max : U32 := Scalar.ofInt U32.max
+@[reducible] def u64_min : U64 := Scalar.ofInt U64.min
+@[reducible] def u64_max : U64 := Scalar.ofInt U64.max
+@[reducible] def u128_min : U128 := Scalar.ofInt U128.min
+@[reducible] def u128_max : U128 := Scalar.ofInt U128.max
+
 -- TODO: below: not sure this is the best way.
 -- Should we rather overload operations like +, -, etc.?
 -- Also, it is possible to automate the generation of those definitions
diff --git a/compiler/Driver.ml b/compiler/Driver.ml
index d88962db..0fde1d74 100644
--- a/compiler/Driver.ml
+++ b/compiler/Driver.ml
@@ -222,20 +222,6 @@ let () =
       in
       if has_loops then log#lwarning (lazy "Support for loops is experimental");
 
-      (* If we target Lean, we request the crates to be split into several files
-         whenever there are opaque functions *)
-      if
-        !backend = Lean
-        && A.FunDeclId.Map.exists
-             (fun _ (d : A.fun_decl) -> d.body = None)
-             m.functions
-        && not !split_files
-      then (
-        log#error
-          "For Lean, we request the -split-file option whenever using opaque \
-           functions";
-        fail ());
-
       (* We don't support mutually recursive definitions with decreases clauses in Lean *)
       if
         !backend = Lean && !extract_decreases_clauses
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index de6c2fc8..74540787 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -8,6 +8,7 @@ open Pure
 open PureUtils
 open TranslateCore
 open ExtractBase
+open ExtractAssumed
 open StringUtils
 open Config
 module F = Format
@@ -3852,8 +3853,13 @@ let extract_global_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter)
   (* Print the type *)
   F.pp_open_hovbox fmt 0;
   extract_ty ctx fmt TypeDeclId.Set.empty false ty;
+  (* Close the definition *)
+  F.pp_print_string fmt ")";
+  F.pp_close_box fmt ();
+  (* Close the definition box *)
   F.pp_close_box fmt ();
-  (* Close the definition boxe *) F.pp_close_box fmt ()
+  (* Add a line *)
+  F.pp_print_space fmt ()
 
 (** Extract a global declaration.
 
diff --git a/compiler/ExtractAssumed.ml b/compiler/ExtractAssumed.ml
new file mode 100644
index 00000000..bbcedb2b
--- /dev/null
+++ b/compiler/ExtractAssumed.ml
@@ -0,0 +1,49 @@
+(** This file declares external identifiers that we catch to map them to
+    definitions coming from the standard libraries in our backends. *)
+
+open Utils
+open StringUtils
+open Names
+
+type simple_name = string list [@@deriving show, ord]
+
+let name_to_simple_name (s : name) : simple_name =
+  (* We simply ignore the disambiguators *)
+  List.filter_map (function Ident id -> Some id | Disambiguator _ -> None) s
+
+(** Small helper which cuts a string at the occurrences of "::" *)
+let string_to_simple_name (s : string) : simple_name =
+  (* No function to split by using string separator?? *)
+  let name = String.split_on_char ':' s in
+  List.filter (fun s -> s <> "") name
+
+module SimpleNameOrd = struct
+  type t = simple_name
+
+  let compare = compare_simple_name
+  let to_string = show_simple_name
+  let pp_t = pp_simple_name
+  let show_t = show_simple_name
+end
+
+module SimpleNameMap = Collections.MakeMap (SimpleNameOrd)
+
+let assumed_globals : (string * string) list =
+  [
+    ("core::num::usize::MAX", "usize_max");
+    ("core::num::u8::MAX", "u8_max");
+    ("core::num::u16::MAX", "u16_max");
+    ("core::num::u32::MAX", "u32_max");
+    ("core::num::u64::MAX", "u64_max");
+    ("core::num::u128::MAX", "u128_max");
+    ("core::num::isize::MAX", "isize_max");
+    ("core::num::i8::MAX", "i8_max");
+    ("core::num::i16::MAX", "i16_max");
+    ("core::num::i32::MAX", "i32_max");
+    ("core::num::i64::MAX", "i64_max");
+    ("core::num::i128::MAX", "i128_max");
+  ]
+
+let assumed_globals_map : string SimpleNameMap.t =
+  SimpleNameMap.of_list
+    (List.map (fun (x, y) -> (string_to_simple_name x, y)) assumed_globals)
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 435aa10c..9c9e08a5 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -5,6 +5,7 @@ open TranslateCore
 module C = Contexts
 module RegionVarId = T.RegionVarId
 module F = Format
+open ExtractAssumed
 
 (** The local logger *)
 let log = L.pure_to_extract_log
@@ -1198,12 +1199,23 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
     extraction_ctx =
   (* TODO: update once the body id can be an option *)
   let is_opaque = false in
-  let name = ctx.fmt.global_name def.name in
   let decl = GlobalId def.def_id in
-  let body = FunId (FromLlbc (Regular def.body_id, None, None)) in
-  let ctx = ctx_add is_opaque decl (name ^ "_c") ctx in
-  let ctx = ctx_add is_opaque body (name ^ "_body") ctx in
-  ctx
+
+  (* Check if the global corresponds to an assumed global that we should map
+     to a custom definition in our standard library (for instance, happens
+     with "core::num::usize::MAX") *)
+  let sname = name_to_simple_name def.name in
+  match SimpleNameMap.find_opt sname assumed_globals_map with
+  | Some name ->
+      (* Yes: register the custom binding *)
+      ctx_add is_opaque decl name ctx
+  | None ->
+      (* Not the case: "standard" registration *)
+      let name = ctx.fmt.global_name def.name in
+      let body = FunId (FromLlbc (Regular def.body_id, None, None)) in
+      let ctx = ctx_add is_opaque decl (name ^ "_c") ctx in
+      let ctx = ctx_add is_opaque body (name ^ "_body") ctx in
+      ctx
 
 let ctx_compute_fun_name (trans_group : pure_fun_translation) (def : fun_decl)
     (ctx : extraction_ctx) : string =
diff --git a/compiler/LlbcAstUtils.ml b/compiler/LlbcAstUtils.ml
index 1111c297..8c8bbabe 100644
--- a/compiler/LlbcAstUtils.ml
+++ b/compiler/LlbcAstUtils.ml
@@ -12,3 +12,23 @@ let lookup_fun_name (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
   match fun_id with
   | Regular id -> (FunDeclId.Map.find id fun_decls).name
   | Assumed aid -> Assumed.get_assumed_name aid
+
+(** Return the opaque declarations found in the crate.
+
+    Remark: the list of functions also contains the list of opaque global bodies.
+ *)
+let crate_get_opaque_decls (k : crate) : T.type_decl list * fun_decl list =
+  let open ExtractAssumed in
+  let is_opaque_fun (d : fun_decl) : bool =
+    let sname = name_to_simple_name d.name in
+    d.body = None && not (SimpleNameMap.mem sname assumed_globals_map)
+  in
+  let is_opaque_type (d : T.type_decl) : bool = d.kind = T.Opaque in
+  (* Note that by checking the function bodies we also the globals *)
+  ( List.filter is_opaque_type (T.TypeDeclId.Map.values k.types),
+    List.filter is_opaque_fun (FunDeclId.Map.values k.functions) )
+
+(** Return true if the crate contains opaque declarations, ignoring the assumed
+    definitions. *)
+let crate_has_opaque_decls (k : crate) : bool =
+  crate_get_opaque_decls k <> ([], [])
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index a4041751..90066163 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -430,19 +430,9 @@ type gen_config = {
 }
 
 (** Returns the pair: (has opaque type decls, has opaque fun decls) *)
-let module_has_opaque_decls (ctx : gen_ctx) : bool * bool =
-  let has_opaque_types =
-    Pure.TypeDeclId.Map.exists
-      (fun _ (d : Pure.type_decl) ->
-        match d.kind with Opaque -> true | _ -> false)
-      ctx.trans_types
-  in
-  let has_opaque_funs =
-    A.FunDeclId.Map.exists
-      (fun _ (trans : pure_fun_translation) -> Option.is_none trans.fwd.f.body)
-      ctx.trans_funs
-  in
-  (has_opaque_types, has_opaque_funs)
+let crate_has_opaque_decls (ctx : gen_ctx) : bool * bool =
+  let types, funs = LlbcAstUtils.crate_get_opaque_decls ctx.crate in
+  (types <> [], funs <> [])
 
 (** Export a type declaration.
 
@@ -557,11 +547,20 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
   let body = trans.fwd.f in
 
   let is_opaque = Option.is_none body.Pure.body in
-  if
+  (* Check if we extract the global *)
+  let extract =
     config.extract_globals
     && (((not is_opaque) && config.extract_transparent)
        || (is_opaque && config.extract_opaque))
-  then
+  in
+  (* Check if it is an assumed global - if yes, we ignore it because we
+     map the definition to one in the standard library *)
+  let open ExtractAssumed in
+  let sname = name_to_simple_name global.name in
+  let extract =
+    extract && SimpleNameMap.find_opt sname assumed_globals_map = None
+  in
+  if extract then
     (* We don't wrap global declaration groups between calls to functions
        [{start, end}_global_decl_group] (which don't exist): global declaration
        groups are always singletons, so the [extract_global_decl] function
@@ -828,7 +827,7 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
     config.extract_opaque && config.extract_fun_decls
     && !Config.wrap_opaque_in_sig
     &&
-    let _, opaque_funs = module_has_opaque_decls ctx in
+    let _, opaque_funs = crate_has_opaque_decls ctx in
     opaque_funs
   in
   if wrap_in_sig then (
@@ -1233,7 +1232,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
 
      (* Check if there are opaque types and functions - in which case we need
       * to split *)
-     let has_opaque_types, has_opaque_funs = module_has_opaque_decls ctx in
+     let has_opaque_types, has_opaque_funs = crate_has_opaque_decls ctx in
      let has_opaque_types = has_opaque_types || !Config.use_state in
 
      (* Extract the types *)
@@ -1302,7 +1301,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
         in
         extract_file template_clauses_config ctx file_info);
 
-     (* Extract the opaque functions, if needed *)
+     (* Extract the opaque declarations, if needed *)
      let opaque_funs_module =
        if has_opaque_funs then (
          (* In the case of Lean we generate a template file *)
@@ -1330,6 +1329,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
            {
              base_gen_config with
              extract_fun_decls = true;
+             extract_globals = true;
              extract_transparent = false;
              extract_opaque = true;
              interface = true;
diff --git a/compiler/dune b/compiler/dune
index db099c3c..2f5a0a44 100644
--- a/compiler/dune
+++ b/compiler/dune
@@ -22,6 +22,7 @@
   Expressions
   ExpressionsUtils
   Extract
+  ExtractAssumed
   ExtractBase
   FunsAnalysis
   Identifiers
-- 
cgit v1.3.1


From 515d95d786fed13c300b9e0d7619711ee6aaf971 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sat, 16 Sep 2023 22:50:19 +0200
Subject: Add a strict_names_map in the extraction_ctx

---
 compiler/ExtractBase.ml | 55 ++++++++++++++++++++++++++++++++++---------------
 compiler/Translate.ml   | 14 +++++++++++++
 2 files changed, 52 insertions(+), 17 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 28928325..15acc492 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -467,6 +467,8 @@ type id =
       (** Used for stored various strings like keywords, definitions which
           should always be in context, etc. and which can't be linked to one
           of the above.
+
+          TODO: rename to "keyword"
        *)
 [@@deriving show, ord]
 
@@ -512,6 +514,14 @@ type names_map = {
        *)
 }
 
+let empty_names_map : names_map =
+  {
+    id_to_name = IdMap.empty;
+    name_to_id = StringMap.empty;
+    names_set = StringSet.empty;
+    opaque_ids = IdSet.empty;
+  }
+
 (** Small helper to report name collision *)
 let report_name_collision (id_to_string : id -> string) (id1 : id) (id2 : id)
     (name : string) : unit =
@@ -645,6 +655,15 @@ type extraction_ctx = {
   unsafe_names_map : unsafe_names_map;
       (** The map for id to names, where we allow name collisions
           (ex.: we might allow record field name collisions). *)
+  strict_names_map : names_map;
+      (** This map is a sub-map of [names_map]. For the ids in this map we also
+          forbid collisions with names in the [unsafe_names_map].
+
+          We do so for keywords for instance, but also for types (in a dependently
+          typed language, we might have an issue if the field of a record has, say,
+          the name "u32", and another field of the same record refers to "u32"
+          (for instance in its type).
+       *)
   fmt : formatter;
   indent_incr : int;
       (** The indent increment we insert whenever we need to indent more *)
@@ -849,6 +868,11 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       ^ fun_name
   | TraitSelfClauseId -> "trait_self_clause"
 
+(** Return [true] if we are strict on collisions for this id (i.e., we forbid
+    collisions even with the ids in the unsafe names map) *)
+let strict_collisions (id : id) : bool =
+  match id with UnknownId | TypeId _ -> true | _ -> false
+
 (** We might not check for collisions for some specific ids (ex.: field names) *)
 let allow_collisions (id : id) : bool =
   match id with
@@ -866,9 +890,9 @@ let ctx_add (is_opaque : bool) (id : id) (name : string) (ctx : extraction_ctx)
      We notably use it for field names: some backends like Lean can use the
      type information to disambiguate field projections.
 
-     Remark: what we do is actually subtle. Taking the example of fields:
-     - we allow fields from different ADT definitions to collide
-     - we do *not* allow field names to collide with other names
+     Remark: we still need to check that those "unsafe" ids don't collide with
+     the ids that we mark as "strict on collision".
+
      For instance, we don't allow naming a field "let". We enforce this by
      not checking collision between ids for which we permit collisions (ex.:
      between fields), but still checking collisions between those ids and the
@@ -876,29 +900,26 @@ let ctx_add (is_opaque : bool) (id : id) (name : string) (ctx : extraction_ctx)
   *)
   if allow_collisions id then (
     assert (not is_opaque);
-    (* Check with the other ids *)
-    names_map_check_collision id_to_string id name ctx.names_map;
+    (* Check with the ids which are considered to be strict on collisions *)
+    names_map_check_collision id_to_string id name ctx.strict_names_map;
     {
       ctx with
       unsafe_names_map = unsafe_names_map_add id name ctx.unsafe_names_map;
     })
   else
-    (* Remark: we don't check that there are no collisions with the unsafe ids.
-       Importantly, we don't want some safe ids like keywords to clash with
-       unsafe ids like fields names. For this, we leverage the fact that we register
-       keywords *first*, then unsafe ids (meaning the clash will be detected with
-       the check in the other branch of the if ... then ... else ..., and we do
-       have to check for all possible collisions, which may be slightly too
-       restrictive).
-
-       TODO: this is a bit hacky, we might want to improve the way we detect
-       clashes by being more precise. Overall, there is only an issue with
-       field names which are allowed to clash with each other.
+    (* Remark: if we are strict on collisions:
+       - we add the id to the strict collisions map
+       - we check that the id doesn't collide with the unsafe map
     *)
+    let strict_names_map =
+      if strict_collisions id then
+        names_map_add id_to_string is_opaque id name ctx.strict_names_map
+      else ctx.strict_names_map
+    in
     let names_map =
       names_map_add id_to_string is_opaque id name ctx.names_map
     in
-    { ctx with names_map }
+    { ctx with strict_names_map; names_map }
 
 (** [with_opaque_pre]: if [true] and the definition is opaque, add the opaque prefix *)
 let ctx_get (with_opaque_pre : bool) (id : id) (ctx : extraction_ctx) : string =
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 90066163..ebb0de0e 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -986,6 +986,19 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
     mk_formatter_and_names_map trans_ctx crate.name
       variant_concatenate_type_name
   in
+  let strict_names_map =
+    let open ExtractBase in
+    let ids =
+      List.filter
+        (fun (id, _) -> strict_collisions id)
+        (IdMap.bindings names_map.id_to_name)
+    in
+    let is_opaque = false in
+    List.fold_left
+      (* id_to_string: we shouldn't need to use it *)
+        (fun m (id, n) -> names_map_add show_id is_opaque id n m)
+      empty_names_map ids
+  in
 
   (* We need to compute which functions are recursive, in order to know
    * whether we should generate a decrease clause or not. *)
@@ -1041,6 +1054,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       trans_ctx;
       names_map;
       unsafe_names_map = { id_to_name = ExtractBase.IdMap.empty };
+      strict_names_map;
       fmt;
       indent_incr = 2;
       use_opaque_pre = !Config.split_files;
-- 
cgit v1.3.1


From 952c4c964e33eeb6956d84efce3ef1b7575f311f Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 17 Sep 2023 00:56:51 +0200
Subject: Fix more issues with the extraction

---
 compiler/LlbcAstUtils.ml | 17 +++++++++++++----
 compiler/Translate.ml    | 40 +++++++++++++++++++++++++++++++++-------
 2 files changed, 46 insertions(+), 11 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/LlbcAstUtils.ml b/compiler/LlbcAstUtils.ml
index 8c8bbabe..a982af30 100644
--- a/compiler/LlbcAstUtils.ml
+++ b/compiler/LlbcAstUtils.ml
@@ -15,13 +15,22 @@ let lookup_fun_name (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
 
 (** Return the opaque declarations found in the crate.
 
+    [filter_assumed]: if [true], do not consider as opaque the external definitions
+    that we will map to definitions from the standard library.
+
     Remark: the list of functions also contains the list of opaque global bodies.
  *)
-let crate_get_opaque_decls (k : crate) : T.type_decl list * fun_decl list =
+let crate_get_opaque_decls (k : crate) (filter_assumed : bool) :
+    T.type_decl list * fun_decl list =
   let open ExtractAssumed in
   let is_opaque_fun (d : fun_decl) : bool =
     let sname = name_to_simple_name d.name in
-    d.body = None && not (SimpleNameMap.mem sname assumed_globals_map)
+    d.body = None
+    (* Something to pay attention to: we must ignore trait method *declarations*
+       (which don't have a body but must not be considered as opaque) *)
+    && (match d.kind with TraitMethodDecl _ -> false | _ -> true)
+    && ((not filter_assumed)
+       || not (SimpleNameMap.mem sname assumed_globals_map))
   in
   let is_opaque_type (d : T.type_decl) : bool = d.kind = T.Opaque in
   (* Note that by checking the function bodies we also the globals *)
@@ -30,5 +39,5 @@ let crate_get_opaque_decls (k : crate) : T.type_decl list * fun_decl list =
 
 (** Return true if the crate contains opaque declarations, ignoring the assumed
     definitions. *)
-let crate_has_opaque_decls (k : crate) : bool =
-  crate_get_opaque_decls k <> ([], [])
+let crate_has_opaque_decls (k : crate) (filter_assumed : bool) : bool =
+  crate_get_opaque_decls k filter_assumed <> ([], [])
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index ebb0de0e..4a4affea 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -403,6 +403,8 @@ type gen_config = {
   extract_decreases_clauses : bool;
   extract_template_decreases_clauses : bool;
   extract_fun_decls : bool;
+  extract_trait_decls : bool;
+  extract_trait_impls : bool;
   extract_transparent : bool;
       (** If [true], extract the transparent declarations, otherwise ignore. *)
   extract_opaque : bool;
@@ -429,9 +431,22 @@ type gen_config = {
   test_trans_unit_functions : bool;
 }
 
-(** Returns the pair: (has opaque type decls, has opaque fun decls) *)
-let crate_has_opaque_decls (ctx : gen_ctx) : bool * bool =
-  let types, funs = LlbcAstUtils.crate_get_opaque_decls ctx.crate in
+(** Returns the pair: (has opaque type decls, has opaque fun decls).
+
+    [filter_assumed]: if [true], do not consider as opaque the external definitions
+    that we will map to definitions from the standard library.
+ *)
+let crate_has_opaque_decls (ctx : gen_ctx) (filter_assumed : bool) : bool * bool
+    =
+  let types, funs =
+    LlbcAstUtils.crate_get_opaque_decls ctx.crate filter_assumed
+  in
+  log#ldebug
+    (lazy
+      ("Opaque decls:" ^ "\n- types:\n"
+      ^ String.concat ",\n" (List.map T.show_type_decl types)
+      ^ "\n- functions:\n"
+      ^ String.concat ",\n" (List.map A.show_fun_decl funs)));
   (types <> [], funs <> [])
 
 (** Export a type declaration.
@@ -800,8 +815,12 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
         (* Translate *)
         export_functions_group pure_funs
     | Global id -> export_global id
-    | TraitDecl id -> export_trait_decl id
-    | TraitImpl id -> export_trait_impl id
+    | TraitDecl id ->
+        if config.extract_trait_decls && config.extract_transparent then
+          export_trait_decl id
+    | TraitImpl id ->
+        if config.extract_trait_impls && config.extract_transparent then
+          export_trait_impl id
   in
 
   (* If we need to export the state type: we try to export it after we defined
@@ -827,7 +846,7 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
     config.extract_opaque && config.extract_fun_decls
     && !Config.wrap_opaque_in_sig
     &&
-    let _, opaque_funs = crate_has_opaque_decls ctx in
+    let _, opaque_funs = crate_has_opaque_decls ctx true in
     opaque_funs
   in
   if wrap_in_sig then (
@@ -1235,6 +1254,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
          extract_decreases_clauses = !Config.extract_decreases_clauses;
          extract_template_decreases_clauses = false;
          extract_fun_decls = false;
+         extract_trait_decls = false;
+         extract_trait_impls = false;
          extract_transparent = true;
          extract_opaque = false;
          extract_state_type = false;
@@ -1246,7 +1267,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
 
      (* Check if there are opaque types and functions - in which case we need
       * to split *)
-     let has_opaque_types, has_opaque_funs = crate_has_opaque_decls ctx in
+     let has_opaque_types, has_opaque_funs = crate_has_opaque_decls ctx true in
      let has_opaque_types = has_opaque_types || !Config.use_state in
 
      (* Extract the types *)
@@ -1267,6 +1288,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
        {
          base_gen_config with
          extract_types = true;
+         extract_trait_decls = true;
          extract_opaque = true;
          extract_state_type = !Config.use_state;
          interface = has_opaque_types;
@@ -1343,6 +1365,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
            {
              base_gen_config with
              extract_fun_decls = true;
+             extract_trait_impls = true;
              extract_globals = true;
              extract_transparent = false;
              extract_opaque = true;
@@ -1376,6 +1399,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
        {
          base_gen_config with
          extract_fun_decls = true;
+         extract_trait_impls = true;
          extract_globals = true;
          test_trans_unit_functions = !Config.test_trans_unit_functions;
        }
@@ -1411,6 +1435,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
          extract_template_decreases_clauses =
            !Config.extract_template_decreases_clauses;
          extract_fun_decls = true;
+         extract_trait_decls = true;
+         extract_trait_impls = true;
          extract_transparent = true;
          extract_opaque = true;
          extract_state_type = !Config.use_state;
-- 
cgit v1.3.1


From 47bc2ba74c90c1a29a081b8950022f74408f037e Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 17 Sep 2023 05:15:18 +0200
Subject: Merge trans_ctx and decls_ctx

---
 compiler/Contexts.ml        |  6 +++-
 compiler/Extract.ml         |  8 ++---
 compiler/ExtractBase.ml     | 12 +++----
 compiler/Interpreter.ml     | 12 ++++---
 compiler/PureMicroPasses.ml | 11 +++----
 compiler/Translate.ml       | 79 ++++++++++-----------------------------------
 compiler/TranslateCore.ml   | 45 +++++++-------------------
 7 files changed, 53 insertions(+), 120 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Contexts.ml b/compiler/Contexts.ml
index 65760d94..a5bc7dc0 100644
--- a/compiler/Contexts.ml
+++ b/compiler/Contexts.ml
@@ -255,7 +255,11 @@ type type_context = {
 }
 [@@deriving show]
 
-type fun_context = { fun_decls : fun_decl FunDeclId.Map.t } [@@deriving show]
+type fun_context = {
+  fun_decls : fun_decl FunDeclId.Map.t;
+  fun_infos : FunsAnalysis.fun_info FunDeclId.Map.t;
+}
+[@@deriving show]
 
 type global_context = { global_decls : global_decl GlobalDeclId.Map.t }
 [@@deriving show]
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index e841082b..596fa013 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -856,9 +856,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
             | Assumed Range -> "r"
             | Assumed State -> ConstStrings.state_basename
             | AdtId adt_id ->
-                let def =
-                  TypeDeclId.Map.find adt_id ctx.type_context.type_decls
-                in
+                let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
                 (* Derive the var name from the last ident of the type name
                  * Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm"
                  *)
@@ -3115,9 +3113,7 @@ and extract_StructUpdate (ctx : extraction_ctx) (fmt : F.formatter)
   let extract_as_unit =
     match (!backend, supd.struct_id) with
     | HOL4, AdtId adt_id ->
-        let d =
-          TypeDeclId.Map.find adt_id ctx.trans_ctx.type_context.type_decls
-        in
+        let d = TypeDeclId.Map.find adt_id ctx.trans_ctx.type_ctx.type_decls in
         d.kind = Struct []
     | _ -> false
   in
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index a81ec052..1586e6ed 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -709,10 +709,10 @@ type extraction_ctx = {
     instance).
  *)
 let id_to_string (id : id) (ctx : extraction_ctx) : string =
-  let global_decls = ctx.trans_ctx.global_context.global_decls in
-  let fun_decls = ctx.trans_ctx.fun_context.fun_decls in
-  let type_decls = ctx.trans_ctx.type_context.type_decls in
-  let trait_decls = ctx.trans_ctx.trait_decls_context.trait_decls in
+  let global_decls = ctx.trans_ctx.global_ctx.global_decls in
+  let fun_decls = ctx.trans_ctx.fun_ctx.fun_decls in
+  let type_decls = ctx.trans_ctx.type_ctx.type_decls in
+  let trait_decls = ctx.trans_ctx.trait_decls_ctx.trait_decls in
   let trait_decl_id_to_string (id : A.TraitDeclId.id) : string =
     let trait_name =
       Print.fun_name_to_string (A.TraitDeclId.Map.find id trait_decls).name
@@ -1293,9 +1293,7 @@ let ctx_compute_fun_name (trans_group : pure_fun_translation) (def : fun_decl)
     (ctx : extraction_ctx) : string =
   (* Lookup the LLBC def to compute the region group information *)
   let def_id = def.def_id in
-  let llbc_def =
-    A.FunDeclId.Map.find def_id ctx.trans_ctx.fun_context.fun_decls
-  in
+  let llbc_def = A.FunDeclId.Map.find def_id ctx.trans_ctx.fun_ctx.fun_decls in
   let sg = llbc_def.signature in
   let num_rgs = List.length sg.regions_hierarchy in
   let { keep_fwd; fwd = _; backs } = trans_group in
diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml
index 4ce6dae8..752d6f2f 100644
--- a/compiler/Interpreter.ml
+++ b/compiler/Interpreter.ml
@@ -26,7 +26,10 @@ let compute_contexts (m : A.crate) : C.decls_ctx =
     TypesAnalysis.analyze_type_declarations type_decls type_decls_list
   in
   let type_ctx = { C.type_decls_groups; type_decls; type_infos } in
-  let fun_ctx = { C.fun_decls } in
+  let fun_infos =
+    FunsAnalysis.analyze_module m fun_decls global_decls !Config.use_state
+  in
+  let fun_ctx = { C.fun_decls; fun_infos } in
   let global_ctx = { C.global_decls } in
   let trait_decls_ctx = { C.trait_decls } in
   let trait_impls_ctx = { C.trait_impls } in
@@ -567,7 +570,8 @@ module Test = struct
   (** Test a unit function (taking no arguments) by evaluating it in an empty
       environment.
    *)
-  let test_unit_function (crate : A.crate) (fid : A.FunDeclId.id) : unit =
+  let test_unit_function (crate : A.crate) (decls_ctx : C.decls_ctx)
+      (fid : A.FunDeclId.id) : unit =
     (* Retrieve the function declaration *)
     let fdef = A.FunDeclId.Map.find fid crate.functions in
     let body = Option.get fdef.body in
@@ -581,7 +585,6 @@ module Test = struct
     assert (body.A.arg_count = 0);
 
     (* Create the evaluation context *)
-    let decls_ctx = compute_contexts crate in
     let ctx = initialize_eval_context decls_ctx [] [] [] in
 
     (* Insert the (uninitialized) local variables *)
@@ -620,8 +623,9 @@ module Test = struct
         (fun _ -> fun_decl_is_transparent_unit)
         crate.functions
     in
+    let decls_ctx = compute_contexts crate in
     let test_unit_fun _ (def : A.fun_decl) : unit =
-      test_unit_function crate def.A.def_id
+      test_unit_function crate decls_ctx def.A.def_id
     in
     A.FunDeclId.Map.iter test_unit_fun unit_funs
 end
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index 53148dbb..2130d5c2 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -586,9 +586,7 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl =
                   generics = _;
                 } ->
                 (* Lookup the def *)
-                let decl =
-                  TypeDeclId.Map.find adt_id ctx.type_context.type_decls
-                in
+                let decl = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
                 (* Check that there are as many arguments as there are fields - note
                    that the def should have a body (otherwise we couldn't use the
                    constructor) *)
@@ -597,8 +595,7 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl =
                   (* Check if the definition is recursive *)
                   let is_rec =
                     match
-                      TypeDeclId.Map.find adt_id
-                        ctx.type_context.type_decls_groups
+                      TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls_groups
                     with
                     | NonRec _ -> false
                     | Rec _ -> true
@@ -796,7 +793,7 @@ let expression_contains_child_call_in_all_paths (ctx : trans_ctx)
                       | FunId fun_id -> fun_id
                       | TraitMethod (_, _, fun_decl_id) -> A.Regular fun_decl_id
                     in
-                    LlbcAstUtils.lookup_fun_sig id0 ctx.fun_context.fun_decls
+                    LlbcAstUtils.lookup_fun_sig id0 ctx.fun_ctx.fun_decls
                   in
                   (* Compute the set of ancestors of the function in call1 *)
                   let call1_ancestors =
@@ -1094,7 +1091,7 @@ let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl =
                 (* This is a struct *)
                 (* Retrieve the definiton, to find how many fields there are *)
                 let adt_decl =
-                  TypeDeclId.Map.find adt_id ctx.type_context.type_decls
+                  TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls
                 in
                 let fields =
                   match adt_decl.kind with
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 4a4affea..13e339ea 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -29,34 +29,12 @@ let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : A.fun_decl)
       ("translate_function_to_symbolics: "
       ^ Print.fun_name_to_string fdef.A.name));
 
-  let {
-    type_context;
-    fun_context;
-    global_context;
-    trait_decls_context;
-    trait_impls_context;
-  } =
-    trans_ctx
-  in
-  let fun_context = { C.fun_decls = fun_context.fun_decls } in
-
-  (* TODO: we should merge trans_ctx and decls_ctx *)
-  let decls_ctx : C.decls_ctx =
-    {
-      C.type_ctx = type_context;
-      fun_ctx = fun_context;
-      global_ctx = global_context;
-      trait_decls_ctx = trait_decls_context;
-      trait_impls_ctx = trait_impls_context;
-    }
-  in
-
   match fdef.body with
   | None -> None
   | Some _ ->
       (* Evaluate *)
       let synthesize = true in
-      let inputs, symb = evaluate_function_symbolic synthesize decls_ctx fdef in
+      let inputs, symb = evaluate_function_symbolic synthesize trans_ctx fdef in
       Some (inputs, Option.get symb)
 
 (** Translate a function, by generating its forward and backward translations.
@@ -74,15 +52,6 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
     (lazy
       ("translate_function_to_pure: " ^ Print.fun_name_to_string fdef.A.name));
 
-  let {
-    type_context;
-    fun_context;
-    global_context;
-    trait_decls_context;
-    trait_impls_context;
-  } =
-    trans_ctx
-  in
   let def_id = fdef.def_id in
 
   (* Compute the symbolic ASTs, if the function is transparent *)
@@ -107,25 +76,25 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
       (List.filter_map
          (fun (tid, g) ->
            match g with Charon.GAst.NonRec _ -> None | Rec _ -> Some tid)
-         (T.TypeDeclId.Map.bindings trans_ctx.type_context.type_decls_groups))
+         (T.TypeDeclId.Map.bindings trans_ctx.type_ctx.type_decls_groups))
   in
   let type_context =
     {
-      SymbolicToPure.type_infos = type_context.type_infos;
-      llbc_type_decls = type_context.type_decls;
+      SymbolicToPure.type_infos = trans_ctx.type_ctx.type_infos;
+      llbc_type_decls = trans_ctx.type_ctx.type_decls;
       type_decls = pure_type_decls;
       recursive_decls = recursive_type_decls;
     }
   in
   let fun_context =
     {
-      SymbolicToPure.llbc_fun_decls = fun_context.fun_decls;
+      SymbolicToPure.llbc_fun_decls = trans_ctx.fun_ctx.fun_decls;
       fun_sigs;
-      fun_infos = fun_context.fun_infos;
+      fun_infos = trans_ctx.fun_ctx.fun_infos;
     }
   in
   let global_context =
-    { SymbolicToPure.llbc_global_decls = global_context.global_decls }
+    { SymbolicToPure.llbc_global_decls = trans_ctx.global_ctx.global_decls }
   in
 
   (* Compute the set of loops, and find better ids for them (starting at 0).
@@ -173,8 +142,8 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
       type_context;
       fun_context;
       global_context;
-      trait_decls_ctx = trait_decls_context.trait_decls;
-      trait_impls_ctx = trait_impls_context.trait_impls;
+      trait_decls_ctx = trans_ctx.trait_decls_ctx.trait_decls;
+      trait_impls_ctx = trans_ctx.trait_impls_ctx.trait_impls;
       fun_decl = fdef;
       forward_inputs = [];
       (* Empty for now *)
@@ -311,22 +280,8 @@ let translate_crate_to_pure (crate : A.crate) :
   (* Debug *)
   log#ldebug (lazy "translate_crate_to_pure");
 
-  (* Compute the type and function contexts *)
-  let decls_ctx = compute_contexts crate in
-  let fun_infos =
-    FA.analyze_module crate decls_ctx.fun_ctx.C.fun_decls
-      decls_ctx.global_ctx.C.global_decls !Config.use_state
-  in
-  let fun_context = { fun_decls = decls_ctx.fun_ctx.fun_decls; fun_infos } in
-  let trans_ctx =
-    {
-      type_context = decls_ctx.type_ctx;
-      fun_context;
-      global_context = decls_ctx.global_ctx;
-      trait_decls_context = decls_ctx.trait_decls_ctx;
-      trait_impls_context = decls_ctx.trait_impls_ctx;
-    }
-  in
+  (* Compute the translation context *)
+  let trans_ctx = compute_contexts crate in
 
   (* Translate all the type definitions *)
   let type_decls =
@@ -362,8 +317,8 @@ let translate_crate_to_pure (crate : A.crate) :
   in
   let sigs = List.append assumed_sigs local_sigs in
   let fun_sigs =
-    SymbolicToPure.translate_fun_signatures fun_context.fun_infos
-      decls_ctx.type_ctx.type_infos sigs
+    SymbolicToPure.translate_fun_signatures trans_ctx.fun_ctx.fun_infos
+      trans_ctx.type_ctx.type_infos sigs
   in
 
   (* Translate all the *transparent* functions *)
@@ -374,18 +329,18 @@ let translate_crate_to_pure (crate : A.crate) :
   in
 
   (* Translate the trait declarations *)
-  let type_infos = trans_ctx.type_context.type_infos in
+  let type_infos = trans_ctx.type_ctx.type_infos in
   let trait_decls =
     List.map
       (SymbolicToPure.translate_trait_decl type_infos)
-      (T.TraitDeclId.Map.values trans_ctx.trait_decls_context.trait_decls)
+      (T.TraitDeclId.Map.values trans_ctx.trait_decls_ctx.trait_decls)
   in
 
   (* Translate the trait implementations *)
   let trait_impls =
     List.map
       (SymbolicToPure.translate_trait_impl type_infos)
-      (T.TraitImplId.Map.values trans_ctx.trait_impls_context.trait_impls)
+      (T.TraitImplId.Map.values trans_ctx.trait_impls_ctx.trait_impls)
   in
 
   (* Apply the micro-passes *)
@@ -554,7 +509,7 @@ let export_types_group (fmt : Format.formatter) (config : gen_config)
  *)
 let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
     (id : A.GlobalDeclId.id) : unit =
-  let global_decls = ctx.trans_ctx.global_context.global_decls in
+  let global_decls = ctx.trans_ctx.global_ctx.global_decls in
   let global = A.GlobalDeclId.Map.find id global_decls in
   let trans = A.FunDeclId.Map.find global.body_id ctx.trans_funs in
   assert (trans.fwd.loops = []);
diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml
index f31dc458..3427fd43 100644
--- a/compiler/TranslateCore.ml
+++ b/compiler/TranslateCore.ml
@@ -10,27 +10,7 @@ module FA = FunsAnalysis
 (** The local logger *)
 let log = L.translate_log
 
-type type_context = C.type_context [@@deriving show]
-
-type fun_context = {
-  fun_decls : A.fun_decl A.FunDeclId.Map.t;
-  fun_infos : FA.fun_info A.FunDeclId.Map.t;
-}
-[@@deriving show]
-
-type trait_decls_context = C.trait_decls_context [@@deriving show]
-type trait_impls_context = C.trait_impls_context [@@deriving show]
-type global_context = C.global_context [@@deriving show]
-
-(* TODO: we should use Contexts.decls_ctx *)
-type trans_ctx = {
-  type_context : type_context;
-  fun_context : fun_context;
-  global_context : global_context;
-  trait_decls_context : trait_decls_context;
-  trait_impls_context : trait_impls_context;
-}
-
+type trans_ctx = C.decls_ctx [@@deriving show]
 type fun_and_loops = { f : Pure.fun_decl; loops : Pure.fun_decl list }
 type pure_fun_translation_no_loops = Pure.fun_decl * Pure.fun_decl list
 
@@ -50,10 +30,10 @@ let trans_ctx_to_type_formatter (ctx : trans_ctx)
     (type_params : Pure.type_var list)
     (const_generic_params : Pure.const_generic_var list) :
     PrintPure.type_formatter =
-  let type_decls = ctx.type_context.type_decls in
-  let global_decls = ctx.global_context.global_decls in
-  let trait_decls = ctx.trait_decls_context.trait_decls in
-  let trait_impls = ctx.trait_impls_context.trait_impls in
+  let type_decls = ctx.type_ctx.type_decls in
+  let global_decls = ctx.global_ctx.global_decls in
+  let trait_decls = ctx.trait_decls_ctx.trait_decls in
+  let trait_impls = ctx.trait_impls_ctx.trait_impls in
   PrintPure.mk_type_formatter type_decls global_decls trait_decls trait_impls
     type_params const_generic_params
 
@@ -66,17 +46,17 @@ let type_decl_to_string (ctx : trans_ctx) (def : Pure.type_decl) : string =
 
 let type_id_to_string (ctx : trans_ctx) (id : Pure.TypeDeclId.id) : string =
   Print.fun_name_to_string
-    (Pure.TypeDeclId.Map.find id ctx.type_context.type_decls).name
+    (Pure.TypeDeclId.Map.find id ctx.type_ctx.type_decls).name
 
 let trans_ctx_to_ast_formatter (ctx : trans_ctx)
     (type_params : Pure.type_var list)
     (const_generic_params : Pure.const_generic_var list) :
     PrintPure.ast_formatter =
-  let type_decls = ctx.type_context.type_decls in
-  let fun_decls = ctx.fun_context.fun_decls in
-  let global_decls = ctx.global_context.global_decls in
-  let trait_decls = ctx.trait_decls_context.trait_decls in
-  let trait_impls = ctx.trait_impls_context.trait_impls in
+  let type_decls = ctx.type_ctx.type_decls in
+  let fun_decls = ctx.fun_ctx.fun_decls in
+  let global_decls = ctx.global_ctx.global_decls in
+  let trait_decls = ctx.trait_decls_ctx.trait_decls in
+  let trait_impls = ctx.trait_impls_ctx.trait_impls in
   PrintPure.mk_ast_formatter type_decls fun_decls global_decls trait_decls
     trait_impls type_params const_generic_params
 
@@ -95,5 +75,4 @@ let fun_decl_to_string (ctx : trans_ctx) (def : Pure.fun_decl) : string =
   PrintPure.fun_decl_to_string fmt def
 
 let fun_decl_id_to_string (ctx : trans_ctx) (id : A.FunDeclId.id) : string =
-  Print.fun_name_to_string
-    (A.FunDeclId.Map.find id ctx.fun_context.fun_decls).name
+  Print.fun_name_to_string (A.FunDeclId.Map.find id ctx.fun_ctx.fun_decls).name
-- 
cgit v1.3.1


From 80728093c432ba15eace9d6ce1cc9e3c56a80ff7 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 17 Sep 2023 05:37:56 +0200
Subject: Make minor modifications

---
 compiler/SymbolicToPure.ml | 19 ++++++++-----------
 compiler/Translate.ml      |  5 +----
 2 files changed, 9 insertions(+), 15 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index 2e0e9862..be9b7261 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -826,10 +826,11 @@ let get_fun_effect_info (fun_infos : FA.fun_info A.FunDeclId.Map.t)
     of the forward function) which we use as hints to generate pretty names
     in the extracted code.
  *)
-let translate_fun_sig (fun_infos : FA.fun_info A.FunDeclId.Map.t)
-    (fun_id : A.fun_id) (type_infos : TA.type_infos) (sg : A.fun_sig)
-    (input_names : string option list) (bid : T.RegionGroupId.id option) :
-    fun_sig_named_outputs =
+let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id)
+    (sg : A.fun_sig) (input_names : string option list)
+    (bid : T.RegionGroupId.id option) : fun_sig_named_outputs =
+  let fun_infos = decls_ctx.fun_ctx.fun_infos in
+  let type_infos = decls_ctx.type_ctx.type_infos in
   (* Retrieve the list of parent backward functions *)
   let gid, parents =
     match bid with
@@ -3021,8 +3022,7 @@ let translate_type_decls (type_decls : T.type_decl list) : type_decl list =
     - optional names for the outputs values (we derive them for the backward
       functions)
  *)
-let translate_fun_signatures (fun_infos : FA.fun_info A.FunDeclId.Map.t)
-    (type_infos : TA.type_infos)
+let translate_fun_signatures (decls_ctx : C.decls_ctx)
     (functions : (A.fun_id * string option list * A.fun_sig) list) :
     fun_sig_named_outputs RegularFunIdNotLoopMap.t =
   (* For every function, translate the signatures of:
@@ -3033,17 +3033,14 @@ let translate_fun_signatures (fun_infos : FA.fun_info A.FunDeclId.Map.t)
       (sg : A.fun_sig) : (regular_fun_id_not_loop * fun_sig_named_outputs) list
       =
     (* The forward function *)
-    let fwd_sg =
-      translate_fun_sig fun_infos fun_id type_infos sg input_names None
-    in
+    let fwd_sg = translate_fun_sig decls_ctx fun_id sg input_names None in
     let fwd_id = (fun_id, None) in
     (* The backward functions *)
     let back_sgs =
       List.map
         (fun (rg : T.region_var_group) ->
           let tsg =
-            translate_fun_sig fun_infos fun_id type_infos sg input_names
-              (Some rg.id)
+            translate_fun_sig decls_ctx fun_id sg input_names (Some rg.id)
           in
           let id = (fun_id, Some rg.id) in
           (id, tsg))
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 13e339ea..e69abee1 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -316,10 +316,7 @@ let translate_crate_to_pure (crate : A.crate) :
       (A.FunDeclId.Map.values crate.functions)
   in
   let sigs = List.append assumed_sigs local_sigs in
-  let fun_sigs =
-    SymbolicToPure.translate_fun_signatures trans_ctx.fun_ctx.fun_infos
-      trans_ctx.type_ctx.type_infos sigs
-  in
+  let fun_sigs = SymbolicToPure.translate_fun_signatures trans_ctx sigs in
 
   (* Translate all the *transparent* functions *)
   let pure_translations =
-- 
cgit v1.3.1


From f11d5186b467df318f7c09eedf8b5629c165b453 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Fri, 20 Oct 2023 15:05:00 +0200
Subject: Start updating to handle function pointers

---
 compiler/AssociatedTypes.ml        | 12 +++++-
 compiler/Assumed.ml                |  2 +-
 compiler/Extract.ml                |  4 +-
 compiler/ExtractBase.ml            |  2 +-
 compiler/FunsAnalysis.ml           |  2 +-
 compiler/InterpreterExpansion.ml   |  2 +-
 compiler/InterpreterExpressions.ml |  9 +++--
 compiler/InterpreterStatements.ml  | 78 +++++++++++++++++++++-----------------
 compiler/InterpreterUtils.ml       |  5 +++
 compiler/Print.ml                  | 23 +++++++++++
 compiler/PrintPure.ml              | 22 +++++------
 compiler/PureMicroPasses.ml        | 32 ++++++++--------
 compiler/SymbolicToPure.ml         | 50 +++++++++++++-----------
 compiler/SynthesizeSymbolic.ml     |  2 +-
 compiler/Translate.ml              | 10 ++---
 compiler/TypesAnalysis.ml          |  8 ++++
 16 files changed, 163 insertions(+), 100 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/AssociatedTypes.ml b/compiler/AssociatedTypes.ml
index 992dade9..022aad2f 100644
--- a/compiler/AssociatedTypes.ml
+++ b/compiler/AssociatedTypes.ml
@@ -157,7 +157,8 @@ let ctx_add_norm_trait_types_from_preds (ctx : C.eval_ctx)
 let rec trait_instance_id_is_local_clause (id : 'r T.trait_instance_id) : bool =
   match id with
   | T.Self | Clause _ -> true
-  | TraitImpl _ | BuiltinOrAuto _ | TraitRef _ | UnknownTrait _ -> false
+  | TraitImpl _ | BuiltinOrAuto _ | TraitRef _ | UnknownTrait _ | FnPointer _ ->
+      false
   | ParentClause (id, _, _) | ItemClause (id, _, _, _) ->
       trait_instance_id_is_local_clause id
 
@@ -187,6 +188,10 @@ let rec ctx_normalize_ty : 'r. 'r norm_ctx -> 'r T.ty -> 'r T.ty =
   | Ref (r, ty, rkind) ->
       let ty = ctx_normalize_ty ctx ty in
       T.Ref (r, ty, rkind)
+  | Arrow (inputs, output) ->
+      let inputs = List.map (ctx_normalize_ty ctx) inputs in
+      let output = ctx_normalize_ty ctx output in
+      Arrow (inputs, output)
   | TraitType (trait_ref, generics, type_name) -> (
       log#ldebug
         (lazy
@@ -401,6 +406,11 @@ and ctx_normalize_trait_instance_id :
       assert (trait_instance_id_is_local_clause trait_ref.trait_id);
       assert (trait_ref.generics = TypesUtils.mk_empty_generic_args);
       (trait_ref.trait_id, None)
+  | FnPointer ty ->
+      let ty = ctx_normalize_ty ctx ty in
+      (* TODO: we might want to return the ref to the function pointer,
+         in order to later normalize a call to this function pointer *)
+      (FnPointer ty, None)
   | UnknownTrait _ ->
       (* This is actually an error case *)
       (id, None)
diff --git a/compiler/Assumed.ml b/compiler/Assumed.ml
index 109175af..b1ec0660 100644
--- a/compiler/Assumed.ml
+++ b/compiler/Assumed.ml
@@ -347,7 +347,7 @@ let assumed_infos : assumed_info list =
   let vec_pre = [ "alloc"; "vec"; "Vec" ] in
   let index_pre = [ "core"; "ops"; "index" ] in
   [
-    (A.Replace, Sig.mem_replace_sig, false, to_name [ "core"; "mem"; "replace" ]);
+    (Replace, Sig.mem_replace_sig, false, to_name [ "core"; "mem"; "replace" ]);
     (BoxNew, Sig.box_new_sig, false, to_name [ "alloc"; "boxed"; "Box"; "new" ]);
     ( BoxFree,
       Sig.box_free_sig,
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index ac81d6f3..688f6ce3 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -2696,7 +2696,7 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
             (* Provided method: we see it as a regular function call, and use
                the function name *)
             let fun_id =
-              FromLlbc (FunId (A.Regular method_id.id), lp_id, rg_id)
+              FromLlbc (FunId (Regular method_id.id), lp_id, rg_id)
             in
             let fun_name = ctx_get_function with_opaque_pre fun_id ctx in
             F.pp_print_string fmt fun_name;
@@ -3519,7 +3519,7 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter)
     (def : fun_decl) : unit =
   let { keep_fwd; num_backs } =
     PureUtils.RegularFunIdMap.find
-      (Pure.FunId (A.Regular def.def_id), def.loop_id, def.back_id)
+      (Pure.FunId (Regular def.def_id), def.loop_id, def.back_id)
       ctx.fun_name_info
   in
   let comment_pre = "[" ^ Print.fun_name_to_string def.basename ^ "]: " in
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 1586e6ed..a921515b 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1482,7 +1482,7 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map =
   let assumed_functions =
     List.map
       (fun (fid, rg, name) ->
-        (FromLlbc (Pure.FunId (A.Assumed fid), None, rg), name))
+        (FromLlbc (Pure.FunId (Assumed fid), None, rg), name))
       init.assumed_llbc_functions
     @ List.map (fun (fid, name) -> (Pure fid, name)) init.assumed_pure_functions
   in
diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml
index f4406653..a09a6d05 100644
--- a/compiler/FunsAnalysis.ml
+++ b/compiler/FunsAnalysis.ml
@@ -76,7 +76,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
                 can_fail := EU.binop_can_fail bop || !can_fail
 
           method! visit_Call env call =
-            (match call.func with
+            (match call.func.func with
             | FunId (Regular id) ->
                 if FunDeclId.Set.mem id fun_ids then (
                   can_diverge := true;
diff --git a/compiler/InterpreterExpansion.ml b/compiler/InterpreterExpansion.ml
index ea692386..c1041fa3 100644
--- a/compiler/InterpreterExpansion.ml
+++ b/compiler/InterpreterExpansion.ml
@@ -709,7 +709,7 @@ let greedy_expand_symbolics_with_borrows (config : C.config) : cm_fun =
             raise
               (Failure
                  "Attempted to greedily expand an ADT which can't be expanded ")
-        | T.TypeVar _ | T.Literal _ | Never | T.TraitType _ ->
+        | T.TypeVar _ | T.Literal _ | Never | T.TraitType _ | T.Arrow _ ->
             raise (Failure "Unreachable")
       in
       (* Compose and continue *)
diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml
index 29826233..a42c552a 100644
--- a/compiler/InterpreterExpressions.ml
+++ b/compiler/InterpreterExpressions.ml
@@ -271,7 +271,7 @@ let eval_operand_no_reorganize (config : C.config) (op : E.operand)
       match cv.value with
       | E.CLiteral lit ->
           cf (literal_to_typed_value (TypesUtils.ty_as_literal cv.ty) lit) ctx
-      | E.TraitConst (trait_ref, generics, const_name) -> (
+      | E.CTraitConst (trait_ref, generics, const_name) -> (
           assert (generics = TypesUtils.mk_empty_generic_args);
           match trait_ref.trait_id with
           | T.TraitImpl _ ->
@@ -329,7 +329,8 @@ let eval_operand_no_reorganize (config : C.config) (op : E.operand)
                      None,
                      value_as_symbolic v.value,
                      SymbolicAst.ConstGenericValue vid,
-                     e ))))
+                     e )))
+      | E.CFnPtr _ -> raise (Failure "TODO"))
   | E.Copy p ->
       (* Access the value *)
       let access = Read in
@@ -426,7 +427,7 @@ let eval_unary_op_concrete (config : C.config) (unop : E.unop) (op : E.operand)
         match mk_scalar sv.int_ty i with
         | Error _ -> cf (Error EPanic)
         | Ok sv -> cf (Ok { v with V.value = V.Literal (PV.Scalar sv) }))
-    | E.Cast (src_ty, tgt_ty), V.Literal (PV.Scalar sv) -> (
+    | E.Cast (E.CastInteger (src_ty, tgt_ty)), V.Literal (PV.Scalar sv) -> (
         assert (src_ty = sv.int_ty);
         let i = sv.PV.value in
         match mk_scalar tgt_ty i with
@@ -452,7 +453,7 @@ let eval_unary_op_symbolic (config : C.config) (unop : E.unop) (op : E.operand)
       match (unop, v.V.ty) with
       | E.Not, (T.Literal Bool as lty) -> lty
       | E.Neg, (T.Literal (Integer _) as lty) -> lty
-      | E.Cast (_, tgt_ty), _ -> T.Literal (Integer tgt_ty)
+      | E.Cast (E.CastInteger (_, tgt_ty)), _ -> T.Literal (Integer tgt_ty)
       | _ -> raise (Failure "Invalid input for unop")
     in
     let res_sv =
diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml
index 36bc3492..9f35c6f2 100644
--- a/compiler/InterpreterStatements.ml
+++ b/compiler/InterpreterStatements.ml
@@ -306,7 +306,7 @@ let get_assumed_function_return_type (ctx : C.eval_ctx) (fid : A.assumed_fun_id)
   assert (generics.trait_refs = []);
   (* [Box::free] has a special treatment *)
   match fid with
-  | A.BoxFree ->
+  | BoxFree ->
       assert (generics.regions = []);
       assert (List.length generics.types = 1);
       assert (generics.const_generics = []);
@@ -583,7 +583,7 @@ let eval_vec_function_concrete (_config : C.config) (_fid : A.assumed_fun_id)
 (** Evaluate a non-local function call in concrete mode *)
 let eval_assumed_function_call_concrete (config : C.config)
     (fid : A.assumed_fun_id) (call : A.call) : cm_fun =
-  let generics = call.generics in
+  let generics = call.func.generics in
   let args = call.args in
   let dest = call.dest in
   (* Sanity check: we don't fully handle the const generic vars environment
@@ -595,7 +595,7 @@ let eval_assumed_function_call_concrete (config : C.config)
      See {!eval_box_free}
   *)
   match fid with
-  | A.BoxFree ->
+  | BoxFree ->
       (* Degenerate case: box_free *)
       eval_box_free config generics args dest
   | _ ->
@@ -636,7 +636,7 @@ let eval_assumed_function_call_concrete (config : C.config)
          * access to a body. *)
         let cf_eval_body : cm_fun =
           match fid with
-          | A.Replace -> eval_replace_concrete config generics
+          | Replace -> eval_replace_concrete config generics
           | BoxNew -> eval_box_new_concrete config generics
           | BoxDeref -> eval_box_deref_concrete config generics
           | BoxDerefMut -> eval_box_deref_mut_concrete config generics
@@ -854,15 +854,14 @@ and eval_global (config : C.config) (dest : E.place) (gid : LA.GlobalDeclId.id)
   match config.mode with
   | ConcreteMode ->
       (* Treat the evaluation of the global as a call to the global body (without arguments) *)
-      let call =
+      let func =
         {
-          A.func = A.FunId (A.Regular global.body_id);
+          E.func = FunId (Regular global.body_id);
           generics = TypesUtils.mk_empty_generic_args;
           trait_and_method_generic_args = None;
-          args = [];
-          dest;
         }
       in
+      let call = { A.func; args = []; dest } in
       (eval_transparent_function_call_concrete config global.body_id call)
         cf ctx
   | SymbolicMode ->
@@ -1019,29 +1018,28 @@ and eval_function_call (config : C.config) (call : A.call) : st_cm_fun =
 and eval_function_call_concrete (config : C.config) (call : A.call) : st_cm_fun
     =
  fun cf ctx ->
-  match call.func with
-  | A.FunId (A.Regular fid) ->
+  match call.func.func with
+  | FunId (Regular fid) ->
       eval_transparent_function_call_concrete config fid call cf ctx
-  | A.FunId (A.Assumed fid) ->
+  | FunId (Assumed fid) ->
       (* Continue - note that we do as if the function call has been successful,
        * by giving {!Unit} to the continuation, because we place us in the case
        * where we haven't panicked. Of course, the translation needs to take the
        * panic case into account... *)
       eval_assumed_function_call_concrete config fid call (cf Unit) ctx
-  | A.TraitMethod _ -> raise (Failure "Unimplemented")
+  | TraitMethod _ -> raise (Failure "Unimplemented")
 
 and eval_function_call_symbolic (config : C.config) (call : A.call) : st_cm_fun
     =
-  match call.func with
-  | A.FunId (A.Regular _) | A.TraitMethod _ ->
+  match call.func.func with
+  | FunId (Regular _) | TraitMethod _ ->
       eval_transparent_function_call_symbolic config call
-  | A.FunId (A.Assumed fid) ->
-      eval_assumed_function_call_symbolic config fid call
+  | FunId (Assumed fid) -> eval_assumed_function_call_symbolic config fid call
 
 (** Evaluate a local (i.e., non-assumed) function call in concrete mode *)
 and eval_transparent_function_call_concrete (config : C.config)
     (fid : A.FunDeclId.id) (call : A.call) : st_cm_fun =
-  let generics = call.A.generics in
+  let generics = call.func.generics in
   let args = call.A.args in
   let dest = call.A.dest in
   (* Sanity check: we don't fully handle the const generic vars environment
@@ -1195,29 +1193,29 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
      to a trait clause but directly to the method provided in the trait declaration.
   *)
   let func, generics, def, inst_sg =
-    match call.func with
-    | A.FunId (A.Regular fid) ->
+    match call.func.func with
+    | FunId (Regular fid) ->
         let def = C.ctx_lookup_fun_decl ctx fid in
         let tr_self = T.UnknownTrait __FUNCTION__ in
         let inst_sg =
-          instantiate_fun_sig ctx call.generics tr_self def.A.signature
+          instantiate_fun_sig ctx call.func.generics tr_self def.A.signature
         in
-        (call.func, call.generics, def, inst_sg)
-    | A.FunId (A.Assumed _) ->
+        (call.func.func, call.func.generics, def, inst_sg)
+    | FunId (Assumed _) ->
         (* Unreachable: must be a transparent function *)
         raise (Failure "Unreachable")
-    | A.TraitMethod (trait_ref, method_name, _) -> (
+    | TraitMethod (trait_ref, method_name, _) -> (
         log#ldebug
           (lazy
             ("trait method call:\n- call: " ^ call_to_string ctx call
            ^ "\n- method name: " ^ method_name ^ "\n- call.generics:\n"
-            ^ egeneric_args_to_string ctx call.generics
+            ^ egeneric_args_to_string ctx call.func.generics
             ^ "\n- trait and method generics:\n"
             ^ egeneric_args_to_string ctx
-                (Option.get call.trait_and_method_generic_args)));
+                (Option.get call.func.trait_and_method_generic_args)));
         (* When instantiating, we need to group the generics for the trait ref
            and the method *)
-        let generics = Option.get call.trait_and_method_generic_args in
+        let generics = Option.get call.func.trait_and_method_generic_args in
         (* Lookup the trait method signature - there are several possibilities
            depending on whethere we call a top-level trait method impl or the
            method from a local clause *)
@@ -1251,7 +1249,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
                    which implements the method. In order to do this properly,
                    we also need to update the generics.
                 *)
-                let func = A.FunId (A.Regular id) in
+                let func = E.FunId (Regular id) in
                 (func, generics, method_def, inst_sg)
             | None ->
                 (* If not found, lookup the methods provided by the trait *declaration*
@@ -1287,7 +1285,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
                 *)
                 let all_generics =
                   TypesUtils.merge_generic_args
-                    trait_ref.trait_decl_ref.decl_generics call.generics
+                    trait_ref.trait_decl_ref.decl_generics call.func.generics
                 in
                 log#ldebug
                   (lazy
@@ -1304,7 +1302,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
                   instantiate_fun_sig ctx all_generics tr_self
                     method_def.A.signature
                 in
-                (call.func, call.generics, method_def, inst_sg))
+                (call.func.func, call.func.generics, method_def, inst_sg))
         | _ ->
             (* We are using a local clause - we lookup the trait decl *)
             let trait_decl =
@@ -1333,7 +1331,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
             let inst_sg =
               instantiate_fun_sig ctx generics tr_self method_def.A.signature
             in
-            (call.func, call.generics, method_def, inst_sg))
+            (call.func.func, call.func.generics, method_def, inst_sg))
   in
   (* Sanity check *)
   assert (List.length call.args = List.length def.A.signature.inputs);
@@ -1357,6 +1355,18 @@ and eval_function_call_symbolic_from_inst_sig (config : C.config)
     (generics : T.egeneric_args) (args : E.operand list) (dest : E.place) :
     st_cm_fun =
  fun cf ctx ->
+  log#ldebug
+    (lazy
+      ("eval_function_call_symbolic_from_inst_sig:\n- fid: "
+      ^ fun_id_or_trait_method_ref_to_string ctx fid
+      ^ "\n- inst_sg:\n"
+      ^ inst_fun_sig_to_string ctx inst_sg
+      ^ "\n- call.generics:\n"
+      ^ egeneric_args_to_string ctx generics
+      ^ "\n- args:\n"
+      ^ String.concat ", " (List.map (operand_to_string ctx) args)
+      ^ "\n- dest:\n" ^ place_to_string ctx dest));
+
   (* Generate a fresh symbolic value for the return value *)
   let ret_sv_ty = inst_sg.A.output in
   let ret_spc = mk_fresh_symbolic_value V.FunCallRet ret_sv_ty in
@@ -1487,7 +1497,7 @@ and eval_function_call_symbolic_from_inst_sig (config : C.config)
 and eval_assumed_function_call_symbolic (config : C.config)
     (fid : A.assumed_fun_id) (call : A.call) : st_cm_fun =
  fun cf ctx ->
-  let generics = call.generics in
+  let generics = call.func.generics in
   let args = call.args in
   let dest = call.dest in
   (* Sanity check: make sure the type parameters don't contain regions -
@@ -1503,7 +1513,7 @@ and eval_assumed_function_call_symbolic (config : C.config)
        See {!eval_box_free}
   *)
   match fid with
-  | A.BoxFree ->
+  | BoxFree ->
       (* Degenerate case: box_free - note that this is not really a function
        * call: no need to call a "synthesize_..." function *)
       eval_box_free config generics args dest (cf Unit) ctx
@@ -1514,7 +1524,7 @@ and eval_assumed_function_call_symbolic (config : C.config)
        * instantiated signatures, and delegate the work to an auxiliary function *)
       let inst_sig =
         match fid with
-        | A.BoxFree ->
+        | BoxFree ->
             (* should have been treated above *)
             raise (Failure "Unreachable")
         | _ ->
@@ -1525,7 +1535,7 @@ and eval_assumed_function_call_symbolic (config : C.config)
       in
 
       (* Evaluate the function call *)
-      eval_function_call_symbolic_from_inst_sig config (A.FunId (A.Assumed fid))
+      eval_function_call_symbolic_from_inst_sig config (FunId (Assumed fid))
         inst_sig generics args dest cf ctx
 
 (** Evaluate a statement seen as a function body *)
diff --git a/compiler/InterpreterUtils.ml b/compiler/InterpreterUtils.ml
index 7aaee6ff..6e08e553 100644
--- a/compiler/InterpreterUtils.ml
+++ b/compiler/InterpreterUtils.ml
@@ -46,6 +46,11 @@ let operand_to_string = PA.operand_to_string
 let egeneric_args_to_string = PA.egeneric_args_to_string
 let rtrait_instance_id_to_string = PA.rtrait_instance_id_to_string
 let fun_sig_to_string = PA.fun_sig_to_string
+let inst_fun_sig_to_string = PA.inst_fun_sig_to_string
+
+let fun_id_or_trait_method_ref_to_string =
+  PA.fun_id_or_trait_method_ref_to_string
+
 let fun_decl_to_string = PA.fun_decl_to_string
 let call_to_string = PA.call_to_string
 
diff --git a/compiler/Print.ml b/compiler/Print.ml
index 5d5c16ee..1d5ddc50 100644
--- a/compiler/Print.ml
+++ b/compiler/Print.ml
@@ -359,6 +359,18 @@ module Values = struct
     ^ "}" ^ "{regions="
     ^ T.RegionId.Set.to_string None abs.regions
     ^ "}" ^ " {\n" ^ avs ^ "\n" ^ indent ^ "}"
+
+  let inst_fun_sig_to_string (fmt : value_formatter) (sg : LlbcAst.inst_fun_sig)
+      : string =
+    (* TODO: print the trait type constraints? *)
+    let ty_fmt = value_to_rtype_formatter fmt in
+    let ty_to_string = PT.ty_to_string ty_fmt in
+
+    let inputs =
+      "(" ^ String.concat ", " (List.map ty_to_string sg.inputs) ^ ")"
+    in
+    let output = ty_to_string sg.output in
+    inputs ^ " -> " ^ output
 end
 
 module PV = Values (* local module *)
@@ -755,6 +767,17 @@ module EvalCtxLlbcAst = struct
     let fmt = PC.eval_ctx_to_ast_formatter ctx in
     PA.fun_sig_to_string fmt "" "  " x
 
+  let inst_fun_sig_to_string (ctx : C.eval_ctx) (x : LlbcAst.inst_fun_sig) :
+      string =
+    let fmt = PC.eval_ctx_to_ast_formatter ctx in
+    let fmt = PC.ast_to_value_formatter fmt in
+    PV.inst_fun_sig_to_string fmt x
+
+  let fun_id_or_trait_method_ref_to_string (ctx : C.eval_ctx)
+      (x : E.fun_id_or_trait_method_ref) : string =
+    let fmt = PC.eval_ctx_to_ast_formatter ctx in
+    PE.fun_id_or_trait_method_ref_to_string fmt x "..."
+
   let statement_to_string (ctx : C.eval_ctx) (indent : string)
       (indent_incr : string) (e : A.statement) : string =
     let fmt = PC.eval_ctx_to_ast_formatter ctx in
diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml
index 5fb5978b..be7b3cb4 100644
--- a/compiler/PrintPure.ml
+++ b/compiler/PrintPure.ml
@@ -593,17 +593,17 @@ let fun_suffix (lp_id : LoopId.id option) (rg_id : T.RegionGroupId.id option) :
 
 let llbc_assumed_fun_id_to_string (fid : A.assumed_fun_id) : string =
   match fid with
-  | A.Replace -> "core::mem::replace"
-  | A.BoxNew -> "alloc::boxed::Box::new"
-  | A.BoxDeref -> "core::ops::deref::Deref::deref"
-  | A.BoxDerefMut -> "core::ops::deref::DerefMut::deref_mut"
-  | A.BoxFree -> "alloc::alloc::box_free"
-  | A.VecNew -> "alloc::vec::Vec::new"
-  | A.VecPush -> "alloc::vec::Vec::push"
-  | A.VecInsert -> "alloc::vec::Vec::insert"
-  | A.VecLen -> "alloc::vec::Vec::len"
-  | A.VecIndex -> "core::ops::index::Index<alloc::vec::Vec>::index"
-  | A.VecIndexMut -> "core::ops::index::IndexMut<alloc::vec::Vec>::index_mut"
+  | Replace -> "core::mem::replace"
+  | BoxNew -> "alloc::boxed::Box::new"
+  | BoxDeref -> "core::ops::deref::Deref::deref"
+  | BoxDerefMut -> "core::ops::deref::DerefMut::deref_mut"
+  | BoxFree -> "alloc::alloc::box_free"
+  | VecNew -> "alloc::vec::Vec::new"
+  | VecPush -> "alloc::vec::Vec::push"
+  | VecInsert -> "alloc::vec::Vec::insert"
+  | VecLen -> "alloc::vec::Vec::len"
+  | VecIndex -> "core::ops::index::Index<alloc::vec::Vec>::index"
+  | VecIndexMut -> "core::ops::index::IndexMut<alloc::vec::Vec>::index_mut"
   | ArrayIndexShared -> "@ArrayIndexShared"
   | ArrayIndexMut -> "@ArrayIndexMut"
   | ArrayToSliceShared -> "@ArrayToSliceShared"
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index cedc3559..b00509a6 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -791,7 +791,7 @@ let expression_contains_child_call_in_all_paths (ctx : trans_ctx)
                     let id0 =
                       match id0 with
                       | FunId fun_id -> fun_id
-                      | TraitMethod (_, _, fun_decl_id) -> A.Regular fun_decl_id
+                      | TraitMethod (_, _, fun_decl_id) -> Regular fun_decl_id
                     in
                     LlbcAstUtils.lookup_fun_sig id0 ctx.fun_ctx.fun_decls
                   in
@@ -1523,29 +1523,29 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl =
         match opt_destruct_function_call e with
         | Some (fun_id, _tys, args) -> (
             match fun_id with
-            | Fun (FromLlbc (FunId (A.Assumed aid), _lp_id, rg_id)) -> (
+            | Fun (FromLlbc (FunId (Assumed aid), _lp_id, rg_id)) -> (
                 (* Below, when dealing with the arguments: we consider the very
                  * general case, where functions could be boxed (meaning we
                  * could have: [box_new f x])
                  * *)
                 match (aid, rg_id) with
-                | A.BoxNew, _ ->
+                | BoxNew, _ ->
                     assert (rg_id = None);
                     let arg, args = Collections.List.pop args in
                     mk_apps arg args
-                | A.BoxDeref, None ->
+                | BoxDeref, None ->
                     (* [Box::deref] forward is the identity *)
                     let arg, args = Collections.List.pop args in
                     mk_apps arg args
-                | A.BoxDeref, Some _ ->
+                | BoxDeref, Some _ ->
                     (* [Box::deref] backward is [()] (doesn't give back anything) *)
                     assert (args = []);
                     mk_unit_rvalue
-                | A.BoxDerefMut, None ->
+                | BoxDerefMut, None ->
                     (* [Box::deref_mut] forward is the identity *)
                     let arg, args = Collections.List.pop args in
                     mk_apps arg args
-                | A.BoxDerefMut, Some _ ->
+                | BoxDerefMut, Some _ ->
                     (* [Box::deref_mut] back is almost the identity:
                      * let box_deref_mut (x_init : t) (x_back : t) : t = x_back
                      * *)
@@ -1555,15 +1555,15 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl =
                       | _ -> raise (Failure "Unreachable")
                     in
                     mk_apps arg args
-                | A.BoxFree, _ ->
+                | BoxFree, _ ->
                     assert (args = []);
                     mk_unit_rvalue
-                | ( ( A.Replace | VecNew | VecPush | VecInsert | VecLen
-                    | VecIndex | VecIndexMut | ArraySubsliceShared
-                    | ArraySubsliceMut | SliceIndexShared | SliceIndexMut
-                    | SliceSubsliceShared | SliceSubsliceMut | ArrayIndexShared
-                    | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut
-                    | ArrayRepeat | SliceLen ),
+                | ( ( Replace | VecNew | VecPush | VecInsert | VecLen | VecIndex
+                    | VecIndexMut | ArraySubsliceShared | ArraySubsliceMut
+                    | SliceIndexShared | SliceIndexMut | SliceSubsliceShared
+                    | SliceSubsliceMut | ArrayIndexShared | ArrayIndexMut
+                    | ArrayToSliceShared | ArrayToSliceMut | ArrayRepeat
+                    | SliceLen ),
                     _ ) ->
                     super#visit_texpression env e)
             | _ -> super#visit_texpression env e)
@@ -2046,7 +2046,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) :
     let inputs_set = VarId.Set.of_list (List.map var_get_id inputs_prefix) in
     assert (Option.is_some decl.loop_id);
 
-    let fun_id = (A.Regular decl.def_id, decl.loop_id) in
+    let fun_id = (E.Regular decl.def_id, decl.loop_id) in
 
     let set_used vid =
       used := List.map (fun (vid', b) -> (vid', b || vid = vid')) !used
@@ -2130,7 +2130,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) :
   (* We then apply the filtering to all the function definitions at once *)
   let filter_in_one (decl : fun_decl) : fun_decl =
     (* Filter the function signature *)
-    let fun_id = (A.Regular decl.def_id, decl.loop_id) in
+    let fun_id = (E.Regular decl.def_id, decl.loop_id) in
     let decl =
       match FunLoopIdMap.find_opt fun_id !used_map with
       | None -> (* Nothing to filter *) decl
diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index 429198ad..54221cb1 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -343,7 +343,7 @@ let bs_ctx_lookup_llbc_fun_decl (id : A.FunDeclId.id) (ctx : bs_ctx) :
 (* TODO: move *)
 let bs_ctx_lookup_local_function_sig (def_id : A.FunDeclId.id)
     (back_id : T.RegionGroupId.id option) (ctx : bs_ctx) : fun_sig =
-  let id = (A.Regular def_id, back_id) in
+  let id = (E.Regular def_id, back_id) in
   (RegularFunIdNotLoopMap.find id ctx.fun_context.fun_sigs).sg
 
 (* Some generic translation functions (we need to translate different "flavours"
@@ -390,6 +390,7 @@ and translate_trait_instance_id (translate_ty : 'r T.ty -> ty)
       let inst_id = translate_trait_instance_id inst_id in
       ItemClause (inst_id, decl_id, item_name, clause_id)
   | TraitRef tr -> TraitRef (translate_trait_ref translate_ty tr)
+  | FnPointer _ -> raise (Failure "TODO")
   | UnknownTrait s -> raise (Failure ("Unknown trait found: " ^ s))
 
 let rec translate_sty (ty : T.sty) : ty =
@@ -427,6 +428,7 @@ let rec translate_sty (ty : T.sty) : ty =
       let trait_ref = translate_strait_ref trait_ref in
       let generics = translate_sgeneric_args generics in
       TraitType (trait_ref, generics, type_name)
+  | Arrow _ -> raise (Failure "TODO")
 
 and translate_sgeneric_args (generics : T.sgeneric_args) : generic_args =
   translate_generic_args translate_sty generics
@@ -569,6 +571,7 @@ let rec translate_fwd_ty (type_infos : TA.type_infos) (ty : 'r T.ty) : ty =
       let trait_ref = translate_fwd_trait_ref type_infos trait_ref in
       let generics = translate_fwd_generic_args type_infos generics in
       TraitType (trait_ref, generics, type_name)
+  | Arrow _ -> raise (Failure "TODO")
 
 and translate_fwd_generic_args (type_infos : TA.type_infos)
     (generics : 'r T.generic_args) : generic_args =
@@ -658,6 +661,7 @@ let rec translate_back_ty (type_infos : TA.type_infos)
       let trait_ref = translate_fwd_trait_ref type_infos trait_ref in
       let generics = translate_fwd_generic_args type_infos generics in
       Some (TraitType (trait_ref, generics, type_name))
+  | Arrow _ -> raise (Failure "TODO")
 
 (** Simply calls [translate_back_ty] *)
 let ctx_translate_back_ty (ctx : bs_ctx) (keep_region : 'r -> bool)
@@ -694,7 +698,7 @@ let type_check_texpression (ctx : bs_ctx) (e : texpression) : unit =
 let translate_fun_id_or_trait_method_ref (ctx : bs_ctx)
     (id : A.fun_id_or_trait_method_ref) : fun_id_or_trait_method_ref =
   match id with
-  | A.FunId fun_id -> FunId fun_id
+  | FunId fun_id -> FunId fun_id
   | TraitMethod (trait_ref, method_name, fun_decl_id) ->
       let type_infos = ctx.type_context.type_infos in
       let trait_ref = translate_fwd_trait_ref type_infos trait_ref in
@@ -795,7 +799,7 @@ let get_fun_effect_info (fun_infos : FA.fun_info A.FunDeclId.Map.t)
     (fun_id : A.fun_id_or_trait_method_ref) (lid : V.LoopId.id option)
     (gid : T.RegionGroupId.id option) : fun_effect_info =
   match fun_id with
-  | A.TraitMethod (_, _, fid) | A.FunId (A.Regular fid) ->
+  | TraitMethod (_, _, fid) | FunId (Regular fid) ->
       let info = A.FunDeclId.Map.find fid fun_infos in
       let stateful_group = info.stateful in
       let stateful =
@@ -808,7 +812,7 @@ let get_fun_effect_info (fun_infos : FA.fun_info A.FunDeclId.Map.t)
         can_diverge = info.can_diverge;
         is_rec = info.is_rec || Option.is_some lid;
       }
-  | A.FunId (A.Assumed aid) ->
+  | FunId (Assumed aid) ->
       assert (lid = None);
       {
         can_fail = Assumed.assumed_can_fail aid;
@@ -841,7 +845,7 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id)
   in
   (* Is the function stateful, and can it fail? *)
   let lid = None in
-  let effect_info = get_fun_effect_info fun_infos (A.FunId fun_id) lid bid in
+  let effect_info = get_fun_effect_info fun_infos (FunId fun_id) lid bid in
   (* We need an evaluation context to normalize the types (to normalize the
      associated types, etc. - for instance it may happen that the types
      refer to the types associated to a trait ref, but where the trait ref
@@ -1706,18 +1710,20 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) :
             in
             (ctx, Unop (Neg int_ty), effect_info, args, None)
         | _ -> raise (Failure "Unreachable"))
-    | S.Unop (E.Cast (src_ty, tgt_ty)) ->
-        (* Note that cast can fail *)
-        let effect_info =
-          {
-            can_fail = true;
-            stateful_group = false;
-            stateful = false;
-            can_diverge = false;
-            is_rec = false;
-          }
-        in
-        (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, None)
+    | S.Unop (E.Cast cast_kind) -> (
+        match cast_kind with
+        | CastInteger (src_ty, tgt_ty) ->
+            (* Note that cast can fail *)
+            let effect_info =
+              {
+                can_fail = true;
+                stateful_group = false;
+                stateful = false;
+                can_diverge = false;
+                is_rec = false;
+              }
+            in
+            (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, None))
     | S.Binop binop -> (
         match args with
         | [ arg0; arg1 ] ->
@@ -1925,7 +1931,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs)
   (* Sanity check: there is the proper number of inputs and outputs, and they have the proper type *)
   (if (* TODO: normalize the types *) !Config.type_check_pure_code then
      match fun_id with
-     | A.FunId fun_id ->
+     | FunId fun_id ->
          let inst_sg =
            get_instantiated_fun_sig fun_id (Some rg_id) generics ctx
          in
@@ -2088,9 +2094,9 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs)
       (* Actually the same case as [SynthInput] *)
       translate_end_abstraction_synth_input ectx abs e ctx rg_id
   | V.LoopCall ->
-      let fun_id = A.Regular ctx.fun_decl.A.def_id in
+      let fun_id = E.Regular ctx.fun_decl.A.def_id in
       let effect_info =
-        get_fun_effect_info ctx.fun_context.fun_infos (A.FunId fun_id)
+        get_fun_effect_info ctx.fun_context.fun_infos (FunId fun_id)
           (Some vloop_id) (Some rg_id)
       in
       let loop_info = LoopId.Map.find loop_id ctx.loops in
@@ -2553,9 +2559,9 @@ and translate_forward_end (ectx : C.eval_ctx)
       let org_args = args in
 
       (* Lookup the effect info for the loop function *)
-      let fid = A.Regular ctx.fun_decl.A.def_id in
+      let fid = E.Regular ctx.fun_decl.A.def_id in
       let effect_info =
-        get_fun_effect_info ctx.fun_context.fun_infos (A.FunId fid) None ctx.bid
+        get_fun_effect_info ctx.fun_context.fun_infos (FunId fid) None ctx.bid
       in
 
       (* Introduce a fresh output value for the forward function *)
diff --git a/compiler/SynthesizeSymbolic.ml b/compiler/SynthesizeSymbolic.ml
index aeb6899f..9084f2b3 100644
--- a/compiler/SynthesizeSymbolic.ml
+++ b/compiler/SynthesizeSymbolic.ml
@@ -85,7 +85,7 @@ let synthesize_symbolic_expansion (sv : V.symbolic_value)
             match ls with
             | [ (Some see, exp) ] -> ExpandNoBranch (see, exp)
             | _ -> raise (Failure "Ill-formed borrow expansion"))
-        | T.TypeVar _ | T.Literal Char | Never | T.TraitType _ ->
+        | T.TypeVar _ | T.Literal Char | Never | T.TraitType _ | T.Arrow _ ->
             raise (Failure "Ill-formed symbolic expansion")
       in
       Some (Expansion (place, sv, expansion))
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index e69abee1..8e01c869 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -61,7 +61,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
 
   (* Initialize the context *)
   let forward_sig =
-    RegularFunIdNotLoopMap.find (A.Regular def_id, None) fun_sigs
+    RegularFunIdNotLoopMap.find (E.Regular def_id, None) fun_sigs
   in
   let sv_to_var = V.SymbolicValueId.Map.empty in
   let var_counter = Pure.VarId.generator_zero in
@@ -200,7 +200,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
         (* Initialize the context - note that the ret_ty is not really
          * useful as we don't translate a body *)
         let backward_sg =
-          RegularFunIdNotLoopMap.find (A.Regular def_id, Some back_id) fun_sigs
+          RegularFunIdNotLoopMap.find (Regular def_id, Some back_id) fun_sigs
         in
         let ctx = { ctx with bid = Some back_id; sg = backward_sg.sg } in
 
@@ -211,7 +211,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
            variables required by the backward function.
         *)
         let backward_sg =
-          RegularFunIdNotLoopMap.find (A.Regular def_id, Some back_id) fun_sigs
+          RegularFunIdNotLoopMap.find (Regular def_id, Some back_id) fun_sigs
         in
         (* We need to ignore the forward inputs, and the state input (if there is) *)
         let backward_inputs =
@@ -298,7 +298,7 @@ let translate_crate_to_pure (crate : A.crate) :
   let assumed_sigs =
     List.map
       (fun (id, sg, _, _) ->
-        (A.Assumed id, List.map (fun _ -> None) (sg : A.fun_sig).inputs, sg))
+        (E.Assumed id, List.map (fun _ -> None) (sg : A.fun_sig).inputs, sg))
       Assumed.assumed_infos
   in
   let local_sigs =
@@ -312,7 +312,7 @@ let translate_crate_to_pure (crate : A.crate) :
                 (fun (v : A.var) -> v.name)
                 (LlbcAstUtils.fun_body_get_input_vars body)
         in
-        (A.Regular fdef.def_id, input_names, fdef.signature))
+        (E.Regular fdef.def_id, input_names, fdef.signature))
       (A.FunDeclId.Map.values crate.functions)
   in
   let sigs = List.append assumed_sigs local_sigs in
diff --git a/compiler/TypesAnalysis.ml b/compiler/TypesAnalysis.ml
index 95c7206a..4a187893 100644
--- a/compiler/TypesAnalysis.ml
+++ b/compiler/TypesAnalysis.ml
@@ -232,6 +232,14 @@ let analyze_full_ty (r_is_static : 'r -> bool) (updated : bool ref)
         in
         (* Return *)
         ty_info
+    | Arrow (inputs, output) ->
+        (* Just dive into the arrow *)
+        let ty_info =
+          List.fold_left
+            (fun ty_info ty -> analyze expl_info ty_info ty)
+            ty_info inputs
+        in
+        analyze expl_info ty_info output
   in
   (* Explore *)
   analyze expl_info_init ty_info ty
-- 
cgit v1.3.1


From 838cc86cb2efc8fb64a94a94b58b82d66844e7e4 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 23 Oct 2023 13:47:39 +0200
Subject: Remove some assumed types and add more support for builtin
 definitions

---
 compiler/Assumed.ml                | 254 +++++---------------
 compiler/Extract.ml                | 145 ++++++------
 compiler/ExtractAssumed.ml         |  61 -----
 compiler/ExtractBase.ml            |  73 +-----
 compiler/ExtractBuiltin.ml         | 468 +++++++++++++++++++++++++++++++++++++
 compiler/FunsAnalysis.ml           |   2 +-
 compiler/InterpreterExpansion.ml   |  15 +-
 compiler/InterpreterExpressions.ml | 100 +++-----
 compiler/InterpreterPaths.ml       |  31 +--
 compiler/InterpreterPaths.mli      |   4 -
 compiler/InterpreterStatements.ml  | 100 +-------
 compiler/Invariants.ml             |  15 +-
 compiler/LlbcAstUtils.ml           |   8 +-
 compiler/PrePasses.ml              |   2 +-
 compiler/Print.ml                  |  11 -
 compiler/PrintPure.ml              |  57 +----
 compiler/Pure.ml                   |  12 +-
 compiler/PureMicroPasses.ml        |  42 ++--
 compiler/PureTypeCheck.ml          |  13 +-
 compiler/Substitute.ml             |  14 +-
 compiler/SymbolicToPure.ml         |  31 +--
 compiler/Translate.ml              | 107 +++++----
 compiler/TypesAnalysis.ml          |   4 +-
 compiler/dune                      |   2 +-
 24 files changed, 763 insertions(+), 808 deletions(-)
 delete mode 100644 compiler/ExtractAssumed.ml
 create mode 100644 compiler/ExtractBuiltin.ml

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Assumed.ml b/compiler/Assumed.ml
index b1ec0660..94fb7a72 100644
--- a/compiler/Assumed.ml
+++ b/compiler/Assumed.ml
@@ -80,8 +80,6 @@ module Sig = struct
   let mk_slice_ty (ty : T.sty) : T.sty =
     Adt (Assumed Slice, mk_generic_args [] [ ty ] [])
 
-  let range_ty : T.sty = Adt (Assumed Range, mk_generic_args [] [ usize_ty ] [])
-
   let mk_sig generics regions_hierarchy inputs output : A.fun_sig =
     let preds : T.predicates =
       { regions_outlive = []; types_outlive = []; trait_type_constraints = [] }
@@ -95,19 +93,6 @@ module Sig = struct
       output;
     }
 
-  (** [fn<T>(&'a mut T, T) -> T] *)
-  let mem_replace_sig : A.fun_sig =
-    (* The signature fields *)
-    let regions = [ region_param_0 ] (* <'a> *) in
-    let regions_hierarchy = [ region_group_0 ] (* [{<'a>}] *) in
-    let types = [ type_param_0 ] (* <T> *) in
-    let generics = mk_generic_params regions types [] in
-    let inputs =
-      [ mk_ref_ty rvar_0 tvar_0 true (* &'a mut T *); tvar_0 (* T *) ]
-    in
-    let output = tvar_0 (* T *) in
-    mk_sig generics regions_hierarchy inputs output
-
   (** [fn<T>(T) -> Box<T>] *)
   let box_new_sig : A.fun_sig =
     let generics = mk_generic_params [] [ type_param_0 ] [] (* <T> *) in
@@ -124,101 +109,6 @@ module Sig = struct
     let output = mk_unit_ty (* () *) in
     mk_sig generics regions_hierarchy inputs output
 
-  (** Helper for [Box::deref_shared] and [Box::deref_mut].
-      Returns:
-      [fn<'a, T>(&'a (mut) Box<T>) -> &'a (mut) T]
-  *)
-  let box_deref_gen_sig (is_mut : bool) : A.fun_sig =
-    let generics =
-      mk_generic_params [ region_param_0 ] [ type_param_0 ] [] (* <'a, T> *)
-    in
-    let regions_hierarchy = [ region_group_0 ] (* <'a> *) in
-    let inputs =
-      [ mk_ref_ty rvar_0 (mk_box_ty tvar_0) is_mut (* &'a (mut) Box<T> *) ]
-    in
-    let output = mk_ref_ty rvar_0 tvar_0 is_mut (* &'a (mut) T *) in
-    mk_sig generics regions_hierarchy inputs output
-
-  (** [fn<'a, T>(&'a Box<T>) -> &'a T] *)
-  let box_deref_shared_sig = box_deref_gen_sig false
-
-  (** [fn<'a, T>(&'a mut Box<T>) -> &'a mut T] *)
-  let box_deref_mut_sig = box_deref_gen_sig true
-
-  (** [fn<T>() -> Vec<T>] *)
-  let vec_new_sig : A.fun_sig =
-    let generics = mk_generic_params [] [ type_param_0 ] [] (* <T> *) in
-    let regions_hierarchy = [] in
-    let inputs = [] in
-    let output = mk_vec_ty tvar_0 (* Vec<T> *) in
-    mk_sig generics regions_hierarchy inputs output
-
-  (** [fn<T>(&'a mut Vec<T>, T)] *)
-  let vec_push_sig : A.fun_sig =
-    let generics =
-      mk_generic_params [ region_param_0 ] [ type_param_0 ] [] (* <'a, T> *)
-    in
-    let regions_hierarchy = [ region_group_0 ] (* <'a> *) in
-    let inputs =
-      [
-        mk_ref_ty rvar_0 (mk_vec_ty tvar_0) true (* &'a mut Vec<T> *);
-        tvar_0 (* T *);
-      ]
-    in
-    let output = mk_unit_ty (* () *) in
-    mk_sig generics regions_hierarchy inputs output
-
-  (** [fn<T>(&'a mut Vec<T>, usize, T)] *)
-  let vec_insert_sig : A.fun_sig =
-    let generics =
-      mk_generic_params [ region_param_0 ] [ type_param_0 ] [] (* <'a, T> *)
-    in
-    let regions_hierarchy = [ region_group_0 ] (* <'a> *) in
-    let inputs =
-      [
-        mk_ref_ty rvar_0 (mk_vec_ty tvar_0) true (* &'a mut Vec<T> *);
-        mk_usize_ty (* usize *);
-        tvar_0 (* T *);
-      ]
-    in
-    let output = mk_unit_ty (* () *) in
-    mk_sig generics regions_hierarchy inputs output
-
-  (** [fn<T>(&'a Vec<T>) -> usize] *)
-  let vec_len_sig : A.fun_sig =
-    let generics =
-      mk_generic_params [ region_param_0 ] [ type_param_0 ] [] (* <'a, T> *)
-    in
-    let regions_hierarchy = [ region_group_0 ] (* <'a> *) in
-    let inputs =
-      [ mk_ref_ty rvar_0 (mk_vec_ty tvar_0) false (* &'a Vec<T> *) ]
-    in
-    let output = mk_usize_ty (* usize *) in
-    mk_sig generics regions_hierarchy inputs output
-
-  (** Helper:
-      [fn<T>(&'a (mut) Vec<T>, usize) -> &'a (mut) T]
-   *)
-  let vec_index_gen_sig (is_mut : bool) : A.fun_sig =
-    let generics =
-      mk_generic_params [ region_param_0 ] [ type_param_0 ] [] (* <'a, T> *)
-    in
-    let regions_hierarchy = [ region_group_0 ] (* <'a> *) in
-    let inputs =
-      [
-        mk_ref_ty rvar_0 (mk_vec_ty tvar_0) is_mut (* &'a (mut) Vec<T> *);
-        mk_usize_ty (* usize *);
-      ]
-    in
-    let output = mk_ref_ty rvar_0 tvar_0 is_mut (* &'a (mut) T *) in
-    mk_sig generics regions_hierarchy inputs output
-
-  (** [fn<T>(&'a Vec<T>, usize) -> &'a T] *)
-  let vec_index_shared_sig : A.fun_sig = vec_index_gen_sig false
-
-  (** [fn<T>(&'a mut Vec<T>, usize) -> &'a mut T] *)
-  let vec_index_mut_sig : A.fun_sig = vec_index_gen_sig true
-
   (** Array/slice functions *)
 
   (** Small helper.
@@ -281,23 +171,6 @@ module Sig = struct
     let cgs = [ cg_param_0 ] in
     mk_array_slice_borrow_sig cgs input_ty None output_ty is_mut
 
-  let mk_array_slice_subslice_sig (is_array : bool) (is_mut : bool) : A.fun_sig
-      =
-    (* Array<T, N> *)
-    let input_ty id =
-      if is_array then mk_array_ty (T.TypeVar id) cgvar_0
-      else mk_slice_ty (T.TypeVar id)
-    in
-    (* Range *)
-    let index_ty = range_ty in
-    (* Slice<T> *)
-    let output_ty id = mk_slice_ty (T.TypeVar id) in
-    let cgs = if is_array then [ cg_param_0 ] else [] in
-    mk_array_slice_borrow_sig cgs input_ty (Some index_ty) output_ty is_mut
-
-  let array_subslice_sig (is_mut : bool) =
-    mk_array_slice_subslice_sig true is_mut
-
   let array_repeat_sig =
     let generics =
       (* <T, N> *)
@@ -311,9 +184,6 @@ module Sig = struct
     in
     mk_sig generics regions_hierarchy inputs output
 
-  let slice_subslice_sig (is_mut : bool) =
-    mk_array_slice_subslice_sig false is_mut
-
   (** Helper:
       [fn<T>(&'a [T]) -> usize]
    *)
@@ -329,7 +199,25 @@ module Sig = struct
     mk_sig generics regions_hierarchy inputs output
 end
 
-type assumed_info = A.assumed_fun_id * A.fun_sig * bool * name
+type raw_assumed_fun_info =
+  A.assumed_fun_id * A.fun_sig * bool * name * bool list option
+
+type assumed_fun_info = {
+  fun_id : A.assumed_fun_id;
+  fun_sig : A.fun_sig;
+  can_fail : bool;
+  name : name;
+  keep_types : bool list option;
+      (** We may want to filter some type arguments.
+
+          For instance, all the `Vec` functions (and the `Vec` type itself) take
+          an `Allocator` type as argument, that we ignore.
+       *)
+}
+
+let mk_assumed_fun_info (raw : raw_assumed_fun_info) : assumed_fun_info =
+  let fun_id, fun_sig, can_fail, name, keep_types = raw in
+  { fun_id; fun_sig; can_fail; name; keep_types }
 
 (** The list of assumed functions and all their information:
     - their signature
@@ -342,96 +230,72 @@ type assumed_info = A.assumed_fun_id * A.fun_sig * bool * name
     a [usize], we have to make sure that vectors are bounded by the max usize.
     As a consequence, [Vec::push] is monadic.
  *)
-let assumed_infos : assumed_info list =
-  let deref_pre = [ "core"; "ops"; "deref" ] in
-  let vec_pre = [ "alloc"; "vec"; "Vec" ] in
-  let index_pre = [ "core"; "ops"; "index" ] in
+let raw_assumed_fun_infos : raw_assumed_fun_info list =
   [
-    (Replace, Sig.mem_replace_sig, false, to_name [ "core"; "mem"; "replace" ]);
-    (BoxNew, Sig.box_new_sig, false, to_name [ "alloc"; "boxed"; "Box"; "new" ]);
+    ( BoxNew,
+      Sig.box_new_sig,
+      false,
+      to_name [ "alloc"; "boxed"; "Box"; "new" ],
+      Some [ true; false ] );
+    (* BoxFree shouldn't be used *)
     ( BoxFree,
       Sig.box_free_sig,
       false,
-      to_name [ "alloc"; "boxed"; "Box"; "free" ] );
-    ( BoxDeref,
-      Sig.box_deref_shared_sig,
-      false,
-      to_name (deref_pre @ [ "Deref"; "deref" ]) );
-    ( BoxDerefMut,
-      Sig.box_deref_mut_sig,
-      false,
-      to_name (deref_pre @ [ "DerefMut"; "deref_mut" ]) );
-    (VecNew, Sig.vec_new_sig, false, to_name (vec_pre @ [ "new" ]));
-    (VecPush, Sig.vec_push_sig, true, to_name (vec_pre @ [ "push" ]));
-    (VecInsert, Sig.vec_insert_sig, true, to_name (vec_pre @ [ "insert" ]));
-    (VecLen, Sig.vec_len_sig, false, to_name (vec_pre @ [ "len" ]));
-    ( VecIndex,
-      Sig.vec_index_shared_sig,
-      true,
-      to_name (index_pre @ [ "Index"; "index" ]) );
-    ( VecIndexMut,
-      Sig.vec_index_mut_sig,
-      true,
-      to_name (index_pre @ [ "IndexMut"; "index_mut" ]) );
+      to_name [ "alloc"; "boxed"; "Box"; "free" ],
+      Some [ true; false ] );
     (* Array Index *)
     ( ArrayIndexShared,
       Sig.array_index_sig false,
       true,
-      to_name [ "@ArrayIndexShared" ] );
-    (ArrayIndexMut, Sig.array_index_sig true, true, to_name [ "@ArrayIndexMut" ]);
+      to_name [ "@ArrayIndexShared" ],
+      None );
+    ( ArrayIndexMut,
+      Sig.array_index_sig true,
+      true,
+      to_name [ "@ArrayIndexMut" ],
+      None );
     (* Array to slice*)
     ( ArrayToSliceShared,
       Sig.array_to_slice_sig false,
       true,
-      to_name [ "@ArrayToSliceShared" ] );
+      to_name [ "@ArrayToSliceShared" ],
+      None );
     ( ArrayToSliceMut,
       Sig.array_to_slice_sig true,
       true,
-      to_name [ "@ArrayToSliceMut" ] );
-    (* Array Subslice *)
-    ( ArraySubsliceShared,
-      Sig.array_subslice_sig false,
-      true,
-      to_name [ "@ArraySubsliceShared" ] );
-    ( ArraySubsliceMut,
-      Sig.array_subslice_sig true,
-      true,
-      to_name [ "@ArraySubsliceMut" ] );
+      to_name [ "@ArrayToSliceMut" ],
+      None );
     (* Array Repeat *)
-    (ArrayRepeat, Sig.array_repeat_sig, false, to_name [ "@ArrayRepeat" ]);
+    (ArrayRepeat, Sig.array_repeat_sig, false, to_name [ "@ArrayRepeat" ], None);
     (* Slice Index *)
     ( SliceIndexShared,
       Sig.slice_index_sig false,
       true,
-      to_name [ "@SliceIndexShared" ] );
-    (SliceIndexMut, Sig.slice_index_sig true, true, to_name [ "@SliceIndexMut" ]);
-    (* Slice Subslice *)
-    ( SliceSubsliceShared,
-      Sig.slice_subslice_sig false,
+      to_name [ "@SliceIndexShared" ],
+      None );
+    ( SliceIndexMut,
+      Sig.slice_index_sig true,
       true,
-      to_name [ "@SliceSubsliceShared" ] );
-    ( SliceSubsliceMut,
-      Sig.slice_subslice_sig true,
-      true,
-      to_name [ "@SliceSubsliceMut" ] );
-    (SliceLen, Sig.slice_len_sig, false, to_name [ "@SliceLen" ]);
+      to_name [ "@SliceIndexMut" ],
+      None );
+    (SliceLen, Sig.slice_len_sig, false, to_name [ "@SliceLen" ], None);
   ]
 
-let get_assumed_info (id : A.assumed_fun_id) : assumed_info =
-  match List.find_opt (fun (id', _, _, _) -> id = id') assumed_infos with
+let assumed_fun_infos : assumed_fun_info list =
+  List.map mk_assumed_fun_info raw_assumed_fun_infos
+
+let get_assumed_fun_info (id : A.assumed_fun_id) : assumed_fun_info =
+  match List.find_opt (fun x -> id = x.fun_id) assumed_fun_infos with
   | Some info -> info
   | None ->
       raise
-        (Failure ("get_assumed_info: not found: " ^ A.show_assumed_fun_id id))
+        (Failure ("get_assumed_fun_info: not found: " ^ A.show_assumed_fun_id id))
 
-let get_assumed_sig (id : A.assumed_fun_id) : A.fun_sig =
-  let _, sg, _, _ = get_assumed_info id in
-  sg
+let get_assumed_fun_sig (id : A.assumed_fun_id) : A.fun_sig =
+  (get_assumed_fun_info id).fun_sig
 
-let get_assumed_name (id : A.assumed_fun_id) : fun_name =
-  let _, _, _, name = get_assumed_info id in
-  name
+let get_assumed_fun_name (id : A.assumed_fun_id) : fun_name =
+  (get_assumed_fun_info id).name
 
-let assumed_can_fail (id : A.assumed_fun_id) : bool =
-  let _, _, b, _ = get_assumed_info id in
-  b
+let assumed_fun_can_fail (id : A.assumed_fun_id) : bool =
+  (get_assumed_fun_info id).can_fail
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 688f6ce3..30c4c27d 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -225,12 +225,9 @@ let assumed_adts () : (assumed_ty * string) list =
         (Result, "Result");
         (Error, "Error");
         (Fuel, "Nat");
-        (Option, "Option");
-        (Vec, "Vec");
         (Array, "Array");
         (Slice, "Slice");
         (Str, "Str");
-        (Range, "Range");
       ]
   | Coq | FStar ->
       [
@@ -238,12 +235,9 @@ let assumed_adts () : (assumed_ty * string) list =
         (Result, "result");
         (Error, "error");
         (Fuel, "nat");
-        (Option, "option");
-        (Vec, "vec");
         (Array, "array");
         (Slice, "slice");
         (Str, "str");
-        (Range, "range");
       ]
   | HOL4 ->
       [
@@ -251,20 +245,17 @@ let assumed_adts () : (assumed_ty * string) list =
         (Result, "result");
         (Error, "error");
         (Fuel, "num");
-        (Option, "option");
-        (Vec, "vec");
         (Array, "array");
         (Slice, "slice");
         (Str, "str");
-        (Range, "range");
       ]
 
 let assumed_struct_constructors () : (assumed_ty * string) list =
   match !backend with
-  | Lean -> [ (Range, "Range.mk"); (Array, "Array.make") ]
-  | Coq -> [ (Range, "mk_range"); (Array, "mk_array") ]
-  | FStar -> [ (Range, "Mkrange"); (Array, "mk_array") ]
-  | HOL4 -> [ (Range, "mk_range"); (Array, "mk_array") ]
+  | Lean -> [ (Array, "Array.make") ]
+  | Coq -> [ (Array, "mk_array") ]
+  | FStar -> [ (Array, "mk_array") ]
+  | HOL4 -> [ (Array, "mk_array") ]
 
 let assumed_variants () : (assumed_ty * VariantId.id * string) list =
   match !backend with
@@ -276,8 +267,6 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list =
         (Error, error_out_of_fuel_id, "OutOfFuel");
         (* No Fuel::Zero on purpose *)
         (* No Fuel::Succ on purpose *)
-        (Option, option_some_id, "Some");
-        (Option, option_none_id, "None");
       ]
   | Coq ->
       [
@@ -287,8 +276,6 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list =
         (Error, error_out_of_fuel_id, "OutOfFuel");
         (Fuel, fuel_zero_id, "O");
         (Fuel, fuel_succ_id, "S");
-        (Option, option_some_id, "Some");
-        (Option, option_none_id, "None");
       ]
   | Lean ->
       [
@@ -297,8 +284,6 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list =
         (Error, error_failure_id, "panic");
         (* No Fuel::Zero on purpose *)
         (* No Fuel::Succ on purpose *)
-        (Option, option_some_id, "some");
-        (Option, option_none_id, "none");
       ]
   | HOL4 ->
       [
@@ -307,8 +292,6 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list =
         (Error, error_failure_id, "Failure");
         (* No Fuel::Zero on purpose *)
         (* No Fuel::Succ on purpose *)
-        (Option, option_some_id, "SOME");
-        (Option, option_none_id, "NONE");
       ]
 
 let assumed_llbc_functions () :
@@ -317,66 +300,30 @@ let assumed_llbc_functions () :
   match !backend with
   | FStar | Coq | HOL4 ->
       [
-        (Replace, None, "mem_replace_fwd");
-        (Replace, rg0, "mem_replace_back");
-        (VecNew, None, "vec_new");
-        (VecPush, None, "vec_push_fwd") (* Shouldn't be used *);
-        (VecPush, rg0, "vec_push_back");
-        (VecInsert, None, "vec_insert_fwd") (* Shouldn't be used *);
-        (VecInsert, rg0, "vec_insert_back");
-        (VecLen, None, "vec_len");
-        (VecIndex, None, "vec_index_fwd");
-        (VecIndex, rg0, "vec_index_back") (* shouldn't be used *);
-        (VecIndexMut, None, "vec_index_mut_fwd");
-        (VecIndexMut, rg0, "vec_index_mut_back");
         (ArrayIndexShared, None, "array_index_shared");
         (ArrayIndexMut, None, "array_index_mut_fwd");
         (ArrayIndexMut, rg0, "array_index_mut_back");
         (ArrayToSliceShared, None, "array_to_slice_shared");
         (ArrayToSliceMut, None, "array_to_slice_mut_fwd");
         (ArrayToSliceMut, rg0, "array_to_slice_mut_back");
-        (ArraySubsliceShared, None, "array_subslice_shared");
-        (ArraySubsliceMut, None, "array_subslice_mut_fwd");
-        (ArraySubsliceMut, rg0, "array_subslice_mut_back");
         (ArrayRepeat, None, "array_repeat");
         (SliceIndexShared, None, "slice_index_shared");
         (SliceIndexMut, None, "slice_index_mut_fwd");
         (SliceIndexMut, rg0, "slice_index_mut_back");
-        (SliceSubsliceShared, None, "slice_subslice_shared");
-        (SliceSubsliceMut, None, "slice_subslice_mut_fwd");
-        (SliceSubsliceMut, rg0, "slice_subslice_mut_back");
         (SliceLen, None, "slice_len");
       ]
   | Lean ->
       [
-        (Replace, None, "mem.replace");
-        (Replace, rg0, "mem.replace_back");
-        (VecNew, None, "Vec.new");
-        (VecPush, None, "Vec.push_fwd") (* Shouldn't be used *);
-        (VecPush, rg0, "Vec.push");
-        (VecInsert, None, "Vec.insert_fwd") (* Shouldn't be used *);
-        (VecInsert, rg0, "Vec.insert");
-        (VecLen, None, "Vec.len");
-        (VecIndex, None, "Vec.index_shared");
-        (VecIndex, rg0, "Vec.index_shared_back") (* shouldn't be used *);
-        (VecIndexMut, None, "Vec.index_mut");
-        (VecIndexMut, rg0, "Vec.index_mut_back");
         (ArrayIndexShared, None, "Array.index_shared");
         (ArrayIndexMut, None, "Array.index_mut");
         (ArrayIndexMut, rg0, "Array.index_mut_back");
         (ArrayToSliceShared, None, "Array.to_slice_shared");
         (ArrayToSliceMut, None, "Array.to_slice_mut");
         (ArrayToSliceMut, rg0, "Array.to_slice_mut_back");
-        (ArraySubsliceShared, None, "Array.subslice_shared");
-        (ArraySubsliceMut, None, "Array.subslice_mut");
-        (ArraySubsliceMut, rg0, "Array.subslice_mut_back");
         (ArrayRepeat, None, "Array.repeat");
         (SliceIndexShared, None, "Slice.index_shared");
         (SliceIndexMut, None, "Slice.index_mut");
         (SliceIndexMut, rg0, "Slice.index_mut_back");
-        (SliceSubsliceShared, None, "Slice.subslice_shared");
-        (SliceSubsliceMut, None, "Slice.subslice_mut");
-        (SliceSubsliceMut, rg0, "Slice.subslice_mut_back");
         (SliceLen, None, "Slice.len");
       ]
 
@@ -850,12 +797,9 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
             | Assumed Result -> "r"
             | Assumed Error -> ConstStrings.error_basename
             | Assumed Fuel -> ConstStrings.fuel_basename
-            | Assumed Option -> "opt"
-            | Assumed Vec -> "v"
             | Assumed Array -> "a"
             | Assumed Slice -> "s"
             | Assumed Str -> "s"
-            | Assumed Range -> "r"
             | Assumed State -> ConstStrings.state_basename
             | AdtId adt_id ->
                 let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
@@ -1397,8 +1341,18 @@ and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter)
  *)
 let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
     extraction_ctx =
+  (* Lookup the builtin information, if there is *)
+  let open ExtractBuiltin in
+  let sname = name_to_simple_name def.name in
+  let info = SimpleNameMap.find_opt sname (builtin_types_map ()) in
   (* Compute and register the type def name *)
-  let ctx = ctx_add_type_decl def ctx in
+  let def_name =
+    match info with
+    | None -> ctx.fmt.type_name def.name
+    | Some info -> info.rust_name
+  in
+  let is_opaque = def.kind = Opaque in
+  let ctx = ctx_add is_opaque (TypeId (AdtId def.def_id)) def_name ctx in
   (* Compute and register:
    * - the variant names, if this is an enumeration
    * - the field names, if this is a structure
@@ -1406,18 +1360,73 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
   let ctx =
     match def.kind with
     | Struct fields ->
+        (* Compute the names *)
+        let field_names, cons_name =
+          match info with
+          | None ->
+              let field_names =
+                FieldId.mapi
+                  (fun fid (field : field) ->
+                    (fid, ctx.fmt.field_name def.name fid field.field_name))
+                  fields
+              in
+              let cons_name = ctx.fmt.struct_constructor def.name in
+              (field_names, cons_name)
+          | Some { body_info = Some (Struct (cons_name, field_names)); _ } ->
+              let field_names =
+                FieldId.mapi
+                  (fun fid (_, name) -> (fid, name))
+                  (List.combine fields field_names)
+              in
+              (field_names, cons_name)
+          | _ -> raise (Failure "Invalid builtin information")
+        in
         (* Add the fields *)
         let ctx =
-          fst
-            (ctx_add_fields def (FieldId.mapi (fun id f -> (id, f)) fields) ctx)
+          List.fold_left
+            (fun ctx (fid, name) ->
+              ctx_add is_opaque (FieldId (AdtId def.def_id, fid)) name ctx)
+            ctx field_names
         in
         (* Add the constructor name *)
-        fst (ctx_add_struct def ctx)
+        ctx_add is_opaque (StructId (AdtId def.def_id)) cons_name ctx
     | Enum variants ->
-        fst
-          (ctx_add_variants def
-             (VariantId.mapi (fun id v -> (id, v)) variants)
-             ctx)
+        let variant_names =
+          match info with
+          | None ->
+              VariantId.mapi
+                (fun variant_id (variant : variant) ->
+                  let name =
+                    ctx.fmt.variant_name def.name variant.variant_name
+                  in
+                  (* Add the type name prefix for Lean *)
+                  let name =
+                    if !Config.backend = Lean then
+                      let type_name = ctx.fmt.type_name def.name in
+                      type_name ^ "." ^ name
+                    else name
+                  in
+                  (variant_id, name))
+                variants
+          | Some { body_info = Some (Enum variant_infos); _ } ->
+              (* We need to compute the map from variant to variant *)
+              let variant_map =
+                StringMap.of_list
+                  (List.map
+                     (fun (info : builtin_enum_variant_info) ->
+                       (info.rust_variant_name, info.extract_variant_name))
+                     variant_infos)
+              in
+              VariantId.mapi
+                (fun variant_id (variant : variant) ->
+                  (variant_id, StringMap.find variant.variant_name variant_map))
+                variants
+          | _ -> raise (Failure "Invalid builtin information")
+        in
+        List.fold_left
+          (fun ctx (vid, vname) ->
+            ctx_add is_opaque (VariantId (AdtId def.def_id, vid)) vname ctx)
+          ctx variant_names
     | Opaque ->
         (* Nothing to do *)
         ctx
diff --git a/compiler/ExtractAssumed.ml b/compiler/ExtractAssumed.ml
deleted file mode 100644
index 7f094b24..00000000
--- a/compiler/ExtractAssumed.ml
+++ /dev/null
@@ -1,61 +0,0 @@
-(** This file declares external identifiers that we catch to map them to
-    definitions coming from the standard libraries in our backends. *)
-
-open Names
-
-type simple_name = string list [@@deriving show, ord]
-
-let name_to_simple_name (s : name) : simple_name =
-  (* We simply ignore the disambiguators *)
-  List.filter_map (function Ident id -> Some id | Disambiguator _ -> None) s
-
-(** Small helper which cuts a string at the occurrences of "::" *)
-let string_to_simple_name (s : string) : simple_name =
-  (* No function to split by using string separator?? *)
-  let name = String.split_on_char ':' s in
-  List.filter (fun s -> s <> "") name
-
-module SimpleNameOrd = struct
-  type t = simple_name
-
-  let compare = compare_simple_name
-  let to_string = show_simple_name
-  let pp_t = pp_simple_name
-  let show_t = show_simple_name
-end
-
-module SimpleNameMap = Collections.MakeMap (SimpleNameOrd)
-
-let assumed_globals : (string * string) list =
-  [
-    (* Min *)
-    ("core::num::usize::MIN", "core_usize_min");
-    ("core::num::u8::MIN", "core_u8_min");
-    ("core::num::u16::MIN", "core_u16_min");
-    ("core::num::u32::MIN", "core_u32_min");
-    ("core::num::u64::MIN", "core_u64_min");
-    ("core::num::u128::MIN", "core_u128_min");
-    ("core::num::isize::MIN", "core_isize_min");
-    ("core::num::i8::MIN", "core_i8_min");
-    ("core::num::i16::MIN", "core_i16_min");
-    ("core::num::i32::MIN", "core_i32_min");
-    ("core::num::i64::MIN", "core_i64_min");
-    ("core::num::i128::MIN", "core_i128_min");
-    (* Max *)
-    ("core::num::usize::MAX", "core_usize_max");
-    ("core::num::u8::MAX", "core_u8_max");
-    ("core::num::u16::MAX", "core_u16_max");
-    ("core::num::u32::MAX", "core_u32_max");
-    ("core::num::u64::MAX", "core_u64_max");
-    ("core::num::u128::MAX", "core_u128_max");
-    ("core::num::isize::MAX", "core_isize_max");
-    ("core::num::i8::MAX", "core_i8_max");
-    ("core::num::i16::MAX", "core_i16_max");
-    ("core::num::i32::MAX", "core_i32_max");
-    ("core::num::i64::MAX", "core_i64_max");
-    ("core::num::i128::MAX", "core_i128_max");
-  ]
-
-let assumed_globals_map : string SimpleNameMap.t =
-  SimpleNameMap.of_list
-    (List.map (fun (x, y) -> (string_to_simple_name x, y)) assumed_globals)
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index a921515b..54f69735 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -5,7 +5,7 @@ open TranslateCore
 module C = Contexts
 module RegionVarId = T.RegionVarId
 module F = Format
-open ExtractAssumed
+open ExtractBuiltin
 
 (** The local logger *)
 let log = L.pure_to_extract_log
@@ -803,15 +803,11 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
             if variant_id = error_failure_id then "@error::Failure"
             else if variant_id = error_out_of_fuel_id then "@error::OutOfFuel"
             else raise (Failure "Unreachable")
-        | Assumed Option ->
-            if variant_id = option_some_id then "@option::Some"
-            else if variant_id = option_none_id then "@option::None"
-            else raise (Failure "Unreachable")
         | Assumed Fuel ->
             if variant_id = fuel_zero_id then "@fuel::0"
             else if variant_id = fuel_succ_id then "@fuel::Succ"
             else raise (Failure "Unreachable")
-        | Assumed (State | Vec | Array | Slice | Str | Range) ->
+        | Assumed (State | Array | Slice | Str) ->
             raise
               (Failure
                  ("Unreachable: variant id ("
@@ -830,9 +826,7 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       let field_name =
         match id with
         | Tuple -> raise (Failure "Unreachable")
-        | Assumed
-            ( State | Result | Error | Fuel | Option | Vec | Array | Slice | Str
-            | Range ) ->
+        | Assumed (State | Result | Error | Fuel | Array | Slice | Str) ->
             (* We can't directly have access to the fields of those types *)
             raise (Failure "Unreachable")
         | AdtId id -> (
@@ -1186,65 +1180,6 @@ let ctx_add_generic_params (generics : generic_params) (ctx : extraction_ctx) :
   let ctx, tcs = ctx_add_local_trait_clauses trait_clauses ctx in
   (ctx, tys, cgs, tcs)
 
-let ctx_add_type_decl_struct (def : type_decl) (ctx : extraction_ctx) :
-    extraction_ctx * string =
-  assert (match def.kind with Struct _ -> true | _ -> false);
-  let is_opaque = false in
-  let cons_name = ctx.fmt.struct_constructor def.name in
-  let ctx = ctx_add is_opaque (StructId (AdtId def.def_id)) cons_name ctx in
-  (ctx, cons_name)
-
-let ctx_add_type_decl (def : type_decl) (ctx : extraction_ctx) : extraction_ctx
-    =
-  let is_opaque = def.kind = Opaque in
-  let def_name = ctx.fmt.type_name def.name in
-  let ctx = ctx_add is_opaque (TypeId (AdtId def.def_id)) def_name ctx in
-  ctx
-
-let ctx_add_field (def : type_decl) (field_id : FieldId.id) (field : field)
-    (ctx : extraction_ctx) : extraction_ctx * string =
-  let is_opaque = false in
-  let name = ctx.fmt.field_name def.name field_id field.field_name in
-  let ctx = ctx_add is_opaque (FieldId (AdtId def.def_id, field_id)) name ctx in
-  (ctx, name)
-
-let ctx_add_fields (def : type_decl) (fields : (FieldId.id * field) list)
-    (ctx : extraction_ctx) : extraction_ctx * string list =
-  List.fold_left_map
-    (fun ctx (vid, v) -> ctx_add_field def vid v ctx)
-    ctx fields
-
-let ctx_add_variant (def : type_decl) (variant_id : VariantId.id)
-    (variant : variant) (ctx : extraction_ctx) : extraction_ctx * string =
-  let is_opaque = false in
-  let name = ctx.fmt.variant_name def.name variant.variant_name in
-  (* Add the type name prefix for Lean *)
-  let name =
-    if !Config.backend = Lean then
-      let type_name = ctx.fmt.type_name def.name in
-      type_name ^ "." ^ name
-    else name
-  in
-  let ctx =
-    ctx_add is_opaque (VariantId (AdtId def.def_id, variant_id)) name ctx
-  in
-  (ctx, name)
-
-let ctx_add_variants (def : type_decl)
-    (variants : (VariantId.id * variant) list) (ctx : extraction_ctx) :
-    extraction_ctx * string list =
-  List.fold_left_map
-    (fun ctx (vid, v) -> ctx_add_variant def vid v ctx)
-    ctx variants
-
-let ctx_add_struct (def : type_decl) (ctx : extraction_ctx) :
-    extraction_ctx * string =
-  assert (match def.kind with Struct _ -> true | _ -> false);
-  let is_opaque = false in
-  let name = ctx.fmt.struct_constructor def.name in
-  let ctx = ctx_add is_opaque (StructId (AdtId def.def_id)) name ctx in
-  (ctx, name)
-
 let ctx_add_decreases_proof (def : fun_decl) (ctx : extraction_ctx) :
     extraction_ctx =
   let is_opaque = false in
@@ -1277,7 +1212,7 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
      to a custom definition in our standard library (for instance, happens
      with "core::num::usize::MAX") *)
   let sname = name_to_simple_name def.name in
-  match SimpleNameMap.find_opt sname assumed_globals_map with
+  match SimpleNameMap.find_opt sname builtin_globals_map with
   | Some name ->
       (* Yes: register the custom binding *)
       ctx_add is_opaque decl name ctx
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
new file mode 100644
index 00000000..cf5cc70d
--- /dev/null
+++ b/compiler/ExtractBuiltin.ml
@@ -0,0 +1,468 @@
+(** This file declares external identifiers that we catch to map them to
+    definitions coming from the standard libraries in our backends. *)
+
+open Names
+open Config
+
+type simple_name = string list [@@deriving show, ord]
+
+let name_to_simple_name (s : name) : simple_name =
+  (* We simply ignore the disambiguators *)
+  List.filter_map (function Ident id -> Some id | Disambiguator _ -> None) s
+
+(** Small helper which cuts a string at the occurrences of "::" *)
+let string_to_simple_name (s : string) : simple_name =
+  (* No function to split by using string separator?? *)
+  let name = String.split_on_char ':' s in
+  List.filter (fun s -> s <> "") name
+
+module SimpleNameOrd = struct
+  type t = simple_name
+
+  let compare = compare_simple_name
+  let to_string = show_simple_name
+  let pp_t = pp_simple_name
+  let show_t = show_simple_name
+end
+
+module SimpleNameMap = Collections.MakeMap (SimpleNameOrd)
+
+(** Small utility to memoize some computations *)
+let mk_memoized (f : unit -> 'a) : unit -> 'a =
+  let r = ref None in
+  let g () =
+    match !r with
+    | Some x -> x
+    | None ->
+        let x = f () in
+        r := Some x;
+        x
+  in
+  g
+
+let builtin_globals : (string * string) list =
+  [
+    (* Min *)
+    ("core::num::usize::MIN", "core_usize_min");
+    ("core::num::u8::MIN", "core_u8_min");
+    ("core::num::u16::MIN", "core_u16_min");
+    ("core::num::u32::MIN", "core_u32_min");
+    ("core::num::u64::MIN", "core_u64_min");
+    ("core::num::u128::MIN", "core_u128_min");
+    ("core::num::isize::MIN", "core_isize_min");
+    ("core::num::i8::MIN", "core_i8_min");
+    ("core::num::i16::MIN", "core_i16_min");
+    ("core::num::i32::MIN", "core_i32_min");
+    ("core::num::i64::MIN", "core_i64_min");
+    ("core::num::i128::MIN", "core_i128_min");
+    (* Max *)
+    ("core::num::usize::MAX", "core_usize_max");
+    ("core::num::u8::MAX", "core_u8_max");
+    ("core::num::u16::MAX", "core_u16_max");
+    ("core::num::u32::MAX", "core_u32_max");
+    ("core::num::u64::MAX", "core_u64_max");
+    ("core::num::u128::MAX", "core_u128_max");
+    ("core::num::isize::MAX", "core_isize_max");
+    ("core::num::i8::MAX", "core_i8_max");
+    ("core::num::i16::MAX", "core_i16_max");
+    ("core::num::i32::MAX", "core_i32_max");
+    ("core::num::i64::MAX", "core_i64_max");
+    ("core::num::i128::MAX", "core_i128_max");
+  ]
+
+let builtin_globals_map : string SimpleNameMap.t =
+  SimpleNameMap.of_list
+    (List.map (fun (x, y) -> (string_to_simple_name x, y)) builtin_globals)
+
+type builtin_variant_info = { fields : (string * string) list }
+
+type builtin_enum_variant_info = {
+  rust_variant_name : string;
+  extract_variant_name : string;
+  fields : string list option;
+}
+
+type builtin_type_body_info =
+  | Struct of string * string list
+    (* The constructor name and the map for the field names *)
+  | Enum of builtin_enum_variant_info list
+(* For every variant, a map for the field names *)
+
+type builtin_type_info = {
+  rust_name : string;
+  extract_name : string;
+  keep_params : bool list option;
+      (** We might want to filter some of the type parameters.
+
+          For instance, `Vec` type takes a type parameter for the allocator,
+          which we want to ignore.
+       *)
+  body_info : builtin_type_body_info option;
+}
+
+(** The assumed types.
+
+    The optional list of booleans is filtering information for the type
+    parameters. For instance, in the case of the `Vec` functions, there is
+    a type parameter for the allocator to use, which we want to filter.
+ *)
+let builtin_types () : builtin_type_info list =
+  [
+    (* Alloc *)
+    {
+      rust_name = "alloc::alloc::Global";
+      extract_name =
+        (match !backend with
+        | Lean -> "AllocGlobal"
+        | Coq | FStar | HOL4 -> "alloc_global");
+      keep_params = None;
+      body_info = None;
+    };
+    (* Vec *)
+    {
+      rust_name = "alloc::vec::Vec";
+      extract_name =
+        (match !backend with Lean -> "Vec" | Coq | FStar | HOL4 -> "vec");
+      keep_params = Some [ true; false ];
+      body_info = None;
+    };
+    (* Option *)
+    {
+      rust_name = "core::option::Option";
+      extract_name =
+        (match !backend with
+        | Lean -> "Option"
+        | Coq | FStar | HOL4 -> "option");
+      keep_params = None;
+      body_info =
+        Some
+          (Enum
+             [
+               {
+                 rust_variant_name = "None";
+                 extract_variant_name =
+                   (match !backend with
+                   | FStar | Coq -> "None"
+                   | Lean -> "none"
+                   | HOL4 -> "NONE");
+                 fields = None;
+               };
+               {
+                 rust_variant_name = "Some";
+                 extract_variant_name =
+                   (match !backend with
+                   | FStar | Coq -> "Some"
+                   | Lean -> "some"
+                   | HOL4 -> "SOME");
+                 fields = None;
+               };
+             ]);
+    };
+    (* Range *)
+    {
+      rust_name = "core::ops::range::Range";
+      extract_name =
+        (match !backend with Lean -> "Range" | Coq | FStar | HOL4 -> "range");
+      keep_params = None;
+      body_info =
+        Some
+          (Struct
+             ( (match !backend with
+               | Lean -> "Range.mk"
+               | Coq | HOL4 -> "mk_range"
+               | FStar -> "Mkrange"),
+               [ "start"; "end_" ] ));
+    };
+  ]
+
+let mk_builtin_types_map () =
+  SimpleNameMap.of_list
+    (List.map
+       (fun info -> (string_to_simple_name info.rust_name, info))
+       (builtin_types ()))
+
+let builtin_types_map = mk_memoized mk_builtin_types_map
+
+type builtin_fun_info = {
+  rg : Types.RegionGroupId.id option;
+  extract_name : string;
+}
+
+(** The assumed functions.
+
+    The optional list of booleans is filtering information for the type
+    parameters. For instance, in the case of the `Vec` functions, there is
+    a type parameter for the allocator to use, which we want to filter.
+ *)
+let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
+  let rg0 = Some Types.RegionGroupId.zero in
+  [
+    ( "core::mem::replace",
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "mem_replace_fwd"
+            | Lean -> "mem.replace");
+        };
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "mem_replace_back"
+            | Lean -> "mem.replace_back");
+        };
+      ] );
+    ( "alloc::vec::Vec::new",
+      Some [ true; false ],
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_new"
+            | Lean -> "Vec.new");
+        };
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_new_back"
+            | Lean -> "Vec.new_back");
+        };
+      ] );
+    ( "alloc::vec::Vec::push",
+      Some [ true; false ],
+      [
+        (* The forward function shouldn't be used *)
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_push_fwd"
+            | Lean -> "Vec.push_fwd");
+        };
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_push_back"
+            | Lean -> "Vec.push");
+        };
+      ] );
+    ( "alloc::vec::Vec::insert",
+      Some [ true; false ],
+      [
+        (* The forward function shouldn't be used *)
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_insert_fwd"
+            | Lean -> "Vec.insert_fwd");
+        };
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_insert_back"
+            | Lean -> "Vec.insert");
+        };
+      ] );
+    ( "alloc::vec::Vec::len",
+      Some [ true; false ],
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_len"
+            | Lean -> "Vec.len");
+        };
+      ] );
+    ( "alloc::vec::Vec::index",
+      Some [ true; false ],
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_index_fwd"
+            | Lean -> "Vec.index_shared");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_index_back"
+            | Lean -> "Vec.index_shared_back");
+        };
+      ] );
+    ( "alloc::vec::Vec::index_mut",
+      Some [ true; false ],
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_index_mut_fwd"
+            | Lean -> "Vec.index_mut");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "vec_index_mut_back"
+            | Lean -> "Vec.index_mut_back");
+        };
+      ] );
+  ]
+
+let mk_builtin_funs_map () =
+  SimpleNameMap.of_list
+    (List.map
+       (fun (name, filter, info) ->
+         (string_to_simple_name name, (filter, info)))
+       (builtin_funs ()))
+
+let builtin_funs_map () = mk_memoized mk_builtin_funs_map
+
+type builtin_trait_info = {
+  rust_name : string;
+  extract_name : string;
+  parent_clauses : string list;
+  consts : (string * string) list;
+  types : (string * string * string list) list;
+      (** Every type has:
+          - a Rust name
+          - an extraction name
+          - a list of clauses *)
+  funs : (string * Types.RegionGroupId.id option * string) list;
+}
+
+let builtin_traits () =
+  let rg0 = Some Types.RegionGroupId.zero in
+  [
+    {
+      (* Deref *)
+      rust_name = "core::ops::deref::Deref";
+      extract_name =
+        (match !backend with
+        | Coq | FStar | HOL4 -> "core_ops_deref_Deref"
+        | Lean -> "core.ops.deref.Deref");
+      parent_clauses = [];
+      consts = [];
+      types =
+        [
+          ( "Target",
+            (match !backend with
+            | Coq | FStar | HOL4 -> "core_ops_deref_Deref_Target"
+            | Lean -> "Target"),
+            [] );
+        ];
+      funs =
+        [
+          ( "deref",
+            None,
+            match !backend with
+            | Coq | FStar | HOL4 -> "core_ops_deref_Deref_deref"
+            | Lean -> "deref" );
+        ];
+    };
+    {
+      (* DerefMut *)
+      rust_name = "core::ops::deref::DerefMut";
+      extract_name =
+        (match !backend with
+        | Coq | FStar | HOL4 -> "core_ops_deref_DerefMut"
+        | Lean -> "core.ops.deref.DerefMut");
+      parent_clauses =
+        [
+          (match !backend with
+          | Coq | FStar | HOL4 -> "deref_inst"
+          | Lean -> "DerefInst");
+        ];
+      consts = [];
+      types = [];
+      funs =
+        [
+          ( "deref_mut",
+            None,
+            match !backend with
+            | Coq | FStar | HOL4 -> "core_ops_deref_DerefMut_deref_mut"
+            | Lean -> "deref_mut" );
+          ( "deref_mut",
+            rg0,
+            match !backend with
+            | Coq | FStar | HOL4 -> "core_ops_deref_DerefMut_deref_mut_back"
+            | Lean -> "deref_mut_back" );
+        ];
+    };
+    {
+      (* Index *)
+      rust_name = "core::ops::index::Index";
+      extract_name =
+        (match !backend with
+        | Coq | FStar | HOL4 -> "core_ops_index_Index"
+        | Lean -> "core.ops.index.Index");
+      parent_clauses = [];
+      consts = [];
+      types =
+        [
+          ( "Output",
+            (match !backend with
+            | Coq | FStar | HOL4 -> "core_ops_index_Index_Output"
+            | Lean -> "Output"),
+            [] );
+        ];
+      funs =
+        [
+          ( "index",
+            None,
+            match !backend with
+            | Coq | FStar | HOL4 -> "core_ops_index_Index_index"
+            | Lean -> "index" );
+        ];
+    };
+    {
+      (* IndexMut *)
+      rust_name = "core::ops::index::IndexMut";
+      extract_name =
+        (match !backend with
+        | Coq | FStar | HOL4 -> "core_ops_index_IndexMut"
+        | Lean -> "core.ops.index.IndexMut");
+      parent_clauses =
+        [
+          (match !backend with
+          | Coq | FStar | HOL4 -> "index_inst"
+          | Lean -> "IndexInst");
+        ];
+      consts = [];
+      types = [];
+      funs =
+        [
+          ( "index_mut",
+            None,
+            match !backend with
+            | Coq | FStar | HOL4 -> "core_ops_index_IndexMut_mut"
+            | Lean -> "index_mut" );
+          ( "index_mut",
+            rg0,
+            match !backend with
+            | Coq | FStar | HOL4 -> "core_ops_index_IndexMut_mut_back"
+            | Lean -> "index_mut_back" );
+        ];
+    };
+  ]
+
+let mk_builtin_traits_map () =
+  SimpleNameMap.of_list
+    (List.map
+       (fun info -> (string_to_simple_name info.rust_name, info))
+       (builtin_traits ()))
+
+let builtin_traits_map () = mk_memoized mk_builtin_traits_map
diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml
index a09a6d05..5e849ba7 100644
--- a/compiler/FunsAnalysis.ml
+++ b/compiler/FunsAnalysis.ml
@@ -88,7 +88,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
                   can_diverge := !can_diverge || info.can_diverge
             | FunId (Assumed id) ->
                 (* None of the assumed functions can diverge nor are considered stateful *)
-                can_fail := !can_fail || Assumed.assumed_can_fail id
+                can_fail := !can_fail || Assumed.assumed_fun_can_fail id
             | TraitMethod _ ->
                 (* We consider trait functions can fail, diverge, and are not stateful *)
                 can_fail := true;
diff --git a/compiler/InterpreterExpansion.ml b/compiler/InterpreterExpansion.ml
index c1041fa3..167e3d58 100644
--- a/compiler/InterpreterExpansion.ml
+++ b/compiler/InterpreterExpansion.ml
@@ -241,17 +241,6 @@ let compute_expanded_symbolic_non_assumed_adt_value (expand_enumerations : bool)
   (* Initialize all the expanded values of all the variants *)
   List.map initialize variants_fields_types
 
-(** Compute the expansion of an Option value.
- *)
-let compute_expanded_symbolic_option_value (expand_enumerations : bool)
-    (kind : V.sv_kind) (ty : T.rty) : V.symbolic_expansion list =
-  assert expand_enumerations;
-  let some_se =
-    V.SeAdt (Some T.option_some_id, [ mk_fresh_symbolic_value kind ty ])
-  in
-  let none_se = V.SeAdt (Some T.option_none_id, []) in
-  [ none_se; some_se ]
-
 let compute_expanded_symbolic_tuple_value (kind : V.sv_kind)
     (field_types : T.rty list) : V.symbolic_expansion =
   (* Generate the field values *)
@@ -286,8 +275,6 @@ let compute_expanded_symbolic_adt_value (expand_enumerations : bool)
         def_id generics ctx
   | T.Tuple, [], _ ->
       [ compute_expanded_symbolic_tuple_value kind generics.types ]
-  | T.Assumed T.Option, [], [ ty ] ->
-      compute_expanded_symbolic_option_value expand_enumerations kind ty
   | T.Assumed T.Box, [], [ boxed_ty ] ->
       [ compute_expanded_symbolic_box_value kind boxed_ty ]
   | _ ->
@@ -704,7 +691,7 @@ let greedy_expand_symbolics_with_borrows (config : C.config) : cm_fun =
         | T.Adt ((Tuple | Assumed Box), _) | T.Ref (_, _, _) ->
             (* Ok *)
             expand_symbolic_value_no_branching config sv None
-        | T.Adt (Assumed (Vec | Option | Array | Slice | Str | Range), _) ->
+        | T.Adt (Assumed (Array | Slice | Str), _) ->
             (* We can't expand those *)
             raise
               (Failure
diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml
index a42c552a..341e97eb 100644
--- a/compiler/InterpreterExpressions.ml
+++ b/compiler/InterpreterExpressions.ml
@@ -142,10 +142,10 @@ let rec copy_value (allow_adt_copy : bool) (config : C.config)
   | V.Adt av ->
       (* Sanity check *)
       (match v.V.ty with
-      | T.Adt (T.Assumed (T.Box | Vec), _) ->
+      | T.Adt (T.Assumed T.Box, _) ->
           raise (Failure "Can't copy an assumed value other than Option")
       | T.Adt (T.AdtId _, _) -> assert allow_adt_copy
-      | T.Adt ((T.Assumed Option | T.Tuple), _) -> () (* Ok *)
+      | T.Adt (T.Tuple, _) -> () (* Ok *)
       | T.Adt
           ( T.Assumed (Slice | T.Array),
             {
@@ -722,70 +722,38 @@ let eval_rvalue_aggregate (config : C.config)
    fun ctx ->
     (* Match on the aggregate kind *)
     match aggregate_kind with
-    | E.AggregatedTuple ->
-        let tys = List.map (fun (v : V.typed_value) -> v.V.ty) values in
-        let v = V.Adt { variant_id = None; field_values = values } in
-        let generics = TypesUtils.mk_generic_args [] tys [] [] in
-        let ty = T.Adt (T.Tuple, generics) in
-        let aggregated : V.typed_value = { V.value = v; ty } in
-        (* Call the continuation *)
-        cf aggregated ctx
-    | E.AggregatedOption (variant_id, ty) ->
-        (* Sanity check *)
-        if variant_id = T.option_none_id then assert (values = [])
-        else if variant_id = T.option_some_id then
-          assert (List.length values = 1)
-        else raise (Failure "Unreachable");
-        (* Construt the value *)
-        let generics = TypesUtils.mk_generic_args [] [ ty ] [] [] in
-        let aty = T.Adt (T.Assumed T.Option, generics) in
-        let av : V.adt_value =
-          { V.variant_id = Some variant_id; V.field_values = values }
-        in
-        let aggregated : V.typed_value = { V.value = Adt av; ty = aty } in
-        (* Call the continuation *)
-        cf aggregated ctx
-    | E.AggregatedAdt (def_id, opt_variant_id, generics) ->
-        (* Sanity checks *)
-        let type_decl = C.ctx_lookup_type_decl ctx def_id in
-        assert (
-          List.length type_decl.generics.regions = List.length generics.regions);
-        let expected_field_types =
-          Assoc.ctx_adt_get_inst_norm_field_etypes ctx def_id opt_variant_id
-            generics
-        in
-        assert (
-          expected_field_types
-          = List.map (fun (v : V.typed_value) -> v.V.ty) values);
-        (* Construct the value *)
-        let av : V.adt_value =
-          { V.variant_id = opt_variant_id; V.field_values = values }
-        in
-        let aty = T.Adt (T.AdtId def_id, generics) in
-        let aggregated : V.typed_value = { V.value = Adt av; ty = aty } in
-        (* Call the continuation *)
-        cf aggregated ctx
-    | E.AggregatedRange ety ->
-        (* There should be two fields exactly *)
-        let v0, v1 =
-          match values with
-          | [ v0; v1 ] -> (v0, v1)
-          | _ -> raise (Failure "Unreachable")
-        in
-        (* Ranges are parametric over the type of indices. For now we only
-           support scalars, which can be of any type *)
-        assert (literal_type_is_integer (ty_as_literal ety));
-        assert (v0.ty = ety);
-        assert (v1.ty = ety);
-        (* Construct the value *)
-        let av : V.adt_value =
-          { V.variant_id = None; V.field_values = values }
-        in
-        let generics = TypesUtils.mk_generic_args_from_types [ ety ] in
-        let aty = T.Adt (T.Assumed T.Range, generics) in
-        let aggregated : V.typed_value = { V.value = Adt av; ty = aty } in
-        (* Call the continuation *)
-        cf aggregated ctx
+    | E.AggregatedAdt (type_id, opt_variant_id, generics) -> (
+        match type_id with
+        | Tuple ->
+            let tys = List.map (fun (v : V.typed_value) -> v.V.ty) values in
+            let v = V.Adt { variant_id = None; field_values = values } in
+            let generics = TypesUtils.mk_generic_args [] tys [] [] in
+            let ty = T.Adt (T.Tuple, generics) in
+            let aggregated : V.typed_value = { V.value = v; ty } in
+            (* Call the continuation *)
+            cf aggregated ctx
+        | AdtId def_id ->
+            (* Sanity checks *)
+            let type_decl = C.ctx_lookup_type_decl ctx def_id in
+            assert (
+              List.length type_decl.generics.regions
+              = List.length generics.regions);
+            let expected_field_types =
+              Assoc.ctx_adt_get_inst_norm_field_etypes ctx def_id opt_variant_id
+                generics
+            in
+            assert (
+              expected_field_types
+              = List.map (fun (v : V.typed_value) -> v.V.ty) values);
+            (* Construct the value *)
+            let av : V.adt_value =
+              { V.variant_id = opt_variant_id; V.field_values = values }
+            in
+            let aty = T.Adt (T.AdtId def_id, generics) in
+            let aggregated : V.typed_value = { V.value = Adt av; ty = aty } in
+            (* Call the continuation *)
+            cf aggregated ctx
+        | Assumed _ -> raise (Failure "Unreachable"))
     | E.AggregatedArray (ety, cg) -> (
         (* Sanity check: all the values have the proper type *)
         assert (List.for_all (fun (v : V.typed_value) -> v.V.ty = ety) values);
diff --git a/compiler/InterpreterPaths.ml b/compiler/InterpreterPaths.ml
index 465d0028..2a277c91 100644
--- a/compiler/InterpreterPaths.ml
+++ b/compiler/InterpreterPaths.ml
@@ -96,7 +96,7 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
   | pe :: p' -> (
       (* Match on the projection element and the value *)
       match (pe, v.V.value, v.V.ty) with
-      | ( Field (((ProjAdt (_, _) | ProjOption _) as proj_kind), field_id),
+      | ( Field ((ProjAdt (_, _) as proj_kind), field_id),
           V.Adt adt,
           T.Adt (type_id, _) ) -> (
           (* Check consistency *)
@@ -104,8 +104,6 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
           | ProjAdt (def_id, opt_variant_id), T.AdtId def_id' ->
               assert (def_id = def_id');
               assert (opt_variant_id = adt.variant_id)
-          | ProjOption variant_id, T.Assumed T.Option ->
-              assert (Some variant_id = adt.variant_id)
           | _ -> raise (Failure "Unreachable"));
           (* Actually project *)
           let fv = T.FieldId.nth adt.field_values field_id in
@@ -136,7 +134,7 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
               Ok (ctx, { res with updated })
           (* If we reach Bottom, it may mean we need to expand an uninitialized
            * enumeration value *))
-      | Field ((ProjAdt (_, _) | ProjTuple _ | ProjOption _), _), V.Bottom, _ ->
+      | Field ((ProjAdt (_, _) | ProjTuple _), _), V.Bottom, _ ->
           Error (FailBottom (1 + List.length p', pe, v.ty))
       (* Symbolic value: needs to be expanded *)
       | _, Symbolic sp, _ ->
@@ -376,20 +374,6 @@ let compute_expanded_bottom_adt_value (ctx : C.eval_ctx)
   let ty = T.Adt (T.AdtId def_id, generics) in
   { V.value = av; V.ty }
 
-let compute_expanded_bottom_option_value (variant_id : T.VariantId.id)
-    (param_ty : T.ety) : V.typed_value =
-  (* Note that the variant can be [Some] or [None]: we expand bottom values
-   * when writing to fields or setting discriminants *)
-  let field_values =
-    if variant_id = T.option_some_id then [ mk_bottom param_ty ]
-    else if variant_id = T.option_none_id then []
-    else raise (Failure "Unreachable")
-  in
-  let av = V.Adt { variant_id = Some variant_id; field_values } in
-  let generics = TypesUtils.mk_generic_args [] [ param_ty ] [] [] in
-  let ty = T.Adt (T.Assumed T.Option, generics) in
-  { V.value = av; ty }
-
 let compute_expanded_bottom_tuple_value (field_types : T.ety list) :
     V.typed_value =
   (* Generate the field values *)
@@ -451,17 +435,6 @@ let expand_bottom_value_from_projection (access : access_kind) (p : E.place)
         T.Adt (T.AdtId def_id', generics) ) ->
         assert (def_id = def_id');
         compute_expanded_bottom_adt_value ctx def_id opt_variant_id generics
-    (* Option *)
-    | ( Field (ProjOption variant_id, _),
-        T.Adt
-          ( T.Assumed T.Option,
-            {
-              T.regions = [];
-              types = [ ty ];
-              const_generics = [];
-              trait_refs = [];
-            } ) ) ->
-        compute_expanded_bottom_option_value variant_id ty
     (* Tuples *)
     | ( Field (ProjTuple arity, _),
         T.Adt
diff --git a/compiler/InterpreterPaths.mli b/compiler/InterpreterPaths.mli
index 041b0a97..0ff8063f 100644
--- a/compiler/InterpreterPaths.mli
+++ b/compiler/InterpreterPaths.mli
@@ -63,10 +63,6 @@ val compute_expanded_bottom_adt_value :
   T.egeneric_args ->
   V.typed_value
 
-(** Compute an expanded [Option] ⊥ value *)
-val compute_expanded_bottom_option_value :
-  T.VariantId.id -> T.ety -> V.typed_value
-
 (** Drop (end) outer loans at a given place, which should be seen as an l-value
     (we will write to it later, but need to drop the loans before writing).
 
diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml
index 9f35c6f2..2aced79f 100644
--- a/compiler/InterpreterStatements.ml
+++ b/compiler/InterpreterStatements.ml
@@ -10,7 +10,6 @@ open TypesUtils
 open ValuesUtils
 module Inv = Invariants
 module S = SynthesizeSymbolic
-open Utils
 open Cps
 open InterpreterUtils
 open InterpreterProjectors
@@ -233,8 +232,7 @@ let set_discriminant (config : C.config) (p : E.place)
   let update_value cf (v : V.typed_value) : m_fun =
    fun ctx ->
     match (v.V.ty, v.V.value) with
-    | T.Adt (((T.AdtId _ | T.Assumed T.Option) as type_id), generics), V.Adt av
-      -> (
+    | T.Adt ((T.AdtId _ as type_id), generics), V.Adt av -> (
         (* There are two situations:
            - either the discriminant is already the proper one (in which case we
              don't do anything)
@@ -253,24 +251,15 @@ let set_discriminant (config : C.config) (p : E.place)
                 | T.AdtId def_id ->
                     compute_expanded_bottom_adt_value ctx def_id
                       (Some variant_id) generics
-                | T.Assumed T.Option ->
-                    assert (generics.regions = []);
-                    compute_expanded_bottom_option_value variant_id
-                      (Collections.List.to_cons_nil generics.types)
                 | _ -> raise (Failure "Unreachable")
               in
               assign_to_place config bottom_v p (cf Unit) ctx)
-    | T.Adt (((T.AdtId _ | T.Assumed T.Option) as type_id), generics), V.Bottom
-      ->
+    | T.Adt ((T.AdtId _ as type_id), generics), V.Bottom ->
         let bottom_v =
           match type_id with
           | T.AdtId def_id ->
               compute_expanded_bottom_adt_value ctx def_id (Some variant_id)
                 generics
-          | T.Assumed T.Option ->
-              assert (generics.regions = []);
-              compute_expanded_bottom_option_value variant_id
-                (Collections.List.to_cons_nil generics.types)
           | _ -> raise (Failure "Unreachable")
         in
         assign_to_place config bottom_v p (cf Unit) ctx
@@ -313,7 +302,7 @@ let get_assumed_function_return_type (ctx : C.eval_ctx) (fid : A.assumed_fun_id)
       mk_unit_ty
   | _ ->
       (* Retrieve the function's signature *)
-      let sg = Assumed.get_assumed_sig fid in
+      let sg = Assumed.get_assumed_fun_sig fid in
       (* Instantiate the return type  *)
       (* There shouldn't be any reference to Self *)
       let tr_self : T.erased_region T.trait_instance_id =
@@ -426,11 +415,6 @@ let pop_frame_assign (config : C.config) (dest : E.place) : cm_fun =
   in
   comp cf_pop cf_assign
 
-(** Auxiliary function - see {!eval_assumed_function_call} *)
-let eval_replace_concrete (_config : C.config) (_generics : T.egeneric_args) :
-    cm_fun =
- fun _cf _ctx -> raise Unimplemented
-
 (** Auxiliary function - see {!eval_assumed_function_call} *)
 let eval_box_new_concrete (config : C.config) (generics : T.egeneric_args) :
     cm_fun =
@@ -475,67 +459,6 @@ let eval_box_new_concrete (config : C.config) (generics : T.egeneric_args) :
       comp cf_move cf_create cf ctx
   | _ -> raise (Failure "Inconsistent state")
 
-(** Auxiliary function which factorizes code to evaluate [std::Deref::deref]
-    and [std::DerefMut::deref_mut] - see {!eval_assumed_function_call} *)
-let eval_box_deref_mut_or_shared_concrete (config : C.config)
-    (generics : T.egeneric_args) (is_mut : bool) : cm_fun =
- fun cf ctx ->
-  (* Check the arguments *)
-  match
-    (generics.regions, generics.types, generics.const_generics, ctx.env)
-  with
-  | ( [],
-      [ boxed_ty ],
-      [],
-      Var (VarBinder input_var, input_value)
-      :: Var (_ret_var, _)
-      :: C.Frame :: _ ) ->
-      (* Required type checking. We must have:
-         - input_value.ty = & (mut) Box<ty>
-         - boxed_ty = ty
-         for some ty
-      *)
-      (let _, input_ty, ref_kind = ty_get_ref input_value.V.ty in
-       assert (match ref_kind with T.Shared -> not is_mut | T.Mut -> is_mut);
-       let input_ty = ty_get_box input_ty in
-       assert (input_ty = boxed_ty));
-
-      (* Borrow the boxed value *)
-      let p =
-        { E.var_id = input_var.C.index; projection = [ E.Deref; E.DerefBox ] }
-      in
-      let borrow_kind = if is_mut then E.Mut else E.Shared in
-      let rv = E.RvRef (p, borrow_kind) in
-      let cf_borrow = eval_rvalue_not_global config rv in
-
-      (* Move the borrow to its destination *)
-      let cf_move cf res : m_fun =
-        match res with
-        | Error EPanic ->
-            (* We can't get there by borrowing a value *)
-            raise (Failure "Unreachable")
-        | Ok borrowed_value ->
-            (* Move and continue *)
-            let destp = mk_place_from_var_id E.VarId.zero in
-            assign_to_place config borrowed_value destp cf
-      in
-
-      (* Compose and apply *)
-      comp cf_borrow cf_move cf ctx
-  | _ -> raise (Failure "Inconsistent state")
-
-(** Auxiliary function - see {!eval_assumed_function_call} *)
-let eval_box_deref_concrete (config : C.config) (generics : T.egeneric_args) :
-    cm_fun =
-  let is_mut = false in
-  eval_box_deref_mut_or_shared_concrete config generics is_mut
-
-(** Auxiliary function - see {!eval_assumed_function_call} *)
-let eval_box_deref_mut_concrete (config : C.config) (generics : T.egeneric_args)
-    : cm_fun =
-  let is_mut = true in
-  eval_box_deref_mut_or_shared_concrete config generics is_mut
-
 (** Auxiliary function - see {!eval_assumed_function_call}.
 
     [Box::free] is not handled the same way as the other assumed functions:
@@ -575,11 +498,6 @@ let eval_box_free (config : C.config) (generics : T.egeneric_args)
       cc cf ctx
   | _ -> raise (Failure "Inconsistent state")
 
-(** Auxiliary function - see {!eval_assumed_function_call} *)
-let eval_vec_function_concrete (_config : C.config) (_fid : A.assumed_fun_id)
-    (_generics : T.egeneric_args) : cm_fun =
- fun _cf _ctx -> raise Unimplemented
-
 (** Evaluate a non-local function call in concrete mode *)
 let eval_assumed_function_call_concrete (config : C.config)
     (fid : A.assumed_fun_id) (call : A.call) : cm_fun =
@@ -636,18 +554,12 @@ let eval_assumed_function_call_concrete (config : C.config)
          * access to a body. *)
         let cf_eval_body : cm_fun =
           match fid with
-          | Replace -> eval_replace_concrete config generics
           | BoxNew -> eval_box_new_concrete config generics
-          | BoxDeref -> eval_box_deref_concrete config generics
-          | BoxDerefMut -> eval_box_deref_mut_concrete config generics
           | BoxFree ->
               (* Should have been treated above *) raise (Failure "Unreachable")
-          | VecNew | VecPush | VecInsert | VecLen | VecIndex | VecIndexMut ->
-              eval_vec_function_concrete config fid generics
           | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared
-          | ArrayToSliceMut | ArraySubsliceShared | ArraySubsliceMut
-          | ArrayRepeat | SliceIndexShared | SliceIndexMut | SliceSubsliceShared
-          | SliceSubsliceMut | SliceLen ->
+          | ArrayToSliceMut | ArrayRepeat | SliceIndexShared | SliceIndexMut
+          | SliceLen ->
               raise (Failure "Unimplemented")
         in
 
@@ -1531,7 +1443,7 @@ and eval_assumed_function_call_symbolic (config : C.config)
             (* There shouldn't be any reference to Self *)
             let tr_self = T.UnknownTrait __FUNCTION__ in
             instantiate_fun_sig ctx generics tr_self
-              (Assumed.get_assumed_sig fid)
+              (Assumed.get_assumed_fun_sig fid)
       in
 
       (* Evaluate the function call *)
diff --git a/compiler/Invariants.ml b/compiler/Invariants.ml
index 9ac5ce13..5c8ec7af 100644
--- a/compiler/Invariants.ml
+++ b/compiler/Invariants.ml
@@ -447,7 +447,7 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
               fields_with_types
         (* Assumed type case *)
         | V.Adt av, T.Adt (T.Assumed aty_id, generics) -> (
-            assert (av.V.variant_id = None || aty_id = T.Option);
+            assert (av.V.variant_id = None);
             match
               ( aty_id,
                 av.V.field_values,
@@ -456,19 +456,8 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
                 generics.const_generics )
             with
             (* Box *)
-            | T.Box, [ inner_value ], [], [ inner_ty ], []
-            | T.Option, [ inner_value ], [], [ inner_ty ], [] ->
+            | T.Box, [ inner_value ], [], [ inner_ty ], [] ->
                 assert (inner_value.V.ty = inner_ty)
-            | T.Option, _, [], [ _ ], [] ->
-                (* Option::None: nothing to check *)
-                ()
-            | T.Vec, fvs, [], [ vec_ty ], [] ->
-                List.iter
-                  (fun (v : V.typed_value) -> assert (v.ty = vec_ty))
-                  fvs
-            | T.Range, [ v0; v1 ], [], [ inner_ty ], [] ->
-                assert (v0.V.ty = inner_ty);
-                assert (v1.V.ty = inner_ty)
             | T.Array, inner_values, _, [ inner_ty ], [ cg ] ->
                 (* *)
                 assert (
diff --git a/compiler/LlbcAstUtils.ml b/compiler/LlbcAstUtils.ml
index a982af30..2553127a 100644
--- a/compiler/LlbcAstUtils.ml
+++ b/compiler/LlbcAstUtils.ml
@@ -5,13 +5,13 @@ let lookup_fun_sig (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
     fun_sig =
   match fun_id with
   | Regular id -> (FunDeclId.Map.find id fun_decls).signature
-  | Assumed aid -> Assumed.get_assumed_sig aid
+  | Assumed aid -> Assumed.get_assumed_fun_sig aid
 
 let lookup_fun_name (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
     Names.fun_name =
   match fun_id with
   | Regular id -> (FunDeclId.Map.find id fun_decls).name
-  | Assumed aid -> Assumed.get_assumed_name aid
+  | Assumed aid -> Assumed.get_assumed_fun_name aid
 
 (** Return the opaque declarations found in the crate.
 
@@ -22,7 +22,7 @@ let lookup_fun_name (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
  *)
 let crate_get_opaque_decls (k : crate) (filter_assumed : bool) :
     T.type_decl list * fun_decl list =
-  let open ExtractAssumed in
+  let open ExtractBuiltin in
   let is_opaque_fun (d : fun_decl) : bool =
     let sname = name_to_simple_name d.name in
     d.body = None
@@ -30,7 +30,7 @@ let crate_get_opaque_decls (k : crate) (filter_assumed : bool) :
        (which don't have a body but must not be considered as opaque) *)
     && (match d.kind with TraitMethodDecl _ -> false | _ -> true)
     && ((not filter_assumed)
-       || not (SimpleNameMap.mem sname assumed_globals_map))
+       || not (SimpleNameMap.mem sname builtin_globals_map))
   in
   let is_opaque_type (d : T.type_decl) : bool = d.kind = T.Opaque in
   (* Note that by checking the function bodies we also the globals *)
diff --git a/compiler/PrePasses.ml b/compiler/PrePasses.ml
index 1058fab0..ee06fa07 100644
--- a/compiler/PrePasses.ml
+++ b/compiler/PrePasses.ml
@@ -108,7 +108,7 @@ let remove_useless_cf_merges (crate : A.crate) (f : A.fun_decl) : A.fun_decl =
     | Assign (_, rv) -> (
         match rv with
         | Use _ | RvRef _ -> not must_end_with_exit
-        | Aggregate (AggregatedTuple, []) -> not must_end_with_exit
+        | Aggregate (AggregatedAdt (Tuple, _, _), []) -> not must_end_with_exit
         | _ -> false)
     | FakeRead _ | Drop _ | Nop -> not must_end_with_exit
     | Panic | Return -> true
diff --git a/compiler/Print.ml b/compiler/Print.ml
index 1d5ddc50..aeacfbf0 100644
--- a/compiler/Print.ml
+++ b/compiler/Print.ml
@@ -127,17 +127,6 @@ module Values = struct
             (* Assumed type *)
             match (aty, field_values) with
             | Box, [ bv ] -> "@Box(" ^ bv ^ ")"
-            | Option, _ ->
-                if av.variant_id = Some T.option_some_id then
-                  "@Option::Some("
-                  ^ Collections.List.to_cons_nil field_values
-                  ^ ")"
-                else if av.variant_id = Some T.option_none_id then (
-                  assert (field_values = []);
-                  "@Option::None")
-                else raise (Failure "Unreachable")
-            | Range, _ -> "@Range{ " ^ String.concat ", " field_values ^ "}"
-            | Vec, _ -> "@Vec[" ^ String.concat ", " field_values ^ "]"
             | Array, _ ->
                 (* Happens when we aggregate values *)
                 "@Array[" ^ String.concat ", " field_values ^ "]"
diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml
index be7b3cb4..6396fe96 100644
--- a/compiler/PrintPure.ml
+++ b/compiler/PrintPure.ml
@@ -195,12 +195,9 @@ let assumed_ty_to_string (aty : assumed_ty) : string =
   | Result -> "Result"
   | Error -> "Error"
   | Fuel -> "Fuel"
-  | Option -> "Option"
-  | Vec -> "Vec"
   | Array -> "Array"
   | Slice -> "Slice"
   | Str -> "Str"
-  | Range -> "Range"
 
 let type_id_to_string (fmt : type_formatter) (id : type_id) : string =
   match id with
@@ -354,10 +351,6 @@ let rec mprojection_to_string (fmt : ast_formatter) (inside : string)
   | pe :: p' -> (
       let s = mprojection_to_string fmt inside p' in
       match pe.pkind with
-      | E.ProjOption variant_id ->
-          assert (variant_id = T.option_some_id);
-          assert (pe.field_id = T.FieldId.zero);
-          "(" ^ s ^ "as Option::Some)." ^ T.FieldId.to_string pe.field_id
       | E.ProjTuple _ -> "(" ^ s ^ ")." ^ T.FieldId.to_string pe.field_id
       | E.ProjAdt (adt_id, opt_variant_id) -> (
           let field_name =
@@ -395,8 +388,6 @@ let adt_variant_to_string (fmt : value_formatter) (adt_id : type_id)
       | State | Array | Slice | Str ->
           (* Those types are opaque: we can't get there *)
           raise (Failure "Unreachable")
-      | Vec -> "@Vec"
-      | Range -> "@Range"
       | Result ->
           let variant_id = Option.get variant_id in
           if variant_id = result_return_id then "@Result::Return"
@@ -412,13 +403,7 @@ let adt_variant_to_string (fmt : value_formatter) (adt_id : type_id)
           let variant_id = Option.get variant_id in
           if variant_id = fuel_zero_id then "@Fuel::Zero"
           else if variant_id = fuel_succ_id then "@Fuel::Succ"
-          else raise (Failure "Unreachable: improper variant id for fuel type")
-      | Option ->
-          let variant_id = Option.get variant_id in
-          if variant_id = option_some_id then "@Option::Some "
-          else if variant_id = option_none_id then "@Option::None"
-          else
-            raise (Failure "Unreachable: improper variant id for result type"))
+          else raise (Failure "Unreachable: improper variant id for fuel type"))
 
 let adt_field_to_string (fmt : value_formatter) (adt_id : type_id)
     (field_id : FieldId.id) : string =
@@ -435,11 +420,10 @@ let adt_field_to_string (fmt : value_formatter) (adt_id : type_id)
   | Assumed aty -> (
       (* Assumed type *)
       match aty with
-      | Range -> FieldId.to_string field_id
-      | State | Fuel | Vec | Array | Slice | Str ->
+      | State | Fuel | Array | Slice | Str ->
           (* Opaque types: we can't get there *)
           raise (Failure "Unreachable")
-      | Result | Error | Option ->
+      | Result | Error ->
           (* Enumerations: we can't get there *)
           raise (Failure "Unreachable"))
 
@@ -510,31 +494,13 @@ let adt_g_value_to_string (fmt : value_formatter)
             | [ v ] -> "@Fuel::Succ " ^ v
             | _ -> raise (Failure "@Fuel::Succ takes exactly one value")
           else raise (Failure "Unreachable: improper variant id for fuel type")
-      | Option ->
-          let variant_id = Option.get variant_id in
-          if variant_id = option_some_id then
-            match field_values with
-            | [ v ] -> "@Option::Some " ^ v
-            | _ -> raise (Failure "Option::Some takes exactly one value")
-          else if variant_id = option_none_id then (
-            assert (field_values = []);
-            "@Option::None")
-          else
-            raise (Failure "Unreachable: improper variant id for result type")
-      | Vec | Array | Slice | Str ->
-          assert (variant_id = None);
-          let field_values =
-            List.mapi (fun i v -> string_of_int i ^ " -> " ^ v) field_values
-          in
-          let id = assumed_ty_to_string aty in
-          id ^ " [" ^ String.concat "; " field_values ^ "]"
-      | Range ->
+      | Array | Slice | Str ->
           assert (variant_id = None);
           let field_values =
             List.mapi (fun i v -> string_of_int i ^ " -> " ^ v) field_values
           in
           let id = assumed_ty_to_string aty in
-          id ^ " {" ^ String.concat "; " field_values ^ "}")
+          id ^ " [" ^ String.concat "; " field_values ^ "]")
   | _ ->
       let fmt = value_to_type_formatter fmt in
       raise
@@ -593,29 +559,16 @@ let fun_suffix (lp_id : LoopId.id option) (rg_id : T.RegionGroupId.id option) :
 
 let llbc_assumed_fun_id_to_string (fid : A.assumed_fun_id) : string =
   match fid with
-  | Replace -> "core::mem::replace"
   | BoxNew -> "alloc::boxed::Box::new"
-  | BoxDeref -> "core::ops::deref::Deref::deref"
-  | BoxDerefMut -> "core::ops::deref::DerefMut::deref_mut"
   | BoxFree -> "alloc::alloc::box_free"
-  | VecNew -> "alloc::vec::Vec::new"
-  | VecPush -> "alloc::vec::Vec::push"
-  | VecInsert -> "alloc::vec::Vec::insert"
-  | VecLen -> "alloc::vec::Vec::len"
-  | VecIndex -> "core::ops::index::Index<alloc::vec::Vec>::index"
-  | VecIndexMut -> "core::ops::index::IndexMut<alloc::vec::Vec>::index_mut"
   | ArrayIndexShared -> "@ArrayIndexShared"
   | ArrayIndexMut -> "@ArrayIndexMut"
   | ArrayToSliceShared -> "@ArrayToSliceShared"
   | ArrayToSliceMut -> "@ArrayToSliceMut"
-  | ArraySubsliceShared -> "@ArraySubsliceShared"
-  | ArraySubsliceMut -> "@ArraySubsliceMut"
   | ArrayRepeat -> "@ArrayRepeat"
   | SliceLen -> "@SliceLen"
   | SliceIndexShared -> "@SliceIndexShared"
   | SliceIndexMut -> "@SliceIndexMut"
-  | SliceSubsliceShared -> "@SliceSubsliceShared"
-  | SliceSubsliceMut -> "@SliceSubsliceMut"
 
 let pure_assumed_fun_id_to_string (fid : pure_assumed_fun_id) : string =
   match fid with
diff --git a/compiler/Pure.ml b/compiler/Pure.ml
index 47c7beb4..81e13af7 100644
--- a/compiler/Pure.ml
+++ b/compiler/Pure.ml
@@ -64,17 +64,7 @@ type fun_decl_id = A.fun_decl_id [@@deriving show, ord]
         this state is opaque to Aeneas (the user can define it, or leave it as
         assumed)
   *)
-type assumed_ty =
-  | State
-  | Result
-  | Error
-  | Fuel
-  | Vec
-  | Option
-  | Array
-  | Slice
-  | Str
-  | Range
+type assumed_ty = State | Result | Error | Fuel | Array | Slice | Str
 [@@deriving show, ord]
 
 (* TODO: we should never directly manipulate [Return] and [Fail], but rather
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index b00509a6..a326d19e 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -1513,7 +1513,7 @@ let unit_vars_to_unit (def : fun_decl) : fun_decl =
     function calls, and when translating end abstractions. Here, we can do
     something simpler, in one micro-pass.
  *)
-let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl =
+let eliminate_box_functions (ctx : trans_ctx) (def : fun_decl) : fun_decl =
   (* The map visitor *)
   let obj =
     object
@@ -1522,30 +1522,42 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl =
       method! visit_texpression env e =
         match opt_destruct_function_call e with
         | Some (fun_id, _tys, args) -> (
+            (* Below, when dealing with the arguments: we consider the very
+             * general case, where functions could be boxed (meaning we
+             * could have: [box_new f x])
+             * *)
             match fun_id with
             | Fun (FromLlbc (FunId (Assumed aid), _lp_id, rg_id)) -> (
-                (* Below, when dealing with the arguments: we consider the very
-                 * general case, where functions could be boxed (meaning we
-                 * could have: [box_new f x])
-                 * *)
                 match (aid, rg_id) with
                 | BoxNew, _ ->
                     assert (rg_id = None);
                     let arg, args = Collections.List.pop args in
                     mk_apps arg args
-                | BoxDeref, None ->
+                | BoxFree, _ ->
+                    assert (args = []);
+                    mk_unit_rvalue
+                | ( ( SliceIndexShared | SliceIndexMut | ArrayIndexShared
+                    | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut
+                    | ArrayRepeat | SliceLen ),
+                    _ ) ->
+                    super#visit_texpression env e)
+            | Fun (FromLlbc (FunId (Regular fid), _lp_id, rg_id)) -> (
+                (* Lookup the function name *)
+                let def = FunDeclId.Map.find fid ctx.fun_ctx.fun_decls in
+                match (Names.name_to_string def.name, rg_id) with
+                | "alloc::box::Boxed::deref", None ->
                     (* [Box::deref] forward is the identity *)
                     let arg, args = Collections.List.pop args in
                     mk_apps arg args
-                | BoxDeref, Some _ ->
+                | "alloc::box::Boxed::deref", Some _ ->
                     (* [Box::deref] backward is [()] (doesn't give back anything) *)
                     assert (args = []);
                     mk_unit_rvalue
-                | BoxDerefMut, None ->
+                | "alloc::box::Boxed::deref_mut", None ->
                     (* [Box::deref_mut] forward is the identity *)
                     let arg, args = Collections.List.pop args in
                     mk_apps arg args
-                | BoxDerefMut, Some _ ->
+                | "alloc::box::Boxed::deref_mut", Some _ ->
                     (* [Box::deref_mut] back is almost the identity:
                      * let box_deref_mut (x_init : t) (x_back : t) : t = x_back
                      * *)
@@ -1555,17 +1567,7 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl =
                       | _ -> raise (Failure "Unreachable")
                     in
                     mk_apps arg args
-                | BoxFree, _ ->
-                    assert (args = []);
-                    mk_unit_rvalue
-                | ( ( Replace | VecNew | VecPush | VecInsert | VecLen | VecIndex
-                    | VecIndexMut | ArraySubsliceShared | ArraySubsliceMut
-                    | SliceIndexShared | SliceIndexMut | SliceSubsliceShared
-                    | SliceSubsliceMut | ArrayIndexShared | ArrayIndexMut
-                    | ArrayToSliceShared | ArrayToSliceMut | ArrayRepeat
-                    | SliceLen ),
-                    _ ) ->
-                    super#visit_texpression env e)
+                | _ -> super#visit_texpression env e)
             | _ -> super#visit_texpression env e)
         | _ -> super#visit_texpression env e
     end
diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml
index b80ff72f..d31f0cf9 100644
--- a/compiler/PureTypeCheck.ml
+++ b/compiler/PureTypeCheck.ml
@@ -46,18 +46,7 @@ let get_adt_field_types (type_decls : type_decl TypeDeclId.Map.t)
           if variant_id = fuel_zero_id then []
           else if variant_id = fuel_succ_id then [ mk_fuel_ty ]
           else raise (Failure "Unreachable: improper variant id for fuel type")
-      | Option ->
-          let ty = Collections.List.to_cons_nil generics.types in
-          let variant_id = Option.get variant_id in
-          if variant_id = option_some_id then [ ty ]
-          else if variant_id = option_none_id then []
-          else
-            raise (Failure "Unreachable: improper variant id for option type")
-      | Range ->
-          let ty = Collections.List.to_cons_nil generics.types in
-          assert (variant_id = None);
-          [ ty; ty ]
-      | Vec | Array | Slice | Str ->
+      | Array | Slice | Str ->
           (* Array: when not symbolic values (for instance, because of aggregates),
              the array expressions are introduced as struct updates *)
           raise (Failure "Attempting to access the fields of an opaque type"))
diff --git a/compiler/Substitute.ml b/compiler/Substitute.ml
index b1680282..6d9b9e15 100644
--- a/compiler/Substitute.ml
+++ b/compiler/Substitute.ml
@@ -305,19 +305,7 @@ let ctx_adt_value_get_instantiated_field_rtypes (ctx : C.eval_ctx)
       generics.types
   | T.Assumed aty -> (
       match aty with
-      | T.Box | T.Vec ->
-          assert (generics.regions = []);
-          assert (List.length generics.types = 1);
-          assert (generics.const_generics = []);
-          generics.types
-      | T.Option ->
-          assert (generics.regions = []);
-          assert (List.length generics.types = 1);
-          assert (generics.const_generics = []);
-          if adt.V.variant_id = Some T.option_some_id then generics.types
-          else if adt.V.variant_id = Some T.option_none_id then []
-          else raise (Failure "Unreachable")
-      | T.Range ->
+      | T.Box ->
           assert (generics.regions = []);
           assert (List.length generics.types = 1);
           assert (generics.const_generics = []);
diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index 54221cb1..9c698b51 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -405,8 +405,6 @@ let rec translate_sty (ty : T.sty) : ty =
           mk_simpl_tuple_ty generics.types
       | T.Assumed aty -> (
           match aty with
-          | T.Vec -> Adt (Assumed Vec, generics)
-          | T.Option -> Adt (Assumed Option, generics)
           | T.Box -> (
               (* Eliminate the boxes *)
               match generics.types with
@@ -418,8 +416,7 @@ let rec translate_sty (ty : T.sty) : ty =
               )
           | T.Array -> Adt (Assumed Array, generics)
           | T.Slice -> Adt (Assumed Slice, generics)
-          | T.Str -> Adt (Assumed Str, generics)
-          | T.Range -> Adt (Assumed Range, generics)))
+          | T.Str -> Adt (Assumed Str, generics)))
   | TypeVar vid -> TypeVar vid
   | Literal ty -> Literal ty
   | Never -> raise (Failure "Unreachable")
@@ -510,12 +507,9 @@ let translate_type_id (id : T.type_id) : type_id =
   | T.Assumed aty ->
       let aty =
         match aty with
-        | T.Vec -> Vec
-        | T.Option -> Option
         | T.Array -> Array
         | T.Slice -> Slice
         | T.Str -> Str
-        | T.Range -> Range
         | T.Box ->
             (* Boxes have to be eliminated: this type id shouldn't
                be translated *)
@@ -534,8 +528,7 @@ let rec translate_fwd_ty (type_infos : TA.type_infos) (ty : 'r T.ty) : ty =
       let t_generics = translate_fwd_generic_args type_infos generics in
       (* Eliminate boxes and simplify tuples *)
       match type_id with
-      | AdtId _
-      | T.Assumed (T.Vec | T.Option | T.Array | T.Slice | T.Str | T.Range) ->
+      | AdtId _ | T.Assumed (T.Array | T.Slice | T.Str) ->
           (* No general parametricity for now *)
           assert (
             not
@@ -610,8 +603,7 @@ let rec translate_back_ty (type_infos : TA.type_infos)
   match ty with
   | T.Adt (type_id, generics) -> (
       match type_id with
-      | T.AdtId _
-      | Assumed (T.Vec | T.Option | T.Array | T.Slice | T.Str | T.Range) ->
+      | T.AdtId _ | Assumed (T.Array | T.Slice | T.Str) ->
           (* Don't accept ADTs (which are not tuples) with borrows for now *)
           assert (not (TypesUtils.ty_has_borrows type_infos ty));
           let type_id = translate_type_id type_id in
@@ -815,7 +807,7 @@ let get_fun_effect_info (fun_infos : FA.fun_info A.FunDeclId.Map.t)
   | FunId (Assumed aid) ->
       assert (lid = None);
       {
-        can_fail = Assumed.assumed_can_fail aid;
+        can_fail = Assumed.assumed_fun_can_fail aid;
         stateful_group = false;
         stateful = false;
         can_diverge = false;
@@ -1221,9 +1213,7 @@ let rec typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx)
         (* For now, only tuples can contain borrows *)
         let adt_id, _ = TypesUtils.ty_as_adt av.ty in
         match adt_id with
-        | T.AdtId _
-        | T.Assumed
-            (T.Box | T.Vec | T.Option | T.Array | T.Slice | T.Str | T.Range) ->
+        | T.AdtId _ | T.Assumed (T.Box | T.Array | T.Slice | T.Str) ->
             assert (field_values = []);
             None
         | T.Tuple ->
@@ -1368,9 +1358,7 @@ let rec typed_avalue_to_given_back (mp : mplace option) (av : V.typed_avalue)
          * vector value upon visiting the "abstraction borrow" node *)
         let adt_id, _ = TypesUtils.ty_as_adt av.ty in
         match adt_id with
-        | T.AdtId _
-        | T.Assumed
-            (T.Box | T.Vec | T.Option | T.Array | T.Slice | T.Str | T.Range) ->
+        | T.AdtId _ | T.Assumed (T.Box | T.Array | T.Slice | T.Str) ->
             assert (field_values = []);
             (ctx, None)
         | T.Tuple ->
@@ -2441,17 +2429,12 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value)
         (mk_typed_pattern_from_var var None)
         (mk_opt_mplace_texpression scrutinee_mplace scrutinee)
         branch
-  | T.Assumed (T.Vec | T.Array | T.Slice | T.Str) ->
+  | T.Assumed (T.Array | T.Slice | T.Str) ->
       (* We can't expand those values: we can access the fields only
        * through the functions provided by the API (note that we don't
        * know how to expand values like vectors or arrays, because they have a variable number
        * of fields!) *)
       raise (Failure "Attempt to expand a non-expandable value")
-  | T.Assumed Range -> raise (Failure "Unimplemented")
-  | T.Assumed T.Option ->
-      (* We shouldn't get there in the "one-branch" case: options have
-       * two variants *)
-      raise (Failure "Unreachable")
 
 and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option)
     (sv : V.symbolic_value) (v : S.value_aggregate) (e : S.expression)
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 8e01c869..15297770 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -297,9 +297,11 @@ let translate_crate_to_pure (crate : A.crate) :
   (* Translate all the function *signatures* *)
   let assumed_sigs =
     List.map
-      (fun (id, sg, _, _) ->
-        (E.Assumed id, List.map (fun _ -> None) (sg : A.fun_sig).inputs, sg))
-      Assumed.assumed_infos
+      (fun (info : Assumed.assumed_fun_info) ->
+        ( E.Assumed info.fun_id,
+          List.map (fun _ -> None) info.fun_sig.inputs,
+          info.fun_sig ))
+      Assumed.assumed_fun_infos
   in
   let local_sigs =
     List.map
@@ -425,11 +427,15 @@ let export_type (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
         (true, kind)
   in
   (* Extract, if the config instructs to do so (depending on whether the type
-   * is opaque or not) *)
-  if
+     is opaque or not). Remark: we don't check if the definitions are builtin
+     here but in the function [export_types_group]: the reason is that if one
+     definition in the group is builtin, then we must check that all the
+     definitions are marked builtin *)
+  let extract =
     (is_opaque && config.extract_opaque)
     || ((not is_opaque) && config.extract_transparent)
-  then (
+  in
+  if extract then (
     if extract_decl then
       Extract.extract_type_decl ctx fmt type_decl_group kind def;
     if extract_extra_info then
@@ -464,41 +470,58 @@ let export_types_group (fmt : Format.formatter) (config : gen_config)
     List.map (fun id -> Pure.TypeDeclId.Map.find id ctx.trans_types) ids
   in
 
-  (* Extract the type declarations.
-
-     Because some declaration groups are delimited, we wrap the declarations
-     between [{start,end}_type_decl_group].
+  (* Check if the definition are builtin - if yes they must be ignored.
+     Note that if one definition in the group is builtin, then all the
+     definitions must be builtin *)
+  let builtin =
+    let open ExtractBuiltin in
+    let types_map = builtin_types_map () in
+    List.map
+      (fun (def : Pure.type_decl) ->
+        let sname = name_to_simple_name def.name in
+        SimpleNameMap.find_opt sname types_map <> None)
+      defs
+  in
 
-     Ex.:
-     ====
-     When targeting HOL4, the calls to [{start,end}_type_decl_group] would generate
-     the [Datatype] and [End] delimiters in the snippet of code below:
+  if List.exists (fun b -> b) builtin then
+    (* Sanity check *)
+    assert (List.for_all (fun b -> b) builtin)
+  else (
+    (* Extract the type declarations.
+
+       Because some declaration groups are delimited, we wrap the declarations
+       between [{start,end}_type_decl_group].
+
+       Ex.:
+       ====
+       When targeting HOL4, the calls to [{start,end}_type_decl_group] would generate
+       the [Datatype] and [End] delimiters in the snippet of code below:
+
+       {[
+         Datatype:
+           tree =
+             TLeaf 'a
+           | TNode node ;
+
+           node =
+             Node (tree list)
+         End
+       ]}
+    *)
+    Extract.start_type_decl_group ctx fmt is_rec defs;
+    List.iteri
+      (fun i def ->
+        let kind = kind_from_index i in
+        export_type_decl kind def)
+      defs;
+    Extract.end_type_decl_group fmt is_rec defs;
 
-     {[
-       Datatype:
-         tree =
-           TLeaf 'a
-         | TNode node ;
-
-         node =
-           Node (tree list)
-       End
-     ]}
-  *)
-  Extract.start_type_decl_group ctx fmt is_rec defs;
-  List.iteri
-    (fun i def ->
-      let kind = kind_from_index i in
-      export_type_decl kind def)
-    defs;
-  Extract.end_type_decl_group fmt is_rec defs;
-
-  (* Export the extra information (ex.: [Arguments] instructions in Coq) *)
-  List.iteri
-    (fun i def ->
-      let kind = kind_from_index i in
-      export_type_extra_info kind def)
-    defs
+    (* Export the extra information (ex.: [Arguments] instructions in Coq) *)
+    List.iteri
+      (fun i def ->
+        let kind = kind_from_index i in
+        export_type_extra_info kind def)
+      defs)
 
 (** Export a global declaration.
 
@@ -520,12 +543,12 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
     && (((not is_opaque) && config.extract_transparent)
        || (is_opaque && config.extract_opaque))
   in
-  (* Check if it is an assumed global - if yes, we ignore it because we
+  (* Check if it is a builtin global - if yes, we ignore it because we
      map the definition to one in the standard library *)
-  let open ExtractAssumed in
+  let open ExtractBuiltin in
   let sname = name_to_simple_name global.name in
   let extract =
-    extract && SimpleNameMap.find_opt sname assumed_globals_map = None
+    extract && SimpleNameMap.find_opt sname builtin_globals_map = None
   in
   if extract then
     (* We don't wrap global declaration groups between calls to functions
diff --git a/compiler/TypesAnalysis.ml b/compiler/TypesAnalysis.ml
index 4a187893..16f8c5f9 100644
--- a/compiler/TypesAnalysis.ml
+++ b/compiler/TypesAnalysis.ml
@@ -168,9 +168,7 @@ let analyze_full_ty (r_is_static : 'r -> bool) (updated : bool ref)
         in
         (* Continue exploring *)
         analyze expl_info ty_info rty
-    | Adt
-        ( (Tuple | Assumed (Box | Vec | Option | Slice | Array | Str | Range)),
-          generics ) ->
+    | Adt ((Tuple | Assumed (Box | Slice | Array | Str)), generics) ->
         (* Nothing to update: just explore the type parameters *)
         List.fold_left
           (fun ty_info ty -> analyze expl_info ty_info ty)
diff --git a/compiler/dune b/compiler/dune
index 2f5a0a44..4ec46b70 100644
--- a/compiler/dune
+++ b/compiler/dune
@@ -22,8 +22,8 @@
   Expressions
   ExpressionsUtils
   Extract
-  ExtractAssumed
   ExtractBase
+  ExtractBuiltin
   FunsAnalysis
   Identifiers
   InterpreterBorrowsCore
-- 
cgit v1.3.1


From c486bd0675f489c5ac917749a68e2c71b55041ae Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 23 Oct 2023 17:29:15 +0200
Subject: Make progress on handling the builtins

---
 compiler/Extract.ml        | 254 +++++++++++++++++++++++++++++++++++++--------
 compiler/ExtractBase.ml    |  68 ------------
 compiler/ExtractBuiltin.ml |  93 +++++++++--------
 compiler/Translate.ml      |   9 +-
 4 files changed, 270 insertions(+), 154 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 30c4c27d..6a306592 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -4062,64 +4062,234 @@ let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter)
       (* Add a break to insert lines between declarations *)
       F.pp_print_break fmt 0 0
 
-(** Register the names for one trait method item *)
-let extract_trait_decl_method_register_names (ctx : extraction_ctx)
-    (trait_decl : trait_decl) (name : string) (id : fun_decl_id) :
+(** Similar to {!extract_trait_decl_register_names} *)
+let extract_trait_decl_register_parent_clause_names (ctx : extraction_ctx)
+    (trait_decl : trait_decl)
+    (builtin_info : ExtractBuiltin.builtin_trait_decl_info option) :
     extraction_ctx =
-  (* We add one field per required forward/backward function *)
-  let trans = A.FunDeclId.Map.find id ctx.trans_funs in
-
-  let register_fun ctx f = ctx_add_trait_method trait_decl name f.f ctx in
+  let is_opaque = false in
+  let generics = trait_decl.generics in
+  (* Compute the clause names *)
+  let clause_names =
+    match builtin_info with
+    | None ->
+        List.map
+          (fun (c : trait_clause) ->
+            let name = ctx.fmt.trait_parent_clause_name trait_decl c in
+            (* Add a prefix if necessary *)
+            let name =
+              if !Config.record_fields_short_names then name
+              else ctx.fmt.trait_decl_name trait_decl ^ name
+            in
+            (c.clause_id, name))
+          generics.trait_clauses
+    | Some info ->
+        List.map
+          (fun (c, name) -> (c.clause_id, name))
+          (List.combine generics.trait_clauses info.parent_clauses)
+  in
+  (* Register the names *)
+  List.fold_left
+    (fun ctx (cid, cname) ->
+      ctx_add is_opaque (TraitParentClauseId (trait_decl.def_id, cid)) cname ctx)
+    ctx clause_names
+
+(** Similar to {!extract_trait_decl_register_names} *)
+let extract_trait_decl_register_constant_names (ctx : extraction_ctx)
+    (trait_decl : trait_decl)
+    (builtin_info : ExtractBuiltin.builtin_trait_decl_info option) :
+    extraction_ctx =
+  let is_opaque = false in
+  let consts = trait_decl.consts in
+  (* Compute the names *)
+  let constant_names =
+    match builtin_info with
+    | None ->
+        List.map
+          (fun (item_name, _) ->
+            let name = ctx.fmt.trait_const_name trait_decl item_name in
+            (* Add a prefix if necessary *)
+            let name =
+              if !Config.record_fields_short_names then name
+              else ctx.fmt.trait_decl_name trait_decl ^ name
+            in
+            (item_name, name))
+          consts
+    | Some info ->
+        let const_map = StringMap.of_list info.consts in
+        List.map
+          (fun (item_name, _) ->
+            (item_name, StringMap.find item_name const_map))
+          consts
+  in
   (* Register the names *)
-  let funs = trans.fwd :: trans.backs in
-  List.fold_left register_fun ctx funs
+  List.fold_left
+    (fun ctx (item_name, name) ->
+      ctx_add is_opaque (TraitItemId (trait_decl.def_id, item_name)) name ctx)
+    ctx constant_names
+
+(** Similar to {!extract_trait_decl_register_names} *)
+let extract_trait_decl_type_names (ctx : extraction_ctx)
+    (trait_decl : trait_decl)
+    (builtin_info : ExtractBuiltin.builtin_trait_decl_info option) :
+    extraction_ctx =
+  let is_opaque = false in
+  let types = trait_decl.types in
+  (* Compute the names *)
+  let type_names =
+    match builtin_info with
+    | None ->
+        let compute_type_name (item_name : string) : string =
+          let type_name = ctx.fmt.trait_type_name trait_decl item_name in
+          if !Config.record_fields_short_names then type_name
+          else ctx.fmt.trait_decl_name trait_decl ^ type_name
+        in
+        let compute_clause_name (item_name : string) (clause : trait_clause) :
+            TraitClauseId.id * string =
+          let name =
+            ctx.fmt.trait_type_clause_name trait_decl item_name clause
+          in
+          (* Add a prefix if necessary *)
+          let name =
+            if !Config.record_fields_short_names then name
+            else ctx.fmt.trait_decl_name trait_decl ^ name
+          in
+          (clause.clause_id, name)
+        in
+        List.map
+          (fun (item_name, (item_clauses, _)) ->
+            (* Type name *)
+            let type_name = compute_type_name item_name in
+            (* Clause names *)
+            let clauses =
+              List.map (compute_clause_name item_name) item_clauses
+            in
+            (item_name, (type_name, clauses)))
+          types
+    | Some info ->
+        let type_map = StringMap.of_list info.types in
+        List.map
+          (fun (item_name, (item_clauses, _)) ->
+            let type_name, clauses_info = StringMap.find item_name type_map in
+            let clauses =
+              List.map
+                (fun (clause, clause_name) -> (clause.clause_id, clause_name))
+                (List.combine item_clauses clauses_info)
+            in
+            (item_name, (type_name, clauses)))
+          types
+  in
+  (* Register the names *)
+  List.fold_left
+    (fun ctx (item_name, (type_name, clauses)) ->
+      let ctx =
+        ctx_add is_opaque
+          (TraitItemId (trait_decl.def_id, item_name))
+          type_name ctx
+      in
+      List.fold_left
+        (fun ctx (clause_id, clause_name) ->
+          ctx_add is_opaque
+            (TraitItemClauseId (trait_decl.def_id, item_name, clause_id))
+            clause_name ctx)
+        ctx clauses)
+    ctx type_names
+
+(** Similar to {!extract_trait_decl_register_names} *)
+let extract_trait_decl_method_names (ctx : extraction_ctx)
+    (trait_decl : trait_decl)
+    (builtin_info : ExtractBuiltin.builtin_trait_decl_info option) :
+    extraction_ctx =
+  let is_opaque = false in
+  let required_methods = trait_decl.required_methods in
+  (* Compute the names *)
+  let method_names =
+    (* We add one field per required forward/backward function *)
+    let get_funs_for_id (id : fun_decl_id) : fun_decl list =
+      let trans : pure_fun_translation = FunDeclId.Map.find id ctx.trans_funs in
+      List.map (fun f -> f.f) (trans.fwd :: trans.backs)
+    in
+    match builtin_info with
+    | None ->
+        (* We add one field per required forward/backward function *)
+        let compute_item_names (item_name : string) (id : fun_decl_id) :
+            string * (RegionGroupId.id option * string) list =
+          let compute_fun_name (f : fun_decl) : RegionGroupId.id option * string
+              =
+            (* We do something special: we use the base name but remove everything
+               but the crate (because [get_name] removes it) and the last ident.
+               This allows us to reuse the [ctx_compute_fun_decl] function.
+            *)
+            let basename : name =
+              match (f.basename : name) with
+              | Ident crate :: name ->
+                  Ident crate :: [ Collections.List.last name ]
+              | _ -> raise (Failure "Unexpected")
+            in
+            let f = { f with basename } in
+            let trans = A.FunDeclId.Map.find f.def_id ctx.trans_funs in
+            let name = ctx_compute_fun_name trans f ctx in
+            (* Add a prefix if necessary *)
+            let name =
+              if !Config.record_fields_short_names then name
+              else ctx.fmt.trait_decl_name trait_decl ^ "_" ^ name
+            in
+            (f.back_id, name)
+          in
+          let funs = get_funs_for_id id in
+          (item_name, List.map compute_fun_name funs)
+        in
+        List.map (fun (name, id) -> compute_item_names name id) required_methods
+    | Some info ->
+        let funs_map = StringMap.of_list info.funs in
+        List.map
+          (fun (item_name, fun_id) ->
+            let info = StringMap.find item_name funs_map in
+            let trans_funs = get_funs_for_id fun_id in
+            let rg_with_name_list =
+              List.map
+                (fun (trans_fun : fun_decl) ->
+                  List.find (fun (rg, _) -> rg = trans_fun.back_id) info)
+                trans_funs
+            in
+            (item_name, rg_with_name_list))
+          required_methods
+  in
+  (* Register the names *)
+  List.fold_left
+    (fun ctx (item_name, funs) ->
+      (* We add one field per required forward/backward function *)
+      List.fold_left
+        (fun ctx (rg, fun_name) ->
+          ctx_add is_opaque
+            (TraitMethodId (trait_decl.def_id, item_name, rg))
+            fun_name ctx)
+        ctx funs)
+    ctx method_names
 
 (** Similar to {!extract_type_decl_register_names} *)
 let extract_trait_decl_register_names (ctx : extraction_ctx)
     (trait_decl : trait_decl) : extraction_ctx =
-  let {
-    def_id = _;
-    name = _;
-    generics;
-    preds = _;
-    all_trait_clauses = _;
-    consts;
-    types;
-    required_methods;
-    provided_methods = _;
-  } =
-    trait_decl
+  (* Lookup the information if this is a builtin trait *)
+  let open ExtractBuiltin in
+  let sname = name_to_simple_name trait_decl.name in
+  let builtin_info =
+    SimpleNameMap.find_opt sname (builtin_trait_decls_map ())
   in
   let ctx = ctx_add_trait_decl trait_decl ctx in
   (* Parent clauses *)
   let ctx =
-    List.fold_left
-      (fun ctx clause -> ctx_add_trait_parent_clause trait_decl clause ctx)
-      ctx generics.trait_clauses
+    extract_trait_decl_register_parent_clause_names ctx trait_decl builtin_info
   in
   (* Constants *)
   let ctx =
-    List.fold_left
-      (fun ctx (name, (_, _)) -> ctx_add_trait_const trait_decl name ctx)
-      ctx consts
+    extract_trait_decl_register_constant_names ctx trait_decl builtin_info
   in
   (* Types *)
-  let ctx =
-    List.fold_left
-      (fun ctx (name, (clauses, _)) ->
-        let ctx = ctx_add_trait_type trait_decl name ctx in
-        List.fold_left
-          (fun ctx clause ->
-            ctx_add_trait_type_clause trait_decl name clause ctx)
-          ctx clauses)
-      ctx types
-  in
+  let ctx = extract_trait_decl_type_names ctx trait_decl builtin_info in
   (* Required methods *)
-  List.fold_left
-    (fun ctx (name, id) ->
-      (* We add one field per required forward/backward function *)
-      extract_trait_decl_method_register_names ctx trait_decl name id)
-    ctx required_methods
+  let ctx = extract_trait_decl_method_names ctx trait_decl builtin_info in
+  ctx
 
 (** Similar to {!extract_type_decl_register_names} *)
 let extract_trait_impl_register_names (ctx : extraction_ctx)
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 54f69735..ea5fe8d3 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1288,74 +1288,6 @@ let ctx_add_trait_impl (d : trait_impl) (ctx : extraction_ctx) : extraction_ctx
   let name = ctx.fmt.trait_impl_name decl d in
   ctx_add is_opaque (TraitImplId d.def_id) name ctx
 
-let ctx_add_trait_const (d : trait_decl) (item : string) (ctx : extraction_ctx)
-    : extraction_ctx =
-  let is_opaque = false in
-  let name = ctx.fmt.trait_const_name d item in
-  (* Add a prefix if necessary *)
-  let name =
-    if !Config.record_fields_short_names then name
-    else ctx.fmt.trait_decl_name d ^ name
-  in
-  ctx_add is_opaque (TraitItemId (d.def_id, item)) name ctx
-
-let ctx_add_trait_type (d : trait_decl) (item : string) (ctx : extraction_ctx) :
-    extraction_ctx =
-  let is_opaque = false in
-  let name = ctx.fmt.trait_type_name d item in
-  (* Add a prefix if necessary *)
-  let name =
-    if !Config.record_fields_short_names then name
-    else ctx.fmt.trait_decl_name d ^ name
-  in
-  ctx_add is_opaque (TraitItemId (d.def_id, item)) name ctx
-
-let ctx_add_trait_method (d : trait_decl) (item_name : string) (f : fun_decl)
-    (ctx : extraction_ctx) : extraction_ctx =
-  (* We do something special: we use the base name but remove everything
-     but the crate (because [get_name] removes it) and the last ident.
-     This allows us to reuse the [ctx_compute_fun_decl] function.
-  *)
-  let basename : name =
-    match (f.basename : name) with
-    | Ident crate :: name -> Ident crate :: [ Collections.List.last name ]
-    | _ -> raise (Failure "Unexpected")
-  in
-  let f = { f with basename } in
-  let trans = A.FunDeclId.Map.find f.def_id ctx.trans_funs in
-  let name = ctx_compute_fun_name trans f ctx in
-  (* Add a prefix if necessary *)
-  let name =
-    if !Config.record_fields_short_names then name
-    else ctx.fmt.trait_decl_name d ^ "_" ^ name
-  in
-  let is_opaque = false in
-  ctx_add is_opaque (TraitMethodId (d.def_id, item_name, f.back_id)) name ctx
-
-let ctx_add_trait_parent_clause (d : trait_decl) (clause : trait_clause)
-    (ctx : extraction_ctx) : extraction_ctx =
-  let is_opaque = false in
-  let name = ctx.fmt.trait_parent_clause_name d clause in
-  (* Add a prefix if necessary *)
-  let name =
-    if !Config.record_fields_short_names then name
-    else ctx.fmt.trait_decl_name d ^ name
-  in
-  ctx_add is_opaque (TraitParentClauseId (d.def_id, clause.clause_id)) name ctx
-
-let ctx_add_trait_type_clause (d : trait_decl) (item : string)
-    (clause : trait_clause) (ctx : extraction_ctx) : extraction_ctx =
-  let is_opaque = false in
-  let name = ctx.fmt.trait_type_clause_name d item clause in
-  (* Add a prefix if necessary *)
-  let name =
-    if !Config.record_fields_short_names then name
-    else ctx.fmt.trait_decl_name d ^ name
-  in
-  ctx_add is_opaque
-    (TraitItemClauseId (d.def_id, item, clause.clause_id))
-    name ctx
-
 type names_map_init = {
   keywords : string list;
   assumed_adts : (assumed_ty * string) list;
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index cf5cc70d..3b4afff6 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -1,5 +1,8 @@
 (** This file declares external identifiers that we catch to map them to
-    definitions coming from the standard libraries in our backends. *)
+    definitions coming from the standard libraries in our backends.
+
+    TODO: there misses trait **implementations**
+ *)
 
 open Names
 open Config
@@ -331,20 +334,20 @@ let mk_builtin_funs_map () =
 
 let builtin_funs_map () = mk_memoized mk_builtin_funs_map
 
-type builtin_trait_info = {
+type builtin_trait_decl_info = {
   rust_name : string;
   extract_name : string;
   parent_clauses : string list;
   consts : (string * string) list;
-  types : (string * string * string list) list;
+  types : (string * (string * string list)) list;
       (** Every type has:
           - a Rust name
           - an extraction name
           - a list of clauses *)
-  funs : (string * Types.RegionGroupId.id option * string) list;
+  funs : (string * (Types.RegionGroupId.id option * string) list) list;
 }
 
-let builtin_traits () =
+let builtin_trait_decls_info () =
   let rg0 = Some Types.RegionGroupId.zero in
   [
     {
@@ -359,18 +362,20 @@ let builtin_traits () =
       types =
         [
           ( "Target",
-            (match !backend with
-            | Coq | FStar | HOL4 -> "core_ops_deref_Deref_Target"
-            | Lean -> "Target"),
-            [] );
+            ( (match !backend with
+              | Coq | FStar | HOL4 -> "core_ops_deref_Deref_Target"
+              | Lean -> "Target"),
+              [] ) );
         ];
       funs =
         [
           ( "deref",
-            None,
-            match !backend with
-            | Coq | FStar | HOL4 -> "core_ops_deref_Deref_deref"
-            | Lean -> "deref" );
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_ops_deref_Deref_deref"
+                | Lean -> "deref" );
+            ] );
         ];
     };
     {
@@ -391,15 +396,16 @@ let builtin_traits () =
       funs =
         [
           ( "deref_mut",
-            None,
-            match !backend with
-            | Coq | FStar | HOL4 -> "core_ops_deref_DerefMut_deref_mut"
-            | Lean -> "deref_mut" );
-          ( "deref_mut",
-            rg0,
-            match !backend with
-            | Coq | FStar | HOL4 -> "core_ops_deref_DerefMut_deref_mut_back"
-            | Lean -> "deref_mut_back" );
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_ops_deref_DerefMut_deref_mut"
+                | Lean -> "deref_mut" );
+              ( rg0,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_ops_deref_DerefMut_deref_mut_back"
+                | Lean -> "deref_mut_back" );
+            ] );
         ];
     };
     {
@@ -414,18 +420,20 @@ let builtin_traits () =
       types =
         [
           ( "Output",
-            (match !backend with
-            | Coq | FStar | HOL4 -> "core_ops_index_Index_Output"
-            | Lean -> "Output"),
-            [] );
+            ( (match !backend with
+              | Coq | FStar | HOL4 -> "core_ops_index_Index_Output"
+              | Lean -> "Output"),
+              [] ) );
         ];
       funs =
         [
           ( "index",
-            None,
-            match !backend with
-            | Coq | FStar | HOL4 -> "core_ops_index_Index_index"
-            | Lean -> "index" );
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_ops_index_Index_index"
+                | Lean -> "index" );
+            ] );
         ];
     };
     {
@@ -446,23 +454,24 @@ let builtin_traits () =
       funs =
         [
           ( "index_mut",
-            None,
-            match !backend with
-            | Coq | FStar | HOL4 -> "core_ops_index_IndexMut_mut"
-            | Lean -> "index_mut" );
-          ( "index_mut",
-            rg0,
-            match !backend with
-            | Coq | FStar | HOL4 -> "core_ops_index_IndexMut_mut_back"
-            | Lean -> "index_mut_back" );
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_ops_index_IndexMut_mut"
+                | Lean -> "index_mut" );
+              ( rg0,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_ops_index_IndexMut_mut_back"
+                | Lean -> "index_mut_back" );
+            ] );
         ];
     };
   ]
 
-let mk_builtin_traits_map () =
+let mk_builtin_trait_decls_map () =
   SimpleNameMap.of_list
     (List.map
        (fun info -> (string_to_simple_name info.rust_name, info))
-       (builtin_traits ()))
+       (builtin_trait_decls_info ()))
 
-let builtin_traits_map () = mk_memoized mk_builtin_traits_map
+let builtin_trait_decls_map = mk_memoized mk_builtin_trait_decls_map
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 15297770..0871a305 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -731,8 +731,13 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
 let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
     (ctx : gen_ctx) (trait_decl_id : Pure.trait_decl_id) : unit =
   let trait_decl = T.TraitDeclId.Map.find trait_decl_id ctx.trans_trait_decls in
-  let ctx = { ctx with trait_decl_id = Some trait_decl.def_id } in
-  Extract.extract_trait_decl ctx fmt trait_decl
+  (* Check if the trait declaration is builtin, in which case we ignore it *)
+  let open ExtractBuiltin in
+  let sname = name_to_simple_name trait_decl.name in
+  if SimpleNameMap.find_opt sname (builtin_trait_decls_map ()) = None then
+    let ctx = { ctx with trait_decl_id = Some trait_decl.def_id } in
+    Extract.extract_trait_decl ctx fmt trait_decl
+  else ()
 
 (** Export a trait implementation. *)
 let export_trait_impl (fmt : Format.formatter) (_config : gen_config)
-- 
cgit v1.3.1


From 63107911c16a9991f7d5cf8c6df621318a03ca3b Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 24 Oct 2023 14:32:38 +0200
Subject: Fix various issues with the builtins

---
 compiler/Extract.ml        | 115 +++++++++++++++++++++++----------
 compiler/ExtractBase.ml    |   1 +
 compiler/ExtractBuiltin.ml |  82 +++++++++++++++++------
 compiler/Translate.ml      | 158 ++++++++++++++++++++++++++-------------------
 4 files changed, 234 insertions(+), 122 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 6a306592..ddc02fa7 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -1277,7 +1277,10 @@ and extract_trait_decl_ref (ctx : extraction_ctx) (fmt : F.formatter)
   let name = ctx_get_trait_decl is_opaque tr.trait_decl_id ctx in
   if use_brackets then F.pp_print_string fmt "(";
   F.pp_print_string fmt name;
-  extract_generic_args ctx fmt no_params_tys tr.decl_generics;
+  (* There is something subtle here: the trait obligations for the implemented
+     trait are put inside the parent clauses, so we must ignore them here *)
+  let generics = { tr.decl_generics with trait_refs = [] } in
+  extract_generic_args ctx fmt no_params_tys generics;
   if use_brackets then F.pp_print_string fmt ")"
 
 and extract_generic_args (ctx : extraction_ctx) (fmt : F.formatter)
@@ -1349,7 +1352,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
   let def_name =
     match info with
     | None -> ctx.fmt.type_name def.name
-    | Some info -> info.rust_name
+    | Some info -> String.concat "." info.rust_name
   in
   let is_opaque = def.kind = Opaque in
   let ctx = ctx_add is_opaque (TypeId (AdtId def.def_id)) def_name ctx in
@@ -1363,7 +1366,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
         (* Compute the names *)
         let field_names, cons_name =
           match info with
-          | None ->
+          | None | Some { body_info = None; _ } ->
               let field_names =
                 FieldId.mapi
                   (fun fid (field : field) ->
@@ -1379,7 +1382,11 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
                   (List.combine fields field_names)
               in
               (field_names, cons_name)
-          | _ -> raise (Failure "Invalid builtin information")
+          | Some info ->
+              raise
+                (Failure
+                   ("Invalid builtin information: "
+                   ^ show_builtin_type_info info))
         in
         (* Add the fields *)
         let ctx =
@@ -2365,33 +2372,70 @@ let extract_state_type (fmt : F.formatter) (ctx : extraction_ctx)
 let extract_fun_decl_register_names (ctx : extraction_ctx)
     (has_decreases_clause : fun_decl -> bool) (def : pure_fun_translation) :
     extraction_ctx =
-  let fwd = def.fwd in
-  let backs = def.backs in
-  (* Register the decrease clauses, if necessary *)
-  let register_decreases ctx def =
-    if has_decreases_clause def then
-      (* Add the termination measure *)
-      let ctx = ctx_add_termination_measure def ctx in
-      (* Add the decreases proof for Lean only *)
-      match !Config.backend with
-      | Coq | FStar -> ctx
-      | HOL4 -> raise (Failure "Unexpected")
-      | Lean -> ctx_add_decreases_proof def ctx
-    else ctx
-  in
-  let ctx = List.fold_left register_decreases ctx (fwd.f :: fwd.loops) in
-  let register_fun ctx f = ctx_add_fun_decl def f ctx in
-  let register_funs ctx fl = List.fold_left register_fun ctx fl in
-  (* Register the names of the forward functions *)
-  let ctx =
-    if def.keep_fwd then register_funs ctx (fwd.f :: fwd.loops) else ctx
-  in
-  (* Register the names of the backward functions *)
-  List.fold_left
-    (fun ctx { f = back; loops = loop_backs } ->
-      let ctx = register_fun ctx back in
-      register_funs ctx loop_backs)
-    ctx backs
+  (* Ignore the trait methods **declarations** (rem.: we do not ignore the trait
+     method implementations): we do not need to refer to them directly. We will
+     only use their type for the fields of the records we generate for the trait
+     declarations *)
+  match def.fwd.f.kind with
+  | TraitMethodDecl _ -> ctx
+  | _ -> (
+      (* Check if the function is builtin *)
+      let builtin =
+        let open ExtractBuiltin in
+        let funs_map = builtin_funs_map () in
+        let sname = name_to_simple_name def.fwd.f.basename in
+        SimpleNameMap.find_opt sname funs_map
+      in
+      (* Use the builtin names if necessary *)
+      match builtin with
+      | Some (_filter, info) ->
+          let backs = List.map (fun f -> f.f) def.backs in
+          let funs = if def.keep_fwd then def.fwd.f :: backs else backs in
+          let is_opaque = false in
+          List.fold_left
+            (fun ctx (f : fun_decl) ->
+              let open ExtractBuiltin in
+              let fun_id =
+                (Pure.FunId (Regular f.def_id), f.loop_id, f.back_id)
+              in
+              let fun_name =
+                (List.find
+                   (fun (x : builtin_fun_info) -> x.rg = f.back_id)
+                   info)
+                  .extract_name
+              in
+              ctx_add is_opaque (FunId (FromLlbc fun_id)) fun_name ctx)
+            ctx funs
+      | None ->
+          let fwd = def.fwd in
+          let backs = def.backs in
+          (* Register the decrease clauses, if necessary *)
+          let register_decreases ctx def =
+            if has_decreases_clause def then
+              (* Add the termination measure *)
+              let ctx = ctx_add_termination_measure def ctx in
+              (* Add the decreases proof for Lean only *)
+              match !Config.backend with
+              | Coq | FStar -> ctx
+              | HOL4 -> raise (Failure "Unexpected")
+              | Lean -> ctx_add_decreases_proof def ctx
+            else ctx
+          in
+          let ctx =
+            List.fold_left register_decreases ctx (fwd.f :: fwd.loops)
+          in
+          let register_fun ctx f = ctx_add_fun_decl def f ctx in
+          let register_funs ctx fl = List.fold_left register_fun ctx fl in
+          (* Register the names of the forward functions *)
+          let ctx =
+            if def.keep_fwd then register_funs ctx (fwd.f :: fwd.loops) else ctx
+          in
+          (* Register the names of the backward functions *)
+          List.fold_left
+            (fun ctx { f = back; loops = loop_backs } ->
+              let ctx = register_fun ctx back in
+              register_funs ctx loop_backs)
+            ctx backs)
 
 (** Simply add the global name to the context. *)
 let extract_global_decl_register_names (ctx : extraction_ctx)
@@ -4539,6 +4583,7 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter)
 (** Extract a trait implementation *)
 let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
     (impl : trait_impl) : unit =
+  log#ldebug (lazy ("extract_trait_impl: " ^ Names.name_to_string impl.name));
   (* Retrieve the impl name *)
   let with_opaque_pre = false in
   let impl_name = ctx_get_trait_impl with_opaque_pre impl.def_id ctx in
@@ -4565,9 +4610,11 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
   (* `let (....) : Trait ... =` *)
   (* Open the box for the name + generics *)
   F.pp_open_hovbox fmt ctx.indent_incr;
-  let qualif = Option.get (ctx.fmt.fun_decl_kind_to_qualif SingleNonRec) in
-  F.pp_print_string fmt qualif;
-  F.pp_print_space fmt ();
+  (match ctx.fmt.fun_decl_kind_to_qualif SingleNonRec with
+  | Some qualif ->
+      F.pp_print_string fmt qualif;
+      F.pp_print_space fmt ()
+  | None -> ());
   F.pp_print_string fmt impl_name;
 
   (* Print the generics *)
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index ea5fe8d3..22b017e5 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1249,6 +1249,7 @@ let ctx_compute_fun_name (trans_group : pure_fun_translation) (def : fun_decl)
   ctx.fmt.fun_name def.basename def.num_loops def.loop_id num_rgs rg_info
     (keep_fwd, num_backs)
 
+(* TODO: move to Extract *)
 let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
     (ctx : extraction_ctx) : extraction_ctx =
   (* Sanity check: the function should not be a global body - those are handled
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index 3b4afff6..0d591028 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -78,21 +78,24 @@ let builtin_globals_map : string SimpleNameMap.t =
     (List.map (fun (x, y) -> (string_to_simple_name x, y)) builtin_globals)
 
 type builtin_variant_info = { fields : (string * string) list }
+[@@deriving show]
 
 type builtin_enum_variant_info = {
   rust_variant_name : string;
   extract_variant_name : string;
   fields : string list option;
 }
+[@@deriving show]
 
 type builtin_type_body_info =
   | Struct of string * string list
     (* The constructor name and the map for the field names *)
   | Enum of builtin_enum_variant_info list
 (* For every variant, a map for the field names *)
+[@@deriving show]
 
 type builtin_type_info = {
-  rust_name : string;
+  rust_name : string list;
   extract_name : string;
   keep_params : bool list option;
       (** We might want to filter some of the type parameters.
@@ -102,6 +105,7 @@ type builtin_type_info = {
        *)
   body_info : builtin_type_body_info option;
 }
+[@@deriving show]
 
 (** The assumed types.
 
@@ -113,7 +117,7 @@ let builtin_types () : builtin_type_info list =
   [
     (* Alloc *)
     {
-      rust_name = "alloc::alloc::Global";
+      rust_name = [ "alloc"; "alloc"; "Global" ];
       extract_name =
         (match !backend with
         | Lean -> "AllocGlobal"
@@ -123,7 +127,7 @@ let builtin_types () : builtin_type_info list =
     };
     (* Vec *)
     {
-      rust_name = "alloc::vec::Vec";
+      rust_name = [ "alloc"; "vec"; "Vec" ];
       extract_name =
         (match !backend with Lean -> "Vec" | Coq | FStar | HOL4 -> "vec");
       keep_params = Some [ true; false ];
@@ -131,7 +135,7 @@ let builtin_types () : builtin_type_info list =
     };
     (* Option *)
     {
-      rust_name = "core::option::Option";
+      rust_name = [ "core"; "option"; "Option" ];
       extract_name =
         (match !backend with
         | Lean -> "Option"
@@ -163,7 +167,7 @@ let builtin_types () : builtin_type_info list =
     };
     (* Range *)
     {
-      rust_name = "core::ops::range::Range";
+      rust_name = [ "core"; "ops"; "range"; "Range" ];
       extract_name =
         (match !backend with Lean -> "Range" | Coq | FStar | HOL4 -> "range");
       keep_params = None;
@@ -180,9 +184,7 @@ let builtin_types () : builtin_type_info list =
 
 let mk_builtin_types_map () =
   SimpleNameMap.of_list
-    (List.map
-       (fun info -> (string_to_simple_name info.rust_name, info))
-       (builtin_types ()))
+    (List.map (fun info -> (info.rust_name, info)) (builtin_types ()))
 
 let builtin_types_map = mk_memoized mk_builtin_types_map
 
@@ -190,6 +192,7 @@ type builtin_fun_info = {
   rg : Types.RegionGroupId.id option;
   extract_name : string;
 }
+[@@deriving show]
 
 (** The assumed functions.
 
@@ -197,10 +200,12 @@ type builtin_fun_info = {
     parameters. For instance, in the case of the `Vec` functions, there is
     a type parameter for the allocator to use, which we want to filter.
  *)
-let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
+let builtin_funs () :
+    (string list * bool list option * builtin_fun_info list) list =
   let rg0 = Some Types.RegionGroupId.zero in
+  (* TODO: fix the names below *)
   [
-    ( "core::mem::replace",
+    ( [ "core::mem::replace" ],
       None,
       [
         {
@@ -218,7 +223,7 @@ let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
             | Lean -> "mem.replace_back");
         };
       ] );
-    ( "alloc::vec::Vec::new",
+    ( [ "alloc::vec::Vec::new" ],
       Some [ true; false ],
       [
         {
@@ -236,7 +241,7 @@ let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
             | Lean -> "Vec.new_back");
         };
       ] );
-    ( "alloc::vec::Vec::push",
+    ( [ "alloc::vec::Vec::push" ],
       Some [ true; false ],
       [
         (* The forward function shouldn't be used *)
@@ -255,7 +260,7 @@ let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
             | Lean -> "Vec.push");
         };
       ] );
-    ( "alloc::vec::Vec::insert",
+    ( [ "alloc::vec::Vec::insert" ],
       Some [ true; false ],
       [
         (* The forward function shouldn't be used *)
@@ -274,7 +279,7 @@ let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
             | Lean -> "Vec.insert");
         };
       ] );
-    ( "alloc::vec::Vec::len",
+    ( [ "alloc::vec::Vec::len" ],
       Some [ true; false ],
       [
         {
@@ -285,7 +290,7 @@ let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
             | Lean -> "Vec.len");
         };
       ] );
-    ( "alloc::vec::Vec::index",
+    ( [ "alloc::vec::Vec::index" ],
       Some [ true; false ],
       [
         {
@@ -304,7 +309,7 @@ let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
             | Lean -> "Vec.index_shared_back");
         };
       ] );
-    ( "alloc::vec::Vec::index_mut",
+    ( [ "alloc::vec::Vec::index_mut" ],
       Some [ true; false ],
       [
         {
@@ -323,16 +328,52 @@ let builtin_funs () : (string * bool list option * builtin_fun_info list) list =
             | Lean -> "Vec.index_mut_back");
         };
       ] );
+    ( [ "alloc"; "boxed"; "Box"; "deref" ],
+      Some [ true; false ],
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "alloc_boxed_box_deref"
+            | Lean -> "alloc.boxed.Box.deref");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_back"
+            | Lean -> "alloc.boxed.Box.deref_back");
+        };
+      ] );
+    ( [ "alloc"; "boxed"; "Box"; "deref_mut" ],
+      Some [ true; false ],
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_mut"
+            | Lean -> "alloc.boxed.Box.deref_mut");
+        };
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_mut_back"
+            | Lean -> "alloc.boxed.Box.deref_mut_back");
+        };
+      ] );
   ]
 
 let mk_builtin_funs_map () =
   SimpleNameMap.of_list
     (List.map
-       (fun (name, filter, info) ->
-         (string_to_simple_name name, (filter, info)))
+       (fun (name, filter, info) -> (name, (filter, info)))
        (builtin_funs ()))
 
-let builtin_funs_map () = mk_memoized mk_builtin_funs_map
+let builtin_funs_map = mk_memoized mk_builtin_funs_map
 
 type builtin_trait_decl_info = {
   rust_name : string;
@@ -346,6 +387,7 @@ type builtin_trait_decl_info = {
           - a list of clauses *)
   funs : (string * (Types.RegionGroupId.id option * string) list) list;
 }
+[@@deriving show]
 
 let builtin_trait_decls_info () =
   let rg0 = Some Types.RegionGroupId.zero in
@@ -389,7 +431,7 @@ let builtin_trait_decls_info () =
         [
           (match !backend with
           | Coq | FStar | HOL4 -> "deref_inst"
-          | Lean -> "DerefInst");
+          | Lean -> "derefInst");
         ];
       consts = [];
       types = [];
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 0871a305..95252b61 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -654,78 +654,100 @@ let export_functions_group_scc (fmt : Format.formatter) (config : gen_config)
  *)
 let export_functions_group (fmt : Format.formatter) (config : gen_config)
     (ctx : gen_ctx) (pure_ls : pure_fun_translation list) : unit =
-  (* Utility to check a function has a decrease clause *)
-  let has_decreases_clause (def : Pure.fun_decl) : bool =
-    PureUtils.FunLoopIdSet.mem (def.def_id, def.loop_id)
-      ctx.functions_with_decreases_clause
+  (* Check if the definition are builtin - if yes they must be ignored.
+     Note that if one definition in the group is builtin, then all the
+     definitions must be builtin *)
+  let builtin =
+    let open ExtractBuiltin in
+    let funs_map = builtin_funs_map () in
+    List.map
+      (fun (trans : pure_fun_translation) ->
+        let sname = name_to_simple_name trans.fwd.f.basename in
+        SimpleNameMap.find_opt sname funs_map <> None)
+      pure_ls
   in
 
-  (* Extract the decrease clauses template bodies *)
-  if config.extract_template_decreases_clauses then
-    List.iter
-      (fun { fwd; _ } ->
-        (* We only generate decreases clauses for the forward functions, because
-           the termination argument should only depend on the forward inputs.
-           The backward functions thus use the same decreases clauses as the
-           forward function.
-
-           Rem.: we might filter backward functions in {!PureMicroPasses}, but
-           we don't remove forward functions. Instead, we remember if we should
-           filter those functions at extraction time with a boolean (see the
-           type of the [pure_ls] input parameter).
-        *)
-        let extract_decrease decl =
-          let has_decr_clause = has_decreases_clause decl in
-          if has_decr_clause then
-            match !Config.backend with
-            | Lean ->
-                Extract.extract_template_lean_termination_and_decreasing ctx fmt
-                  decl
-            | FStar ->
-                Extract.extract_template_fstar_decreases_clause ctx fmt decl
-            | Coq ->
-                raise (Failure "Coq doesn't have decreases/termination clauses")
-            | HOL4 ->
-                raise
-                  (Failure "HOL4 doesn't have decreases/termination clauses")
-        in
-        extract_decrease fwd.f;
-        List.iter extract_decrease fwd.loops)
-      pure_ls;
-
-  (* Concatenate the function definitions, filtering the useless forward
-   * functions. *)
-  let decls =
-    List.concat
-      (List.map
-         (fun { keep_fwd; fwd; backs } ->
-           let fwd = if keep_fwd then List.append fwd.loops [ fwd.f ] else [] in
-           let backs : Pure.fun_decl list =
-             List.concat
-               (List.map (fun back -> List.append back.loops [ back.f ]) backs)
-           in
-           List.append fwd backs)
-         pure_ls)
-  in
+  if List.exists (fun b -> b) builtin then
+    (* Sanity check *)
+    assert (List.for_all (fun b -> b) builtin)
+  else
+    (* Utility to check a function has a decrease clause *)
+    let has_decreases_clause (def : Pure.fun_decl) : bool =
+      PureUtils.FunLoopIdSet.mem (def.def_id, def.loop_id)
+        ctx.functions_with_decreases_clause
+    in
+
+    (* Extract the decrease clauses template bodies *)
+    if config.extract_template_decreases_clauses then
+      List.iter
+        (fun { fwd; _ } ->
+          (* We only generate decreases clauses for the forward functions, because
+             the termination argument should only depend on the forward inputs.
+             The backward functions thus use the same decreases clauses as the
+             forward function.
+
+             Rem.: we might filter backward functions in {!PureMicroPasses}, but
+             we don't remove forward functions. Instead, we remember if we should
+             filter those functions at extraction time with a boolean (see the
+             type of the [pure_ls] input parameter).
+          *)
+          let extract_decrease decl =
+            let has_decr_clause = has_decreases_clause decl in
+            if has_decr_clause then
+              match !Config.backend with
+              | Lean ->
+                  Extract.extract_template_lean_termination_and_decreasing ctx
+                    fmt decl
+              | FStar ->
+                  Extract.extract_template_fstar_decreases_clause ctx fmt decl
+              | Coq ->
+                  raise
+                    (Failure "Coq doesn't have decreases/termination clauses")
+              | HOL4 ->
+                  raise
+                    (Failure "HOL4 doesn't have decreases/termination clauses")
+          in
+          extract_decrease fwd.f;
+          List.iter extract_decrease fwd.loops)
+        pure_ls;
+
+    (* Concatenate the function definitions, filtering the useless forward
+     * functions. *)
+    let decls =
+      List.concat
+        (List.map
+           (fun { keep_fwd; fwd; backs } ->
+             let fwd =
+               if keep_fwd then List.append fwd.loops [ fwd.f ] else []
+             in
+             let backs : Pure.fun_decl list =
+               List.concat
+                 (List.map
+                    (fun back -> List.append back.loops [ back.f ])
+                    backs)
+             in
+             List.append fwd backs)
+           pure_ls)
+    in
 
-  (* Extract the function definitions *)
-  (if config.extract_fun_decls then
-     (* Group the mutually recursive definitions *)
-     let subgroups = ReorderDecls.group_reorder_fun_decls decls in
+    (* Extract the function definitions *)
+    (if config.extract_fun_decls then
+       (* Group the mutually recursive definitions *)
+       let subgroups = ReorderDecls.group_reorder_fun_decls decls in
 
-     (* Extract the subgroups *)
-     let export_subgroup (is_rec : bool) (decls : Pure.fun_decl list) : unit =
-       export_functions_group_scc fmt config ctx is_rec decls
-     in
-     List.iter (fun (is_rec, decls) -> export_subgroup is_rec decls) subgroups);
-
-  (* Insert unit tests if necessary *)
-  if config.test_trans_unit_functions then
-    List.iter
-      (fun trans ->
-        if trans.keep_fwd then
-          Extract.extract_unit_test_if_unit_fun ctx fmt trans.fwd.f)
-      pure_ls
+       (* Extract the subgroups *)
+       let export_subgroup (is_rec : bool) (decls : Pure.fun_decl list) : unit =
+         export_functions_group_scc fmt config ctx is_rec decls
+       in
+       List.iter (fun (is_rec, decls) -> export_subgroup is_rec decls) subgroups);
+
+    (* Insert unit tests if necessary *)
+    if config.test_trans_unit_functions then
+      List.iter
+        (fun trans ->
+          if trans.keep_fwd then
+            Extract.extract_unit_test_if_unit_fun ctx fmt trans.fwd.f)
+        pure_ls
 
 (** Export a trait declaration. *)
 let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
-- 
cgit v1.3.1


From be70eed487b507dc002660a4c891397003165e75 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 24 Oct 2023 15:01:55 +0200
Subject: Add support for builtin trait implementations

---
 compiler/Extract.ml        | 32 ++++++++++++++++++++++++++++++--
 compiler/ExtractBase.ml    | 17 -----------------
 compiler/ExtractBuiltin.ml | 34 ++++++++++++++++++++++++++++++++++
 compiler/Translate.ml      | 17 ++++++++++++++++-
 4 files changed, 80 insertions(+), 20 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index ddc02fa7..a1c9605b 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -4320,7 +4320,15 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
   let builtin_info =
     SimpleNameMap.find_opt sname (builtin_trait_decls_map ())
   in
-  let ctx = ctx_add_trait_decl trait_decl ctx in
+  let ctx =
+    let trait_name =
+      match builtin_info with
+      | None -> ctx.fmt.trait_decl_name trait_decl
+      | Some info -> info.extract_name
+    in
+    let is_opaque = false in
+    ctx_add is_opaque (TraitDeclId trait_decl.def_id) trait_name ctx
+  in
   (* Parent clauses *)
   let ctx =
     extract_trait_decl_register_parent_clause_names ctx trait_decl builtin_info
@@ -4338,11 +4346,31 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
 (** Similar to {!extract_type_decl_register_names} *)
 let extract_trait_impl_register_names (ctx : extraction_ctx)
     (trait_impl : trait_impl) : extraction_ctx =
+  let trait_decl =
+    TraitDeclId.Map.find trait_impl.impl_trait.trait_decl_id
+      ctx.trans_trait_decls
+  in
+  (* Check if the trait implementation is builtin *)
+  let builtin_info =
+    let open ExtractBuiltin in
+    let type_sname = name_to_simple_name trait_impl.name in
+    let trait_sname = name_to_simple_name trait_decl.name in
+    SimpleNamePairMap.find_opt (type_sname, trait_sname)
+      (builtin_trait_impls_map ())
+  in
+
   (* For now we do not support overriding provided methods *)
   assert (trait_impl.provided_methods = []);
   (* Everything is taken care of by {!extract_trait_decl_register_names} *but*
      the name of the implementation itself *)
-  ctx_add_trait_impl trait_impl ctx
+  (* Compute the name *)
+  let name =
+    match builtin_info with
+    | None -> ctx.fmt.trait_impl_name trait_decl trait_impl
+    | Some name -> name
+  in
+  let is_opaque = false in
+  ctx_add is_opaque (TraitImplId trait_impl.def_id) name ctx
 
 (** Small helper.
 
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 22b017e5..3ff299f2 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1272,23 +1272,6 @@ let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
         ctx.fun_name_info;
   }
 
-let ctx_add_trait_decl (d : trait_decl) (ctx : extraction_ctx) : extraction_ctx
-    =
-  let is_opaque = false in
-  let name = ctx.fmt.trait_decl_name d in
-  ctx_add is_opaque (TraitDeclId d.def_id) name ctx
-
-let ctx_add_trait_impl (d : trait_impl) (ctx : extraction_ctx) : extraction_ctx
-    =
-  (* We need to lookup the trait decl that is implemented by the trait impl *)
-  let decl =
-    Pure.TraitDeclId.Map.find d.impl_trait.trait_decl_id ctx.trans_trait_decls
-  in
-  (* Compute the name *)
-  let is_opaque = false in
-  let name = ctx.fmt.trait_impl_name decl d in
-  ctx_add is_opaque (TraitImplId d.def_id) name ctx
-
 type names_map_init = {
   keywords : string list;
   assumed_adts : (assumed_ty * string) list;
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index 0d591028..d3cea54e 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -517,3 +517,37 @@ let mk_builtin_trait_decls_map () =
        (builtin_trait_decls_info ()))
 
 let builtin_trait_decls_map = mk_memoized mk_builtin_trait_decls_map
+
+(* TODO: generalize this.
+
+   For now, the key is:
+   - name of the impl (ex.: "alloc.boxed.Boxed")
+   - name of the implemented trait (ex.: "core.ops.deref.Deref"
+*)
+type simple_name_pair = simple_name * simple_name [@@deriving show, ord]
+
+module SimpleNamePairOrd = struct
+  type t = simple_name_pair
+
+  let compare = compare_simple_name_pair
+  let to_string = show_simple_name_pair
+  let pp_t = pp_simple_name_pair
+  let show_t = show_simple_name_pair
+end
+
+module SimpleNamePairMap = Collections.MakeMap (SimpleNamePairOrd)
+
+let builtin_trait_impls_info () : ((string list * string list) * string) list =
+  [
+    (* core::ops::Deref<alloc::boxed::Box<T>> *)
+    ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "Deref" ]),
+      "alloc.boxed.Box.coreOpsDerefInst" );
+    (* core::ops::DerefMut<alloc::boxed::Box<T>> *)
+    ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "DerefMut" ]),
+      "alloc.boxed.Box.coreOpsDerefMutInst" );
+  ]
+
+let mk_builtin_trait_impls_map () =
+  SimpleNamePairMap.of_list (builtin_trait_impls_info ())
+
+let builtin_trait_impls_map = mk_memoized mk_builtin_trait_impls_map
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 95252b61..74a8537f 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -764,8 +764,23 @@ let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
 (** Export a trait implementation. *)
 let export_trait_impl (fmt : Format.formatter) (_config : gen_config)
     (ctx : gen_ctx) (trait_impl_id : Pure.trait_impl_id) : unit =
+  (* Lookup the definition *)
   let trait_impl = T.TraitImplId.Map.find trait_impl_id ctx.trans_trait_impls in
-  Extract.extract_trait_impl ctx fmt trait_impl
+  let trait_decl =
+    Pure.TraitDeclId.Map.find trait_impl.impl_trait.trait_decl_id
+      ctx.trans_trait_decls
+  in
+  (* Check if the trait implementation is builtin *)
+  let builtin_info =
+    let open ExtractBuiltin in
+    let type_sname = name_to_simple_name trait_impl.name in
+    let trait_sname = name_to_simple_name trait_decl.name in
+    SimpleNamePairMap.find_opt (type_sname, trait_sname)
+      (builtin_trait_impls_map ())
+  in
+  match builtin_info with
+  | None -> Extract.extract_trait_impl ctx fmt trait_impl
+  | Some _ -> ()
 
 (** A generic utility to generate the extracted definitions: as we may want to
     split the definitions between different files (or not), we can control
-- 
cgit v1.3.1


From b631875f8166b3db81187a179eef2f21f52db2bd Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 24 Oct 2023 15:26:41 +0200
Subject: Remove the possibility of generating opaque module signatures

---
 compiler/Config.ml      |   7 --
 compiler/Extract.ml     | 167 +++++++++++-----------------------
 compiler/ExtractBase.ml | 233 ++++++++++++------------------------------------
 compiler/Translate.ml   |  34 +------
 4 files changed, 111 insertions(+), 330 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Config.ml b/compiler/Config.ml
index 62f6c300..cd0903b6 100644
--- a/compiler/Config.ml
+++ b/compiler/Config.ml
@@ -306,13 +306,6 @@ let filter_useless_monadic_calls = ref true
  *)
 let filter_useless_functions = ref true
 
-(** Obsolete. TODO: remove.
-
-    For Lean we used to parameterize the entire development by a section variable
-    called opaque_defs, of type OpaqueDefs.
-  *)
-let wrap_opaque_in_sig = ref false
-
 (** Use short names for the record fields.
 
     Some backends can't disambiguate records when their field names have collisions.
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index a1c9605b..275cb3b9 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -758,12 +758,6 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     fname ^ lp_suffix ^ suffix
   in
 
-  let opaque_pre () =
-    match !Config.backend with
-    | FStar | Coq | HOL4 -> ""
-    | Lean -> if !Config.wrap_opaque_in_sig then "opaque_defs." else ""
-  in
-
   let var_basename (_varset : StringSet.t) (basename : string option) (ty : ty)
       : string =
     (* Small helper to derive var names from ADT type names.
@@ -934,7 +928,6 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     trait_type_name;
     trait_method_name;
     trait_type_clause_name;
-    opaque_pre;
     var_basename;
     type_var_basename;
     const_generic_var_basename;
@@ -983,11 +976,8 @@ let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter)
       (* In HOL4, opaque functions have a special treatment *)
       if is_single_opaque_fun_decl_group dg then ()
       else
-        let with_opaque_pre = false in
         let compute_fun_def_name (def : Pure.fun_decl) : string =
-          ctx_get_local_function with_opaque_pre def.def_id def.loop_id
-            def.back_id ctx
-          ^ "_def"
+          ctx_get_local_function def.def_id def.loop_id def.back_id ctx ^ "_def"
         in
         let names = List.map compute_fun_def_name dg in
         (* Add a break before *)
@@ -1110,7 +1100,7 @@ let extract_const_generic (ctx : extraction_ctx) (fmt : F.formatter)
     (inside : bool) (cg : const_generic) : unit =
   match cg with
   | ConstGenericGlobal id ->
-      let s = ctx_get_global ctx.use_opaque_pre id ctx in
+      let s = ctx_get_global id ctx in
       F.pp_print_string fmt s
   | ConstGenericValue v -> ctx.fmt.extract_literal fmt inside v
   | ConstGenericVar id ->
@@ -1178,14 +1168,13 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
              In HOL4 we would write:
              `('a, 'b) tree`
           *)
-          let with_opaque_pre = false in
           match !backend with
           | FStar | Coq | Lean ->
               let print_paren = inside && has_params in
               if print_paren then F.pp_print_string fmt "(";
               (* TODO: for now, only the opaque *functions* are extracted in the
                  opaque module. The opaque *types* are assumed. *)
-              F.pp_print_string fmt (ctx_get_type with_opaque_pre type_id ctx);
+              F.pp_print_string fmt (ctx_get_type type_id ctx);
               extract_generic_args ctx fmt no_params_tys generics;
               if print_paren then F.pp_print_string fmt ")"
           | HOL4 ->
@@ -1208,7 +1197,7 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
                   (extract_rec true) types;
                 if print_paren then F.pp_print_string fmt ")";
                 F.pp_print_space fmt ());
-              F.pp_print_string fmt (ctx_get_type with_opaque_pre type_id ctx);
+              F.pp_print_string fmt (ctx_get_type type_id ctx);
               if trait_refs <> [] then (
                 F.pp_print_space fmt ();
                 Collections.List.iter_link (F.pp_print_space fmt)
@@ -1273,8 +1262,7 @@ and extract_trait_decl_ref (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_decl_ref) :
     unit =
   let use_brackets = tr.decl_generics <> empty_generic_args && inside in
-  let is_opaque = false in
-  let name = ctx_get_trait_decl is_opaque tr.trait_decl_id ctx in
+  let name = ctx_get_trait_decl tr.trait_decl_id ctx in
   if use_brackets then F.pp_print_string fmt "(";
   F.pp_print_string fmt name;
   (* There is something subtle here: the trait obligations for the implemented
@@ -1307,14 +1295,13 @@ and extract_generic_args (ctx : extraction_ctx) (fmt : F.formatter)
 and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (inside : bool) (id : trait_instance_id)
     : unit =
-  let with_opaque_pre = false in
   match id with
   | Self ->
       (* This has specific treatment depending on the item we're extracting
          (associated type, etc.). We should have caught this elsewhere. *)
       raise (Failure "Unexpected")
   | TraitImpl id ->
-      let name = ctx_get_trait_impl with_opaque_pre id ctx in
+      let name = ctx_get_trait_impl id ctx in
       F.pp_print_string fmt name
   | Clause id ->
       let name = ctx_get_local_trait_clause id ctx in
@@ -1354,8 +1341,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
     | None -> ctx.fmt.type_name def.name
     | Some info -> String.concat "." info.rust_name
   in
-  let is_opaque = def.kind = Opaque in
-  let ctx = ctx_add is_opaque (TypeId (AdtId def.def_id)) def_name ctx in
+  let ctx = ctx_add (TypeId (AdtId def.def_id)) def_name ctx in
   (* Compute and register:
    * - the variant names, if this is an enumeration
    * - the field names, if this is a structure
@@ -1392,11 +1378,11 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
         let ctx =
           List.fold_left
             (fun ctx (fid, name) ->
-              ctx_add is_opaque (FieldId (AdtId def.def_id, fid)) name ctx)
+              ctx_add (FieldId (AdtId def.def_id, fid)) name ctx)
             ctx field_names
         in
         (* Add the constructor name *)
-        ctx_add is_opaque (StructId (AdtId def.def_id)) cons_name ctx
+        ctx_add (StructId (AdtId def.def_id)) cons_name ctx
     | Enum variants ->
         let variant_names =
           match info with
@@ -1432,7 +1418,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
         in
         List.fold_left
           (fun ctx (vid, vname) ->
-            ctx_add is_opaque (VariantId (AdtId def.def_id, vid)) vname ctx)
+            ctx_add (VariantId (AdtId def.def_id, vid)) vname ctx)
           ctx variant_names
     | Opaque ->
         (* Nothing to do *)
@@ -1635,9 +1621,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter)
       (* If Coq: print the constructor name *)
       (* TODO: remove superfluous test not is_rec below *)
       if !backend = Coq && not is_rec then (
-        let with_opaque_pre = false in
-        F.pp_print_string fmt
-          (ctx_get_struct with_opaque_pre (AdtId def.def_id) ctx);
+        F.pp_print_string fmt (ctx_get_struct (AdtId def.def_id) ctx);
         F.pp_print_string fmt " ");
       (match !backend with
       | Lean -> ()
@@ -1681,16 +1665,14 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter)
       (* We extract for Coq or Lean, and we have a recursive record, or a record in
          a group of mutually recursive types: we extract it as an inductive type *)
       assert (is_rec && (!backend = Coq || !backend = Lean));
-      let with_opaque_pre = false in
       (* Small trick: in Lean we use namespaces, meaning we don't need to prefix
          the constructor name with the name of the type at definition site,
          i.e., instead of generating `inductive Foo := | MkFoo ...` like in Coq
          we generate `inductive Foo := | mk ... *)
       let cons_name =
-        if !backend = Lean then "mk"
-        else ctx_get_struct with_opaque_pre (AdtId def.def_id) ctx
+        if !backend = Lean then "mk" else ctx_get_struct (AdtId def.def_id) ctx
       in
-      let def_name = ctx_get_local_type with_opaque_pre def.def_id ctx in
+      let def_name = ctx_get_local_type def.def_id ctx in
       extract_type_decl_variant ctx fmt type_decl_group def_name type_params
         cg_params cons_name fields)
   in
@@ -1720,8 +1702,7 @@ let extract_comment (fmt : F.formatter) (sl : string list) : unit =
 
 let extract_trait_clause_type (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (clause : trait_clause) : unit =
-  let with_opaque_pre = false in
-  let trait_name = ctx_get_trait_decl with_opaque_pre clause.trait_id ctx in
+  let trait_name = ctx_get_trait_decl clause.trait_id ctx in
   F.pp_print_string fmt trait_name;
   extract_generic_args ctx fmt no_params_tys clause.generics
 
@@ -1743,8 +1724,7 @@ let extract_trait_self_clause (insert_req_space : unit -> unit)
   F.pp_print_space fmt ();
   F.pp_print_string fmt ":";
   F.pp_print_space fmt ();
-  let with_opaque_pre = false in
-  let trait_id = ctx_get_trait_decl with_opaque_pre trait_decl.def_id ctx in
+  let trait_id = ctx_get_trait_decl trait_decl.def_id ctx in
   F.pp_print_string fmt trait_id;
   List.iter
     (fun p ->
@@ -1913,8 +1893,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
   let is_opaque_coq = !backend = Coq && is_opaque in
   let use_forall = is_opaque_coq && def.generics <> empty_generic_params in
   (* Retrieve the definition name *)
-  let with_opaque_pre = false in
-  let def_name = ctx_get_local_type with_opaque_pre def.def_id ctx in
+  let def_name = ctx_get_local_type def.def_id ctx in
   (* Add the type and const generic params - note that we need those bindings only for the
    * body translation (they are not top-level) *)
   let ctx_body, type_params, cg_params, trait_clauses =
@@ -2001,8 +1980,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
 let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter)
     (def : type_decl) : unit =
   (* Retrieve the definition name *)
-  let with_opaque_pre = false in
-  let def_name = ctx_get_local_type with_opaque_pre def.def_id ctx in
+  let def_name = ctx_get_local_type def.def_id ctx in
   (* Generic parameters are unsupported *)
   assert (def.generics.const_generics = []);
   (* Trait clauses on type definitions are unsupported *)
@@ -2027,8 +2005,7 @@ let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter)
 let extract_type_decl_hol4_empty_record (ctx : extraction_ctx)
     (fmt : F.formatter) (def : type_decl) : unit =
   (* Retrieve the definition name *)
-  let with_opaque_pre = false in
-  let def_name = ctx_get_local_type with_opaque_pre def.def_id ctx in
+  let def_name = ctx_get_local_type def.def_id ctx in
   (* Sanity check *)
   assert (def.generics = empty_generic_params);
   (* Generate the declaration *)
@@ -2111,8 +2088,7 @@ let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter)
     | Struct fields ->
         let adt_id = AdtId decl.def_id in
         (* Generate the instruction for the record constructor *)
-        let with_opaque_pre = false in
-        let cons_name = ctx_get_struct with_opaque_pre adt_id ctx in
+        let cons_name = ctx_get_struct adt_id ctx in
         extract_arguments_info cons_name fields;
         (* Generate the instruction for the record projectors, if there are *)
         let is_rec = decl_is_from_rec_group kind in
@@ -2156,11 +2132,8 @@ let extract_type_decl_record_field_projectors (ctx : extraction_ctx)
         in
         let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in
         let ctx, field_var = ctx_add_var "x" (VarId.of_int 1) ctx in
-        let with_opaque_pre = false in
-        let def_name = ctx_get_local_type with_opaque_pre decl.def_id ctx in
-        let cons_name =
-          ctx_get_struct with_opaque_pre (AdtId decl.def_id) ctx
-        in
+        let def_name = ctx_get_local_type decl.def_id ctx in
+        let cons_name = ctx_get_struct (AdtId decl.def_id) ctx in
         let extract_field_proj (field_id : FieldId.id) (_ : field) : unit =
           F.pp_print_space fmt ();
           (* Outer box for the projector definition *)
@@ -2391,7 +2364,6 @@ let extract_fun_decl_register_names (ctx : extraction_ctx)
       | Some (_filter, info) ->
           let backs = List.map (fun f -> f.f) def.backs in
           let funs = if def.keep_fwd then def.fwd.f :: backs else backs in
-          let is_opaque = false in
           List.fold_left
             (fun ctx (f : fun_decl) ->
               let open ExtractBuiltin in
@@ -2404,7 +2376,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx)
                    info)
                   .extract_name
               in
-              ctx_add is_opaque (FunId (FromLlbc fun_id)) fun_name ctx)
+              ctx_add (FunId (FromLlbc fun_id)) fun_name ctx)
             ctx funs
       | None ->
           let fwd = def.fwd in
@@ -2509,18 +2481,14 @@ let extract_adt_g_value
          * [{ field0=...; ...; fieldn=...; }] in case of structures.
          *)
         let cons =
-          (* The ADT shouldn't be opaque *)
-          let with_opaque_pre = false in
           match variant_id with
           | Some vid -> (
               (* In the case of Lean, we might have to add the type name as a prefix *)
               match (!backend, adt_id) with
               | Lean, Assumed _ ->
-                  ctx_get_type with_opaque_pre adt_id ctx
-                  ^ "."
-                  ^ ctx_get_variant adt_id vid ctx
+                  ctx_get_type adt_id ctx ^ "." ^ ctx_get_variant adt_id vid ctx
               | _ -> ctx_get_variant adt_id vid ctx)
-          | None -> ctx_get_struct with_opaque_pre adt_id ctx
+          | None -> ctx_get_struct adt_id ctx
         in
         let use_parentheses = inside && field_values <> [] in
         if use_parentheses then F.pp_print_string fmt "(";
@@ -2539,8 +2507,7 @@ let extract_adt_g_value
 (* Extract globals in the same way as variables *)
 let extract_global (ctx : extraction_ctx) (fmt : F.formatter)
     (id : A.GlobalDeclId.id) : unit =
-  let with_opaque_pre = ctx.use_opaque_pre in
-  F.pp_print_string fmt (ctx_get_global with_opaque_pre id ctx)
+  F.pp_print_string fmt (ctx_get_global id ctx)
 
 (** [inside]: see {!extract_ty}.
 
@@ -2676,9 +2643,9 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
       if inside then F.pp_print_string fmt "(";
       (* Open a box for the function call *)
       F.pp_open_hovbox fmt ctx.indent_incr;
-      (* Print the function name *)
-      let with_opaque_pre = ctx.use_opaque_pre in
-      (* For the function name: the id is not the same depending on whether
+      (* Print the function name.
+
+         For the function name: the id is not the same depending on whether
          we call a trait method and a "regular" function (remark: trait
          method *implementations* are considered as regular functions here;
          only calls to method of traits which are parameterized in a where
@@ -2751,7 +2718,7 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
             let fun_id =
               FromLlbc (FunId (Regular method_id.id), lp_id, rg_id)
             in
-            let fun_name = ctx_get_function with_opaque_pre fun_id ctx in
+            let fun_name = ctx_get_function fun_id ctx in
             F.pp_print_string fmt fun_name;
 
             (* Note that we do not need to print the generics for the trait
@@ -2762,7 +2729,7 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
             F.pp_print_space fmt ();
             extract_trait_ref ctx fmt TypeDeclId.Set.empty true trait_ref
       | _ ->
-          let fun_name = ctx_get_function with_opaque_pre fun_id ctx in
+          let fun_name = ctx_get_function fun_id ctx in
           F.pp_print_string fmt fun_name);
 
       (* Sanity check: HOL4 doesn't support const generics *)
@@ -3260,7 +3227,7 @@ and extract_StructUpdate (ctx : extraction_ctx) (fmt : F.formatter)
         (* Open the box for `Array.replicate T N [` *)
         F.pp_open_hovbox fmt ctx.indent_incr;
         (* Print the array constructor *)
-        let cs = ctx_get_struct false (Assumed Array) ctx in
+        let cs = ctx_get_struct (Assumed Array) ctx in
         F.pp_print_string fmt cs;
         (* Print the parameters *)
         let _, generics = ty_as_adt e_ty in
@@ -3613,10 +3580,8 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
     (kind : decl_kind) (has_decreases_clause : bool) (def : fun_decl) : unit =
   assert (not def.is_global_decl_body);
   (* Retrieve the function name *)
-  let with_opaque_pre = false in
   let def_name =
-    ctx_get_local_function with_opaque_pre def.def_id def.loop_id def.back_id
-      ctx
+    ctx_get_local_function def.def_id def.loop_id def.back_id ctx
   in
   (* Add a break before *)
   if !backend <> HOL4 || not (decl_is_first_from_group kind) then
@@ -3649,8 +3614,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
      if `wrap_opaque_in_sig`: we generate a record of assumed funcions.
      TODO: this is obsolete.
   *)
-  (if not (!Config.wrap_opaque_in_sig && (kind = Assumed || kind = Declared))
-   then
+  (if not (kind = Assumed || kind = Declared) then
      let qualif = ctx.fmt.fun_decl_kind_to_qualif kind in
      match qualif with
      | Some qualif ->
@@ -3867,10 +3831,8 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
 let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter)
     (def : fun_decl) : unit =
   (* Retrieve the definition name *)
-  let with_opaque_pre = false in
   let def_name =
-    ctx_get_local_function with_opaque_pre def.def_id def.loop_id def.back_id
-      ctx
+    ctx_get_local_function def.def_id def.loop_id def.back_id ctx
   in
   assert (def.signature.generics.const_generics = []);
   (* Add the type/const gen parameters - note that we need those bindings
@@ -4065,10 +4027,9 @@ let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter)
   extract_comment fmt [ "[" ^ Print.global_name_to_string global.name ^ "]" ];
   F.pp_print_space fmt ();
 
-  let with_opaque_pre = false in
-  let decl_name = ctx_get_global with_opaque_pre global.def_id ctx in
+  let decl_name = ctx_get_global global.def_id ctx in
   let body_name =
-    ctx_get_function with_opaque_pre
+    ctx_get_function
       (FromLlbc (Pure.FunId (Regular global.body_id), None, None))
       ctx
   in
@@ -4111,7 +4072,6 @@ let extract_trait_decl_register_parent_clause_names (ctx : extraction_ctx)
     (trait_decl : trait_decl)
     (builtin_info : ExtractBuiltin.builtin_trait_decl_info option) :
     extraction_ctx =
-  let is_opaque = false in
   let generics = trait_decl.generics in
   (* Compute the clause names *)
   let clause_names =
@@ -4135,7 +4095,7 @@ let extract_trait_decl_register_parent_clause_names (ctx : extraction_ctx)
   (* Register the names *)
   List.fold_left
     (fun ctx (cid, cname) ->
-      ctx_add is_opaque (TraitParentClauseId (trait_decl.def_id, cid)) cname ctx)
+      ctx_add (TraitParentClauseId (trait_decl.def_id, cid)) cname ctx)
     ctx clause_names
 
 (** Similar to {!extract_trait_decl_register_names} *)
@@ -4143,7 +4103,6 @@ let extract_trait_decl_register_constant_names (ctx : extraction_ctx)
     (trait_decl : trait_decl)
     (builtin_info : ExtractBuiltin.builtin_trait_decl_info option) :
     extraction_ctx =
-  let is_opaque = false in
   let consts = trait_decl.consts in
   (* Compute the names *)
   let constant_names =
@@ -4169,7 +4128,7 @@ let extract_trait_decl_register_constant_names (ctx : extraction_ctx)
   (* Register the names *)
   List.fold_left
     (fun ctx (item_name, name) ->
-      ctx_add is_opaque (TraitItemId (trait_decl.def_id, item_name)) name ctx)
+      ctx_add (TraitItemId (trait_decl.def_id, item_name)) name ctx)
     ctx constant_names
 
 (** Similar to {!extract_trait_decl_register_names} *)
@@ -4177,7 +4136,6 @@ let extract_trait_decl_type_names (ctx : extraction_ctx)
     (trait_decl : trait_decl)
     (builtin_info : ExtractBuiltin.builtin_trait_decl_info option) :
     extraction_ctx =
-  let is_opaque = false in
   let types = trait_decl.types in
   (* Compute the names *)
   let type_names =
@@ -4227,13 +4185,11 @@ let extract_trait_decl_type_names (ctx : extraction_ctx)
   List.fold_left
     (fun ctx (item_name, (type_name, clauses)) ->
       let ctx =
-        ctx_add is_opaque
-          (TraitItemId (trait_decl.def_id, item_name))
-          type_name ctx
+        ctx_add (TraitItemId (trait_decl.def_id, item_name)) type_name ctx
       in
       List.fold_left
         (fun ctx (clause_id, clause_name) ->
-          ctx_add is_opaque
+          ctx_add
             (TraitItemClauseId (trait_decl.def_id, item_name, clause_id))
             clause_name ctx)
         ctx clauses)
@@ -4244,7 +4200,6 @@ let extract_trait_decl_method_names (ctx : extraction_ctx)
     (trait_decl : trait_decl)
     (builtin_info : ExtractBuiltin.builtin_trait_decl_info option) :
     extraction_ctx =
-  let is_opaque = false in
   let required_methods = trait_decl.required_methods in
   (* Compute the names *)
   let method_names =
@@ -4305,7 +4260,7 @@ let extract_trait_decl_method_names (ctx : extraction_ctx)
       (* We add one field per required forward/backward function *)
       List.fold_left
         (fun ctx (rg, fun_name) ->
-          ctx_add is_opaque
+          ctx_add
             (TraitMethodId (trait_decl.def_id, item_name, rg))
             fun_name ctx)
         ctx funs)
@@ -4326,8 +4281,7 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
       | None -> ctx.fmt.trait_decl_name trait_decl
       | Some info -> info.extract_name
     in
-    let is_opaque = false in
-    ctx_add is_opaque (TraitDeclId trait_decl.def_id) trait_name ctx
+    ctx_add (TraitDeclId trait_decl.def_id) trait_name ctx
   in
   (* Parent clauses *)
   let ctx =
@@ -4369,8 +4323,7 @@ let extract_trait_impl_register_names (ctx : extraction_ctx)
     | None -> ctx.fmt.trait_impl_name trait_decl trait_impl
     | Some name -> name
   in
-  let is_opaque = false in
-  ctx_add is_opaque (TraitImplId trait_impl.def_id) name ctx
+  ctx_add (TraitImplId trait_impl.def_id) name ctx
 
 (** Small helper.
 
@@ -4446,8 +4399,7 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter)
 let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
     (decl : trait_decl) : unit =
   (* Retrieve the trait name *)
-  let with_opaque_pre = false in
-  let decl_name = ctx_get_trait_decl with_opaque_pre decl.def_id ctx in
+  let decl_name = ctx_get_trait_decl decl.def_id ctx in
   (* Add a break before *)
   F.pp_print_break fmt 0 0;
   (* Print a comment to link the extracted type to its original rust definition *)
@@ -4592,7 +4544,7 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter)
       if use_forall then F.pp_print_string fmt ",";
       (* Extract the function call *)
       F.pp_print_space fmt ();
-      let id = ctx_get_local_function false f.def_id None f.back_id ctx in
+      let id = ctx_get_local_function f.def_id None f.back_id ctx in
       F.pp_print_string fmt id;
       let all_generics =
         let i_tys, i_cgs, i_tcs = impl_generics in
@@ -4613,8 +4565,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
     (impl : trait_impl) : unit =
   log#ldebug (lazy ("extract_trait_impl: " ^ Names.name_to_string impl.name));
   (* Retrieve the impl name *)
-  let with_opaque_pre = false in
-  let impl_name = ctx_get_trait_impl with_opaque_pre impl.def_id ctx in
+  let impl_name = ctx_get_trait_impl impl.def_id ctx in
   (* Add a break before *)
   F.pp_print_break fmt 0 0;
   (* Print a comment to link the extracted type to its original rust definition *)
@@ -4690,7 +4641,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
       let item_name = ctx_get_trait_const trait_decl_id name ctx in
       let ty () =
         F.pp_print_space fmt ();
-        F.pp_print_string fmt (ctx_get_global false id ctx)
+        F.pp_print_string fmt (ctx_get_global id ctx)
       in
 
       extract_trait_impl_item ctx fmt item_name ty)
@@ -4776,12 +4727,8 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter)
         F.pp_print_string fmt "assert_norm";
         F.pp_print_space fmt ();
         F.pp_print_string fmt "(";
-        (* Note that if the function is opaque, the unit test will fail
-           because the normalizer will get stuck *)
-        let with_opaque_pre = ctx.use_opaque_pre in
         let fun_name =
-          ctx_get_local_function with_opaque_pre def.def_id def.loop_id
-            def.back_id ctx
+          ctx_get_local_function def.def_id def.loop_id def.back_id ctx
         in
         F.pp_print_string fmt fun_name;
         if sg.inputs <> [] then (
@@ -4796,12 +4743,8 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter)
         F.pp_print_string fmt "Check";
         F.pp_print_space fmt ();
         F.pp_print_string fmt "(";
-        (* Note that if the function is opaque, the unit test will fail
-           because the normalizer will get stuck *)
-        let with_opaque_pre = ctx.use_opaque_pre in
         let fun_name =
-          ctx_get_local_function with_opaque_pre def.def_id def.loop_id
-            def.back_id ctx
+          ctx_get_local_function def.def_id def.loop_id def.back_id ctx
         in
         F.pp_print_string fmt fun_name;
         if sg.inputs <> [] then (
@@ -4813,12 +4756,8 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter)
         F.pp_print_string fmt "#assert";
         F.pp_print_space fmt ();
         F.pp_print_string fmt "(";
-        (* Note that if the function is opaque, the unit test will fail
-           because the normalizer will get stuck *)
-        let with_opaque_pre = ctx.use_opaque_pre in
         let fun_name =
-          ctx_get_local_function with_opaque_pre def.def_id def.loop_id
-            def.back_id ctx
+          ctx_get_local_function def.def_id def.loop_id def.back_id ctx
         in
         F.pp_print_string fmt fun_name;
         if sg.inputs <> [] then (
@@ -4832,12 +4771,8 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter)
     | HOL4 ->
         F.pp_print_string fmt "val _ = assert_return (";
         F.pp_print_string fmt "“";
-        (* Note that if the function is opaque, the unit test will fail
-           because the normalizer will get stuck *)
-        let with_opaque_pre = ctx.use_opaque_pre in
         let fun_name =
-          ctx_get_local_function with_opaque_pre def.def_id def.loop_id
-            def.back_id ctx
+          ctx_get_local_function def.def_id def.loop_id def.back_id ctx
         in
         F.pp_print_string fmt fun_name;
         if sg.inputs <> [] then (
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 3ff299f2..f26beeb6 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -251,37 +251,6 @@ type formatter = {
   trait_type_name : trait_decl -> string -> string;
   trait_method_name : trait_decl -> string -> string;
   trait_type_clause_name : trait_decl -> string -> trait_clause -> string;
-  opaque_pre : unit -> string;
-      (** TODO: obsolete, remove.
-
-          The prefix to use for opaque definitions.
-
-          We need this because for some backends like Lean and Coq, we group
-          opaque definitions in module signatures, meaning that using those
-          definitions requires to prefix them with a module parameter name (such
-          as "opaque_defs.").
-
-          For instance, if we have an opaque function [f : int -> int], which
-          is used by the non-opaque function [g], we would generate (in Coq):
-          {[
-            (* The module signature declaring the opaque definitions *)
-            module type OpaqueDefs = {
-              f_fwd : int -> int
-              ... (* Other definitions *)
-            }
-
-            (* The definitions generated for the non-opaque definitions *)
-            module Funs (opaque: OpaqueDefs) = {
-              let g ... =
-                ...
-                opaque_defs.f_fwd
-                ...
-            }
-          ]}
-
-          Upon using [f] in [g], we don't directly use the the name "f_fwd",
-          but prefix it with the "opaque_defs." identifier.
-       *)
   var_basename : StringSet.t -> string option -> ty -> string;
       (** Generates a variable basename.
 
@@ -498,20 +467,6 @@ type names_map = {
           precisely which identifiers are mapped to the same name...
        *)
   names_set : StringSet.t;
-  opaque_ids : IdSet.t;
-      (** TODO: this is obsolete. Remove.
-
-          The set of opaque definitions.
-
-          See {!formatter.opaque_pre} for detailed explanations about why
-          we need to know which definitions are opaque to compute names.
-
-          Also note that the opaque ids don't contain the ids of the assumed
-          definitions. In practice, assumed definitions are opaque_defs. However, they
-          are not grouped in the opaque module, meaning we never need to
-          prefix them (with, say, "opaque_defs."): we thus consider them as non-opaque
-          with regards to the names map.
-       *)
 }
 
 let empty_names_map : names_map =
@@ -519,7 +474,6 @@ let empty_names_map : names_map =
     id_to_name = IdMap.empty;
     name_to_id = StringMap.empty;
     names_set = StringSet.empty;
-    opaque_ids = IdSet.empty;
   }
 
 (** Small helper to report name collision *)
@@ -547,8 +501,8 @@ let names_map_check_collision (id_to_string : id -> string) (id : id)
       (* There is a clash: print a nice debugging message for the user *)
       report_name_collision id_to_string clash id name
 
-let names_map_add (id_to_string : id -> string) (is_opaque : bool) (id : id)
-    (name : string) (nm : names_map) : names_map =
+let names_map_add (id_to_string : id -> string) (id : id) (name : string)
+    (nm : names_map) : names_map =
   (* Check if there is a clash *)
   names_map_check_collision id_to_string id name nm;
   (* Sanity check *)
@@ -564,32 +518,24 @@ let names_map_add (id_to_string : id -> string) (is_opaque : bool) (id : id)
   let id_to_name = IdMap.add id name nm.id_to_name in
   let name_to_id = StringMap.add name id nm.name_to_id in
   let names_set = StringSet.add name nm.names_set in
-  let opaque_ids =
-    if is_opaque then IdSet.add id nm.opaque_ids else nm.opaque_ids
-  in
-  { id_to_name; name_to_id; names_set; opaque_ids }
+  { id_to_name; name_to_id; names_set }
 
 let names_map_add_assumed_type (id_to_string : id -> string) (id : assumed_ty)
     (name : string) (nm : names_map) : names_map =
-  let is_opaque = false in
-  names_map_add id_to_string is_opaque (TypeId (Assumed id)) name nm
+  names_map_add id_to_string (TypeId (Assumed id)) name nm
 
 let names_map_add_assumed_struct (id_to_string : id -> string) (id : assumed_ty)
     (name : string) (nm : names_map) : names_map =
-  let is_opaque = false in
-  names_map_add id_to_string is_opaque (StructId (Assumed id)) name nm
+  names_map_add id_to_string (StructId (Assumed id)) name nm
 
 let names_map_add_assumed_variant (id_to_string : id -> string)
     (id : assumed_ty) (variant_id : VariantId.id) (name : string)
     (nm : names_map) : names_map =
-  let is_opaque = false in
-  names_map_add id_to_string is_opaque
-    (VariantId (Assumed id, variant_id))
-    name nm
+  names_map_add id_to_string (VariantId (Assumed id, variant_id)) name nm
 
-let names_map_add_function (id_to_string : id -> string) (is_opaque : bool)
-    (fid : fun_id) (name : string) (nm : names_map) : names_map =
-  names_map_add id_to_string is_opaque (FunId fid) name nm
+let names_map_add_function (id_to_string : id -> string) (fid : fun_id)
+    (name : string) (nm : names_map) : names_map =
+  names_map_add id_to_string (FunId fid) name nm
 
 (** The unsafe names map stores mappings from identifiers to names which might
     collide. For some backends and some names, it might be acceptable to have
@@ -667,14 +613,6 @@ type extraction_ctx = {
   fmt : formatter;
   indent_incr : int;
       (** The indent increment we insert whenever we need to indent more *)
-  use_opaque_pre : bool;
-      (** Do we use the "opaque_defs." prefix for the opaque definitions?
-
-          Opaque function definitions might refer opaque types: if we are in the
-          opaque module, we musn't use the "opaque_defs." prefix, otherwise we
-          use it.
-          Also see {!names_map.opaque_ids}.
-       *)
   use_dep_ite : bool;
       (** For Lean: do we use dependent-if then else expressions?
 
@@ -884,8 +822,7 @@ let allow_collisions (id : id) : bool =
       !Config.record_fields_short_names
   | _ -> false
 
-let ctx_add (is_opaque : bool) (id : id) (name : string) (ctx : extraction_ctx)
-    : extraction_ctx =
+let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx =
   (* The id_to_string function to print nice debugging messages if there are
    * collisions *)
   let id_to_string (id : id) : string = id_to_string id ctx in
@@ -902,7 +839,6 @@ let ctx_add (is_opaque : bool) (id : id) (name : string) (ctx : extraction_ctx)
      others (ex.: fields and keywords).
   *)
   if allow_collisions id then (
-    assert (not is_opaque);
     (* Check with the ids which are considered to be strict on collisions *)
     names_map_check_collision id_to_string id name ctx.strict_names_map;
     {
@@ -916,16 +852,13 @@ let ctx_add (is_opaque : bool) (id : id) (name : string) (ctx : extraction_ctx)
     *)
     let strict_names_map =
       if strict_collisions id then
-        names_map_add id_to_string is_opaque id name ctx.strict_names_map
+        names_map_add id_to_string id name ctx.strict_names_map
       else ctx.strict_names_map
     in
-    let names_map =
-      names_map_add id_to_string is_opaque id name ctx.names_map
-    in
+    let names_map = names_map_add id_to_string id name ctx.names_map in
     { ctx with strict_names_map; names_map }
 
-(** [with_opaque_pre]: if [true] and the definition is opaque, add the opaque prefix *)
-let ctx_get (with_opaque_pre : bool) (id : id) (ctx : extraction_ctx) : string =
+let ctx_get (id : id) (ctx : extraction_ctx) : string =
   (* We do not use the same name map if we allow/disallow collisions *)
   let map_to_string (m : string IdMap.t) : string =
     "[\n"
@@ -951,9 +884,7 @@ let ctx_get (with_opaque_pre : bool) (id : id) (ctx : extraction_ctx) : string =
   else
     let m = ctx.names_map.id_to_name in
     match IdMap.find_opt id m with
-    | Some s ->
-        let is_opaque = IdSet.mem id ctx.names_map.opaque_ids in
-        if with_opaque_pre && is_opaque then ctx.fmt.opaque_pre () ^ s else s
+    | Some s -> s
     | None ->
         let err =
           "Could not find: " ^ id_to_string id ctx ^ "\nNames map:\n"
@@ -963,53 +894,38 @@ let ctx_get (with_opaque_pre : bool) (id : id) (ctx : extraction_ctx) : string =
         if !Config.extract_fail_hard then raise (Failure err)
         else "(ERROR: \"" ^ id_to_string id ctx ^ "\")"
 
-let ctx_get_global (with_opaque_pre : bool) (id : A.GlobalDeclId.id)
-    (ctx : extraction_ctx) : string =
-  ctx_get with_opaque_pre (GlobalId id) ctx
+let ctx_get_global (id : A.GlobalDeclId.id) (ctx : extraction_ctx) : string =
+  ctx_get (GlobalId id) ctx
 
-let ctx_get_function (with_opaque_pre : bool) (id : fun_id)
-    (ctx : extraction_ctx) : string =
-  ctx_get with_opaque_pre (FunId id) ctx
+let ctx_get_function (id : fun_id) (ctx : extraction_ctx) : string =
+  ctx_get (FunId id) ctx
 
-let ctx_get_local_function (with_opaque_pre : bool) (id : A.FunDeclId.id)
-    (lp : LoopId.id option) (rg : RegionGroupId.id option)
-    (ctx : extraction_ctx) : string =
-  ctx_get_function with_opaque_pre (FromLlbc (FunId (Regular id), lp, rg)) ctx
+let ctx_get_local_function (id : A.FunDeclId.id) (lp : LoopId.id option)
+    (rg : RegionGroupId.id option) (ctx : extraction_ctx) : string =
+  ctx_get_function (FromLlbc (FunId (Regular id), lp, rg)) ctx
 
-let ctx_get_type (with_opaque_pre : bool) (id : type_id) (ctx : extraction_ctx)
-    : string =
+let ctx_get_type (id : type_id) (ctx : extraction_ctx) : string =
   assert (id <> Tuple);
-  ctx_get with_opaque_pre (TypeId id) ctx
+  ctx_get (TypeId id) ctx
 
-let ctx_get_local_type (with_opaque_pre : bool) (id : TypeDeclId.id)
-    (ctx : extraction_ctx) : string =
-  ctx_get_type with_opaque_pre (AdtId id) ctx
+let ctx_get_local_type (id : TypeDeclId.id) (ctx : extraction_ctx) : string =
+  ctx_get_type (AdtId id) ctx
 
 let ctx_get_assumed_type (id : assumed_ty) (ctx : extraction_ctx) : string =
-  (* In practice, the assumed types are opaque. However, assumed types
-     are never grouped in the opaque module, meaning we never need to
-     prefix them: we thus consider them as non-opaque with regards to the
-     names map.
-  *)
-  let is_opaque = false in
-  ctx_get_type is_opaque (Assumed id) ctx
+  ctx_get_type (Assumed id) ctx
 
 let ctx_get_trait_self_clause (ctx : extraction_ctx) : string =
-  let with_opaque_pre = false in
-  ctx_get with_opaque_pre TraitSelfClauseId ctx
+  ctx_get TraitSelfClauseId ctx
 
-let ctx_get_trait_decl (with_opaque_pre : bool) (id : trait_decl_id)
-    (ctx : extraction_ctx) : string =
-  ctx_get with_opaque_pre (TraitDeclId id) ctx
+let ctx_get_trait_decl (id : trait_decl_id) (ctx : extraction_ctx) : string =
+  ctx_get (TraitDeclId id) ctx
 
-let ctx_get_trait_impl (with_opaque_pre : bool) (id : trait_impl_id)
-    (ctx : extraction_ctx) : string =
-  ctx_get with_opaque_pre (TraitImplId id) ctx
+let ctx_get_trait_impl (id : trait_impl_id) (ctx : extraction_ctx) : string =
+  ctx_get (TraitImplId id) ctx
 
 let ctx_get_trait_item (id : trait_decl_id) (item_name : string)
     (ctx : extraction_ctx) : string =
-  let is_opaque = false in
-  ctx_get is_opaque (TraitItemId (id, item_name)) ctx
+  ctx_get (TraitItemId (id, item_name)) ctx
 
 let ctx_get_trait_const (id : trait_decl_id) (item_name : string)
     (ctx : extraction_ctx) : string =
@@ -1021,83 +937,69 @@ let ctx_get_trait_type (id : trait_decl_id) (item_name : string)
 
 let ctx_get_trait_method (id : trait_decl_id) (item_name : string)
     (rg_id : T.RegionGroupId.id option) (ctx : extraction_ctx) : string =
-  let with_opaque_pre = false in
-  ctx_get with_opaque_pre (TraitMethodId (id, item_name, rg_id)) ctx
+  ctx_get (TraitMethodId (id, item_name, rg_id)) ctx
 
 let ctx_get_trait_parent_clause (id : trait_decl_id) (clause : trait_clause_id)
     (ctx : extraction_ctx) : string =
-  let with_opaque_pre = false in
-  ctx_get with_opaque_pre (TraitParentClauseId (id, clause)) ctx
+  ctx_get (TraitParentClauseId (id, clause)) ctx
 
 let ctx_get_trait_item_clause (id : trait_decl_id) (item : string)
     (clause : trait_clause_id) (ctx : extraction_ctx) : string =
-  let with_opaque_pre = false in
-  ctx_get with_opaque_pre (TraitItemClauseId (id, item, clause)) ctx
+  ctx_get (TraitItemClauseId (id, item, clause)) ctx
 
 let ctx_get_var (id : VarId.id) (ctx : extraction_ctx) : string =
-  let is_opaque = false in
-  ctx_get is_opaque (VarId id) ctx
+  ctx_get (VarId id) ctx
 
 let ctx_get_type_var (id : TypeVarId.id) (ctx : extraction_ctx) : string =
-  let is_opaque = false in
-  ctx_get is_opaque (TypeVarId id) ctx
+  ctx_get (TypeVarId id) ctx
 
 let ctx_get_const_generic_var (id : ConstGenericVarId.id) (ctx : extraction_ctx)
     : string =
-  let is_opaque = false in
-  ctx_get is_opaque (ConstGenericVarId id) ctx
+  ctx_get (ConstGenericVarId id) ctx
 
 let ctx_get_local_trait_clause (id : TraitClauseId.id) (ctx : extraction_ctx) :
     string =
-  let is_opaque = false in
-  ctx_get is_opaque (LocalTraitClauseId id) ctx
+  ctx_get (LocalTraitClauseId id) ctx
 
 let ctx_get_field (type_id : type_id) (field_id : FieldId.id)
     (ctx : extraction_ctx) : string =
-  let is_opaque = false in
-  ctx_get is_opaque (FieldId (type_id, field_id)) ctx
+  ctx_get (FieldId (type_id, field_id)) ctx
 
-let ctx_get_struct (with_opaque_pre : bool) (def_id : type_id)
-    (ctx : extraction_ctx) : string =
-  ctx_get with_opaque_pre (StructId def_id) ctx
+let ctx_get_struct (def_id : type_id) (ctx : extraction_ctx) : string =
+  ctx_get (StructId def_id) ctx
 
 let ctx_get_variant (def_id : type_id) (variant_id : VariantId.id)
     (ctx : extraction_ctx) : string =
-  let is_opaque = false in
-  ctx_get is_opaque (VariantId (def_id, variant_id)) ctx
+  ctx_get (VariantId (def_id, variant_id)) ctx
 
 let ctx_get_decreases_proof (def_id : A.FunDeclId.id)
     (loop_id : LoopId.id option) (ctx : extraction_ctx) : string =
-  let is_opaque = false in
-  ctx_get is_opaque (DecreasesProofId (Regular def_id, loop_id)) ctx
+  ctx_get (DecreasesProofId (Regular def_id, loop_id)) ctx
 
 let ctx_get_termination_measure (def_id : A.FunDeclId.id)
     (loop_id : LoopId.id option) (ctx : extraction_ctx) : string =
-  let is_opaque = false in
-  ctx_get is_opaque (TerminationMeasureId (Regular def_id, loop_id)) ctx
+  ctx_get (TerminationMeasureId (Regular def_id, loop_id)) ctx
 
 (** Generate a unique type variable name and add it to the context *)
 let ctx_add_type_var (basename : string) (id : TypeVarId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
-  let is_opaque = false in
   let name = ctx.fmt.type_var_basename ctx.names_map.names_set basename in
   let name =
     basename_to_unique ctx.names_map.names_set ctx.fmt.append_index name
   in
-  let ctx = ctx_add is_opaque (TypeVarId id) name ctx in
+  let ctx = ctx_add (TypeVarId id) name ctx in
   (ctx, name)
 
 (** Generate a unique const generic variable name and add it to the context *)
 let ctx_add_const_generic_var (basename : string) (id : ConstGenericVarId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
-  let is_opaque = false in
   let name =
     ctx.fmt.const_generic_var_basename ctx.names_map.names_set basename
   in
   let name =
     basename_to_unique ctx.names_map.names_set ctx.fmt.append_index name
   in
-  let ctx = ctx_add is_opaque (ConstGenericVarId id) name ctx in
+  let ctx = ctx_add (ConstGenericVarId id) name ctx in
   (ctx, name)
 
 (** See {!ctx_add_type_var} *)
@@ -1110,31 +1012,28 @@ let ctx_add_type_vars (vars : (string * TypeVarId.id) list)
 (** Generate a unique variable name and add it to the context *)
 let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) :
     extraction_ctx * string =
-  let is_opaque = false in
   let name =
     basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename
   in
-  let ctx = ctx_add is_opaque (VarId id) name ctx in
+  let ctx = ctx_add (VarId id) name ctx in
   (ctx, name)
 
 (** Generate a unique variable name for the trait self clause and add it to the context *)
 let ctx_add_trait_self_clause (ctx : extraction_ctx) : extraction_ctx * string =
-  let is_opaque = false in
   let basename = ctx.fmt.trait_self_clause_basename in
   let name =
     basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename
   in
-  let ctx = ctx_add is_opaque TraitSelfClauseId name ctx in
+  let ctx = ctx_add TraitSelfClauseId name ctx in
   (ctx, name)
 
 (** Generate a unique trait clause name and add it to the context *)
 let ctx_add_local_trait_clause (basename : string) (id : TraitClauseId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
-  let is_opaque = false in
   let name =
     basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename
   in
-  let ctx = ctx_add is_opaque (LocalTraitClauseId id) name ctx in
+  let ctx = ctx_add (LocalTraitClauseId id) name ctx in
   (ctx, name)
 
 (** See {!ctx_add_var} *)
@@ -1182,30 +1081,23 @@ let ctx_add_generic_params (generics : generic_params) (ctx : extraction_ctx) :
 
 let ctx_add_decreases_proof (def : fun_decl) (ctx : extraction_ctx) :
     extraction_ctx =
-  let is_opaque = false in
   let name =
     ctx.fmt.decreases_proof_name def.def_id def.basename def.num_loops
       def.loop_id
   in
-  ctx_add is_opaque
-    (DecreasesProofId (Regular def.def_id, def.loop_id))
-    name ctx
+  ctx_add (DecreasesProofId (Regular def.def_id, def.loop_id)) name ctx
 
 let ctx_add_termination_measure (def : fun_decl) (ctx : extraction_ctx) :
     extraction_ctx =
-  let is_opaque = false in
   let name =
     ctx.fmt.termination_measure_name def.def_id def.basename def.num_loops
       def.loop_id
   in
-  ctx_add is_opaque
-    (TerminationMeasureId (Regular def.def_id, def.loop_id))
-    name ctx
+  ctx_add (TerminationMeasureId (Regular def.def_id, def.loop_id)) name ctx
 
 let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
     extraction_ctx =
   (* TODO: update once the body id can be an option *)
-  let is_opaque = false in
   let decl = GlobalId def.def_id in
 
   (* Check if the global corresponds to an assumed global that we should map
@@ -1215,13 +1107,13 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
   match SimpleNameMap.find_opt sname builtin_globals_map with
   | Some name ->
       (* Yes: register the custom binding *)
-      ctx_add is_opaque decl name ctx
+      ctx_add decl name ctx
   | None ->
       (* Not the case: "standard" registration *)
       let name = ctx.fmt.global_name def.name in
       let body = FunId (FromLlbc (FunId (Regular def.body_id), None, None)) in
-      let ctx = ctx_add is_opaque decl (name ^ "_c") ctx in
-      let ctx = ctx_add is_opaque body (name ^ "_body") ctx in
+      let ctx = ctx_add decl (name ^ "_c") ctx in
+      let ctx = ctx_add body (name ^ "_body") ctx in
       ctx
 
 let ctx_compute_fun_name (trans_group : pure_fun_translation) (def : fun_decl)
@@ -1259,11 +1151,10 @@ let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
   let def_id = def.def_id in
   let { keep_fwd; fwd = _; backs } = trans_group in
   let num_backs = List.length backs in
-  let is_opaque = def.body = None in
   (* Add the function name *)
   let def_name = ctx_compute_fun_name trans_group def ctx in
   let fun_id = (Pure.FunId (Regular def_id), def.loop_id, def.back_id) in
-  let ctx = ctx_add is_opaque (FunId (FromLlbc fun_id)) def_name ctx in
+  let ctx = ctx_add (FunId (FromLlbc fun_id)) def_name ctx in
   (* Add the name info *)
   {
     ctx with
@@ -1296,12 +1187,11 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map =
   let name_to_id =
     StringMap.of_list (List.map (fun x -> (x, UnknownId)) keywords)
   in
-  let opaque_ids = IdSet.empty in
   (* We fist initialize [id_to_name] as empty, because the id of a keyword is [UnknownId].
    * Also note that we don't need this mapping for keywords: we insert keywords only
    * to check collisions. *)
   let id_to_name = IdMap.empty in
-  let nm = { id_to_name; name_to_id; names_set; opaque_ids } in
+  let nm = { id_to_name; name_to_id; names_set } in
   (* For debugging - we are creating bindings for assumed types and functions, so
    * it is ok if we simply use the "show" function (those aren't simply identified
    * by numbers) *)
@@ -1338,15 +1228,8 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map =
     @ List.map (fun (fid, name) -> (Pure fid, name)) init.assumed_pure_functions
   in
   let nm =
-    (* In practice, the assumed function are opaque. However, assumed functions
-       are never grouped in the opaque module, meaning we never need to
-       prefix them: we thus consider them as non-opaque with regards to the
-       names map.
-    *)
-    let is_opaque = false in
     List.fold_left
-      (fun nm (fid, name) ->
-        names_map_add_function id_to_string is_opaque fid name nm)
+      (fun nm (fid, name) -> names_map_add_function id_to_string fid name nm)
       nm assumed_functions
   in
   (* Return *)
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 74a8537f..b3269aa2 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -851,37 +851,10 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
   if config.extract_state_type && config.extract_fun_decls then
     export_state_type ();
 
-  (* Obsolete: (TODO: remove) For Lean we parameterize the entire development by a section
-     variable called opaque_defs, of type OpaqueDefs. The code below emits the type
-     definition for OpaqueDefs, which is a structure, in which each field is one of the
-     functions marked as Opaque. We emit the `structure ...` bit here, then rely on
-     `extract_fun_decl` to be aware of this, and skip the keyword (e.g. "axiom" or "val")
-     so as to generate valid syntax for records.
-
-     We also generate such a structure only if there actually are opaque definitions. *)
-  let wrap_in_sig =
-    config.extract_opaque && config.extract_fun_decls
-    && !Config.wrap_opaque_in_sig
-    &&
-    let _, opaque_funs = crate_has_opaque_decls ctx true in
-    opaque_funs
-  in
-  if wrap_in_sig then (
-    (* We change the name of the structure depending on whether we *only*
-       extract opaque definitions, or if we extract all definitions *)
-    let struct_name =
-      if config.extract_transparent then "Definitions" else "OpaqueDefs"
-    in
-    Format.pp_print_break fmt 0 0;
-    Format.pp_open_vbox fmt ctx.indent_incr;
-    Format.pp_print_string fmt ("structure " ^ struct_name ^ " where");
-    Format.pp_print_break fmt 0 0);
   List.iter export_decl_group ctx.crate.declarations;
 
   if config.extract_state_type && not config.extract_fun_decls then
-    export_state_type ();
-
-  if wrap_in_sig then Format.pp_close_box fmt ()
+    export_state_type ()
 
 type extract_file_info = {
   filename : string;
@@ -1029,10 +1002,9 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
         (fun (id, _) -> strict_collisions id)
         (IdMap.bindings names_map.id_to_name)
     in
-    let is_opaque = false in
     List.fold_left
       (* id_to_string: we shouldn't need to use it *)
-        (fun m (id, n) -> names_map_add show_id is_opaque id n m)
+        (fun m (id, n) -> names_map_add show_id id n m)
       empty_names_map ids
   in
 
@@ -1093,7 +1065,6 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       strict_names_map;
       fmt;
       indent_incr = 2;
-      use_opaque_pre = !Config.split_files;
       use_dep_ite = !Config.backend = Lean && !Config.extract_decreases_clauses;
       fun_name_info = PureUtils.RegularFunIdMap.empty;
       trait_decl_id = None (* None by default *);
@@ -1389,7 +1360,6 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
              interface = true;
            }
          in
-         let ctx = { ctx with use_opaque_pre = false } in
          let file_info =
            {
              filename = opaque_filename;
-- 
cgit v1.3.1


From 9ddd174959970f87658191034b70d0cfa02ff451 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 24 Oct 2023 15:49:54 +0200
Subject: Filter some type arguments for the builtin types/functions

---
 compiler/Extract.ml        | 67 ++++++++++++++++++++++++++++++++++++++++++++--
 compiler/ExtractBase.ml    | 13 +++++++++
 compiler/ExtractBuiltin.ml | 15 +++++------
 compiler/Translate.ml      |  2 ++
 4 files changed, 87 insertions(+), 10 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 275cb3b9..bf90a411 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -1175,6 +1175,26 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
               (* TODO: for now, only the opaque *functions* are extracted in the
                  opaque module. The opaque *types* are assumed. *)
               F.pp_print_string fmt (ctx_get_type type_id ctx);
+              (* We might need to filter the type arguments, if the type
+                 is builtin (for instance, we filter the global allocator type
+                 argument for `Vec`). *)
+              let generics =
+                match type_id with
+                | AdtId id -> (
+                    match
+                      TypeDeclId.Map.find_opt id ctx.types_filter_type_args_map
+                    with
+                    | None -> generics
+                    | Some filter ->
+                        let types = List.combine filter generics.types in
+                        let types =
+                          List.filter_map
+                            (fun (b, ty) -> if b then Some ty else None)
+                            types
+                        in
+                        { generics with types })
+                | _ -> generics
+              in
               extract_generic_args ctx fmt no_params_tys generics;
               if print_paren then F.pp_print_string fmt ")"
           | HOL4 ->
@@ -1335,6 +1355,17 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
   let open ExtractBuiltin in
   let sname = name_to_simple_name def.name in
   let info = SimpleNameMap.find_opt sname (builtin_types_map ()) in
+  (* Register the filtering information, if there is *)
+  let ctx =
+    match info with
+    | Some { keep_params = Some keep; _ } ->
+        {
+          ctx with
+          types_filter_type_args_map =
+            TypeDeclId.Map.add def.def_id keep ctx.types_filter_type_args_map;
+        }
+    | _ -> ctx
+  in
   (* Compute and register the type def name *)
   let def_name =
     match info with
@@ -2361,7 +2392,19 @@ let extract_fun_decl_register_names (ctx : extraction_ctx)
       in
       (* Use the builtin names if necessary *)
       match builtin with
-      | Some (_filter, info) ->
+      | Some (filter_info, info) ->
+          (* Register the filtering information, if there is *)
+          let ctx =
+            match filter_info with
+            | Some keep ->
+                {
+                  ctx with
+                  funs_filter_type_args_map =
+                    FunDeclId.Map.add def.fwd.f.def_id keep
+                      ctx.funs_filter_type_args_map;
+                }
+            | _ -> ctx
+          in
           let backs = List.map (fun f -> f.f) def.backs in
           let funs = if def.keep_fwd then def.fwd.f :: backs else backs in
           List.fold_left
@@ -2734,7 +2777,27 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
 
       (* Sanity check: HOL4 doesn't support const generics *)
       assert (generics.const_generics = [] || !backend <> HOL4);
-      (* Print the generics *)
+      (* Print the generics.
+
+         We might need to filter some of the type arguments, if the type
+         is builtin (for instance, we filter the global allocator type
+         argument for `Vec::new`).
+      *)
+      let generics =
+        match fun_id with
+        | FromLlbc (FunId (Regular id), _, _) -> (
+            match FunDeclId.Map.find_opt id ctx.funs_filter_type_args_map with
+            | None -> generics
+            | Some filter ->
+                let types = List.combine filter generics.types in
+                let types =
+                  List.filter_map
+                    (fun (b, ty) -> if b then Some ty else None)
+                    types
+                in
+                { generics with types })
+        | _ -> generics
+      in
       extract_generic_args ctx fmt TypeDeclId.Set.empty generics;
       (* Print the arguments *)
       List.iter
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index f26beeb6..e004aba8 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -640,6 +640,19 @@ type extraction_ctx = {
   functions_with_decreases_clause : PureUtils.FunLoopIdSet.t;
   trans_trait_decls : Pure.trait_decl Pure.TraitDeclId.Map.t;
   trans_trait_impls : Pure.trait_impl Pure.TraitImplId.Map.t;
+  types_filter_type_args_map : bool list TypeDeclId.Map.t;
+      (** The map to filter the type arguments for the builtin type
+          definitions.
+
+          We need this for type `Vec`, for instance, which takes a useless
+          (in the context of the type translation) type argument for the
+          allocator which is used, and which we want to remove.
+
+          TODO: it would be cleaner to filter those types in a micro-pass,
+          rather than at code generation time.
+        *)
+  funs_filter_type_args_map : bool list FunDeclId.Map.t;
+      (** Same as {!types_filter_type_args_map}, but for functions *)
 }
 
 (** Debugging function, used when communicating name collisions to the user,
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index d3cea54e..65c18efd 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -203,9 +203,8 @@ type builtin_fun_info = {
 let builtin_funs () :
     (string list * bool list option * builtin_fun_info list) list =
   let rg0 = Some Types.RegionGroupId.zero in
-  (* TODO: fix the names below *)
   [
-    ( [ "core::mem::replace" ],
+    ( [ "core"; "mem"; "replace" ],
       None,
       [
         {
@@ -223,7 +222,7 @@ let builtin_funs () :
             | Lean -> "mem.replace_back");
         };
       ] );
-    ( [ "alloc::vec::Vec::new" ],
+    ( [ "alloc"; "vec"; "Vec"; "new" ],
       Some [ true; false ],
       [
         {
@@ -241,7 +240,7 @@ let builtin_funs () :
             | Lean -> "Vec.new_back");
         };
       ] );
-    ( [ "alloc::vec::Vec::push" ],
+    ( [ "alloc"; "vec"; "Vec"; "push" ],
       Some [ true; false ],
       [
         (* The forward function shouldn't be used *)
@@ -260,7 +259,7 @@ let builtin_funs () :
             | Lean -> "Vec.push");
         };
       ] );
-    ( [ "alloc::vec::Vec::insert" ],
+    ( [ "alloc"; "vec"; "Vec"; "insert" ],
       Some [ true; false ],
       [
         (* The forward function shouldn't be used *)
@@ -279,7 +278,7 @@ let builtin_funs () :
             | Lean -> "Vec.insert");
         };
       ] );
-    ( [ "alloc::vec::Vec::len" ],
+    ( [ "alloc"; "vec"; "Vec"; "len" ],
       Some [ true; false ],
       [
         {
@@ -290,7 +289,7 @@ let builtin_funs () :
             | Lean -> "Vec.len");
         };
       ] );
-    ( [ "alloc::vec::Vec::index" ],
+    ( [ "alloc"; "vec"; "Vec"; "index" ],
       Some [ true; false ],
       [
         {
@@ -309,7 +308,7 @@ let builtin_funs () :
             | Lean -> "Vec.index_shared_back");
         };
       ] );
-    ( [ "alloc::vec::Vec::index_mut" ],
+    ( [ "alloc"; "vec"; "Vec"; "index_mut" ],
       Some [ true; false ],
       [
         {
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index b3269aa2..35dff9e6 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -1074,6 +1074,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       trans_types;
       trans_funs;
       functions_with_decreases_clause = rec_functions;
+      types_filter_type_args_map = Pure.TypeDeclId.Map.empty;
+      funs_filter_type_args_map = Pure.FunDeclId.Map.empty;
     }
   in
 
-- 
cgit v1.3.1


From e3cb3646bbe3d50240aa0bf4763f8e816fb9a706 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Wed, 25 Oct 2023 15:36:06 +0200
Subject: Fix some issues at extraction and add builtins

---
 backends/lean/Base/Primitives.lean              |   4 +-
 backends/lean/Base/Primitives/Alloc.lean        |   2 +-
 backends/lean/Base/Primitives/Array.lean        | 403 -----------------
 backends/lean/Base/Primitives/ArraySlice.lean   | 560 ++++++++++++++++++++++++
 backends/lean/Base/Primitives/Base.lean         |   7 +
 backends/lean/Base/Primitives/CoreOps.lean      |  37 ++
 backends/lean/Base/Primitives/CoreOpsDeref.lean |  18 -
 backends/lean/Base/Primitives/Vec.lean          |   2 +-
 compiler/Extract.ml                             |  45 +-
 compiler/ExtractBuiltin.ml                      | 304 ++++++++++++-
 compiler/LlbcAstUtils.ml                        |  19 +-
 compiler/Translate.ml                           |  10 +-
 12 files changed, 948 insertions(+), 463 deletions(-)
 delete mode 100644 backends/lean/Base/Primitives/Array.lean
 create mode 100644 backends/lean/Base/Primitives/ArraySlice.lean
 create mode 100644 backends/lean/Base/Primitives/CoreOps.lean
 delete mode 100644 backends/lean/Base/Primitives/CoreOpsDeref.lean

(limited to 'compiler/Translate.ml')

diff --git a/backends/lean/Base/Primitives.lean b/backends/lean/Base/Primitives.lean
index 22378af7..613b6076 100644
--- a/backends/lean/Base/Primitives.lean
+++ b/backends/lean/Base/Primitives.lean
@@ -1,6 +1,6 @@
 import Base.Primitives.Base
 import Base.Primitives.Scalar
-import Base.Primitives.Array
+import Base.Primitives.ArraySlice
 import Base.Primitives.Vec
 import Base.Primitives.Alloc
-import Base.Primitives.CoreOpsDeref
+import Base.Primitives.CoreOps
diff --git a/backends/lean/Base/Primitives/Alloc.lean b/backends/lean/Base/Primitives/Alloc.lean
index 0580421f..34590499 100644
--- a/backends/lean/Base/Primitives/Alloc.lean
+++ b/backends/lean/Base/Primitives/Alloc.lean
@@ -1,6 +1,6 @@
 import Lean
 import Base.Primitives.Base
-import Base.Primitives.CoreOpsDeref
+import Base.Primitives.CoreOps
 
 open Primitives
 open Result
diff --git a/backends/lean/Base/Primitives/Array.lean b/backends/lean/Base/Primitives/Array.lean
deleted file mode 100644
index 49c84bee..00000000
--- a/backends/lean/Base/Primitives/Array.lean
+++ /dev/null
@@ -1,403 +0,0 @@
-/- Arrays/slices -/
-import Lean
-import Lean.Meta.Tactic.Simp
-import Init.Data.List.Basic
-import Mathlib.Tactic.RunCmd
-import Mathlib.Tactic.Linarith
-import Base.IList
-import Base.Primitives.Scalar
-import Base.Primitives.Range
-import Base.Arith
-import Base.Progress.Base
-
-namespace Primitives
-
-open Result Error
-
-def Array (α : Type u) (n : Usize) := { l : List α // l.length = n.val }
-
-instance (a : Type u) (n : Usize) : Arith.HasIntProp (Array a n) where
-  prop_ty := λ v => v.val.len = n.val
-  prop := λ ⟨ _, l ⟩ => by simp[Scalar.max, List.len_eq_length, *]
-
-instance {α : Type u} {n : Usize} (p : Array α n → Prop) : Arith.HasIntProp (Subtype p) where
-  prop_ty := λ x => p x
-  prop := λ x => x.property
-
-@[simp]
-abbrev Array.length {α : Type u} {n : Usize} (v : Array α n) : Int := v.val.len
-
-@[simp]
-abbrev Array.v {α : Type u} {n : Usize} (v : Array α n) : List α := v.val
-
-example {α: Type u} {n : Usize} (v : Array α n) : v.length ≤ Scalar.max ScalarTy.Usize := by
-  scalar_tac
-
-def Array.make (α : Type u) (n : Usize) (init : List α) (hl : init.len = n.val := by decide) :
-  Array α n := ⟨ init, by simp [← List.len_eq_length]; apply hl ⟩
-
-example : Array Int (Usize.ofInt 2) := Array.make Int (Usize.ofInt 2) [0, 1]
-
-@[simp]
-abbrev Array.index {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i : Int) : α :=
-  v.val.index i
-
-@[simp]
-abbrev Array.slice {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i j : Int) : List α :=
-  v.val.slice i j
-
-def Array.index_shared (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some x => ret x
-
--- For initialization
-def Array.repeat (α : Type u) (n : Usize) (x : α) : Array α n :=
-  ⟨ List.ireplicate n.val x, by have h := n.hmin; simp_all [Scalar.min] ⟩
-
-@[pspec]
-theorem Array.repeat_spec {α : Type u} (n : Usize) (x : α) :
-  ∃ a, Array.repeat α n x = a ∧ a.val = List.ireplicate n.val x := by
-  simp [Array.repeat]
-
-/- In the theorems below: we don't always need the `∃ ..`, but we use one
-   so that `progress` introduces an opaque variable and an equality. This
-   helps control the context.
- -/
-
-@[pspec]
-theorem Array.index_shared_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize)
-  (hbound : i.val < v.length) :
-  ∃ x, v.index_shared α n i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_shared]
-  -- TODO: dependent rewrite
-  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
-  simp [*]
-
--- This shouldn't be used
-def Array.index_shared_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (_: α) : Result Unit :=
-  if i.val < List.length v.val then
-    .ret ()
-  else
-    .fail arrayOutOfBounds
-
-def Array.index_mut (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some x => ret x
-
-@[pspec]
-theorem Array.index_mut_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize)
-  (hbound : i.val < v.length) :
-  ∃ x, v.index_mut α n i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_mut]
-  -- TODO: dependent rewrite
-  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
-  simp [*]
-
-def Array.index_mut_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: α) : Result (Array α n) :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some _ =>
-    .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩
-
-@[pspec]
-theorem Array.index_mut_back_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α)
-  (hbound : i.val < v.length) :
-  ∃ nv, v.index_mut_back α n i x = ret nv ∧
-  nv.val = v.val.update i.val x
-  := by
-  simp only [index_mut_back]
-  have h := List.indexOpt_bounds v.val i.val
-  split
-  . simp_all [length]; cases h <;> scalar_tac
-  . simp_all
-
-def Slice (α : Type u) := { l : List α // l.length ≤ Usize.max }
-
-instance (a : Type u) : Arith.HasIntProp (Slice a) where
-  prop_ty := λ v => 0 ≤ v.val.len ∧ v.val.len ≤ Scalar.max ScalarTy.Usize
-  prop := λ ⟨ _, l ⟩ => by simp[Scalar.max, List.len_eq_length, *]
-
-instance {α : Type u} (p : Slice α → Prop) : Arith.HasIntProp (Subtype p) where
-  prop_ty := λ x => p x
-  prop := λ x => x.property
-
-@[simp]
-abbrev Slice.length {α : Type u} (v : Slice α) : Int := v.val.len
-
-@[simp]
-abbrev Slice.v {α : Type u} (v : Slice α) : List α := v.val
-
-example {a: Type u} (v : Slice a) : v.length ≤ Scalar.max ScalarTy.Usize := by
-  scalar_tac
-
-def Slice.new (α : Type u): Slice α := ⟨ [], by apply Scalar.cMax_suffices .Usize; simp ⟩
-
--- TODO: very annoying that the α is an explicit parameter
-def Slice.len (α : Type u) (v : Slice α) : Usize :=
-  Usize.ofIntCore v.val.len (by scalar_tac) (by scalar_tac)
-
-@[simp]
-theorem Slice.len_val {α : Type u} (v : Slice α) : (Slice.len α v).val = v.length :=
-  by rfl
-
-@[simp]
-abbrev Slice.index {α : Type u} [Inhabited α] (v: Slice α) (i: Int) : α :=
-  v.val.index i
-
-@[simp]
-abbrev Slice.slice {α : Type u} [Inhabited α] (s : Slice α) (i j : Int) : List α :=
-  s.val.slice i j
-
-def Slice.index_shared (α : Type u) (v: Slice α) (i: Usize) : Result α :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some x => ret x
-
-/- In the theorems below: we don't always need the `∃ ..`, but we use one
-   so that `progress` introduces an opaque variable and an equality. This
-   helps control the context.
- -/
-
-@[pspec]
-theorem Slice.index_shared_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize)
-  (hbound : i.val < v.length) :
-  ∃ x, v.index_shared α i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_shared]
-  -- TODO: dependent rewrite
-  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
-  simp [*]
-
--- This shouldn't be used
-def Slice.index_shared_back (α : Type u) (v: Slice α) (i: Usize) (_: α) : Result Unit :=
-  if i.val < List.length v.val then
-    .ret ()
-  else
-    .fail arrayOutOfBounds
-
-def Slice.index_mut (α : Type u) (v: Slice α) (i: Usize) : Result α :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some x => ret x
-
-@[pspec]
-theorem Slice.index_mut_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize)
-  (hbound : i.val < v.length) :
-  ∃ x, v.index_mut α i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_mut]
-  -- TODO: dependent rewrite
-  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
-  simp [*]
-
-def Slice.index_mut_back (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some _ =>
-    .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩
-
-@[pspec]
-theorem Slice.index_mut_back_spec {α : Type u} (v: Slice α) (i: Usize) (x : α)
-  (hbound : i.val < v.length) :
-  ∃ nv, v.index_mut_back α i x = ret nv ∧
-  nv.val = v.val.update i.val x
-  := by
-  simp only [index_mut_back]
-  have h := List.indexOpt_bounds v.val i.val
-  split
-  . simp_all [length]; cases h <;> scalar_tac
-  . simp_all
-
-/- Array to slice/subslices -/
-
-/- We could make this function not use the `Result` type. By making it monadic, we
-   push the user to use the `Array.to_slice_shared_spec` spec theorem below (through the
-   `progress` tactic), meaning `Array.to_slice_shared` should be considered as opaque.
-   All what the spec theorem reveals is that the "representative" lists are the same. -/
-def Array.to_slice_shared (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) :=
-  ret ⟨ v.val, by simp [← List.len_eq_length]; scalar_tac ⟩
-
-@[pspec]
-theorem Array.to_slice_shared_spec {α : Type u} {n : Usize} (v : Array α n) :
-  ∃ s, to_slice_shared α n v = ret s ∧ v.val = s.val := by simp [to_slice_shared]
-
-def Array.to_slice_mut (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) :=
-  to_slice_shared α n v
-
-@[pspec]
-theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) :
-  ∃ s, Array.to_slice_shared α n v = ret s ∧ v.val = s.val := to_slice_shared_spec v
-
-def Array.to_slice_mut_back (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) :=
-  if h: s.val.len = n.val then
-    ret ⟨ s.val, by simp [← List.len_eq_length, *] ⟩
-  else fail panic
-
-@[pspec]
-theorem Array.to_slice_mut_back_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) :
-  ∃ na, to_slice_mut_back α n a ns = ret na ∧ na.val = ns.val
-  := by simp [to_slice_mut_back, *]
-
-def Array.subslice_shared (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) :=
-  -- TODO: not completely sure here
-  if r.start.val < r.end_.val ∧ r.end_.val ≤ a.val.len then
-    ret ⟨ a.val.slice r.start.val r.end_.val,
-          by
-            simp [← List.len_eq_length]
-            have := a.val.slice_len_le r.start.val r.end_.val
-            scalar_tac ⟩
-  else
-    fail panic
-
-@[pspec]
-theorem Array.subslice_shared_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize)
-  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) :
-  ∃ s, subslice_shared α n a r = ret s ∧
-  s.val = a.val.slice r.start.val r.end_.val ∧
-  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i))
-  := by
-  simp [subslice_shared, *]
-  intro i _ _
-  have := List.index_slice r.start.val r.end_.val i a.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac)
-  simp [*]
-
-def Array.subslice_mut (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) :=
-  Array.subslice_shared α n a r
-
-@[pspec]
-theorem Array.subslice_mut_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize)
-  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) :
-  ∃ s, subslice_mut α n a r = ret s ∧
-  s.val = a.slice r.start.val r.end_.val ∧
-  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i))
-  := subslice_shared_spec a r h0 h1
-
-def Array.subslice_mut_back (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) (s : Slice α) : Result (Array α n) :=
-  -- TODO: not completely sure here
-  if h: r.start.val < r.end_.val ∧ r.end_.val ≤ a.length ∧ s.val.len = r.end_.val - r.start.val then
-    let s_beg := a.val.itake r.start.val
-    let s_end := a.val.idrop r.end_.val
-    have : s_beg.len = r.start.val := by
-      apply List.itake_len
-      . simp_all; scalar_tac
-      . scalar_tac
-    have : s_end.len = a.val.len - r.end_.val := by
-      apply List.idrop_len
-      . scalar_tac
-      . scalar_tac
-    let na := s_beg.append (s.val.append s_end)
-    have : na.len = a.val.len := by simp [*]
-    ret ⟨ na, by simp_all [← List.len_eq_length]; scalar_tac ⟩
-  else
-    fail panic
-
--- TODO: it is annoying to write `.val` everywhere. We could leverage coercions,
--- but: some symbols like `+` are already overloaded to be notations for monadic
--- operations/
--- We should introduce special symbols for the monadic arithmetic operations
--- (the use will never write those symbols directly).
-@[pspec]
-theorem Array.subslice_mut_back_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α)
-  (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : s.length = r.end_.val - r.start.val) :
-  ∃ na, subslice_mut_back α n a r s = ret na ∧
-  (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧
-  (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = s.index (i - r.start.val)) ∧
-  (∀ i, r.end_.val ≤ i → i < n.val → na.index i = a.index i) := by
-  simp [subslice_mut_back, *]
-  have h := List.replace_slice_index r.start.val r.end_.val a.val s.val
-    (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac)
-  simp [List.replace_slice] at h
-  have ⟨ h0, h1, h2 ⟩ := h
-  clear h
-  split_conjs
-  . intro i _ _
-    have := h0 i (by int_tac) (by int_tac)
-    simp [*]
-  . intro i _ _
-    have := h1 i (by int_tac) (by int_tac)
-    simp [*]
-  . intro i _ _
-    have := h2 i (by int_tac) (by int_tac)
-    simp [*]
-
-def Slice.subslice_shared (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) :=
-  -- TODO: not completely sure here
-  if r.start.val < r.end_.val ∧ r.end_.val ≤ s.length then
-    ret ⟨ s.val.slice r.start.val r.end_.val,
-          by
-            simp [← List.len_eq_length]
-            have := s.val.slice_len_le r.start.val r.end_.val
-            scalar_tac ⟩
-  else
-    fail panic
-
-@[pspec]
-theorem Slice.subslice_shared_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize)
-  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) :
-  ∃ ns, subslice_shared α s r = ret ns ∧
-  ns.val = s.slice r.start.val r.end_.val ∧
-  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i))
-  := by
-  simp [subslice_shared, *]
-  intro i _ _
-  have := List.index_slice r.start.val r.end_.val i s.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac)
-  simp [*]
-
-def Slice.subslice_mut (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) :=
-  Slice.subslice_shared α s r
-
-@[pspec]
-theorem Slice.subslice_mut_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize)
-  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) :
-  ∃ ns, subslice_mut α s r = ret ns ∧
-  ns.val = s.slice r.start.val r.end_.val ∧
-  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i))
-  := subslice_shared_spec s r h0 h1
-
-attribute [pp_dot] List.len List.length List.index -- use the dot notation when printing
-set_option pp.coercions false -- do not print coercions with ↑ (this doesn't parse)
-
-def Slice.subslice_mut_back (α : Type u) (s : Slice α) (r : Range Usize) (ss : Slice α) : Result (Slice α) :=
-  -- TODO: not completely sure here
-  if h: r.start.val < r.end_.val ∧ r.end_.val ≤ s.length ∧ ss.val.len = r.end_.val - r.start.val then
-    let s_beg := s.val.itake r.start.val
-    let s_end := s.val.idrop r.end_.val
-    have : s_beg.len = r.start.val := by
-      apply List.itake_len
-      . simp_all; scalar_tac
-      . scalar_tac
-    have : s_end.len = s.val.len - r.end_.val := by
-      apply List.idrop_len
-      . scalar_tac
-      . scalar_tac
-    let ns := s_beg.append (ss.val.append s_end)
-    have : ns.len = s.val.len := by simp [*]
-    ret ⟨ ns, by simp_all [← List.len_eq_length]; scalar_tac ⟩
-  else
-    fail panic
-
-@[pspec]
-theorem Slice.subslice_mut_back_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α)
-  (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : ss.length = r.end_.val - r.start.val) :
-  ∃ na, subslice_mut_back α a r ss = ret na ∧
-  (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧
-  (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = ss.index (i - r.start.val)) ∧
-  (∀ i, r.end_.val ≤ i → i < a.length → na.index i = a.index i) := by
-  simp [subslice_mut_back, *]
-  have h := List.replace_slice_index r.start.val r.end_.val a.val ss.val
-    (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac)
-  simp [List.replace_slice, *] at h
-  have ⟨ h0, h1, h2 ⟩ := h
-  clear h
-  split_conjs
-  . intro i _ _
-    have := h0 i (by int_tac) (by int_tac)
-    simp [*]
-  . intro i _ _
-    have := h1 i (by int_tac) (by int_tac)
-    simp [*]
-  . intro i _ _
-    have := h2 i (by int_tac) (by int_tac)
-    simp [*]
-
-end Primitives
diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean
new file mode 100644
index 00000000..47807a0d
--- /dev/null
+++ b/backends/lean/Base/Primitives/ArraySlice.lean
@@ -0,0 +1,560 @@
+/- Arrays/Slices -/
+import Lean
+import Lean.Meta.Tactic.Simp
+import Init.Data.List.Basic
+import Mathlib.Tactic.RunCmd
+import Mathlib.Tactic.Linarith
+import Base.IList
+import Base.Primitives.Scalar
+import Base.Primitives.Range
+import Base.Primitives.CoreOps
+import Base.Arith
+import Base.Progress.Base
+
+namespace Primitives
+
+open Result Error
+
+def Array (α : Type u) (n : Usize) := { l : List α // l.length = n.val }
+
+instance (a : Type u) (n : Usize) : Arith.HasIntProp (Array a n) where
+  prop_ty := λ v => v.val.len = n.val
+  prop := λ ⟨ _, l ⟩ => by simp[Scalar.max, List.len_eq_length, *]
+
+instance {α : Type u} {n : Usize} (p : Array α n → Prop) : Arith.HasIntProp (Subtype p) where
+  prop_ty := λ x => p x
+  prop := λ x => x.property
+
+@[simp]
+abbrev Array.length {α : Type u} {n : Usize} (v : Array α n) : Int := v.val.len
+
+@[simp]
+abbrev Array.v {α : Type u} {n : Usize} (v : Array α n) : List α := v.val
+
+example {α: Type u} {n : Usize} (v : Array α n) : v.length ≤ Scalar.max ScalarTy.Usize := by
+  scalar_tac
+
+def Array.make (α : Type u) (n : Usize) (init : List α) (hl : init.len = n.val := by decide) :
+  Array α n := ⟨ init, by simp [← List.len_eq_length]; apply hl ⟩
+
+example : Array Int (Usize.ofInt 2) := Array.make Int (Usize.ofInt 2) [0, 1]
+
+@[simp]
+abbrev Array.index {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i : Int) : α :=
+  v.val.index i
+
+@[simp]
+abbrev Array.slice {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i j : Int) : List α :=
+  v.val.slice i j
+
+def Array.index_shared (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α :=
+  match v.val.indexOpt i.val with
+  | none => fail .arrayOutOfBounds
+  | some x => ret x
+
+-- For initialization
+def Array.repeat (α : Type u) (n : Usize) (x : α) : Array α n :=
+  ⟨ List.ireplicate n.val x, by have h := n.hmin; simp_all [Scalar.min] ⟩
+
+@[pspec]
+theorem Array.repeat_spec {α : Type u} (n : Usize) (x : α) :
+  ∃ a, Array.repeat α n x = a ∧ a.val = List.ireplicate n.val x := by
+  simp [Array.repeat]
+
+/- In the theorems below: we don't always need the `∃ ..`, but we use one
+   so that `progress` introduces an opaque variable and an equality. This
+   helps control the context.
+ -/
+
+@[pspec]
+theorem Array.index_shared_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize)
+  (hbound : i.val < v.length) :
+  ∃ x, v.index_shared α n i = ret x ∧ x = v.val.index i.val := by
+  simp only [index_shared]
+  -- TODO: dependent rewrite
+  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
+  simp [*]
+
+-- This shouldn't be used
+def Array.index_shared_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (_: α) : Result Unit :=
+  if i.val < List.length v.val then
+    .ret ()
+  else
+    .fail arrayOutOfBounds
+
+def Array.index_mut (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α :=
+  match v.val.indexOpt i.val with
+  | none => fail .arrayOutOfBounds
+  | some x => ret x
+
+@[pspec]
+theorem Array.index_mut_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize)
+  (hbound : i.val < v.length) :
+  ∃ x, v.index_mut α n i = ret x ∧ x = v.val.index i.val := by
+  simp only [index_mut]
+  -- TODO: dependent rewrite
+  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
+  simp [*]
+
+def Array.index_mut_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: α) : Result (Array α n) :=
+  match v.val.indexOpt i.val with
+  | none => fail .arrayOutOfBounds
+  | some _ =>
+    .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩
+
+@[pspec]
+theorem Array.index_mut_back_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α)
+  (hbound : i.val < v.length) :
+  ∃ nv, v.index_mut_back α n i x = ret nv ∧
+  nv.val = v.val.update i.val x
+  := by
+  simp only [index_mut_back]
+  have h := List.indexOpt_bounds v.val i.val
+  split
+  . simp_all [length]; cases h <;> scalar_tac
+  . simp_all
+
+def Slice (α : Type u) := { l : List α // l.length ≤ Usize.max }
+
+instance (a : Type u) : Arith.HasIntProp (Slice a) where
+  prop_ty := λ v => 0 ≤ v.val.len ∧ v.val.len ≤ Scalar.max ScalarTy.Usize
+  prop := λ ⟨ _, l ⟩ => by simp[Scalar.max, List.len_eq_length, *]
+
+instance {α : Type u} (p : Slice α → Prop) : Arith.HasIntProp (Subtype p) where
+  prop_ty := λ x => p x
+  prop := λ x => x.property
+
+@[simp]
+abbrev Slice.length {α : Type u} (v : Slice α) : Int := v.val.len
+
+@[simp]
+abbrev Slice.v {α : Type u} (v : Slice α) : List α := v.val
+
+example {a: Type u} (v : Slice a) : v.length ≤ Scalar.max ScalarTy.Usize := by
+  scalar_tac
+
+def Slice.new (α : Type u): Slice α := ⟨ [], by apply Scalar.cMax_suffices .Usize; simp ⟩
+
+-- TODO: very annoying that the α is an explicit parameter
+def Slice.len (α : Type u) (v : Slice α) : Usize :=
+  Usize.ofIntCore v.val.len (by scalar_tac) (by scalar_tac)
+
+@[simp]
+theorem Slice.len_val {α : Type u} (v : Slice α) : (Slice.len α v).val = v.length :=
+  by rfl
+
+@[simp]
+abbrev Slice.index {α : Type u} [Inhabited α] (v: Slice α) (i: Int) : α :=
+  v.val.index i
+
+@[simp]
+abbrev Slice.slice {α : Type u} [Inhabited α] (s : Slice α) (i j : Int) : List α :=
+  s.val.slice i j
+
+def Slice.index_shared (α : Type u) (v: Slice α) (i: Usize) : Result α :=
+  match v.val.indexOpt i.val with
+  | none => fail .arrayOutOfBounds
+  | some x => ret x
+
+/- In the theorems below: we don't always need the `∃ ..`, but we use one
+   so that `progress` introduces an opaque variable and an equality. This
+   helps control the context.
+ -/
+
+@[pspec]
+theorem Slice.index_shared_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize)
+  (hbound : i.val < v.length) :
+  ∃ x, v.index_shared α i = ret x ∧ x = v.val.index i.val := by
+  simp only [index_shared]
+  -- TODO: dependent rewrite
+  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
+  simp [*]
+
+-- This shouldn't be used
+def Slice.index_shared_back (α : Type u) (v: Slice α) (i: Usize) (_: α) : Result Unit :=
+  if i.val < List.length v.val then
+    .ret ()
+  else
+    .fail arrayOutOfBounds
+
+def Slice.index_mut (α : Type u) (v: Slice α) (i: Usize) : Result α :=
+  match v.val.indexOpt i.val with
+  | none => fail .arrayOutOfBounds
+  | some x => ret x
+
+@[pspec]
+theorem Slice.index_mut_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize)
+  (hbound : i.val < v.length) :
+  ∃ x, v.index_mut α i = ret x ∧ x = v.val.index i.val := by
+  simp only [index_mut]
+  -- TODO: dependent rewrite
+  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
+  simp [*]
+
+def Slice.index_mut_back (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) :=
+  match v.val.indexOpt i.val with
+  | none => fail .arrayOutOfBounds
+  | some _ =>
+    .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩
+
+@[pspec]
+theorem Slice.index_mut_back_spec {α : Type u} (v: Slice α) (i: Usize) (x : α)
+  (hbound : i.val < v.length) :
+  ∃ nv, v.index_mut_back α i x = ret nv ∧
+  nv.val = v.val.update i.val x
+  := by
+  simp only [index_mut_back]
+  have h := List.indexOpt_bounds v.val i.val
+  split
+  . simp_all [length]; cases h <;> scalar_tac
+  . simp_all
+
+/- Array to slice/subslices -/
+
+/- We could make this function not use the `Result` type. By making it monadic, we
+   push the user to use the `Array.to_slice_shared_spec` spec theorem below (through the
+   `progress` tactic), meaning `Array.to_slice_shared` should be considered as opaque.
+   All what the spec theorem reveals is that the "representative" lists are the same. -/
+def Array.to_slice_shared (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) :=
+  ret ⟨ v.val, by simp [← List.len_eq_length]; scalar_tac ⟩
+
+@[pspec]
+theorem Array.to_slice_shared_spec {α : Type u} {n : Usize} (v : Array α n) :
+  ∃ s, to_slice_shared α n v = ret s ∧ v.val = s.val := by simp [to_slice_shared]
+
+def Array.to_slice_mut (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) :=
+  to_slice_shared α n v
+
+@[pspec]
+theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) :
+  ∃ s, Array.to_slice_shared α n v = ret s ∧ v.val = s.val := to_slice_shared_spec v
+
+def Array.to_slice_mut_back (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) :=
+  if h: s.val.len = n.val then
+    ret ⟨ s.val, by simp [← List.len_eq_length, *] ⟩
+  else fail panic
+
+@[pspec]
+theorem Array.to_slice_mut_back_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) :
+  ∃ na, to_slice_mut_back α n a ns = ret na ∧ na.val = ns.val
+  := by simp [to_slice_mut_back, *]
+
+def Array.subslice_shared (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) :=
+  -- TODO: not completely sure here
+  if r.start.val < r.end_.val ∧ r.end_.val ≤ a.val.len then
+    ret ⟨ a.val.slice r.start.val r.end_.val,
+          by
+            simp [← List.len_eq_length]
+            have := a.val.slice_len_le r.start.val r.end_.val
+            scalar_tac ⟩
+  else
+    fail panic
+
+@[pspec]
+theorem Array.subslice_shared_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize)
+  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) :
+  ∃ s, subslice_shared α n a r = ret s ∧
+  s.val = a.val.slice r.start.val r.end_.val ∧
+  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i))
+  := by
+  simp [subslice_shared, *]
+  intro i _ _
+  have := List.index_slice r.start.val r.end_.val i a.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac)
+  simp [*]
+
+def Array.subslice_mut (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) :=
+  Array.subslice_shared α n a r
+
+@[pspec]
+theorem Array.subslice_mut_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize)
+  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) :
+  ∃ s, subslice_mut α n a r = ret s ∧
+  s.val = a.slice r.start.val r.end_.val ∧
+  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i))
+  := subslice_shared_spec a r h0 h1
+
+def Array.subslice_mut_back (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) (s : Slice α) : Result (Array α n) :=
+  -- TODO: not completely sure here
+  if h: r.start.val < r.end_.val ∧ r.end_.val ≤ a.length ∧ s.val.len = r.end_.val - r.start.val then
+    let s_beg := a.val.itake r.start.val
+    let s_end := a.val.idrop r.end_.val
+    have : s_beg.len = r.start.val := by
+      apply List.itake_len
+      . simp_all; scalar_tac
+      . scalar_tac
+    have : s_end.len = a.val.len - r.end_.val := by
+      apply List.idrop_len
+      . scalar_tac
+      . scalar_tac
+    let na := s_beg.append (s.val.append s_end)
+    have : na.len = a.val.len := by simp [*]
+    ret ⟨ na, by simp_all [← List.len_eq_length]; scalar_tac ⟩
+  else
+    fail panic
+
+-- TODO: it is annoying to write `.val` everywhere. We could leverage coercions,
+-- but: some symbols like `+` are already overloaded to be notations for monadic
+-- operations/
+-- We should introduce special symbols for the monadic arithmetic operations
+-- (the use will never write those symbols directly).
+@[pspec]
+theorem Array.subslice_mut_back_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α)
+  (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : s.length = r.end_.val - r.start.val) :
+  ∃ na, subslice_mut_back α n a r s = ret na ∧
+  (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧
+  (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = s.index (i - r.start.val)) ∧
+  (∀ i, r.end_.val ≤ i → i < n.val → na.index i = a.index i) := by
+  simp [subslice_mut_back, *]
+  have h := List.replace_slice_index r.start.val r.end_.val a.val s.val
+    (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac)
+  simp [List.replace_slice] at h
+  have ⟨ h0, h1, h2 ⟩ := h
+  clear h
+  split_conjs
+  . intro i _ _
+    have := h0 i (by int_tac) (by int_tac)
+    simp [*]
+  . intro i _ _
+    have := h1 i (by int_tac) (by int_tac)
+    simp [*]
+  . intro i _ _
+    have := h2 i (by int_tac) (by int_tac)
+    simp [*]
+
+def Slice.subslice_shared (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) :=
+  -- TODO: not completely sure here
+  if r.start.val < r.end_.val ∧ r.end_.val ≤ s.length then
+    ret ⟨ s.val.slice r.start.val r.end_.val,
+          by
+            simp [← List.len_eq_length]
+            have := s.val.slice_len_le r.start.val r.end_.val
+            scalar_tac ⟩
+  else
+    fail panic
+
+@[pspec]
+theorem Slice.subslice_shared_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize)
+  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) :
+  ∃ ns, subslice_shared α s r = ret ns ∧
+  ns.val = s.slice r.start.val r.end_.val ∧
+  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i))
+  := by
+  simp [subslice_shared, *]
+  intro i _ _
+  have := List.index_slice r.start.val r.end_.val i s.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac)
+  simp [*]
+
+def Slice.subslice_mut (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) :=
+  Slice.subslice_shared α s r
+
+@[pspec]
+theorem Slice.subslice_mut_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize)
+  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) :
+  ∃ ns, subslice_mut α s r = ret ns ∧
+  ns.val = s.slice r.start.val r.end_.val ∧
+  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i))
+  := subslice_shared_spec s r h0 h1
+
+attribute [pp_dot] List.len List.length List.index -- use the dot notation when printing
+set_option pp.coercions false -- do not print coercions with ↑ (this doesn't parse)
+
+def Slice.subslice_mut_back (α : Type u) (s : Slice α) (r : Range Usize) (ss : Slice α) : Result (Slice α) :=
+  -- TODO: not completely sure here
+  if h: r.start.val < r.end_.val ∧ r.end_.val ≤ s.length ∧ ss.val.len = r.end_.val - r.start.val then
+    let s_beg := s.val.itake r.start.val
+    let s_end := s.val.idrop r.end_.val
+    have : s_beg.len = r.start.val := by
+      apply List.itake_len
+      . simp_all; scalar_tac
+      . scalar_tac
+    have : s_end.len = s.val.len - r.end_.val := by
+      apply List.idrop_len
+      . scalar_tac
+      . scalar_tac
+    let ns := s_beg.append (ss.val.append s_end)
+    have : ns.len = s.val.len := by simp [*]
+    ret ⟨ ns, by simp_all [← List.len_eq_length]; scalar_tac ⟩
+  else
+    fail panic
+
+@[pspec]
+theorem Slice.subslice_mut_back_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α)
+  (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : ss.length = r.end_.val - r.start.val) :
+  ∃ na, subslice_mut_back α a r ss = ret na ∧
+  (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧
+  (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = ss.index (i - r.start.val)) ∧
+  (∀ i, r.end_.val ≤ i → i < a.length → na.index i = a.index i) := by
+  simp [subslice_mut_back, *]
+  have h := List.replace_slice_index r.start.val r.end_.val a.val ss.val
+    (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac)
+  simp [List.replace_slice, *] at h
+  have ⟨ h0, h1, h2 ⟩ := h
+  clear h
+  split_conjs
+  . intro i _ _
+    have := h0 i (by int_tac) (by int_tac)
+    simp [*]
+  . intro i _ _
+    have := h1 i (by int_tac) (by int_tac)
+    simp [*]
+  . intro i _ _
+    have := h2 i (by int_tac) (by int_tac)
+    simp [*]
+
+/- Trait declaration: [core::slice::index::private_slice_index::Sealed] -/
+structure core.slice.index.private_slice_index.Sealed (Self : Type) where
+
+/- Trait declaration: [core::slice::index::SliceIndex] -/
+structure core.slice.index.SliceIndex (Self T0 : Type) where
+  sealedInst :core.slice.index.private_slice_index.Sealed Self
+  Output : Type
+  get : Self → T0 → Result (Option Output)
+  get_mut : Self → T0 → Result (Option Output)
+  get_mut_back : Self → T0 → Option Output → Result T0
+  get_unchecked : Self → ConstRawPtr T0 → Result (ConstRawPtr Output)
+  get_unchecked_mut : Self → MutRawPtr T0 → Result (MutRawPtr Output)
+  index : Self → T0 → Result Output
+  index_mut : Self → T0 → Result Output
+  index_mut_back : Self → T0 → Output → Result T0
+
+/- [core::slice::index::[T]::index]: forward function -/
+def core.slice.index.Slice.index
+  (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0))
+  (slice : Slice T0) (i : I) : Result inst.Output := do
+  let x ← inst.get i slice
+  match x with
+  | none => fail panic
+  | some x => ret x
+
+/- [core::slice::index::Range:::get]: forward function -/
+def core.slice.index.Range.get (T0 : Type) (i : Range Usize) (slice : Slice T0) :
+  Result (Option (Slice T0)) :=
+  sorry -- TODO
+
+/- [core::slice::index::Range::get_mut]: forward function -/
+def core.slice.index.Range.get_mut
+  (T0 : Type) : Range Usize → Slice T0 → Result (Option (Slice T0)) :=
+  sorry -- TODO
+
+/- [core::slice::index::Range::get_mut]: backward function 0 -/
+def core.slice.index.Range.get_mut_back
+  (T0 : Type) :
+  Range Usize → Slice T0 → Option (Slice T0) → Result (Slice T0) :=
+  sorry -- TODO
+
+/- [core::slice::index::Range::get_unchecked]: forward function -/
+def core.slice.index.Range.get_unchecked
+  (T0 : Type) :
+  Range Usize → ConstRawPtr (Slice T0) → Result (ConstRawPtr (Slice T0)) :=
+  -- Don't know what the model should be - for now we always fail to make
+  -- sure code which uses it fails
+  fun _ _ => fail panic
+
+/- [core::slice::index::Range::get_unchecked_mut]: forward function -/
+def core.slice.index.Range.get_unchecked_mut
+  (T0 : Type) :
+  Range Usize → MutRawPtr (Slice T0) → Result (MutRawPtr (Slice T0)) :=
+  -- Don't know what the model should be - for now we always fail to make
+  -- sure code which uses it fails
+  fun _ _ => fail panic
+
+/- [core::slice::index::Range::index]: forward function -/
+def core.slice.index.Range.index
+  (T0 : Type) : Range Usize → Slice T0 → Result (Slice T0) :=
+  sorry -- TODO
+
+/- [core::slice::index::Range::index_mut]: forward function -/
+def core.slice.index.Range.index_mut
+  (T0 : Type) : Range Usize → Slice T0 → Result (Slice T0) :=
+  sorry -- TODO
+
+/- [core::slice::index::Range::index_mut]: backward function 0 -/
+def core.slice.index.Range.index_mut_back
+  (T0 : Type) : Range Usize → Slice T0 → Slice T0 → Result (Slice T0) :=
+  sorry -- TODO
+
+/- [core::slice::index::[T]::index_mut]: forward function -/
+def core.slice.index.Slice.index_mut
+  (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0)) :
+  Slice T0 → I → Result inst.Output :=
+  sorry -- TODO
+
+/- [core::slice::index::[T]::index_mut]: backward function 0 -/
+def core.slice.index.Slice.index_mut_back
+  (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0)) :
+  Slice T0 → I → inst.Output → Result (Slice T0) :=
+  sorry -- TODO
+
+/- [core::array::[T; N]::index]: forward function -/
+def core.array.Array.index
+  (T0 I : Type) (N : Usize) (inst : core.ops.index.Index (Slice T0) I) :
+  Array T0 N → I → Result inst.Output :=
+  sorry -- TODO
+
+/- [core::array::[T; N]::index_mut]: forward function -/
+def core.array.Array.index_mut
+  (T0 I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T0) I) :
+  Array T0 N → I → Result inst.indexInst.Output :=
+  sorry -- TODO
+
+/- [core::array::[T; N]::index_mut]: backward function 0 -/
+def core.array.Array.index_mut_back
+  (T0 I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T0) I) :
+  Array T0 N → I → inst.indexInst.Output → Result (Array T0 N) :=
+  sorry -- TODO
+
+/- Trait implementation: [core::slice::index::[T]] -/
+def core.slice.index.Slice.coreopsindexIndexInst (T0 I : Type)
+  (inst : core.slice.index.SliceIndex I (Slice T0)) :
+  core.ops.index.Index (Slice T0) I := {
+  Output := inst.Output
+  index := core.slice.index.Slice.index T0 I inst
+}
+
+/- Trait implementation: [core::slice::index::private_slice_index::Range] -/
+def core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst
+  : core.slice.index.private_slice_index.Sealed (Range Usize) := {}
+
+/- Trait implementation: [core::slice::index::Range] -/
+def core.slice.index.Range.coresliceindexSliceIndexInst (T0 : Type) :
+  core.slice.index.SliceIndex (Range Usize) (Slice T0) := {
+  sealedInst :=
+    core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst
+  Output := Slice T0
+  get := core.slice.index.Range.get T0
+  get_mut := core.slice.index.Range.get_mut T0
+  get_mut_back := core.slice.index.Range.get_mut_back T0
+  get_unchecked := core.slice.index.Range.get_unchecked T0
+  get_unchecked_mut := core.slice.index.Range.get_unchecked_mut T0
+  index := core.slice.index.Range.index T0
+  index_mut := core.slice.index.Range.index_mut T0
+  index_mut_back := core.slice.index.Range.index_mut_back T0
+}
+
+/- Trait implementation: [core::slice::index::[T]] -/
+def core.slice.index.Slice.coreopsindexIndexMutInst (T0 I : Type)
+  (inst : core.slice.index.SliceIndex I (Slice T0)) :
+  core.ops.index.IndexMut (Slice T0) I := {
+  indexInst := core.slice.index.Slice.coreopsindexIndexInst T0 I inst
+  index_mut := core.slice.index.Slice.index_mut T0 I inst
+  index_mut_back := core.slice.index.Slice.index_mut_back T0 I inst
+}
+
+/- Trait implementation: [core::array::[T; N]] -/
+def core.array.Array.coreopsindexIndexInst (T0 I : Type) (N : Usize)
+  (inst : core.ops.index.Index (Slice T0) I) :
+  core.ops.index.Index (Array T0 N) I := {
+  Output := inst.Output
+  index := core.array.Array.index T0 I N inst
+}
+
+/- Trait implementation: [core::array::[T; N]] -/
+def core.array.Array.coreopsindexIndexMutInst (T0 I : Type) (N : Usize)
+  (inst : core.ops.index.IndexMut (Slice T0) I) :
+  core.ops.index.IndexMut (Array T0 N) I := {
+  indexInst := core.array.Array.coreopsindexIndexInst T0 I N inst.indexInst
+  index_mut := core.array.Array.index_mut T0 I N inst
+  index_mut_back := core.array.Array.index_mut_back T0 I N inst
+}
+
+end Primitives
diff --git a/backends/lean/Base/Primitives/Base.lean b/backends/lean/Base/Primitives/Base.lean
index 10af8f67..7fc33251 100644
--- a/backends/lean/Base/Primitives/Base.lean
+++ b/backends/lean/Base/Primitives/Base.lean
@@ -127,4 +127,11 @@ def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } :=
  Use with `simp [ aeneas ]` -/
 register_simp_attr aeneas
 
+-- We don't really use raw pointers for now
+structure MutRawPtr (T : Type) where
+  v : T
+
+structure ConstRawPtr (T : Type) where
+  v : T
+
 end Primitives
diff --git a/backends/lean/Base/Primitives/CoreOps.lean b/backends/lean/Base/Primitives/CoreOps.lean
new file mode 100644
index 00000000..da458f66
--- /dev/null
+++ b/backends/lean/Base/Primitives/CoreOps.lean
@@ -0,0 +1,37 @@
+import Lean
+import Base.Primitives.Base
+
+open Primitives
+open Result
+
+namespace core.ops
+
+namespace index -- core.ops.index
+
+/- Trait declaration: [core::ops::index::Index] -/
+structure Index (Self Idx : Type) where
+  Output : Type
+  index : Self → Idx → Result Output
+
+/- Trait declaration: [core::ops::index::IndexMut] -/
+structure IndexMut (Self Idx : Type) where
+  indexInst : Index Self Idx
+  index_mut : Self → Idx → Result indexInst.Output
+  index_mut_back : Self → Idx → indexInst.Output → Result Self
+
+end index -- core.ops.index
+
+namespace deref -- core.ops.deref
+
+structure Deref (Self : Type) where
+  Target : Type
+  deref : Self → Result Target
+
+structure DerefMut (Self : Type) where
+  derefInst : Deref Self
+  deref_mut : Self → Result derefInst.Target
+  deref_mut_back : Self → derefInst.Target → Result Self
+
+end deref -- core.ops.deref
+
+end core.ops
diff --git a/backends/lean/Base/Primitives/CoreOpsDeref.lean b/backends/lean/Base/Primitives/CoreOpsDeref.lean
deleted file mode 100644
index 2b540012..00000000
--- a/backends/lean/Base/Primitives/CoreOpsDeref.lean
+++ /dev/null
@@ -1,18 +0,0 @@
-import Lean
-import Base.Primitives.Base
-
-open Primitives
-open Result
-
-namespace core.ops.deref
-
-structure Deref (Self : Type) where
-  Target : Type
-  deref : Self → Result Target
-
-structure DerefMut (Self : Type) where
-  derefInst : Deref Self
-  deref_mut : Self → Result derefInst.Target
-  deref_mut_back : Self → derefInst.Target → Result Self
-
-end core.ops.deref
diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean
index c4c4d9f2..99fcedc6 100644
--- a/backends/lean/Base/Primitives/Vec.lean
+++ b/backends/lean/Base/Primitives/Vec.lean
@@ -6,7 +6,7 @@ import Mathlib.Tactic.RunCmd
 import Mathlib.Tactic.Linarith
 import Base.IList
 import Base.Primitives.Scalar
-import Base.Primitives.Array
+import Base.Primitives.ArraySlice
 import Base.Arith
 import Base.Progress.Base
 
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index afd722e5..6b6a2686 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -234,26 +234,20 @@ let assumed_adts () : (assumed_ty * string) list =
         (Array, "Array");
         (Slice, "Slice");
         (Str, "Str");
+        (RawPtr Mut, "MutRawPtr");
+        (RawPtr Const, "ConstRawPtr");
       ]
-  | Coq | FStar ->
+  | Coq | FStar | HOL4 ->
       [
         (State, "state");
         (Result, "result");
         (Error, "error");
-        (Fuel, "nat");
-        (Array, "array");
-        (Slice, "slice");
-        (Str, "str");
-      ]
-  | HOL4 ->
-      [
-        (State, "state");
-        (Result, "result");
-        (Error, "error");
-        (Fuel, "num");
+        (Fuel, if !backend = HOL4 then "num" else "nat");
         (Array, "array");
         (Slice, "slice");
         (Str, "str");
+        (RawPtr Mut, "mut_raw_ptr");
+        (RawPtr Const, "const_raw_ptr");
       ]
 
 let assumed_struct_constructors () : (assumed_ty * string) list =
@@ -1378,7 +1372,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
   let def_name =
     match info with
     | None -> ctx.fmt.type_name def.name
-    | Some info -> String.concat "." info.rust_name
+    | Some info -> info.extract_name
   in
   let ctx = ctx_add (TypeId (AdtId def.def_id)) def_name ctx in
   (* Compute and register:
@@ -4281,16 +4275,9 @@ let extract_trait_decl_method_names (ctx : extraction_ctx)
             string * (RegionGroupId.id option * string) list =
           let compute_fun_name (f : fun_decl) : RegionGroupId.id option * string
               =
-            (* We do something special: we use the base name but remove everything
-               but the crate (because [get_name] removes it) and the last ident.
-               This allows us to reuse the [ctx_compute_fun_decl] function.
-            *)
-            let basename : name =
-              match (f.basename : name) with
-              | Ident crate :: name ->
-                  Ident crate :: [ Collections.List.last name ]
-              | _ -> raise (Failure "Unexpected")
-            in
+            (* We do something special to reuse the [ctx_compute_fun_decl]
+               function. TODO: make it cleaner. *)
+            let basename : name = [ Ident item_name ] in
             let f = { f with basename } in
             let trans = A.FunDeclId.Map.find f.def_id ctx.trans_funs in
             let name = ctx_compute_fun_name trans f ctx in
@@ -4503,6 +4490,17 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
   extract_generic_params ctx fmt TypeDeclId.Set.empty generics type_params
     cg_params trait_clauses;
 
+  (* Add the parent clauses as local clauses, so that we can refer to them *)
+  let ctx =
+    List.fold_left
+      (fun ctx clause ->
+        let item_name =
+          ctx_get_trait_parent_clause decl.def_id clause.clause_id ctx
+        in
+        ctx_add (LocalTraitClauseId clause.clause_id) item_name ctx)
+      ctx decl.generics.trait_clauses
+  in
+
   F.pp_print_space fmt ();
   (match !backend with
   | Lean -> F.pp_print_string fmt "where"
@@ -4522,6 +4520,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
         ctx_get_trait_parent_clause decl.def_id clause.clause_id ctx
       in
       let ty () =
+        F.pp_print_space fmt ();
         extract_trait_clause_type ctx fmt TypeDeclId.Set.empty clause
       in
       extract_trait_decl_item ctx fmt item_name ty)
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index 4c6fe014..c781463e 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -121,7 +121,7 @@ let builtin_types () : builtin_type_info list =
       rust_name = [ "alloc"; "alloc"; "Global" ];
       extract_name =
         (match !backend with
-        | Lean -> "AllocGlobal"
+        | Lean -> "alloc.alloc.Global"
         | Coq | FStar | HOL4 -> "alloc_global");
       keep_params = None;
       body_info = None;
@@ -335,7 +335,7 @@ let builtin_funs () :
           rg = None;
           extract_name =
             (match !backend with
-            | FStar | Coq | HOL4 -> "alloc_boxed_box_deref"
+            | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref"
             | Lean -> "alloc.boxed.Box.deref");
         };
         (* The backward function shouldn't be used *)
@@ -343,7 +343,7 @@ let builtin_funs () :
           rg = rg0;
           extract_name =
             (match !backend with
-            | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_back"
+            | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref_back"
             | Lean -> "alloc.boxed.Box.deref_back");
         };
       ] );
@@ -354,7 +354,7 @@ let builtin_funs () :
           rg = None;
           extract_name =
             (match !backend with
-            | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_mut"
+            | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref_mut"
             | Lean -> "alloc.boxed.Box.deref_mut");
         };
         {
@@ -365,6 +365,179 @@ let builtin_funs () :
             | Lean -> "alloc.boxed.Box.deref_mut_back");
         };
       ] );
+    (* TODO: fix the same like "[T]" below *)
+    ( [ "core"; "slice"; "index"; "[T]"; "index" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Slice_index"
+            | Lean -> "core.slice.index.Slice.index");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_back"
+            | Lean -> "core.slice.index.Slice.index_back");
+        };
+      ] );
+    ( [ "core"; "slice"; "index"; "[T]"; "index_mut" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_mut"
+            | Lean -> "core.slice.index.Slice.index_mut");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_mut_back"
+            | Lean -> "core.slice.index.Slice.index_mut_back");
+        };
+      ] );
+    ( [ "core"; "array"; "[T; N]"; "index" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_array_Array_index"
+            | Lean -> "core.array.Array.index");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_array_Array_index_back"
+            | Lean -> "core.array.Array.index_back");
+        };
+      ] );
+    ( [ "core"; "array"; "[T; N]"; "index_mut" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_array_Array_index_mut"
+            | Lean -> "core.array.Array.index_mut");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_array_Array_index_mut_back"
+            | Lean -> "core.array.Array.index_mut_back");
+        };
+      ] );
+    ( [ "core"; "slice"; "index"; "Range"; "get" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_get"
+            | Lean -> "core.slice.index.Range.get");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_back"
+            | Lean -> "core.slice.index.Range.get_back");
+        };
+      ] );
+    ( [ "core"; "slice"; "index"; "Range"; "get_mut" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_mut"
+            | Lean -> "core.slice.index.Range.get_mut");
+        };
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_mut_back"
+            | Lean -> "core.slice.index.Range.get_mut_back");
+        };
+      ] );
+    ( [ "core"; "slice"; "index"; "Range"; "index" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_index"
+            | Lean -> "core.slice.index.Range.index");
+        };
+        (* The backward function shouldn't be used *)
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_index_back"
+            | Lean -> "core.slice.index.Range.index_back");
+        };
+      ] );
+    ( [ "core"; "slice"; "index"; "Range"; "index_mut" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_index_mut"
+            | Lean -> "core.slice.index.Range.index_mut");
+        };
+        {
+          rg = rg0;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_index_mut_back"
+            | Lean -> "core.slice.index.Range.index_mut_back");
+        };
+      ] );
+    ( [ "core"; "slice"; "index"; "Range"; "get_unchecked" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_unchecked"
+            | Lean -> "core.slice.index.Range.get_unchecked");
+        };
+      ] );
+    ( [ "core"; "slice"; "index"; "Range"; "get_unchecked_mut" ],
+      None,
+      [
+        {
+          rg = None;
+          extract_name =
+            (match !backend with
+            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_unchecked_mut"
+            | Lean -> "core.slice.index.Range.get_unchecked_mut");
+        };
+      ] );
   ]
 
 let mk_builtin_funs_map () =
@@ -528,7 +701,7 @@ let builtin_trait_decls_info () =
         [
           (match !backend with
           | Coq | FStar | HOL4 -> "index_inst"
-          | Lean -> "IndexInst");
+          | Lean -> "indexInst");
         ];
       consts = [];
       types = [];
@@ -547,6 +720,104 @@ let builtin_trait_decls_info () =
             ] );
         ];
     };
+    {
+      (* Sealed *)
+      rust_name = "core::slice::index::private_slice_index::Sealed";
+      extract_name =
+        (match !backend with
+        | Coq | FStar | HOL4 -> "core_slice_index_sealed"
+        | Lean -> "core.slice.index.private_slice_index.Sealed");
+      parent_clauses = [];
+      consts = [];
+      types = [];
+      funs = [];
+    };
+    {
+      (* SliceIndex *)
+      rust_name = "core::slice::index::SliceIndex";
+      extract_name =
+        (match !backend with
+        | Coq | FStar | HOL4 -> "core_SliceIndex"
+        | Lean -> "core.slice.index.SliceIndex");
+      parent_clauses =
+        [
+          (match !backend with
+          | Coq | FStar | HOL4 -> "sealed_inst"
+          | Lean -> "sealedInst");
+        ];
+      consts = [];
+      types =
+        [
+          ( "Output",
+            ( (match !backend with
+              | Coq | FStar | HOL4 -> "core_SliceIndex_Output"
+              | Lean -> "Output"),
+              [] ) );
+        ];
+      funs =
+        [
+          ( "get",
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_get"
+                | Lean -> "get" );
+              (* The backward function shouldn't be used *)
+              ( rg0,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_get_back"
+                | Lean -> "get_back" );
+            ] );
+          ( "get_mut",
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_get_mut"
+                | Lean -> "get_mut" );
+              ( rg0,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_get_mut_back"
+                | Lean -> "get_mut_back" );
+            ] );
+          ( "get_unchecked",
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_get_unchecked"
+                | Lean -> "get_unchecked" );
+            ] );
+          ( "get_unchecked_mut",
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_get_unchecked_mut"
+                | Lean -> "get_unchecked_mut" );
+            ] );
+          ( "index",
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_index"
+                | Lean -> "index" );
+              (* The backward function shouldn't be used *)
+              ( rg0,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_index_back"
+                | Lean -> "index_back" );
+            ] );
+          ( "index_mut",
+            [
+              ( None,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_index_mut"
+                | Lean -> "index_mut" );
+              ( rg0,
+                match !backend with
+                | Coq | FStar | HOL4 -> "core_SliceIndex_index_mut_back"
+                | Lean -> "index_mut_back" );
+            ] );
+        ];
+    };
   ]
 
 let mk_builtin_trait_decls_map () =
@@ -577,6 +848,7 @@ end
 module SimpleNamePairMap = Collections.MakeMap (SimpleNamePairOrd)
 
 let builtin_trait_impls_info () : ((string list * string list) * string) list =
+  (* TODO: fix the names like "[T]" below *)
   [
     (* core::ops::Deref<alloc::boxed::Box<T>> *)
     ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "Deref" ]),
@@ -584,6 +856,28 @@ let builtin_trait_impls_info () : ((string list * string list) * string) list =
     (* core::ops::DerefMut<alloc::boxed::Box<T>> *)
     ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "DerefMut" ]),
       "alloc.boxed.Box.coreOpsDerefMutInst" );
+    (* core::ops::index::Index<[T], I> *)
+    ( ([ "core"; "slice"; "index"; "[T]" ], [ "core"; "ops"; "index"; "Index" ]),
+      "core.slice.index.Slice.coreopsindexIndexInst" );
+    (* core::slice::index::private_slice_index::Sealed<Range<usize>> *)
+    ( ( [ "core"; "slice"; "index"; "private_slice_index"; "Range" ],
+        [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ] ),
+      "core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst"
+    );
+    (* core::slice::index::SliceIndex<Range<usize>, [T]> *)
+    ( ( [ "core"; "slice"; "index"; "Range" ],
+        [ "core"; "slice"; "index"; "SliceIndex" ] ),
+      "core.slice.index.Range.coresliceindexSliceIndexInst" );
+    (* core::ops::index::IndexMut<[T], I> *)
+    ( ( [ "core"; "slice"; "index"; "[T]" ],
+        [ "core"; "ops"; "index"; "IndexMut" ] ),
+      "core.slice.index.Slice.coreopsindexIndexMutInst" );
+    (* core::ops::index::Index<[T; N], I> *)
+    ( ([ "core"; "array"; "[T; N]" ], [ "core"; "ops"; "index"; "Index" ]),
+      "core.array.Array.coreopsindexIndexInst" );
+    (* core::ops::index::IndexMut<[T; N], I> *)
+    ( ([ "core"; "array"; "[T; N]" ], [ "core"; "ops"; "index"; "IndexMut" ]),
+      "core.array.Array.coreopsindexIndexMutInst" );
   ]
 
 let mk_builtin_trait_impls_map () =
diff --git a/compiler/LlbcAstUtils.ml b/compiler/LlbcAstUtils.ml
index 2553127a..0ab4ed94 100644
--- a/compiler/LlbcAstUtils.ml
+++ b/compiler/LlbcAstUtils.ml
@@ -13,14 +13,14 @@ let lookup_fun_name (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
   | Regular id -> (FunDeclId.Map.find id fun_decls).name
   | Assumed aid -> Assumed.get_assumed_fun_name aid
 
-(** Return the opaque declarations found in the crate.
+(** Return the opaque declarations found in the crate, which are also *not builtin*.
 
     [filter_assumed]: if [true], do not consider as opaque the external definitions
     that we will map to definitions from the standard library.
 
     Remark: the list of functions also contains the list of opaque global bodies.
  *)
-let crate_get_opaque_decls (k : crate) (filter_assumed : bool) :
+let crate_get_opaque_non_builtin_decls (k : crate) (filter_assumed : bool) :
     T.type_decl list * fun_decl list =
   let open ExtractBuiltin in
   let is_opaque_fun (d : fun_decl) : bool =
@@ -30,14 +30,21 @@ let crate_get_opaque_decls (k : crate) (filter_assumed : bool) :
        (which don't have a body but must not be considered as opaque) *)
     && (match d.kind with TraitMethodDecl _ -> false | _ -> true)
     && ((not filter_assumed)
-       || not (SimpleNameMap.mem sname builtin_globals_map))
+       || (not (SimpleNameMap.mem sname builtin_globals_map))
+          && not (SimpleNameMap.mem sname (builtin_funs_map ())))
+  in
+  let is_opaque_type (d : T.type_decl) : bool =
+    let sname = name_to_simple_name d.name in
+    d.kind = T.Opaque
+    && ((not filter_assumed)
+       || not (SimpleNameMap.mem sname (builtin_types_map ())))
   in
-  let is_opaque_type (d : T.type_decl) : bool = d.kind = T.Opaque in
   (* Note that by checking the function bodies we also the globals *)
   ( List.filter is_opaque_type (T.TypeDeclId.Map.values k.types),
     List.filter is_opaque_fun (FunDeclId.Map.values k.functions) )
 
 (** Return true if the crate contains opaque declarations, ignoring the assumed
     definitions. *)
-let crate_has_opaque_decls (k : crate) (filter_assumed : bool) : bool =
-  crate_get_opaque_decls k filter_assumed <> ([], [])
+let crate_has_opaque_non_builtin_decls (k : crate) (filter_assumed : bool) :
+    bool =
+  crate_get_opaque_non_builtin_decls k filter_assumed <> ([], [])
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 35dff9e6..019a5c35 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -390,10 +390,10 @@ type gen_config = {
     [filter_assumed]: if [true], do not consider as opaque the external definitions
     that we will map to definitions from the standard library.
  *)
-let crate_has_opaque_decls (ctx : gen_ctx) (filter_assumed : bool) : bool * bool
-    =
+let crate_has_opaque_non_builtin_decls (ctx : gen_ctx) (filter_assumed : bool) :
+    bool * bool =
   let types, funs =
-    LlbcAstUtils.crate_get_opaque_decls ctx.crate filter_assumed
+    LlbcAstUtils.crate_get_opaque_non_builtin_decls ctx.crate filter_assumed
   in
   log#ldebug
     (lazy
@@ -1257,7 +1257,9 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
 
      (* Check if there are opaque types and functions - in which case we need
       * to split *)
-     let has_opaque_types, has_opaque_funs = crate_has_opaque_decls ctx true in
+     let has_opaque_types, has_opaque_funs =
+       crate_has_opaque_non_builtin_decls ctx true
+     in
      let has_opaque_types = has_opaque_types || !Config.use_state in
 
      (* Extract the types *)
-- 
cgit v1.3.1


From 81b7a7d706bc1a0f2f57bc254a8af158039a10cf Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Wed, 25 Oct 2023 18:44:28 +0200
Subject: Make the hashmap files typecheck again in Lean

---
 Makefile                                      |    6 +-
 backends/lean/Base/Primitives/ArraySlice.lean |   61 +-
 backends/lean/Base/Primitives/Range.lean      |    2 +-
 backends/lean/Base/Primitives/Vec.lean        |   74 +-
 backends/lean/Base/Progress/Progress.lean     |    3 +-
 compiler/Extract.ml                           | 2500 ++-----------------------
 compiler/ExtractBase.ml                       |    2 +
 compiler/ExtractBuiltin.ml                    |  509 ++---
 compiler/ExtractTypes.ml                      | 2390 +++++++++++++++++++++++
 compiler/Pure.ml                              |    4 +-
 compiler/Translate.ml                         |    1 +
 compiler/dune                                 |    1 +
 12 files changed, 2778 insertions(+), 2775 deletions(-)
 create mode 100644 compiler/ExtractTypes.ml

(limited to 'compiler/Translate.ml')

diff --git a/Makefile b/Makefile
index 2c996345..958ae8d7 100644
--- a/Makefile
+++ b/Makefile
@@ -142,7 +142,8 @@ tcoq-loops: OPTIONS += -use-fuel -no-split-files
 tlean-loops: SUBDIR :=
 thol4-loops: SUBDIR := misc-loops
 
-trans-hashmap: OPTIONS += -no-state -test-trans-units
+# TODO: reactivate -test-trans-units
+trans-hashmap: OPTIONS += -no-state
 trans-hashmap: SUBDIR := hashmap
 tfstar-hashmap: OPTIONS += -decreases-clauses -template-clauses
 tcoq-hashmap: OPTIONS += -use-fuel
@@ -150,7 +151,8 @@ tlean-hashmap: SUBDIR :=
 tlean-hashmap: OPTIONS += -no-gen-lib-entry # We add a custom import in the Hashmap.lean file: we do not want to overwrite it
 thol4-hashmap: OPTIONS +=
 
-trans-hashmap_main: OPTIONS += -test-trans-units
+# TODO: reactivate -test-trans-units
+trans-hashmap_main: OPTIONS +=
 trans-hashmap_main: SUBDIR := hashmap_on_disk
 tfstar-hashmap_main: OPTIONS += -decreases-clauses -template-clauses
 tcoq-hashmap_main: OPTIONS += -use-fuel
diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean
index 47807a0d..615e0783 100644
--- a/backends/lean/Base/Primitives/ArraySlice.lean
+++ b/backends/lean/Base/Primitives/ArraySlice.lean
@@ -13,7 +13,7 @@ import Base.Progress.Base
 
 namespace Primitives
 
-open Result Error
+open Result Error core.ops.range
 
 def Array (α : Type u) (n : Usize) := { l : List α // l.length = n.val }
 
@@ -406,7 +406,7 @@ structure core.slice.index.private_slice_index.Sealed (Self : Type) where
 
 /- Trait declaration: [core::slice::index::SliceIndex] -/
 structure core.slice.index.SliceIndex (Self T0 : Type) where
-  sealedInst :core.slice.index.private_slice_index.Sealed Self
+  sealedInst : core.slice.index.private_slice_index.Sealed Self
   Output : Type
   get : Self → T0 → Result (Option Output)
   get_mut : Self → T0 → Result (Option Output)
@@ -557,4 +557,61 @@ def core.array.Array.coreopsindexIndexMutInst (T0 I : Type) (N : Usize)
   index_mut_back := core.array.Array.index_mut_back T0 I N inst
 }
 
+/- [core::slice::index::usize::get]: forward function -/
+def core.slice.index.Usize.get
+  (T : Type) : Usize → Slice T → Result (Option T) :=
+  sorry -- TODO
+
+/- [core::slice::index::usize::get_mut]: forward function -/
+def core.slice.index.Usize.get_mut
+  (T : Type) : Usize → Slice T → Result (Option T) :=
+  sorry -- TODO
+
+/- [core::slice::index::usize::get_mut]: backward function 0 -/
+def core.slice.index.Usize.get_mut_back
+  (T : Type) : Usize → Slice T → Option T → Result (Slice T) :=
+  sorry -- TODO
+
+/- [core::slice::index::usize::get_unchecked]: forward function -/
+def core.slice.index.Usize.get_unchecked
+  (T : Type) : Usize → ConstRawPtr (Slice T) → Result (ConstRawPtr T) :=
+  sorry -- TODO
+
+/- [core::slice::index::usize::get_unchecked_mut]: forward function -/
+def core.slice.index.Usize.get_unchecked_mut
+  (T : Type) : Usize → MutRawPtr (Slice T) → Result (MutRawPtr T) :=
+  sorry -- TODO
+
+/- [core::slice::index::usize::index]: forward function -/
+def core.slice.index.Usize.index (T : Type) : Usize → Slice T → Result T :=
+  sorry -- TODO
+
+/- [core::slice::index::usize::index_mut]: forward function -/
+def core.slice.index.Usize.index_mut (T : Type) : Usize → Slice T → Result T :=
+  sorry -- TODO
+
+/- [core::slice::index::usize::index_mut]: backward function 0 -/
+def core.slice.index.Usize.index_mut_back
+  (T : Type) : Usize → Slice T → T → Result (Slice T) :=
+  sorry -- TODO
+
+/- Trait implementation: [core::slice::index::private_slice_index::usize] -/
+def core.slice.index.private_slice_index.usize.coresliceindexprivate_slice_indexSealedInst
+  : core.slice.index.private_slice_index.Sealed Usize := {}
+
+/- Trait implementation: [core::slice::index::usize] -/
+def core.slice.index.usize.coresliceindexSliceIndexInst (T : Type) :
+  core.slice.index.SliceIndex Usize (Slice T) := {
+  sealedInst := core.slice.index.private_slice_index.usize.coresliceindexprivate_slice_indexSealedInst
+  Output := T
+  get := core.slice.index.Usize.get T
+  get_mut := core.slice.index.Usize.get_mut T
+  get_mut_back := core.slice.index.Usize.get_mut_back T
+  get_unchecked := core.slice.index.Usize.get_unchecked T
+  get_unchecked_mut := core.slice.index.Usize.get_unchecked_mut T
+  index := core.slice.index.Usize.index T
+  index_mut := core.slice.index.Usize.index_mut T
+  index_mut_back := core.slice.index.Usize.index_mut_back T
+}
+
 end Primitives
diff --git a/backends/lean/Base/Primitives/Range.lean b/backends/lean/Base/Primitives/Range.lean
index 26cbee42..a268bcba 100644
--- a/backends/lean/Base/Primitives/Range.lean
+++ b/backends/lean/Base/Primitives/Range.lean
@@ -11,7 +11,7 @@ import Base.Progress.Base
 
 namespace Primitives
 
-structure Range (α : Type u) where
+structure core.ops.range.Range (α : Type u) where
   mk ::
   start: α
   end_: α
diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean
index 99fcedc6..e1b7e87b 100644
--- a/backends/lean/Base/Primitives/Vec.lean
+++ b/backends/lean/Base/Primitives/Vec.lean
@@ -14,6 +14,8 @@ namespace Primitives
 
 open Result Error
 
+namespace alloc.vec
+
 def Vec (α : Type u) := { l : List α // l.length ≤ Usize.max }
 
 instance (a : Type u) : Arith.HasIntProp (Vec a) where
@@ -79,7 +81,7 @@ theorem Vec.insert_spec {α : Type u} (v: Vec α) (i: Usize) (x: α)
   ∃ nv, v.insert α i x = ret nv ∧ nv.val = v.val.update i.val x := by
   simp [insert, *]
 
-def Vec.index_shared (α : Type u) (v: Vec α) (i: Usize) : Result α :=
+def Vec.index_usize (α : Type u) (v: Vec α) (i: Usize) : Result α :=
   match v.val.indexOpt i.val with
   | none => fail .arrayOutOfBounds
   | some x => ret x
@@ -90,51 +92,65 @@ def Vec.index_shared (α : Type u) (v: Vec α) (i: Usize) : Result α :=
  -/
 
 @[pspec]
-theorem Vec.index_shared_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize)
+theorem Vec.index_usize_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize)
   (hbound : i.val < v.length) :
-  ∃ x, v.index_shared α i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_shared]
+  ∃ x, v.index_usize α i = ret x ∧ x = v.val.index i.val := by
+  simp only [index_usize]
   -- TODO: dependent rewrite
   have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
   simp [*]
 
--- This shouldn't be used
-def Vec.index_back (α : Type u) (v: Vec α) (i: Usize) (_: α) : Result Unit :=
-  if i.val < List.length v.val then
-    .ret ()
-  else
-    .fail arrayOutOfBounds
-
-def Vec.index_mut (α : Type u) (v: Vec α) (i: Usize) : Result α :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some x => ret x
-
-@[pspec]
-theorem Vec.index_mut_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize)
-  (hbound : i.val < v.length) :
-  ∃ x, v.index_mut α i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_mut]
-  -- TODO: dependent rewrite
-  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
-  simp [*]
-
-def Vec.index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α) : Result (Vec α) :=
+def Vec.update_usize (α : Type u) (v: Vec α) (i: Usize) (x: α) : Result (Vec α) :=
   match v.val.indexOpt i.val with
   | none => fail .arrayOutOfBounds
   | some _ =>
     .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩
 
 @[pspec]
-theorem Vec.index_mut_back_spec {α : Type u} (v: Vec α) (i: Usize) (x : α)
+theorem Vec.update_usize_spec {α : Type u} (v: Vec α) (i: Usize) (x : α)
   (hbound : i.val < v.length) :
-  ∃ nv, v.index_mut_back α i x = ret nv ∧
+  ∃ nv, v.update_usize α i x = ret nv ∧
   nv.val = v.val.update i.val x
   := by
-  simp only [index_mut_back]
+  simp only [update_usize]
   have h := List.indexOpt_bounds v.val i.val
   split
   . simp_all [length]; cases h <;> scalar_tac
   . simp_all
 
+/- [alloc::vec::Vec::index]: forward function -/
+def Vec.index (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T))
+  (self : Vec T) (i : I) : Result inst.Output :=
+  sorry -- TODO
+
+/- [alloc::vec::Vec::index_mut]: forward function -/
+def Vec.index_mut (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T))
+  (self : Vec T) (i : I) : Result inst.Output :=
+  sorry -- TODO
+
+/- [alloc::vec::Vec::index_mut]: backward function 0 -/
+def Vec.index_mut_back
+  (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T))
+  (self : Vec T) (i : I) (x : inst.Output) : Result (alloc.vec.Vec T) :=
+  sorry -- TODO
+
+/- Trait implementation: [alloc::vec::Vec] -/
+def Vec.coreopsindexIndexInst (T I : Type)
+  (inst : core.slice.index.SliceIndex I (Slice T)) :
+  core.ops.index.Index (alloc.vec.Vec T) I := {
+  Output := inst.Output
+  index := Vec.index T I inst
+}
+
+/- Trait implementation: [alloc::vec::Vec] -/
+def Vec.coreopsindexIndexMutInst (T I : Type)
+  (inst : core.slice.index.SliceIndex I (Slice T)) :
+  core.ops.index.IndexMut (alloc.vec.Vec T) I := {
+  indexInst := Vec.coreopsindexIndexInst T I inst
+  index_mut := Vec.index_mut T I inst
+  index_mut_back := Vec.index_mut_back T I inst
+}
+
+end alloc.vec
+
 end Primitives
diff --git a/backends/lean/Base/Progress/Progress.lean b/backends/lean/Base/Progress/Progress.lean
index ecf05dab..24c6f912 100644
--- a/backends/lean/Base/Progress/Progress.lean
+++ b/backends/lean/Base/Progress/Progress.lean
@@ -383,6 +383,7 @@ namespace Test
   -- #eval showStoredPSpec
   -- #eval showStoredPSpecClass
   -- #eval showStoredPSpecExprClass
+  open alloc.vec
 
   example {ty} {x y : Scalar ty}
     (hmin : Scalar.min ty ≤ x.val + y.val)
@@ -408,7 +409,7 @@ namespace Test
      `α : Type u` where u is quantified, while here we use `α : Type 0` -/
   example {α : Type} (v: Vec α) (i: Usize) (x : α)
     (hbounds : i.val < v.length) :
-    ∃ nv, v.index_mut_back α i x = ret nv ∧
+    ∃ nv, v.update_usize α i x = ret nv ∧
     nv.val = v.val.update i.val x := by
     progress
     simp [*]
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 6b6a2686..caa4835f 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -7,2370 +7,8 @@ open Pure
 open PureUtils
 open TranslateCore
 open ExtractBase
-open StringUtils
 open Config
-module F = Format
-
-(** Small helper to compute the name of an int type *)
-let int_name (int_ty : integer_type) =
-  let isize, usize, i_format, u_format =
-    match !backend with
-    | FStar | Coq | HOL4 ->
-        ("isize", "usize", format_of_string "i%d", format_of_string "u%d")
-    | Lean -> ("Isize", "Usize", format_of_string "I%d", format_of_string "U%d")
-  in
-  match int_ty with
-  | Isize -> isize
-  | I8 -> Printf.sprintf i_format 8
-  | I16 -> Printf.sprintf i_format 16
-  | I32 -> Printf.sprintf i_format 32
-  | I64 -> Printf.sprintf i_format 64
-  | I128 -> Printf.sprintf i_format 128
-  | Usize -> usize
-  | U8 -> Printf.sprintf u_format 8
-  | U16 -> Printf.sprintf u_format 16
-  | U32 -> Printf.sprintf u_format 32
-  | U64 -> Printf.sprintf u_format 64
-  | U128 -> Printf.sprintf u_format 128
-
-(** Small helper to compute the name of a unary operation *)
-let unop_name (unop : unop) : string =
-  match unop with
-  | Not -> (
-      match !backend with FStar | Lean -> "not" | Coq -> "negb" | HOL4 -> "~")
-  | Neg (int_ty : integer_type) -> (
-      match !backend with Lean -> "-" | _ -> int_name int_ty ^ "_neg")
-  | Cast _ ->
-      (* We never directly use the unop name in this case *)
-      raise (Failure "Unsupported")
-
-(** Small helper to compute the name of a binary operation (note that many
-    binary operations like "less than" are extracted to primitive operations,
-    like [<]).
- *)
-let named_binop_name (binop : E.binop) (int_ty : integer_type) : string =
-  let binop =
-    match binop with
-    | Div -> "div"
-    | Rem -> "rem"
-    | Add -> "add"
-    | Sub -> "sub"
-    | Mul -> "mul"
-    | Lt -> "lt"
-    | Le -> "le"
-    | Ge -> "ge"
-    | Gt -> "gt"
-    | BitXor -> "xor"
-    | BitAnd -> "and"
-    | BitOr -> "or"
-    | Shl -> "lsl"
-    | Shr ->
-        "asr"
-        (* NOTE: make sure arithmetic shift right is implemented, i.e. OCaml's asr operator, not lsr *)
-    | _ -> raise (Failure "Unreachable")
-  in
-  (* Remark: the Lean case is actually not used *)
-  match !backend with
-  | Lean -> int_name int_ty ^ "." ^ binop
-  | FStar | Coq | HOL4 -> int_name int_ty ^ "_" ^ binop
-
-(** A list of keywords/identifiers used by the backend and with which we
-    want to check collision.
-
-    Remark: this is useful mostly to look for collisions when generating
-    names for *variables*.
- *)
-let keywords () =
-  let named_unops =
-    unop_name Not
-    :: List.map (fun it -> unop_name (Neg it)) T.all_signed_int_types
-  in
-  let named_binops = [ E.Div; Rem; Add; Sub; Mul ] in
-  let named_binops =
-    List.concat_map
-      (fun bn -> List.map (fun it -> named_binop_name bn it) T.all_int_types)
-      named_binops
-  in
-  let misc =
-    match !backend with
-    | FStar ->
-        [
-          "assert";
-          "assert_norm";
-          "assume";
-          "else";
-          "fun";
-          "fn";
-          "FStar";
-          "FStar.Mul";
-          "if";
-          "in";
-          "include";
-          "int";
-          "let";
-          "list";
-          "match";
-          "not";
-          "open";
-          "rec";
-          "scalar_cast";
-          "then";
-          "type";
-          "Type0";
-          "Type";
-          "unit";
-          "val";
-          "with";
-        ]
-    | Coq ->
-        [
-          "assert";
-          "Arguments";
-          "Axiom";
-          "char_of_byte";
-          "Check";
-          "Declare";
-          "Definition";
-          "else";
-          "End";
-          "fun";
-          "Fixpoint";
-          "if";
-          "in";
-          "int";
-          "Inductive";
-          "Import";
-          "let";
-          "Lemma";
-          "match";
-          "Module";
-          "not";
-          "Notation";
-          "Proof";
-          "Qed";
-          "rec";
-          "Record";
-          "Require";
-          "Scope";
-          "Search";
-          "SearchPattern";
-          "Set";
-          "then";
-          (* [tt] is unit *)
-          "tt";
-          "type";
-          "Type";
-          "unit";
-          "with";
-        ]
-    | Lean ->
-        [
-          "by";
-          "class";
-          "decreasing_by";
-          "def";
-          "deriving";
-          "do";
-          "else";
-          "end";
-          "for";
-          "have";
-          "if";
-          "inductive";
-          "instance";
-          "import";
-          "let";
-          "macro";
-          "match";
-          "namespace";
-          "opaque";
-          "open";
-          "run_cmd";
-          "set_option";
-          "simp";
-          "structure";
-          "syntax";
-          "termination_by";
-          "then";
-          "Type";
-          "unsafe";
-          "where";
-          "with";
-          "opaque_defs";
-        ]
-    | HOL4 ->
-        [
-          "Axiom";
-          "case";
-          "Definition";
-          "else";
-          "End";
-          "fix";
-          "fix_exec";
-          "fn";
-          "fun";
-          "if";
-          "in";
-          "int";
-          "Inductive";
-          "let";
-          "of";
-          "Proof";
-          "QED";
-          "then";
-          "Theorem";
-        ]
-  in
-  List.concat [ named_unops; named_binops; misc ]
-
-let assumed_adts () : (assumed_ty * string) list =
-  match !backend with
-  | Lean ->
-      [
-        (State, "State");
-        (Result, "Result");
-        (Error, "Error");
-        (Fuel, "Nat");
-        (Array, "Array");
-        (Slice, "Slice");
-        (Str, "Str");
-        (RawPtr Mut, "MutRawPtr");
-        (RawPtr Const, "ConstRawPtr");
-      ]
-  | Coq | FStar | HOL4 ->
-      [
-        (State, "state");
-        (Result, "result");
-        (Error, "error");
-        (Fuel, if !backend = HOL4 then "num" else "nat");
-        (Array, "array");
-        (Slice, "slice");
-        (Str, "str");
-        (RawPtr Mut, "mut_raw_ptr");
-        (RawPtr Const, "const_raw_ptr");
-      ]
-
-let assumed_struct_constructors () : (assumed_ty * string) list =
-  match !backend with
-  | Lean -> [ (Array, "Array.make") ]
-  | Coq -> [ (Array, "mk_array") ]
-  | FStar -> [ (Array, "mk_array") ]
-  | HOL4 -> [ (Array, "mk_array") ]
-
-let assumed_variants () : (assumed_ty * VariantId.id * string) list =
-  match !backend with
-  | FStar ->
-      [
-        (Result, result_return_id, "Return");
-        (Result, result_fail_id, "Fail");
-        (Error, error_failure_id, "Failure");
-        (Error, error_out_of_fuel_id, "OutOfFuel");
-        (* No Fuel::Zero on purpose *)
-        (* No Fuel::Succ on purpose *)
-      ]
-  | Coq ->
-      [
-        (Result, result_return_id, "Return");
-        (Result, result_fail_id, "Fail_");
-        (Error, error_failure_id, "Failure");
-        (Error, error_out_of_fuel_id, "OutOfFuel");
-        (Fuel, fuel_zero_id, "O");
-        (Fuel, fuel_succ_id, "S");
-      ]
-  | Lean ->
-      [
-        (Result, result_return_id, "ret");
-        (Result, result_fail_id, "fail");
-        (Error, error_failure_id, "panic");
-        (* No Fuel::Zero on purpose *)
-        (* No Fuel::Succ on purpose *)
-      ]
-  | HOL4 ->
-      [
-        (Result, result_return_id, "Return");
-        (Result, result_fail_id, "Fail");
-        (Error, error_failure_id, "Failure");
-        (* No Fuel::Zero on purpose *)
-        (* No Fuel::Succ on purpose *)
-      ]
-
-let assumed_llbc_functions () :
-    (A.assumed_fun_id * T.RegionGroupId.id option * string) list =
-  let rg0 = Some T.RegionGroupId.zero in
-  match !backend with
-  | FStar | Coq | HOL4 ->
-      [
-        (ArrayIndexShared, None, "array_index_shared");
-        (ArrayIndexMut, None, "array_index_mut_fwd");
-        (ArrayIndexMut, rg0, "array_index_mut_back");
-        (ArrayToSliceShared, None, "array_to_slice_shared");
-        (ArrayToSliceMut, None, "array_to_slice_mut_fwd");
-        (ArrayToSliceMut, rg0, "array_to_slice_mut_back");
-        (ArrayRepeat, None, "array_repeat");
-        (SliceIndexShared, None, "slice_index_shared");
-        (SliceIndexMut, None, "slice_index_mut_fwd");
-        (SliceIndexMut, rg0, "slice_index_mut_back");
-        (SliceLen, None, "slice_len");
-      ]
-  | Lean ->
-      [
-        (ArrayIndexShared, None, "Array.index_shared");
-        (ArrayIndexMut, None, "Array.index_mut");
-        (ArrayIndexMut, rg0, "Array.index_mut_back");
-        (ArrayToSliceShared, None, "Array.to_slice_shared");
-        (ArrayToSliceMut, None, "Array.to_slice_mut");
-        (ArrayToSliceMut, rg0, "Array.to_slice_mut_back");
-        (ArrayRepeat, None, "Array.repeat");
-        (SliceIndexShared, None, "Slice.index_shared");
-        (SliceIndexMut, None, "Slice.index_mut");
-        (SliceIndexMut, rg0, "Slice.index_mut_back");
-        (SliceLen, None, "Slice.len");
-      ]
-
-let assumed_pure_functions () : (pure_assumed_fun_id * string) list =
-  match !backend with
-  | FStar ->
-      [
-        (Return, "return");
-        (Fail, "fail");
-        (Assert, "massert");
-        (FuelDecrease, "decrease");
-        (FuelEqZero, "is_zero");
-      ]
-  | Coq ->
-      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
-      [ (Return, "return_"); (Fail, "fail_"); (Assert, "massert") ]
-  | Lean ->
-      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
-      [ (Return, "return"); (Fail, "fail_"); (Assert, "massert") ]
-  | HOL4 ->
-      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
-      [ (Return, "return"); (Fail, "fail"); (Assert, "massert") ]
-
-let names_map_init () : names_map_init =
-  {
-    keywords = keywords ();
-    assumed_adts = assumed_adts ();
-    assumed_structs = assumed_struct_constructors ();
-    assumed_variants = assumed_variants ();
-    assumed_llbc_functions = assumed_llbc_functions ();
-    assumed_pure_functions = assumed_pure_functions ();
-  }
-
-let extract_unop (extract_expr : bool -> texpression -> unit)
-    (fmt : F.formatter) (inside : bool) (unop : unop) (arg : texpression) : unit
-    =
-  match unop with
-  | Not | Neg _ ->
-      let unop = unop_name unop in
-      if inside then F.pp_print_string fmt "(";
-      F.pp_print_string fmt unop;
-      F.pp_print_space fmt ();
-      extract_expr true arg;
-      if inside then F.pp_print_string fmt ")"
-  | Cast (src, tgt) -> (
-      (* HOL4 has a special treatment: because it doesn't support dependent
-         types, we don't have a specific operator for the cast *)
-      match !backend with
-      | HOL4 ->
-          (* Casting, say, an u32 to an i32 would be done as follows:
-             {[
-               mk_i32 (u32_to_int x)
-             ]}
-          *)
-          if inside then F.pp_print_string fmt "(";
-          F.pp_print_string fmt ("mk_" ^ int_name tgt);
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "(";
-          F.pp_print_string fmt (int_name src ^ "_to_int");
-          F.pp_print_space fmt ();
-          extract_expr true arg;
-          F.pp_print_string fmt ")";
-          if inside then F.pp_print_string fmt ")"
-      | FStar | Coq | Lean ->
-          (* Rem.: the source type is an implicit parameter *)
-          if inside then F.pp_print_string fmt "(";
-          let cast_str =
-            match !backend with
-            | Coq | FStar -> "scalar_cast"
-            | Lean -> (* TODO: I8.cast, I16.cast, etc.*) "Scalar.cast"
-            | HOL4 -> raise (Failure "Unreachable")
-          in
-          F.pp_print_string fmt cast_str;
-          F.pp_print_space fmt ();
-          if !backend <> Lean then (
-            F.pp_print_string fmt
-              (StringUtils.capitalize_first_letter
-                 (PrintPure.integer_type_to_string src));
-            F.pp_print_space fmt ());
-          if !backend = Lean then F.pp_print_string fmt ("." ^ int_name tgt)
-          else
-            F.pp_print_string fmt
-              (StringUtils.capitalize_first_letter
-                 (PrintPure.integer_type_to_string tgt));
-          F.pp_print_space fmt ();
-          extract_expr true arg;
-          if inside then F.pp_print_string fmt ")")
-
-(** [extract_expr] : the boolean argument is [inside] *)
-let extract_binop (extract_expr : bool -> texpression -> unit)
-    (fmt : F.formatter) (inside : bool) (binop : E.binop)
-    (int_ty : integer_type) (arg0 : texpression) (arg1 : texpression) : unit =
-  if inside then F.pp_print_string fmt "(";
-  (* Some binary operations have a special notation depending on the backend *)
-  (match (!backend, binop) with
-  | HOL4, (Eq | Ne)
-  | (FStar | Coq | Lean), (Eq | Lt | Le | Ne | Ge | Gt)
-  | Lean, (Div | Rem | Add | Sub | Mul) ->
-      let binop =
-        match binop with
-        | Eq -> "="
-        | Lt -> "<"
-        | Le -> "<="
-        | Ne -> if !backend = Lean then "!=" else "<>"
-        | Ge -> ">="
-        | Gt -> ">"
-        | Div -> "/"
-        | Rem -> "%"
-        | Add -> "+"
-        | Sub -> "-"
-        | Mul -> "*"
-        | _ -> raise (Failure "Unreachable")
-      in
-      let binop =
-        match !backend with FStar | Lean | HOL4 -> binop | Coq -> "s" ^ binop
-      in
-      extract_expr false arg0;
-      F.pp_print_space fmt ();
-      F.pp_print_string fmt binop;
-      F.pp_print_space fmt ();
-      extract_expr false arg1
-  | _ ->
-      let binop = named_binop_name binop int_ty in
-      F.pp_print_string fmt binop;
-      F.pp_print_space fmt ();
-      extract_expr true arg0;
-      F.pp_print_space fmt ();
-      extract_expr true arg1);
-  if inside then F.pp_print_string fmt ")"
-
-let type_decl_kind_to_qualif (kind : decl_kind)
-    (type_kind : type_decl_kind option) : string option =
-  match !backend with
-  | FStar -> (
-      match kind with
-      | SingleNonRec -> Some "type"
-      | SingleRec -> Some "type"
-      | MutRecFirst -> Some "type"
-      | MutRecInner -> Some "and"
-      | MutRecLast -> Some "and"
-      | Assumed -> Some "assume type"
-      | Declared -> Some "val")
-  | Coq -> (
-      match (kind, type_kind) with
-      | SingleNonRec, Some Enum -> Some "Inductive"
-      | SingleNonRec, Some Struct -> Some "Record"
-      | (SingleRec | MutRecFirst), Some _ -> Some "Inductive"
-      | (MutRecInner | MutRecLast), Some _ ->
-          (* Coq doesn't support groups of mutually recursive definitions which mix
-           * records and inducties: we convert everything to records if this happens
-           *)
-          Some "with"
-      | (Assumed | Declared), None -> Some "Axiom"
-      | SingleNonRec, None ->
-          (* This is for traits *)
-          Some "Record"
-      | _ ->
-          raise
-            (Failure
-               ("Unexpected: (" ^ show_decl_kind kind ^ ", "
-               ^ Print.option_to_string show_type_decl_kind type_kind
-               ^ ")")))
-  | Lean -> (
-      match kind with
-      | SingleNonRec ->
-          if type_kind = Some Struct then Some "structure" else Some "inductive"
-      | SingleRec -> Some "inductive"
-      | MutRecFirst -> Some "inductive"
-      | MutRecInner -> Some "inductive"
-      | MutRecLast -> Some "inductive"
-      | Assumed -> Some "axiom"
-      | Declared -> Some "axiom")
-  | HOL4 -> None
-
-let fun_decl_kind_to_qualif (kind : decl_kind) : string option =
-  match !backend with
-  | FStar -> (
-      match kind with
-      | SingleNonRec -> Some "let"
-      | SingleRec -> Some "let rec"
-      | MutRecFirst -> Some "let rec"
-      | MutRecInner -> Some "and"
-      | MutRecLast -> Some "and"
-      | Assumed -> Some "assume val"
-      | Declared -> Some "val")
-  | Coq -> (
-      match kind with
-      | SingleNonRec -> Some "Definition"
-      | SingleRec -> Some "Fixpoint"
-      | MutRecFirst -> Some "Fixpoint"
-      | MutRecInner -> Some "with"
-      | MutRecLast -> Some "with"
-      | Assumed -> Some "Axiom"
-      | Declared -> Some "Axiom")
-  | Lean -> (
-      match kind with
-      | SingleNonRec -> Some "def"
-      | SingleRec -> Some "divergent def"
-      | MutRecFirst -> Some "mutual divergent def"
-      | MutRecInner -> Some "divergent def"
-      | MutRecLast -> Some "divergent def"
-      | Assumed -> Some "axiom"
-      | Declared -> Some "axiom")
-  | HOL4 -> None
-
-(** The type of types.
-
-    TODO: move inside the formatter?
- *)
-let type_keyword () =
-  match !backend with
-  | FStar -> "Type0"
-  | Coq | Lean -> "Type"
-  | HOL4 -> raise (Failure "Unexpected")
-
-(**
-   [ctx]: we use the context to lookup type definitions, to retrieve type names.
-   This is used to compute variable names, when they have no basenames: in this
-   case we use the first letter of the type name.
-
-   [variant_concatenate_type_name]: if true, add the type name as a prefix
-   to the variant names.
-   Ex.:
-   In Rust:
-     {[
-       enum List = {
-         Cons(u32, Box<List>),x
-         Nil,
-       }
-     ]}
-
-   F*, if option activated:
-     {[
-       type list =
-       | ListCons : u32 -> list -> list
-       | ListNil : list
-     ]}
-
-   F*, if option not activated:
-     {[
-       type list =
-       | Cons : u32 -> list -> list
-       | Nil : list
-     ]}
-
-   Rk.: this should be true by default, because in Rust all the variant names
-   are actively uniquely identifier by the type name [List::Cons(...)], while
-   in other languages it is not necessarily the case, and thus clashes can mess
-   up type checking. Note that some languages actually forbids the name clashes
-   (it is the case of F* ).
- *)
-let mk_formatter (ctx : trans_ctx) (crate_name : string)
-    (variant_concatenate_type_name : bool) : formatter =
-  let int_name = int_name in
-
-  (* Prepare a name.
-   * The first id elem is always the crate: if it is the local crate,
-   * we remove it.
-   * We also remove all the disambiguators, then convert everything to strings.
-   * **Rmk:** because we remove the disambiguators, there may be name collisions
-   * (which is ok, because we check for name collisions and fail if there is any).
-   *)
-  let get_name (name : name) : string list =
-    (* Rmk.: initially we only filtered the disambiguators equal to 0 *)
-    let name = Names.filter_disambiguators name in
-    match name with
-    | Ident crate :: name ->
-        let name = if crate = crate_name then name else Ident crate :: name in
-        let name =
-          List.map
-            (function
-              | Names.Ident s -> s
-              | Disambiguator d -> Names.Disambiguator.to_string d)
-            name
-        in
-        name
-    | _ ->
-        raise (Failure ("Unexpected name shape: " ^ Print.name_to_string name))
-  in
-  let flatten_name (name : string list) : string =
-    match !backend with
-    | FStar | Coq | HOL4 -> String.concat "_" name
-    | Lean -> String.concat "." name
-  in
-  let get_type_name = get_name in
-  let type_name_to_camel_case name =
-    let name = get_type_name name in
-    let name = List.map to_camel_case name in
-    String.concat "" name
-  in
-  let type_name_to_snake_case name =
-    let name = get_type_name name in
-    let name = List.map to_snake_case name in
-    let name = String.concat "_" name in
-    match !backend with
-    | FStar | Lean | HOL4 -> name
-    | Coq -> capitalize_first_letter name
-  in
-  let type_name name =
-    match !backend with
-    | FStar | Coq | HOL4 -> type_name_to_snake_case name ^ "_t"
-    | Lean -> String.concat "." (get_type_name name)
-  in
-  let field_name (def_name : name) (field_id : FieldId.id)
-      (field_name : string option) : string =
-    let field_name_s =
-      match field_name with
-      | Some field_name -> field_name
-      | None ->
-          (* TODO: extract structs with no field names to tuples *)
-          FieldId.to_string field_id
-    in
-    if !Config.record_fields_short_names then
-      if field_name = None then (* TODO: this is a bit ugly *)
-        "_" ^ field_name_s
-      else field_name_s
-    else
-      let def_name = type_name_to_snake_case def_name ^ "_" in
-      def_name ^ field_name_s
-  in
-  let variant_name (def_name : name) (variant : string) : string =
-    match !backend with
-    | FStar | Coq | HOL4 ->
-        let variant = to_camel_case variant in
-        if variant_concatenate_type_name then
-          type_name_to_camel_case def_name ^ variant
-        else variant
-    | Lean -> variant
-  in
-  let struct_constructor (basename : name) : string =
-    let tname = type_name basename in
-    let prefix =
-      match !backend with FStar -> "Mk" | Coq | HOL4 -> "mk" | Lean -> ""
-    in
-    let suffix =
-      match !backend with FStar | Coq | HOL4 -> "" | Lean -> ".mk"
-    in
-    prefix ^ tname ^ suffix
-  in
-  let get_fun_name fname =
-    let fname = get_name fname in
-    (* TODO: don't convert to snake case for Coq, HOL4, F* *)
-    flatten_name fname
-  in
-  let global_name (name : global_name) : string =
-    (* Converting to snake case also lowercases the letters (in Rust, global
-     * names are written in capital letters). *)
-    let parts = List.map to_snake_case (get_name name) in
-    String.concat "_" parts
-  in
-  let fun_name (fname : fun_name) (num_loops : int) (loop_id : LoopId.id option)
-      (num_rgs : int) (rg : region_group_info option) (filter_info : bool * int)
-      : string =
-    let fname = get_fun_name fname in
-    (* Compute the suffix *)
-    let suffix = default_fun_suffix num_loops loop_id num_rgs rg filter_info in
-    (* Concatenate *)
-    fname ^ suffix
-  in
-
-  let trait_decl_name (trait_decl : trait_decl) : string =
-    type_name trait_decl.name
-  in
-
-  let trait_impl_name (trait_decl : trait_decl) (trait_impl : trait_impl) :
-      string =
-    (* TODO: provisional: we concatenate the trait impl name (which is its type)
-       with the trait decl name *)
-    let trait_decl =
-      let name = trait_decl.name in
-      match !backend with
-      | FStar | Coq | HOL4 -> type_name_to_snake_case name ^ "_inst"
-      | Lean -> String.concat "" (get_type_name name) ^ "Inst"
-    in
-    flatten_name (get_type_name trait_impl.name @ [ trait_decl ])
-  in
-
-  let trait_parent_clause_name (trait_decl : trait_decl) (clause : trait_clause)
-      : string =
-    (* TODO: improve - it would be better to not use indices *)
-    let clause = "parent_clause_" ^ TraitClauseId.to_string clause.clause_id in
-    if !Config.record_fields_short_names then clause
-    else trait_decl_name trait_decl ^ "_" ^ clause
-  in
-  let trait_type_name (trait_decl : trait_decl) (item : string) : string =
-    if !Config.record_fields_short_names then item
-    else trait_decl_name trait_decl ^ "_" ^ item
-  in
-  let trait_const_name (trait_decl : trait_decl) (item : string) : string =
-    if !Config.record_fields_short_names then item
-    else trait_decl_name trait_decl ^ "_" ^ item
-  in
-  let trait_method_name (trait_decl : trait_decl) (item : string) : string =
-    if !Config.record_fields_short_names then item
-    else trait_decl_name trait_decl ^ "_" ^ item
-  in
-  let trait_type_clause_name (trait_decl : trait_decl) (item : string)
-      (clause : trait_clause) : string =
-    (* TODO: improve - it would be better to not use indices *)
-    trait_type_name trait_decl item
-    ^ "_clause_"
-    ^ TraitClauseId.to_string clause.clause_id
-  in
-
-  let termination_measure_name (_fid : A.FunDeclId.id) (fname : fun_name)
-      (num_loops : int) (loop_id : LoopId.id option) : string =
-    let fname = get_fun_name fname in
-    let lp_suffix = default_fun_loop_suffix num_loops loop_id in
-    (* Compute the suffix *)
-    let suffix =
-      match !Config.backend with
-      | FStar -> "_decreases"
-      | Lean -> "_terminates"
-      | Coq | HOL4 -> raise (Failure "Unexpected")
-    in
-    (* Concatenate *)
-    fname ^ lp_suffix ^ suffix
-  in
-
-  let decreases_proof_name (_fid : A.FunDeclId.id) (fname : fun_name)
-      (num_loops : int) (loop_id : LoopId.id option) : string =
-    let fname = get_fun_name fname in
-    let lp_suffix = default_fun_loop_suffix num_loops loop_id in
-    (* Compute the suffix *)
-    let suffix =
-      match !Config.backend with
-      | Lean -> "_decreases"
-      | FStar | Coq | HOL4 -> raise (Failure "Unexpected")
-    in
-    (* Concatenate *)
-    fname ^ lp_suffix ^ suffix
-  in
-
-  let var_basename (_varset : StringSet.t) (basename : string option) (ty : ty)
-      : string =
-    (* Small helper to derive var names from ADT type names.
-
-       We do the following:
-       - convert the type name to snake case
-       - take the first letter of every "letter group"
-       Ex.: "HashMap" -> "hash_map" -> "hm"
-    *)
-    let name_from_type_ident (name : string) : string =
-      let cl = to_snake_case name in
-      let cl = String.split_on_char '_' cl in
-      let cl = List.filter (fun s -> String.length s > 0) cl in
-      assert (List.length cl > 0);
-      let cl = List.map (fun s -> s.[0]) cl in
-      StringUtils.string_of_chars cl
-    in
-    (* If there is a basename, we use it *)
-    match basename with
-    | Some basename ->
-        (* This should be a no-op *)
-        to_snake_case basename
-    | None -> (
-        (* No basename: we use the first letter of the type *)
-        match ty with
-        | Adt (type_id, generics) -> (
-            match type_id with
-            | Tuple ->
-                (* The "pair" case is frequent enough to have its special treatment *)
-                if List.length generics.types = 2 then "p" else "t"
-            | Assumed Result -> "r"
-            | Assumed Error -> ConstStrings.error_basename
-            | Assumed Fuel -> ConstStrings.fuel_basename
-            | Assumed Array -> "a"
-            | Assumed Slice -> "s"
-            | Assumed Str -> "s"
-            | Assumed State -> ConstStrings.state_basename
-            | Assumed (RawPtr _) -> "p"
-            | AdtId adt_id ->
-                let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
-                (* Derive the var name from the last ident of the type name
-                 * Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm"
-                 *)
-                (* The name shouldn't be empty, and its last element should
-                 * be an ident *)
-                let cl = List.nth def.name (List.length def.name - 1) in
-                name_from_type_ident (Names.as_ident cl))
-        | TypeVar _ -> (
-            (* TODO: use "t" also for F* *)
-            match !backend with
-            | FStar -> "x" (* lacking inspiration here... *)
-            | Coq | Lean | HOL4 -> "t" (* lacking inspiration here... *))
-        | Literal lty -> (
-            match lty with Bool -> "b" | Char -> "c" | Integer _ -> "i")
-        | Arrow _ -> "f"
-        | TraitType (_, _, name) -> name_from_type_ident name)
-  in
-  let type_var_basename (_varset : StringSet.t) (basename : string) : string =
-    (* Rust type variables are snake-case and start with a capital letter *)
-    match !backend with
-    | FStar ->
-        (* This is *not* a no-op: this removes the capital letter *)
-        to_snake_case basename
-    | HOL4 ->
-        (* In HOL4, type variable names must start with "'" *)
-        "'" ^ to_snake_case basename
-    | Coq | Lean -> basename
-  in
-  let const_generic_var_basename (_varset : StringSet.t) (basename : string) :
-      string =
-    (* Rust type variables are snake-case and start with a capital letter *)
-    match !backend with
-    | FStar | HOL4 ->
-        (* This is *not* a no-op: this removes the capital letter *)
-        to_snake_case basename
-    | Coq | Lean -> basename
-  in
-  let trait_clause_basename (_varset : StringSet.t) (_clause : trait_clause) :
-      string =
-    (* TODO: actually use the clause to derive the name *)
-    "inst"
-  in
-  let trait_self_clause_basename = "self_clause" in
-  let append_index (basename : string) (i : int) : string =
-    basename ^ string_of_int i
-  in
-
-  let extract_literal (fmt : F.formatter) (inside : bool) (cv : literal) : unit
-      =
-    match cv with
-    | Scalar sv -> (
-        match !backend with
-        | FStar -> F.pp_print_string fmt (Z.to_string sv.PV.value)
-        | Coq | HOL4 | Lean ->
-            let print_brackets = inside && !backend = HOL4 in
-            if print_brackets then F.pp_print_string fmt "(";
-            (match !backend with
-            | Coq | Lean -> ()
-            | HOL4 ->
-                F.pp_print_string fmt ("int_to_" ^ int_name sv.PV.int_ty);
-                F.pp_print_space fmt ()
-            | _ -> raise (Failure "Unreachable"));
-            (* We need to add parentheses if the value is negative *)
-            if sv.PV.value >= Z.of_int 0 then
-              F.pp_print_string fmt (Z.to_string sv.PV.value)
-            else if !backend = Lean then
-              (* TODO: parsing issues with Lean because there are ambiguous
-                 interpretations between int values and nat values *)
-              F.pp_print_string fmt
-                ("(-(" ^ Z.to_string (Z.neg sv.PV.value) ^ ":Int))")
-            else F.pp_print_string fmt ("(" ^ Z.to_string sv.PV.value ^ ")");
-            (match !backend with
-            | Coq ->
-                let iname = int_name sv.PV.int_ty in
-                F.pp_print_string fmt ("%" ^ iname)
-            | Lean ->
-                let iname = String.lowercase_ascii (int_name sv.PV.int_ty) in
-                F.pp_print_string fmt ("#" ^ iname)
-            | HOL4 -> ()
-            | _ -> raise (Failure "Unreachable"));
-            if print_brackets then F.pp_print_string fmt ")")
-    | Bool b ->
-        let b =
-          match !backend with
-          | HOL4 -> if b then "T" else "F"
-          | Coq | FStar | Lean -> if b then "true" else "false"
-        in
-        F.pp_print_string fmt b
-    | Char c -> (
-        match !backend with
-        | HOL4 ->
-            (* [#"a"] is a notation for [CHR 97] (97 is the ASCII code for 'a') *)
-            F.pp_print_string fmt ("#\"" ^ String.make 1 c ^ "\"")
-        | FStar | Lean -> F.pp_print_string fmt ("'" ^ String.make 1 c ^ "'")
-        | Coq ->
-            if inside then F.pp_print_string fmt "(";
-            F.pp_print_string fmt "char_of_byte";
-            F.pp_print_space fmt ();
-            (* Convert the the char to ascii *)
-            let c =
-              let i = Char.code c in
-              let x0 = i / 16 in
-              let x1 = i mod 16 in
-              "Coq.Init.Byte.x" ^ string_of_int x0 ^ string_of_int x1
-            in
-            F.pp_print_string fmt c;
-            if inside then F.pp_print_string fmt ")")
-  in
-  let bool_name = if !backend = Lean then "Bool" else "bool" in
-  let char_name = if !backend = Lean then "Char" else "char" in
-  let str_name = if !backend = Lean then "String" else "string" in
-  {
-    bool_name;
-    char_name;
-    int_name;
-    str_name;
-    type_decl_kind_to_qualif;
-    fun_decl_kind_to_qualif;
-    field_name;
-    variant_name;
-    struct_constructor;
-    type_name;
-    global_name;
-    fun_name;
-    termination_measure_name;
-    decreases_proof_name;
-    trait_decl_name;
-    trait_impl_name;
-    trait_parent_clause_name;
-    trait_const_name;
-    trait_type_name;
-    trait_method_name;
-    trait_type_clause_name;
-    var_basename;
-    type_var_basename;
-    const_generic_var_basename;
-    trait_self_clause_basename;
-    trait_clause_basename;
-    append_index;
-    extract_literal;
-    extract_unop;
-    extract_binop;
-  }
-
-let mk_formatter_and_names_map (ctx : trans_ctx) (crate_name : string)
-    (variant_concatenate_type_name : bool) : formatter * names_map =
-  let fmt = mk_formatter ctx crate_name variant_concatenate_type_name in
-  let names_map = initialize_names_map fmt (names_map_init ()) in
-  (fmt, names_map)
-
-let is_single_opaque_fun_decl_group (dg : Pure.fun_decl list) : bool =
-  match dg with [ d ] -> d.body = None | _ -> false
-
-let is_single_opaque_type_decl_group (dg : Pure.type_decl list) : bool =
-  match dg with [ d ] -> d.kind = Opaque | _ -> false
-
-let is_empty_record_type_decl (d : Pure.type_decl) : bool = d.kind = Struct []
-
-let is_empty_record_type_decl_group (dg : Pure.type_decl list) : bool =
-  match dg with [ d ] -> is_empty_record_type_decl d | _ -> false
-
-(** In some provers, groups of definitions must be delimited.
-
-    - in Coq, *every* group (including singletons) must end with "."
-    - in Lean, groups of mutually recursive definitions must end with "end"
-    - in HOL4 (in most situations) the whole group must be within a `Define` command
-
-    Calls to {!extract_fun_decl} should be inserted between calls to
-    {!start_fun_decl_group} and {!end_fun_decl_group}.
-
-    TODO: maybe those [{start/end}_decl_group] functions are not that much a good
-    idea and we should merge them with the corresponding [extract_decl] functions.
- *)
-let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter)
-    (is_rec : bool) (dg : Pure.fun_decl list) =
-  match !backend with
-  | FStar | Coq | Lean -> ()
-  | HOL4 ->
-      (* In HOL4, opaque functions have a special treatment *)
-      if is_single_opaque_fun_decl_group dg then ()
-      else
-        let compute_fun_def_name (def : Pure.fun_decl) : string =
-          ctx_get_local_function def.def_id def.loop_id def.back_id ctx ^ "_def"
-        in
-        let names = List.map compute_fun_def_name dg in
-        (* Add a break before *)
-        F.pp_print_break fmt 0 0;
-        (* Open the box for the delimiters *)
-        F.pp_open_vbox fmt 0;
-        (* Open the box for the definitions themselves *)
-        F.pp_open_vbox fmt ctx.indent_incr;
-        (* Print the delimiters *)
-        if is_rec then
-          F.pp_print_string fmt
-            ("val [" ^ String.concat ", " names ^ "] = DefineDiv ‘")
-        else (
-          assert (List.length names = 1);
-          let name = List.hd names in
-          F.pp_print_string fmt ("val " ^ name ^ " = Define ‘"));
-        F.pp_print_cut fmt ()
-
-(** See {!start_fun_decl_group}. *)
-let end_fun_decl_group (fmt : F.formatter) (is_rec : bool)
-    (dg : Pure.fun_decl list) =
-  match !backend with
-  | FStar -> ()
-  | Coq ->
-      (* For aesthetic reasons, we print the Coq end group delimiter directly
-         in {!extract_fun_decl}. *)
-      ()
-  | Lean ->
-      (* We must add the "end" keyword to groups of mutually recursive functions *)
-      if is_rec && List.length dg > 1 then (
-        F.pp_print_cut fmt ();
-        F.pp_print_string fmt "end";
-        (* Add breaks to insert new lines between definitions *)
-        F.pp_print_break fmt 0 0)
-      else ()
-  | HOL4 ->
-      (* In HOL4, opaque functions have a special treatment *)
-      if is_single_opaque_fun_decl_group dg then ()
-      else (
-        (* Close the box for the definitions *)
-        F.pp_close_box fmt ();
-        (* Print the end delimiter *)
-        F.pp_print_cut fmt ();
-        F.pp_print_string fmt "’";
-        (* Close the box for the delimiters *)
-        F.pp_close_box fmt ();
-        (* Add breaks to insert new lines between definitions *)
-        F.pp_print_break fmt 0 0)
-
-(** See {!start_fun_decl_group}: similar usage, but for the type declarations. *)
-let start_type_decl_group (ctx : extraction_ctx) (fmt : F.formatter)
-    (is_rec : bool) (dg : Pure.type_decl list) =
-  match !backend with
-  | FStar | Coq -> ()
-  | Lean ->
-      if is_rec && List.length dg > 1 then (
-        F.pp_print_space fmt ();
-        F.pp_print_string fmt "mutual";
-        F.pp_print_space fmt ())
-  | HOL4 ->
-      (* In HOL4, opaque types and empty records have a special treatment *)
-      if
-        is_single_opaque_type_decl_group dg
-        || is_empty_record_type_decl_group dg
-      then ()
-      else (
-        (* Add a break before *)
-        F.pp_print_break fmt 0 0;
-        (* Open the box for the delimiters *)
-        F.pp_open_vbox fmt 0;
-        (* Open the box for the definitions themselves *)
-        F.pp_open_vbox fmt ctx.indent_incr;
-        (* Print the delimiters *)
-        F.pp_print_string fmt "Datatype:";
-        F.pp_print_cut fmt ())
-
-(** See {!start_fun_decl_group}. *)
-let end_type_decl_group (fmt : F.formatter) (is_rec : bool)
-    (dg : Pure.type_decl list) =
-  match !backend with
-  | FStar -> ()
-  | Coq ->
-      (* For aesthetic reasons, we print the Coq end group delimiter directly
-         in {!extract_fun_decl}. *)
-      ()
-  | Lean ->
-      (* We must add the "end" keyword to groups of mutually recursive functions *)
-      if is_rec && List.length dg > 1 then (
-        F.pp_print_cut fmt ();
-        F.pp_print_string fmt "end";
-        (* Add breaks to insert new lines between definitions *)
-        F.pp_print_break fmt 0 0)
-      else ()
-  | HOL4 ->
-      (* In HOL4, opaque types and empty records have a special treatment *)
-      if
-        is_single_opaque_type_decl_group dg
-        || is_empty_record_type_decl_group dg
-      then ()
-      else (
-        (* Close the box for the definitions *)
-        F.pp_close_box fmt ();
-        (* Print the end delimiter *)
-        F.pp_print_cut fmt ();
-        F.pp_print_string fmt "End";
-        (* Close the box for the delimiters *)
-        F.pp_close_box fmt ();
-        (* Add breaks to insert new lines between definitions *)
-        F.pp_print_break fmt 0 0)
-
-let unit_name () =
-  match !backend with Lean -> "Unit" | Coq | FStar | HOL4 -> "unit"
-
-(** Small helper *)
-let extract_arrow (fmt : F.formatter) () : unit =
-  if !Config.backend = Lean then F.pp_print_string fmt "→"
-  else F.pp_print_string fmt "->"
-
-let extract_const_generic (ctx : extraction_ctx) (fmt : F.formatter)
-    (inside : bool) (cg : const_generic) : unit =
-  match cg with
-  | ConstGenericGlobal id ->
-      let s = ctx_get_global id ctx in
-      F.pp_print_string fmt s
-  | ConstGenericValue v -> ctx.fmt.extract_literal fmt inside v
-  | ConstGenericVar id ->
-      let s = ctx_get_const_generic_var id ctx in
-      F.pp_print_string fmt s
-
-let extract_literal_type (ctx : extraction_ctx) (fmt : F.formatter)
-    (ty : literal_type) : unit =
-  match ty with
-  | Bool -> F.pp_print_string fmt ctx.fmt.bool_name
-  | Char -> F.pp_print_string fmt ctx.fmt.char_name
-  | Integer int_ty -> F.pp_print_string fmt (ctx.fmt.int_name int_ty)
-
-(** [inside] constrols whether we should add parentheses or not around type
-    applications (if [true] we add parentheses).
-
-    [no_params_tys]: for all the types inside this set, do not print the type parameters.
-    This is used for HOL4. As polymorphism is uniform in HOL4, printing the
-    type parameters in the recursive definitions is useless (and actually
-    forbidden).
-
-    For instance, where in F* we would write:
-    {[
-      type list a = | Nil : list a | Cons : a -> list a -> list a
-    ]}
-
-    In HOL4 we would simply write:
-    {[
-      Datatype:
-        list = Nil 'a | Cons 'a list
-      End
-    ]}
- *)
-let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
-    (no_params_tys : TypeDeclId.Set.t) (inside : bool) (ty : ty) : unit =
-  let extract_rec = extract_ty ctx fmt no_params_tys in
-  match ty with
-  | Adt (type_id, generics) -> (
-      let has_params = generics <> empty_generic_args in
-      match type_id with
-      | Tuple ->
-          (* This is a bit annoying, but in F*/Coq/HOL4 [()] is not the unit type:
-           * we have to write [unit]... *)
-          if generics.types = [] then F.pp_print_string fmt (unit_name ())
-          else (
-            F.pp_print_string fmt "(";
-            Collections.List.iter_link
-              (fun () ->
-                F.pp_print_space fmt ();
-                let product =
-                  match !backend with
-                  | FStar -> "&"
-                  | Coq -> "*"
-                  | Lean -> "×"
-                  | HOL4 -> "#"
-                in
-                F.pp_print_string fmt product;
-                F.pp_print_space fmt ())
-              (extract_rec true) generics.types;
-            F.pp_print_string fmt ")")
-      | AdtId _ | Assumed _ -> (
-          (* HOL4 behaves differently. Where in Coq/FStar/Lean we would write:
-             `tree a b`
-
-             In HOL4 we would write:
-             `('a, 'b) tree`
-          *)
-          match !backend with
-          | FStar | Coq | Lean ->
-              let print_paren = inside && has_params in
-              if print_paren then F.pp_print_string fmt "(";
-              (* TODO: for now, only the opaque *functions* are extracted in the
-                 opaque module. The opaque *types* are assumed. *)
-              F.pp_print_string fmt (ctx_get_type type_id ctx);
-              (* We might need to filter the type arguments, if the type
-                 is builtin (for instance, we filter the global allocator type
-                 argument for `Vec`). *)
-              let generics =
-                match type_id with
-                | AdtId id -> (
-                    match
-                      TypeDeclId.Map.find_opt id ctx.types_filter_type_args_map
-                    with
-                    | None -> generics
-                    | Some filter ->
-                        let types = List.combine filter generics.types in
-                        let types =
-                          List.filter_map
-                            (fun (b, ty) -> if b then Some ty else None)
-                            types
-                        in
-                        { generics with types })
-                | _ -> generics
-              in
-              extract_generic_args ctx fmt no_params_tys generics;
-              if print_paren then F.pp_print_string fmt ")"
-          | HOL4 ->
-              let { types; const_generics; trait_refs } = generics in
-              (* Const generics are not supported in HOL4 *)
-              assert (const_generics = []);
-              let print_tys =
-                match type_id with
-                | AdtId id -> not (TypeDeclId.Set.mem id no_params_tys)
-                | Assumed _ -> true
-                | _ -> raise (Failure "Unreachable")
-              in
-              if types <> [] && print_tys then (
-                let print_paren = List.length types > 1 in
-                if print_paren then F.pp_print_string fmt "(";
-                Collections.List.iter_link
-                  (fun () ->
-                    F.pp_print_string fmt ",";
-                    F.pp_print_space fmt ())
-                  (extract_rec true) types;
-                if print_paren then F.pp_print_string fmt ")";
-                F.pp_print_space fmt ());
-              F.pp_print_string fmt (ctx_get_type type_id ctx);
-              if trait_refs <> [] then (
-                F.pp_print_space fmt ();
-                Collections.List.iter_link (F.pp_print_space fmt)
-                  (extract_trait_ref ctx fmt no_params_tys true)
-                  trait_refs)))
-  | TypeVar vid -> F.pp_print_string fmt (ctx_get_type_var vid ctx)
-  | Literal lty -> extract_literal_type ctx fmt lty
-  | Arrow (arg_ty, ret_ty) ->
-      if inside then F.pp_print_string fmt "(";
-      extract_rec false arg_ty;
-      F.pp_print_space fmt ();
-      extract_arrow fmt ();
-      F.pp_print_space fmt ();
-      extract_rec false ret_ty;
-      if inside then F.pp_print_string fmt ")"
-  | TraitType (trait_ref, generics, type_name) ->
-      if !parameterize_trait_types then raise (Failure "Unimplemented")
-      else if trait_ref.trait_id <> Self then (
-        (* HOL4 doesn't have 1st class types *)
-        assert (!backend <> HOL4);
-        let use_brackets = generics <> empty_generic_args in
-        if use_brackets then F.pp_print_string fmt "(";
-        extract_trait_ref ctx fmt no_params_tys false trait_ref;
-        extract_generic_args ctx fmt no_params_tys generics;
-        let name =
-          ctx_get_trait_type trait_ref.trait_decl_ref.trait_decl_id type_name
-            ctx
-        in
-        if use_brackets then F.pp_print_string fmt ")";
-        F.pp_print_string fmt ("." ^ name))
-      else
-        (* There are two situations:
-           - we are extracting a declared item (typically a function signature)
-             for a trait declaration. We directly refer to the item (we extract
-             trait declarations as structures, so we can refer to their fields)
-           - we are extracting a provided method for a trait declaration. We
-             refer to the item in the self trait clause (see {!SelfTraitClauseId}).
-
-           Remark: we can't get there for trait *implementations* because then the
-           types should have been normalized.
-        *)
-        let trait_decl_id = Option.get ctx.trait_decl_id in
-        let item_name = ctx_get_trait_type trait_decl_id type_name ctx in
-        assert (generics = empty_generic_args);
-        if ctx.is_provided_method then
-          (* Provided method: use the trait self clause *)
-          let self_clause = ctx_get_trait_self_clause ctx in
-          F.pp_print_string fmt (self_clause ^ "." ^ item_name)
-        else
-          (* Declaration: directly refer to the item *)
-          F.pp_print_string fmt item_name
-
-and extract_trait_ref (ctx : extraction_ctx) (fmt : F.formatter)
-    (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_ref) : unit =
-  let use_brackets = tr.generics <> empty_generic_args && inside in
-  if use_brackets then F.pp_print_string fmt "(";
-  extract_trait_instance_id ctx fmt no_params_tys inside tr.trait_id;
-  extract_generic_args ctx fmt no_params_tys tr.generics;
-  if use_brackets then F.pp_print_string fmt ")"
-
-and extract_trait_decl_ref (ctx : extraction_ctx) (fmt : F.formatter)
-    (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_decl_ref) :
-    unit =
-  let use_brackets = tr.decl_generics <> empty_generic_args && inside in
-  let name = ctx_get_trait_decl tr.trait_decl_id ctx in
-  if use_brackets then F.pp_print_string fmt "(";
-  F.pp_print_string fmt name;
-  (* There is something subtle here: the trait obligations for the implemented
-     trait are put inside the parent clauses, so we must ignore them here *)
-  let generics = { tr.decl_generics with trait_refs = [] } in
-  extract_generic_args ctx fmt no_params_tys generics;
-  if use_brackets then F.pp_print_string fmt ")"
-
-and extract_generic_args (ctx : extraction_ctx) (fmt : F.formatter)
-    (no_params_tys : TypeDeclId.Set.t) (generics : generic_args) : unit =
-  let { types; const_generics; trait_refs } = generics in
-  if !backend <> HOL4 then (
-    if types <> [] then (
-      F.pp_print_space fmt ();
-      Collections.List.iter_link (F.pp_print_space fmt)
-        (extract_ty ctx fmt no_params_tys true)
-        types);
-    if const_generics <> [] then (
-      assert (!backend <> HOL4);
-      F.pp_print_space fmt ();
-      Collections.List.iter_link (F.pp_print_space fmt)
-        (extract_const_generic ctx fmt true)
-        const_generics));
-  if trait_refs <> [] then (
-    F.pp_print_space fmt ();
-    Collections.List.iter_link (F.pp_print_space fmt)
-      (extract_trait_ref ctx fmt no_params_tys true)
-      trait_refs)
-
-and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter)
-    (no_params_tys : TypeDeclId.Set.t) (inside : bool) (id : trait_instance_id)
-    : unit =
-  match id with
-  | Self ->
-      (* This has specific treatment depending on the item we're extracting
-         (associated type, etc.). We should have caught this elsewhere. *)
-      raise (Failure "Unexpected")
-  | TraitImpl id ->
-      let name = ctx_get_trait_impl id ctx in
-      F.pp_print_string fmt name
-  | Clause id ->
-      let name = ctx_get_local_trait_clause id ctx in
-      F.pp_print_string fmt name
-  | ParentClause (inst_id, decl_id, clause_id) ->
-      (* Use the trait decl id to lookup the name *)
-      let name = ctx_get_trait_parent_clause decl_id clause_id ctx in
-      extract_trait_instance_id ctx fmt no_params_tys true inst_id;
-      F.pp_print_string fmt ("." ^ name)
-  | ItemClause (inst_id, decl_id, item_name, clause_id) ->
-      (* Use the trait decl id to lookup the name *)
-      let name = ctx_get_trait_item_clause decl_id item_name clause_id ctx in
-      extract_trait_instance_id ctx fmt no_params_tys true inst_id;
-      F.pp_print_string fmt ("." ^ name)
-  | TraitRef trait_ref ->
-      extract_trait_ref ctx fmt no_params_tys inside trait_ref
-  | UnknownTrait _ ->
-      (* This is an error case *)
-      raise (Failure "Unexpected")
-
-(** Compute the names for all the top-level identifiers used in a type
-    definition (type name, variant names, field names, etc. but not type
-    parameters).
-
-    We need to do this preemptively, beforce extracting any definition,
-    because of recursive definitions.
- *)
-let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
-    extraction_ctx =
-  (* Lookup the builtin information, if there is *)
-  let open ExtractBuiltin in
-  let sname = name_to_simple_name def.name in
-  let info = SimpleNameMap.find_opt sname (builtin_types_map ()) in
-  (* Register the filtering information, if there is *)
-  let ctx =
-    match info with
-    | Some { keep_params = Some keep; _ } ->
-        {
-          ctx with
-          types_filter_type_args_map =
-            TypeDeclId.Map.add def.def_id keep ctx.types_filter_type_args_map;
-        }
-    | _ -> ctx
-  in
-  (* Compute and register the type def name *)
-  let def_name =
-    match info with
-    | None -> ctx.fmt.type_name def.name
-    | Some info -> info.extract_name
-  in
-  let ctx = ctx_add (TypeId (AdtId def.def_id)) def_name ctx in
-  (* Compute and register:
-   * - the variant names, if this is an enumeration
-   * - the field names, if this is a structure
-   *)
-  let ctx =
-    match def.kind with
-    | Struct fields ->
-        (* Compute the names *)
-        let field_names, cons_name =
-          match info with
-          | None | Some { body_info = None; _ } ->
-              let field_names =
-                FieldId.mapi
-                  (fun fid (field : field) ->
-                    (fid, ctx.fmt.field_name def.name fid field.field_name))
-                  fields
-              in
-              let cons_name = ctx.fmt.struct_constructor def.name in
-              (field_names, cons_name)
-          | Some { body_info = Some (Struct (cons_name, field_names)); _ } ->
-              let field_names =
-                FieldId.mapi
-                  (fun fid (_, name) -> (fid, name))
-                  (List.combine fields field_names)
-              in
-              (field_names, cons_name)
-          | Some info ->
-              raise
-                (Failure
-                   ("Invalid builtin information: "
-                   ^ show_builtin_type_info info))
-        in
-        (* Add the fields *)
-        let ctx =
-          List.fold_left
-            (fun ctx (fid, name) ->
-              ctx_add (FieldId (AdtId def.def_id, fid)) name ctx)
-            ctx field_names
-        in
-        (* Add the constructor name *)
-        ctx_add (StructId (AdtId def.def_id)) cons_name ctx
-    | Enum variants ->
-        let variant_names =
-          match info with
-          | None ->
-              VariantId.mapi
-                (fun variant_id (variant : variant) ->
-                  let name =
-                    ctx.fmt.variant_name def.name variant.variant_name
-                  in
-                  (* Add the type name prefix for Lean *)
-                  let name =
-                    if !Config.backend = Lean then
-                      let type_name = ctx.fmt.type_name def.name in
-                      type_name ^ "." ^ name
-                    else name
-                  in
-                  (variant_id, name))
-                variants
-          | Some { body_info = Some (Enum variant_infos); _ } ->
-              (* We need to compute the map from variant to variant *)
-              let variant_map =
-                StringMap.of_list
-                  (List.map
-                     (fun (info : builtin_enum_variant_info) ->
-                       (info.rust_variant_name, info.extract_variant_name))
-                     variant_infos)
-              in
-              VariantId.mapi
-                (fun variant_id (variant : variant) ->
-                  (variant_id, StringMap.find variant.variant_name variant_map))
-                variants
-          | _ -> raise (Failure "Invalid builtin information")
-        in
-        List.fold_left
-          (fun ctx (vid, vname) ->
-            ctx_add (VariantId (AdtId def.def_id, vid)) vname ctx)
-          ctx variant_names
-    | Opaque ->
-        (* Nothing to do *)
-        ctx
-  in
-  (* Return *)
-  ctx
-
-(** Print the variants *)
-let extract_type_decl_variant (ctx : extraction_ctx) (fmt : F.formatter)
-    (type_decl_group : TypeDeclId.Set.t) (type_name : string)
-    (type_params : string list) (cg_params : string list) (cons_name : string)
-    (fields : field list) : unit =
-  F.pp_print_space fmt ();
-  (* variant box *)
-  F.pp_open_hvbox fmt ctx.indent_incr;
-  (* [| Cons :]
-   * Note that we really don't want any break above so we print everything
-   * at once. *)
-  let opt_colon = if !backend <> HOL4 then " :" else "" in
-  F.pp_print_string fmt ("| " ^ cons_name ^ opt_colon);
-  let print_field (fid : FieldId.id) (f : field) (ctx : extraction_ctx) :
-      extraction_ctx =
-    F.pp_print_space fmt ();
-    (* Open the field box *)
-    F.pp_open_box fmt ctx.indent_incr;
-    (* Print the field names, if the backend accepts it.
-     * [  x :]
-     * Note that when printing fields, we register the field names as
-     * *variables*: they don't need to be unique at the top level. *)
-    let ctx =
-      match !backend with
-      | FStar -> (
-          match f.field_name with
-          | None -> ctx
-          | Some field_name ->
-              let var_id = VarId.of_int (FieldId.to_int fid) in
-              let field_name =
-                ctx.fmt.var_basename ctx.names_map.names_set (Some field_name)
-                  f.field_ty
-              in
-              let ctx, field_name = ctx_add_var field_name var_id ctx in
-              F.pp_print_string fmt (field_name ^ " :");
-              F.pp_print_space fmt ();
-              ctx)
-      | Coq | Lean | HOL4 -> ctx
-    in
-    (* Print the field type *)
-    let inside = !backend = HOL4 in
-    extract_ty ctx fmt type_decl_group inside f.field_ty;
-    (* Print the arrow [->] *)
-    if !backend <> HOL4 then (
-      F.pp_print_space fmt ();
-      extract_arrow fmt ());
-    (* Close the field box *)
-    F.pp_close_box fmt ();
-    (* Return *)
-    ctx
-  in
-  (* Print the fields *)
-  let fields = FieldId.mapi (fun fid f -> (fid, f)) fields in
-  let _ =
-    List.fold_left (fun ctx (fid, f) -> print_field fid f ctx) ctx fields
-  in
-  (* Sanity check: HOL4 doesn't support const generics *)
-  assert (cg_params = [] || !backend <> HOL4);
-  (* Print the final type *)
-  if !backend <> HOL4 then (
-    F.pp_print_space fmt ();
-    F.pp_open_hovbox fmt 0;
-    F.pp_print_string fmt type_name;
-    List.iter
-      (fun p ->
-        F.pp_print_space fmt ();
-        F.pp_print_string fmt p)
-      (List.append type_params cg_params);
-    F.pp_close_box fmt ());
-  (* Close the variant box *)
-  F.pp_close_box fmt ()
-
-(* TODO: we don' need the [def_name] paramter: it can be retrieved from the context *)
-let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter)
-    (type_decl_group : TypeDeclId.Set.t) (def : type_decl) (def_name : string)
-    (type_params : string list) (cg_params : string list)
-    (variants : variant list) : unit =
-  (* We want to generate a definition which looks like this (taking F* as example):
-     {[
-       type list a = | Cons : a -> list a -> list a | Nil : list a
-     ]}
-
-     If there isn't enough space on one line:
-     {[
-       type s =
-       | Cons : a -> list a -> list a
-       | Nil : list a
-     ]}
-
-     And if we need to write the type of a variant on several lines:
-     {[
-       type s =
-       | Cons :
-         a ->
-         list a ->
-         list a
-       | Nil : list a
-     ]}
-
-     Finally, it is possible to give names to the variant fields in Rust.
-     In this situation, we generate a definition like this:
-     {[
-       type s =
-       | Cons : hd:a -> tl:list a -> list a
-       | Nil : list a
-     ]}
-
-     Note that we already printed: [type s =]
-  *)
-  let print_variant _variant_id (v : variant) =
-    (* We don't lookup the name, because it may have a prefix for the type
-       id (in the case of Lean) *)
-    let cons_name = ctx.fmt.variant_name def.name v.variant_name in
-    let fields = v.fields in
-    extract_type_decl_variant ctx fmt type_decl_group def_name type_params
-      cg_params cons_name fields
-  in
-  (* Print the variants *)
-  let variants = VariantId.mapi (fun vid v -> (vid, v)) variants in
-  List.iter (fun (vid, v) -> print_variant vid v) variants
-
-let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter)
-    (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl)
-    (type_params : string list) (cg_params : string list) (fields : field list)
-    : unit =
-  (* We want to generate a definition which looks like this (taking F* as example):
-     {[
-       type t = { x : int; y : bool; }
-     ]}
-
-     If there isn't enough space on one line:
-     {[
-       type t =
-       {
-         x : int; y : bool;
-       }
-     ]}
-
-     And if there is even less space:
-     {[
-       type t =
-       {
-         x : int;
-         y : bool;
-       }
-     ]}
-
-     Also, in case there are no fields, we need to define the type as [unit]
-     ([type t = {}] doesn't work in F* ).
-
-     Coq:
-     ====
-     We need to define the constructor name upon defining the struct (record, in Coq).
-     The syntex is:
-     {[
-       Record Foo = mkFoo { x : int; y : bool; }.
-     }]
-
-     Also, Coq doesn't support groups of mutually recursive inductives and records.
-     This is fine, because we can then define records as inductives, and leverage
-     the fact that when record fields are accessed, the records are symbolically
-     expanded which introduces let bindings of the form: [let RecordCons ... = x in ...].
-     As a consequence, we never use the record projectors (unless we reconstruct
-     them in the micro passes of course).
-
-     HOL4:
-     =====
-     Type definitions are written as follows:
-     {[
-       Datatype:
-         tree =
-           TLeaf 'a
-         | TNode node ;
-
-         node =
-           Node (tree list)
-       End
-     ]}
-  *)
-  (* Note that we already printed: [type t =] *)
-  let is_rec = decl_is_from_rec_group kind in
-  let _ =
-    if !backend = FStar && fields = [] then (
-      F.pp_print_space fmt ();
-      F.pp_print_string fmt (unit_name ()))
-    else if !backend = Lean && fields = [] then ()
-      (* If the definition is recursive, we may need to extract it as an inductive
-         (instead of a record). We start with the "normal" case: we extract it
-         as a record. *)
-    else if (not is_rec) || (!backend <> Coq && !backend <> Lean) then (
-      if !backend <> Lean then F.pp_print_space fmt ();
-      (* If Coq: print the constructor name *)
-      (* TODO: remove superfluous test not is_rec below *)
-      if !backend = Coq && not is_rec then (
-        F.pp_print_string fmt (ctx_get_struct (AdtId def.def_id) ctx);
-        F.pp_print_string fmt " ");
-      (match !backend with
-      | Lean -> ()
-      | FStar | Coq -> F.pp_print_string fmt "{"
-      | HOL4 -> F.pp_print_string fmt "<|");
-      F.pp_print_break fmt 1 ctx.indent_incr;
-      (* The body itself *)
-      (* Open a box for the body *)
-      (match !backend with
-      | Coq | FStar | HOL4 -> F.pp_open_hvbox fmt 0
-      | Lean -> F.pp_open_vbox fmt 0);
-      (* Print the fields *)
-      let print_field (field_id : FieldId.id) (f : field) : unit =
-        let field_name = ctx_get_field (AdtId def.def_id) field_id ctx in
-        (* Open a box for the field *)
-        F.pp_open_box fmt ctx.indent_incr;
-        F.pp_print_string fmt field_name;
-        F.pp_print_space fmt ();
-        F.pp_print_string fmt ":";
-        F.pp_print_space fmt ();
-        extract_ty ctx fmt type_decl_group false f.field_ty;
-        if !backend <> Lean then F.pp_print_string fmt ";";
-        (* Close the box for the field *)
-        F.pp_close_box fmt ()
-      in
-      let fields = FieldId.mapi (fun fid f -> (fid, f)) fields in
-      Collections.List.iter_link (F.pp_print_space fmt)
-        (fun (fid, f) -> print_field fid f)
-        fields;
-      (* Close the box for the body *)
-      F.pp_close_box fmt ();
-      match !backend with
-      | Lean -> ()
-      | FStar | Coq ->
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "}"
-      | HOL4 ->
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "|>")
-    else (
-      (* We extract for Coq or Lean, and we have a recursive record, or a record in
-         a group of mutually recursive types: we extract it as an inductive type *)
-      assert (is_rec && (!backend = Coq || !backend = Lean));
-      (* Small trick: in Lean we use namespaces, meaning we don't need to prefix
-         the constructor name with the name of the type at definition site,
-         i.e., instead of generating `inductive Foo := | MkFoo ...` like in Coq
-         we generate `inductive Foo := | mk ... *)
-      let cons_name =
-        if !backend = Lean then "mk" else ctx_get_struct (AdtId def.def_id) ctx
-      in
-      let def_name = ctx_get_local_type def.def_id ctx in
-      extract_type_decl_variant ctx fmt type_decl_group def_name type_params
-        cg_params cons_name fields)
-  in
-  ()
-
-(** Extract a nestable, muti-line comment *)
-let extract_comment (fmt : F.formatter) (sl : string list) : unit =
-  (* Delimiters, space after we break a line *)
-  let ld, space, rd =
-    match !backend with
-    | Coq | FStar | HOL4 -> ("(** ", 4, " *)")
-    | Lean -> ("/- ", 3, " -/")
-  in
-  F.pp_open_vbox fmt space;
-  F.pp_print_string fmt ld;
-  (match sl with
-  | [] -> ()
-  | s :: sl ->
-      F.pp_print_string fmt s;
-      List.iter
-        (fun s ->
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt s)
-        sl);
-  F.pp_print_string fmt rd;
-  F.pp_close_box fmt ()
-
-let extract_trait_clause_type (ctx : extraction_ctx) (fmt : F.formatter)
-    (no_params_tys : TypeDeclId.Set.t) (clause : trait_clause) : unit =
-  let trait_name = ctx_get_trait_decl clause.trait_id ctx in
-  F.pp_print_string fmt trait_name;
-  extract_generic_args ctx fmt no_params_tys clause.generics
-
-(** Insert a space, if necessary *)
-let insert_req_space (fmt : F.formatter) (space : bool ref) : unit =
-  if !space then space := false else F.pp_print_space fmt ()
-
-(** Extract the trait self clause.
-
-    We add the trait self clause for provided methods (see {!TraitSelfClauseId}).
- *)
-let extract_trait_self_clause (insert_req_space : unit -> unit)
-    (ctx : extraction_ctx) (fmt : F.formatter) (trait_decl : trait_decl)
-    (params : string list) : unit =
-  insert_req_space ();
-  F.pp_print_string fmt "(";
-  let self_clause = ctx_get_trait_self_clause ctx in
-  F.pp_print_string fmt self_clause;
-  F.pp_print_space fmt ();
-  F.pp_print_string fmt ":";
-  F.pp_print_space fmt ();
-  let trait_id = ctx_get_trait_decl trait_decl.def_id ctx in
-  F.pp_print_string fmt trait_id;
-  List.iter
-    (fun p ->
-      F.pp_print_space fmt ();
-      F.pp_print_string fmt p)
-    params;
-  F.pp_print_string fmt ")"
-
-(**
- - [trait_decl]: if [Some], it means we are extracting the generics for a provided
-   method and need to insert a trait self clause (see {!TraitSelfClauseId}).
- *)
-let extract_generic_params (ctx : extraction_ctx) (fmt : F.formatter)
-    (no_params_tys : TypeDeclId.Set.t) ?(use_forall = false)
-    ?(use_forall_use_sep = true) ?(as_implicits : bool = false)
-    ?(space : bool ref option = None) ?(trait_decl : trait_decl option = None)
-    (generics : generic_params) (type_params : string list)
-    (cg_params : string list) (trait_clauses : string list) : unit =
-  let all_params = List.concat [ type_params; cg_params; trait_clauses ] in
-  (* HOL4 doesn't support const generics *)
-  assert (cg_params = [] || !backend <> HOL4);
-  let left_bracket (implicit : bool) =
-    if implicit then F.pp_print_string fmt "{" else F.pp_print_string fmt "("
-  in
-  let right_bracket (implicit : bool) =
-    if implicit then F.pp_print_string fmt "}" else F.pp_print_string fmt ")"
-  in
-  let insert_req_space () =
-    match space with
-    | None -> F.pp_print_space fmt ()
-    | Some space -> insert_req_space fmt space
-  in
-  (* Print the type/const generic parameters *)
-  if all_params <> [] then (
-    if use_forall then (
-      if use_forall_use_sep then (
-        insert_req_space ();
-        F.pp_print_string fmt ":");
-      insert_req_space ();
-      F.pp_print_string fmt "forall");
-    (* Small helper - we may need to split the parameters *)
-    let print_generics (as_implicits : bool) (type_params : string list)
-        (const_generics : const_generic_var list)
-        (trait_clauses : trait_clause list) : unit =
-      (* Note that in HOL4 we don't print the type parameters. *)
-      if !backend <> HOL4 then (
-        (* Print the type parameters *)
-        if type_params <> [] then (
-          insert_req_space ();
-          (* ( *)
-          left_bracket as_implicits;
-          List.iter
-            (fun s ->
-              F.pp_print_string fmt s;
-              F.pp_print_space fmt ())
-            type_params;
-          F.pp_print_string fmt ":";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt (type_keyword ());
-          (* ) *)
-          right_bracket as_implicits);
-        (* Print the const generic parameters *)
-        List.iter
-          (fun (var : const_generic_var) ->
-            insert_req_space ();
-            (* ( *)
-            left_bracket as_implicits;
-            let n = ctx_get_const_generic_var var.index ctx in
-            F.pp_print_string fmt n;
-            F.pp_print_space fmt ();
-            F.pp_print_string fmt ":";
-            F.pp_print_space fmt ();
-            extract_literal_type ctx fmt var.ty;
-            (* ) *)
-            right_bracket as_implicits)
-          const_generics);
-      (* Print the trait clauses *)
-      List.iter
-        (fun (clause : trait_clause) ->
-          insert_req_space ();
-          (* ( *)
-          left_bracket as_implicits;
-          let n = ctx_get_local_trait_clause clause.clause_id ctx in
-          F.pp_print_string fmt n;
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt ":";
-          F.pp_print_space fmt ();
-          extract_trait_clause_type ctx fmt no_params_tys clause;
-          (* ) *)
-          right_bracket as_implicits)
-        trait_clauses
-    in
-    (* If we extract the generics for a provided method for a trait declaration
-       (indicated by the trait decl given as input), we need to split the generics:
-       - we print the generics for the trait decl
-       - we print the trait self clause
-       - we print the generics for the trait method
-    *)
-    match trait_decl with
-    | None ->
-        print_generics as_implicits type_params generics.const_generics
-          generics.trait_clauses
-    | Some trait_decl ->
-        (* Split the generics between the generics specific to the trait decl
-           and those specific to the trait method *)
-        let open Collections.List in
-        let dtype_params, mtype_params =
-          split_at type_params (length trait_decl.generics.types)
-        in
-        let dcgs, mcgs =
-          split_at generics.const_generics
-            (length trait_decl.generics.const_generics)
-        in
-        let dtrait_clauses, mtrait_clauses =
-          split_at generics.trait_clauses
-            (length trait_decl.generics.trait_clauses)
-        in
-        (* Extract the trait decl generics - note that we can always deduce
-           those parameters from the trait self clause: for this reason
-           they are always implicit *)
-        print_generics true dtype_params dcgs dtrait_clauses;
-        (* Extract the trait self clause *)
-        let params =
-          concat
-            [
-              dtype_params;
-              map
-                (fun (cg : const_generic_var) ->
-                  ctx_get_const_generic_var cg.index ctx)
-                dcgs;
-              map
-                (fun c -> ctx_get_local_trait_clause c.clause_id ctx)
-                dtrait_clauses;
-            ]
-        in
-        extract_trait_self_clause insert_req_space ctx fmt trait_decl params;
-        (* Extract the method generics *)
-        print_generics as_implicits mtype_params mcgs mtrait_clauses)
-
-(** Extract a type declaration.
-
-    This function is for all type declarations and all backends **at the exception**
-    of opaque (assumed/declared) types format4 HOL4.
-
-    See {!extract_type_decl}.
- *)
-let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
-    (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl)
-    (extract_body : bool) : unit =
-  (* Sanity check *)
-  assert (extract_body || !backend <> HOL4);
-  let type_kind =
-    if extract_body then
-      match def.kind with
-      | Struct _ -> Some Struct
-      | Enum _ -> Some Enum
-      | Opaque -> None
-    else None
-  in
-  (* If in Coq and the declaration is opaque, it must have the shape:
-     [Axiom Ident : forall (T0 ... Tn : Type) (N0 : ...) ... (Nn : ...), ... -> ... -> ...].
-
-     The boolean [is_opaque_coq] is used to detect this case.
-  *)
-  let is_opaque = type_kind = None in
-  let is_opaque_coq = !backend = Coq && is_opaque in
-  let use_forall = is_opaque_coq && def.generics <> empty_generic_params in
-  (* Retrieve the definition name *)
-  let def_name = ctx_get_local_type def.def_id ctx in
-  (* Add the type and const generic params - note that we need those bindings only for the
-   * body translation (they are not top-level) *)
-  let ctx_body, type_params, cg_params, trait_clauses =
-    ctx_add_generic_params def.generics ctx
-  in
-  (* Add a break before *)
-  if !backend <> HOL4 || not (decl_is_first_from_group kind) then
-    F.pp_print_break fmt 0 0;
-  (* Print a comment to link the extracted type to its original rust definition *)
-  extract_comment fmt [ "[" ^ Print.name_to_string def.name ^ "]" ];
-  F.pp_print_break fmt 0 0;
-  (* Open a box for the definition, so that whenever possible it gets printed on
-   * one line. Note however that in the case of Lean line breaks are important
-   * for parsing: we thus use a hovbox. *)
-  (match !backend with
-  | Coq | FStar | HOL4 -> F.pp_open_hvbox fmt 0
-  | Lean -> F.pp_open_vbox fmt 0);
-  (* Open a box for "type TYPE_NAME (TYPE_PARAMS CONST_GEN_PARAMS) =" *)
-  F.pp_open_hovbox fmt ctx.indent_incr;
-  (* > "type TYPE_NAME" *)
-  let qualif = ctx.fmt.type_decl_kind_to_qualif kind type_kind in
-  (match qualif with
-  | Some qualif -> F.pp_print_string fmt (qualif ^ " " ^ def_name)
-  | None -> F.pp_print_string fmt def_name);
-  (* HOL4 doesn't support const generics, and type definitions in HOL4 don't
-     support trait clauses *)
-  assert ((cg_params = [] && trait_clauses = []) || !backend <> HOL4);
-  (* Print the generic parameters *)
-  extract_generic_params ctx_body fmt type_decl_group ~use_forall def.generics
-    type_params cg_params trait_clauses;
-  (* Print the "=" if we extract the body*)
-  if extract_body then (
-    F.pp_print_space fmt ();
-    let eq =
-      match !backend with
-      | FStar -> "="
-      | Coq -> ":="
-      | Lean ->
-          if type_kind = Some Struct && kind = SingleNonRec then "where"
-          else ":="
-      | HOL4 -> "="
-    in
-    F.pp_print_string fmt eq)
-  else (
-    (* Otherwise print ": Type", unless it is the HOL4 backend (in
-       which case we declare the type with `new_type`) *)
-    if use_forall then F.pp_print_string fmt ","
-    else (
-      F.pp_print_space fmt ();
-      F.pp_print_string fmt ":");
-    F.pp_print_space fmt ();
-    F.pp_print_string fmt (type_keyword ()));
-  (* Close the box for "type TYPE_NAME (TYPE_PARAMS) =" *)
-  F.pp_close_box fmt ();
-  (if extract_body then
-     match def.kind with
-     | Struct fields ->
-         extract_type_decl_struct_body ctx_body fmt type_decl_group kind def
-           type_params cg_params fields
-     | Enum variants ->
-         extract_type_decl_enum_body ctx_body fmt type_decl_group def def_name
-           type_params cg_params variants
-     | Opaque -> raise (Failure "Unreachable"));
-  (* Add the definition end delimiter *)
-  if !backend = HOL4 && decl_is_not_last_from_group kind then (
-    F.pp_print_space fmt ();
-    F.pp_print_string fmt ";")
-  else if !backend = Coq && decl_is_last_from_group kind then (
-    (* This is actually an end of group delimiter. For aesthetic reasons
-       we print it here instead of in {!end_type_decl_group}. *)
-    F.pp_print_cut fmt ();
-    F.pp_print_string fmt ".");
-  (* Close the box for the definition *)
-  F.pp_close_box fmt ();
-  (* Add breaks to insert new lines between definitions *)
-  if !backend <> HOL4 || decl_is_not_last_from_group kind then
-    F.pp_print_break fmt 0 0
-
-(** Extract an opaque type declaration to HOL4.
-
-    Remark (SH): having to treat this specific case separately is very annoying,
-    but I could not find a better way.
- *)
-let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter)
-    (def : type_decl) : unit =
-  (* Retrieve the definition name *)
-  let def_name = ctx_get_local_type def.def_id ctx in
-  (* Generic parameters are unsupported *)
-  assert (def.generics.const_generics = []);
-  (* Trait clauses on type definitions are unsupported *)
-  assert (def.generics.trait_clauses = []);
-  (* Types  *)
-  (* Count the number of parameters *)
-  let num_params = List.length def.generics.types in
-  (* Generate the declaration *)
-  F.pp_print_space fmt ();
-  F.pp_print_string fmt
-    ("val _ = new_type (\"" ^ def_name ^ "\", " ^ string_of_int num_params ^ ")");
-  F.pp_print_space fmt ()
-
-(** Extract an empty record type declaration to HOL4.
-
-    Empty records are not supported in HOL4, so we extract them as type
-    abbreviations to the unit type.
-
-    Remark (SH): having to treat this specific case separately is very annoying,
-    but I could not find a better way.
- *)
-let extract_type_decl_hol4_empty_record (ctx : extraction_ctx)
-    (fmt : F.formatter) (def : type_decl) : unit =
-  (* Retrieve the definition name *)
-  let def_name = ctx_get_local_type def.def_id ctx in
-  (* Sanity check *)
-  assert (def.generics = empty_generic_params);
-  (* Generate the declaration *)
-  F.pp_print_space fmt ();
-  F.pp_print_string fmt ("Type " ^ def_name ^ " = “: unit”");
-  F.pp_print_space fmt ()
-
-(** Extract a type declaration.
-
-    Note that all the names used for extraction should already have been
-    registered.
-
-    This function should be inserted between calls to {!start_type_decl_group}
-    and {!end_type_decl_group}.
- *)
-let extract_type_decl (ctx : extraction_ctx) (fmt : F.formatter)
-    (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) :
-    unit =
-  let extract_body =
-    match kind with
-    | SingleNonRec | SingleRec | MutRecFirst | MutRecInner | MutRecLast -> true
-    | Assumed | Declared -> false
-  in
-  if extract_body then
-    if !backend = HOL4 && is_empty_record_type_decl def then
-      extract_type_decl_hol4_empty_record ctx fmt def
-    else extract_type_decl_gen ctx fmt type_decl_group kind def extract_body
-  else
-    match !backend with
-    | FStar | Coq | Lean ->
-        extract_type_decl_gen ctx fmt type_decl_group kind def extract_body
-    | HOL4 -> extract_type_decl_hol4_opaque ctx fmt def
-
-(** Auxiliary function.
-
-    Generate [Arguments] instructions in Coq.
- *)
-let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter)
-    (kind : decl_kind) (decl : type_decl) : unit =
-  assert (!backend = Coq);
-  (* Generating the [Arguments] instructions is useful only if there are type parameters *)
-  if decl.generics.types = [] && decl.generics.const_generics = [] then ()
-  else
-    (* Add the type params - note that we need those bindings only for the
-     * body translation (they are not top-level) *)
-    let _ctx_body, type_params, cg_params, trait_clauses =
-      ctx_add_generic_params decl.generics ctx
-    in
-    (* Auxiliary function to extract an [Arguments Cons {T} _ _.] instruction *)
-    let extract_arguments_info (cons_name : string) (fields : 'a list) : unit =
-      (* Add a break before *)
-      F.pp_print_break fmt 0 0;
-      (* Open a box *)
-      F.pp_open_hovbox fmt ctx.indent_incr;
-      F.pp_print_break fmt 0 0;
-      F.pp_print_string fmt "Arguments";
-      F.pp_print_space fmt ();
-      F.pp_print_string fmt cons_name;
-      (* Print the type/const params and the trait clauses (`{T}`) *)
-      List.iter
-        (fun (var : string) ->
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt ("{" ^ var ^ "}"))
-        (List.concat [ type_params; cg_params; trait_clauses ]);
-      (* Print the fields (`_`) *)
-      List.iter
-        (fun _ ->
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "_")
-        fields;
-      F.pp_print_string fmt ".";
-
-      (* Close the box *)
-      F.pp_close_box fmt ()
-    in
-
-    (* Generate the [Arguments] instruction *)
-    match decl.kind with
-    | Opaque -> ()
-    | Struct fields ->
-        let adt_id = AdtId decl.def_id in
-        (* Generate the instruction for the record constructor *)
-        let cons_name = ctx_get_struct adt_id ctx in
-        extract_arguments_info cons_name fields;
-        (* Generate the instruction for the record projectors, if there are *)
-        let is_rec = decl_is_from_rec_group kind in
-        if not is_rec then
-          FieldId.iteri
-            (fun fid _ ->
-              let cons_name = ctx_get_field adt_id fid ctx in
-              extract_arguments_info cons_name [])
-            fields;
-        (* Add breaks to insert new lines between definitions *)
-        F.pp_print_break fmt 0 0
-    | Enum variants ->
-        (* Generate the instructions *)
-        VariantId.iteri
-          (fun vid (v : variant) ->
-            let cons_name = ctx_get_variant (AdtId decl.def_id) vid ctx in
-            extract_arguments_info cons_name v.fields)
-          variants;
-        (* Add breaks to insert new lines between definitions *)
-        F.pp_print_break fmt 0 0
-
-(** Auxiliary function.
-
-    Generate field projectors in Coq.
-
-    Sometimes we extract records as inductives in Coq: when this happens we
-    have to define the field projectors afterwards.
- *)
-let extract_type_decl_record_field_projectors (ctx : extraction_ctx)
-    (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit =
-  assert (!backend = Coq);
-  match decl.kind with
-  | Opaque | Enum _ -> ()
-  | Struct fields ->
-      (* Records are extracted as inductives only if they are recursive *)
-      let is_rec = decl_is_from_rec_group kind in
-      if is_rec then
-        (* Add the type params *)
-        let ctx, type_params, cg_params, trait_clauses =
-          ctx_add_generic_params decl.generics ctx
-        in
-        let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in
-        let ctx, field_var = ctx_add_var "x" (VarId.of_int 1) ctx in
-        let def_name = ctx_get_local_type decl.def_id ctx in
-        let cons_name = ctx_get_struct (AdtId decl.def_id) ctx in
-        let extract_field_proj (field_id : FieldId.id) (_ : field) : unit =
-          F.pp_print_space fmt ();
-          (* Outer box for the projector definition *)
-          F.pp_open_hvbox fmt 0;
-          (* Inner box for the projector definition *)
-          F.pp_open_hvbox fmt ctx.indent_incr;
-          (* Open a box for the [Definition PROJ ... :=] *)
-          F.pp_open_hovbox fmt ctx.indent_incr;
-          F.pp_print_string fmt "Definition";
-          F.pp_print_space fmt ();
-          let field_name = ctx_get_field (AdtId decl.def_id) field_id ctx in
-          F.pp_print_string fmt field_name;
-          (* Print the generics *)
-          let as_implicits = true in
-          extract_generic_params ctx fmt TypeDeclId.Set.empty ~as_implicits
-            decl.generics type_params cg_params trait_clauses;
-          (* Print the record parameter *)
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "(";
-          F.pp_print_string fmt record_var;
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt ":";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt def_name;
-          List.iter
-            (fun p ->
-              F.pp_print_space fmt ();
-              F.pp_print_string fmt p)
-            type_params;
-          F.pp_print_string fmt ")";
-          (* *)
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt ":=";
-          (* Close the box for the [Definition PROJ ... :=] *)
-          F.pp_close_box fmt ();
-          F.pp_print_space fmt ();
-          (* Open a box for the whole match *)
-          F.pp_open_hvbox fmt 0;
-          (* Open a box for the [match ... with] *)
-          F.pp_open_hovbox fmt ctx.indent_incr;
-          F.pp_print_string fmt "match";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt record_var;
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "with";
-          (* Close the box for the [match ... with] *)
-          F.pp_close_box fmt ();
-
-          (* Open a box for the branch *)
-          F.pp_open_hovbox fmt ctx.indent_incr;
-          (* Print the match branch *)
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "|";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt cons_name;
-          FieldId.iteri
-            (fun id _ ->
-              F.pp_print_space fmt ();
-              if field_id = id then F.pp_print_string fmt field_var
-              else F.pp_print_string fmt "_")
-            fields;
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "=>";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt field_var;
-          (* Close the box for the branch *)
-          F.pp_close_box fmt ();
-          (* Print the [end] *)
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "end";
-          (* Close the box for the whole match *)
-          F.pp_close_box fmt ();
-          (* Close the inner box projector *)
-          F.pp_close_box fmt ();
-          (* If Coq: end the definition with a "." *)
-          if !backend = Coq then (
-            F.pp_print_cut fmt ();
-            F.pp_print_string fmt ".");
-          (* Close the outer box projector  *)
-          F.pp_close_box fmt ();
-          (* Add breaks to insert new lines between definitions *)
-          F.pp_print_break fmt 0 0
-        in
-
-        let extract_proj_notation (field_id : FieldId.id) (_ : field) : unit =
-          F.pp_print_space fmt ();
-          (* Outer box for the projector definition *)
-          F.pp_open_hvbox fmt 0;
-          (* Inner box for the projector definition *)
-          F.pp_open_hovbox fmt ctx.indent_incr;
-          let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in
-          F.pp_print_string fmt "Notation";
-          F.pp_print_space fmt ();
-          let field_name = ctx_get_field (AdtId decl.def_id) field_id ctx in
-          F.pp_print_string fmt ("\"" ^ record_var ^ " .(" ^ field_name ^ ")\"");
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt ":=";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "(";
-          F.pp_print_string fmt field_name;
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt record_var;
-          F.pp_print_string fmt ")";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "(at level 9)";
-          (* Close the inner box projector *)
-          F.pp_close_box fmt ();
-          (* If Coq: end the definition with a "." *)
-          if !backend = Coq then (
-            F.pp_print_cut fmt ();
-            F.pp_print_string fmt ".");
-          (* Close the outer box projector  *)
-          F.pp_close_box fmt ();
-          (* Add breaks to insert new lines between definitions *)
-          F.pp_print_break fmt 0 0
-        in
-
-        let extract_field_proj_and_notation (field_id : FieldId.id)
-            (field : field) : unit =
-          extract_field_proj field_id field;
-          extract_proj_notation field_id field
-        in
-
-        FieldId.iteri extract_field_proj_and_notation fields
-
-(** Extract extra information for a type (e.g., [Arguments] instructions in Coq).
-
-    Note that all the names used for extraction should already have been
-    registered.
- *)
-let extract_type_decl_extra_info (ctx : extraction_ctx) (fmt : F.formatter)
-    (kind : decl_kind) (decl : type_decl) : unit =
-  match !backend with
-  | FStar | Lean | HOL4 -> ()
-  | Coq ->
-      extract_type_decl_coq_arguments ctx fmt kind decl;
-      extract_type_decl_record_field_projectors ctx fmt kind decl
-
-(** Extract the state type declaration. *)
-let extract_state_type (fmt : F.formatter) (ctx : extraction_ctx)
-    (kind : decl_kind) : unit =
-  (* Add a break before *)
-  F.pp_print_break fmt 0 0;
-  (* Print a comment  *)
-  extract_comment fmt [ "The state type used in the state-error monad" ];
-  F.pp_print_break fmt 0 0;
-  (* Open a box for the definition, so that whenever possible it gets printed on
-   * one line *)
-  F.pp_open_hvbox fmt 0;
-  (* Retrieve the name *)
-  let state_name = ctx_get_assumed_type State ctx in
-  (* The syntax for Lean and Coq is almost identical. *)
-  let print_axiom () =
-    let axiom =
-      match !backend with
-      | Coq -> "Axiom"
-      | Lean -> "axiom"
-      | FStar | HOL4 -> raise (Failure "Unexpected")
-    in
-    F.pp_print_string fmt axiom;
-    F.pp_print_space fmt ();
-    F.pp_print_string fmt state_name;
-    F.pp_print_space fmt ();
-    F.pp_print_string fmt ":";
-    F.pp_print_space fmt ();
-    F.pp_print_string fmt "Type";
-    if !backend = Coq then F.pp_print_string fmt "."
-  in
-  (* The kind should be [Assumed] or [Declared] *)
-  (match kind with
-  | SingleNonRec | SingleRec | MutRecFirst | MutRecInner | MutRecLast ->
-      raise (Failure "Unexpected")
-  | Assumed -> (
-      match !backend with
-      | FStar ->
-          F.pp_print_string fmt "assume";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "type";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt state_name;
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt ":";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "Type0"
-      | HOL4 ->
-          F.pp_print_string fmt ("val _ = new_type (\"" ^ state_name ^ "\", 0)")
-      | Coq | Lean -> print_axiom ())
-  | Declared -> (
-      match !backend with
-      | FStar ->
-          F.pp_print_string fmt "val";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt state_name;
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt ":";
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "Type0"
-      | HOL4 ->
-          F.pp_print_string fmt ("val _ = new_type (\"" ^ state_name ^ "\", 0)")
-      | Coq | Lean -> print_axiom ()));
-  (* Close the box for the definition *)
-  F.pp_close_box fmt ();
-  (* Add breaks to insert new lines between definitions *)
-  F.pp_print_break fmt 0 0
+include ExtractTypes
 
 (** Compute the names for all the pure functions generated from a rust function
     (forward function and backward functions).
@@ -2415,13 +53,23 @@ let extract_fun_decl_register_names (ctx : extraction_ctx)
               let fun_id =
                 (Pure.FunId (Regular f.def_id), f.loop_id, f.back_id)
               in
-              let fun_name =
-                (List.find
-                   (fun (x : builtin_fun_info) -> x.rg = f.back_id)
-                   info)
-                  .extract_name
+              let fun_info =
+                List.find_opt
+                  (fun (x : builtin_fun_info) -> x.rg = f.back_id)
+                  info
               in
-              ctx_add (FunId (FromLlbc fun_id)) fun_name ctx)
+              match fun_info with
+              | Some fun_info ->
+                  ctx_add (FunId (FromLlbc fun_id)) fun_info.extract_name ctx
+              | None ->
+                  raise
+                    (Failure
+                       ("Not found: "
+                       ^ Names.name_to_string f.basename
+                       ^ ", "
+                       ^ Print.option_to_string Pure.show_loop_id f.loop_id
+                       ^ Print.option_to_string Pure.show_region_group_id
+                           f.back_id)))
             ctx funs
       | None ->
           let fwd = def.fwd in
@@ -2554,6 +202,32 @@ let extract_global (ctx : extraction_ctx) (fmt : F.formatter)
     (id : A.GlobalDeclId.id) : unit =
   F.pp_print_string fmt (ctx_get_global id ctx)
 
+(* Filter the generics of a function if it is builtin *)
+let fun_builtin_filter_types (id : FunDeclId.id) (types : 'a list)
+    (ctx : extraction_ctx) : ('a list, 'a list * string) Result.result =
+  match FunDeclId.Map.find_opt id ctx.funs_filter_type_args_map with
+  | None -> Result.Ok types
+  | Some filter ->
+      if List.length filter <> List.length types then (
+        let decl = FunDeclId.Map.find id ctx.trans_funs in
+        let err =
+          "Ill-formed builtin information for function "
+          ^ Names.name_to_string decl.fwd.f.basename
+          ^ ": "
+          ^ string_of_int (List.length filter)
+          ^ " filtering arguments provided for "
+          ^ string_of_int (List.length types)
+          ^ " type arguments"
+        in
+        log#serror err;
+        Result.Error (types, err))
+      else
+        let types = List.combine filter types in
+        let types =
+          List.filter_map (fun (b, ty) -> if b then Some ty else None) types
+        in
+        Result.Ok types
+
 (** [inside]: see {!extract_ty}.
 
     As a pattern can introduce new variables, we return an extraction context
@@ -2785,22 +459,24 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
          is builtin (for instance, we filter the global allocator type
          argument for `Vec::new`).
       *)
-      let generics =
+      let types =
         match fun_id with
-        | FromLlbc (FunId (Regular id), _, _) -> (
-            match FunDeclId.Map.find_opt id ctx.funs_filter_type_args_map with
-            | None -> generics
-            | Some filter ->
-                let types = List.combine filter generics.types in
-                let types =
-                  List.filter_map
-                    (fun (b, ty) -> if b then Some ty else None)
-                    types
-                in
-                { generics with types })
-        | _ -> generics
+        | FromLlbc (FunId (Regular id), _, _) ->
+            fun_builtin_filter_types id generics.types ctx
+        | _ -> Result.Ok generics.types
       in
-      extract_generic_args ctx fmt TypeDeclId.Set.empty generics;
+      (match types with
+      | Ok types ->
+          extract_generic_args ctx fmt TypeDeclId.Set.empty
+            { generics with types }
+      | Error (types, err) ->
+          extract_generic_args ctx fmt TypeDeclId.Set.empty
+            { generics with types };
+          if !Config.extract_fail_hard then raise (Failure err)
+          else
+            F.pp_print_string fmt
+              "(\"ERROR: ill-formed builtin: invalid number of filtering \
+               arguments\")");
       (* Print the arguments *)
       List.iter
         (fun ve ->
@@ -4353,10 +2029,8 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
 (** Similar to {!extract_type_decl_register_names} *)
 let extract_trait_impl_register_names (ctx : extraction_ctx)
     (trait_impl : trait_impl) : extraction_ctx =
-  let trait_decl =
-    TraitDeclId.Map.find trait_impl.impl_trait.trait_decl_id
-      ctx.trans_trait_decls
-  in
+  let decl_id = trait_impl.impl_trait.trait_decl_id in
+  let trait_decl = TraitDeclId.Map.find decl_id ctx.trans_trait_decls in
   (* Check if the trait implementation is builtin *)
   let builtin_info =
     let open ExtractBuiltin in
@@ -4365,6 +2039,24 @@ let extract_trait_impl_register_names (ctx : extraction_ctx)
     SimpleNamePairMap.find_opt (type_sname, trait_sname)
       (builtin_trait_impls_map ())
   in
+  (* Register some builtin information (if necessary) *)
+  let ctx, builtin_info =
+    match builtin_info with
+    | None -> (ctx, None)
+    | Some (filter, info) ->
+        let ctx =
+          match filter with
+          | None -> ctx
+          | Some filter ->
+              {
+                ctx with
+                trait_impls_filter_type_args_map =
+                  TraitImplId.Map.add trait_impl.def_id filter
+                    ctx.trait_impls_filter_type_args_map;
+              }
+        in
+        (ctx, Some info)
+  in
 
   (* For now we do not support overriding provided methods *)
   assert (trait_impl.provided_methods = []);
@@ -4596,12 +2288,36 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter)
     let f = f.f in
     let fun_name = ctx_get_trait_method trait_decl_id item_name f.back_id ctx in
     let ty () =
+      (* Filter the generics if the method is a builtin *)
+      let i_tys, _, _ = impl_generics in
+      let impl_types, i_tys, f_tys =
+        match FunDeclId.Map.find_opt f.def_id ctx.funs_filter_type_args_map with
+        | None -> (impl.generics.types, i_tys, f.signature.generics.types)
+        | Some filter ->
+            let filter_list filter ls =
+              let ls = List.combine filter ls in
+              List.filter_map (fun (b, ty) -> if b then Some ty else None) ls
+            in
+            let impl_types = impl.generics.types in
+            let impl_filter =
+              Collections.List.prefix (List.length impl_types) filter
+            in
+            let i_tys = i_tys in
+            let i_filter = Collections.List.prefix (List.length i_tys) filter in
+            ( filter_list impl_filter impl_types,
+              filter_list i_filter i_tys,
+              filter_list filter f.signature.generics.types )
+      in
+      let f_generics = { f.signature.generics with types = f_tys } in
       (* Extract the generics - we need to quantify over the generics which
          are specific to the method, and call it will all the generics
          (trait impl + method generics) *)
       let f_generics =
-        generic_params_drop_prefix impl.generics f.signature.generics
+        generic_params_drop_prefix
+          { impl.generics with types = impl_types }
+          f_generics
       in
+      (* Register and print the quantified generics *)
       let ctx, f_tys, f_cgs, f_tcs = ctx_add_generic_params f_generics ctx in
       let use_forall = f_generics <> empty_generic_params in
       extract_generic_params ctx fmt TypeDeclId.Set.empty ~use_forall f_generics
@@ -4609,12 +2325,14 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter)
       if use_forall then F.pp_print_string fmt ",";
       (* Extract the function call *)
       F.pp_print_space fmt ();
-      let id = ctx_get_local_function f.def_id None f.back_id ctx in
-      F.pp_print_string fmt id;
+      let fun_name = ctx_get_local_function f.def_id None f.back_id ctx in
+      F.pp_print_string fmt fun_name;
       let all_generics =
-        let i_tys, i_cgs, i_tcs = impl_generics in
+        let _, i_cgs, i_tcs = impl_generics in
         List.concat [ i_tys; f_tys; i_cgs; f_cgs; i_tcs; f_tcs ]
       in
+
+      (* Filter the generics if the function is builtin *)
       List.iter
         (fun p ->
           F.pp_print_space fmt ();
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 3eef6b3b..7e8e4ffc 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -653,6 +653,8 @@ type extraction_ctx = {
         *)
   funs_filter_type_args_map : bool list FunDeclId.Map.t;
       (** Same as {!types_filter_type_args_map}, but for functions *)
+  trait_impls_filter_type_args_map : bool list TraitImplId.Map.t;
+      (** Same as {!types_filter_type_args_map}, but for trait implementations *)
 }
 
 (** Debugging function, used when communicating name collisions to the user,
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index c781463e..fa873c6a 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -122,7 +122,7 @@ let builtin_types () : builtin_type_info list =
       extract_name =
         (match !backend with
         | Lean -> "alloc.alloc.Global"
-        | Coq | FStar | HOL4 -> "alloc_global");
+        | Coq | FStar | HOL4 -> "alloc_alloc_Global");
       keep_params = None;
       body_info = None;
     };
@@ -130,7 +130,9 @@ let builtin_types () : builtin_type_info list =
     {
       rust_name = [ "alloc"; "vec"; "Vec" ];
       extract_name =
-        (match !backend with Lean -> "Vec" | Coq | FStar | HOL4 -> "vec");
+        (match !backend with
+        | Lean -> "alloc.vec.Vec"
+        | Coq | FStar | HOL4 -> "alloc_vec_Vec");
       keep_params = Some [ true; false ];
       body_info = None;
     };
@@ -170,15 +172,17 @@ let builtin_types () : builtin_type_info list =
     {
       rust_name = [ "core"; "ops"; "range"; "Range" ];
       extract_name =
-        (match !backend with Lean -> "Range" | Coq | FStar | HOL4 -> "range");
+        (match !backend with
+        | Lean -> "core.ops.range.Range"
+        | Coq | FStar | HOL4 -> "core_ops_range_Range");
       keep_params = None;
       body_info =
         Some
           (Struct
              ( (match !backend with
-               | Lean -> "Range.mk"
-               | Coq | HOL4 -> "mk_range"
-               | FStar -> "Mkrange"),
+               | Lean -> "core.ops.range.Range.mk"
+               | Coq | HOL4 -> "mk_core_ops_range_Range"
+               | FStar -> "Mkcore_ops_range_Range"),
                [ "start"; "end_" ] ));
     };
   ]
@@ -204,340 +208,118 @@ type builtin_fun_info = {
 let builtin_funs () :
     (string list * bool list option * builtin_fun_info list) list =
   let rg0 = Some Types.RegionGroupId.zero in
+  (* Small utility *)
+  let mk_fun (name : string list) (extract_name : string list option)
+      (filter : bool list option) (with_back : bool) (back_no_suffix : bool) :
+      string list * bool list option * builtin_fun_info list =
+    let extract_name =
+      match extract_name with None -> name | Some name -> name
+    in
+    let fwd_name =
+      match !backend with
+      | FStar | Coq | HOL4 -> String.concat "_" extract_name
+      | Lean -> String.concat "." extract_name
+    in
+    let fwd_suffix = if with_back && back_no_suffix then "_fwd" else "" in
+    let fwd = [ { rg = None; extract_name = fwd_name ^ fwd_suffix } ] in
+    let back_suffix = if with_back && back_no_suffix then "" else "_back" in
+    let back =
+      if with_back then [ { rg = rg0; extract_name = fwd_name ^ back_suffix } ]
+      else []
+    in
+    (name, filter, fwd @ back)
+  in
   [
-    ( [ "core"; "mem"; "replace" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_mem_replace_fwd"
-            | Lean -> "core.mem.replace");
-        };
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_mem_replace_back"
-            | Lean -> "core.mem.replace_back");
-        };
-      ] );
-    ( [ "alloc"; "vec"; "Vec"; "new" ],
-      Some [ true; false ],
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_new"
-            | Lean -> "Vec.new");
-        };
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_new_back"
-            | Lean -> "Vec.new_back");
-        };
-      ] );
-    ( [ "alloc"; "vec"; "Vec"; "push" ],
-      Some [ true; false ],
-      [
-        (* The forward function shouldn't be used *)
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_push_fwd"
-            | Lean -> "Vec.push_fwd");
-        };
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_push_back"
-            | Lean -> "Vec.push");
-        };
-      ] );
-    ( [ "alloc"; "vec"; "Vec"; "insert" ],
-      Some [ true; false ],
-      [
-        (* The forward function shouldn't be used *)
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_insert_fwd"
-            | Lean -> "Vec.insert_fwd");
-        };
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_insert_back"
-            | Lean -> "Vec.insert");
-        };
-      ] );
-    ( [ "alloc"; "vec"; "Vec"; "len" ],
-      Some [ true; false ],
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_len"
-            | Lean -> "Vec.len");
-        };
-      ] );
-    ( [ "alloc"; "vec"; "Vec"; "index" ],
-      Some [ true; false ],
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_index_fwd"
-            | Lean -> "Vec.index_shared");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_index_back"
-            | Lean -> "Vec.index_shared_back");
-        };
-      ] );
-    ( [ "alloc"; "vec"; "Vec"; "index_mut" ],
-      Some [ true; false ],
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_index_mut_fwd"
-            | Lean -> "Vec.index_mut");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "vec_index_mut_back"
-            | Lean -> "Vec.index_mut_back");
-        };
-      ] );
-    ( [ "alloc"; "boxed"; "Box"; "deref" ],
-      Some [ true; false ],
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref"
-            | Lean -> "alloc.boxed.Box.deref");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref_back"
-            | Lean -> "alloc.boxed.Box.deref_back");
-        };
-      ] );
-    ( [ "alloc"; "boxed"; "Box"; "deref_mut" ],
-      Some [ true; false ],
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref_mut"
-            | Lean -> "alloc.boxed.Box.deref_mut");
-        };
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_mut_back"
-            | Lean -> "alloc.boxed.Box.deref_mut_back");
-        };
-      ] );
+    mk_fun [ "core"; "mem"; "replace" ] None None true false;
+    mk_fun [ "alloc"; "vec"; "Vec"; "new" ] None None false false;
+    mk_fun
+      [ "alloc"; "vec"; "Vec"; "push" ]
+      None
+      (Some [ true; false ])
+      true true;
+    mk_fun
+      [ "alloc"; "vec"; "Vec"; "insert" ]
+      None
+      (Some [ true; false ])
+      true true;
+    mk_fun
+      [ "alloc"; "vec"; "Vec"; "len" ]
+      None
+      (Some [ true; false ])
+      true false;
+    mk_fun
+      [ "alloc"; "vec"; "Vec"; "index" ]
+      None
+      (Some [ true; true; false ])
+      true false;
+    mk_fun
+      [ "alloc"; "vec"; "Vec"; "index_mut" ]
+      None
+      (Some [ true; true; false ])
+      true false;
+    mk_fun
+      [ "alloc"; "boxed"; "Box"; "deref" ]
+      None
+      (Some [ true; false ])
+      true false;
+    mk_fun
+      [ "alloc"; "boxed"; "Box"; "deref_mut" ]
+      None
+      (Some [ true; false ])
+      true false;
     (* TODO: fix the same like "[T]" below *)
-    ( [ "core"; "slice"; "index"; "[T]"; "index" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Slice_index"
-            | Lean -> "core.slice.index.Slice.index");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_back"
-            | Lean -> "core.slice.index.Slice.index_back");
-        };
-      ] );
-    ( [ "core"; "slice"; "index"; "[T]"; "index_mut" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_mut"
-            | Lean -> "core.slice.index.Slice.index_mut");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_mut_back"
-            | Lean -> "core.slice.index.Slice.index_mut_back");
-        };
-      ] );
-    ( [ "core"; "array"; "[T; N]"; "index" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_array_Array_index"
-            | Lean -> "core.array.Array.index");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_array_Array_index_back"
-            | Lean -> "core.array.Array.index_back");
-        };
-      ] );
-    ( [ "core"; "array"; "[T; N]"; "index_mut" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_array_Array_index_mut"
-            | Lean -> "core.array.Array.index_mut");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_array_Array_index_mut_back"
-            | Lean -> "core.array.Array.index_mut_back");
-        };
-      ] );
-    ( [ "core"; "slice"; "index"; "Range"; "get" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_get"
-            | Lean -> "core.slice.index.Range.get");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_back"
-            | Lean -> "core.slice.index.Range.get_back");
-        };
-      ] );
-    ( [ "core"; "slice"; "index"; "Range"; "get_mut" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_mut"
-            | Lean -> "core.slice.index.Range.get_mut");
-        };
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_mut_back"
-            | Lean -> "core.slice.index.Range.get_mut_back");
-        };
-      ] );
-    ( [ "core"; "slice"; "index"; "Range"; "index" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_index"
-            | Lean -> "core.slice.index.Range.index");
-        };
-        (* The backward function shouldn't be used *)
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_index_back"
-            | Lean -> "core.slice.index.Range.index_back");
-        };
-      ] );
-    ( [ "core"; "slice"; "index"; "Range"; "index_mut" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_index_mut"
-            | Lean -> "core.slice.index.Range.index_mut");
-        };
-        {
-          rg = rg0;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_index_mut_back"
-            | Lean -> "core.slice.index.Range.index_mut_back");
-        };
-      ] );
-    ( [ "core"; "slice"; "index"; "Range"; "get_unchecked" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_unchecked"
-            | Lean -> "core.slice.index.Range.get_unchecked");
-        };
-      ] );
-    ( [ "core"; "slice"; "index"; "Range"; "get_unchecked_mut" ],
-      None,
-      [
-        {
-          rg = None;
-          extract_name =
-            (match !backend with
-            | FStar | Coq | HOL4 -> "core_slice_index_Range_get_unchecked_mut"
-            | Lean -> "core.slice.index.Range.get_unchecked_mut");
-        };
-      ] );
+    mk_fun
+      [ "core"; "slice"; "index"; "[T]"; "index" ]
+      (Some [ "core"; "slice"; "index"; "Slice"; "index" ])
+      None true false;
+    mk_fun
+      [ "core"; "slice"; "index"; "[T]"; "index_mut" ]
+      (Some [ "core"; "slice"; "index"; "Slice"; "index_mut" ])
+      None true false;
+    mk_fun
+      [ "core"; "array"; "[T; N]"; "index" ]
+      (Some [ "core"; "array"; "Array"; "index" ])
+      None true false;
+    mk_fun
+      [ "core"; "array"; "[T; N]"; "index_mut" ]
+      (Some [ "core"; "array"; "Array"; "index_mut" ])
+      None true false;
+    mk_fun [ "core"; "slice"; "index"; "Range"; "get" ] None None true false;
+    mk_fun [ "core"; "slice"; "index"; "Range"; "get_mut" ] None None true false;
+    mk_fun [ "core"; "slice"; "index"; "Range"; "index" ] None None true false;
+    mk_fun
+      [ "core"; "slice"; "index"; "Range"; "index_mut" ]
+      None None true false;
+    mk_fun
+      [ "core"; "slice"; "index"; "Range"; "get_unchecked" ]
+      None None false false;
+    mk_fun
+      [ "core"; "slice"; "index"; "Range"; "get_unchecked_mut" ]
+      None None false false;
+    mk_fun
+      [ "core"; "slice"; "index"; "usize"; "get" ]
+      (Some [ "core"; "slice"; "index"; "Usize"; "get" ])
+      None true false;
+    mk_fun
+      [ "core"; "slice"; "index"; "usize"; "get_mut" ]
+      (Some [ "core"; "slice"; "index"; "Usize"; "get_mut" ])
+      None true false;
+    mk_fun
+      [ "core"; "slice"; "index"; "usize"; "get_unchecked" ]
+      (Some [ "core"; "slice"; "index"; "Usize"; "get_unchecked" ])
+      None false false;
+    mk_fun
+      [ "core"; "slice"; "index"; "usize"; "get_unchecked_mut" ]
+      (Some [ "core"; "slice"; "index"; "Usize"; "get_unchecked_mut" ])
+      None false false;
+    mk_fun
+      [ "core"; "slice"; "index"; "usize"; "index" ]
+      (Some [ "core"; "slice"; "index"; "Usize"; "index" ])
+      None true false;
+    mk_fun
+      [ "core"; "slice"; "index"; "usize"; "index_mut" ]
+      (Some [ "core"; "slice"; "index"; "Usize"; "index_mut" ])
+      None true false;
   ]
 
 let mk_builtin_funs_map () =
@@ -576,6 +358,8 @@ let builtin_non_fallible_funs =
   in
   let int_funs = List.concat int_funs in
   [
+    "alloc::vec::Vec::new";
+    "alloc::vec::Vec::len";
     "alloc::boxed::Box::deref";
     "alloc::boxed::Box::deref_mut";
     "core::mem::replace";
@@ -847,37 +631,68 @@ end
 
 module SimpleNamePairMap = Collections.MakeMap (SimpleNamePairOrd)
 
-let builtin_trait_impls_info () : ((string list * string list) * string) list =
+let builtin_trait_impls_info () :
+    ((string list * string list) * (bool list option * string)) list =
+  let fmt ?(filter : bool list option = None) (name : string) :
+      bool list option * string =
+    let name =
+      match !backend with
+      | Lean -> name
+      | FStar | Coq | HOL4 ->
+          let name = String.split_on_char '.' name in
+          String.concat "_" name
+    in
+    (filter, name)
+  in
   (* TODO: fix the names like "[T]" below *)
   [
     (* core::ops::Deref<alloc::boxed::Box<T>> *)
     ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "Deref" ]),
-      "alloc.boxed.Box.coreOpsDerefInst" );
+      fmt "alloc.boxed.Box.coreOpsDerefInst" );
     (* core::ops::DerefMut<alloc::boxed::Box<T>> *)
     ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "DerefMut" ]),
-      "alloc.boxed.Box.coreOpsDerefMutInst" );
+      fmt "alloc.boxed.Box.coreOpsDerefMutInst" );
     (* core::ops::index::Index<[T], I> *)
     ( ([ "core"; "slice"; "index"; "[T]" ], [ "core"; "ops"; "index"; "Index" ]),
-      "core.slice.index.Slice.coreopsindexIndexInst" );
+      fmt "core.slice.index.Slice.coreopsindexIndexInst" );
     (* core::slice::index::private_slice_index::Sealed<Range<usize>> *)
     ( ( [ "core"; "slice"; "index"; "private_slice_index"; "Range" ],
         [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ] ),
-      "core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst"
+      fmt
+        "core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst"
     );
     (* core::slice::index::SliceIndex<Range<usize>, [T]> *)
     ( ( [ "core"; "slice"; "index"; "Range" ],
         [ "core"; "slice"; "index"; "SliceIndex" ] ),
-      "core.slice.index.Range.coresliceindexSliceIndexInst" );
+      fmt "core.slice.index.Range.coresliceindexSliceIndexInst" );
     (* core::ops::index::IndexMut<[T], I> *)
     ( ( [ "core"; "slice"; "index"; "[T]" ],
         [ "core"; "ops"; "index"; "IndexMut" ] ),
-      "core.slice.index.Slice.coreopsindexIndexMutInst" );
+      fmt "core.slice.index.Slice.coreopsindexIndexMutInst" );
     (* core::ops::index::Index<[T; N], I> *)
     ( ([ "core"; "array"; "[T; N]" ], [ "core"; "ops"; "index"; "Index" ]),
-      "core.array.Array.coreopsindexIndexInst" );
+      fmt "core.array.Array.coreopsindexIndexInst" );
     (* core::ops::index::IndexMut<[T; N], I> *)
     ( ([ "core"; "array"; "[T; N]" ], [ "core"; "ops"; "index"; "IndexMut" ]),
-      "core.array.Array.coreopsindexIndexMutInst" );
+      fmt "core.array.Array.coreopsindexIndexMutInst" );
+    (* core::slice::index::private_slice_index::Sealed<usize> *)
+    ( ( [ "core"; "slice"; "index"; "private_slice_index"; "usize" ],
+        [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ] ),
+      fmt
+        "core.slice.index.private_slice_index.usize.coresliceindexprivate_slice_indexSealedInst"
+    );
+    (* core::slice::index::SliceIndex<usize, [T]> *)
+    ( ( [ "core"; "slice"; "index"; "usize" ],
+        [ "core"; "slice"; "index"; "SliceIndex" ] ),
+      fmt "core.slice.index.usize.coresliceindexSliceIndexInst" );
+    (* core::ops::index::Index<Vec<T>, T> *)
+    ( ([ "alloc"; "vec"; "Vec" ], [ "core"; "ops"; "index"; "Index" ]),
+      let filter = Some [ true; true; false ] in
+      fmt ~filter "alloc.vec.Vec.coreopsindexIndexInst" );
+    (* core::ops::index::IndexMut<Vec<T>, T> *)
+    ( ([ "alloc"; "vec"; "Vec" ], [ "core"; "ops"; "index"; "IndexMut" ]),
+      let filter = Some [ true; true; false ] in
+      fmt ~filter "alloc.vec.Vec.coreopsindexIndexMutInst" );
   ]
 
 let mk_builtin_trait_impls_map () =
diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml
new file mode 100644
index 00000000..219f273f
--- /dev/null
+++ b/compiler/ExtractTypes.ml
@@ -0,0 +1,2390 @@
+(** The generic extraction *)
+(* Turn the whole module into a functor: it is very annoying to carry the
+   the formatter everywhere...
+*)
+
+open Pure
+open PureUtils
+open TranslateCore
+open ExtractBase
+open StringUtils
+open Config
+module F = Format
+
+(** Small helper to compute the name of an int type *)
+let int_name (int_ty : integer_type) =
+  let isize, usize, i_format, u_format =
+    match !backend with
+    | FStar | Coq | HOL4 ->
+        ("isize", "usize", format_of_string "i%d", format_of_string "u%d")
+    | Lean -> ("Isize", "Usize", format_of_string "I%d", format_of_string "U%d")
+  in
+  match int_ty with
+  | Isize -> isize
+  | I8 -> Printf.sprintf i_format 8
+  | I16 -> Printf.sprintf i_format 16
+  | I32 -> Printf.sprintf i_format 32
+  | I64 -> Printf.sprintf i_format 64
+  | I128 -> Printf.sprintf i_format 128
+  | Usize -> usize
+  | U8 -> Printf.sprintf u_format 8
+  | U16 -> Printf.sprintf u_format 16
+  | U32 -> Printf.sprintf u_format 32
+  | U64 -> Printf.sprintf u_format 64
+  | U128 -> Printf.sprintf u_format 128
+
+(** Small helper to compute the name of a unary operation *)
+let unop_name (unop : unop) : string =
+  match unop with
+  | Not -> (
+      match !backend with FStar | Lean -> "not" | Coq -> "negb" | HOL4 -> "~")
+  | Neg (int_ty : integer_type) -> (
+      match !backend with Lean -> "-" | _ -> int_name int_ty ^ "_neg")
+  | Cast _ ->
+      (* We never directly use the unop name in this case *)
+      raise (Failure "Unsupported")
+
+(** Small helper to compute the name of a binary operation (note that many
+    binary operations like "less than" are extracted to primitive operations,
+    like [<]).
+ *)
+let named_binop_name (binop : E.binop) (int_ty : integer_type) : string =
+  let binop =
+    match binop with
+    | Div -> "div"
+    | Rem -> "rem"
+    | Add -> "add"
+    | Sub -> "sub"
+    | Mul -> "mul"
+    | Lt -> "lt"
+    | Le -> "le"
+    | Ge -> "ge"
+    | Gt -> "gt"
+    | BitXor -> "xor"
+    | BitAnd -> "and"
+    | BitOr -> "or"
+    | Shl -> "lsl"
+    | Shr ->
+        "asr"
+        (* NOTE: make sure arithmetic shift right is implemented, i.e. OCaml's asr operator, not lsr *)
+    | _ -> raise (Failure "Unreachable")
+  in
+  (* Remark: the Lean case is actually not used *)
+  match !backend with
+  | Lean -> int_name int_ty ^ "." ^ binop
+  | FStar | Coq | HOL4 -> int_name int_ty ^ "_" ^ binop
+
+(** A list of keywords/identifiers used by the backend and with which we
+    want to check collision.
+
+    Remark: this is useful mostly to look for collisions when generating
+    names for *variables*.
+ *)
+let keywords () =
+  let named_unops =
+    unop_name Not
+    :: List.map (fun it -> unop_name (Neg it)) T.all_signed_int_types
+  in
+  let named_binops = [ E.Div; Rem; Add; Sub; Mul ] in
+  let named_binops =
+    List.concat_map
+      (fun bn -> List.map (fun it -> named_binop_name bn it) T.all_int_types)
+      named_binops
+  in
+  let misc =
+    match !backend with
+    | FStar ->
+        [
+          "assert";
+          "assert_norm";
+          "assume";
+          "else";
+          "fun";
+          "fn";
+          "FStar";
+          "FStar.Mul";
+          "if";
+          "in";
+          "include";
+          "int";
+          "let";
+          "list";
+          "match";
+          "not";
+          "open";
+          "rec";
+          "scalar_cast";
+          "then";
+          "type";
+          "Type0";
+          "Type";
+          "unit";
+          "val";
+          "with";
+        ]
+    | Coq ->
+        [
+          "assert";
+          "Arguments";
+          "Axiom";
+          "char_of_byte";
+          "Check";
+          "Declare";
+          "Definition";
+          "else";
+          "End";
+          "fun";
+          "Fixpoint";
+          "if";
+          "in";
+          "int";
+          "Inductive";
+          "Import";
+          "let";
+          "Lemma";
+          "match";
+          "Module";
+          "not";
+          "Notation";
+          "Proof";
+          "Qed";
+          "rec";
+          "Record";
+          "Require";
+          "Scope";
+          "Search";
+          "SearchPattern";
+          "Set";
+          "then";
+          (* [tt] is unit *)
+          "tt";
+          "type";
+          "Type";
+          "unit";
+          "with";
+        ]
+    | Lean ->
+        [
+          "by";
+          "class";
+          "decreasing_by";
+          "def";
+          "deriving";
+          "do";
+          "else";
+          "end";
+          "for";
+          "have";
+          "if";
+          "inductive";
+          "instance";
+          "import";
+          "let";
+          "macro";
+          "match";
+          "namespace";
+          "opaque";
+          "open";
+          "run_cmd";
+          "set_option";
+          "simp";
+          "structure";
+          "syntax";
+          "termination_by";
+          "then";
+          "Type";
+          "unsafe";
+          "where";
+          "with";
+          "opaque_defs";
+        ]
+    | HOL4 ->
+        [
+          "Axiom";
+          "case";
+          "Definition";
+          "else";
+          "End";
+          "fix";
+          "fix_exec";
+          "fn";
+          "fun";
+          "if";
+          "in";
+          "int";
+          "Inductive";
+          "let";
+          "of";
+          "Proof";
+          "QED";
+          "then";
+          "Theorem";
+        ]
+  in
+  List.concat [ named_unops; named_binops; misc ]
+
+let assumed_adts () : (assumed_ty * string) list =
+  match !backend with
+  | Lean ->
+      [
+        (State, "State");
+        (Result, "Result");
+        (Error, "Error");
+        (Fuel, "Nat");
+        (Array, "Array");
+        (Slice, "Slice");
+        (Str, "Str");
+        (RawPtr Mut, "MutRawPtr");
+        (RawPtr Const, "ConstRawPtr");
+      ]
+  | Coq | FStar | HOL4 ->
+      [
+        (State, "state");
+        (Result, "result");
+        (Error, "error");
+        (Fuel, if !backend = HOL4 then "num" else "nat");
+        (Array, "array");
+        (Slice, "slice");
+        (Str, "str");
+        (RawPtr Mut, "mut_raw_ptr");
+        (RawPtr Const, "const_raw_ptr");
+      ]
+
+let assumed_struct_constructors () : (assumed_ty * string) list =
+  match !backend with
+  | Lean -> [ (Array, "Array.make") ]
+  | Coq -> [ (Array, "mk_array") ]
+  | FStar -> [ (Array, "mk_array") ]
+  | HOL4 -> [ (Array, "mk_array") ]
+
+let assumed_variants () : (assumed_ty * VariantId.id * string) list =
+  match !backend with
+  | FStar ->
+      [
+        (Result, result_return_id, "Return");
+        (Result, result_fail_id, "Fail");
+        (Error, error_failure_id, "Failure");
+        (Error, error_out_of_fuel_id, "OutOfFuel");
+        (* No Fuel::Zero on purpose *)
+        (* No Fuel::Succ on purpose *)
+      ]
+  | Coq ->
+      [
+        (Result, result_return_id, "Return");
+        (Result, result_fail_id, "Fail_");
+        (Error, error_failure_id, "Failure");
+        (Error, error_out_of_fuel_id, "OutOfFuel");
+        (Fuel, fuel_zero_id, "O");
+        (Fuel, fuel_succ_id, "S");
+      ]
+  | Lean ->
+      [
+        (Result, result_return_id, "ret");
+        (Result, result_fail_id, "fail");
+        (Error, error_failure_id, "panic");
+        (* No Fuel::Zero on purpose *)
+        (* No Fuel::Succ on purpose *)
+      ]
+  | HOL4 ->
+      [
+        (Result, result_return_id, "Return");
+        (Result, result_fail_id, "Fail");
+        (Error, error_failure_id, "Failure");
+        (* No Fuel::Zero on purpose *)
+        (* No Fuel::Succ on purpose *)
+      ]
+
+let assumed_llbc_functions () :
+    (A.assumed_fun_id * T.RegionGroupId.id option * string) list =
+  let rg0 = Some T.RegionGroupId.zero in
+  match !backend with
+  | FStar | Coq | HOL4 ->
+      [
+        (ArrayIndexShared, None, "array_index_shared");
+        (ArrayIndexMut, None, "array_index_mut_fwd");
+        (ArrayIndexMut, rg0, "array_index_mut_back");
+        (ArrayToSliceShared, None, "array_to_slice_shared");
+        (ArrayToSliceMut, None, "array_to_slice_mut_fwd");
+        (ArrayToSliceMut, rg0, "array_to_slice_mut_back");
+        (ArrayRepeat, None, "array_repeat");
+        (SliceIndexShared, None, "slice_index_shared");
+        (SliceIndexMut, None, "slice_index_mut_fwd");
+        (SliceIndexMut, rg0, "slice_index_mut_back");
+        (SliceLen, None, "slice_len");
+      ]
+  | Lean ->
+      [
+        (ArrayIndexShared, None, "Array.index_shared");
+        (ArrayIndexMut, None, "Array.index_mut");
+        (ArrayIndexMut, rg0, "Array.index_mut_back");
+        (ArrayToSliceShared, None, "Array.to_slice_shared");
+        (ArrayToSliceMut, None, "Array.to_slice_mut");
+        (ArrayToSliceMut, rg0, "Array.to_slice_mut_back");
+        (ArrayRepeat, None, "Array.repeat");
+        (SliceIndexShared, None, "Slice.index_shared");
+        (SliceIndexMut, None, "Slice.index_mut");
+        (SliceIndexMut, rg0, "Slice.index_mut_back");
+        (SliceLen, None, "Slice.len");
+      ]
+
+let assumed_pure_functions () : (pure_assumed_fun_id * string) list =
+  match !backend with
+  | FStar ->
+      [
+        (Return, "return");
+        (Fail, "fail");
+        (Assert, "massert");
+        (FuelDecrease, "decrease");
+        (FuelEqZero, "is_zero");
+      ]
+  | Coq ->
+      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
+      [ (Return, "return_"); (Fail, "fail_"); (Assert, "massert") ]
+  | Lean ->
+      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
+      [ (Return, "return"); (Fail, "fail_"); (Assert, "massert") ]
+  | HOL4 ->
+      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
+      [ (Return, "return"); (Fail, "fail"); (Assert, "massert") ]
+
+let names_map_init () : names_map_init =
+  {
+    keywords = keywords ();
+    assumed_adts = assumed_adts ();
+    assumed_structs = assumed_struct_constructors ();
+    assumed_variants = assumed_variants ();
+    assumed_llbc_functions = assumed_llbc_functions ();
+    assumed_pure_functions = assumed_pure_functions ();
+  }
+
+let extract_unop (extract_expr : bool -> texpression -> unit)
+    (fmt : F.formatter) (inside : bool) (unop : unop) (arg : texpression) : unit
+    =
+  match unop with
+  | Not | Neg _ ->
+      let unop = unop_name unop in
+      if inside then F.pp_print_string fmt "(";
+      F.pp_print_string fmt unop;
+      F.pp_print_space fmt ();
+      extract_expr true arg;
+      if inside then F.pp_print_string fmt ")"
+  | Cast (src, tgt) -> (
+      (* HOL4 has a special treatment: because it doesn't support dependent
+         types, we don't have a specific operator for the cast *)
+      match !backend with
+      | HOL4 ->
+          (* Casting, say, an u32 to an i32 would be done as follows:
+             {[
+               mk_i32 (u32_to_int x)
+             ]}
+          *)
+          if inside then F.pp_print_string fmt "(";
+          F.pp_print_string fmt ("mk_" ^ int_name tgt);
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "(";
+          F.pp_print_string fmt (int_name src ^ "_to_int");
+          F.pp_print_space fmt ();
+          extract_expr true arg;
+          F.pp_print_string fmt ")";
+          if inside then F.pp_print_string fmt ")"
+      | FStar | Coq | Lean ->
+          (* Rem.: the source type is an implicit parameter *)
+          if inside then F.pp_print_string fmt "(";
+          let cast_str =
+            match !backend with
+            | Coq | FStar -> "scalar_cast"
+            | Lean -> (* TODO: I8.cast, I16.cast, etc.*) "Scalar.cast"
+            | HOL4 -> raise (Failure "Unreachable")
+          in
+          F.pp_print_string fmt cast_str;
+          F.pp_print_space fmt ();
+          if !backend <> Lean then (
+            F.pp_print_string fmt
+              (StringUtils.capitalize_first_letter
+                 (PrintPure.integer_type_to_string src));
+            F.pp_print_space fmt ());
+          if !backend = Lean then F.pp_print_string fmt ("." ^ int_name tgt)
+          else
+            F.pp_print_string fmt
+              (StringUtils.capitalize_first_letter
+                 (PrintPure.integer_type_to_string tgt));
+          F.pp_print_space fmt ();
+          extract_expr true arg;
+          if inside then F.pp_print_string fmt ")")
+
+(** [extract_expr] : the boolean argument is [inside] *)
+let extract_binop (extract_expr : bool -> texpression -> unit)
+    (fmt : F.formatter) (inside : bool) (binop : E.binop)
+    (int_ty : integer_type) (arg0 : texpression) (arg1 : texpression) : unit =
+  if inside then F.pp_print_string fmt "(";
+  (* Some binary operations have a special notation depending on the backend *)
+  (match (!backend, binop) with
+  | HOL4, (Eq | Ne)
+  | (FStar | Coq | Lean), (Eq | Lt | Le | Ne | Ge | Gt)
+  | Lean, (Div | Rem | Add | Sub | Mul) ->
+      let binop =
+        match binop with
+        | Eq -> "="
+        | Lt -> "<"
+        | Le -> "<="
+        | Ne -> if !backend = Lean then "!=" else "<>"
+        | Ge -> ">="
+        | Gt -> ">"
+        | Div -> "/"
+        | Rem -> "%"
+        | Add -> "+"
+        | Sub -> "-"
+        | Mul -> "*"
+        | _ -> raise (Failure "Unreachable")
+      in
+      let binop =
+        match !backend with FStar | Lean | HOL4 -> binop | Coq -> "s" ^ binop
+      in
+      extract_expr false arg0;
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt binop;
+      F.pp_print_space fmt ();
+      extract_expr false arg1
+  | _ ->
+      let binop = named_binop_name binop int_ty in
+      F.pp_print_string fmt binop;
+      F.pp_print_space fmt ();
+      extract_expr true arg0;
+      F.pp_print_space fmt ();
+      extract_expr true arg1);
+  if inside then F.pp_print_string fmt ")"
+
+let type_decl_kind_to_qualif (kind : decl_kind)
+    (type_kind : type_decl_kind option) : string option =
+  match !backend with
+  | FStar -> (
+      match kind with
+      | SingleNonRec -> Some "type"
+      | SingleRec -> Some "type"
+      | MutRecFirst -> Some "type"
+      | MutRecInner -> Some "and"
+      | MutRecLast -> Some "and"
+      | Assumed -> Some "assume type"
+      | Declared -> Some "val")
+  | Coq -> (
+      match (kind, type_kind) with
+      | SingleNonRec, Some Enum -> Some "Inductive"
+      | SingleNonRec, Some Struct -> Some "Record"
+      | (SingleRec | MutRecFirst), Some _ -> Some "Inductive"
+      | (MutRecInner | MutRecLast), Some _ ->
+          (* Coq doesn't support groups of mutually recursive definitions which mix
+           * records and inducties: we convert everything to records if this happens
+           *)
+          Some "with"
+      | (Assumed | Declared), None -> Some "Axiom"
+      | SingleNonRec, None ->
+          (* This is for traits *)
+          Some "Record"
+      | _ ->
+          raise
+            (Failure
+               ("Unexpected: (" ^ show_decl_kind kind ^ ", "
+               ^ Print.option_to_string show_type_decl_kind type_kind
+               ^ ")")))
+  | Lean -> (
+      match kind with
+      | SingleNonRec ->
+          if type_kind = Some Struct then Some "structure" else Some "inductive"
+      | SingleRec -> Some "inductive"
+      | MutRecFirst -> Some "inductive"
+      | MutRecInner -> Some "inductive"
+      | MutRecLast -> Some "inductive"
+      | Assumed -> Some "axiom"
+      | Declared -> Some "axiom")
+  | HOL4 -> None
+
+let fun_decl_kind_to_qualif (kind : decl_kind) : string option =
+  match !backend with
+  | FStar -> (
+      match kind with
+      | SingleNonRec -> Some "let"
+      | SingleRec -> Some "let rec"
+      | MutRecFirst -> Some "let rec"
+      | MutRecInner -> Some "and"
+      | MutRecLast -> Some "and"
+      | Assumed -> Some "assume val"
+      | Declared -> Some "val")
+  | Coq -> (
+      match kind with
+      | SingleNonRec -> Some "Definition"
+      | SingleRec -> Some "Fixpoint"
+      | MutRecFirst -> Some "Fixpoint"
+      | MutRecInner -> Some "with"
+      | MutRecLast -> Some "with"
+      | Assumed -> Some "Axiom"
+      | Declared -> Some "Axiom")
+  | Lean -> (
+      match kind with
+      | SingleNonRec -> Some "def"
+      | SingleRec -> Some "divergent def"
+      | MutRecFirst -> Some "mutual divergent def"
+      | MutRecInner -> Some "divergent def"
+      | MutRecLast -> Some "divergent def"
+      | Assumed -> Some "axiom"
+      | Declared -> Some "axiom")
+  | HOL4 -> None
+
+(** The type of types.
+
+    TODO: move inside the formatter?
+ *)
+let type_keyword () =
+  match !backend with
+  | FStar -> "Type0"
+  | Coq | Lean -> "Type"
+  | HOL4 -> raise (Failure "Unexpected")
+
+(**
+   [ctx]: we use the context to lookup type definitions, to retrieve type names.
+   This is used to compute variable names, when they have no basenames: in this
+   case we use the first letter of the type name.
+
+   [variant_concatenate_type_name]: if true, add the type name as a prefix
+   to the variant names.
+   Ex.:
+   In Rust:
+     {[
+       enum List = {
+         Cons(u32, Box<List>),x
+         Nil,
+       }
+     ]}
+
+   F*, if option activated:
+     {[
+       type list =
+       | ListCons : u32 -> list -> list
+       | ListNil : list
+     ]}
+
+   F*, if option not activated:
+     {[
+       type list =
+       | Cons : u32 -> list -> list
+       | Nil : list
+     ]}
+
+   Rk.: this should be true by default, because in Rust all the variant names
+   are actively uniquely identifier by the type name [List::Cons(...)], while
+   in other languages it is not necessarily the case, and thus clashes can mess
+   up type checking. Note that some languages actually forbids the name clashes
+   (it is the case of F* ).
+ *)
+let mk_formatter (ctx : trans_ctx) (crate_name : string)
+    (variant_concatenate_type_name : bool) : formatter =
+  let int_name = int_name in
+
+  (* Prepare a name.
+   * The first id elem is always the crate: if it is the local crate,
+   * we remove it.
+   * We also remove all the disambiguators, then convert everything to strings.
+   * **Rmk:** because we remove the disambiguators, there may be name collisions
+   * (which is ok, because we check for name collisions and fail if there is any).
+   *)
+  let get_name (name : name) : string list =
+    (* Rmk.: initially we only filtered the disambiguators equal to 0 *)
+    let name = Names.filter_disambiguators name in
+    match name with
+    | Ident crate :: name ->
+        let name = if crate = crate_name then name else Ident crate :: name in
+        let name =
+          List.map
+            (function
+              | Names.Ident s -> s
+              | Disambiguator d -> Names.Disambiguator.to_string d)
+            name
+        in
+        name
+    | _ ->
+        raise (Failure ("Unexpected name shape: " ^ Print.name_to_string name))
+  in
+  let flatten_name (name : string list) : string =
+    match !backend with
+    | FStar | Coq | HOL4 -> String.concat "_" name
+    | Lean -> String.concat "." name
+  in
+  let get_type_name = get_name in
+  let type_name_to_camel_case name =
+    let name = get_type_name name in
+    let name = List.map to_camel_case name in
+    String.concat "" name
+  in
+  let type_name_to_snake_case name =
+    let name = get_type_name name in
+    let name = List.map to_snake_case name in
+    let name = String.concat "_" name in
+    match !backend with
+    | FStar | Lean | HOL4 -> name
+    | Coq -> capitalize_first_letter name
+  in
+  let type_name name =
+    match !backend with
+    | FStar | Coq | HOL4 -> type_name_to_snake_case name ^ "_t"
+    | Lean -> String.concat "." (get_type_name name)
+  in
+  let field_name (def_name : name) (field_id : FieldId.id)
+      (field_name : string option) : string =
+    let field_name_s =
+      match field_name with
+      | Some field_name -> field_name
+      | None ->
+          (* TODO: extract structs with no field names to tuples *)
+          FieldId.to_string field_id
+    in
+    if !Config.record_fields_short_names then
+      if field_name = None then (* TODO: this is a bit ugly *)
+        "_" ^ field_name_s
+      else field_name_s
+    else
+      let def_name = type_name_to_snake_case def_name ^ "_" in
+      def_name ^ field_name_s
+  in
+  let variant_name (def_name : name) (variant : string) : string =
+    match !backend with
+    | FStar | Coq | HOL4 ->
+        let variant = to_camel_case variant in
+        if variant_concatenate_type_name then
+          type_name_to_camel_case def_name ^ variant
+        else variant
+    | Lean -> variant
+  in
+  let struct_constructor (basename : name) : string =
+    let tname = type_name basename in
+    let prefix =
+      match !backend with FStar -> "Mk" | Coq | HOL4 -> "mk" | Lean -> ""
+    in
+    let suffix =
+      match !backend with FStar | Coq | HOL4 -> "" | Lean -> ".mk"
+    in
+    prefix ^ tname ^ suffix
+  in
+  let get_fun_name fname =
+    let fname = get_name fname in
+    (* TODO: don't convert to snake case for Coq, HOL4, F* *)
+    flatten_name fname
+  in
+  let global_name (name : global_name) : string =
+    (* Converting to snake case also lowercases the letters (in Rust, global
+     * names are written in capital letters). *)
+    let parts = List.map to_snake_case (get_name name) in
+    String.concat "_" parts
+  in
+  let fun_name (fname : fun_name) (num_loops : int) (loop_id : LoopId.id option)
+      (num_rgs : int) (rg : region_group_info option) (filter_info : bool * int)
+      : string =
+    let fname = get_fun_name fname in
+    (* Compute the suffix *)
+    let suffix = default_fun_suffix num_loops loop_id num_rgs rg filter_info in
+    (* Concatenate *)
+    fname ^ suffix
+  in
+
+  let trait_decl_name (trait_decl : trait_decl) : string =
+    type_name trait_decl.name
+  in
+
+  let trait_impl_name (trait_decl : trait_decl) (trait_impl : trait_impl) :
+      string =
+    (* TODO: provisional: we concatenate the trait impl name (which is its type)
+       with the trait decl name *)
+    let trait_decl =
+      let name = trait_decl.name in
+      match !backend with
+      | FStar | Coq | HOL4 -> type_name_to_snake_case name ^ "_inst"
+      | Lean -> String.concat "" (get_type_name name) ^ "Inst"
+    in
+    flatten_name (get_type_name trait_impl.name @ [ trait_decl ])
+  in
+
+  let trait_parent_clause_name (trait_decl : trait_decl) (clause : trait_clause)
+      : string =
+    (* TODO: improve - it would be better to not use indices *)
+    let clause = "parent_clause_" ^ TraitClauseId.to_string clause.clause_id in
+    if !Config.record_fields_short_names then clause
+    else trait_decl_name trait_decl ^ "_" ^ clause
+  in
+  let trait_type_name (trait_decl : trait_decl) (item : string) : string =
+    if !Config.record_fields_short_names then item
+    else trait_decl_name trait_decl ^ "_" ^ item
+  in
+  let trait_const_name (trait_decl : trait_decl) (item : string) : string =
+    if !Config.record_fields_short_names then item
+    else trait_decl_name trait_decl ^ "_" ^ item
+  in
+  let trait_method_name (trait_decl : trait_decl) (item : string) : string =
+    if !Config.record_fields_short_names then item
+    else trait_decl_name trait_decl ^ "_" ^ item
+  in
+  let trait_type_clause_name (trait_decl : trait_decl) (item : string)
+      (clause : trait_clause) : string =
+    (* TODO: improve - it would be better to not use indices *)
+    trait_type_name trait_decl item
+    ^ "_clause_"
+    ^ TraitClauseId.to_string clause.clause_id
+  in
+
+  let termination_measure_name (_fid : A.FunDeclId.id) (fname : fun_name)
+      (num_loops : int) (loop_id : LoopId.id option) : string =
+    let fname = get_fun_name fname in
+    let lp_suffix = default_fun_loop_suffix num_loops loop_id in
+    (* Compute the suffix *)
+    let suffix =
+      match !Config.backend with
+      | FStar -> "_decreases"
+      | Lean -> "_terminates"
+      | Coq | HOL4 -> raise (Failure "Unexpected")
+    in
+    (* Concatenate *)
+    fname ^ lp_suffix ^ suffix
+  in
+
+  let decreases_proof_name (_fid : A.FunDeclId.id) (fname : fun_name)
+      (num_loops : int) (loop_id : LoopId.id option) : string =
+    let fname = get_fun_name fname in
+    let lp_suffix = default_fun_loop_suffix num_loops loop_id in
+    (* Compute the suffix *)
+    let suffix =
+      match !Config.backend with
+      | Lean -> "_decreases"
+      | FStar | Coq | HOL4 -> raise (Failure "Unexpected")
+    in
+    (* Concatenate *)
+    fname ^ lp_suffix ^ suffix
+  in
+
+  let var_basename (_varset : StringSet.t) (basename : string option) (ty : ty)
+      : string =
+    (* Small helper to derive var names from ADT type names.
+
+       We do the following:
+       - convert the type name to snake case
+       - take the first letter of every "letter group"
+       Ex.: "HashMap" -> "hash_map" -> "hm"
+    *)
+    let name_from_type_ident (name : string) : string =
+      let cl = to_snake_case name in
+      let cl = String.split_on_char '_' cl in
+      let cl = List.filter (fun s -> String.length s > 0) cl in
+      assert (List.length cl > 0);
+      let cl = List.map (fun s -> s.[0]) cl in
+      StringUtils.string_of_chars cl
+    in
+    (* If there is a basename, we use it *)
+    match basename with
+    | Some basename ->
+        (* This should be a no-op *)
+        to_snake_case basename
+    | None -> (
+        (* No basename: we use the first letter of the type *)
+        match ty with
+        | Adt (type_id, generics) -> (
+            match type_id with
+            | Tuple ->
+                (* The "pair" case is frequent enough to have its special treatment *)
+                if List.length generics.types = 2 then "p" else "t"
+            | Assumed Result -> "r"
+            | Assumed Error -> ConstStrings.error_basename
+            | Assumed Fuel -> ConstStrings.fuel_basename
+            | Assumed Array -> "a"
+            | Assumed Slice -> "s"
+            | Assumed Str -> "s"
+            | Assumed State -> ConstStrings.state_basename
+            | Assumed (RawPtr _) -> "p"
+            | AdtId adt_id ->
+                let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
+                (* Derive the var name from the last ident of the type name
+                 * Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm"
+                 *)
+                (* The name shouldn't be empty, and its last element should
+                 * be an ident *)
+                let cl = List.nth def.name (List.length def.name - 1) in
+                name_from_type_ident (Names.as_ident cl))
+        | TypeVar _ -> (
+            (* TODO: use "t" also for F* *)
+            match !backend with
+            | FStar -> "x" (* lacking inspiration here... *)
+            | Coq | Lean | HOL4 -> "t" (* lacking inspiration here... *))
+        | Literal lty -> (
+            match lty with Bool -> "b" | Char -> "c" | Integer _ -> "i")
+        | Arrow _ -> "f"
+        | TraitType (_, _, name) -> name_from_type_ident name)
+  in
+  let type_var_basename (_varset : StringSet.t) (basename : string) : string =
+    (* Rust type variables are snake-case and start with a capital letter *)
+    match !backend with
+    | FStar ->
+        (* This is *not* a no-op: this removes the capital letter *)
+        to_snake_case basename
+    | HOL4 ->
+        (* In HOL4, type variable names must start with "'" *)
+        "'" ^ to_snake_case basename
+    | Coq | Lean -> basename
+  in
+  let const_generic_var_basename (_varset : StringSet.t) (basename : string) :
+      string =
+    (* Rust type variables are snake-case and start with a capital letter *)
+    match !backend with
+    | FStar | HOL4 ->
+        (* This is *not* a no-op: this removes the capital letter *)
+        to_snake_case basename
+    | Coq | Lean -> basename
+  in
+  let trait_clause_basename (_varset : StringSet.t) (_clause : trait_clause) :
+      string =
+    (* TODO: actually use the clause to derive the name *)
+    "inst"
+  in
+  let trait_self_clause_basename = "self_clause" in
+  let append_index (basename : string) (i : int) : string =
+    basename ^ string_of_int i
+  in
+
+  let extract_literal (fmt : F.formatter) (inside : bool) (cv : literal) : unit
+      =
+    match cv with
+    | Scalar sv -> (
+        match !backend with
+        | FStar -> F.pp_print_string fmt (Z.to_string sv.PV.value)
+        | Coq | HOL4 | Lean ->
+            let print_brackets = inside && !backend = HOL4 in
+            if print_brackets then F.pp_print_string fmt "(";
+            (match !backend with
+            | Coq | Lean -> ()
+            | HOL4 ->
+                F.pp_print_string fmt ("int_to_" ^ int_name sv.PV.int_ty);
+                F.pp_print_space fmt ()
+            | _ -> raise (Failure "Unreachable"));
+            (* We need to add parentheses if the value is negative *)
+            if sv.PV.value >= Z.of_int 0 then
+              F.pp_print_string fmt (Z.to_string sv.PV.value)
+            else if !backend = Lean then
+              (* TODO: parsing issues with Lean because there are ambiguous
+                 interpretations between int values and nat values *)
+              F.pp_print_string fmt
+                ("(-(" ^ Z.to_string (Z.neg sv.PV.value) ^ ":Int))")
+            else F.pp_print_string fmt ("(" ^ Z.to_string sv.PV.value ^ ")");
+            (match !backend with
+            | Coq ->
+                let iname = int_name sv.PV.int_ty in
+                F.pp_print_string fmt ("%" ^ iname)
+            | Lean ->
+                let iname = String.lowercase_ascii (int_name sv.PV.int_ty) in
+                F.pp_print_string fmt ("#" ^ iname)
+            | HOL4 -> ()
+            | _ -> raise (Failure "Unreachable"));
+            if print_brackets then F.pp_print_string fmt ")")
+    | Bool b ->
+        let b =
+          match !backend with
+          | HOL4 -> if b then "T" else "F"
+          | Coq | FStar | Lean -> if b then "true" else "false"
+        in
+        F.pp_print_string fmt b
+    | Char c -> (
+        match !backend with
+        | HOL4 ->
+            (* [#"a"] is a notation for [CHR 97] (97 is the ASCII code for 'a') *)
+            F.pp_print_string fmt ("#\"" ^ String.make 1 c ^ "\"")
+        | FStar | Lean -> F.pp_print_string fmt ("'" ^ String.make 1 c ^ "'")
+        | Coq ->
+            if inside then F.pp_print_string fmt "(";
+            F.pp_print_string fmt "char_of_byte";
+            F.pp_print_space fmt ();
+            (* Convert the the char to ascii *)
+            let c =
+              let i = Char.code c in
+              let x0 = i / 16 in
+              let x1 = i mod 16 in
+              "Coq.Init.Byte.x" ^ string_of_int x0 ^ string_of_int x1
+            in
+            F.pp_print_string fmt c;
+            if inside then F.pp_print_string fmt ")")
+  in
+  let bool_name = if !backend = Lean then "Bool" else "bool" in
+  let char_name = if !backend = Lean then "Char" else "char" in
+  let str_name = if !backend = Lean then "String" else "string" in
+  {
+    bool_name;
+    char_name;
+    int_name;
+    str_name;
+    type_decl_kind_to_qualif;
+    fun_decl_kind_to_qualif;
+    field_name;
+    variant_name;
+    struct_constructor;
+    type_name;
+    global_name;
+    fun_name;
+    termination_measure_name;
+    decreases_proof_name;
+    trait_decl_name;
+    trait_impl_name;
+    trait_parent_clause_name;
+    trait_const_name;
+    trait_type_name;
+    trait_method_name;
+    trait_type_clause_name;
+    var_basename;
+    type_var_basename;
+    const_generic_var_basename;
+    trait_self_clause_basename;
+    trait_clause_basename;
+    append_index;
+    extract_literal;
+    extract_unop;
+    extract_binop;
+  }
+
+let mk_formatter_and_names_map (ctx : trans_ctx) (crate_name : string)
+    (variant_concatenate_type_name : bool) : formatter * names_map =
+  let fmt = mk_formatter ctx crate_name variant_concatenate_type_name in
+  let names_map = initialize_names_map fmt (names_map_init ()) in
+  (fmt, names_map)
+
+let is_single_opaque_fun_decl_group (dg : Pure.fun_decl list) : bool =
+  match dg with [ d ] -> d.body = None | _ -> false
+
+let is_single_opaque_type_decl_group (dg : Pure.type_decl list) : bool =
+  match dg with [ d ] -> d.kind = Opaque | _ -> false
+
+let is_empty_record_type_decl (d : Pure.type_decl) : bool = d.kind = Struct []
+
+let is_empty_record_type_decl_group (dg : Pure.type_decl list) : bool =
+  match dg with [ d ] -> is_empty_record_type_decl d | _ -> false
+
+(** In some provers, groups of definitions must be delimited.
+
+    - in Coq, *every* group (including singletons) must end with "."
+    - in Lean, groups of mutually recursive definitions must end with "end"
+    - in HOL4 (in most situations) the whole group must be within a `Define` command
+
+    Calls to {!extract_fun_decl} should be inserted between calls to
+    {!start_fun_decl_group} and {!end_fun_decl_group}.
+
+    TODO: maybe those [{start/end}_decl_group] functions are not that much a good
+    idea and we should merge them with the corresponding [extract_decl] functions.
+ *)
+let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter)
+    (is_rec : bool) (dg : Pure.fun_decl list) =
+  match !backend with
+  | FStar | Coq | Lean -> ()
+  | HOL4 ->
+      (* In HOL4, opaque functions have a special treatment *)
+      if is_single_opaque_fun_decl_group dg then ()
+      else
+        let compute_fun_def_name (def : Pure.fun_decl) : string =
+          ctx_get_local_function def.def_id def.loop_id def.back_id ctx ^ "_def"
+        in
+        let names = List.map compute_fun_def_name dg in
+        (* Add a break before *)
+        F.pp_print_break fmt 0 0;
+        (* Open the box for the delimiters *)
+        F.pp_open_vbox fmt 0;
+        (* Open the box for the definitions themselves *)
+        F.pp_open_vbox fmt ctx.indent_incr;
+        (* Print the delimiters *)
+        if is_rec then
+          F.pp_print_string fmt
+            ("val [" ^ String.concat ", " names ^ "] = DefineDiv ‘")
+        else (
+          assert (List.length names = 1);
+          let name = List.hd names in
+          F.pp_print_string fmt ("val " ^ name ^ " = Define ‘"));
+        F.pp_print_cut fmt ()
+
+(** See {!start_fun_decl_group}. *)
+let end_fun_decl_group (fmt : F.formatter) (is_rec : bool)
+    (dg : Pure.fun_decl list) =
+  match !backend with
+  | FStar -> ()
+  | Coq ->
+      (* For aesthetic reasons, we print the Coq end group delimiter directly
+         in {!extract_fun_decl}. *)
+      ()
+  | Lean ->
+      (* We must add the "end" keyword to groups of mutually recursive functions *)
+      if is_rec && List.length dg > 1 then (
+        F.pp_print_cut fmt ();
+        F.pp_print_string fmt "end";
+        (* Add breaks to insert new lines between definitions *)
+        F.pp_print_break fmt 0 0)
+      else ()
+  | HOL4 ->
+      (* In HOL4, opaque functions have a special treatment *)
+      if is_single_opaque_fun_decl_group dg then ()
+      else (
+        (* Close the box for the definitions *)
+        F.pp_close_box fmt ();
+        (* Print the end delimiter *)
+        F.pp_print_cut fmt ();
+        F.pp_print_string fmt "’";
+        (* Close the box for the delimiters *)
+        F.pp_close_box fmt ();
+        (* Add breaks to insert new lines between definitions *)
+        F.pp_print_break fmt 0 0)
+
+(** See {!start_fun_decl_group}: similar usage, but for the type declarations. *)
+let start_type_decl_group (ctx : extraction_ctx) (fmt : F.formatter)
+    (is_rec : bool) (dg : Pure.type_decl list) =
+  match !backend with
+  | FStar | Coq -> ()
+  | Lean ->
+      if is_rec && List.length dg > 1 then (
+        F.pp_print_space fmt ();
+        F.pp_print_string fmt "mutual";
+        F.pp_print_space fmt ())
+  | HOL4 ->
+      (* In HOL4, opaque types and empty records have a special treatment *)
+      if
+        is_single_opaque_type_decl_group dg
+        || is_empty_record_type_decl_group dg
+      then ()
+      else (
+        (* Add a break before *)
+        F.pp_print_break fmt 0 0;
+        (* Open the box for the delimiters *)
+        F.pp_open_vbox fmt 0;
+        (* Open the box for the definitions themselves *)
+        F.pp_open_vbox fmt ctx.indent_incr;
+        (* Print the delimiters *)
+        F.pp_print_string fmt "Datatype:";
+        F.pp_print_cut fmt ())
+
+(** See {!start_fun_decl_group}. *)
+let end_type_decl_group (fmt : F.formatter) (is_rec : bool)
+    (dg : Pure.type_decl list) =
+  match !backend with
+  | FStar -> ()
+  | Coq ->
+      (* For aesthetic reasons, we print the Coq end group delimiter directly
+         in {!extract_fun_decl}. *)
+      ()
+  | Lean ->
+      (* We must add the "end" keyword to groups of mutually recursive functions *)
+      if is_rec && List.length dg > 1 then (
+        F.pp_print_cut fmt ();
+        F.pp_print_string fmt "end";
+        (* Add breaks to insert new lines between definitions *)
+        F.pp_print_break fmt 0 0)
+      else ()
+  | HOL4 ->
+      (* In HOL4, opaque types and empty records have a special treatment *)
+      if
+        is_single_opaque_type_decl_group dg
+        || is_empty_record_type_decl_group dg
+      then ()
+      else (
+        (* Close the box for the definitions *)
+        F.pp_close_box fmt ();
+        (* Print the end delimiter *)
+        F.pp_print_cut fmt ();
+        F.pp_print_string fmt "End";
+        (* Close the box for the delimiters *)
+        F.pp_close_box fmt ();
+        (* Add breaks to insert new lines between definitions *)
+        F.pp_print_break fmt 0 0)
+
+let unit_name () =
+  match !backend with Lean -> "Unit" | Coq | FStar | HOL4 -> "unit"
+
+(** Small helper *)
+let extract_arrow (fmt : F.formatter) () : unit =
+  if !Config.backend = Lean then F.pp_print_string fmt "→"
+  else F.pp_print_string fmt "->"
+
+let extract_const_generic (ctx : extraction_ctx) (fmt : F.formatter)
+    (inside : bool) (cg : const_generic) : unit =
+  match cg with
+  | ConstGenericGlobal id ->
+      let s = ctx_get_global id ctx in
+      F.pp_print_string fmt s
+  | ConstGenericValue v -> ctx.fmt.extract_literal fmt inside v
+  | ConstGenericVar id ->
+      let s = ctx_get_const_generic_var id ctx in
+      F.pp_print_string fmt s
+
+let extract_literal_type (ctx : extraction_ctx) (fmt : F.formatter)
+    (ty : literal_type) : unit =
+  match ty with
+  | Bool -> F.pp_print_string fmt ctx.fmt.bool_name
+  | Char -> F.pp_print_string fmt ctx.fmt.char_name
+  | Integer int_ty -> F.pp_print_string fmt (ctx.fmt.int_name int_ty)
+
+(** [inside] constrols whether we should add parentheses or not around type
+    applications (if [true] we add parentheses).
+
+    [no_params_tys]: for all the types inside this set, do not print the type parameters.
+    This is used for HOL4. As polymorphism is uniform in HOL4, printing the
+    type parameters in the recursive definitions is useless (and actually
+    forbidden).
+
+    For instance, where in F* we would write:
+    {[
+      type list a = | Nil : list a | Cons : a -> list a -> list a
+    ]}
+
+    In HOL4 we would simply write:
+    {[
+      Datatype:
+        list = Nil 'a | Cons 'a list
+      End
+    ]}
+ *)
+let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
+    (no_params_tys : TypeDeclId.Set.t) (inside : bool) (ty : ty) : unit =
+  let extract_rec = extract_ty ctx fmt no_params_tys in
+  match ty with
+  | Adt (type_id, generics) -> (
+      let has_params = generics <> empty_generic_args in
+      match type_id with
+      | Tuple ->
+          (* This is a bit annoying, but in F*/Coq/HOL4 [()] is not the unit type:
+           * we have to write [unit]... *)
+          if generics.types = [] then F.pp_print_string fmt (unit_name ())
+          else (
+            F.pp_print_string fmt "(";
+            Collections.List.iter_link
+              (fun () ->
+                F.pp_print_space fmt ();
+                let product =
+                  match !backend with
+                  | FStar -> "&"
+                  | Coq -> "*"
+                  | Lean -> "×"
+                  | HOL4 -> "#"
+                in
+                F.pp_print_string fmt product;
+                F.pp_print_space fmt ())
+              (extract_rec true) generics.types;
+            F.pp_print_string fmt ")")
+      | AdtId _ | Assumed _ -> (
+          (* HOL4 behaves differently. Where in Coq/FStar/Lean we would write:
+             `tree a b`
+
+             In HOL4 we would write:
+             `('a, 'b) tree`
+          *)
+          match !backend with
+          | FStar | Coq | Lean ->
+              let print_paren = inside && has_params in
+              if print_paren then F.pp_print_string fmt "(";
+              (* TODO: for now, only the opaque *functions* are extracted in the
+                 opaque module. The opaque *types* are assumed. *)
+              F.pp_print_string fmt (ctx_get_type type_id ctx);
+              (* We might need to filter the type arguments, if the type
+                 is builtin (for instance, we filter the global allocator type
+                 argument for `Vec`). *)
+              let generics =
+                match type_id with
+                | AdtId id -> (
+                    match
+                      TypeDeclId.Map.find_opt id ctx.types_filter_type_args_map
+                    with
+                    | None -> generics
+                    | Some filter ->
+                        let types = List.combine filter generics.types in
+                        let types =
+                          List.filter_map
+                            (fun (b, ty) -> if b then Some ty else None)
+                            types
+                        in
+                        { generics with types })
+                | _ -> generics
+              in
+              extract_generic_args ctx fmt no_params_tys generics;
+              if print_paren then F.pp_print_string fmt ")"
+          | HOL4 ->
+              let { types; const_generics; trait_refs } = generics in
+              (* Const generics are not supported in HOL4 *)
+              assert (const_generics = []);
+              let print_tys =
+                match type_id with
+                | AdtId id -> not (TypeDeclId.Set.mem id no_params_tys)
+                | Assumed _ -> true
+                | _ -> raise (Failure "Unreachable")
+              in
+              if types <> [] && print_tys then (
+                let print_paren = List.length types > 1 in
+                if print_paren then F.pp_print_string fmt "(";
+                Collections.List.iter_link
+                  (fun () ->
+                    F.pp_print_string fmt ",";
+                    F.pp_print_space fmt ())
+                  (extract_rec true) types;
+                if print_paren then F.pp_print_string fmt ")";
+                F.pp_print_space fmt ());
+              F.pp_print_string fmt (ctx_get_type type_id ctx);
+              if trait_refs <> [] then (
+                F.pp_print_space fmt ();
+                Collections.List.iter_link (F.pp_print_space fmt)
+                  (extract_trait_ref ctx fmt no_params_tys true)
+                  trait_refs)))
+  | TypeVar vid -> F.pp_print_string fmt (ctx_get_type_var vid ctx)
+  | Literal lty -> extract_literal_type ctx fmt lty
+  | Arrow (arg_ty, ret_ty) ->
+      if inside then F.pp_print_string fmt "(";
+      extract_rec false arg_ty;
+      F.pp_print_space fmt ();
+      extract_arrow fmt ();
+      F.pp_print_space fmt ();
+      extract_rec false ret_ty;
+      if inside then F.pp_print_string fmt ")"
+  | TraitType (trait_ref, generics, type_name) ->
+      if !parameterize_trait_types then raise (Failure "Unimplemented")
+      else if trait_ref.trait_id <> Self then (
+        (* HOL4 doesn't have 1st class types *)
+        assert (!backend <> HOL4);
+        let use_brackets = generics <> empty_generic_args in
+        if use_brackets then F.pp_print_string fmt "(";
+        extract_trait_ref ctx fmt no_params_tys false trait_ref;
+        extract_generic_args ctx fmt no_params_tys generics;
+        let name =
+          ctx_get_trait_type trait_ref.trait_decl_ref.trait_decl_id type_name
+            ctx
+        in
+        if use_brackets then F.pp_print_string fmt ")";
+        F.pp_print_string fmt ("." ^ name))
+      else
+        (* There are two situations:
+           - we are extracting a declared item (typically a function signature)
+             for a trait declaration. We directly refer to the item (we extract
+             trait declarations as structures, so we can refer to their fields)
+           - we are extracting a provided method for a trait declaration. We
+             refer to the item in the self trait clause (see {!SelfTraitClauseId}).
+
+           Remark: we can't get there for trait *implementations* because then the
+           types should have been normalized.
+        *)
+        let trait_decl_id = Option.get ctx.trait_decl_id in
+        let item_name = ctx_get_trait_type trait_decl_id type_name ctx in
+        assert (generics = empty_generic_args);
+        if ctx.is_provided_method then
+          (* Provided method: use the trait self clause *)
+          let self_clause = ctx_get_trait_self_clause ctx in
+          F.pp_print_string fmt (self_clause ^ "." ^ item_name)
+        else
+          (* Declaration: directly refer to the item *)
+          F.pp_print_string fmt item_name
+
+and extract_trait_ref (ctx : extraction_ctx) (fmt : F.formatter)
+    (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_ref) : unit =
+  let use_brackets = tr.generics <> empty_generic_args && inside in
+  if use_brackets then F.pp_print_string fmt "(";
+  (* We may need to filter the parameters if the trait is builtin *)
+  let generics =
+    match tr.trait_id with
+    | TraitImpl id -> (
+        match
+          TraitImplId.Map.find_opt id ctx.trait_impls_filter_type_args_map
+        with
+        | None -> tr.generics
+        | Some filter ->
+            let types =
+              List.filter_map
+                (fun (b, x) -> if b then Some x else None)
+                (List.combine filter tr.generics.types)
+            in
+            { tr.generics with types })
+    | _ -> tr.generics
+  in
+  extract_trait_instance_id ctx fmt no_params_tys inside tr.trait_id;
+  extract_generic_args ctx fmt no_params_tys generics;
+  if use_brackets then F.pp_print_string fmt ")"
+
+and extract_trait_decl_ref (ctx : extraction_ctx) (fmt : F.formatter)
+    (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_decl_ref) :
+    unit =
+  let use_brackets = tr.decl_generics <> empty_generic_args && inside in
+  let name = ctx_get_trait_decl tr.trait_decl_id ctx in
+  if use_brackets then F.pp_print_string fmt "(";
+  F.pp_print_string fmt name;
+  (* There is something subtle here: the trait obligations for the implemented
+     trait are put inside the parent clauses, so we must ignore them here *)
+  let generics = { tr.decl_generics with trait_refs = [] } in
+  extract_generic_args ctx fmt no_params_tys generics;
+  if use_brackets then F.pp_print_string fmt ")"
+
+and extract_generic_args (ctx : extraction_ctx) (fmt : F.formatter)
+    (no_params_tys : TypeDeclId.Set.t) (generics : generic_args) : unit =
+  let { types; const_generics; trait_refs } = generics in
+  if !backend <> HOL4 then (
+    if types <> [] then (
+      F.pp_print_space fmt ();
+      Collections.List.iter_link (F.pp_print_space fmt)
+        (extract_ty ctx fmt no_params_tys true)
+        types);
+    if const_generics <> [] then (
+      assert (!backend <> HOL4);
+      F.pp_print_space fmt ();
+      Collections.List.iter_link (F.pp_print_space fmt)
+        (extract_const_generic ctx fmt true)
+        const_generics));
+  if trait_refs <> [] then (
+    F.pp_print_space fmt ();
+    Collections.List.iter_link (F.pp_print_space fmt)
+      (extract_trait_ref ctx fmt no_params_tys true)
+      trait_refs)
+
+and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter)
+    (no_params_tys : TypeDeclId.Set.t) (inside : bool) (id : trait_instance_id)
+    : unit =
+  match id with
+  | Self ->
+      (* This has specific treatment depending on the item we're extracting
+         (associated type, etc.). We should have caught this elsewhere. *)
+      raise (Failure "Unexpected")
+  | TraitImpl id ->
+      let name = ctx_get_trait_impl id ctx in
+      F.pp_print_string fmt name
+  | Clause id ->
+      let name = ctx_get_local_trait_clause id ctx in
+      F.pp_print_string fmt name
+  | ParentClause (inst_id, decl_id, clause_id) ->
+      (* Use the trait decl id to lookup the name *)
+      let name = ctx_get_trait_parent_clause decl_id clause_id ctx in
+      extract_trait_instance_id ctx fmt no_params_tys true inst_id;
+      F.pp_print_string fmt ("." ^ name)
+  | ItemClause (inst_id, decl_id, item_name, clause_id) ->
+      (* Use the trait decl id to lookup the name *)
+      let name = ctx_get_trait_item_clause decl_id item_name clause_id ctx in
+      extract_trait_instance_id ctx fmt no_params_tys true inst_id;
+      F.pp_print_string fmt ("." ^ name)
+  | TraitRef trait_ref ->
+      extract_trait_ref ctx fmt no_params_tys inside trait_ref
+  | UnknownTrait _ ->
+      (* This is an error case *)
+      raise (Failure "Unexpected")
+
+(** Compute the names for all the top-level identifiers used in a type
+    definition (type name, variant names, field names, etc. but not type
+    parameters).
+
+    We need to do this preemptively, beforce extracting any definition,
+    because of recursive definitions.
+ *)
+let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
+    extraction_ctx =
+  (* Lookup the builtin information, if there is *)
+  let open ExtractBuiltin in
+  let sname = name_to_simple_name def.name in
+  let info = SimpleNameMap.find_opt sname (builtin_types_map ()) in
+  (* Register the filtering information, if there is *)
+  let ctx =
+    match info with
+    | Some { keep_params = Some keep; _ } ->
+        {
+          ctx with
+          types_filter_type_args_map =
+            TypeDeclId.Map.add def.def_id keep ctx.types_filter_type_args_map;
+        }
+    | _ -> ctx
+  in
+  (* Compute and register the type def name *)
+  let def_name =
+    match info with
+    | None -> ctx.fmt.type_name def.name
+    | Some info -> info.extract_name
+  in
+  let ctx = ctx_add (TypeId (AdtId def.def_id)) def_name ctx in
+  (* Compute and register:
+   * - the variant names, if this is an enumeration
+   * - the field names, if this is a structure
+   *)
+  let ctx =
+    match def.kind with
+    | Struct fields ->
+        (* Compute the names *)
+        let field_names, cons_name =
+          match info with
+          | None | Some { body_info = None; _ } ->
+              let field_names =
+                FieldId.mapi
+                  (fun fid (field : field) ->
+                    (fid, ctx.fmt.field_name def.name fid field.field_name))
+                  fields
+              in
+              let cons_name = ctx.fmt.struct_constructor def.name in
+              (field_names, cons_name)
+          | Some { body_info = Some (Struct (cons_name, field_names)); _ } ->
+              let field_names =
+                FieldId.mapi
+                  (fun fid (_, name) -> (fid, name))
+                  (List.combine fields field_names)
+              in
+              (field_names, cons_name)
+          | Some info ->
+              raise
+                (Failure
+                   ("Invalid builtin information: "
+                   ^ show_builtin_type_info info))
+        in
+        (* Add the fields *)
+        let ctx =
+          List.fold_left
+            (fun ctx (fid, name) ->
+              ctx_add (FieldId (AdtId def.def_id, fid)) name ctx)
+            ctx field_names
+        in
+        (* Add the constructor name *)
+        ctx_add (StructId (AdtId def.def_id)) cons_name ctx
+    | Enum variants ->
+        let variant_names =
+          match info with
+          | None ->
+              VariantId.mapi
+                (fun variant_id (variant : variant) ->
+                  let name =
+                    ctx.fmt.variant_name def.name variant.variant_name
+                  in
+                  (* Add the type name prefix for Lean *)
+                  let name =
+                    if !Config.backend = Lean then
+                      let type_name = ctx.fmt.type_name def.name in
+                      type_name ^ "." ^ name
+                    else name
+                  in
+                  (variant_id, name))
+                variants
+          | Some { body_info = Some (Enum variant_infos); _ } ->
+              (* We need to compute the map from variant to variant *)
+              let variant_map =
+                StringMap.of_list
+                  (List.map
+                     (fun (info : builtin_enum_variant_info) ->
+                       (info.rust_variant_name, info.extract_variant_name))
+                     variant_infos)
+              in
+              VariantId.mapi
+                (fun variant_id (variant : variant) ->
+                  (variant_id, StringMap.find variant.variant_name variant_map))
+                variants
+          | _ -> raise (Failure "Invalid builtin information")
+        in
+        List.fold_left
+          (fun ctx (vid, vname) ->
+            ctx_add (VariantId (AdtId def.def_id, vid)) vname ctx)
+          ctx variant_names
+    | Opaque ->
+        (* Nothing to do *)
+        ctx
+  in
+  (* Return *)
+  ctx
+
+(** Print the variants *)
+let extract_type_decl_variant (ctx : extraction_ctx) (fmt : F.formatter)
+    (type_decl_group : TypeDeclId.Set.t) (type_name : string)
+    (type_params : string list) (cg_params : string list) (cons_name : string)
+    (fields : field list) : unit =
+  F.pp_print_space fmt ();
+  (* variant box *)
+  F.pp_open_hvbox fmt ctx.indent_incr;
+  (* [| Cons :]
+   * Note that we really don't want any break above so we print everything
+   * at once. *)
+  let opt_colon = if !backend <> HOL4 then " :" else "" in
+  F.pp_print_string fmt ("| " ^ cons_name ^ opt_colon);
+  let print_field (fid : FieldId.id) (f : field) (ctx : extraction_ctx) :
+      extraction_ctx =
+    F.pp_print_space fmt ();
+    (* Open the field box *)
+    F.pp_open_box fmt ctx.indent_incr;
+    (* Print the field names, if the backend accepts it.
+     * [  x :]
+     * Note that when printing fields, we register the field names as
+     * *variables*: they don't need to be unique at the top level. *)
+    let ctx =
+      match !backend with
+      | FStar -> (
+          match f.field_name with
+          | None -> ctx
+          | Some field_name ->
+              let var_id = VarId.of_int (FieldId.to_int fid) in
+              let field_name =
+                ctx.fmt.var_basename ctx.names_map.names_set (Some field_name)
+                  f.field_ty
+              in
+              let ctx, field_name = ctx_add_var field_name var_id ctx in
+              F.pp_print_string fmt (field_name ^ " :");
+              F.pp_print_space fmt ();
+              ctx)
+      | Coq | Lean | HOL4 -> ctx
+    in
+    (* Print the field type *)
+    let inside = !backend = HOL4 in
+    extract_ty ctx fmt type_decl_group inside f.field_ty;
+    (* Print the arrow [->] *)
+    if !backend <> HOL4 then (
+      F.pp_print_space fmt ();
+      extract_arrow fmt ());
+    (* Close the field box *)
+    F.pp_close_box fmt ();
+    (* Return *)
+    ctx
+  in
+  (* Print the fields *)
+  let fields = FieldId.mapi (fun fid f -> (fid, f)) fields in
+  let _ =
+    List.fold_left (fun ctx (fid, f) -> print_field fid f ctx) ctx fields
+  in
+  (* Sanity check: HOL4 doesn't support const generics *)
+  assert (cg_params = [] || !backend <> HOL4);
+  (* Print the final type *)
+  if !backend <> HOL4 then (
+    F.pp_print_space fmt ();
+    F.pp_open_hovbox fmt 0;
+    F.pp_print_string fmt type_name;
+    List.iter
+      (fun p ->
+        F.pp_print_space fmt ();
+        F.pp_print_string fmt p)
+      (List.append type_params cg_params);
+    F.pp_close_box fmt ());
+  (* Close the variant box *)
+  F.pp_close_box fmt ()
+
+(* TODO: we don' need the [def_name] paramter: it can be retrieved from the context *)
+let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter)
+    (type_decl_group : TypeDeclId.Set.t) (def : type_decl) (def_name : string)
+    (type_params : string list) (cg_params : string list)
+    (variants : variant list) : unit =
+  (* We want to generate a definition which looks like this (taking F* as example):
+     {[
+       type list a = | Cons : a -> list a -> list a | Nil : list a
+     ]}
+
+     If there isn't enough space on one line:
+     {[
+       type s =
+       | Cons : a -> list a -> list a
+       | Nil : list a
+     ]}
+
+     And if we need to write the type of a variant on several lines:
+     {[
+       type s =
+       | Cons :
+         a ->
+         list a ->
+         list a
+       | Nil : list a
+     ]}
+
+     Finally, it is possible to give names to the variant fields in Rust.
+     In this situation, we generate a definition like this:
+     {[
+       type s =
+       | Cons : hd:a -> tl:list a -> list a
+       | Nil : list a
+     ]}
+
+     Note that we already printed: [type s =]
+  *)
+  let print_variant _variant_id (v : variant) =
+    (* We don't lookup the name, because it may have a prefix for the type
+       id (in the case of Lean) *)
+    let cons_name = ctx.fmt.variant_name def.name v.variant_name in
+    let fields = v.fields in
+    extract_type_decl_variant ctx fmt type_decl_group def_name type_params
+      cg_params cons_name fields
+  in
+  (* Print the variants *)
+  let variants = VariantId.mapi (fun vid v -> (vid, v)) variants in
+  List.iter (fun (vid, v) -> print_variant vid v) variants
+
+let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter)
+    (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl)
+    (type_params : string list) (cg_params : string list) (fields : field list)
+    : unit =
+  (* We want to generate a definition which looks like this (taking F* as example):
+     {[
+       type t = { x : int; y : bool; }
+     ]}
+
+     If there isn't enough space on one line:
+     {[
+       type t =
+       {
+         x : int; y : bool;
+       }
+     ]}
+
+     And if there is even less space:
+     {[
+       type t =
+       {
+         x : int;
+         y : bool;
+       }
+     ]}
+
+     Also, in case there are no fields, we need to define the type as [unit]
+     ([type t = {}] doesn't work in F* ).
+
+     Coq:
+     ====
+     We need to define the constructor name upon defining the struct (record, in Coq).
+     The syntex is:
+     {[
+       Record Foo = mkFoo { x : int; y : bool; }.
+     }]
+
+     Also, Coq doesn't support groups of mutually recursive inductives and records.
+     This is fine, because we can then define records as inductives, and leverage
+     the fact that when record fields are accessed, the records are symbolically
+     expanded which introduces let bindings of the form: [let RecordCons ... = x in ...].
+     As a consequence, we never use the record projectors (unless we reconstruct
+     them in the micro passes of course).
+
+     HOL4:
+     =====
+     Type definitions are written as follows:
+     {[
+       Datatype:
+         tree =
+           TLeaf 'a
+         | TNode node ;
+
+         node =
+           Node (tree list)
+       End
+     ]}
+  *)
+  (* Note that we already printed: [type t =] *)
+  let is_rec = decl_is_from_rec_group kind in
+  let _ =
+    if !backend = FStar && fields = [] then (
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt (unit_name ()))
+    else if !backend = Lean && fields = [] then ()
+      (* If the definition is recursive, we may need to extract it as an inductive
+         (instead of a record). We start with the "normal" case: we extract it
+         as a record. *)
+    else if (not is_rec) || (!backend <> Coq && !backend <> Lean) then (
+      if !backend <> Lean then F.pp_print_space fmt ();
+      (* If Coq: print the constructor name *)
+      (* TODO: remove superfluous test not is_rec below *)
+      if !backend = Coq && not is_rec then (
+        F.pp_print_string fmt (ctx_get_struct (AdtId def.def_id) ctx);
+        F.pp_print_string fmt " ");
+      (match !backend with
+      | Lean -> ()
+      | FStar | Coq -> F.pp_print_string fmt "{"
+      | HOL4 -> F.pp_print_string fmt "<|");
+      F.pp_print_break fmt 1 ctx.indent_incr;
+      (* The body itself *)
+      (* Open a box for the body *)
+      (match !backend with
+      | Coq | FStar | HOL4 -> F.pp_open_hvbox fmt 0
+      | Lean -> F.pp_open_vbox fmt 0);
+      (* Print the fields *)
+      let print_field (field_id : FieldId.id) (f : field) : unit =
+        let field_name = ctx_get_field (AdtId def.def_id) field_id ctx in
+        (* Open a box for the field *)
+        F.pp_open_box fmt ctx.indent_incr;
+        F.pp_print_string fmt field_name;
+        F.pp_print_space fmt ();
+        F.pp_print_string fmt ":";
+        F.pp_print_space fmt ();
+        extract_ty ctx fmt type_decl_group false f.field_ty;
+        if !backend <> Lean then F.pp_print_string fmt ";";
+        (* Close the box for the field *)
+        F.pp_close_box fmt ()
+      in
+      let fields = FieldId.mapi (fun fid f -> (fid, f)) fields in
+      Collections.List.iter_link (F.pp_print_space fmt)
+        (fun (fid, f) -> print_field fid f)
+        fields;
+      (* Close the box for the body *)
+      F.pp_close_box fmt ();
+      match !backend with
+      | Lean -> ()
+      | FStar | Coq ->
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "}"
+      | HOL4 ->
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "|>")
+    else (
+      (* We extract for Coq or Lean, and we have a recursive record, or a record in
+         a group of mutually recursive types: we extract it as an inductive type *)
+      assert (is_rec && (!backend = Coq || !backend = Lean));
+      (* Small trick: in Lean we use namespaces, meaning we don't need to prefix
+         the constructor name with the name of the type at definition site,
+         i.e., instead of generating `inductive Foo := | MkFoo ...` like in Coq
+         we generate `inductive Foo := | mk ... *)
+      let cons_name =
+        if !backend = Lean then "mk" else ctx_get_struct (AdtId def.def_id) ctx
+      in
+      let def_name = ctx_get_local_type def.def_id ctx in
+      extract_type_decl_variant ctx fmt type_decl_group def_name type_params
+        cg_params cons_name fields)
+  in
+  ()
+
+(** Extract a nestable, muti-line comment *)
+let extract_comment (fmt : F.formatter) (sl : string list) : unit =
+  (* Delimiters, space after we break a line *)
+  let ld, space, rd =
+    match !backend with
+    | Coq | FStar | HOL4 -> ("(** ", 4, " *)")
+    | Lean -> ("/- ", 3, " -/")
+  in
+  F.pp_open_vbox fmt space;
+  F.pp_print_string fmt ld;
+  (match sl with
+  | [] -> ()
+  | s :: sl ->
+      F.pp_print_string fmt s;
+      List.iter
+        (fun s ->
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt s)
+        sl);
+  F.pp_print_string fmt rd;
+  F.pp_close_box fmt ()
+
+let extract_trait_clause_type (ctx : extraction_ctx) (fmt : F.formatter)
+    (no_params_tys : TypeDeclId.Set.t) (clause : trait_clause) : unit =
+  let trait_name = ctx_get_trait_decl clause.trait_id ctx in
+  F.pp_print_string fmt trait_name;
+  extract_generic_args ctx fmt no_params_tys clause.generics
+
+(** Insert a space, if necessary *)
+let insert_req_space (fmt : F.formatter) (space : bool ref) : unit =
+  if !space then space := false else F.pp_print_space fmt ()
+
+(** Extract the trait self clause.
+
+    We add the trait self clause for provided methods (see {!TraitSelfClauseId}).
+ *)
+let extract_trait_self_clause (insert_req_space : unit -> unit)
+    (ctx : extraction_ctx) (fmt : F.formatter) (trait_decl : trait_decl)
+    (params : string list) : unit =
+  insert_req_space ();
+  F.pp_print_string fmt "(";
+  let self_clause = ctx_get_trait_self_clause ctx in
+  F.pp_print_string fmt self_clause;
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt ":";
+  F.pp_print_space fmt ();
+  let trait_id = ctx_get_trait_decl trait_decl.def_id ctx in
+  F.pp_print_string fmt trait_id;
+  List.iter
+    (fun p ->
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt p)
+    params;
+  F.pp_print_string fmt ")"
+
+(**
+ - [trait_decl]: if [Some], it means we are extracting the generics for a provided
+   method and need to insert a trait self clause (see {!TraitSelfClauseId}).
+ *)
+let extract_generic_params (ctx : extraction_ctx) (fmt : F.formatter)
+    (no_params_tys : TypeDeclId.Set.t) ?(use_forall = false)
+    ?(use_forall_use_sep = true) ?(as_implicits : bool = false)
+    ?(space : bool ref option = None) ?(trait_decl : trait_decl option = None)
+    (generics : generic_params) (type_params : string list)
+    (cg_params : string list) (trait_clauses : string list) : unit =
+  let all_params = List.concat [ type_params; cg_params; trait_clauses ] in
+  (* HOL4 doesn't support const generics *)
+  assert (cg_params = [] || !backend <> HOL4);
+  let left_bracket (implicit : bool) =
+    if implicit then F.pp_print_string fmt "{" else F.pp_print_string fmt "("
+  in
+  let right_bracket (implicit : bool) =
+    if implicit then F.pp_print_string fmt "}" else F.pp_print_string fmt ")"
+  in
+  let insert_req_space () =
+    match space with
+    | None -> F.pp_print_space fmt ()
+    | Some space -> insert_req_space fmt space
+  in
+  (* Print the type/const generic parameters *)
+  if all_params <> [] then (
+    if use_forall then (
+      if use_forall_use_sep then (
+        insert_req_space ();
+        F.pp_print_string fmt ":");
+      insert_req_space ();
+      F.pp_print_string fmt "forall");
+    (* Small helper - we may need to split the parameters *)
+    let print_generics (as_implicits : bool) (type_params : string list)
+        (const_generics : const_generic_var list)
+        (trait_clauses : trait_clause list) : unit =
+      (* Note that in HOL4 we don't print the type parameters. *)
+      if !backend <> HOL4 then (
+        (* Print the type parameters *)
+        if type_params <> [] then (
+          insert_req_space ();
+          (* ( *)
+          left_bracket as_implicits;
+          List.iter
+            (fun s ->
+              F.pp_print_string fmt s;
+              F.pp_print_space fmt ())
+            type_params;
+          F.pp_print_string fmt ":";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt (type_keyword ());
+          (* ) *)
+          right_bracket as_implicits);
+        (* Print the const generic parameters *)
+        List.iter
+          (fun (var : const_generic_var) ->
+            insert_req_space ();
+            (* ( *)
+            left_bracket as_implicits;
+            let n = ctx_get_const_generic_var var.index ctx in
+            F.pp_print_string fmt n;
+            F.pp_print_space fmt ();
+            F.pp_print_string fmt ":";
+            F.pp_print_space fmt ();
+            extract_literal_type ctx fmt var.ty;
+            (* ) *)
+            right_bracket as_implicits)
+          const_generics);
+      (* Print the trait clauses *)
+      List.iter
+        (fun (clause : trait_clause) ->
+          insert_req_space ();
+          (* ( *)
+          left_bracket as_implicits;
+          let n = ctx_get_local_trait_clause clause.clause_id ctx in
+          F.pp_print_string fmt n;
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt ":";
+          F.pp_print_space fmt ();
+          extract_trait_clause_type ctx fmt no_params_tys clause;
+          (* ) *)
+          right_bracket as_implicits)
+        trait_clauses
+    in
+    (* If we extract the generics for a provided method for a trait declaration
+       (indicated by the trait decl given as input), we need to split the generics:
+       - we print the generics for the trait decl
+       - we print the trait self clause
+       - we print the generics for the trait method
+    *)
+    match trait_decl with
+    | None ->
+        print_generics as_implicits type_params generics.const_generics
+          generics.trait_clauses
+    | Some trait_decl ->
+        (* Split the generics between the generics specific to the trait decl
+           and those specific to the trait method *)
+        let open Collections.List in
+        let dtype_params, mtype_params =
+          split_at type_params (length trait_decl.generics.types)
+        in
+        let dcgs, mcgs =
+          split_at generics.const_generics
+            (length trait_decl.generics.const_generics)
+        in
+        let dtrait_clauses, mtrait_clauses =
+          split_at generics.trait_clauses
+            (length trait_decl.generics.trait_clauses)
+        in
+        (* Extract the trait decl generics - note that we can always deduce
+           those parameters from the trait self clause: for this reason
+           they are always implicit *)
+        print_generics true dtype_params dcgs dtrait_clauses;
+        (* Extract the trait self clause *)
+        let params =
+          concat
+            [
+              dtype_params;
+              map
+                (fun (cg : const_generic_var) ->
+                  ctx_get_const_generic_var cg.index ctx)
+                dcgs;
+              map
+                (fun c -> ctx_get_local_trait_clause c.clause_id ctx)
+                dtrait_clauses;
+            ]
+        in
+        extract_trait_self_clause insert_req_space ctx fmt trait_decl params;
+        (* Extract the method generics *)
+        print_generics as_implicits mtype_params mcgs mtrait_clauses)
+
+(** Extract a type declaration.
+
+    This function is for all type declarations and all backends **at the exception**
+    of opaque (assumed/declared) types format4 HOL4.
+
+    See {!extract_type_decl}.
+ *)
+let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
+    (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl)
+    (extract_body : bool) : unit =
+  (* Sanity check *)
+  assert (extract_body || !backend <> HOL4);
+  let type_kind =
+    if extract_body then
+      match def.kind with
+      | Struct _ -> Some Struct
+      | Enum _ -> Some Enum
+      | Opaque -> None
+    else None
+  in
+  (* If in Coq and the declaration is opaque, it must have the shape:
+     [Axiom Ident : forall (T0 ... Tn : Type) (N0 : ...) ... (Nn : ...), ... -> ... -> ...].
+
+     The boolean [is_opaque_coq] is used to detect this case.
+  *)
+  let is_opaque = type_kind = None in
+  let is_opaque_coq = !backend = Coq && is_opaque in
+  let use_forall = is_opaque_coq && def.generics <> empty_generic_params in
+  (* Retrieve the definition name *)
+  let def_name = ctx_get_local_type def.def_id ctx in
+  (* Add the type and const generic params - note that we need those bindings only for the
+   * body translation (they are not top-level) *)
+  let ctx_body, type_params, cg_params, trait_clauses =
+    ctx_add_generic_params def.generics ctx
+  in
+  (* Add a break before *)
+  if !backend <> HOL4 || not (decl_is_first_from_group kind) then
+    F.pp_print_break fmt 0 0;
+  (* Print a comment to link the extracted type to its original rust definition *)
+  extract_comment fmt [ "[" ^ Print.name_to_string def.name ^ "]" ];
+  F.pp_print_break fmt 0 0;
+  (* Open a box for the definition, so that whenever possible it gets printed on
+   * one line. Note however that in the case of Lean line breaks are important
+   * for parsing: we thus use a hovbox. *)
+  (match !backend with
+  | Coq | FStar | HOL4 -> F.pp_open_hvbox fmt 0
+  | Lean -> F.pp_open_vbox fmt 0);
+  (* Open a box for "type TYPE_NAME (TYPE_PARAMS CONST_GEN_PARAMS) =" *)
+  F.pp_open_hovbox fmt ctx.indent_incr;
+  (* > "type TYPE_NAME" *)
+  let qualif = ctx.fmt.type_decl_kind_to_qualif kind type_kind in
+  (match qualif with
+  | Some qualif -> F.pp_print_string fmt (qualif ^ " " ^ def_name)
+  | None -> F.pp_print_string fmt def_name);
+  (* HOL4 doesn't support const generics, and type definitions in HOL4 don't
+     support trait clauses *)
+  assert ((cg_params = [] && trait_clauses = []) || !backend <> HOL4);
+  (* Print the generic parameters *)
+  extract_generic_params ctx_body fmt type_decl_group ~use_forall def.generics
+    type_params cg_params trait_clauses;
+  (* Print the "=" if we extract the body*)
+  if extract_body then (
+    F.pp_print_space fmt ();
+    let eq =
+      match !backend with
+      | FStar -> "="
+      | Coq -> ":="
+      | Lean ->
+          if type_kind = Some Struct && kind = SingleNonRec then "where"
+          else ":="
+      | HOL4 -> "="
+    in
+    F.pp_print_string fmt eq)
+  else (
+    (* Otherwise print ": Type", unless it is the HOL4 backend (in
+       which case we declare the type with `new_type`) *)
+    if use_forall then F.pp_print_string fmt ","
+    else (
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt ":");
+    F.pp_print_space fmt ();
+    F.pp_print_string fmt (type_keyword ()));
+  (* Close the box for "type TYPE_NAME (TYPE_PARAMS) =" *)
+  F.pp_close_box fmt ();
+  (if extract_body then
+     match def.kind with
+     | Struct fields ->
+         extract_type_decl_struct_body ctx_body fmt type_decl_group kind def
+           type_params cg_params fields
+     | Enum variants ->
+         extract_type_decl_enum_body ctx_body fmt type_decl_group def def_name
+           type_params cg_params variants
+     | Opaque -> raise (Failure "Unreachable"));
+  (* Add the definition end delimiter *)
+  if !backend = HOL4 && decl_is_not_last_from_group kind then (
+    F.pp_print_space fmt ();
+    F.pp_print_string fmt ";")
+  else if !backend = Coq && decl_is_last_from_group kind then (
+    (* This is actually an end of group delimiter. For aesthetic reasons
+       we print it here instead of in {!end_type_decl_group}. *)
+    F.pp_print_cut fmt ();
+    F.pp_print_string fmt ".");
+  (* Close the box for the definition *)
+  F.pp_close_box fmt ();
+  (* Add breaks to insert new lines between definitions *)
+  if !backend <> HOL4 || decl_is_not_last_from_group kind then
+    F.pp_print_break fmt 0 0
+
+(** Extract an opaque type declaration to HOL4.
+
+    Remark (SH): having to treat this specific case separately is very annoying,
+    but I could not find a better way.
+ *)
+let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter)
+    (def : type_decl) : unit =
+  (* Retrieve the definition name *)
+  let def_name = ctx_get_local_type def.def_id ctx in
+  (* Generic parameters are unsupported *)
+  assert (def.generics.const_generics = []);
+  (* Trait clauses on type definitions are unsupported *)
+  assert (def.generics.trait_clauses = []);
+  (* Types  *)
+  (* Count the number of parameters *)
+  let num_params = List.length def.generics.types in
+  (* Generate the declaration *)
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt
+    ("val _ = new_type (\"" ^ def_name ^ "\", " ^ string_of_int num_params ^ ")");
+  F.pp_print_space fmt ()
+
+(** Extract an empty record type declaration to HOL4.
+
+    Empty records are not supported in HOL4, so we extract them as type
+    abbreviations to the unit type.
+
+    Remark (SH): having to treat this specific case separately is very annoying,
+    but I could not find a better way.
+ *)
+let extract_type_decl_hol4_empty_record (ctx : extraction_ctx)
+    (fmt : F.formatter) (def : type_decl) : unit =
+  (* Retrieve the definition name *)
+  let def_name = ctx_get_local_type def.def_id ctx in
+  (* Sanity check *)
+  assert (def.generics = empty_generic_params);
+  (* Generate the declaration *)
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt ("Type " ^ def_name ^ " = “: unit”");
+  F.pp_print_space fmt ()
+
+(** Extract a type declaration.
+
+    Note that all the names used for extraction should already have been
+    registered.
+
+    This function should be inserted between calls to {!start_type_decl_group}
+    and {!end_type_decl_group}.
+ *)
+let extract_type_decl (ctx : extraction_ctx) (fmt : F.formatter)
+    (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) :
+    unit =
+  let extract_body =
+    match kind with
+    | SingleNonRec | SingleRec | MutRecFirst | MutRecInner | MutRecLast -> true
+    | Assumed | Declared -> false
+  in
+  if extract_body then
+    if !backend = HOL4 && is_empty_record_type_decl def then
+      extract_type_decl_hol4_empty_record ctx fmt def
+    else extract_type_decl_gen ctx fmt type_decl_group kind def extract_body
+  else
+    match !backend with
+    | FStar | Coq | Lean ->
+        extract_type_decl_gen ctx fmt type_decl_group kind def extract_body
+    | HOL4 -> extract_type_decl_hol4_opaque ctx fmt def
+
+(** Auxiliary function.
+
+    Generate [Arguments] instructions in Coq.
+ *)
+let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter)
+    (kind : decl_kind) (decl : type_decl) : unit =
+  assert (!backend = Coq);
+  (* Generating the [Arguments] instructions is useful only if there are type parameters *)
+  if decl.generics.types = [] && decl.generics.const_generics = [] then ()
+  else
+    (* Add the type params - note that we need those bindings only for the
+     * body translation (they are not top-level) *)
+    let _ctx_body, type_params, cg_params, trait_clauses =
+      ctx_add_generic_params decl.generics ctx
+    in
+    (* Auxiliary function to extract an [Arguments Cons {T} _ _.] instruction *)
+    let extract_arguments_info (cons_name : string) (fields : 'a list) : unit =
+      (* Add a break before *)
+      F.pp_print_break fmt 0 0;
+      (* Open a box *)
+      F.pp_open_hovbox fmt ctx.indent_incr;
+      F.pp_print_break fmt 0 0;
+      F.pp_print_string fmt "Arguments";
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt cons_name;
+      (* Print the type/const params and the trait clauses (`{T}`) *)
+      List.iter
+        (fun (var : string) ->
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt ("{" ^ var ^ "}"))
+        (List.concat [ type_params; cg_params; trait_clauses ]);
+      (* Print the fields (`_`) *)
+      List.iter
+        (fun _ ->
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "_")
+        fields;
+      F.pp_print_string fmt ".";
+
+      (* Close the box *)
+      F.pp_close_box fmt ()
+    in
+
+    (* Generate the [Arguments] instruction *)
+    match decl.kind with
+    | Opaque -> ()
+    | Struct fields ->
+        let adt_id = AdtId decl.def_id in
+        (* Generate the instruction for the record constructor *)
+        let cons_name = ctx_get_struct adt_id ctx in
+        extract_arguments_info cons_name fields;
+        (* Generate the instruction for the record projectors, if there are *)
+        let is_rec = decl_is_from_rec_group kind in
+        if not is_rec then
+          FieldId.iteri
+            (fun fid _ ->
+              let cons_name = ctx_get_field adt_id fid ctx in
+              extract_arguments_info cons_name [])
+            fields;
+        (* Add breaks to insert new lines between definitions *)
+        F.pp_print_break fmt 0 0
+    | Enum variants ->
+        (* Generate the instructions *)
+        VariantId.iteri
+          (fun vid (v : variant) ->
+            let cons_name = ctx_get_variant (AdtId decl.def_id) vid ctx in
+            extract_arguments_info cons_name v.fields)
+          variants;
+        (* Add breaks to insert new lines between definitions *)
+        F.pp_print_break fmt 0 0
+
+(** Auxiliary function.
+
+    Generate field projectors in Coq.
+
+    Sometimes we extract records as inductives in Coq: when this happens we
+    have to define the field projectors afterwards.
+ *)
+let extract_type_decl_record_field_projectors (ctx : extraction_ctx)
+    (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit =
+  assert (!backend = Coq);
+  match decl.kind with
+  | Opaque | Enum _ -> ()
+  | Struct fields ->
+      (* Records are extracted as inductives only if they are recursive *)
+      let is_rec = decl_is_from_rec_group kind in
+      if is_rec then
+        (* Add the type params *)
+        let ctx, type_params, cg_params, trait_clauses =
+          ctx_add_generic_params decl.generics ctx
+        in
+        let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in
+        let ctx, field_var = ctx_add_var "x" (VarId.of_int 1) ctx in
+        let def_name = ctx_get_local_type decl.def_id ctx in
+        let cons_name = ctx_get_struct (AdtId decl.def_id) ctx in
+        let extract_field_proj (field_id : FieldId.id) (_ : field) : unit =
+          F.pp_print_space fmt ();
+          (* Outer box for the projector definition *)
+          F.pp_open_hvbox fmt 0;
+          (* Inner box for the projector definition *)
+          F.pp_open_hvbox fmt ctx.indent_incr;
+          (* Open a box for the [Definition PROJ ... :=] *)
+          F.pp_open_hovbox fmt ctx.indent_incr;
+          F.pp_print_string fmt "Definition";
+          F.pp_print_space fmt ();
+          let field_name = ctx_get_field (AdtId decl.def_id) field_id ctx in
+          F.pp_print_string fmt field_name;
+          (* Print the generics *)
+          let as_implicits = true in
+          extract_generic_params ctx fmt TypeDeclId.Set.empty ~as_implicits
+            decl.generics type_params cg_params trait_clauses;
+          (* Print the record parameter *)
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "(";
+          F.pp_print_string fmt record_var;
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt ":";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt def_name;
+          List.iter
+            (fun p ->
+              F.pp_print_space fmt ();
+              F.pp_print_string fmt p)
+            type_params;
+          F.pp_print_string fmt ")";
+          (* *)
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt ":=";
+          (* Close the box for the [Definition PROJ ... :=] *)
+          F.pp_close_box fmt ();
+          F.pp_print_space fmt ();
+          (* Open a box for the whole match *)
+          F.pp_open_hvbox fmt 0;
+          (* Open a box for the [match ... with] *)
+          F.pp_open_hovbox fmt ctx.indent_incr;
+          F.pp_print_string fmt "match";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt record_var;
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "with";
+          (* Close the box for the [match ... with] *)
+          F.pp_close_box fmt ();
+
+          (* Open a box for the branch *)
+          F.pp_open_hovbox fmt ctx.indent_incr;
+          (* Print the match branch *)
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "|";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt cons_name;
+          FieldId.iteri
+            (fun id _ ->
+              F.pp_print_space fmt ();
+              if field_id = id then F.pp_print_string fmt field_var
+              else F.pp_print_string fmt "_")
+            fields;
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "=>";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt field_var;
+          (* Close the box for the branch *)
+          F.pp_close_box fmt ();
+          (* Print the [end] *)
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "end";
+          (* Close the box for the whole match *)
+          F.pp_close_box fmt ();
+          (* Close the inner box projector *)
+          F.pp_close_box fmt ();
+          (* If Coq: end the definition with a "." *)
+          if !backend = Coq then (
+            F.pp_print_cut fmt ();
+            F.pp_print_string fmt ".");
+          (* Close the outer box projector  *)
+          F.pp_close_box fmt ();
+          (* Add breaks to insert new lines between definitions *)
+          F.pp_print_break fmt 0 0
+        in
+
+        let extract_proj_notation (field_id : FieldId.id) (_ : field) : unit =
+          F.pp_print_space fmt ();
+          (* Outer box for the projector definition *)
+          F.pp_open_hvbox fmt 0;
+          (* Inner box for the projector definition *)
+          F.pp_open_hovbox fmt ctx.indent_incr;
+          let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in
+          F.pp_print_string fmt "Notation";
+          F.pp_print_space fmt ();
+          let field_name = ctx_get_field (AdtId decl.def_id) field_id ctx in
+          F.pp_print_string fmt ("\"" ^ record_var ^ " .(" ^ field_name ^ ")\"");
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt ":=";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "(";
+          F.pp_print_string fmt field_name;
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt record_var;
+          F.pp_print_string fmt ")";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "(at level 9)";
+          (* Close the inner box projector *)
+          F.pp_close_box fmt ();
+          (* If Coq: end the definition with a "." *)
+          if !backend = Coq then (
+            F.pp_print_cut fmt ();
+            F.pp_print_string fmt ".");
+          (* Close the outer box projector  *)
+          F.pp_close_box fmt ();
+          (* Add breaks to insert new lines between definitions *)
+          F.pp_print_break fmt 0 0
+        in
+
+        let extract_field_proj_and_notation (field_id : FieldId.id)
+            (field : field) : unit =
+          extract_field_proj field_id field;
+          extract_proj_notation field_id field
+        in
+
+        FieldId.iteri extract_field_proj_and_notation fields
+
+(** Extract extra information for a type (e.g., [Arguments] instructions in Coq).
+
+    Note that all the names used for extraction should already have been
+    registered.
+ *)
+let extract_type_decl_extra_info (ctx : extraction_ctx) (fmt : F.formatter)
+    (kind : decl_kind) (decl : type_decl) : unit =
+  match !backend with
+  | FStar | Lean | HOL4 -> ()
+  | Coq ->
+      extract_type_decl_coq_arguments ctx fmt kind decl;
+      extract_type_decl_record_field_projectors ctx fmt kind decl
+
+(** Extract the state type declaration. *)
+let extract_state_type (fmt : F.formatter) (ctx : extraction_ctx)
+    (kind : decl_kind) : unit =
+  (* Add a break before *)
+  F.pp_print_break fmt 0 0;
+  (* Print a comment  *)
+  extract_comment fmt [ "The state type used in the state-error monad" ];
+  F.pp_print_break fmt 0 0;
+  (* Open a box for the definition, so that whenever possible it gets printed on
+   * one line *)
+  F.pp_open_hvbox fmt 0;
+  (* Retrieve the name *)
+  let state_name = ctx_get_assumed_type State ctx in
+  (* The syntax for Lean and Coq is almost identical. *)
+  let print_axiom () =
+    let axiom =
+      match !backend with
+      | Coq -> "Axiom"
+      | Lean -> "axiom"
+      | FStar | HOL4 -> raise (Failure "Unexpected")
+    in
+    F.pp_print_string fmt axiom;
+    F.pp_print_space fmt ();
+    F.pp_print_string fmt state_name;
+    F.pp_print_space fmt ();
+    F.pp_print_string fmt ":";
+    F.pp_print_space fmt ();
+    F.pp_print_string fmt "Type";
+    if !backend = Coq then F.pp_print_string fmt "."
+  in
+  (* The kind should be [Assumed] or [Declared] *)
+  (match kind with
+  | SingleNonRec | SingleRec | MutRecFirst | MutRecInner | MutRecLast ->
+      raise (Failure "Unexpected")
+  | Assumed -> (
+      match !backend with
+      | FStar ->
+          F.pp_print_string fmt "assume";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "type";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt state_name;
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt ":";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "Type0"
+      | HOL4 ->
+          F.pp_print_string fmt ("val _ = new_type (\"" ^ state_name ^ "\", 0)")
+      | Coq | Lean -> print_axiom ())
+  | Declared -> (
+      match !backend with
+      | FStar ->
+          F.pp_print_string fmt "val";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt state_name;
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt ":";
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt "Type0"
+      | HOL4 ->
+          F.pp_print_string fmt ("val _ = new_type (\"" ^ state_name ^ "\", 0)")
+      | Coq | Lean -> print_axiom ()));
+  (* Close the box for the definition *)
+  F.pp_close_box fmt ();
+  (* Add breaks to insert new lines between definitions *)
+  F.pp_print_break fmt 0 0
diff --git a/compiler/Pure.ml b/compiler/Pure.ml
index 9a3654b8..a5aa0edd 100644
--- a/compiler/Pure.ml
+++ b/compiler/Pure.ml
@@ -24,8 +24,6 @@ module TraitClauseId = T.TraitClauseId
 module LoopId =
 IdGen ()
 
-type loop_id = LoopId.id [@@deriving show, ord]
-
 (** We give an identifier to every phase of the synthesis (forward, backward
     for group of regions 0, etc.) *)
 module SynthPhaseId =
@@ -47,6 +45,8 @@ type trait_clause_id = T.trait_clause_id [@@deriving show, ord]
 type trait_item_name = T.trait_item_name [@@deriving show, ord]
 type global_decl_id = T.global_decl_id [@@deriving show, ord]
 type fun_decl_id = A.fun_decl_id [@@deriving show, ord]
+type loop_id = LoopId.id [@@deriving show, ord]
+type region_group_id = T.region_group_id [@@deriving show, ord]
 type mutability = Mut | Const [@@deriving show, ord]
 
 (** The assumed types for the pure AST.
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 019a5c35..c5ac4e96 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -1076,6 +1076,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
       functions_with_decreases_clause = rec_functions;
       types_filter_type_args_map = Pure.TypeDeclId.Map.empty;
       funs_filter_type_args_map = Pure.FunDeclId.Map.empty;
+      trait_impls_filter_type_args_map = Pure.TraitImplId.Map.empty;
     }
   in
 
diff --git a/compiler/dune b/compiler/dune
index a4b09df4..648c7325 100644
--- a/compiler/dune
+++ b/compiler/dune
@@ -24,6 +24,7 @@
   Extract
   ExtractBase
   ExtractBuiltin
+  ExtractTypes
   FunsAnalysis
   Identifiers
   InterpreterBorrowsCore
-- 
cgit v1.3.1


From ca24c351f97a3f8989a6866de0868ef54241b194 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 26 Oct 2023 12:07:50 +0200
Subject: Make progress on fixing the extraction for Lean

---
 backends/lean/Base/Primitives/ArraySlice.lean | 164 ++++++++-----------------
 compiler/Extract.ml                           |   2 +-
 compiler/ExtractBase.ml                       | 165 ++++++++++++++++----------
 compiler/ExtractTypes.ml                      |  48 ++++----
 compiler/Translate.ml                         |  21 +---
 5 files changed, 180 insertions(+), 220 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean
index 615e0783..2a080ca6 100644
--- a/backends/lean/Base/Primitives/ArraySlice.lean
+++ b/backends/lean/Base/Primitives/ArraySlice.lean
@@ -40,14 +40,14 @@ def Array.make (α : Type u) (n : Usize) (init : List α) (hl : init.len = n.val
 example : Array Int (Usize.ofInt 2) := Array.make Int (Usize.ofInt 2) [0, 1]
 
 @[simp]
-abbrev Array.index {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i : Int) : α :=
+abbrev Array.index_s {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i : Int) : α :=
   v.val.index i
 
 @[simp]
 abbrev Array.slice {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i j : Int) : List α :=
   v.val.slice i j
 
-def Array.index_shared (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α :=
+def Array.index_usize (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α :=
   match v.val.indexOpt i.val with
   | none => fail .arrayOutOfBounds
   | some x => ret x
@@ -67,48 +67,27 @@ theorem Array.repeat_spec {α : Type u} (n : Usize) (x : α) :
  -/
 
 @[pspec]
-theorem Array.index_shared_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize)
+theorem Array.index_usize_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize)
   (hbound : i.val < v.length) :
-  ∃ x, v.index_shared α n i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_shared]
+  ∃ x, v.index_usize α n i = ret x ∧ x = v.val.index i.val := by
+  simp only [index_usize]
   -- TODO: dependent rewrite
   have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
   simp [*]
 
--- This shouldn't be used
-def Array.index_shared_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (_: α) : Result Unit :=
-  if i.val < List.length v.val then
-    .ret ()
-  else
-    .fail arrayOutOfBounds
-
-def Array.index_mut (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some x => ret x
-
-@[pspec]
-theorem Array.index_mut_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize)
-  (hbound : i.val < v.length) :
-  ∃ x, v.index_mut α n i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_mut]
-  -- TODO: dependent rewrite
-  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
-  simp [*]
-
-def Array.index_mut_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: α) : Result (Array α n) :=
+def Array.update_usize (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: α) : Result (Array α n) :=
   match v.val.indexOpt i.val with
   | none => fail .arrayOutOfBounds
   | some _ =>
     .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩
 
 @[pspec]
-theorem Array.index_mut_back_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α)
+theorem Array.update_usize_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α)
   (hbound : i.val < v.length) :
-  ∃ nv, v.index_mut_back α n i x = ret nv ∧
+  ∃ nv, v.update_usize α n i x = ret nv ∧
   nv.val = v.val.update i.val x
   := by
-  simp only [index_mut_back]
+  simp only [update_usize]
   have h := List.indexOpt_bounds v.val i.val
   split
   . simp_all [length]; cases h <;> scalar_tac
@@ -144,14 +123,14 @@ theorem Slice.len_val {α : Type u} (v : Slice α) : (Slice.len α v).val = v.le
   by rfl
 
 @[simp]
-abbrev Slice.index {α : Type u} [Inhabited α] (v: Slice α) (i: Int) : α :=
+abbrev Slice.index_s {α : Type u} [Inhabited α] (v: Slice α) (i: Int) : α :=
   v.val.index i
 
 @[simp]
 abbrev Slice.slice {α : Type u} [Inhabited α] (s : Slice α) (i j : Int) : List α :=
   s.val.slice i j
 
-def Slice.index_shared (α : Type u) (v: Slice α) (i: Usize) : Result α :=
+def Slice.index_usize (α : Type u) (v: Slice α) (i: Usize) : Result α :=
   match v.val.indexOpt i.val with
   | none => fail .arrayOutOfBounds
   | some x => ret x
@@ -162,10 +141,10 @@ def Slice.index_shared (α : Type u) (v: Slice α) (i: Usize) : Result α :=
  -/
 
 @[pspec]
-theorem Slice.index_shared_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize)
+theorem Slice.index_usize_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize)
   (hbound : i.val < v.length) :
-  ∃ x, v.index_shared α i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_shared]
+  ∃ x, v.index_usize α i = ret x ∧ x = v.val.index i.val := by
+  simp only [index_usize]
   -- TODO: dependent rewrite
   have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
   simp [*]
@@ -177,33 +156,19 @@ def Slice.index_shared_back (α : Type u) (v: Slice α) (i: Usize) (_: α) : Res
   else
     .fail arrayOutOfBounds
 
-def Slice.index_mut (α : Type u) (v: Slice α) (i: Usize) : Result α :=
-  match v.val.indexOpt i.val with
-  | none => fail .arrayOutOfBounds
-  | some x => ret x
-
-@[pspec]
-theorem Slice.index_mut_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize)
-  (hbound : i.val < v.length) :
-  ∃ x, v.index_mut α i = ret x ∧ x = v.val.index i.val := by
-  simp only [index_mut]
-  -- TODO: dependent rewrite
-  have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*])
-  simp [*]
-
-def Slice.index_mut_back (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) :=
+def Slice.update_usize (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) :=
   match v.val.indexOpt i.val with
   | none => fail .arrayOutOfBounds
   | some _ =>
     .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩
 
 @[pspec]
-theorem Slice.index_mut_back_spec {α : Type u} (v: Slice α) (i: Usize) (x : α)
+theorem Slice.update_usize_spec {α : Type u} (v: Slice α) (i: Usize) (x : α)
   (hbound : i.val < v.length) :
-  ∃ nv, v.index_mut_back α i x = ret nv ∧
+  ∃ nv, v.update_usize α i x = ret nv ∧
   nv.val = v.val.update i.val x
   := by
-  simp only [index_mut_back]
+  simp only [update_usize]
   have h := List.indexOpt_bounds v.val i.val
   split
   . simp_all [length]; cases h <;> scalar_tac
@@ -212,34 +177,27 @@ theorem Slice.index_mut_back_spec {α : Type u} (v: Slice α) (i: Usize) (x : α
 /- Array to slice/subslices -/
 
 /- We could make this function not use the `Result` type. By making it monadic, we
-   push the user to use the `Array.to_slice_shared_spec` spec theorem below (through the
-   `progress` tactic), meaning `Array.to_slice_shared` should be considered as opaque.
+   push the user to use the `Array.to_slice_spec` spec theorem below (through the
+   `progress` tactic), meaning `Array.to_slice` should be considered as opaque.
    All what the spec theorem reveals is that the "representative" lists are the same. -/
-def Array.to_slice_shared (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) :=
+def Array.to_slice (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) :=
   ret ⟨ v.val, by simp [← List.len_eq_length]; scalar_tac ⟩
 
 @[pspec]
-theorem Array.to_slice_shared_spec {α : Type u} {n : Usize} (v : Array α n) :
-  ∃ s, to_slice_shared α n v = ret s ∧ v.val = s.val := by simp [to_slice_shared]
-
-def Array.to_slice_mut (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) :=
-  to_slice_shared α n v
+theorem Array.to_slice_spec {α : Type u} {n : Usize} (v : Array α n) :
+  ∃ s, to_slice α n v = ret s ∧ v.val = s.val := by simp [to_slice]
 
-@[pspec]
-theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) :
-  ∃ s, Array.to_slice_shared α n v = ret s ∧ v.val = s.val := to_slice_shared_spec v
-
-def Array.to_slice_mut_back (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) :=
+def Array.from_slice (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) :=
   if h: s.val.len = n.val then
     ret ⟨ s.val, by simp [← List.len_eq_length, *] ⟩
   else fail panic
 
 @[pspec]
-theorem Array.to_slice_mut_back_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) :
-  ∃ na, to_slice_mut_back α n a ns = ret na ∧ na.val = ns.val
-  := by simp [to_slice_mut_back, *]
+theorem Array.from_slice_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) :
+  ∃ na, from_slice α n a ns = ret na ∧ na.val = ns.val
+  := by simp [from_slice, *]
 
-def Array.subslice_shared (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) :=
+def Array.subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) :=
   -- TODO: not completely sure here
   if r.start.val < r.end_.val ∧ r.end_.val ≤ a.val.len then
     ret ⟨ a.val.slice r.start.val r.end_.val,
@@ -251,29 +209,18 @@ def Array.subslice_shared (α : Type u) (n : Usize) (a : Array α n) (r : Range
     fail panic
 
 @[pspec]
-theorem Array.subslice_shared_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize)
+theorem Array.subslice_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize)
   (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) :
-  ∃ s, subslice_shared α n a r = ret s ∧
+  ∃ s, subslice α n a r = ret s ∧
   s.val = a.val.slice r.start.val r.end_.val ∧
   (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i))
   := by
-  simp [subslice_shared, *]
+  simp [subslice, *]
   intro i _ _
   have := List.index_slice r.start.val r.end_.val i a.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac)
   simp [*]
 
-def Array.subslice_mut (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) :=
-  Array.subslice_shared α n a r
-
-@[pspec]
-theorem Array.subslice_mut_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize)
-  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) :
-  ∃ s, subslice_mut α n a r = ret s ∧
-  s.val = a.slice r.start.val r.end_.val ∧
-  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i))
-  := subslice_shared_spec a r h0 h1
-
-def Array.subslice_mut_back (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) (s : Slice α) : Result (Array α n) :=
+def Array.update_subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) (s : Slice α) : Result (Array α n) :=
   -- TODO: not completely sure here
   if h: r.start.val < r.end_.val ∧ r.end_.val ≤ a.length ∧ s.val.len = r.end_.val - r.start.val then
     let s_beg := a.val.itake r.start.val
@@ -298,13 +245,13 @@ def Array.subslice_mut_back (α : Type u) (n : Usize) (a : Array α n) (r : Rang
 -- We should introduce special symbols for the monadic arithmetic operations
 -- (the use will never write those symbols directly).
 @[pspec]
-theorem Array.subslice_mut_back_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α)
+theorem Array.update_subslice_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α)
   (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : s.length = r.end_.val - r.start.val) :
-  ∃ na, subslice_mut_back α n a r s = ret na ∧
-  (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧
-  (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = s.index (i - r.start.val)) ∧
-  (∀ i, r.end_.val ≤ i → i < n.val → na.index i = a.index i) := by
-  simp [subslice_mut_back, *]
+  ∃ na, update_subslice α n a r s = ret na ∧
+  (∀ i, 0 ≤ i → i < r.start.val → na.index_s i = a.index_s i) ∧
+  (∀ i, r.start.val ≤ i → i < r.end_.val → na.index_s i = s.index_s (i - r.start.val)) ∧
+  (∀ i, r.end_.val ≤ i → i < n.val → na.index_s i = a.index_s i) := by
+  simp [update_subslice, *]
   have h := List.replace_slice_index r.start.val r.end_.val a.val s.val
     (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac)
   simp [List.replace_slice] at h
@@ -321,7 +268,7 @@ theorem Array.subslice_mut_back_spec {α : Type u} {n : Usize} [Inhabited α] (a
     have := h2 i (by int_tac) (by int_tac)
     simp [*]
 
-def Slice.subslice_shared (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) :=
+def Slice.subslice (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) :=
   -- TODO: not completely sure here
   if r.start.val < r.end_.val ∧ r.end_.val ≤ s.length then
     ret ⟨ s.val.slice r.start.val r.end_.val,
@@ -333,32 +280,21 @@ def Slice.subslice_shared (α : Type u) (s : Slice α) (r : Range Usize) : Resul
     fail panic
 
 @[pspec]
-theorem Slice.subslice_shared_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize)
+theorem Slice.subslice_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize)
   (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) :
-  ∃ ns, subslice_shared α s r = ret ns ∧
+  ∃ ns, subslice α s r = ret ns ∧
   ns.val = s.slice r.start.val r.end_.val ∧
-  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i))
+  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index_s i = s.index_s (r.start.val + i))
   := by
-  simp [subslice_shared, *]
+  simp [subslice, *]
   intro i _ _
   have := List.index_slice r.start.val r.end_.val i s.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac)
   simp [*]
 
-def Slice.subslice_mut (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) :=
-  Slice.subslice_shared α s r
-
-@[pspec]
-theorem Slice.subslice_mut_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize)
-  (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) :
-  ∃ ns, subslice_mut α s r = ret ns ∧
-  ns.val = s.slice r.start.val r.end_.val ∧
-  (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i))
-  := subslice_shared_spec s r h0 h1
-
 attribute [pp_dot] List.len List.length List.index -- use the dot notation when printing
 set_option pp.coercions false -- do not print coercions with ↑ (this doesn't parse)
 
-def Slice.subslice_mut_back (α : Type u) (s : Slice α) (r : Range Usize) (ss : Slice α) : Result (Slice α) :=
+def Slice.update_subslice (α : Type u) (s : Slice α) (r : Range Usize) (ss : Slice α) : Result (Slice α) :=
   -- TODO: not completely sure here
   if h: r.start.val < r.end_.val ∧ r.end_.val ≤ s.length ∧ ss.val.len = r.end_.val - r.start.val then
     let s_beg := s.val.itake r.start.val
@@ -378,13 +314,13 @@ def Slice.subslice_mut_back (α : Type u) (s : Slice α) (r : Range Usize) (ss :
     fail panic
 
 @[pspec]
-theorem Slice.subslice_mut_back_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α)
+theorem Slice.update_subslice_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α)
   (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : ss.length = r.end_.val - r.start.val) :
-  ∃ na, subslice_mut_back α a r ss = ret na ∧
-  (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧
-  (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = ss.index (i - r.start.val)) ∧
-  (∀ i, r.end_.val ≤ i → i < a.length → na.index i = a.index i) := by
-  simp [subslice_mut_back, *]
+  ∃ na, update_subslice α a r ss = ret na ∧
+  (∀ i, 0 ≤ i → i < r.start.val → na.index_s i = a.index_s i) ∧
+  (∀ i, r.start.val ≤ i → i < r.end_.val → na.index_s i = ss.index_s (i - r.start.val)) ∧
+  (∀ i, r.end_.val ≤ i → i < a.length → na.index_s i = a.index_s i) := by
+  simp [update_subslice, *]
   have h := List.replace_slice_index r.start.val r.end_.val a.val ss.val
     (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac)
   simp [List.replace_slice, *] at h
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index fdcd82d9..574602c7 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -241,7 +241,7 @@ let rec extract_typed_pattern (ctx : extraction_ctx) (fmt : F.formatter)
       ctx
   | PatVar (v, _) ->
       let vname =
-        ctx.fmt.var_basename ctx.names_map.names_set v.basename v.ty
+        ctx.fmt.var_basename ctx.names_maps.names_map.names_set v.basename v.ty
       in
       let ctx, vname = ctx_add_var vname v.id ctx in
       F.pp_print_string fmt vname;
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 7e8e4ffc..8f71116c 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -520,23 +520,6 @@ let names_map_add (id_to_string : id -> string) (id : id) (name : string)
   let names_set = StringSet.add name nm.names_set in
   { id_to_name; name_to_id; names_set }
 
-let names_map_add_assumed_type (id_to_string : id -> string) (id : assumed_ty)
-    (name : string) (nm : names_map) : names_map =
-  names_map_add id_to_string (TypeId (Assumed id)) name nm
-
-let names_map_add_assumed_struct (id_to_string : id -> string) (id : assumed_ty)
-    (name : string) (nm : names_map) : names_map =
-  names_map_add id_to_string (StructId (Assumed id)) name nm
-
-let names_map_add_assumed_variant (id_to_string : id -> string)
-    (id : assumed_ty) (variant_id : VariantId.id) (name : string)
-    (nm : names_map) : names_map =
-  names_map_add id_to_string (VariantId (Assumed id, variant_id)) name nm
-
-let names_map_add_function (id_to_string : id -> string) (fid : fun_id)
-    (name : string) (nm : names_map) : names_map =
-  names_map_add id_to_string (FunId fid) name nm
-
 (** The unsafe names map stores mappings from identifiers to names which might
     collide. For some backends and some names, it might be acceptable to have
     collisions. For instance, in Lean, different records can have fields with
@@ -547,6 +530,8 @@ let names_map_add_function (id_to_string : id -> string) (fid : fun_id)
   *)
 type unsafe_names_map = { id_to_name : string IdMap.t }
 
+let empty_unsafe_names_map = { id_to_name = IdMap.empty }
+
 let unsafe_names_map_add (id : id) (name : string) (nm : unsafe_names_map) :
     unsafe_names_map =
   { id_to_name = IdMap.add id name nm.id_to_name }
@@ -585,16 +570,7 @@ let basename_to_unique (names_set : StringSet.t)
 
 type fun_name_info = { keep_fwd : bool; num_backs : int }
 
-(** Extraction context.
-
-    Note that the extraction context contains information coming from the
-    LLBC AST (not only the pure AST). This is useful for naming, for instance:
-    we use the region information to generate the names of the backward
-    functions, etc.
- *)
-type extraction_ctx = {
-  crate : A.crate;
-  trans_ctx : trans_ctx;
+type names_maps = {
   names_map : names_map;
       (** The map for id to names, where we forbid name collisions
           (ex.: we always forbid function name collisions). *)
@@ -610,6 +586,19 @@ type extraction_ctx = {
           the name "u32", and another field of the same record refers to "u32"
           (for instance in its type).
        *)
+}
+
+(** Extraction context.
+
+    Note that the extraction context contains information coming from the
+    LLBC AST (not only the pure AST). This is useful for naming, for instance:
+    we use the region information to generate the names of the backward
+    functions, etc.
+ *)
+type extraction_ctx = {
+  crate : A.crate;
+  trans_ctx : trans_ctx;
+  names_maps : names_maps;
   fmt : formatter;
   indent_incr : int;
       (** The indent increment we insert whenever we need to indent more *)
@@ -836,12 +825,15 @@ let allow_collisions (id : id) : bool =
   | FieldId _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitItemId _
   | TraitMethodId _ ->
       !Config.record_fields_short_names
+  | FunId (Pure _ | FromLlbc (FunId (Assumed _), _, _)) ->
+      (* We map several assumed functions to the same id *)
+      true
   | _ -> false
 
-let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx =
-  (* The id_to_string function to print nice debugging messages if there are
-   * collisions *)
-  let id_to_string (id : id) : string = id_to_string id ctx in
+(** The [id_to_string] function to print nice debugging messages if there are
+    collisions *)
+let names_maps_add (id_to_string : id -> string) (id : id) (name : string)
+    (nm : names_maps) : names_maps =
   (* We do not use the same name map if we allow/disallow collisions.
      We notably use it for field names: some backends like Lean can use the
      type information to disambiguate field projections.
@@ -856,59 +848,90 @@ let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx =
   *)
   if allow_collisions id then (
     (* Check with the ids which are considered to be strict on collisions *)
-    names_map_check_collision id_to_string id name ctx.strict_names_map;
+    names_map_check_collision id_to_string id name nm.strict_names_map;
     {
-      ctx with
-      unsafe_names_map = unsafe_names_map_add id name ctx.unsafe_names_map;
+      nm with
+      unsafe_names_map = unsafe_names_map_add id name nm.unsafe_names_map;
     })
   else
     (* Remark: if we are strict on collisions:
        - we add the id to the strict collisions map
        - we check that the id doesn't collide with the unsafe map
+       TODO: we might not check that:
+       - a user defined function doesn't collide with an assumed function
+       - two trait decl items don't collide with each other
     *)
     let strict_names_map =
       if strict_collisions id then
-        names_map_add id_to_string id name ctx.strict_names_map
-      else ctx.strict_names_map
+        names_map_add id_to_string id name nm.strict_names_map
+      else nm.strict_names_map
     in
-    let names_map = names_map_add id_to_string id name ctx.names_map in
-    { ctx with strict_names_map; names_map }
+    let names_map = names_map_add id_to_string id name nm.names_map in
+    { nm with strict_names_map; names_map }
 
-let ctx_get (id : id) (ctx : extraction_ctx) : string =
+let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx =
+  let id_to_string (id : id) : string = id_to_string id ctx in
+  let names_maps = names_maps_add id_to_string id name ctx.names_maps in
+  { ctx with names_maps }
+
+(** The [id_to_string] function to print nice debugging messages if there are
+    collisions *)
+let names_maps_get (id_to_string : id -> string) (id : id) (nm : names_maps) :
+    string =
   (* We do not use the same name map if we allow/disallow collisions *)
   let map_to_string (m : string IdMap.t) : string =
     "[\n"
     ^ String.concat ","
         (List.map
-           (fun (id, n) -> "\n  " ^ id_to_string id ctx ^ " -> " ^ n)
+           (fun (id, n) -> "\n  " ^ id_to_string id ^ " -> " ^ n)
            (IdMap.bindings m))
     ^ "\n]"
   in
   if allow_collisions id then (
-    let m = ctx.unsafe_names_map.id_to_name in
+    let m = nm.unsafe_names_map.id_to_name in
     match IdMap.find_opt id m with
     | Some s -> s
     | None ->
         let err =
-          "Could not find: " ^ id_to_string id ctx ^ "\nNames map:\n"
+          "Could not find: " ^ id_to_string id ^ "\nNames map:\n"
           ^ map_to_string m
         in
         log#serror err;
         if !Config.extract_fail_hard then raise (Failure err)
-        else
-          "(%%%ERROR: unknown identifier\": " ^ id_to_string id ctx ^ "\"%%%)")
+        else "(%%%ERROR: unknown identifier\": " ^ id_to_string id ^ "\"%%%)")
   else
-    let m = ctx.names_map.id_to_name in
+    let m = nm.names_map.id_to_name in
     match IdMap.find_opt id m with
     | Some s -> s
     | None ->
         let err =
-          "Could not find: " ^ id_to_string id ctx ^ "\nNames map:\n"
+          "Could not find: " ^ id_to_string id ^ "\nNames map:\n"
           ^ map_to_string m
         in
         log#serror err;
         if !Config.extract_fail_hard then raise (Failure err)
-        else "(ERROR: \"" ^ id_to_string id ctx ^ "\")"
+        else "(ERROR: \"" ^ id_to_string id ^ "\")"
+
+let ctx_get (id : id) (ctx : extraction_ctx) : string =
+  let id_to_string (id : id) : string = id_to_string id ctx in
+  names_maps_get id_to_string id ctx.names_maps
+
+let names_maps_add_assumed_type (id_to_string : id -> string) (id : assumed_ty)
+    (name : string) (nm : names_maps) : names_maps =
+  names_maps_add id_to_string (TypeId (Assumed id)) name nm
+
+let names_maps_add_assumed_struct (id_to_string : id -> string)
+    (id : assumed_ty) (name : string) (nm : names_maps) : names_maps =
+  names_maps_add id_to_string (StructId (Assumed id)) name nm
+
+let names_maps_add_assumed_variant (id_to_string : id -> string)
+    (id : assumed_ty) (variant_id : VariantId.id) (name : string)
+    (nm : names_maps) : names_maps =
+  names_maps_add id_to_string (VariantId (Assumed id, variant_id)) name nm
+
+let names_maps_add_function (id_to_string : id -> string) (fid : fun_id)
+    (name : string) (nm : names_maps) : names_maps =
+  names_maps_add id_to_string (FunId fid) name nm
 
 let ctx_get_global (id : A.GlobalDeclId.id) (ctx : extraction_ctx) : string =
   ctx_get (GlobalId id) ctx
@@ -999,9 +1022,12 @@ let ctx_get_termination_measure (def_id : A.FunDeclId.id)
 (** Generate a unique type variable name and add it to the context *)
 let ctx_add_type_var (basename : string) (id : TypeVarId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
-  let name = ctx.fmt.type_var_basename ctx.names_map.names_set basename in
   let name =
-    basename_to_unique ctx.names_map.names_set ctx.fmt.append_index name
+    ctx.fmt.type_var_basename ctx.names_maps.names_map.names_set basename
+  in
+  let name =
+    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
+      name
   in
   let ctx = ctx_add (TypeVarId id) name ctx in
   (ctx, name)
@@ -1010,10 +1036,12 @@ let ctx_add_type_var (basename : string) (id : TypeVarId.id)
 let ctx_add_const_generic_var (basename : string) (id : ConstGenericVarId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
   let name =
-    ctx.fmt.const_generic_var_basename ctx.names_map.names_set basename
+    ctx.fmt.const_generic_var_basename ctx.names_maps.names_map.names_set
+      basename
   in
   let name =
-    basename_to_unique ctx.names_map.names_set ctx.fmt.append_index name
+    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
+      name
   in
   let ctx = ctx_add (ConstGenericVarId id) name ctx in
   (ctx, name)
@@ -1029,7 +1057,8 @@ let ctx_add_type_vars (vars : (string * TypeVarId.id) list)
 let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) :
     extraction_ctx * string =
   let name =
-    basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename
+    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
+      basename
   in
   let ctx = ctx_add (VarId id) name ctx in
   (ctx, name)
@@ -1038,7 +1067,8 @@ let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) :
 let ctx_add_trait_self_clause (ctx : extraction_ctx) : extraction_ctx * string =
   let basename = ctx.fmt.trait_self_clause_basename in
   let name =
-    basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename
+    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
+      basename
   in
   let ctx = ctx_add TraitSelfClauseId name ctx in
   (ctx, name)
@@ -1047,7 +1077,8 @@ let ctx_add_trait_self_clause (ctx : extraction_ctx) : extraction_ctx * string =
 let ctx_add_local_trait_clause (basename : string) (id : TraitClauseId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
   let name =
-    basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename
+    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
+      basename
   in
   let ctx = ctx_add (LocalTraitClauseId id) name ctx in
   (ctx, name)
@@ -1057,7 +1088,9 @@ let ctx_add_vars (vars : var list) (ctx : extraction_ctx) :
     extraction_ctx * string list =
   List.fold_left_map
     (fun ctx (v : var) ->
-      let name = ctx.fmt.var_basename ctx.names_map.names_set v.basename v.ty in
+      let name =
+        ctx.fmt.var_basename ctx.names_maps.names_map.names_set v.basename v.ty
+      in
       ctx_add_var name v.id ctx)
     ctx vars
 
@@ -1078,7 +1111,9 @@ let ctx_add_local_trait_clauses (clauses : trait_clause list)
     (ctx : extraction_ctx) : extraction_ctx * string list =
   List.fold_left_map
     (fun ctx (c : trait_clause) ->
-      let basename = ctx.fmt.trait_clause_basename ctx.names_map.names_set c in
+      let basename =
+        ctx.fmt.trait_clause_basename ctx.names_maps.names_map.names_set c
+      in
       ctx_add_local_trait_clause basename c.clause_id ctx)
     ctx clauses
 
@@ -1189,9 +1224,10 @@ type names_map_init = {
   assumed_pure_functions : (pure_assumed_fun_id * string) list;
 }
 
-(** Initialize a names map with a proper set of keywords/names coming from the
+(** Initialize names maps with a proper set of keywords/names coming from the
     target language/prover. *)
-let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map =
+let initialize_names_maps (fmt : formatter) (init : names_map_init) : names_maps
+    =
   let int_names = List.map fmt.int_name T.all_int_types in
   let keywords =
     List.concat
@@ -1207,7 +1243,10 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map =
    * Also note that we don't need this mapping for keywords: we insert keywords only
    * to check collisions. *)
   let id_to_name = IdMap.empty in
-  let nm = { id_to_name; name_to_id; names_set } in
+  let names_map = { id_to_name; name_to_id; names_set } in
+  let unsafe_names_map = empty_unsafe_names_map in
+  let strict_names_map = empty_names_map in
+  let nm = { names_map; unsafe_names_map; strict_names_map } in
   (* For debugging - we are creating bindings for assumed types and functions, so
    * it is ok if we simply use the "show" function (those aren't simply identified
    * by numbers) *)
@@ -1221,19 +1260,19 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map =
   let nm =
     List.fold_left
       (fun nm (type_id, name) ->
-        names_map_add_assumed_type id_to_string type_id name nm)
+        names_maps_add_assumed_type id_to_string type_id name nm)
       nm init.assumed_adts
   in
   let nm =
     List.fold_left
       (fun nm (type_id, name) ->
-        names_map_add_assumed_struct id_to_string type_id name nm)
+        names_maps_add_assumed_struct id_to_string type_id name nm)
       nm init.assumed_structs
   in
   let nm =
     List.fold_left
       (fun nm (type_id, variant_id, name) ->
-        names_map_add_assumed_variant id_to_string type_id variant_id name nm)
+        names_maps_add_assumed_variant id_to_string type_id variant_id name nm)
       nm init.assumed_variants
   in
   let assumed_functions =
@@ -1245,7 +1284,7 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map =
   in
   let nm =
     List.fold_left
-      (fun nm (fid, name) -> names_map_add_function id_to_string fid name nm)
+      (fun nm (fid, name) -> names_maps_add_function id_to_string fid name nm)
       nm assumed_functions
   in
   (* Return *)
diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml
index 219f273f..fd3baf0d 100644
--- a/compiler/ExtractTypes.ml
+++ b/compiler/ExtractTypes.ml
@@ -300,30 +300,30 @@ let assumed_llbc_functions () :
   match !backend with
   | FStar | Coq | HOL4 ->
       [
-        (ArrayIndexShared, None, "array_index_shared");
-        (ArrayIndexMut, None, "array_index_mut_fwd");
-        (ArrayIndexMut, rg0, "array_index_mut_back");
-        (ArrayToSliceShared, None, "array_to_slice_shared");
-        (ArrayToSliceMut, None, "array_to_slice_mut_fwd");
-        (ArrayToSliceMut, rg0, "array_to_slice_mut_back");
+        (ArrayIndexShared, None, "array_index_usize");
+        (ArrayIndexMut, None, "array_index_usize");
+        (ArrayIndexMut, rg0, "array_update_usize");
+        (ArrayToSliceShared, None, "array_to_slice");
+        (ArrayToSliceMut, None, "array_to_slice");
+        (ArrayToSliceMut, rg0, "array_from_slice");
         (ArrayRepeat, None, "array_repeat");
-        (SliceIndexShared, None, "slice_index_shared");
-        (SliceIndexMut, None, "slice_index_mut_fwd");
-        (SliceIndexMut, rg0, "slice_index_mut_back");
+        (SliceIndexShared, None, "slice_index_usize");
+        (SliceIndexMut, None, "slice_index_usize");
+        (SliceIndexMut, rg0, "slice_update_usize");
         (SliceLen, None, "slice_len");
       ]
   | Lean ->
       [
-        (ArrayIndexShared, None, "Array.index_shared");
-        (ArrayIndexMut, None, "Array.index_mut");
-        (ArrayIndexMut, rg0, "Array.index_mut_back");
-        (ArrayToSliceShared, None, "Array.to_slice_shared");
-        (ArrayToSliceMut, None, "Array.to_slice_mut");
-        (ArrayToSliceMut, rg0, "Array.to_slice_mut_back");
+        (ArrayIndexShared, None, "Array.index_usize");
+        (ArrayIndexMut, None, "Array.index_usize");
+        (ArrayIndexMut, rg0, "Array.update_usize");
+        (ArrayToSliceShared, None, "Array.to_slice");
+        (ArrayToSliceMut, None, "Array.to_slice");
+        (ArrayToSliceMut, rg0, "Array.from_slice");
         (ArrayRepeat, None, "Array.repeat");
-        (SliceIndexShared, None, "Slice.index_shared");
-        (SliceIndexMut, None, "Slice.index_mut");
-        (SliceIndexMut, rg0, "Slice.index_mut_back");
+        (SliceIndexShared, None, "Slice.index_usize");
+        (SliceIndexMut, None, "Slice.index_usize");
+        (SliceIndexMut, rg0, "Slice.update_usize");
         (SliceLen, None, "Slice.len");
       ]
 
@@ -941,11 +941,11 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     extract_binop;
   }
 
-let mk_formatter_and_names_map (ctx : trans_ctx) (crate_name : string)
-    (variant_concatenate_type_name : bool) : formatter * names_map =
+let mk_formatter_and_names_maps (ctx : trans_ctx) (crate_name : string)
+    (variant_concatenate_type_name : bool) : formatter * names_maps =
   let fmt = mk_formatter ctx crate_name variant_concatenate_type_name in
-  let names_map = initialize_names_map fmt (names_map_init ()) in
-  (fmt, names_map)
+  let names_maps = initialize_names_maps fmt (names_map_init ()) in
+  (fmt, names_maps)
 
 let is_single_opaque_fun_decl_group (dg : Pure.fun_decl list) : bool =
   match dg with [ d ] -> d.body = None | _ -> false
@@ -1507,8 +1507,8 @@ let extract_type_decl_variant (ctx : extraction_ctx) (fmt : F.formatter)
           | Some field_name ->
               let var_id = VarId.of_int (FieldId.to_int fid) in
               let field_name =
-                ctx.fmt.var_basename ctx.names_map.names_set (Some field_name)
-                  f.field_ty
+                ctx.fmt.var_basename ctx.names_maps.names_map.names_set
+                  (Some field_name) f.field_ty
               in
               let ctx, field_name = ctx_add_var field_name var_id ctx in
               F.pp_print_string fmt (field_name ^ " :");
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index c5ac4e96..cb23198a 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -990,23 +990,10 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
   in
   (* Initialize the names map (we insert the names of the "primitives"
      declarations, and insert the names of the local declarations later) *)
-  let mk_formatter_and_names_map = Extract.mk_formatter_and_names_map in
-  let fmt, names_map =
-    mk_formatter_and_names_map trans_ctx crate.name
+  let fmt, names_maps =
+    Extract.mk_formatter_and_names_maps trans_ctx crate.name
       variant_concatenate_type_name
   in
-  let strict_names_map =
-    let open ExtractBase in
-    let ids =
-      List.filter
-        (fun (id, _) -> strict_collisions id)
-        (IdMap.bindings names_map.id_to_name)
-    in
-    List.fold_left
-      (* id_to_string: we shouldn't need to use it *)
-        (fun m (id, n) -> names_map_add show_id id n m)
-      empty_names_map ids
-  in
 
   (* We need to compute which functions are recursive, in order to know
    * whether we should generate a decrease clause or not. *)
@@ -1060,9 +1047,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
     {
       ExtractBase.crate;
       trans_ctx;
-      names_map;
-      unsafe_names_map = { id_to_name = ExtractBase.IdMap.empty };
-      strict_names_map;
+      names_maps;
       fmt;
       indent_incr = 2;
       use_dep_ite = !Config.backend = Lean && !Config.extract_decreases_clauses;
-- 
cgit v1.3.1


From 3a22c56e026ee4488bc5e2d16d2066853ae7ccb9 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 9 Nov 2023 16:22:09 +0100
Subject: Make the traits work for Coq

---
 Makefile                   |   2 +-
 compiler/Extract.ml        | 391 +++++++++++++++++++++++++++++----------------
 compiler/ExtractBase.ml    |   8 +
 compiler/ExtractBuiltin.ml |  12 +-
 compiler/ExtractTypes.ml   | 106 +++++++-----
 compiler/FunsAnalysis.ml   |   7 +-
 compiler/Translate.ml      |  22 ++-
 7 files changed, 354 insertions(+), 194 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/Makefile b/Makefile
index b67bd08b..427a5751 100644
--- a/Makefile
+++ b/Makefile
@@ -134,7 +134,7 @@ thol4-array: OPTIONS +=
 test-traits: OPTIONS +=
 test-traits: SUBDIR := traits
 tfstar-traits: OPTIONS += -decreases-clauses -template-clauses
-tcoq-traits: OPTIONS += -use-fuel
+tcoq-traits: OPTIONS +=
 tlean-traits: SUBDIR :=
 tlean-traits: OPTIONS +=
 thol4-traits: OPTIONS +=
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index e22f1385..d04f5c1d 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -320,8 +320,11 @@ and extract_App (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool)
             ctx_get_trait_const trait_ref.trait_decl_ref.trait_decl_id
               const_name ctx
           in
+          let add_brackets (s : string) =
+            if !backend = Coq then "(" ^ s ^ ")" else s
+          in
           if use_brackets then F.pp_print_string fmt ")";
-          F.pp_print_string fmt ("." ^ name))
+          F.pp_print_string fmt ("." ^ add_brackets name))
   | _ ->
       (* "Regular" expression *)
       (* Open parentheses *)
@@ -430,7 +433,10 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
               ctx_get_trait_method trait_ref.trait_decl_ref.trait_decl_id
                 method_name rg_id ctx
             in
-            F.pp_print_string fmt ("." ^ fun_name))
+            let add_brackets (s : string) =
+              if !backend = Coq then "(" ^ s ^ ")" else s
+            in
+            F.pp_print_string fmt ("." ^ add_brackets fun_name))
           else
             (* Provided method: we see it as a regular function call, and use
                the function name *)
@@ -2021,12 +2027,15 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
     SimpleNameMap.find_opt sname (builtin_trait_decls_map ())
   in
   let ctx =
-    let trait_name =
+    let trait_name, trait_constructor =
       match builtin_info with
-      | None -> ctx.fmt.trait_decl_name trait_decl
-      | Some info -> info.extract_name
+      | None ->
+          ( ctx.fmt.trait_decl_name trait_decl,
+            ctx.fmt.trait_decl_constructor trait_decl )
+      | Some info -> (info.extract_name, info.constructor)
     in
-    ctx_add (TraitDeclId trait_decl.def_id) trait_name ctx
+    let ctx = ctx_add (TraitDeclId trait_decl.def_id) trait_name ctx in
+    ctx_add (TraitDeclConstructorId trait_decl.def_id) trait_constructor ctx
   in
   (* Parent clauses *)
   let ctx =
@@ -2108,7 +2117,7 @@ let extract_trait_decl_item (ctx : extraction_ctx) (fmt : F.formatter)
 
 let extract_trait_impl_item (ctx : extraction_ctx) (fmt : F.formatter)
     (item_name : string) (ty : unit -> unit) : unit =
-  let assign = match !Config.backend with Lean -> ":=" | _ -> "=" in
+  let assign = match !Config.backend with Lean | Coq -> ":=" | _ -> "=" in
   extract_trait_item ctx fmt item_name assign ty
 
 (** Small helper - TODO: move *)
@@ -2215,87 +2224,173 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
     cg_params trait_clauses;
 
   F.pp_print_space fmt ();
-  (match !backend with
-  | Lean -> F.pp_print_string fmt "where"
-  | FStar -> if not is_empty then F.pp_print_string fmt "= {"
-  | _ -> F.pp_print_string fmt "{");
-  if !backend = FStar && is_empty then F.pp_print_string fmt "= unit";
+  if is_empty && !backend = FStar then (
+    F.pp_print_string fmt "= unit";
+    (* Outer box *)
+    F.pp_close_box fmt ())
+  else if is_empty && !backend = Coq then (
+    (* Coq is not very good at infering constructors *)
+    let cons = ctx_get_trait_constructor decl.def_id ctx in
+    F.pp_print_string fmt (":= " ^ cons ^ "{}.");
+    (* Outer box *)
+    F.pp_close_box fmt ())
+  else (
+    (match !backend with
+    | Lean -> F.pp_print_string fmt "where"
+    | FStar -> F.pp_print_string fmt "= {"
+    | Coq ->
+        let cons = ctx_get_trait_constructor decl.def_id ctx in
+        F.pp_print_string fmt (":= " ^ cons ^ " {")
+    | _ -> F.pp_print_string fmt "{");
 
-  (* Close the box for the name + generics *)
-  F.pp_close_box fmt ();
+    (* Close the box for the name + generics *)
+    F.pp_close_box fmt ();
 
-  (*
-   * Extract the items
-   *)
+    (*
+     * Extract the items
+     *)
 
-  (* The constants *)
-  List.iter
-    (fun (name, (ty, _)) ->
-      let item_name = ctx_get_trait_const decl.def_id name ctx in
-      let ty () =
-        let inside = false in
-        F.pp_print_space fmt ();
-        extract_ty ctx fmt TypeDeclId.Set.empty inside ty
-      in
-      extract_trait_decl_item ctx fmt item_name ty)
-    decl.consts;
+    (* The constants *)
+    List.iter
+      (fun (name, (ty, _)) ->
+        let item_name = ctx_get_trait_const decl.def_id name ctx in
+        let ty () =
+          let inside = false in
+          F.pp_print_space fmt ();
+          extract_ty ctx fmt TypeDeclId.Set.empty inside ty
+        in
+        extract_trait_decl_item ctx fmt item_name ty)
+      decl.consts;
 
-  (* The types *)
-  List.iter
-    (fun (name, (clauses, _)) ->
-      (* Extract the type *)
-      let item_name = ctx_get_trait_type decl.def_id name ctx in
-      let ty () =
-        F.pp_print_space fmt ();
-        F.pp_print_string fmt (type_keyword ())
-      in
-      extract_trait_decl_item ctx fmt item_name ty;
-      (* Extract the clauses *)
-      List.iter
-        (fun clause ->
-          let item_name =
-            ctx_get_trait_item_clause decl.def_id name clause.clause_id ctx
-          in
-          let ty () =
-            F.pp_print_space fmt ();
-            extract_trait_clause_type ctx fmt TypeDeclId.Set.empty clause
-          in
-          extract_trait_decl_item ctx fmt item_name ty)
-        clauses)
-    decl.types;
+    (* The types *)
+    List.iter
+      (fun (name, (clauses, _)) ->
+        (* Extract the type *)
+        let item_name = ctx_get_trait_type decl.def_id name ctx in
+        let ty () =
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt (type_keyword ())
+        in
+        extract_trait_decl_item ctx fmt item_name ty;
+        (* Extract the clauses *)
+        List.iter
+          (fun clause ->
+            let item_name =
+              ctx_get_trait_item_clause decl.def_id name clause.clause_id ctx
+            in
+            let ty () =
+              F.pp_print_space fmt ();
+              extract_trait_clause_type ctx fmt TypeDeclId.Set.empty clause
+            in
+            extract_trait_decl_item ctx fmt item_name ty)
+          clauses)
+      decl.types;
 
-  (* The parent clauses - note that the parent clauses may refer to the types
-     and const generics: for this reason we extract them *after* *)
-  List.iter
-    (fun clause ->
-      let item_name =
-        ctx_get_trait_parent_clause decl.def_id clause.clause_id ctx
-      in
-      let ty () =
-        F.pp_print_space fmt ();
-        extract_trait_clause_type ctx fmt TypeDeclId.Set.empty clause
-      in
-      extract_trait_decl_item ctx fmt item_name ty)
-    decl.parent_clauses;
+    (* The parent clauses - note that the parent clauses may refer to the types
+       and const generics: for this reason we extract them *after* *)
+    List.iter
+      (fun clause ->
+        let item_name =
+          ctx_get_trait_parent_clause decl.def_id clause.clause_id ctx
+        in
+        let ty () =
+          F.pp_print_space fmt ();
+          extract_trait_clause_type ctx fmt TypeDeclId.Set.empty clause
+        in
+        extract_trait_decl_item ctx fmt item_name ty)
+      decl.parent_clauses;
 
-  (* The required methods *)
-  List.iter
-    (fun (name, id) -> extract_trait_decl_method_items ctx fmt decl name id)
-    decl.required_methods;
-
-  (* Close the outer boxes for the definition *)
-  if !Config.backend <> Lean then F.pp_close_box fmt ();
-  (* Close the brackets *)
-  (match !Config.backend with
-  | Lean -> ()
-  | _ ->
-      if (not (!backend = FStar)) || not is_empty then (
+    (* The required methods *)
+    List.iter
+      (fun (name, id) -> extract_trait_decl_method_items ctx fmt decl name id)
+      decl.required_methods;
+
+    (* Close the outer boxes for the definition *)
+    if !Config.backend <> Lean then F.pp_close_box fmt ();
+    (* Close the brackets *)
+    match !Config.backend with
+    | Lean -> ()
+    | Coq ->
+        F.pp_print_space fmt ();
+        F.pp_print_string fmt "}."
+    | _ ->
         F.pp_print_space fmt ();
-        F.pp_print_string fmt "}"));
+        F.pp_print_string fmt "}");
   F.pp_close_box fmt ();
   (* Add breaks to insert new lines between definitions *)
   F.pp_print_break fmt 0 0
 
+(** Generate the [Arguments] instructions for the trait declarationsin Coq, so
+    that we don't have to provide the implicit arguments when projecting the fields. *)
+let extract_trait_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter)
+    (decl : trait_decl) : unit =
+  (* Generating the [Arguments] instructions is useful only if there are parameters *)
+  let num_params =
+    List.length decl.generics.types
+    + List.length decl.generics.const_generics
+    + List.length decl.generics.trait_clauses
+  in
+  if num_params > 0 then (
+    (* The constructor *)
+    let cons_name = ctx_get_trait_constructor decl.def_id ctx in
+    extract_coq_arguments_instruction ctx fmt cons_name num_params;
+    (* The constants *)
+    List.iter
+      (fun (name, _) ->
+        let item_name = ctx_get_trait_const decl.def_id name ctx in
+        extract_coq_arguments_instruction ctx fmt item_name num_params)
+      decl.consts;
+    (* The types *)
+    List.iter
+      (fun (name, (clauses, _)) ->
+        (* The type *)
+        let item_name = ctx_get_trait_type decl.def_id name ctx in
+        extract_coq_arguments_instruction ctx fmt item_name num_params;
+        (* The type clauses *)
+        List.iter
+          (fun clause ->
+            let item_name =
+              ctx_get_trait_item_clause decl.def_id name clause.clause_id ctx
+            in
+            extract_coq_arguments_instruction ctx fmt item_name num_params)
+          clauses)
+      decl.types;
+    (* The parent clauses *)
+    List.iter
+      (fun clause ->
+        let item_name =
+          ctx_get_trait_parent_clause decl.def_id clause.clause_id ctx
+        in
+        extract_coq_arguments_instruction ctx fmt item_name num_params)
+      decl.parent_clauses;
+    (* The required methods *)
+    List.iter
+      (fun (item_name, id) ->
+        (* Lookup the definition *)
+        let trans = A.FunDeclId.Map.find id ctx.trans_funs in
+        (* Extract the items *)
+        let funs =
+          if trans.keep_fwd then trans.fwd :: trans.backs else trans.backs
+        in
+        let extract_for_method (f : fun_and_loops) =
+          let f = f.f in
+          let item_name =
+            ctx_get_trait_method decl.def_id item_name f.back_id ctx
+          in
+          extract_coq_arguments_instruction ctx fmt item_name num_params
+        in
+        List.iter extract_for_method funs)
+      decl.required_methods;
+    (* Add a space *)
+    F.pp_print_space fmt ())
+
+(** See {!extract_trait_decl_coq_arguments} *)
+let extract_trait_decl_extra_info (ctx : extraction_ctx) (fmt : F.formatter)
+    (trait_decl : trait_decl) : unit =
+  match !backend with
+  | Coq -> extract_trait_decl_coq_arguments ctx fmt trait_decl
+  | _ -> ()
+
 (** Small helper.
 
     Extract the items for a method in a trait impl.
@@ -2425,76 +2520,92 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
   let is_empty = trait_impl_is_empty { impl with provided_methods = [] } in
 
   F.pp_print_space fmt ();
-  if !Config.backend = Lean then F.pp_print_string fmt ":= {"
-  else if !Config.backend = FStar && is_empty then F.pp_print_string fmt "= ()"
-  else F.pp_print_string fmt "= {";
+  if is_empty && !Config.backend = FStar then (
+    F.pp_print_string fmt "= ()";
+    (* Outer box *)
+    F.pp_close_box fmt ())
+  else if is_empty && !Config.backend = Coq then (
+    (* Coq is not very good at infering constructors *)
+    let cons = ctx_get_trait_constructor impl.impl_trait.trait_decl_id ctx in
+    F.pp_print_string fmt (":= " ^ cons ^ ".");
+    (* Outer box *)
+    F.pp_close_box fmt ())
+  else (
+    if !Config.backend = Lean then F.pp_print_string fmt ":= {"
+    else if !Config.backend = Coq then F.pp_print_string fmt ":= {|"
+    else F.pp_print_string fmt "= {";
 
-  (* Close the box for the name + generics *)
-  F.pp_close_box fmt ();
+    (* Close the box for the name + generics *)
+    F.pp_close_box fmt ();
 
-  (*
-   * Extract the items
-   *)
-  let trait_decl_id = impl.impl_trait.trait_decl_id in
+    (*
+     * Extract the items
+     *)
+    let trait_decl_id = impl.impl_trait.trait_decl_id in
 
-  (* The constants *)
-  List.iter
-    (fun (name, (_, id)) ->
-      let item_name = ctx_get_trait_const trait_decl_id name ctx in
-      let ty () =
-        F.pp_print_space fmt ();
-        F.pp_print_string fmt (ctx_get_global id ctx)
-      in
+    (* The constants *)
+    List.iter
+      (fun (name, (_, id)) ->
+        let item_name = ctx_get_trait_const trait_decl_id name ctx in
+        let ty () =
+          F.pp_print_space fmt ();
+          F.pp_print_string fmt (ctx_get_global id ctx)
+        in
 
-      extract_trait_impl_item ctx fmt item_name ty)
-    impl.consts;
+        extract_trait_impl_item ctx fmt item_name ty)
+      impl.consts;
 
-  (* The types *)
-  List.iter
-    (fun (name, (trait_refs, ty)) ->
-      (* Extract the type *)
-      let item_name = ctx_get_trait_type trait_decl_id name ctx in
-      let ty () =
-        F.pp_print_space fmt ();
-        extract_ty ctx fmt TypeDeclId.Set.empty false ty
-      in
-      extract_trait_impl_item ctx fmt item_name ty;
-      (* Extract the clauses *)
-      TraitClauseId.iteri
-        (fun clause_id trait_ref ->
-          let item_name =
-            ctx_get_trait_item_clause trait_decl_id name clause_id ctx
-          in
-          let ty () =
-            F.pp_print_space fmt ();
-            extract_trait_ref ctx fmt TypeDeclId.Set.empty false trait_ref
-          in
-          extract_trait_impl_item ctx fmt item_name ty)
-        trait_refs)
-    impl.types;
-
-  (* The parent clauses *)
-  TraitClauseId.iteri
-    (fun clause_id trait_ref ->
-      let item_name = ctx_get_trait_parent_clause trait_decl_id clause_id ctx in
-      let ty () =
-        F.pp_print_space fmt ();
-        extract_trait_ref ctx fmt TypeDeclId.Set.empty false trait_ref
-      in
-      extract_trait_impl_item ctx fmt item_name ty)
-    impl.parent_trait_refs;
+    (* The types *)
+    List.iter
+      (fun (name, (trait_refs, ty)) ->
+        (* Extract the type *)
+        let item_name = ctx_get_trait_type trait_decl_id name ctx in
+        let ty () =
+          F.pp_print_space fmt ();
+          extract_ty ctx fmt TypeDeclId.Set.empty false ty
+        in
+        extract_trait_impl_item ctx fmt item_name ty;
+        (* Extract the clauses *)
+        TraitClauseId.iteri
+          (fun clause_id trait_ref ->
+            let item_name =
+              ctx_get_trait_item_clause trait_decl_id name clause_id ctx
+            in
+            let ty () =
+              F.pp_print_space fmt ();
+              extract_trait_ref ctx fmt TypeDeclId.Set.empty false trait_ref
+            in
+            extract_trait_impl_item ctx fmt item_name ty)
+          trait_refs)
+      impl.types;
+
+    (* The parent clauses *)
+    TraitClauseId.iteri
+      (fun clause_id trait_ref ->
+        let item_name =
+          ctx_get_trait_parent_clause trait_decl_id clause_id ctx
+        in
+        let ty () =
+          F.pp_print_space fmt ();
+          extract_trait_ref ctx fmt TypeDeclId.Set.empty false trait_ref
+        in
+        extract_trait_impl_item ctx fmt item_name ty)
+      impl.parent_trait_refs;
 
-  (* The required methods *)
-  List.iter
-    (fun (name, id) ->
-      extract_trait_impl_method_items ctx fmt impl name id all_generics)
-    impl.required_methods;
+    (* The required methods *)
+    List.iter
+      (fun (name, id) ->
+        extract_trait_impl_method_items ctx fmt impl name id all_generics)
+      impl.required_methods;
 
-  (* Close the outer boxes for the definition, as well as the brackets *)
-  F.pp_close_box fmt ();
-  if (not (!backend = FStar)) || not is_empty then (
-    F.pp_print_space fmt ();
-    F.pp_print_string fmt "}");
+    (* Close the outer boxes for the definition, as well as the brackets *)
+    F.pp_close_box fmt ();
+    if !backend = Coq then (
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt "|}.")
+    else if (not (!backend = FStar)) || not is_empty then (
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt "}"));
   F.pp_close_box fmt ();
   (* Add breaks to insert new lines between definitions *)
   F.pp_print_break fmt 0 0
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 55b1bca3..31b1a447 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -246,6 +246,7 @@ type formatter = {
        *)
   trait_decl_name : trait_decl -> string;
   trait_impl_name : trait_decl -> trait_impl -> string;
+  trait_decl_constructor : trait_decl -> string;
   trait_parent_clause_name : trait_decl -> trait_clause -> string;
   trait_const_name : trait_decl -> string -> string;
   trait_type_name : trait_decl -> string -> string;
@@ -388,6 +389,7 @@ type id =
   | TraitDeclId of TraitDeclId.id
   | TraitImplId of TraitImplId.id
   | LocalTraitClauseId of TraitClauseId.id
+  | TraitDeclConstructorId of TraitDeclId.id
   | TraitMethodId of TraitDeclId.id * string * T.RegionGroupId.id option
       (** Something peculiar with trait methods: because we have to take into
           account forward/backward functions, we may need to generate fields
@@ -801,6 +803,8 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | TraitImplId id -> "trait_impl_id: " ^ TraitImplId.to_string id
   | LocalTraitClauseId id ->
       "local_trait_clause_id: " ^ TraitClauseId.to_string id
+  | TraitDeclConstructorId id ->
+      "trait_decl_constructor: " ^ trait_decl_id_to_string id
   | TraitParentClauseId (id, clause_id) ->
       "trait_parent_clause_id: " ^ trait_decl_id_to_string id ^ ", clause_id: "
       ^ TraitClauseId.to_string clause_id
@@ -959,6 +963,10 @@ let ctx_get_local_type (id : TypeDeclId.id) (ctx : extraction_ctx) : string =
 let ctx_get_assumed_type (id : assumed_ty) (ctx : extraction_ctx) : string =
   ctx_get_type (Assumed id) ctx
 
+let ctx_get_trait_constructor (id : trait_decl_id) (ctx : extraction_ctx) :
+    string =
+  ctx_get (TraitDeclConstructorId id) ctx
+
 let ctx_get_trait_self_clause (ctx : extraction_ctx) : string =
   ctx_get TraitSelfClauseId ctx
 
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index c6bde9c2..a54ab604 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -420,6 +420,7 @@ let builtin_fun_effects_map =
 type builtin_trait_decl_info = {
   rust_name : string;
   extract_name : string;
+  constructor : string;
   parent_clauses : string list;
   consts : (string * string) list;
   types : (string * (string * string list)) list;
@@ -444,6 +445,7 @@ let builtin_trait_decls_info () =
           | Coq | FStar | HOL4 -> String.concat "_" rust_name
           | Lean -> String.concat "." rust_name)
     in
+    let constructor = mk_struct_constructor extract_name in
     let consts = [] in
     let types =
       let mk_type item_name =
@@ -479,7 +481,15 @@ let builtin_trait_decls_info () =
       List.map mk_method methods
     in
     let rust_name = String.concat "::" rust_name in
-    { rust_name; extract_name; parent_clauses; consts; types; methods }
+    {
+      rust_name;
+      extract_name;
+      constructor;
+      parent_clauses;
+      consts;
+      types;
+      methods;
+    }
   in
   [
     (* Deref *)
diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml
index a294d4ca..77f76bb4 100644
--- a/compiler/ExtractTypes.ml
+++ b/compiler/ExtractTypes.ml
@@ -697,6 +697,11 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     | Coq | HOL4 | Lean -> name
   in
 
+  let trait_decl_constructor (trait_decl : trait_decl) : string =
+    let name = trait_decl_name trait_decl in
+    ExtractBuiltin.mk_struct_constructor name
+  in
+
   let trait_parent_clause_name (trait_decl : trait_decl) (clause : trait_clause)
       : string =
     (* TODO: improve - it would be better to not use indices *)
@@ -937,6 +942,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     decreases_proof_name;
     trait_decl_name;
     trait_impl_name;
+    trait_decl_constructor;
     trait_parent_clause_name;
     trait_const_name;
     trait_type_name;
@@ -1254,6 +1260,9 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
           ctx_get_trait_type trait_ref.trait_decl_ref.trait_decl_id type_name
             ctx
         in
+        let add_brackets (s : string) =
+          if !backend = Coq then "(" ^ s ^ ")" else s
+        in
         (* There may be a special treatment depending on the instance id.
            See the comments for {!extract_trait_instance_id_with_dot}.
            TODO: there should be a cleaner way to do. The annoying thing
@@ -1276,7 +1285,7 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
             extract_trait_ref ctx fmt no_params_tys false trait_ref;
             extract_generic_args ctx fmt no_params_tys generics;
             if use_brackets then F.pp_print_string fmt ")";
-            F.pp_print_string fmt ("." ^ type_name))
+            F.pp_print_string fmt ("." ^ add_brackets type_name))
 
 and extract_trait_ref (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_ref) : unit =
@@ -1376,6 +1385,7 @@ and extract_trait_instance_id_with_dot (ctx : extraction_ctx)
 and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (inside : bool) (id : trait_instance_id)
     : unit =
+  let add_brackets (s : string) = if !backend = Coq then "(" ^ s ^ ")" else s in
   match id with
   | Self ->
       (* This has a specific treatment depending on the item we're extracting
@@ -1393,12 +1403,12 @@ and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter)
       (* Use the trait decl id to lookup the name *)
       let name = ctx_get_trait_parent_clause decl_id clause_id ctx in
       extract_trait_instance_id_with_dot ctx fmt no_params_tys true inst_id;
-      F.pp_print_string fmt name
+      F.pp_print_string fmt (add_brackets name)
   | ItemClause (inst_id, decl_id, item_name, clause_id) ->
       (* Use the trait decl id to lookup the name *)
       let name = ctx_get_trait_item_clause decl_id item_name clause_id ctx in
       extract_trait_instance_id_with_dot ctx fmt no_params_tys true inst_id;
-      F.pp_print_string fmt name
+      F.pp_print_string fmt (add_brackets name)
   | TraitRef trait_ref ->
       extract_trait_ref ctx fmt no_params_tys inside trait_ref
   | UnknownTrait _ ->
@@ -2156,49 +2166,59 @@ let extract_type_decl (ctx : extraction_ctx) (fmt : F.formatter)
         extract_type_decl_gen ctx fmt type_decl_group kind def extract_body
     | HOL4 -> extract_type_decl_hol4_opaque ctx fmt def
 
+(** Generate a [Argument] instruction in Coq to allow omitting implicit
+    arguments for variants, fields, etc..
+
+    For instance, provided we have this definition:
+    {[
+      Inductive result A :=
+      | Return : A -> result A
+      | Fail_ : error -> result A.
+    ]}
+
+    We may want to generate those instructions:
+    {[
+      Arguments Return {_} a.
+      Arguments Fail_ {_}.
+    ]}
+ *)
+let extract_coq_arguments_instruction (ctx : extraction_ctx) (fmt : F.formatter)
+    (cons_name : string) (num_implicit_params : int) : unit =
+  (* Add a break before *)
+  F.pp_print_break fmt 0 0;
+  (* Open a box *)
+  F.pp_open_hovbox fmt ctx.indent_incr;
+  F.pp_print_break fmt 0 0;
+  F.pp_print_string fmt "Arguments";
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt cons_name;
+  (* Print the type/const params and the trait clauses (`{T}`) *)
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt "{";
+  Collections.List.iter_times num_implicit_params (fun () ->
+      F.pp_print_space fmt ();
+      F.pp_print_string fmt "_");
+  F.pp_print_space fmt ();
+  F.pp_print_string fmt "}.";
+
+  (* Close the box *)
+  F.pp_close_box fmt ()
+
 (** Auxiliary function.
 
-    Generate [Arguments] instructions in Coq.
+    Generate [Arguments] instructions in Coq for type definitions.
  *)
 let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter)
     (kind : decl_kind) (decl : type_decl) : unit =
   assert (!backend = Coq);
-  (* Generating the [Arguments] instructions is useful only if there are type parameters *)
-  if decl.generics.types = [] && decl.generics.const_generics = [] then ()
+  (* Generating the [Arguments] instructions is useful only if there are parameters *)
+  let num_params =
+    List.length decl.generics.types
+    + List.length decl.generics.const_generics
+    + List.length decl.generics.trait_clauses
+  in
+  if num_params = 0 then ()
   else
-    (* Add the type params - note that we need those bindings only for the
-     * body translation (they are not top-level) *)
-    let _ctx_body, type_params, cg_params, trait_clauses =
-      ctx_add_generic_params decl.generics ctx
-    in
-    (* Auxiliary function to extract an [Arguments Cons {T} _ _.] instruction *)
-    let extract_arguments_info (cons_name : string) (fields : 'a list) : unit =
-      (* Add a break before *)
-      F.pp_print_break fmt 0 0;
-      (* Open a box *)
-      F.pp_open_hovbox fmt ctx.indent_incr;
-      F.pp_print_break fmt 0 0;
-      F.pp_print_string fmt "Arguments";
-      F.pp_print_space fmt ();
-      F.pp_print_string fmt cons_name;
-      (* Print the type/const params and the trait clauses (`{T}`) *)
-      List.iter
-        (fun (var : string) ->
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt ("{" ^ var ^ "}"))
-        (List.concat [ type_params; cg_params; trait_clauses ]);
-      (* Print the fields (`_`) *)
-      List.iter
-        (fun _ ->
-          F.pp_print_space fmt ();
-          F.pp_print_string fmt "_")
-        fields;
-      F.pp_print_string fmt ".";
-
-      (* Close the box *)
-      F.pp_close_box fmt ()
-    in
-
     (* Generate the [Arguments] instruction *)
     match decl.kind with
     | Opaque -> ()
@@ -2206,23 +2226,23 @@ let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter)
         let adt_id = AdtId decl.def_id in
         (* Generate the instruction for the record constructor *)
         let cons_name = ctx_get_struct adt_id ctx in
-        extract_arguments_info cons_name fields;
+        extract_coq_arguments_instruction ctx fmt cons_name num_params;
         (* Generate the instruction for the record projectors, if there are *)
         let is_rec = decl_is_from_rec_group kind in
         if not is_rec then
           FieldId.iteri
             (fun fid _ ->
               let cons_name = ctx_get_field adt_id fid ctx in
-              extract_arguments_info cons_name [])
+              extract_coq_arguments_instruction ctx fmt cons_name num_params)
             fields;
         (* Add breaks to insert new lines between definitions *)
         F.pp_print_break fmt 0 0
     | Enum variants ->
         (* Generate the instructions *)
         VariantId.iteri
-          (fun vid (v : variant) ->
+          (fun vid (_ : variant) ->
             let cons_name = ctx_get_variant (AdtId decl.def_id) vid ctx in
-            extract_arguments_info cons_name v.fields)
+            extract_coq_arguments_instruction ctx fmt cons_name num_params)
           variants;
         (* Add breaks to insert new lines between definitions *)
         F.pp_print_break fmt 0 0
diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml
index 69c0df71..e17ea16f 100644
--- a/compiler/FunsAnalysis.ml
+++ b/compiler/FunsAnalysis.ml
@@ -104,9 +104,10 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
                 (* None of the assumed functions can diverge nor are considered stateful *)
                 can_fail := !can_fail || Assumed.assumed_fun_can_fail id
             | TraitMethod _ ->
-                (* We consider trait functions can fail, diverge, and are not stateful *)
-                can_fail := true;
-                can_diverge := true);
+                (* We consider trait functions can fail, but can not diverge and are not stateful.
+                   TODO: this may cause issues if we use use a fuel parameter.
+                *)
+                can_fail := true);
             super#visit_Call env call
 
           method! visit_Panic env =
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index cb23198a..a3d96023 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -751,14 +751,17 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
 
 (** Export a trait declaration. *)
 let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
-    (ctx : gen_ctx) (trait_decl_id : Pure.trait_decl_id) : unit =
+    (ctx : gen_ctx) (trait_decl_id : Pure.trait_decl_id) (extract_decl : bool)
+    (extract_extra_info : bool) : unit =
   let trait_decl = T.TraitDeclId.Map.find trait_decl_id ctx.trans_trait_decls in
   (* Check if the trait declaration is builtin, in which case we ignore it *)
   let open ExtractBuiltin in
   let sname = name_to_simple_name trait_decl.name in
-  if SimpleNameMap.find_opt sname (builtin_trait_decls_map ()) = None then
+  if SimpleNameMap.find_opt sname (builtin_trait_decls_map ()) = None then (
     let ctx = { ctx with trait_decl_id = Some trait_decl.def_id } in
-    Extract.extract_trait_decl ctx fmt trait_decl
+    if extract_decl then Extract.extract_trait_decl ctx fmt trait_decl;
+    if extract_extra_info then
+      Extract.extract_trait_decl_extra_info ctx fmt trait_decl)
   else ()
 
 (** Export a trait implementation. *)
@@ -796,7 +799,12 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
   let export_functions_group = export_functions_group fmt config ctx in
   let export_global = export_global fmt config ctx in
   let export_types_group = export_types_group fmt config ctx in
-  let export_trait_decl = export_trait_decl fmt config ctx in
+  let export_trait_decl_group id =
+    export_trait_decl fmt config ctx id true false
+  in
+  let export_trait_decl_group_extra_info id =
+    export_trait_decl fmt config ctx id false true
+  in
   let export_trait_impl = export_trait_impl fmt config ctx in
 
   let export_state_type () : unit =
@@ -833,8 +841,10 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
         export_functions_group pure_funs
     | Global id -> export_global id
     | TraitDecl id ->
-        if config.extract_trait_decls && config.extract_transparent then
-          export_trait_decl id
+        (* TODO: update to extract groups *)
+        if config.extract_trait_decls && config.extract_transparent then (
+          export_trait_decl_group id;
+          export_trait_decl_group_extra_info id)
     | TraitImpl id ->
         if config.extract_trait_impls && config.extract_transparent then
           export_trait_impl id
-- 
cgit v1.3.1


From b9f33bdd871a1bd7a1bd29f148dd05bd7990548b Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 12 Nov 2023 19:28:56 +0100
Subject: Remove the 'r type variable from the ty type definition

---
 compiler/AssociatedTypes.ml            | 482 ++++++++++++---------------------
 compiler/Assumed.ml                    |  29 +-
 compiler/Contexts.ml                   | 239 +++++-----------
 compiler/Extract.ml                    |  26 +-
 compiler/ExtractBase.ml                |  54 ++--
 compiler/ExtractTypes.ml               |  42 +--
 compiler/FunsAnalysis.ml               |   4 +-
 compiler/Interpreter.ml                |  11 +-
 compiler/InterpreterBorrows.ml         |  52 ++--
 compiler/InterpreterBorrows.mli        |   1 -
 compiler/InterpreterBorrowsCore.ml     |  40 ++-
 compiler/InterpreterExpansion.ml       |  38 +--
 compiler/InterpreterExpressions.ml     |  90 +++---
 compiler/InterpreterLoopsCore.ml       |  12 +-
 compiler/InterpreterLoopsFixedPoint.ml |  16 +-
 compiler/InterpreterLoopsJoinCtxs.ml   |  51 ++--
 compiler/InterpreterLoopsMatchCtxs.ml  |  87 +++---
 compiler/InterpreterPaths.ml           |  33 +--
 compiler/InterpreterPaths.mli          |   7 +-
 compiler/InterpreterProjectors.ml      |  35 +--
 compiler/InterpreterProjectors.mli     |   6 +-
 compiler/InterpreterStatements.ml      | 118 ++++----
 compiler/InterpreterUtils.ml           |  83 +++---
 compiler/Invariants.ml                 |  67 +++--
 compiler/LlbcAst.ml                    |   9 +-
 compiler/LlbcAstUtils.ml               |   8 +-
 compiler/Print.ml                      | 202 ++++----------
 compiler/PrintPure.ml                  |  24 +-
 compiler/Pure.ml                       |  12 +-
 compiler/PureMicroPasses.ml            |  10 +-
 compiler/PureTypeCheck.ml              |  12 +-
 compiler/PureUtils.ml                  |  56 ++--
 compiler/ReorderDecls.ml               |   4 +-
 compiler/Substitute.ml                 | 426 +++++++++++------------------
 compiler/SymbolicAst.ml                |  40 +--
 compiler/SymbolicToPure.ml             | 219 +++++++--------
 compiler/SynthesizeSymbolic.ml         |  20 +-
 compiler/Translate.ml                  |  12 +-
 compiler/TypesAnalysis.ml              |  24 +-
 compiler/TypesUtils.ml                 |  87 +++++-
 compiler/Values.ml                     | 298 ++++++--------------
 compiler/ValuesUtils.ml                |  30 +-
 42 files changed, 1305 insertions(+), 1811 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/AssociatedTypes.ml b/compiler/AssociatedTypes.ml
index 581e218c..c76af138 100644
--- a/compiler/AssociatedTypes.ml
+++ b/compiler/AssociatedTypes.ml
@@ -20,141 +20,80 @@ module PA = Print.EvalCtxLlbcAst
 (** The local logger *)
 let log = L.associated_types_log
 
-let trait_type_ref_substitute (subst : ('r, 'r1) Subst.subst)
-    (r : 'r C.trait_type_ref) : 'r1 C.trait_type_ref =
+let trait_type_ref_substitute (subst : Subst.subst) (r : C.trait_type_ref) :
+    C.trait_type_ref =
   let { C.trait_ref; type_name } = r in
   let trait_ref = Subst.trait_ref_substitute subst trait_ref in
   { C.trait_ref; type_name }
 
-(* TODO: how not to duplicate below? *)
-module RTyOrd = struct
-  type t = T.rty
+module TyOrd = struct
+  type t = T.ty
 
-  let compare = T.compare_rty
-  let to_string = T.show_rty
-  let pp_t = T.pp_rty
-  let show_t = T.show_rty
+  let compare = T.compare_ty
+  let to_string = T.show_ty
+  let pp_t = T.pp_ty
+  let show_t = T.show_ty
 end
 
-module STyOrd = struct
-  type t = T.sty
+module TyMap = Collections.MakeMap (TyOrd)
 
-  let compare = T.compare_sty
-  let to_string = T.show_sty
-  let pp_t = T.pp_sty
-  let show_t = T.show_sty
-end
-
-module RTyMap = Collections.MakeMap (RTyOrd)
-module STyMap = Collections.MakeMap (STyOrd)
-
-(* TODO: is it possible not to have this? *)
-module type TypeWrapper = sig
-  type t
-end
-
-(* TODO: don't manage to get the syntax right so using a functor *)
-module MakeNormalizer
-    (R : TypeWrapper)
-    (RTyMap : Collections.Map with type key = R.t T.region T.ty)
-    (M : Collections.Map with type key = R.t T.region C.trait_type_ref) =
-struct
-  let compute_norm_trait_types_from_preds
-      (trait_type_constraints : R.t T.region T.trait_type_constraint list) :
-      R.t T.region T.ty M.t =
-    (* Compute a union-find structure by recursively exploring the predicates and clauses *)
-    let norm : R.t T.region T.ty UF.elem RTyMap.t ref = ref RTyMap.empty in
-    let get_ref (ty : R.t T.region T.ty) : R.t T.region T.ty UF.elem =
-      match RTyMap.find_opt ty !norm with
-      | Some r -> r
-      | None ->
-          let r = UF.make ty in
-          norm := RTyMap.add ty r !norm;
-          r
-    in
-    let add_trait_type_constraint (c : R.t T.region T.trait_type_constraint) =
-      let trait_ty = T.TraitType (c.trait_ref, c.generics, c.type_name) in
-      let trait_ty_ref = get_ref trait_ty in
-      let ty_ref = get_ref c.ty in
-      let new_repr = UF.get ty_ref in
-      let merged = UF.union trait_ty_ref ty_ref in
-      (* Not sure the set operation is necessary, but I want to control which
-         representative is chosen *)
-      UF.set merged new_repr
-    in
-    (* Explore the local predicates *)
-    List.iter add_trait_type_constraint trait_type_constraints;
-    (* TODO: explore the local clauses *)
-    (* Compute the norm maps *)
-    let rbindings =
-      List.map (fun (k, v) -> (k, UF.get v)) (RTyMap.bindings !norm)
-    in
-    (* Filter the keys to keep only the trait type aliases *)
-    let rbindings =
-      List.filter_map
-        (fun (k, v) ->
-          match k with
-          | T.TraitType (trait_ref, generics, type_name) ->
-              assert (generics = TypesUtils.mk_empty_generic_args);
-              Some ({ C.trait_ref; type_name }, v)
-          | _ -> None)
-        rbindings
-    in
-    M.of_list rbindings
-end
-
-(** Compute the representative classes of trait associated types, for normalization *)
-let compute_norm_trait_stypes_from_preds
-    (trait_type_constraints : T.strait_type_constraint list) :
-    T.sty C.STraitTypeRefMap.t =
-  (* Compute the normalization map for the types with regions *)
-  let module R = struct
-    type t = T.region_var_id
-  end in
-  let module M = C.STraitTypeRefMap in
-  let module Norm = MakeNormalizer (R) (STyMap) (M) in
-  Norm.compute_norm_trait_types_from_preds trait_type_constraints
-
-(** Compute the representative classes of trait associated types, for normalization *)
 let compute_norm_trait_types_from_preds
-    (trait_type_constraints : T.rtrait_type_constraint list) :
-    T.ety C.ETraitTypeRefMap.t * T.rty C.RTraitTypeRefMap.t =
-  (* Compute the normalization map for the types with regions *)
-  let module R = struct
-    type t = T.region_id
-  end in
-  let module M = C.RTraitTypeRefMap in
-  let module Norm = MakeNormalizer (R) (RTyMap) (M) in
+    (trait_type_constraints : T.trait_type_constraint list) :
+    T.ty C.TraitTypeRefMap.t =
+  (* Compute a union-find structure by recursively exploring the predicates and clauses *)
+  let norm : T.ty UF.elem TyMap.t ref = ref TyMap.empty in
+  let get_ref (ty : T.ty) : T.ty UF.elem =
+    match TyMap.find_opt ty !norm with
+    | Some r -> r
+    | None ->
+        let r = UF.make ty in
+        norm := TyMap.add ty r !norm;
+        r
+  in
+  let add_trait_type_constraint (c : T.trait_type_constraint) =
+    (* Sanity check: the type constraint can't make use of regions - Remark
+       that it would be enough to only visit the field [ty] of the trait type
+       constraint, but for safety we visit all the fields *)
+    assert (TU.trait_type_constraint_no_regions c);
+    let trait_ty = T.TraitType (c.trait_ref, c.generics, c.type_name) in
+    let trait_ty_ref = get_ref trait_ty in
+    let ty_ref = get_ref c.ty in
+    let new_repr = UF.get ty_ref in
+    let merged = UF.union trait_ty_ref ty_ref in
+    (* Not sure the set operation is necessary, but I want to control which
+       representative is chosen *)
+    UF.set merged new_repr
+  in
+  (* Explore the local predicates *)
+  List.iter add_trait_type_constraint trait_type_constraints;
+  (* TODO: explore the local clauses *)
+  (* Compute the norm maps *)
   let rbindings =
-    Norm.compute_norm_trait_types_from_preds trait_type_constraints
+    List.map (fun (k, v) -> (k, UF.get v)) (TyMap.bindings !norm)
   in
-  (* Compute the normalization map for the types with erased regions *)
-  let ebindings =
-    List.map
+  (* Filter the keys to keep only the trait type aliases *)
+  let rbindings =
+    List.filter_map
       (fun (k, v) ->
-        ( trait_type_ref_substitute Subst.erase_regions_subst k,
-          Subst.erase_regions v ))
-      (M.bindings rbindings)
-  in
-  (C.ETraitTypeRefMap.of_list ebindings, rbindings)
-
-let ctx_add_norm_trait_stypes_from_preds (ctx : C.eval_ctx)
-    (trait_type_constraints : T.strait_type_constraint list) : C.eval_ctx =
-  let norm_trait_stypes =
-    compute_norm_trait_stypes_from_preds trait_type_constraints
+        match k with
+        | T.TraitType (trait_ref, generics, type_name) ->
+            assert (generics = TypesUtils.mk_empty_generic_args);
+            Some ({ C.trait_ref; type_name }, v)
+        | _ -> None)
+      rbindings
   in
-  { ctx with C.norm_trait_stypes }
+  C.TraitTypeRefMap.of_list rbindings
 
 let ctx_add_norm_trait_types_from_preds (ctx : C.eval_ctx)
-    (trait_type_constraints : T.rtrait_type_constraint list) : C.eval_ctx =
-  let norm_trait_etypes, norm_trait_rtypes =
+    (trait_type_constraints : T.trait_type_constraint list) : C.eval_ctx =
+  let norm_trait_types =
     compute_norm_trait_types_from_preds trait_type_constraints
   in
-  { ctx with C.norm_trait_etypes; norm_trait_rtypes }
+  { ctx with C.norm_trait_types }
 
 (** A trait instance id refers to a local clause if it only uses the variants:
     [Self], [Clause], [ParentClause], [ItemClause] *)
-let rec trait_instance_id_is_local_clause (id : 'r T.trait_instance_id) : bool =
+let rec trait_instance_id_is_local_clause (id : T.trait_instance_id) : bool =
   match id with
   | T.Self | Clause _ -> true
   | TraitImpl _ | BuiltinOrAuto _ | TraitRef _ | UnknownTrait _ | FnPointer _ ->
@@ -165,75 +104,52 @@ let rec trait_instance_id_is_local_clause (id : 'r T.trait_instance_id) : bool =
 (** About the conversion functions: for now we need them (TODO: merge ety, rty, etc.),
     but they should be applied to types without regions.
  *)
-type 'r norm_ctx = {
-  ctx : C.eval_ctx;
-  get_ty_repr : 'r C.trait_type_ref -> 'r T.ty option;
-  convert_ety : T.ety -> 'r T.ty; (* TODO: remove? *)
-  convert_etrait_ref : T.etrait_ref -> 'r T.trait_ref; (* TODO: remove? *)
-  ty_to_string : 'r T.ty -> string;
-  generic_params_to_string : T.generic_params -> string;
-  generic_args_to_string : 'r T.generic_args -> string;
-  trait_ref_to_string : 'r T.trait_ref -> string;
-  trait_instance_id_to_string : 'r T.trait_instance_id -> string;
-  pp_r : Format.formatter -> 'r -> unit;
-}
-
-(** Small utility to lookup trait impls, together with a substitution.
-
-    Remark: one reason we have those small helpers is that all functions are
-    parameterized by a type variable 'r. The OCaml type inferencer and type
-    checker are however not very good at generating precise error messages in
-    this context: if in the body of the function we have an overly constrained
-    usage of 'r (for instance, the type inferencer deduces 'r should be
-    [T.erased_region]), it will not be able to pinpoint the location which
-    introduced the constraints and we just get a type-checking error for the
-    whole function. The fact that we have mutually recursive functions makes it
-    worse (the type-checker sometimes indicates a well-typed function as not
-    well-typed, because it calls a not well-typed function...).
-    By isolating the places where such errors typically happen in small helpers
-    (i.e., the places where we convert between different types of regions by
-    performing substitutions), we make maintenance a lot easier.
- *)
-let ctx_lookup_trait_impl :
-      'r.
-      'r norm_ctx ->
-      T.TraitImplId.id ->
-      'r T.generic_args ->
-      A.trait_impl * (T.region_var_id T.region, 'r) Subst.subst =
- fun ctx impl_id generics ->
+type norm_ctx = { ctx : C.eval_ctx }
+
+let ctx_get_ty_repr (ctx : norm_ctx) (x : C.trait_type_ref) : T.ty option =
+  C.TraitTypeRefMap.find_opt x ctx.ctx.norm_trait_types
+
+let ty_to_string (ctx : norm_ctx) (ty : T.ty) : string =
+  PA.ty_to_string ctx.ctx ty
+
+let trait_ref_to_string (ctx : norm_ctx) (x : T.trait_ref) : string =
+  PA.trait_ref_to_string ctx.ctx x
+
+let trait_instance_id_to_string (ctx : norm_ctx) (x : T.trait_instance_id) :
+    string =
+  PA.trait_instance_id_to_string ctx.ctx x
+
+let generic_args_to_string (ctx : norm_ctx) (x : T.generic_args) : string =
+  PA.generic_args_to_string ctx.ctx x
+
+let generic_params_to_string (ctx : norm_ctx) (x : T.generic_params) : string =
+  "<" ^ String.concat ", " (fst (PA.generic_params_to_strings ctx.ctx x)) ^ ">"
+
+(** Small utility to lookup trait impls, together with a substitution. *)
+let ctx_lookup_trait_impl (ctx : norm_ctx) (impl_id : T.TraitImplId.id)
+    (generics : T.generic_args) : A.trait_impl * Subst.subst =
   (* Lookup the implementation *)
   let trait_impl = C.ctx_lookup_trait_impl ctx.ctx impl_id in
   (* The substitution *)
   let tr_self = T.UnknownTrait __FUNCTION__ in
   let subst =
-    Subst.make_subst_from_generics_no_regions trait_impl.generics generics
-      tr_self
+    Subst.make_subst_from_generics trait_impl.generics generics tr_self
   in
   (* Return *)
   (trait_impl, subst)
 
-let ctx_lookup_trait_impl_ty :
-      'r.
-      'r norm_ctx -> T.TraitImplId.id -> 'r T.generic_args -> string -> 'r T.ty
-    =
- fun ctx impl_id generics type_name ->
+let ctx_lookup_trait_impl_ty (ctx : norm_ctx) (impl_id : T.TraitImplId.id)
+    (generics : T.generic_args) (type_name : string) : T.ty =
   (* Lookup the implementation *)
   let trait_impl, subst = ctx_lookup_trait_impl ctx impl_id generics in
   (* Lookup the type *)
   let ty = snd (List.assoc type_name trait_impl.types) in
-  (* Annoying: convert etype to an stype - TODO: how to avoid that? *)
-  let ty : T.sty = TypesUtils.ety_no_regions_to_gr_ty ty in
   (* Substitute *)
   Subst.ty_substitute subst ty
 
-let ctx_lookup_trait_impl_parent_clause :
-      'r.
-      'r norm_ctx ->
-      T.TraitImplId.id ->
-      'r T.generic_args ->
-      T.TraitClauseId.id ->
-      'r T.trait_ref =
- fun ctx impl_id generics clause_id ->
+let ctx_lookup_trait_impl_parent_clause (ctx : norm_ctx)
+    (impl_id : T.TraitImplId.id) (generics : T.generic_args)
+    (clause_id : T.TraitClauseId.id) : T.trait_ref =
   (* Lookup the implementation *)
   let trait_impl, subst = ctx_lookup_trait_impl ctx impl_id generics in
   (* Lookup the clause *)
@@ -243,15 +159,9 @@ let ctx_lookup_trait_impl_parent_clause :
   (* Substitute *)
   Subst.trait_ref_substitute subst clause
 
-let ctx_lookup_trait_impl_item_clause :
-      'r.
-      'r norm_ctx ->
-      T.TraitImplId.id ->
-      'r T.generic_args ->
-      string ->
-      T.TraitClauseId.id ->
-      'r T.trait_ref =
- fun ctx impl_id generics item_name clause_id ->
+let ctx_lookup_trait_impl_item_clause (ctx : norm_ctx)
+    (impl_id : T.TraitImplId.id) (generics : T.generic_args)
+    (item_name : string) (clause_id : T.TraitClauseId.id) : T.trait_ref =
   (* Lookup the implementation *)
   let trait_impl, subst = ctx_lookup_trait_impl ctx impl_id generics in
   (* Lookup the item then its clause *)
@@ -259,10 +169,6 @@ let ctx_lookup_trait_impl_item_clause :
   let clause = T.TraitClauseId.nth (fst item) clause_id in
   (* Sanity check: the clause necessarily refers to an impl *)
   let _ = TypesUtils.trait_instance_id_as_trait_impl clause.trait_id in
-  (* Annoying: convert etype to an stype - TODO: how to avoid that? *)
-  let clause : T.strait_ref =
-    TypesUtils.etrait_ref_no_regions_to_gr_trait_ref clause
-  in
   (* Substitute *)
   Subst.trait_ref_substitute subst clause
 
@@ -272,12 +178,11 @@ let ctx_lookup_trait_impl_item_clause :
 
     See the comments for {!ctx_normalize_trait_instance_id}.
   *)
-let rec ctx_normalize_ty : 'r. 'r norm_ctx -> 'r T.ty -> 'r T.ty =
- fun ctx ty ->
-  log#ldebug (lazy ("ctx_normalize_ty: " ^ ctx.ty_to_string ty));
+let rec ctx_normalize_ty (ctx : norm_ctx) (ty : T.ty) : T.ty =
+  log#ldebug (lazy ("ctx_normalize_ty: " ^ ty_to_string ctx ty));
   match ty with
-  | T.Adt (id, generics) -> Adt (id, ctx_normalize_generic_args ctx generics)
-  | TypeVar _ | Literal _ | Never -> ty
+  | T.TAdt (id, generics) -> TAdt (id, ctx_normalize_generic_args ctx generics)
+  | TypeVar _ | TLiteral _ | Never -> ty
   | Ref (r, ty, rkind) ->
       let ty = ctx_normalize_ty ctx ty in
       T.Ref (r, ty, rkind)
@@ -291,19 +196,18 @@ let rec ctx_normalize_ty : 'r. 'r norm_ctx -> 'r T.ty -> 'r T.ty =
   | TraitType (trait_ref, generics, type_name) -> (
       log#ldebug
         (lazy
-          ("ctx_normalize_ty:\n- trait type: " ^ ctx.ty_to_string ty
+          ("ctx_normalize_ty:\n- trait type: " ^ ty_to_string ctx ty
          ^ "\n- trait_ref: "
-          ^ ctx.trait_ref_to_string trait_ref
-          ^ "\n- raw trait ref:\n"
-          ^ T.show_trait_ref ctx.pp_r trait_ref
+          ^ trait_ref_to_string ctx trait_ref
+          ^ "\n- raw trait ref:\n" ^ T.show_trait_ref trait_ref
           ^ "\n- generics:\n"
-          ^ ctx.generic_args_to_string generics));
+          ^ generic_args_to_string ctx generics));
       (* Normalize and attempt to project the type from the trait ref *)
       let trait_ref = ctx_normalize_trait_ref ctx trait_ref in
       let generics = ctx_normalize_generic_args ctx generics in
       (*  For now, we don't support higher order types *)
       assert (generics = TypesUtils.mk_empty_generic_args);
-      let ty : 'r T.ty =
+      let ty : T.ty =
         match trait_ref.trait_id with
         | T.TraitRef
             { T.trait_id = T.TraitImpl impl_id; generics = ref_generics; _ } ->
@@ -311,7 +215,7 @@ let rec ctx_normalize_ty : 'r. 'r norm_ctx -> 'r T.ty -> 'r T.ty =
             log#ldebug
               (lazy
                 ("ctx_normalize_ty: trait type: trait ref: "
-               ^ ctx.ty_to_string ty));
+               ^ ty_to_string ctx ty));
             (* Lookup the type *)
             let ty =
               ctx_lookup_trait_impl_ty ctx impl_id trait_ref.generics type_name
@@ -322,10 +226,9 @@ let rec ctx_normalize_ty : 'r. 'r norm_ctx -> 'r T.ty -> 'r T.ty =
             log#ldebug
               (lazy
                 ("ctx_normalize_ty (trait impl):\n- trait type: "
-               ^ ctx.ty_to_string ty ^ "\n- trait_ref: "
-                ^ ctx.trait_ref_to_string trait_ref
-                ^ "\n- raw trait ref:\n"
-                ^ T.show_trait_ref ctx.pp_r trait_ref));
+               ^ ty_to_string ctx ty ^ "\n- trait_ref: "
+                ^ trait_ref_to_string ctx trait_ref
+                ^ "\n- raw trait ref:\n" ^ T.show_trait_ref trait_ref));
             (* This happens. This doesn't come from the substitutions
                performed by Aeneas (the [TraitImpl] would be wrapped in a
                [TraitRef] but from non-normalized traits translated from
@@ -342,17 +245,16 @@ let rec ctx_normalize_ty : 'r. 'r norm_ctx -> 'r T.ty -> 'r T.ty =
             log#ldebug
               (lazy
                 ("ctx_normalize_ty: trait type: not a trait ref: "
-               ^ ctx.ty_to_string ty ^ "\n- trait_ref: "
-                ^ ctx.trait_ref_to_string trait_ref
-                ^ "\n- raw trait ref:\n"
-                ^ T.show_trait_ref ctx.pp_r trait_ref));
+               ^ ty_to_string ctx ty ^ "\n- trait_ref: "
+                ^ trait_ref_to_string ctx trait_ref
+                ^ "\n- raw trait ref:\n" ^ T.show_trait_ref trait_ref));
             (* We can't project *)
             assert (trait_instance_id_is_local_clause trait_ref.trait_id);
             T.TraitType (trait_ref, generics, type_name)
       in
-      let tr : 'r C.trait_type_ref = { C.trait_ref; type_name } in
+      let tr : C.trait_type_ref = { C.trait_ref; type_name } in
       (* Lookup the representative, if there is *)
-      match ctx.get_ty_repr tr with None -> ty | Some ty -> ty)
+      match ctx_get_ty_repr ctx tr with None -> ty | Some ty -> ty)
 
 (** This returns the normalized trait instance id together with an optional
     reference to a trait **implementation** (the `trait_ref` we return has
@@ -398,12 +300,8 @@ let rec ctx_normalize_ty : 'r. 'r norm_ctx -> 'r T.ty -> 'r T.ty =
         In this case we can lookup the trait implementation and recursively project
         over it.
  *)
-and ctx_normalize_trait_instance_id :
-      'r.
-      'r norm_ctx ->
-      'r T.trait_instance_id ->
-      'r T.trait_instance_id * 'r T.trait_ref option =
- fun ctx id ->
+and ctx_normalize_trait_instance_id (ctx : norm_ctx) (id : T.trait_instance_id)
+    : T.trait_instance_id * T.trait_ref option =
   match id with
   | Self -> (id, None)
   | TraitImpl _ ->
@@ -481,7 +379,7 @@ and ctx_normalize_trait_instance_id :
       (* Normalize the generics *)
       let generics = ctx_normalize_generic_args ctx generics in
       let trait_decl_ref = ctx_normalize_trait_decl_ref ctx trait_decl_ref in
-      let trait_ref : 'r T.trait_ref =
+      let trait_ref : T.trait_ref =
         { T.trait_id = T.TraitImpl trait_id; generics; trait_decl_ref }
       in
       (TraitRef trait_ref, Some trait_ref)
@@ -500,21 +398,20 @@ and ctx_normalize_trait_instance_id :
       (* This is actually an error case *)
       (id, None)
 
-and ctx_normalize_generic_args (ctx : 'r norm_ctx)
-    (generics : 'r T.generic_args) : 'r T.generic_args =
+and ctx_normalize_generic_args (ctx : norm_ctx) (generics : T.generic_args) :
+    T.generic_args =
   let { T.regions; types; const_generics; trait_refs } = generics in
   let types = List.map (ctx_normalize_ty ctx) types in
   let trait_refs = List.map (ctx_normalize_trait_ref ctx) trait_refs in
   { T.regions; types; const_generics; trait_refs }
 
-and ctx_normalize_trait_ref (ctx : 'r norm_ctx) (trait_ref : 'r T.trait_ref) :
-    'r T.trait_ref =
+and ctx_normalize_trait_ref (ctx : norm_ctx) (trait_ref : T.trait_ref) :
+    T.trait_ref =
   log#ldebug
     (lazy
       ("ctx_normalize_trait_ref: "
-      ^ ctx.trait_ref_to_string trait_ref
-      ^ "\n- raw trait ref:\n"
-      ^ T.show_trait_ref ctx.pp_r trait_ref));
+      ^ trait_ref_to_string ctx trait_ref
+      ^ "\n- raw trait ref:\n" ^ T.show_trait_ref trait_ref));
   let { T.trait_id; generics; trait_decl_ref } = trait_ref in
   (* Check if the id is an impl, otherwise normalize it *)
   let trait_id, norm_trait_ref = ctx_normalize_trait_instance_id ctx trait_id in
@@ -523,7 +420,7 @@ and ctx_normalize_trait_ref (ctx : 'r norm_ctx) (trait_ref : 'r T.trait_ref) :
       log#ldebug
         (lazy
           ("ctx_normalize_trait_ref: no norm: "
-          ^ ctx.trait_instance_id_to_string trait_id));
+          ^ trait_instance_id_to_string ctx trait_id));
       let generics = ctx_normalize_generic_args ctx generics in
       let trait_decl_ref = ctx_normalize_trait_decl_ref ctx trait_decl_ref in
       { T.trait_id; generics; trait_decl_ref }
@@ -531,151 +428,108 @@ and ctx_normalize_trait_ref (ctx : 'r norm_ctx) (trait_ref : 'r T.trait_ref) :
       log#ldebug
         (lazy
           ("ctx_normalize_trait_ref: normalized to: "
-          ^ ctx.trait_ref_to_string trait_ref));
+          ^ trait_ref_to_string ctx trait_ref));
       assert (generics = TypesUtils.mk_empty_generic_args);
       trait_ref
 
 (* Not sure this one is really necessary *)
-and ctx_normalize_trait_decl_ref (ctx : 'r norm_ctx)
-    (trait_decl_ref : 'r T.trait_decl_ref) : 'r T.trait_decl_ref =
+and ctx_normalize_trait_decl_ref (ctx : norm_ctx)
+    (trait_decl_ref : T.trait_decl_ref) : T.trait_decl_ref =
   let { T.trait_decl_id; decl_generics } = trait_decl_ref in
   let decl_generics = ctx_normalize_generic_args ctx decl_generics in
   { T.trait_decl_id; decl_generics }
 
-let ctx_normalize_trait_type_constraint (ctx : 'r norm_ctx)
-    (ttc : 'r T.trait_type_constraint) : 'r T.trait_type_constraint =
+let ctx_normalize_trait_type_constraint (ctx : norm_ctx)
+    (ttc : T.trait_type_constraint) : T.trait_type_constraint =
   let { T.trait_ref; generics; type_name; ty } = ttc in
   let trait_ref = ctx_normalize_trait_ref ctx trait_ref in
   let generics = ctx_normalize_generic_args ctx generics in
   let ty = ctx_normalize_ty ctx ty in
   { T.trait_ref; generics; type_name; ty }
 
-let generic_params_to_string ctx x =
-  "<" ^ String.concat ", " (fst (PA.generic_params_to_strings ctx x)) ^ ">"
-
-let mk_snorm_ctx (ctx : C.eval_ctx) : T.RegionVarId.id T.region norm_ctx =
-  let get_ty_repr x = C.STraitTypeRefMap.find_opt x ctx.norm_trait_stypes in
-  {
-    ctx;
-    get_ty_repr;
-    convert_ety = TypesUtils.ety_no_regions_to_sty;
-    convert_etrait_ref = TypesUtils.etrait_ref_no_regions_to_gr_trait_ref;
-    ty_to_string = PA.sty_to_string ctx;
-    generic_params_to_string = generic_params_to_string ctx;
-    generic_args_to_string = PA.sgeneric_args_to_string ctx;
-    trait_ref_to_string = PA.strait_ref_to_string ctx;
-    trait_instance_id_to_string = PA.strait_instance_id_to_string ctx;
-    pp_r = T.pp_region T.pp_region_var_id;
-  }
-
-let mk_rnorm_ctx (ctx : C.eval_ctx) : T.RegionId.id T.region norm_ctx =
-  let get_ty_repr x = C.RTraitTypeRefMap.find_opt x ctx.norm_trait_rtypes in
-  {
-    ctx;
-    get_ty_repr;
-    convert_ety = TypesUtils.ety_no_regions_to_rty;
-    convert_etrait_ref = TypesUtils.etrait_ref_no_regions_to_gr_trait_ref;
-    ty_to_string = PA.rty_to_string ctx;
-    generic_params_to_string = generic_params_to_string ctx;
-    generic_args_to_string = PA.rgeneric_args_to_string ctx;
-    trait_ref_to_string = PA.rtrait_ref_to_string ctx;
-    trait_instance_id_to_string = PA.rtrait_instance_id_to_string ctx;
-    pp_r = T.pp_region T.pp_region_id;
-  }
-
-let mk_enorm_ctx (ctx : C.eval_ctx) : T.erased_region norm_ctx =
-  let get_ty_repr x = C.ETraitTypeRefMap.find_opt x ctx.norm_trait_etypes in
-  {
-    ctx;
-    get_ty_repr;
-    convert_ety = (fun x -> x);
-    convert_etrait_ref = (fun x -> x);
-    ty_to_string = PA.ety_to_string ctx;
-    generic_params_to_string = generic_params_to_string ctx;
-    generic_args_to_string = PA.egeneric_args_to_string ctx;
-    trait_ref_to_string = PA.etrait_ref_to_string ctx;
-    trait_instance_id_to_string = PA.etrait_instance_id_to_string ctx;
-    pp_r = T.pp_erased_region;
-  }
-
-let ctx_normalize_sty (ctx : C.eval_ctx) (ty : T.sty) : T.sty =
-  ctx_normalize_ty (mk_snorm_ctx ctx) ty
-
-let ctx_normalize_rty (ctx : C.eval_ctx) (ty : T.rty) : T.rty =
-  ctx_normalize_ty (mk_rnorm_ctx ctx) ty
-
-let ctx_normalize_ety (ctx : C.eval_ctx) (ty : T.ety) : T.ety =
-  ctx_normalize_ty (mk_enorm_ctx ctx) ty
-
-let ctx_normalize_rtrait_type_constraint (ctx : C.eval_ctx)
-    (ttc : T.rtrait_type_constraint) : T.rtrait_type_constraint =
-  ctx_normalize_trait_type_constraint (mk_rnorm_ctx ctx) ttc
-
-(** Same as [type_decl_get_instantiated_variants_fields_rtypes] but normalizes the types *)
+let mk_norm_ctx (ctx : C.eval_ctx) : norm_ctx = { ctx }
+
+let ctx_normalize_ty (ctx : C.eval_ctx) (ty : T.ty) : T.ty =
+  ctx_normalize_ty (mk_norm_ctx ctx) ty
+
+(** Normalize a type and erase the regions at the same time *)
+let ctx_normalize_erase_ty (ctx : C.eval_ctx) (ty : T.ty) : T.ty =
+  let ty = ctx_normalize_ty ctx ty in
+  Subst.erase_regions ty
+
+let ctx_normalize_trait_type_constraint (ctx : C.eval_ctx)
+    (ttc : T.trait_type_constraint) : T.trait_type_constraint =
+  ctx_normalize_trait_type_constraint (mk_norm_ctx ctx) ttc
+
+(** Same as [type_decl_get_instantiated_variants_fields_types] but normalizes the types *)
 let type_decl_get_inst_norm_variants_fields_rtypes (ctx : C.eval_ctx)
-    (def : T.type_decl) (generics : T.rgeneric_args) :
-    (T.VariantId.id option * T.rty list) list =
+    (def : T.type_decl) (generics : T.generic_args) :
+    (T.VariantId.id option * T.ty list) list =
   let res =
-    Subst.type_decl_get_instantiated_variants_fields_rtypes def generics
+    Subst.type_decl_get_instantiated_variants_fields_types def generics
   in
   List.map
     (fun (variant_id, types) ->
-      (variant_id, List.map (ctx_normalize_rty ctx) types))
+      (variant_id, List.map (ctx_normalize_ty ctx) types))
     res
 
-(** Same as [type_decl_get_instantiated_field_rtypes] but normalizes the types *)
+(** Same as [type_decl_get_instantiated_field_types] but normalizes the types *)
 let type_decl_get_inst_norm_field_rtypes (ctx : C.eval_ctx) (def : T.type_decl)
-    (opt_variant_id : T.VariantId.id option) (generics : T.rgeneric_args) :
-    T.rty list =
+    (opt_variant_id : T.VariantId.id option) (generics : T.generic_args) :
+    T.ty list =
   let types =
-    Subst.type_decl_get_instantiated_field_rtypes def opt_variant_id generics
+    Subst.type_decl_get_instantiated_field_types def opt_variant_id generics
   in
-  List.map (ctx_normalize_rty ctx) types
+  List.map (ctx_normalize_ty ctx) types
 
 (** Same as [ctx_adt_value_get_instantiated_field_rtypes] but normalizes the types *)
 let ctx_adt_value_get_inst_norm_field_rtypes (ctx : C.eval_ctx)
-    (adt : V.adt_value) (id : T.type_id) (generics : T.rgeneric_args) :
-    T.rty list =
+    (adt : V.adt_value) (id : T.type_id) (generics : T.generic_args) : T.ty list
+    =
   let types =
-    Subst.ctx_adt_value_get_instantiated_field_rtypes ctx adt id generics
+    Subst.ctx_adt_value_get_instantiated_field_types ctx adt id generics
   in
-  List.map (ctx_normalize_rty ctx) types
+  List.map (ctx_normalize_ty ctx) types
 
-(** Same as [ctx_adt_value_get_instantiated_field_etypes] but normalizes the types *)
+(** Same as [ctx_adt_value_get_instantiated_field_types] but normalizes the types
+    and erases the regions. *)
 let type_decl_get_inst_norm_field_etypes (ctx : C.eval_ctx) (def : T.type_decl)
-    (opt_variant_id : T.VariantId.id option) (generics : T.egeneric_args) :
-    T.ety list =
+    (opt_variant_id : T.VariantId.id option) (generics : T.generic_args) :
+    T.ty list =
   let types =
-    Subst.type_decl_get_instantiated_field_etypes def opt_variant_id generics
+    Subst.type_decl_get_instantiated_field_types def opt_variant_id generics
   in
-  List.map (ctx_normalize_ety ctx) types
+  let types = List.map (ctx_normalize_ty ctx) types in
+  List.map Subst.erase_regions types
 
-(** Same as [ctx_adt_get_instantiated_field_etypes] but normalizes the types *)
+(** Same as [ctx_adt_get_instantiated_field_types] but normalizes the types and
+    erases the regions. *)
 let ctx_adt_get_inst_norm_field_etypes (ctx : C.eval_ctx)
     (def_id : T.TypeDeclId.id) (opt_variant_id : T.VariantId.id option)
-    (generics : T.egeneric_args) : T.ety list =
+    (generics : T.generic_args) : T.ty list =
   let types =
-    Subst.ctx_adt_get_instantiated_field_etypes ctx def_id opt_variant_id
+    Subst.ctx_adt_get_instantiated_field_types ctx def_id opt_variant_id
       generics
   in
-  List.map (ctx_normalize_ety ctx) types
+  let types = List.map (ctx_normalize_ty ctx) types in
+  List.map Subst.erase_regions types
 
 (** Same as [substitute_signature] but normalizes the types *)
 let ctx_subst_norm_signature (ctx : C.eval_ctx)
     (asubst : T.RegionGroupId.id -> V.AbstractionId.id)
-    (r_subst : T.RegionVarId.id -> T.RegionId.id)
-    (ty_subst : T.TypeVarId.id -> T.rty)
+    (r_subst : T.RegionId.id -> T.RegionId.id)
+    (ty_subst : T.TypeVarId.id -> T.ty)
     (cg_subst : T.ConstGenericVarId.id -> T.const_generic)
-    (tr_subst : T.TraitClauseId.id -> T.rtrait_instance_id)
-    (tr_self : T.rtrait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig =
+    (tr_subst : T.TraitClauseId.id -> T.trait_instance_id)
+    (tr_self : T.trait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig =
   let sg =
     Subst.substitute_signature asubst r_subst ty_subst cg_subst tr_subst tr_self
       sg
   in
   let { A.regions_hierarchy; inputs; output; trait_type_constraints } = sg in
-  let inputs = List.map (ctx_normalize_rty ctx) inputs in
-  let output = ctx_normalize_rty ctx output in
+  let inputs = List.map (ctx_normalize_ty ctx) inputs in
+  let output = ctx_normalize_ty ctx output in
   let trait_type_constraints =
-    List.map (ctx_normalize_rtrait_type_constraint ctx) trait_type_constraints
+    List.map (ctx_normalize_trait_type_constraint ctx) trait_type_constraints
   in
   { regions_hierarchy; inputs; output; trait_type_constraints }
diff --git a/compiler/Assumed.ml b/compiler/Assumed.ml
index 79f6b0d4..d8f19173 100644
--- a/compiler/Assumed.ml
+++ b/compiler/Assumed.ml
@@ -37,11 +37,11 @@ module A = LlbcAst
 module Sig = struct
   (** A few utilities *)
 
-  let rvar_id_0 = T.RegionVarId.of_int 0
-  let rvar_0 : T.RegionVarId.id T.region = T.Var rvar_id_0
+  let rvar_id_0 = T.RegionId.of_int 0
+  let rvar_0 : T.region = T.RVar rvar_id_0
   let rg_id_0 = T.RegionGroupId.of_int 0
   let tvar_id_0 = T.TypeVarId.of_int 0
-  let tvar_0 : T.sty = T.TypeVar tvar_id_0
+  let tvar_0 : T.ty = T.TypeVar tvar_id_0
   let cgvar_id_0 = T.ConstGenericVarId.of_int 0
   let cgvar_0 : T.const_generic = T.ConstGenericVar cgvar_id_0
 
@@ -49,36 +49,35 @@ module Sig = struct
   let region_param_0 : T.region_var = { T.index = rvar_id_0; name = Some "'a" }
 
   (** Region group: [{ parent={}; regions:{'a of id 0} }] *)
-  let region_group_0 : T.region_var_group =
+  let region_group_0 : T.region_group =
     { T.id = rg_id_0; regions = [ rvar_id_0 ]; parents = [] }
 
   (** Type parameter [T] of id 0 *)
   let type_param_0 : T.type_var = { T.index = tvar_id_0; name = "T" }
 
-  let usize_ty : T.sty = T.Literal (Integer Usize)
+  let usize_ty : T.ty = T.TLiteral (TInteger Usize)
 
   (** Const generic parameter [const N : usize] of id 0 *)
   let cg_param_0 : T.const_generic_var =
-    { T.index = cgvar_id_0; name = "N"; ty = Integer Usize }
+    { T.index = cgvar_id_0; name = "N"; ty = TInteger Usize }
 
   let empty_const_generic_params : T.const_generic_var list = []
 
-  let mk_generic_args regions types const_generics : T.sgeneric_args =
+  let mk_generic_args regions types const_generics : T.generic_args =
     { regions; types; const_generics; trait_refs = [] }
 
   let mk_generic_params regions types const_generics : T.generic_params =
     { regions; types; const_generics; trait_clauses = [] }
 
-  let mk_ref_ty (r : T.RegionVarId.id T.region) (ty : T.sty) (is_mut : bool) :
-      T.sty =
+  let mk_ref_ty (r : T.region) (ty : T.ty) (is_mut : bool) : T.ty =
     let ref_kind = if is_mut then T.Mut else T.Shared in
     mk_ref_ty r ty ref_kind
 
-  let mk_array_ty (ty : T.sty) (cg : T.const_generic) : T.sty =
-    Adt (Assumed Array, mk_generic_args [] [ ty ] [ cg ])
+  let mk_array_ty (ty : T.ty) (cg : T.const_generic) : T.ty =
+    TAdt (TAssumed TArray, mk_generic_args [] [ ty ] [ cg ])
 
-  let mk_slice_ty (ty : T.sty) : T.sty =
-    Adt (Assumed Slice, mk_generic_args [] [ ty ] [])
+  let mk_slice_ty (ty : T.ty) : T.ty =
+    TAdt (TAssumed TSlice, mk_generic_args [] [ ty ] [])
 
   let mk_sig generics regions_hierarchy inputs output : A.fun_sig =
     let preds : T.predicates =
@@ -125,8 +124,8 @@ module Sig = struct
       borrow.
    *)
   let mk_array_slice_borrow_sig (cgs : T.const_generic_var list)
-      (input_ty : T.TypeVarId.id -> T.sty) (index_ty : T.sty option)
-      (output_ty : T.TypeVarId.id -> T.sty) (is_mut : bool) : A.fun_sig =
+      (input_ty : T.TypeVarId.id -> T.ty) (index_ty : T.ty option)
+      (output_ty : T.TypeVarId.id -> T.ty) (is_mut : bool) : A.fun_sig =
     let generics =
       mk_generic_params [ region_param_0 ] [ type_param_0 ] cgs (* <'a, T> *)
     in
diff --git a/compiler/Contexts.ml b/compiler/Contexts.ml
index dac64a9a..9a20a6cc 100644
--- a/compiler/Contexts.ml
+++ b/compiler/Contexts.ml
@@ -112,16 +112,16 @@ let reset_global_counters () =
   fun_call_id_counter := FunCallId.generator_zero;
   dummy_var_id_counter := DummyVarId.generator_zero
 
-(** Ancestor for {!var_binder} iter visitor *)
-class ['self] iter_var_binder_base =
+(** Ancestor for {!env} iter visitor *)
+class ['self] iter_env_base =
   object (_self : 'self)
     inherit [_] iter_abs
     method visit_var_id : 'env -> var_id -> unit = fun _ _ -> ()
     method visit_dummy_var_id : 'env -> dummy_var_id -> unit = fun _ _ -> ()
   end
 
-(** Ancestor for {!var_binder} map visitor *)
-class ['self] map_var_binder_base =
+(** Ancestor for {!env} map visitor *)
+class ['self] map_env_base =
   object (_self : 'self)
     inherit [_] map_abs
     method visit_var_id : 'env -> var_id -> var_id = fun _ x -> x
@@ -135,97 +135,29 @@ type var_binder = {
   index : var_id;  (** Unique variable identifier *)
   name : string option;  (** Possible name *)
 }
-[@@deriving
-  show,
-    visitors
-      {
-        name = "iter_var_binder";
-        variety = "iter";
-        ancestors = [ "iter_var_binder_base" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      },
-    visitors
-      {
-        name = "map_var_binder";
-        variety = "map";
-        ancestors = [ "map_var_binder_base" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      }]
 
 (** A binder, for a "real" variable or a dummy variable *)
-type binder = VarBinder of var_binder | DummyBinder of dummy_var_id
-[@@deriving
-  show,
-    visitors
-      {
-        name = "iter_binder";
-        variety = "iter";
-        ancestors = [ "iter_var_binder" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      },
-    visitors
-      {
-        name = "map_binder";
-        variety = "map";
-        ancestors = [ "map_var_binder" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      }]
-
-(** Ancestor for {!env_elem} iter visitor *)
-class ['self] iter_env_elem_base =
-  object (_self : 'self)
-    inherit [_] iter_binder
-  end
-
-(** Ancestor for {!env_elem} map visitor *)
-class ['self] map_env_elem_base =
-  object (_self : 'self)
-    inherit [_] map_binder
-  end
+and binder = BVar of var_binder | BDummy of dummy_var_id
 
 (** Environment value: mapping from variable to value, abstraction (only
     used in symbolic mode) or stack frame delimiter.
-    
-    TODO: rename Var (-> Binding?)
  *)
-type env_elem =
-  | Var of binder * typed_value
+and env_elem =
+  | EBinding of binder * typed_value
       (** Variable binding - the binder is None if the variable is a dummy variable
           (we use dummy variables to store temporaries while doing bookkeeping such
            as ending borrows for instance). *)
-  | Abs of abs
-  | Frame
-[@@deriving
-  show,
-    visitors
-      {
-        name = "iter_env_elem";
-        variety = "iter";
-        ancestors = [ "iter_env_elem_base" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      },
-    visitors
-      {
-        name = "map_env_elem";
-        variety = "map";
-        ancestors = [ "map_env_elem_base" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      }]
+  | EAbs of abs
+  | EFrame
 
-type env = env_elem list
+and env = env_elem list
 [@@deriving
   show,
     visitors
       {
         name = "iter_env";
         variety = "iter";
-        ancestors = [ "iter_env_elem" ];
+        ancestors = [ "iter_env_base" ];
         nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
         concrete = true;
       },
@@ -233,7 +165,7 @@ type env = env_elem list
       {
         name = "map_env";
         variety = "map";
-        ancestors = [ "map_env_elem" ];
+        ancestors = [ "map_env_base" ];
         nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
         concrete = true;
       }]
@@ -280,48 +212,20 @@ type decls_ctx = {
 [@@deriving show]
 
 (** A reference to a trait associated type *)
-type 'r trait_type_ref = { trait_ref : 'r trait_ref; type_name : string }
-[@@deriving show, ord]
-
-type etrait_type_ref = erased_region trait_type_ref [@@deriving show, ord]
-
-type rtrait_type_ref = Types.RegionId.id Types.region trait_type_ref
-[@@deriving show, ord]
-
-type strait_type_ref = Types.RegionVarId.id Types.region trait_type_ref
+type trait_type_ref = { trait_ref : trait_ref; type_name : string }
 [@@deriving show, ord]
 
 (* TODO: correctly use the functors so as not to have a duplication below *)
-module ETraitTypeRefOrd = struct
-  type t = etrait_type_ref
+module TraitTypeRefOrd = struct
+  type t = trait_type_ref
 
-  let compare = compare_etrait_type_ref
-  let to_string = show_etrait_type_ref
-  let pp_t = pp_etrait_type_ref
-  let show_t = show_etrait_type_ref
+  let compare = compare_trait_type_ref
+  let to_string = show_trait_type_ref
+  let pp_t = pp_trait_type_ref
+  let show_t = show_trait_type_ref
 end
 
-module RTraitTypeRefOrd = struct
-  type t = rtrait_type_ref
-
-  let compare = compare_rtrait_type_ref
-  let to_string = show_rtrait_type_ref
-  let pp_t = pp_rtrait_type_ref
-  let show_t = show_rtrait_type_ref
-end
-
-module STraitTypeRefOrd = struct
-  type t = strait_type_ref
-
-  let compare = compare_strait_type_ref
-  let to_string = show_strait_type_ref
-  let pp_t = pp_strait_type_ref
-  let show_t = show_strait_type_ref
-end
-
-module ETraitTypeRefMap = Collections.MakeMap (ETraitTypeRefOrd)
-module RTraitTypeRefMap = Collections.MakeMap (RTraitTypeRefOrd)
-module STraitTypeRefMap = Collections.MakeMap (STraitTypeRefOrd)
+module TraitTypeRefMap = Collections.MakeMap (TraitTypeRefOrd)
 
 (** Evaluation context *)
 type eval_ctx = {
@@ -337,25 +241,10 @@ type eval_ctx = {
       (** The map from const generic vars to their values. Those values
           can be symbolic values or concrete values (in the latter case:
           if we run in interpreter mode) *)
-  norm_trait_etypes : ety ETraitTypeRefMap.t;
+  norm_trait_types : ty TraitTypeRefMap.t;
       (** The normalized trait types (a map from trait types to their representatives).
-          Note that this doesn't support account higher-order types. *)
-  norm_trait_rtypes : rty RTraitTypeRefMap.t;
-      (** We need this because we manipulate two kinds of types.
-          Note that we actually forbid regions from appearing both in the trait
-          references and in the constraints given to the associated types,
-          meaning that we don't have to worry about mismatches due to changes
-          in region ids.
-
-          TODO: how not to duplicate?
-       *)
-  norm_trait_stypes : sty STraitTypeRefMap.t;
-      (** We sometimes need to normalize types in non-instantiated signatures.
-
-          Note that we either need to use the etypes/rtypes maps, or the stypes map.
-          This means that we either compute the maps for etypes and rtypes, or compute
-          the one for stypes (we don't always compute and carry all the maps).
-       *)
+          Note that this doesn't take into account higher-order type constraints
+          (of the shape `for<'a> ...`). *)
   env : env;
   ended_regions : RegionId.Set.t;
 }
@@ -389,10 +278,10 @@ let env_lookup_var (env : env) (vid : VarId.id) : var_binder * typed_value =
     match env with
     | [] ->
         raise (Invalid_argument ("Variable not found: " ^ VarId.to_string vid))
-    | Var (VarBinder var, v) :: env' ->
+    | EBinding (BVar var, v) :: env' ->
         if var.index = vid then (var, v) else lookup env'
-    | (Var (DummyBinder _, _) | Abs _) :: env' -> lookup env'
-    | Frame :: _ -> raise (Failure "End of frame")
+    | (EBinding (BDummy _, _) | EAbs _) :: env' -> lookup env'
+    | EFrame :: _ -> raise (Failure "End of frame")
   in
   lookup env
 
@@ -440,11 +329,11 @@ let env_update_var_value (env : env) (vid : VarId.id) (nv : typed_value) : env =
   let rec update env =
     match env with
     | [] -> raise (Failure "Unexpected")
-    | Var ((VarBinder b as var), v) :: env' ->
-        if b.index = vid then Var (var, nv) :: env'
-        else Var (var, v) :: update env'
-    | ((Var (DummyBinder _, _) | Abs _) as ee) :: env' -> ee :: update env'
-    | Frame :: _ -> raise (Failure "End of frame")
+    | EBinding ((BVar b as var), v) :: env' ->
+        if b.index = vid then EBinding (var, nv) :: env'
+        else EBinding (var, v) :: update env'
+    | ((EBinding (BDummy _, _) | EAbs _) as ee) :: env' -> ee :: update env'
+    | EFrame :: _ -> raise (Failure "End of frame")
   in
   update env
 
@@ -466,9 +355,9 @@ let ctx_update_var_value (ctx : eval_ctx) (vid : VarId.id) (nv : typed_value) :
     is important).
 *)
 let ctx_push_var (ctx : eval_ctx) (var : var) (v : typed_value) : eval_ctx =
-  assert (var.var_ty = v.ty);
+  assert (TypesUtils.ty_is_ety var.var_ty && var.var_ty = v.ty);
   let bv = var_to_binder var in
-  { ctx with env = Var (VarBinder bv, v) :: ctx.env }
+  { ctx with env = EBinding (BVar bv, v) :: ctx.env }
 
 (** Push a list of variables.
 
@@ -488,11 +377,12 @@ let ctx_push_vars (ctx : eval_ctx) (vars : (var * typed_value) list) : eval_ctx
              vars)));
   assert (
     List.for_all
-      (fun (var, (value : typed_value)) -> var.var_ty = value.ty)
+      (fun (var, (value : typed_value)) ->
+        TypesUtils.ty_is_ety var.var_ty && var.var_ty = value.ty)
       vars);
   let vars =
     List.map
-      (fun (var, value) -> Var (VarBinder (var_to_binder var), value))
+      (fun (var, value) -> EBinding (BVar (var_to_binder var), value))
       vars
   in
   let vars = List.rev vars in
@@ -501,7 +391,7 @@ let ctx_push_vars (ctx : eval_ctx) (vars : (var * typed_value) list) : eval_ctx
 (** Push a dummy variable in the context's environment. *)
 let ctx_push_dummy_var (ctx : eval_ctx) (vid : DummyVarId.id) (v : typed_value)
     : eval_ctx =
-  { ctx with env = Var (DummyBinder vid, v) :: ctx.env }
+  { ctx with env = EBinding (BDummy vid, v) :: ctx.env }
 
 (** Remove a dummy variable from a context's environment. *)
 let ctx_remove_dummy_var (ctx : eval_ctx) (vid : DummyVarId.id) :
@@ -509,7 +399,7 @@ let ctx_remove_dummy_var (ctx : eval_ctx) (vid : DummyVarId.id) :
   let rec remove_var (env : env) : env * typed_value =
     match env with
     | [] -> raise (Failure "Could not lookup a dummy variable")
-    | Var (DummyBinder vid', v) :: env when vid' = vid -> (env, v)
+    | EBinding (BDummy vid', v) :: env when vid' = vid -> (env, v)
     | ee :: env ->
         let env, v = remove_var env in
         (ee :: env, v)
@@ -522,27 +412,36 @@ let ctx_lookup_dummy_var (ctx : eval_ctx) (vid : DummyVarId.id) : typed_value =
   let rec lookup_var (env : env) : typed_value =
     match env with
     | [] -> raise (Failure "Could not lookup a dummy variable")
-    | Var (DummyBinder vid', v) :: _env when vid' = vid -> v
+    | EBinding (BDummy vid', v) :: _env when vid' = vid -> v
     | _ :: env -> lookup_var env
   in
   lookup_var ctx.env
 
+let erase_regions (ty : ty) : ty =
+  let v =
+    object
+      inherit [_] map_ty
+      method! visit_region _ _ = RErased
+    end
+  in
+  v#visit_ty () ty
+
 (** Push an uninitialized variable (which thus maps to {!constructor:Values.value.Bottom}) *)
 let ctx_push_uninitialized_var (ctx : eval_ctx) (var : var) : eval_ctx =
-  ctx_push_var ctx var (mk_bottom var.var_ty)
+  ctx_push_var ctx var (mk_bottom (erase_regions var.var_ty))
 
 (** Push a list of uninitialized variables (which thus map to {!constructor:Values.value.Bottom}) *)
 let ctx_push_uninitialized_vars (ctx : eval_ctx) (vars : var list) : eval_ctx =
-  let vars = List.map (fun v -> (v, mk_bottom v.var_ty)) vars in
+  let vars = List.map (fun v -> (v, mk_bottom (erase_regions v.var_ty))) vars in
   ctx_push_vars ctx vars
 
 let env_find_abs (env : env) (pred : V.abs -> bool) : V.abs option =
   let rec lookup env =
     match env with
     | [] -> None
-    | Var (_, _) :: env' -> lookup env'
-    | Abs abs :: env' -> if pred abs then Some abs else lookup env'
-    | Frame :: env' -> lookup env'
+    | EBinding (_, _) :: env' -> lookup env'
+    | EAbs abs :: env' -> if pred abs then Some abs else lookup env'
+    | EFrame :: env' -> lookup env'
   in
   lookup env
 
@@ -558,17 +457,17 @@ let env_remove_abs (env : env) (abs_id : V.AbstractionId.id) :
   let rec remove (env : env) : env * V.abs option =
     match env with
     | [] -> raise (Failure "Unreachable")
-    | Frame :: _ -> (env, None)
-    | Var (bv, v) :: env ->
+    | EFrame :: _ -> (env, None)
+    | EBinding (bv, v) :: env ->
         let env, abs_opt = remove env in
-        (Var (bv, v) :: env, abs_opt)
-    | Abs abs :: env ->
+        (EBinding (bv, v) :: env, abs_opt)
+    | EAbs abs :: env ->
         if abs.abs_id = abs_id then (env, Some abs)
         else
           let env, abs_opt = remove env in
           (* Update the parents set *)
           let parents = V.AbstractionId.Set.remove abs_id abs.parents in
-          (Abs { abs with V.parents } :: env, abs_opt)
+          (EAbs { abs with V.parents } :: env, abs_opt)
   in
   remove env
 
@@ -584,12 +483,12 @@ let env_subst_abs (env : env) (abs_id : V.AbstractionId.id) (nabs : V.abs) :
   let rec update (env : env) : env * V.abs option =
     match env with
     | [] -> raise (Failure "Unreachable")
-    | Frame :: _ -> (* We're done *) (env, None)
-    | Var (bv, v) :: env ->
+    | EFrame :: _ -> (* We're done *) (env, None)
+    | EBinding (bv, v) :: env ->
         let env, opt_abs = update env in
-        (Var (bv, v) :: env, opt_abs)
-    | Abs abs :: env ->
-        if abs.abs_id = abs_id then (Abs nabs :: env, Some abs)
+        (EBinding (bv, v) :: env, opt_abs)
+    | EAbs abs :: env ->
+        if abs.abs_id = abs_id then (EAbs nabs :: env, Some abs)
         else
           let env, opt_abs = update env in
           (* Update the parents set *)
@@ -600,7 +499,7 @@ let env_subst_abs (env : env) (abs_id : V.AbstractionId.id) (nabs : V.abs) :
               V.AbstractionId.Set.add nabs.abs_id parents
             else parents
           in
-          (Abs { abs with V.parents } :: env, opt_abs)
+          (EAbs { abs with V.parents } :: env, opt_abs)
   in
   update env
 
@@ -641,7 +540,7 @@ class ['self] iter_frame =
       fun acc env ->
         match env with
         | [] -> ()
-        | Frame :: _ -> (* We stop here *) ()
+        | EFrame :: _ -> (* We stop here *) ()
         | em :: env ->
             self#visit_env_elem acc em;
             self#visit_env acc env
@@ -656,7 +555,7 @@ class ['self] map_frame_concrete =
       fun acc env ->
         match env with
         | [] -> []
-        | Frame :: env -> (* We stop here *) Frame :: env
+        | EFrame :: env -> (* We stop here *) EFrame :: env
         | em :: env ->
             let em = self#visit_env_elem acc em in
             let env = self#visit_env acc env in
@@ -686,17 +585,17 @@ class ['self] map_eval_ctx =
 let env_iter_abs (f : V.abs -> unit) (env : env) : unit =
   List.iter
     (fun (ee : env_elem) ->
-      match ee with Var _ | Frame -> () | Abs abs -> f abs)
+      match ee with EBinding _ | EFrame -> () | EAbs abs -> f abs)
     env
 
 let env_map_abs (f : V.abs -> V.abs) (env : env) : env =
   List.map
     (fun (ee : env_elem) ->
-      match ee with Var _ | Frame -> ee | Abs abs -> Abs (f abs))
+      match ee with EBinding _ | EFrame -> ee | EAbs abs -> EAbs (f abs))
     env
 
 let env_filter_abs (f : V.abs -> bool) (env : env) : env =
   List.filter
     (fun (ee : env_elem) ->
-      match ee with Var _ | Frame -> true | Abs abs -> f abs)
+      match ee with EBinding _ | EFrame -> true | EAbs abs -> f abs)
     env
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index d04f5c1d..24999c7d 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -51,7 +51,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx)
             (fun ctx (f : fun_decl) ->
               let open ExtractBuiltin in
               let fun_id =
-                (Pure.FunId (Regular f.def_id), f.loop_id, f.back_id)
+                (Pure.FunId (FRegular f.def_id), f.loop_id, f.back_id)
               in
               let fun_info =
                 List.find_opt
@@ -124,7 +124,7 @@ let extract_adt_g_value
     (inside : bool) (variant_id : VariantId.id option) (field_values : 'v list)
     (ty : ty) : extraction_ctx =
   match ty with
-  | Adt (Tuple, generics) ->
+  | TAdt (Tuple, generics) ->
       (* Tuple *)
       (* For now, we only support fully applied tuple constructors *)
       assert (List.length generics.types = List.length field_values);
@@ -146,7 +146,7 @@ let extract_adt_g_value
         in
         F.pp_print_string fmt ")";
         ctx)
-  | Adt (adt_id, _) ->
+  | TAdt (adt_id, _) ->
       (* "Regular" ADT *)
 
       (* If we are generating a pattern for a let-binding and we target Lean,
@@ -178,7 +178,7 @@ let extract_adt_g_value
           | Some vid -> (
               (* In the case of Lean, we might have to add the type name as a prefix *)
               match (!backend, adt_id) with
-              | Lean, Assumed _ ->
+              | Lean, TAssumed _ ->
                   ctx_get_type adt_id ctx ^ "." ^ ctx_get_variant adt_id vid ctx
               | _ -> ctx_get_variant adt_id vid ctx)
           | None -> ctx_get_struct adt_id ctx
@@ -441,7 +441,7 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
             (* Provided method: we see it as a regular function call, and use
                the function name *)
             let fun_id =
-              FromLlbc (FunId (Regular method_id.id), lp_id, rg_id)
+              FromLlbc (FunId (FRegular method_id.id), lp_id, rg_id)
             in
             let fun_name = ctx_get_function fun_id ctx in
             F.pp_print_string fmt fun_name;
@@ -467,7 +467,7 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
       *)
       let types =
         match fun_id with
-        | FromLlbc (FunId (Regular id), _, _) ->
+        | FromLlbc (FunId (FRegular id), _, _) ->
             fun_builtin_filter_types id generics.types ctx
         | _ -> Result.Ok generics.types
       in
@@ -506,7 +506,7 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
 and extract_adt_cons (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool)
     (adt_cons : adt_cons_id) (generics : generic_args) (args : texpression list)
     : unit =
-  let e_ty = Adt (adt_cons.adt_id, generics) in
+  let e_ty = TAdt (adt_cons.adt_id, generics) in
   let is_single_pat = false in
   let _ =
     extract_adt_g_value
@@ -966,7 +966,7 @@ and extract_StructUpdate (ctx : extraction_ctx) (fmt : F.formatter)
         if need_paren then F.pp_print_string fmt ")";
         print_bracket false orb;
         F.pp_close_box fmt ()
-    | Assumed Array ->
+    | TAssumed Array ->
         (* Open the boxes *)
         F.pp_open_hvbox fmt ctx.indent_incr;
         let need_paren = inside in
@@ -974,7 +974,7 @@ and extract_StructUpdate (ctx : extraction_ctx) (fmt : F.formatter)
         (* Open the box for `Array.replicate T N [` *)
         F.pp_open_hovbox fmt ctx.indent_incr;
         (* Print the array constructor *)
-        let cs = ctx_get_struct (Assumed Array) ctx in
+        let cs = ctx_get_struct (TAssumed Array) ctx in
         F.pp_print_string fmt cs;
         (* Print the parameters *)
         let _, generics = ty_as_adt e_ty in
@@ -1286,7 +1286,7 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter)
     (def : fun_decl) : unit =
   let { keep_fwd; num_backs } =
     PureUtils.RegularFunIdMap.find
-      (Pure.FunId (Regular def.def_id), def.loop_id, def.back_id)
+      (Pure.FunId (FRegular def.def_id), def.loop_id, def.back_id)
       ctx.fun_name_info
   in
   let comment_pre = "[" ^ Print.fun_name_to_string def.basename ^ "]: " in
@@ -1772,7 +1772,7 @@ let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter)
   let decl_name = ctx_get_global global.def_id ctx in
   let body_name =
     ctx_get_function
-      (FromLlbc (Pure.FunId (Regular global.body_id), None, None))
+      (FromLlbc (Pure.FunId (FRegular global.body_id), None, None))
       ctx
   in
 
@@ -2662,7 +2662,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter)
         F.pp_print_space fmt ();
         F.pp_print_string fmt "=";
         F.pp_print_space fmt ();
-        let success = ctx_get_variant (Assumed Result) result_return_id ctx in
+        let success = ctx_get_variant (TAssumed Result) result_return_id ctx in
         F.pp_print_string fmt (success ^ " ())")
     | Coq ->
         F.pp_print_string fmt "Check";
@@ -2691,7 +2691,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter)
         F.pp_print_space fmt ();
         F.pp_print_string fmt "==";
         F.pp_print_space fmt ();
-        let success = ctx_get_variant (Assumed Result) result_return_id ctx in
+        let success = ctx_get_variant (TAssumed Result) result_return_id ctx in
         F.pp_print_string fmt ("." ^ success ^ " ())")
     | HOL4 ->
         F.pp_print_string fmt "val _ = assert_return (";
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 31b1a447..272e6396 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -3,7 +3,7 @@
 open Pure
 open TranslateCore
 module C = Contexts
-module RegionVarId = T.RegionVarId
+module RegionId = T.RegionId
 module F = Format
 open ExtractBuiltin
 
@@ -675,7 +675,7 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
     | AdtId id ->
         let def = TypeDeclId.Map.find id type_decls in
         Print.name_to_string def.name
-    | Assumed aty -> show_assumed_ty aty
+    | TAssumed aty -> show_assumed_ty aty
     | Tuple -> raise (Failure "Unreachable")
   in
   match id with
@@ -687,10 +687,10 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       | FromLlbc (fid, lp_id, rg_id) ->
           let fun_name =
             match fid with
-            | FunId (Regular fid) ->
+            | FunId (FRegular fid) ->
                 Print.fun_name_to_string
                   (A.FunDeclId.Map.find fid fun_decls).name
-            | FunId (Assumed aid) -> A.show_assumed_fun_id aid
+            | FunId (FAssumed aid) -> A.show_assumed_fun_id aid
             | TraitMethod (trait_ref, method_name, _) ->
                 (* Shouldn't happen *)
                 if !Config.fail_hard then raise (Failure "Unexpected")
@@ -716,9 +716,9 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | DecreasesProofId (fid, lid) ->
       let fun_name =
         match fid with
-        | Regular fid ->
+        | FRegular fid ->
             Print.fun_name_to_string (A.FunDeclId.Map.find fid fun_decls).name
-        | Assumed aid -> A.show_assumed_fun_id aid
+        | FAssumed aid -> A.show_assumed_fun_id aid
       in
       let loop =
         match lid with
@@ -729,9 +729,9 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | TerminationMeasureId (fid, lid) ->
       let fun_name =
         match fid with
-        | Regular fid ->
+        | FRegular fid ->
             Print.fun_name_to_string (A.FunDeclId.Map.find fid fun_decls).name
-        | Assumed aid -> A.show_assumed_fun_id aid
+        | FAssumed aid -> A.show_assumed_fun_id aid
       in
       let loop =
         match lid with
@@ -745,19 +745,19 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       let variant_name =
         match id with
         | Tuple -> raise (Failure "Unreachable")
-        | Assumed Result ->
+        | TAssumed Result ->
             if variant_id = result_return_id then "@result::Return"
             else if variant_id = result_fail_id then "@result::Fail"
             else raise (Failure "Unreachable")
-        | Assumed Error ->
+        | TAssumed Error ->
             if variant_id = error_failure_id then "@error::Failure"
             else if variant_id = error_out_of_fuel_id then "@error::OutOfFuel"
             else raise (Failure "Unreachable")
-        | Assumed Fuel ->
+        | TAssumed Fuel ->
             if variant_id = fuel_zero_id then "@fuel::0"
             else if variant_id = fuel_succ_id then "@fuel::Succ"
             else raise (Failure "Unreachable")
-        | Assumed (State | Array | Slice | Str | RawPtr _) ->
+        | TAssumed (State | Array | Slice | Str | RawPtr _) ->
             raise
               (Failure
                  ("Unreachable: variant id ("
@@ -776,7 +776,7 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       let field_name =
         match id with
         | Tuple -> raise (Failure "Unreachable")
-        | Assumed
+        | TAssumed
             (State | Result | Error | Fuel | Array | Slice | Str | RawPtr _) ->
             (* We can't directly have access to the fields of those types *)
             raise (Failure "Unreachable")
@@ -835,7 +835,7 @@ let allow_collisions (id : id) : bool =
   | FieldId _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitItemId _
   | TraitMethodId _ ->
       !Config.record_fields_short_names
-  | FunId (Pure _ | FromLlbc (FunId (Assumed _), _, _)) ->
+  | FunId (Pure _ | FromLlbc (FunId (FAssumed _), _, _)) ->
       (* We map several assumed functions to the same id *)
       true
   | _ -> false
@@ -928,16 +928,16 @@ let ctx_get (id : id) (ctx : extraction_ctx) : string =
 
 let names_maps_add_assumed_type (id_to_string : id -> string) (id : assumed_ty)
     (name : string) (nm : names_maps) : names_maps =
-  names_maps_add id_to_string (TypeId (Assumed id)) name nm
+  names_maps_add id_to_string (TypeId (TAssumed id)) name nm
 
 let names_maps_add_assumed_struct (id_to_string : id -> string)
     (id : assumed_ty) (name : string) (nm : names_maps) : names_maps =
-  names_maps_add id_to_string (StructId (Assumed id)) name nm
+  names_maps_add id_to_string (StructId (TAssumed id)) name nm
 
 let names_maps_add_assumed_variant (id_to_string : id -> string)
     (id : assumed_ty) (variant_id : VariantId.id) (name : string)
     (nm : names_maps) : names_maps =
-  names_maps_add id_to_string (VariantId (Assumed id, variant_id)) name nm
+  names_maps_add id_to_string (VariantId (TAssumed id, variant_id)) name nm
 
 let names_maps_add_function (id_to_string : id -> string) (fid : fun_id)
     (name : string) (nm : names_maps) : names_maps =
@@ -951,7 +951,7 @@ let ctx_get_function (id : fun_id) (ctx : extraction_ctx) : string =
 
 let ctx_get_local_function (id : A.FunDeclId.id) (lp : LoopId.id option)
     (rg : RegionGroupId.id option) (ctx : extraction_ctx) : string =
-  ctx_get_function (FromLlbc (FunId (Regular id), lp, rg)) ctx
+  ctx_get_function (FromLlbc (FunId (FRegular id), lp, rg)) ctx
 
 let ctx_get_type (id : type_id) (ctx : extraction_ctx) : string =
   assert (id <> Tuple);
@@ -961,7 +961,7 @@ let ctx_get_local_type (id : TypeDeclId.id) (ctx : extraction_ctx) : string =
   ctx_get_type (AdtId id) ctx
 
 let ctx_get_assumed_type (id : assumed_ty) (ctx : extraction_ctx) : string =
-  ctx_get_type (Assumed id) ctx
+  ctx_get_type (TAssumed id) ctx
 
 let ctx_get_trait_constructor (id : trait_decl_id) (ctx : extraction_ctx) :
     string =
@@ -1027,11 +1027,11 @@ let ctx_get_variant (def_id : type_id) (variant_id : VariantId.id)
 
 let ctx_get_decreases_proof (def_id : A.FunDeclId.id)
     (loop_id : LoopId.id option) (ctx : extraction_ctx) : string =
-  ctx_get (DecreasesProofId (Regular def_id, loop_id)) ctx
+  ctx_get (DecreasesProofId (FRegular def_id, loop_id)) ctx
 
 let ctx_get_termination_measure (def_id : A.FunDeclId.id)
     (loop_id : LoopId.id option) (ctx : extraction_ctx) : string =
-  ctx_get (TerminationMeasureId (Regular def_id, loop_id)) ctx
+  ctx_get (TerminationMeasureId (FRegular def_id, loop_id)) ctx
 
 (** Generate a unique type variable name and add it to the context *)
 let ctx_add_type_var (basename : string) (id : TypeVarId.id)
@@ -1150,7 +1150,7 @@ let ctx_add_decreases_proof (def : fun_decl) (ctx : extraction_ctx) :
     ctx.fmt.decreases_proof_name def.def_id def.basename def.num_loops
       def.loop_id
   in
-  ctx_add (DecreasesProofId (Regular def.def_id, def.loop_id)) name ctx
+  ctx_add (DecreasesProofId (FRegular def.def_id, def.loop_id)) name ctx
 
 let ctx_add_termination_measure (def : fun_decl) (ctx : extraction_ctx) :
     extraction_ctx =
@@ -1158,7 +1158,7 @@ let ctx_add_termination_measure (def : fun_decl) (ctx : extraction_ctx) :
     ctx.fmt.termination_measure_name def.def_id def.basename def.num_loops
       def.loop_id
   in
-  ctx_add (TerminationMeasureId (Regular def.def_id, def.loop_id)) name ctx
+  ctx_add (TerminationMeasureId (FRegular def.def_id, def.loop_id)) name ctx
 
 let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
     extraction_ctx =
@@ -1176,7 +1176,7 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
   | None ->
       (* Not the case: "standard" registration *)
       let name = ctx.fmt.global_name def.name in
-      let body = FunId (FromLlbc (FunId (Regular def.body_id), None, None)) in
+      let body = FunId (FromLlbc (FunId (FRegular def.body_id), None, None)) in
       let ctx = ctx_add decl (name ^ "_c") ctx in
       let ctx = ctx_add body (name ^ "_body") ctx in
       ctx
@@ -1197,7 +1197,7 @@ let ctx_compute_fun_name (trans_group : pure_fun_translation) (def : fun_decl)
         let rg = T.RegionGroupId.nth sg.regions_hierarchy rg_id in
         let region_names =
           List.map
-            (fun rid -> (T.RegionVarId.nth sg.generics.regions rid).name)
+            (fun rid -> (T.RegionId.nth sg.generics.regions rid).name)
             rg.regions
         in
         Some { id = rg_id; region_names }
@@ -1218,7 +1218,7 @@ let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
   let num_backs = List.length backs in
   (* Add the function name *)
   let def_name = ctx_compute_fun_name trans_group def ctx in
-  let fun_id = (Pure.FunId (Regular def_id), def.loop_id, def.back_id) in
+  let fun_id = (Pure.FunId (FRegular def_id), def.loop_id, def.back_id) in
   let ctx = ctx_add (FunId (FromLlbc fun_id)) def_name ctx in
   (* Add the name info *)
   {
@@ -1300,7 +1300,7 @@ let initialize_names_maps (fmt : formatter) (init : names_map_init) : names_maps
   let assumed_functions =
     List.map
       (fun (fid, rg, name) ->
-        (FromLlbc (Pure.FunId (Assumed fid), None, rg), name))
+        (FromLlbc (Pure.FunId (FAssumed fid), None, rg), name))
       init.assumed_llbc_functions
     @ List.map (fun (fid, name) -> (Pure fid, name)) init.assumed_pure_functions
   in
diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml
index 77f76bb4..48273023 100644
--- a/compiler/ExtractTypes.ml
+++ b/compiler/ExtractTypes.ml
@@ -799,19 +799,19 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     | None -> (
         (* No basename: we use the first letter of the type *)
         match ty with
-        | Adt (type_id, generics) -> (
+        | TAdt (type_id, generics) -> (
             match type_id with
             | Tuple ->
                 (* The "pair" case is frequent enough to have its special treatment *)
                 if List.length generics.types = 2 then "p" else "t"
-            | Assumed Result -> "r"
-            | Assumed Error -> ConstStrings.error_basename
-            | Assumed Fuel -> ConstStrings.fuel_basename
-            | Assumed Array -> "a"
-            | Assumed Slice -> "s"
-            | Assumed Str -> "s"
-            | Assumed State -> ConstStrings.state_basename
-            | Assumed (RawPtr _) -> "p"
+            | TAssumed Result -> "r"
+            | TAssumed Error -> ConstStrings.error_basename
+            | TAssumed Fuel -> ConstStrings.fuel_basename
+            | TAssumed Array -> "a"
+            | TAssumed Slice -> "s"
+            | TAssumed Str -> "s"
+            | TAssumed State -> ConstStrings.state_basename
+            | TAssumed (RawPtr _) -> "p"
             | AdtId adt_id ->
                 let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
                 (* Derive the var name from the last ident of the type name
@@ -826,8 +826,8 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
             match !backend with
             | FStar -> "x" (* lacking inspiration here... *)
             | Coq | Lean | HOL4 -> "t" (* lacking inspiration here... *))
-        | Literal lty -> (
-            match lty with Bool -> "b" | Char -> "c" | Integer _ -> "i")
+        | TLiteral lty -> (
+            match lty with TBool -> "b" | TChar -> "c" | TInteger _ -> "i")
         | Arrow _ -> "f"
         | TraitType (_, _, name) -> name_from_type_ident name)
   in
@@ -864,7 +864,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
   let extract_literal (fmt : F.formatter) (inside : bool) (cv : literal) : unit
       =
     match cv with
-    | Scalar sv -> (
+    | VScalar sv -> (
         match !backend with
         | FStar -> F.pp_print_string fmt (Z.to_string sv.PV.value)
         | Coq | HOL4 | Lean ->
@@ -895,14 +895,14 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
             | HOL4 -> ()
             | _ -> raise (Failure "Unreachable"));
             if print_brackets then F.pp_print_string fmt ")")
-    | Bool b ->
+    | VBool b ->
         let b =
           match !backend with
           | HOL4 -> if b then "T" else "F"
           | Coq | FStar | Lean -> if b then "true" else "false"
         in
         F.pp_print_string fmt b
-    | Char c -> (
+    | VChar c -> (
         match !backend with
         | HOL4 ->
             (* [#"a"] is a notation for [CHR 97] (97 is the ASCII code for 'a') *)
@@ -1130,9 +1130,9 @@ let extract_const_generic (ctx : extraction_ctx) (fmt : F.formatter)
 let extract_literal_type (ctx : extraction_ctx) (fmt : F.formatter)
     (ty : literal_type) : unit =
   match ty with
-  | Bool -> F.pp_print_string fmt ctx.fmt.bool_name
-  | Char -> F.pp_print_string fmt ctx.fmt.char_name
-  | Integer int_ty -> F.pp_print_string fmt (ctx.fmt.int_name int_ty)
+  | TBool -> F.pp_print_string fmt ctx.fmt.bool_name
+  | TChar -> F.pp_print_string fmt ctx.fmt.char_name
+  | TInteger int_ty -> F.pp_print_string fmt (ctx.fmt.int_name int_ty)
 
 (** [inside] constrols whether we should add parentheses or not around type
     applications (if [true] we add parentheses).
@@ -1158,7 +1158,7 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
     (no_params_tys : TypeDeclId.Set.t) (inside : bool) (ty : ty) : unit =
   let extract_rec = extract_ty ctx fmt no_params_tys in
   match ty with
-  | Adt (type_id, generics) -> (
+  | TAdt (type_id, generics) -> (
       let has_params = generics <> empty_generic_args in
       match type_id with
       | Tuple ->
@@ -1181,7 +1181,7 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
                 F.pp_print_space fmt ())
               (extract_rec true) generics.types;
             F.pp_print_string fmt ")")
-      | AdtId _ | Assumed _ -> (
+      | AdtId _ | TAssumed _ -> (
           (* HOL4 behaves differently. Where in Coq/FStar/Lean we would write:
              `tree a b`
 
@@ -1224,7 +1224,7 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
               let print_tys =
                 match type_id with
                 | AdtId id -> not (TypeDeclId.Set.mem id no_params_tys)
-                | Assumed _ -> true
+                | TAssumed _ -> true
                 | _ -> raise (Failure "Unreachable")
               in
               if types <> [] && print_tys then (
@@ -1244,7 +1244,7 @@ let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter)
                   (extract_trait_ref ctx fmt no_params_tys true)
                   trait_refs)))
   | TypeVar vid -> F.pp_print_string fmt (ctx_get_type_var vid ctx)
-  | Literal lty -> extract_literal_type ctx fmt lty
+  | TLiteral lty -> extract_literal_type ctx fmt lty
   | Arrow (arg_ty, ret_ty) ->
       if inside then F.pp_print_string fmt "(";
       extract_rec false arg_ty;
diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml
index e17ea16f..1f17c1aa 100644
--- a/compiler/FunsAnalysis.ml
+++ b/compiler/FunsAnalysis.ml
@@ -91,7 +91,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
 
           method! visit_Call env call =
             (match call.func.func with
-            | FunId (Regular id) ->
+            | FunId (FRegular id) ->
                 if FunDeclId.Set.mem id fun_ids then (
                   can_diverge := true;
                   is_rec := true)
@@ -100,7 +100,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
                   self#may_fail info.can_fail;
                   stateful := !stateful || info.stateful;
                   can_diverge := !can_diverge || info.can_diverge
-            | FunId (Assumed id) ->
+            | FunId (FAssumed id) ->
                 (* None of the assumed functions can diverge nor are considered stateful *)
                 can_fail := !can_fail || Assumed.assumed_fun_can_fail id
             | TraitMethod _ ->
diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml
index 24ff4808..bc28bcd6 100644
--- a/compiler/Interpreter.ml
+++ b/compiler/Interpreter.ml
@@ -46,7 +46,7 @@ let normalize_inst_fun_sig (ctx : C.eval_ctx) (sg : A.inst_fun_sig) :
   let { A.regions_hierarchy = _; trait_type_constraints = _; inputs; output } =
     sg
   in
-  let norm = AssociatedTypes.ctx_normalize_rty ctx in
+  let norm = AssociatedTypes.ctx_normalize_ty ctx in
   let inputs = List.map norm inputs in
   let output = norm output in
   { sg with A.inputs; output }
@@ -70,7 +70,7 @@ let symbolic_instantiate_fun_sig (ctx : C.eval_ctx) (sg : A.fun_sig)
   in
   let generics =
     let { T.regions; types; const_generics; trait_clauses } = sg.generics in
-    let regions = List.map (fun _ -> T.Erased) regions in
+    let regions = List.map (fun _ -> T.RErased) regions in
     let types = List.map (fun (v : T.type_var) -> T.TypeVar v.T.index) types in
     let const_generics =
       List.map
@@ -110,9 +110,8 @@ let symbolic_instantiate_fun_sig (ctx : C.eval_ctx) (sg : A.fun_sig)
        ]}
     *)
     (* We will need to update the trait refs map while we perform the instantiations *)
-    let mk_tr_subst
-        (tr_map : T.erased_region T.trait_instance_id T.TraitClauseId.Map.t)
-        clause_id : T.erased_region T.trait_instance_id =
+    let mk_tr_subst (tr_map : T.trait_instance_id T.TraitClauseId.Map.t)
+        clause_id : T.trait_instance_id =
       match T.TraitClauseId.Map.find_opt clause_id tr_map with
       | Some tr -> tr
       | None -> raise (Failure "Local trait clause not found")
@@ -185,7 +184,7 @@ let initialize_symbolic_context_for_fun (ctx : C.decls_ctx) (fdef : A.fun_decl)
   let sg = fdef.signature in
   (* Create the context *)
   let region_groups =
-    List.map (fun (g : T.region_var_group) -> g.id) sg.regions_hierarchy
+    List.map (fun (g : T.region_group) -> g.id) sg.regions_hierarchy
   in
   let ctx =
     initialize_eval_context ctx region_groups sg.generics.types
diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml
index e97795a1..d4dbf80a 100644
--- a/compiler/InterpreterBorrows.ml
+++ b/compiler/InterpreterBorrows.ml
@@ -301,8 +301,8 @@ let give_back_value (config : C.config) (bid : V.BorrowId.id)
               if nv.V.ty <> expected_ty then (
                 log#serror
                   ("give_back_value: improper type:\n- expected: "
-                 ^ ety_to_string ctx ty ^ "\n- received: "
-                 ^ ety_to_string ctx nv.V.ty);
+                 ^ PA.ty_to_string ctx ty ^ "\n- received: "
+                  ^ PA.ty_to_string ctx nv.V.ty);
                 raise (Failure "Value given back doesn't have the proper type"));
               (* Replace *)
               set_replaced ();
@@ -426,12 +426,12 @@ let give_back_value (config : C.config) (bid : V.BorrowId.id)
             (* Nothing special to do *)
             super#visit_ALoan opt_abs lc
 
-      method! visit_Abs opt_abs abs =
+      method! visit_EAbs opt_abs abs =
         (* We remember in which abstraction we are before diving -
          * this is necessary for projecting values: we need to know
          * over which regions to project *)
         assert (Option.is_none opt_abs);
-        super#visit_Abs (Some abs) abs
+        super#visit_EAbs (Some abs) abs
     end
   in
 
@@ -447,7 +447,7 @@ let give_back_symbolic_value (_config : C.config)
     (proj_regions : T.RegionId.Set.t) (proj_ty : T.rty) (sv : V.symbolic_value)
     (nsv : V.symbolic_value) (ctx : C.eval_ctx) : C.eval_ctx =
   (* Sanity checks *)
-  assert (sv.sv_id <> nsv.sv_id);
+  assert (sv.sv_id <> nsv.sv_id && ty_is_rty proj_ty);
   (match nsv.sv_kind with
   | V.SynthInputGivenBack | SynthRetGivenBack | FunCallGivenBack | LoopGivenBack
     ->
@@ -554,8 +554,8 @@ let give_back_avalue_to_same_abstraction (_config : C.config)
               if nv.V.ty <> expected_ty then (
                 log#serror
                   ("give_back_avalue_to_same_abstraction: improper type:\n\
-                    - expected: " ^ rty_to_string ctx ty ^ "\n- received: "
-                 ^ rty_to_string ctx nv.V.ty);
+                    - expected: " ^ PA.ty_to_string ctx ty ^ "\n- received: "
+                  ^ PA.ty_to_string ctx nv.V.ty);
                 raise (Failure "Value given back doesn't have the proper type"));
               (* This is the loan we are looking for: apply the projection to
                * the value we give back and replaced this mutable loan with
@@ -1734,14 +1734,14 @@ let destructure_abs (abs_kind : V.abs_kind) (can_end : bool)
   and list_values (v : V.typed_value) : V.typed_avalue list * V.typed_value =
     let ty = v.V.ty in
     match v.V.value with
-    | Literal _ -> ([], v)
-    | Adt adt ->
+    | VLiteral _ -> ([], v)
+    | VAdt adt ->
         let avll, field_values =
           List.split (List.map list_values adt.field_values)
         in
         let avl = List.concat avll in
         let adt = { adt with V.field_values } in
-        (avl, { v with V.value = Adt adt })
+        (avl, { v with V.value = VAdt adt })
     | Bottom -> raise (Failure "Unreachable")
     | Borrow _ ->
         (* We don't support nested borrows for now *)
@@ -1750,9 +1750,9 @@ let destructure_abs (abs_kind : V.abs_kind) (can_end : bool)
         match lc with
         | SharedLoan (bids, sv) ->
             let avl, sv = list_values sv in
-            if destructure_shared_values then
+            if destructure_shared_values then (
               (* Rem.: the shared value can't contain loans nor borrows *)
-              let rty = ety_no_regions_to_rty ty in
+              assert (ty_no_regions ty);
               let av : V.typed_avalue =
                 assert (not (value_has_loans_or_borrows ctx sv.V.value));
                 (* We introduce fresh ids for the symbolic values *)
@@ -1771,12 +1771,12 @@ let destructure_abs (abs_kind : V.abs_kind) (can_end : bool)
                 let sv = mk_value_with_fresh_sids sv in
                 (* Create the new avalue *)
                 let value =
-                  V.ALoan (V.ASharedLoan (bids, sv, mk_aignored rty))
+                  V.ALoan (V.ASharedLoan (bids, sv, mk_aignored ty))
                 in
-                { V.value; ty = rty }
+                { V.value; ty }
               in
               let avl = List.append [ av ] avl in
-              (avl, sv)
+              (avl, sv))
             else (avl, { v with V.value = V.Loan (V.SharedLoan (bids, sv)) })
         | MutLoan _ -> raise (Failure "Unreachable"))
     | Symbolic _ ->
@@ -1842,12 +1842,12 @@ let convert_value_to_abstractions (abs_kind : V.abs_kind) (can_end : bool)
 
     let ty = v.V.ty in
     match v.V.value with
-    | V.Literal _ -> ([], v)
+    | V.VLiteral _ -> ([], v)
     | V.Bottom ->
         (* Can happen: we *do* convert dummy values to abstractions, and dummy
            values can contain bottoms *)
         ([], v)
-    | V.Adt adt ->
+    | V.VAdt adt ->
         (* Two cases, depending on whether we have to group all the borrows/loans
            inside one abstraction or not *)
         let avl, field_values =
@@ -1879,16 +1879,17 @@ let convert_value_to_abstractions (abs_kind : V.abs_kind) (can_end : bool)
             ([], field_values)
         in
         let adt = { adt with field_values } in
-        (avl, { v with V.value = V.Adt adt })
+        (avl, { v with V.value = V.VAdt adt })
     | V.Borrow bc -> (
         let _, ref_ty, kind = ty_as_ref ty in
+        assert (ty_no_regions ref_ty);
         (* Sanity check *)
         assert allow_borrows;
         (* Convert the borrow content *)
         match bc with
         | SharedBorrow bid ->
-            let ref_ty = ety_no_regions_to_rty ref_ty in
-            let ty = T.Ref (T.Var r_id, ref_ty, kind) in
+            assert (ty_no_regions ref_ty);
+            let ty = T.Ref (T.RVar r_id, ref_ty, kind) in
             let value = V.ABorrow (V.ASharedBorrow bid) in
             ([ { V.value; ty } ], v)
         | MutBorrow (bid, bv) ->
@@ -1896,8 +1897,7 @@ let convert_value_to_abstractions (abs_kind : V.abs_kind) (can_end : bool)
             (* We don't support nested borrows for now *)
             assert (not (value_has_borrows ctx bv.V.value));
             (* Create an avalue to push - note that we use [AIgnore] for the inner avalue *)
-            let ref_ty = ety_no_regions_to_rty ref_ty in
-            let ty = T.Ref (T.Var r_id, ref_ty, kind) in
+            let ty = T.Ref (T.RVar r_id, ref_ty, kind) in
             let ignored = mk_aignored ref_ty in
             let av = V.ABorrow (V.AMutBorrow (bid, ignored)) in
             let av = { V.value = av; ty } in
@@ -1917,8 +1917,8 @@ let convert_value_to_abstractions (abs_kind : V.abs_kind) (can_end : bool)
             assert (not (value_has_borrows ctx sv.V.value));
             (* Push the avalue - note that we use [AIgnore] for the inner avalue *)
             (* For avalues, a loan has the borrow type *)
-            let ty = ety_no_regions_to_rty ty in
-            let ty = mk_ref_ty (T.Var r_id) ty T.Shared in
+            assert (ty_no_regions ty);
+            let ty = mk_ref_ty (T.RVar r_id) ty T.Shared in
             let ignored = mk_aignored ty in
             (* Rem.: the shared value might contain loans *)
             let avl, sv = to_avalues false true true r_id sv in
@@ -1935,8 +1935,8 @@ let convert_value_to_abstractions (abs_kind : V.abs_kind) (can_end : bool)
         | V.MutLoan bid ->
             (* Push the avalue - note that we use [AIgnore] for the inner avalue *)
             (* For avalues, a loan has the borrow type *)
-            let ty = ety_no_regions_to_rty ty in
-            let ty = mk_ref_ty (T.Var r_id) ty T.Mut in
+            assert (ty_no_regions ty);
+            let ty = mk_ref_ty (T.RVar r_id) ty T.Mut in
             let ignored = mk_aignored ty in
             let av = V.ALoan (V.AMutLoan (bid, ignored)) in
             let av = { V.value = av; ty } in
diff --git a/compiler/InterpreterBorrows.mli b/compiler/InterpreterBorrows.mli
index 31b67bd7..6302dcc3 100644
--- a/compiler/InterpreterBorrows.mli
+++ b/compiler/InterpreterBorrows.mli
@@ -137,7 +137,6 @@ val convert_value_to_abstractions :
     Rem.: it may be more idiomatic to have a functor, but this seems a bit
     heavyweight, though.
   *)
-
 type merge_duplicates_funcs = {
   merge_amut_borrows :
     V.borrow_id ->
diff --git a/compiler/InterpreterBorrowsCore.ml b/compiler/InterpreterBorrowsCore.ml
index e7da045c..cf8e5994 100644
--- a/compiler/InterpreterBorrowsCore.ml
+++ b/compiler/InterpreterBorrowsCore.ml
@@ -88,24 +88,29 @@ let add_borrow_or_abs_id_to_chain (msg : string) (id : borrow_or_abs_id)
 (** Helper function.
   
     This function allows to define in a generic way a comparison of **region types**.
-    See [projections_interesect] for instance.
-    
+    See [projections_intersect] for instance.
+
+    Important: the regions in the types mustn't be erased.
+
     [default]: default boolean to return, when comparing types with no regions
     [combine]: how to combine booleans
     [compare_regions]: how to compare regions
 
     TODO: is there a way of deriving such a comparison?
+    TODO: rename
  *)
 let rec compare_rtys (default : bool) (combine : bool -> bool -> bool)
-    (compare_regions : T.RegionId.id T.region -> T.RegionId.id T.region -> bool)
-    (ty1 : T.rty) (ty2 : T.rty) : bool =
+    (compare_regions : T.region -> T.region -> bool) (ty1 : T.rty) (ty2 : T.rty)
+    : bool =
   let compare = compare_rtys default combine compare_regions in
+  (* Sanity check - TODO: don't do this at every recursive call *)
+  assert (ty_is_rty ty1 && ty_is_rty ty2);
   (* Normalize the associated types *)
   match (ty1, ty2) with
-  | T.Literal lit1, T.Literal lit2 ->
+  | T.TLiteral lit1, T.TLiteral lit2 ->
       assert (lit1 = lit2);
       default
-  | T.Adt (id1, generics1), T.Adt (id2, generics2) ->
+  | T.TAdt (id1, generics1), T.TAdt (id2, generics2) ->
       assert (id1 = id2);
       (* There are no regions in the const generics, so we ignore them,
          but we still check they are the same, for sanity *)
@@ -161,8 +166,8 @@ let rec compare_rtys (default : bool) (combine : bool -> bool -> bool)
   | _ ->
       log#lerror
         (lazy
-          ("compare_rtys: unexpected inputs:" ^ "\n- ty1: " ^ T.show_rty ty1
-         ^ "\n- ty2: " ^ T.show_rty ty2));
+          ("compare_rtys: unexpected inputs:" ^ "\n- ty1: " ^ T.show_ty ty1
+         ^ "\n- ty2: " ^ T.show_ty ty2));
       raise (Failure "Unreachable")
 
 (** Check if two different projections intersect. This is necessary when
@@ -183,6 +188,9 @@ let projections_intersect (ty1 : T.rty) (rset1 : T.RegionId.Set.t) (ty2 : T.rty)
 
 (** Check if the first projection contains the second projection.
     We use this function when checking invariants.
+
+    The regions in the types shouldn't be erased (this function will raise an exception
+    otherwise).
 *)
 let projection_contains (ty1 : T.rty) (rset1 : T.RegionId.Set.t) (ty2 : T.rty)
     (rset2 : T.RegionId.Set.t) : bool =
@@ -264,21 +272,21 @@ let lookup_loan_opt (ek : exploration_kind) (l : V.BorrowId.id)
         | V.AIgnoredSharedLoan _ ->
             super#visit_aloan_content env lc
 
-      method! visit_Var env bv v =
+      method! visit_EBinding env bv v =
         assert (Option.is_none !abs_or_var);
         abs_or_var :=
           Some
             (match bv with
-            | VarBinder b -> VarId b.C.index
-            | DummyBinder id -> DummyVarId id);
-        super#visit_Var env bv v;
+            | BVar b -> VarId b.C.index
+            | BDummy id -> DummyVarId id);
+        super#visit_EBinding env bv v;
         abs_or_var := None
 
-      method! visit_Abs env abs =
+      method! visit_EAbs env abs =
         assert (Option.is_none !abs_or_var);
         if ek.enter_abs then (
           abs_or_var := Some (AbsId abs.V.abs_id);
-          super#visit_Abs env abs;
+          super#visit_EAbs env abs;
           abs_or_var := None)
         else ()
     end
@@ -921,6 +929,8 @@ let remove_intersecting_aproj_borrows_shared (regions : T.RegionId.Set.t)
     
     Note that for sanity, this function checks that we update *at least* one
     projector of loans.
+
+    [proj_ty]: shouldn't contain erased regions.
         
     [subst]: takes as parameters the abstraction in which we perform the
     substitution and the list of given back values at the projector of
@@ -932,6 +942,8 @@ let update_intersecting_aproj_loans (proj_regions : T.RegionId.Set.t)
     (proj_ty : T.rty) (sv : V.symbolic_value)
     (subst : V.abs -> (V.msymbolic_value * V.aproj) list -> V.aproj)
     (ctx : C.eval_ctx) : C.eval_ctx =
+  (* *)
+  assert (ty_is_rty proj_ty);
   (* Small helpers for sanity checks *)
   let updated = ref false in
   let update abs local_given_back : V.aproj =
diff --git a/compiler/InterpreterExpansion.ml b/compiler/InterpreterExpansion.ml
index b267bb51..48688893 100644
--- a/compiler/InterpreterExpansion.ml
+++ b/compiler/InterpreterExpansion.ml
@@ -211,11 +211,12 @@ let apply_symbolic_expansion_non_borrow (config : C.config)
     The function might return a list of values if the symbolic value to expand
     is an enumeration.
     
+    [generics]: mustn't contain erased regions.
     [expand_enumerations] controls the expansion of enumerations: if false, it
     doesn't allow the expansion of enumerations *containing several variants*.
  *)
 let compute_expanded_symbolic_non_assumed_adt_value (expand_enumerations : bool)
-    (kind : V.sv_kind) (def_id : T.TypeDeclId.id) (generics : T.rgeneric_args)
+    (kind : V.sv_kind) (def_id : T.TypeDeclId.id) (generics : T.generic_args)
     (ctx : C.eval_ctx) : V.symbolic_expansion list =
   (* Lookup the definition and check if it is an enumeration with several
    * variants *)
@@ -263,11 +264,12 @@ let compute_expanded_symbolic_box_value (kind : V.sv_kind) (boxed_ty : T.rty) :
     The function might return a list of values if the symbolic value to expand
     is an enumeration.
 
+    [generics]: the regions shouldn't have been erased.
     [expand_enumerations] controls the expansion of enumerations: if [false], it
     doesn't allow the expansion of enumerations *containing several variants*.
  *)
 let compute_expanded_symbolic_adt_value (expand_enumerations : bool)
-    (kind : V.sv_kind) (adt_id : T.type_id) (generics : T.rgeneric_args)
+    (kind : V.sv_kind) (adt_id : T.type_id) (generics : T.generic_args)
     (ctx : C.eval_ctx) : V.symbolic_expansion list =
   match (adt_id, generics.regions, generics.types) with
   | T.AdtId def_id, _, _ ->
@@ -275,7 +277,7 @@ let compute_expanded_symbolic_adt_value (expand_enumerations : bool)
         def_id generics ctx
   | T.Tuple, [], _ ->
       [ compute_expanded_symbolic_tuple_value kind generics.types ]
-  | T.Assumed T.Box, [], [ boxed_ty ] ->
+  | T.TAssumed T.TBox, [], [ boxed_ty ] ->
       [ compute_expanded_symbolic_box_value kind boxed_ty ]
   | _ ->
       raise
@@ -330,10 +332,10 @@ let expand_symbolic_value_shared_borrow (config : C.config)
           V.Borrow (V.SharedBorrow bid)
         else super#visit_Symbolic env sv
 
-      method! visit_Abs proj_regions abs =
+      method! visit_EAbs proj_regions abs =
         assert (Option.is_none proj_regions);
         let proj_regions = Some abs.V.regions in
-        super#visit_Abs proj_regions abs
+        super#visit_EAbs proj_regions abs
 
       method! visit_AProjSharedBorrow proj_regions asb =
         let expand_asb (asb : V.abstract_shared_borrow) :
@@ -398,9 +400,9 @@ let expand_symbolic_value_shared_borrow (config : C.config)
 (** TODO: simplify and merge with the other expansion function *)
 let expand_symbolic_value_borrow (config : C.config)
     (original_sv : V.symbolic_value) (original_sv_place : SA.mplace option)
-    (region : T.RegionId.id T.region) (ref_ty : T.rty) (rkind : T.ref_kind) :
-    cm_fun =
+    (region : T.region) (ref_ty : T.rty) (rkind : T.ref_kind) : cm_fun =
  fun cf ctx ->
+  assert (region <> T.RErased);
   (* Check that we are allowed to expand the reference *)
   assert (not (region_in_set region ctx.ended_regions));
   (* Match on the reference kind *)
@@ -500,10 +502,10 @@ let expand_symbolic_bool (config : C.config) (sv : V.symbolic_value)
   let original_sv = sv in
   let original_sv_place = sv_place in
   let rty = original_sv.V.sv_ty in
-  assert (rty = T.Literal PV.Bool);
+  assert (rty = T.TLiteral PV.TBool);
   (* Expand the symbolic value to true or false and continue execution *)
-  let see_true = V.SeLiteral (PV.Bool true) in
-  let see_false = V.SeLiteral (PV.Bool false) in
+  let see_true = V.SeLiteral (PV.VBool true) in
+  let see_false = V.SeLiteral (PV.VBool false) in
   let seel = [ (Some see_true, cf_true); (Some see_false, cf_false) ] in
   (* Apply the symbolic expansion (this also outputs the updated symbolic AST) *)
   apply_branching_symbolic_expansions_non_borrow config original_sv
@@ -527,7 +529,7 @@ let expand_symbolic_value_no_branching (config : C.config)
    fun cf ctx ->
     match rty with
     (* ADTs *)
-    | T.Adt (adt_id, generics) ->
+    | T.TAdt (adt_id, generics) ->
         (* Compute the expanded value *)
         let allow_branching = false in
         let seel =
@@ -584,7 +586,7 @@ let expand_symbolic_adt (config : C.config) (sv : V.symbolic_value)
   (* Execute *)
   match rty with
   (* ADTs *)
-  | T.Adt (adt_id, generics) ->
+  | T.TAdt (adt_id, generics) ->
       let allow_branching = true in
       (* Compute the expanded value *)
       let seel =
@@ -604,7 +606,7 @@ let expand_symbolic_int (config : C.config) (sv : V.symbolic_value)
     (tgts : (V.scalar_value * st_cm_fun) list) (otherwise : st_cm_fun)
     (cf_after_join : st_m_fun) : m_fun =
   (* Sanity check *)
-  assert (sv.V.sv_ty = T.Literal (PV.Integer int_type));
+  assert (sv.V.sv_ty = T.TLiteral (PV.TInteger int_type));
   (* For all the branches of the switch, we expand the symbolic value
    * to the value given by the branch and execute the branch statement.
    * For the otherwise branch, we leave the symbolic value as it is
@@ -615,7 +617,7 @@ let expand_symbolic_int (config : C.config) (sv : V.symbolic_value)
    * (optional expansion, statement to execute)
    *)
   let seel =
-    List.map (fun (v, cf) -> (Some (V.SeLiteral (PV.Scalar v)), cf)) tgts
+    List.map (fun (v, cf) -> (Some (V.SeLiteral (PV.VScalar v)), cf)) tgts
   in
   let seel = List.append seel [ (None, otherwise) ] in
   (* Then expand and evaluate - this generates the proper symbolic AST *)
@@ -663,7 +665,7 @@ let greedy_expand_symbolics_with_borrows (config : C.config) : cm_fun =
           ^ symbolic_value_to_string ctx sv));
       let cc : cm_fun =
         match sv.V.sv_ty with
-        | T.Adt (AdtId def_id, _) ->
+        | T.TAdt (AdtId def_id, _) ->
             (* {!expand_symbolic_value_no_branching} checks if there are branchings,
              * but we prefer to also check it here - this leads to cleaner messages
              * and debugging *)
@@ -688,15 +690,15 @@ let greedy_expand_symbolics_with_borrows (config : C.config) : cm_fun =
                      [config]): "
                    ^ Print.name_to_string def.name))
             else expand_symbolic_value_no_branching config sv None
-        | T.Adt ((Tuple | Assumed Box), _) | T.Ref (_, _, _) ->
+        | T.TAdt ((Tuple | TAssumed TBox), _) | T.Ref (_, _, _) ->
             (* Ok *)
             expand_symbolic_value_no_branching config sv None
-        | T.Adt (Assumed (Array | Slice | Str), _) ->
+        | T.TAdt (TAssumed (TArray | TSlice | TStr), _) ->
             (* We can't expand those *)
             raise
               (Failure
                  "Attempted to greedily expand an ADT which can't be expanded ")
-        | T.TypeVar _ | T.Literal _ | Never | T.TraitType _ | T.Arrow _
+        | T.TypeVar _ | T.TLiteral _ | Never | T.TraitType _ | T.Arrow _
         | T.RawPtr _ ->
             raise (Failure "Unreachable")
       in
diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml
index 245f3b77..f4430c77 100644
--- a/compiler/InterpreterExpressions.ml
+++ b/compiler/InterpreterExpressions.ml
@@ -105,13 +105,13 @@ let literal_to_typed_value (ty : PV.literal_type) (cv : V.literal) :
       ^ Print.PrimitiveValues.literal_to_string cv));
   match (ty, cv) with
   (* Scalar, boolean... *)
-  | PV.Bool, Bool v -> { V.value = V.Literal (Bool v); ty = T.Literal ty }
-  | Char, Char v -> { V.value = V.Literal (Char v); ty = T.Literal ty }
-  | Integer int_ty, PV.Scalar v ->
+  | PV.TBool, VBool v -> { V.value = V.VLiteral (VBool v); ty = T.TLiteral ty }
+  | TChar, VChar v -> { V.value = V.VLiteral (VChar v); ty = T.TLiteral ty }
+  | TInteger int_ty, PV.VScalar v ->
       (* Check the type and the ranges *)
       assert (int_ty = v.int_ty);
       assert (check_scalar_value_in_range v);
-      { V.value = V.Literal (PV.Scalar v); ty = T.Literal ty }
+      { V.value = V.VLiteral (PV.VScalar v); ty = T.TLiteral ty }
   (* Remaining cases (invalid) *)
   | _, _ -> raise (Failure "Improperly typed constant value")
 
@@ -138,17 +138,17 @@ let rec copy_value (allow_adt_copy : bool) (config : C.config)
    * the fact that we have exhaustive matches below makes very obvious the cases
    * in which we need to fail *)
   match v.V.value with
-  | V.Literal _ -> (ctx, v)
-  | V.Adt av ->
+  | V.VLiteral _ -> (ctx, v)
+  | V.VAdt av ->
       (* Sanity check *)
       (match v.V.ty with
-      | T.Adt (T.Assumed T.Box, _) ->
+      | T.TAdt (T.TAssumed T.TBox, _) ->
           raise (Failure "Can't copy an assumed value other than Option")
-      | T.Adt (T.AdtId _, _) as ty ->
+      | T.TAdt (T.AdtId _, _) as ty ->
           assert (allow_adt_copy || ty_is_primitively_copyable ty)
-      | T.Adt (T.Tuple, _) -> () (* Ok *)
-      | T.Adt
-          ( T.Assumed (Slice | T.Array),
+      | T.TAdt (T.Tuple, _) -> () (* Ok *)
+      | T.TAdt
+          ( T.TAssumed (TSlice | T.TArray),
             {
               regions = [];
               types = [ ty ];
@@ -162,7 +162,7 @@ let rec copy_value (allow_adt_copy : bool) (config : C.config)
           (copy_value allow_adt_copy config)
           ctx av.field_values
       in
-      (ctx, { v with V.value = V.Adt { av with field_values = fields } })
+      (ctx, { v with V.value = V.VAdt { av with field_values = fields } })
   | V.Bottom -> raise (Failure "Can't copy ⊥")
   | V.Borrow bc -> (
       (* We can only copy shared borrows *)
@@ -292,7 +292,7 @@ let eval_operand_no_reorganize (config : C.config) (op : E.operand)
                 List.find (fun (name, _) -> name = const_name) trait_decl.consts
               in
               (* Introduce a fresh symbolic value *)
-              let v = mk_fresh_symbolic_typed_value_from_ety V.TraitConst ty in
+              let v = mk_fresh_symbolic_typed_value V.TraitConst ty in
               (* Continue the evaluation *)
               let e = cf v ctx in
               (* We have to wrap the generated expression *)
@@ -304,7 +304,7 @@ let eval_operand_no_reorganize (config : C.config) (op : E.operand)
                        ( ctx0,
                          None,
                          value_as_symbolic v.value,
-                         SymbolicAst.TraitConstValue
+                         SymbolicAst.VaTraitConstValue
                            (trait_ref, generics, const_name),
                          e ))))
       | E.CVar vid -> (
@@ -329,7 +329,7 @@ let eval_operand_no_reorganize (config : C.config) (op : E.operand)
                    ( ctx0,
                      None,
                      value_as_symbolic v.value,
-                     SymbolicAst.ConstGenericValue vid,
+                     SymbolicAst.VaConstGenericValue vid,
                      e )))
       | E.CFnPtr _ -> raise (Failure "TODO"))
   | E.Copy p ->
@@ -421,21 +421,21 @@ let eval_unary_op_concrete (config : C.config) (unop : E.unop) (op : E.operand)
   (* Apply the unop *)
   let apply cf (v : V.typed_value) : m_fun =
     match (unop, v.V.value) with
-    | E.Not, V.Literal (Bool b) ->
-        cf (Ok { v with V.value = V.Literal (Bool (not b)) })
-    | E.Neg, V.Literal (PV.Scalar sv) -> (
+    | E.Not, V.VLiteral (VBool b) ->
+        cf (Ok { v with V.value = V.VLiteral (VBool (not b)) })
+    | E.Neg, V.VLiteral (PV.VScalar sv) -> (
         let i = Z.neg sv.PV.value in
         match mk_scalar sv.int_ty i with
         | Error _ -> cf (Error EPanic)
-        | Ok sv -> cf (Ok { v with V.value = V.Literal (PV.Scalar sv) }))
-    | E.Cast (E.CastInteger (src_ty, tgt_ty)), V.Literal (PV.Scalar sv) -> (
+        | Ok sv -> cf (Ok { v with V.value = V.VLiteral (PV.VScalar sv) }))
+    | E.Cast (E.CastInteger (src_ty, tgt_ty)), V.VLiteral (PV.VScalar sv) -> (
         assert (src_ty = sv.int_ty);
         let i = sv.PV.value in
         match mk_scalar tgt_ty i with
         | Error _ -> cf (Error EPanic)
         | Ok sv ->
-            let ty = T.Literal (Integer tgt_ty) in
-            let value = V.Literal (PV.Scalar sv) in
+            let ty = T.TLiteral (TInteger tgt_ty) in
+            let value = V.VLiteral (PV.VScalar sv) in
             cf (Ok { V.ty; value }))
     | _ -> raise (Failure "Invalid input for unop")
   in
@@ -452,9 +452,9 @@ let eval_unary_op_symbolic (config : C.config) (unop : E.unop) (op : E.operand)
     let res_sv_id = C.fresh_symbolic_value_id () in
     let res_sv_ty =
       match (unop, v.V.ty) with
-      | E.Not, (T.Literal Bool as lty) -> lty
-      | E.Neg, (T.Literal (Integer _) as lty) -> lty
-      | E.Cast (E.CastInteger (_, tgt_ty)), _ -> T.Literal (Integer tgt_ty)
+      | E.Not, (T.TLiteral TBool as lty) -> lty
+      | E.Neg, (T.TLiteral (TInteger _) as lty) -> lty
+      | E.Cast (E.CastInteger (_, tgt_ty)), _ -> T.TLiteral (TInteger tgt_ty)
       | _ -> raise (Failure "Invalid input for unop")
     in
     let res_sv =
@@ -489,11 +489,11 @@ let eval_binary_op_concrete_compute (binop : E.binop) (v1 : V.typed_value)
     (* Equality/inequality check is primitive only for a subset of types *)
     assert (ty_is_primitively_copyable v1.ty);
     let b = v1 = v2 in
-    Ok { V.value = V.Literal (Bool b); ty = T.Literal Bool })
+    Ok { V.value = V.VLiteral (VBool b); ty = T.TLiteral TBool })
   else
     (* For the non-equality operations, the input values are necessarily scalars *)
     match (v1.V.value, v2.V.value) with
-    | V.Literal (PV.Scalar sv1), V.Literal (PV.Scalar sv2) -> (
+    | V.VLiteral (PV.VScalar sv1), V.VLiteral (PV.VScalar sv2) -> (
         (* There are binops which require the two operands to have the same
            type, and binops for which it is not the case.
            There are also binops which return booleans, and binops which
@@ -514,7 +514,7 @@ let eval_binary_op_concrete_compute (binop : E.binop) (v1 : V.typed_value)
                   raise (Failure "Unreachable")
             in
             Ok
-              ({ V.value = V.Literal (Bool b); ty = T.Literal Bool }
+              ({ V.value = V.VLiteral (VBool b); ty = T.TLiteral TBool }
                 : V.typed_value)
         | E.Div | E.Rem | E.Add | E.Sub | E.Mul | E.BitXor | E.BitAnd | E.BitOr
           -> (
@@ -543,8 +543,8 @@ let eval_binary_op_concrete_compute (binop : E.binop) (v1 : V.typed_value)
             | Ok sv ->
                 Ok
                   {
-                    V.value = V.Literal (PV.Scalar sv);
-                    ty = T.Literal (Integer sv1.int_ty);
+                    V.value = V.VLiteral (PV.VScalar sv);
+                    ty = T.TLiteral (TInteger sv1.int_ty);
                   })
         | E.Shl | E.Shr -> raise Unimplemented
         | E.Ne | E.Eq -> raise (Failure "Unreachable"))
@@ -580,19 +580,19 @@ let eval_binary_op_symbolic (config : C.config) (binop : E.binop)
         assert (v1.ty = v2.ty);
         (* Equality/inequality check is primitive only for a subset of types *)
         assert (ty_is_primitively_copyable v1.ty);
-        T.Literal Bool)
+        T.TLiteral TBool)
       else
         (* Other operations: input types are integers *)
         match (v1.V.ty, v2.V.ty) with
-        | T.Literal (Integer int_ty1), T.Literal (Integer int_ty2) -> (
+        | T.TLiteral (TInteger int_ty1), T.TLiteral (TInteger int_ty2) -> (
             match binop with
             | E.Lt | E.Le | E.Ge | E.Gt ->
                 assert (int_ty1 = int_ty2);
-                T.Literal Bool
+                T.TLiteral TBool
             | E.Div | E.Rem | E.Add | E.Sub | E.Mul | E.BitXor | E.BitAnd
             | E.BitOr ->
                 assert (int_ty1 = int_ty2);
-                T.Literal (Integer int_ty1)
+                T.TLiteral (TInteger int_ty1)
             | E.Shl | E.Shr -> raise Unimplemented
             | E.Ne | E.Eq -> raise (Failure "Unreachable"))
         | _ -> raise (Failure "Invalid inputs for binop")
@@ -670,7 +670,7 @@ let eval_rvalue_ref (config : C.config) (p : E.place) (bkind : E.borrow_kind)
           | E.TwoPhaseMut -> T.Mut
           | _ -> raise (Failure "Unreachable")
         in
-        let rv_ty = T.Ref (T.Erased, v.ty, ref_kind) in
+        let rv_ty = T.Ref (T.RErased, v.ty, ref_kind) in
         let bc =
           match bkind with
           | E.Shared | E.Shallow ->
@@ -698,7 +698,7 @@ let eval_rvalue_ref (config : C.config) (p : E.place) (bkind : E.borrow_kind)
        fun ctx ->
         (* Compute the rvalue - wrap the value in a mutable borrow with a fresh id *)
         let bid = C.fresh_borrow_id () in
-        let rv_ty = T.Ref (T.Erased, v.ty, Mut) in
+        let rv_ty = T.Ref (T.RErased, v.ty, Mut) in
         let rv : V.typed_value =
           { V.value = V.Borrow (V.MutBorrow (bid, v)); ty = rv_ty }
         in
@@ -727,9 +727,9 @@ let eval_rvalue_aggregate (config : C.config)
         match type_id with
         | Tuple ->
             let tys = List.map (fun (v : V.typed_value) -> v.V.ty) values in
-            let v = V.Adt { variant_id = None; field_values = values } in
+            let v = V.VAdt { variant_id = None; field_values = values } in
             let generics = TypesUtils.mk_generic_args [] tys [] [] in
-            let ty = T.Adt (T.Tuple, generics) in
+            let ty = T.TAdt (T.Tuple, generics) in
             let aggregated : V.typed_value = { V.value = v; ty } in
             (* Call the continuation *)
             cf aggregated ctx
@@ -750,11 +750,11 @@ let eval_rvalue_aggregate (config : C.config)
             let av : V.adt_value =
               { V.variant_id = opt_variant_id; V.field_values = values }
             in
-            let aty = T.Adt (T.AdtId def_id, generics) in
-            let aggregated : V.typed_value = { V.value = Adt av; ty = aty } in
+            let aty = T.TAdt (T.AdtId def_id, generics) in
+            let aggregated : V.typed_value = { V.value = VAdt av; ty = aty } in
             (* Call the continuation *)
             cf aggregated ctx
-        | Assumed _ -> raise (Failure "Unreachable"))
+        | TAssumed _ -> raise (Failure "Unreachable"))
     | E.AggregatedArray (ety, cg) -> (
         (* Sanity check: all the values have the proper type *)
         assert (List.for_all (fun (v : V.typed_value) -> v.V.ty = ety) values);
@@ -762,22 +762,20 @@ let eval_rvalue_aggregate (config : C.config)
         let len = (literal_as_scalar (const_generic_as_literal cg)).value in
         assert (len = Z.of_int (List.length values));
         let generics = TypesUtils.mk_generic_args [] [ ety ] [ cg ] [] in
-        let ty = T.Adt (T.Assumed T.Array, generics) in
+        let ty = T.TAdt (T.TAssumed T.TArray, generics) in
         (* In order to generate a better AST, we introduce a symbolic
            value equal to the array. The reason is that otherwise, the
            array we introduce here might be duplicated in the generated
            code: by introducing a symbolic value we introduce a let-binding
            in the generated code. *)
-        let saggregated =
-          mk_fresh_symbolic_typed_value_from_ety V.Aggregate ty
-        in
+        let saggregated = mk_fresh_symbolic_typed_value V.Aggregate ty in
         (* Call the continuation *)
         match cf saggregated ctx with
         | None -> None
         | Some e ->
             (* Introduce the symbolic value in the AST *)
             let sv = ValuesUtils.value_as_symbolic saggregated.value in
-            Some (SymbolicAst.IntroSymbolic (ctx, None, sv, Array values, e)))
+            Some (SymbolicAst.IntroSymbolic (ctx, None, sv, VaArray values, e)))
   in
   (* Compose and apply *)
   comp eval_ops compute cf
diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml
index 6e33c75b..50bc7767 100644
--- a/compiler/InterpreterLoopsCore.ml
+++ b/compiler/InterpreterLoopsCore.ml
@@ -343,24 +343,24 @@ let ctx_split_fixed_new (fixed_ids : ids_sets) (ctx : C.eval_ctx) :
      though) in the target context *)
   let is_fresh (ee : C.env_elem) : bool =
     match ee with
-    | C.Var (VarBinder _, _) | C.Frame -> false
-    | C.Var (DummyBinder bv, _) -> is_fresh_did bv
-    | C.Abs abs -> is_fresh_abs_id abs.abs_id
+    | C.EBinding (BVar _, _) | C.EFrame -> false
+    | C.EBinding (BDummy bv, _) -> is_fresh_did bv
+    | C.EAbs abs -> is_fresh_abs_id abs.abs_id
   in
   let new_eel, filt_env = List.partition is_fresh ctx.env in
-  let is_abs ee = match ee with C.Abs _ -> true | _ -> false in
+  let is_abs ee = match ee with C.EAbs _ -> true | _ -> false in
   let new_absl, new_dummyl = List.partition is_abs new_eel in
   let new_absl =
     List.map
       (fun ee ->
-        match ee with C.Abs abs -> abs | _ -> raise (Failure "Unreachable"))
+        match ee with C.EAbs abs -> abs | _ -> raise (Failure "Unreachable"))
       new_absl
   in
   let new_dummyl =
     List.map
       (fun ee ->
         match ee with
-        | C.Var (DummyBinder _, v) -> v
+        | C.EBinding (BDummy _, v) -> v
         | _ -> raise (Failure "Unreachable"))
       new_dummyl
   in
diff --git a/compiler/InterpreterLoopsFixedPoint.ml b/compiler/InterpreterLoopsFixedPoint.ml
index 4310f017..3447131c 100644
--- a/compiler/InterpreterLoopsFixedPoint.ml
+++ b/compiler/InterpreterLoopsFixedPoint.ml
@@ -85,7 +85,7 @@ let prepare_ashared_loans (loop_id : V.LoopId.id option) : cm_fun =
   *)
   let absl =
     List.filter_map
-      (function C.Var _ | C.Frame -> None | C.Abs abs -> Some abs)
+      (function C.EBinding _ | C.EFrame -> None | C.EAbs abs -> Some abs)
       ctx.env
   in
   let absl_ids, absl_id_maps = compute_absl_ids absl in
@@ -109,7 +109,6 @@ let prepare_ashared_loans (loop_id : V.LoopId.id option) : cm_fun =
       (fun r -> if T.RegionId.Set.mem r rids then nrid else r)
       (fun x -> x)
       (fun x -> x)
-      (fun x -> x)
       (fun id ->
         let nid = C.fresh_symbolic_value_id () in
         let sv = V.SymbolicValueId.Map.find id absl_id_maps.sids_to_values in
@@ -163,14 +162,15 @@ let prepare_ashared_loans (loop_id : V.LoopId.id option) : cm_fun =
     assert (T.RegionId.Set.is_empty abs.ancestors_regions);
 
     (* Introduce the new abstraction for the shared values *)
-    let rty = ety_no_regions_to_rty sv.V.ty in
+    assert (ty_no_regions sv.V.ty);
+    let rty = sv.V.ty in
 
     (* Create the shared loan child *)
     let child_rty = rty in
     let child_av = mk_aignored child_rty in
 
     (* Create the shared loan *)
-    let loan_rty = T.Ref (T.Var nrid, rty, T.Shared) in
+    let loan_rty = T.Ref (T.RVar nrid, rty, T.Shared) in
     let loan_value =
       V.ALoan (V.ASharedLoan (V.BorrowId.Set.singleton nlid, nsv, child_av))
     in
@@ -304,7 +304,7 @@ let prepare_ashared_loans (loop_id : V.LoopId.id option) : cm_fun =
   in
 
   (* Add the abstractions *)
-  let fresh_absl = List.map (fun abs -> C.Abs abs) !fresh_absl in
+  let fresh_absl = List.map (fun abs -> C.EAbs abs) !fresh_absl in
   let env = List.append fresh_absl env in
   let ctx = { ctx with env } in
 
@@ -322,7 +322,7 @@ let prepare_ashared_loans (loop_id : V.LoopId.id option) : cm_fun =
              let sv =
                V.SymbolicValueId.Map.find sid new_ctx_ids_map.sids_to_values
              in
-             SymbolicAst.IntroSymbolic (ctx, None, sv, SingleValue v, e))
+             SymbolicAst.IntroSymbolic (ctx, None, sv, VaSingleValue v, e))
            e !sid_subst)
 
 let prepare_ashared_loans_no_synth (loop_id : V.LoopId.id) (ctx : C.eval_ctx) :
@@ -865,8 +865,8 @@ let compute_fp_ctx_symbolic_values (ctx : C.eval_ctx) (fp_ctx : C.eval_ctx) :
       List.filter
         (fun (ee : C.env_elem) ->
           match ee with
-          | C.Var _ | C.Frame -> false
-          | Abs abs -> V.AbstractionId.Set.mem abs.abs_id old_ids.aids)
+          | C.EBinding _ | C.EFrame -> false
+          | EAbs abs -> V.AbstractionId.Set.mem abs.abs_id old_ids.aids)
         ctx.env
     in
 
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 6d3ecb18..654ee21b 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -163,14 +163,14 @@ let collapse_ctx (loop_id : V.LoopId.id)
       (List.map
          (fun ee ->
            match ee with
-           | C.Abs _ | C.Frame | C.Var (VarBinder _, _) -> [ ee ]
-           | C.Var (DummyBinder id, v) ->
+           | C.EAbs _ | C.EFrame | C.EBinding (BVar _, _) -> [ ee ]
+           | C.EBinding (BDummy id, v) ->
                if is_fresh_did id then
                  let absl =
                    convert_value_to_abstractions abs_kind can_end
                      destructure_shared_values ctx0 v
                  in
-                 List.map (fun abs -> C.Abs abs) absl
+                 List.map (fun abs -> C.EAbs abs) absl
                else [ ee ])
          ctx0.env)
   in
@@ -436,14 +436,14 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
     (* Sanity check: there are no values/abstractions which should be in the prefix *)
     let check_valid (ee : C.env_elem) : unit =
       match ee with
-      | C.Var (C.VarBinder _, _) ->
+      | C.EBinding (C.BVar _, _) ->
           (* Variables are necessarily in the prefix *)
           raise (Failure "Unreachable")
-      | Var (C.DummyBinder did, _) ->
+      | EBinding (C.BDummy did, _) ->
           assert (not (C.DummyVarId.Set.mem did fixed_ids.dids))
-      | Abs abs ->
+      | EAbs abs ->
           assert (not (V.AbstractionId.Set.mem abs.abs_id fixed_ids.aids))
-      | Frame ->
+      | EFrame ->
           (* This should have been eliminated *)
           raise (Failure "Unreachable")
     in
@@ -451,7 +451,7 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
     List.iter check_valid env1;
     (* Concatenate the suffixes and append the abstractions introduced while
        joining the prefixes *)
-    let absl = List.map (fun abs -> C.Abs abs) (List.rev !nabs) in
+    let absl = List.map (fun abs -> C.EAbs abs) (List.rev !nabs) in
     List.concat [ env0; env1; absl ]
   in
 
@@ -466,12 +466,12 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
   (* Rem.: this function raises exceptions *)
   let rec join_prefixes (env0 : C.env) (env1 : C.env) : C.env =
     match (env0, env1) with
-    | ( (C.Var (C.DummyBinder b0, v0) as var0) :: env0',
-        (C.Var (C.DummyBinder b1, v1) as var1) :: env1' ) ->
+    | ( (C.EBinding (C.BDummy b0, v0) as var0) :: env0',
+        (C.EBinding (C.BDummy b1, v1) as var1) :: env1' ) ->
         (* Debug *)
         log#ldebug
           (lazy
-            ("join_prefixes: DummyBinders:\n\n- fixed_ids:\n" ^ "\n"
+            ("join_prefixes: BDummys:\n\n- fixed_ids:\n" ^ "\n"
            ^ show_ids_sets fixed_ids ^ "\n\n- value0:\n"
             ^ env_elem_to_string ctx var0
             ^ "\n\n- value1:\n"
@@ -486,17 +486,17 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
           assert (b0 = b1);
           let b = b0 in
           let v = M.match_typed_values ctx v0 v1 in
-          let var = C.Var (C.DummyBinder b, v) in
+          let var = C.EBinding (C.BDummy b, v) in
           (* Continue *)
           var :: join_prefixes env0' env1')
         else (* Not in the prefix anymore *)
           join_suffixes env0 env1
-    | ( (C.Var (C.VarBinder b0, v0) as var0) :: env0',
-        (C.Var (C.VarBinder b1, v1) as var1) :: env1' ) ->
+    | ( (C.EBinding (C.BVar b0, v0) as var0) :: env0',
+        (C.EBinding (C.BVar b1, v1) as var1) :: env1' ) ->
         (* Debug *)
         log#ldebug
           (lazy
-            ("join_prefixes: VarBinders:\n\n- fixed_ids:\n" ^ "\n"
+            ("join_prefixes: BVars:\n\n- fixed_ids:\n" ^ "\n"
            ^ show_ids_sets fixed_ids ^ "\n\n- value0:\n"
             ^ env_elem_to_string ctx var0
             ^ "\n\n- value1:\n"
@@ -509,10 +509,10 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
         (* Match the values *)
         let b = b0 in
         let v = M.match_typed_values ctx v0 v1 in
-        let var = C.Var (C.VarBinder b, v) in
+        let var = C.EBinding (C.BVar b, v) in
         (* Continue *)
         var :: join_prefixes env0' env1'
-    | (C.Abs abs0 as abs) :: env0', C.Abs abs1 :: env1' ->
+    | (C.EAbs abs0 as abs) :: env0', C.EAbs abs1 :: env1' ->
         (* Debug *)
         log#ldebug
           (lazy
@@ -537,7 +537,7 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
     (* Remove the frame delimiter (the first element of an environment is a frame delimiter) *)
     let env0, env1 =
       match (env0, env1) with
-      | C.Frame :: env0, C.Frame :: env1 -> (env0, env1)
+      | C.EFrame :: env0, C.EFrame :: env1 -> (env0, env1)
       | _ -> raise (Failure "Unreachable")
     in
 
@@ -546,7 +546,7 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
         ("- env0:\n" ^ C.show_env env0 ^ "\n\n- env1:\n" ^ C.show_env env1
        ^ "\n\n"));
 
-    let env = List.rev (C.Frame :: join_prefixes env0 env1) in
+    let env = List.rev (C.EFrame :: join_prefixes env0 env1) in
 
     (* Construct the joined context - of course, the type, fun, etc. contexts
      * should be the same in the two contexts *)
@@ -560,9 +560,7 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
       type_vars;
       const_generic_vars;
       const_generic_vars_map;
-      norm_trait_etypes;
-      norm_trait_rtypes;
-      norm_trait_stypes;
+      norm_trait_types;
       env = _;
       ended_regions = ended_regions0;
     } =
@@ -578,9 +576,7 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
       type_vars = _;
       const_generic_vars = _;
       const_generic_vars_map = _;
-      norm_trait_etypes = _;
-      norm_trait_rtypes = _;
-      norm_trait_stypes = _;
+      norm_trait_types = _;
       env = _;
       ended_regions = ended_regions1;
     } =
@@ -598,9 +594,7 @@ let join_ctxs (loop_id : V.LoopId.id) (fixed_ids : ids_sets) (ctx0 : C.eval_ctx)
         type_vars;
         const_generic_vars;
         const_generic_vars_map;
-        norm_trait_etypes;
-        norm_trait_rtypes;
-        norm_trait_stypes;
+        norm_trait_types;
         env;
         ended_regions;
       }
@@ -656,7 +650,6 @@ let refresh_abs (old_abs : V.AbstractionId.Set.t) (ctx : C.eval_ctx) :
       (fun x -> x)
       (fun x -> x)
       (fun x -> x)
-      (fun x -> x)
       subst ctx.env
   in
   { ctx with C.env }
diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml
index 8cab546e..9bc25626 100644
--- a/compiler/InterpreterLoopsMatchCtxs.ml
+++ b/compiler/InterpreterLoopsMatchCtxs.ml
@@ -144,12 +144,16 @@ let compute_abs_borrows_loans_maps (no_duplicates : bool)
     borrow_loan_to_abs = !borrow_loan_to_abs;
   }
 
-(** Match two types during a join. *)
-let rec match_types (match_distinct_types : 'r T.ty -> 'r T.ty -> 'r T.ty)
-    (match_regions : 'r -> 'r -> 'r) (ty0 : 'r T.ty) (ty1 : 'r T.ty) : 'r T.ty =
+(** Match two types during a join.
+
+    TODO: probably don't need to take [match_regions] as input anymore.
+ *)
+let rec match_types (match_distinct_types : T.ty -> T.ty -> T.ty)
+    (match_regions : T.region -> T.region -> T.region) (ty0 : T.ty) (ty1 : T.ty)
+    : T.ty =
   let match_rec = match_types match_distinct_types match_regions in
   match (ty0, ty1) with
-  | Adt (id0, generics0), Adt (id1, generics1) ->
+  | TAdt (id0, generics0), TAdt (id1, generics1) ->
       assert (id0 = id1);
       assert (generics0.const_generics = generics1.const_generics);
       assert (generics0.trait_refs = generics1.trait_refs);
@@ -167,12 +171,12 @@ let rec match_types (match_distinct_types : 'r T.ty -> 'r T.ty -> 'r T.ty)
           (List.combine generics0.types generics1.types)
       in
       let generics = { T.regions; types; const_generics; trait_refs } in
-      Adt (id, generics)
+      TAdt (id, generics)
   | TypeVar vid0, TypeVar vid1 ->
       assert (vid0 = vid1);
       let vid = vid0 in
       TypeVar vid
-  | Literal lty0, Literal lty1 ->
+  | TLiteral lty0, TLiteral lty1 ->
       assert (lty0 = lty1);
       ty0
   | Never, Never -> ty0
@@ -190,16 +194,16 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct
     let match_rec = match_typed_values ctx in
     let ty = M.match_etys v0.V.ty v1.V.ty in
     match (v0.V.value, v1.V.value) with
-    | V.Literal lv0, V.Literal lv1 ->
+    | V.VLiteral lv0, V.VLiteral lv1 ->
         if lv0 = lv1 then v1 else M.match_distinct_literals ty lv0 lv1
-    | V.Adt av0, V.Adt av1 ->
+    | V.VAdt av0, V.VAdt av1 ->
         if av0.variant_id = av1.variant_id then
           let fields = List.combine av0.field_values av1.field_values in
           let field_values =
             List.map (fun (f0, f1) -> match_rec f0 f1) fields
           in
           let value : V.value =
-            V.Adt { variant_id = av0.variant_id; field_values }
+            V.VAdt { variant_id = av0.variant_id; field_values }
           in
           { V.value; ty = v1.V.ty }
         else (
@@ -393,7 +397,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
 
   let match_distinct_literals (ty : T.ety) (_ : V.literal) (_ : V.literal) :
       V.typed_value =
-    mk_fresh_symbolic_typed_value_from_ety V.LoopJoin ty
+    mk_fresh_symbolic_typed_value_from_no_regions_ty V.LoopJoin ty
 
   let match_distinct_adts (ty : T.ety) (adt0 : V.adt_value) (adt1 : V.adt_value)
       : V.typed_value =
@@ -422,7 +426,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
     check_loans false adt1.field_values;
 
     (* No borrows, no loans: we can introduce a symbolic value *)
-    mk_fresh_symbolic_typed_value_from_ety V.LoopJoin ty
+    mk_fresh_symbolic_typed_value_from_no_regions_ty V.LoopJoin ty
 
   let match_shared_borrows _ (ty : T.ety) (bid0 : V.borrow_id)
       (bid1 : V.borrow_id) : V.borrow_id =
@@ -439,12 +443,12 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
 
       (* Generate a fresh symbolic value for the shared value *)
       let _, bv_ty, kind = ty_as_ref ty in
-      let sv = mk_fresh_symbolic_typed_value_from_ety V.LoopJoin bv_ty in
-
-      let borrow_ty =
-        mk_ref_ty (T.Var rid) (ety_no_regions_to_rty bv_ty) kind
+      let sv =
+        mk_fresh_symbolic_typed_value_from_no_regions_ty V.LoopJoin bv_ty
       in
 
+      let borrow_ty = mk_ref_ty (T.RVar rid) bv_ty kind in
+
       (* Generate the avalues for the abstraction *)
       let mk_aborrow (bid : V.borrow_id) : V.typed_avalue =
         let value = V.ABorrow (V.ASharedBorrow bid) in
@@ -453,10 +457,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
       let borrows = [ mk_aborrow bid0; mk_aborrow bid1 ] in
 
       let loan =
-        V.ASharedLoan
-          ( V.BorrowId.Set.singleton bid2,
-            sv,
-            mk_aignored (ety_no_regions_to_rty bv_ty) )
+        V.ASharedLoan (V.BorrowId.Set.singleton bid2, sv, mk_aignored bv_ty)
       in
       (* Note that an aloan has a borrow type *)
       let loan = { V.value = V.ALoan loan; ty = borrow_ty } in
@@ -542,8 +543,9 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
         let nbid = C.fresh_borrow_id () in
 
         let kind = T.Mut in
-        let bv_ty = ety_no_regions_to_rty bv.V.ty in
-        let borrow_ty = mk_ref_ty (T.Var rid) bv_ty kind in
+        let bv_ty = bv.V.ty in
+        assert (ty_no_regions bv_ty);
+        let borrow_ty = mk_ref_ty (T.RVar rid) bv_ty kind in
 
         let borrow_av =
           let ty = borrow_ty in
@@ -588,21 +590,22 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
 
       (* Generate a fresh symbolic value for the borrowed value *)
       let _, bv_ty, kind = ty_as_ref ty in
-      let sv = mk_fresh_symbolic_typed_value_from_ety V.LoopJoin bv_ty in
-
-      let borrow_ty =
-        mk_ref_ty (T.Var rid) (ety_no_regions_to_rty bv_ty) kind
+      let sv =
+        mk_fresh_symbolic_typed_value_from_no_regions_ty V.LoopJoin bv_ty
       in
 
+      let borrow_ty = mk_ref_ty (T.RVar rid) bv_ty kind in
+
       (* Generate the avalues for the abstraction *)
       let mk_aborrow (bid : V.borrow_id) (bv : V.typed_value) : V.typed_avalue =
-        let bv_ty = ety_no_regions_to_rty bv.V.ty in
+        let bv_ty = bv.V.ty in
+        assert (ty_no_regions bv_ty);
         let value = V.ABorrow (V.AMutBorrow (bid, mk_aignored bv_ty)) in
         { V.value; ty = borrow_ty }
       in
       let borrows = [ mk_aborrow bid0 bv0; mk_aborrow bid1 bv1 ] in
 
-      let loan = V.AMutLoan (bid2, mk_aignored (ety_no_regions_to_rty bv_ty)) in
+      let loan = V.AMutLoan (bid2, mk_aignored bv_ty) in
       (* Note that an aloan has a borrow type *)
       let loan = { V.value = V.ALoan loan; ty = borrow_ty } in
 
@@ -832,17 +835,17 @@ struct
     let match_distinct_types _ _ = raise (Distinct "match_rtys") in
     let match_regions r0 r1 =
       match (r0, r1) with
-      | T.Static, T.Static -> r1
-      | Var rid0, Var rid1 ->
+      | T.RStatic, T.RStatic -> r1
+      | RVar rid0, RVar rid1 ->
           let rid = match_rid rid0 rid1 in
-          Var rid
+          RVar rid
       | _ -> raise (Distinct "match_rtys")
     in
     match_types match_distinct_types match_regions ty0 ty1
 
   let match_distinct_literals (ty : T.ety) (_ : V.literal) (_ : V.literal) :
       V.typed_value =
-    mk_fresh_symbolic_typed_value_from_ety V.LoopJoin ty
+    mk_fresh_symbolic_typed_value_from_no_regions_ty V.LoopJoin ty
 
   let match_distinct_adts (_ty : T.ety) (_adt0 : V.adt_value)
       (_adt1 : V.adt_value) : V.typed_value =
@@ -982,7 +985,7 @@ struct
       (lazy
         ("MakeCheckEquivMatcher:match_amut_loans:" ^ "\n- id0: "
        ^ V.BorrowId.to_string id0 ^ "\n- id1: " ^ V.BorrowId.to_string id1
-       ^ "\n- ty: " ^ rty_to_string S.ctx ty ^ "\n- av: "
+       ^ "\n- ty: " ^ PA.ty_to_string S.ctx ty ^ "\n- av: "
         ^ typed_avalue_to_string S.ctx av));
 
     let id = match_loan_id id0 id1 in
@@ -1153,8 +1156,8 @@ let match_ctxs (check_equiv : bool) (fixed_ids : ids_sets)
         ^ "\n\n"));
 
     match (env0, env1) with
-    | ( C.Var (C.DummyBinder b0, v0) :: env0',
-        C.Var (C.DummyBinder b1, v1) :: env1' ) ->
+    | ( C.EBinding (C.BDummy b0, v0) :: env0',
+        C.EBinding (C.BDummy b1, v1) :: env1' ) ->
         (* Sanity check: if the dummy value is an old value, the bindings must
            be the same and their values equal (and the borrows/loans/symbolic *)
         if C.DummyVarId.Set.mem b0 fixed_ids.dids then (
@@ -1168,14 +1171,14 @@ let match_ctxs (check_equiv : bool) (fixed_ids : ids_sets)
            are the identity actually) *)
         let _ = M.match_typed_values ctx v0 v1 in
         match_envs env0' env1'
-    | C.Var (C.VarBinder b0, v0) :: env0', C.Var (C.VarBinder b1, v1) :: env1'
+    | C.EBinding (C.BVar b0, v0) :: env0', C.EBinding (C.BVar b1, v1) :: env1'
       ->
         assert (b0 = b1);
         (* Match the values *)
         let _ = M.match_typed_values ctx v0 v1 in
         (* Continue *)
         match_envs env0' env1'
-    | C.Abs abs0 :: env0', C.Abs abs1 :: env1' ->
+    | C.EAbs abs0 :: env0', C.EAbs abs1 :: env1' ->
         log#ldebug (lazy "match_ctxs: match_envs: matching abs");
         (* Same as for the dummy values: there are two cases *)
         if V.AbstractionId.Set.mem abs0.abs_id fixed_ids.aids then (
@@ -1211,7 +1214,7 @@ let match_ctxs (check_equiv : bool) (fixed_ids : ids_sets)
     let env1 = List.rev ctx1.env in
     let env0, env1 =
       match (env0, env1) with
-      | C.Frame :: env0, C.Frame :: env1 -> (env0, env1)
+      | C.EFrame :: env0, C.EFrame :: env1 -> (env0, env1)
       | _ -> raise (Failure "Unreachable")
     in
 
@@ -1275,7 +1278,7 @@ let match_ctx_with_target (config : C.config) (loop_id : V.LoopId.id)
 
     (* Remove the abstractions *)
     let filter (ee : C.env_elem) : bool =
-      match ee with Var _ -> true | Abs _ | Frame -> false
+      match ee with EBinding _ -> true | EAbs _ | EFrame -> false
     in
     let filt_src_env = List.filter filter filt_src_env in
     let filt_tgt_env = List.filter filter filt_tgt_env in
@@ -1304,11 +1307,11 @@ let match_ctx_with_target (config : C.config) (loop_id : V.LoopId.id)
         List.iter
           (fun (var0, var1) ->
             match (var0, var1) with
-            | C.Var (C.DummyBinder b0, v0), C.Var (C.DummyBinder b1, v1) ->
+            | C.EBinding (C.BDummy b0, v0), C.EBinding (C.BDummy b1, v1) ->
                 assert (b0 = b1);
                 let _ = M.match_typed_values ctx v0 v1 in
                 ()
-            | C.Var (C.VarBinder b0, v0), C.Var (C.VarBinder b1, v1) ->
+            | C.EBinding (C.BVar b0, v0), C.EBinding (C.BVar b1, v1) ->
                 assert (b0 = b1);
                 let _ = M.match_typed_values ctx v0 v1 in
                 ()
@@ -1392,7 +1395,7 @@ let match_ctx_with_target (config : C.config) (loop_id : V.LoopId.id)
         ^ eval_ctx_to_string_no_filter filt_src_ctx
         ^ "\n\n- new_absl:\n"
         ^ eval_ctx_to_string
-            { src_ctx with C.env = List.map (fun abs -> C.Abs abs) new_absl }
+            { src_ctx with C.env = List.map (fun abs -> C.EAbs abs) new_absl }
         ^ "\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- fp_bl_maps:\n"
         ^ show_borrow_loan_corresp fp_bl_maps
         ^ "\n\n- src_to_tgt_maps: "
@@ -1585,7 +1588,7 @@ let match_ctx_with_target (config : C.config) (loop_id : V.LoopId.id)
       end
     in
     let new_absl = List.map (visit_src#visit_abs ()) new_absl in
-    let new_absl = List.map (fun abs -> C.Abs abs) new_absl in
+    let new_absl = List.map (fun abs -> C.EAbs abs) new_absl in
 
     (* Add the abstractions from the target context to the source context *)
     let nenv = List.append new_absl tgt_ctx.env in
diff --git a/compiler/InterpreterPaths.ml b/compiler/InterpreterPaths.ml
index 2a277c91..728e5226 100644
--- a/compiler/InterpreterPaths.ml
+++ b/compiler/InterpreterPaths.ml
@@ -97,8 +97,8 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
       (* Match on the projection element and the value *)
       match (pe, v.V.value, v.V.ty) with
       | ( Field ((ProjAdt (_, _) as proj_kind), field_id),
-          V.Adt adt,
-          T.Adt (type_id, _) ) -> (
+          V.VAdt adt,
+          T.TAdt (type_id, _) ) -> (
           (* Check consistency *)
           (match (proj_kind, type_id) with
           | ProjAdt (def_id, opt_variant_id), T.AdtId def_id' ->
@@ -114,11 +114,11 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
               let nvalues =
                 T.FieldId.update_nth adt.field_values field_id res.updated
               in
-              let nadt = V.Adt { adt with V.field_values = nvalues } in
+              let nadt = V.VAdt { adt with V.field_values = nvalues } in
               let updated = { v with value = nadt } in
               Ok (ctx, { res with updated }))
       (* Tuples *)
-      | Field (ProjTuple arity, field_id), V.Adt adt, T.Adt (T.Tuple, _) -> (
+      | Field (ProjTuple arity, field_id), V.VAdt adt, T.TAdt (T.Tuple, _) -> (
           assert (arity = List.length adt.field_values);
           let fv = T.FieldId.nth adt.field_values field_id in
           (* Project *)
@@ -129,7 +129,7 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
               let nvalues =
                 T.FieldId.update_nth adt.field_values field_id res.updated
               in
-              let ntuple = V.Adt { adt with field_values = nvalues } in
+              let ntuple = V.VAdt { adt with field_values = nvalues } in
               let updated = { v with value = ntuple } in
               Ok (ctx, { res with updated })
           (* If we reach Bottom, it may mean we need to expand an uninitialized
@@ -142,8 +142,8 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
           Error (FailSymbolic (1 + List.length p', sp))
       (* Box dereferencement *)
       | ( DerefBox,
-          Adt { variant_id = None; field_values = [ bv ] },
-          T.Adt (T.Assumed T.Box, _) ) -> (
+          VAdt { variant_id = None; field_values = [ bv ] },
+          T.TAdt (T.TAssumed T.TBox, _) ) -> (
           (* We allow moving outside of boxes. In practice, this kind of
            * manipulations should happen only inside unsafe code, so
            * it shouldn't happen due to user code, and we leverage it
@@ -156,7 +156,7 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
                 {
                   v with
                   value =
-                    V.Adt { variant_id = None; field_values = [ res.updated ] };
+                    V.VAdt { variant_id = None; field_values = [ res.updated ] };
                 }
               in
               Ok (ctx, { res with updated = nv }))
@@ -248,7 +248,7 @@ let rec access_projection (access : projection_access) (ctx : C.eval_ctx)
                     in
                     Ok (ctx, { res with updated = nv })
               else Error (FailSharedLoan bids))
-      | (_, (V.Literal _ | V.Adt _ | V.Bottom | V.Borrow _), _) as r ->
+      | (_, (V.VLiteral _ | V.VAdt _ | V.Bottom | V.Borrow _), _) as r ->
           let pe, v, ty = r in
           let pe = "- pe: " ^ E.show_projection_elem pe in
           let v = "- v:\n" ^ V.show_value v in
@@ -357,7 +357,8 @@ let write_place (access : access_kind) (p : E.place) (nv : V.typed_value)
 
 let compute_expanded_bottom_adt_value (ctx : C.eval_ctx)
     (def_id : T.TypeDeclId.id) (opt_variant_id : T.VariantId.id option)
-    (generics : T.egeneric_args) : V.typed_value =
+    (generics : T.generic_args) : V.typed_value =
+  assert (TypesUtils.generic_args_only_erased_regions generics);
   (* Lookup the definition and check if it is an enumeration - it
      should be an enumeration if and only if the projection element
      is a field projection with *some* variant id. Retrieve the list
@@ -370,17 +371,17 @@ let compute_expanded_bottom_adt_value (ctx : C.eval_ctx)
   in
   (* Initialize the expanded value *)
   let fields = List.map mk_bottom field_types in
-  let av = V.Adt { variant_id = opt_variant_id; field_values = fields } in
-  let ty = T.Adt (T.AdtId def_id, generics) in
+  let av = V.VAdt { variant_id = opt_variant_id; field_values = fields } in
+  let ty = T.TAdt (T.AdtId def_id, generics) in
   { V.value = av; V.ty }
 
 let compute_expanded_bottom_tuple_value (field_types : T.ety list) :
     V.typed_value =
   (* Generate the field values *)
   let fields = List.map mk_bottom field_types in
-  let v = V.Adt { variant_id = None; field_values = fields } in
+  let v = V.VAdt { variant_id = None; field_values = fields } in
   let generics = TypesUtils.mk_generic_args [] field_types [] [] in
-  let ty = T.Adt (T.Tuple, generics) in
+  let ty = T.TAdt (T.Tuple, generics) in
   { V.value = v; V.ty }
 
 (** Auxiliary helper to expand {!V.Bottom} values.
@@ -432,12 +433,12 @@ let expand_bottom_value_from_projection (access : access_kind) (p : E.place)
     match (pe, ty) with
     (* "Regular" ADTs *)
     | ( Field (ProjAdt (def_id, opt_variant_id), _),
-        T.Adt (T.AdtId def_id', generics) ) ->
+        T.TAdt (T.AdtId def_id', generics) ) ->
         assert (def_id = def_id');
         compute_expanded_bottom_adt_value ctx def_id opt_variant_id generics
     (* Tuples *)
     | ( Field (ProjTuple arity, _),
-        T.Adt
+        T.TAdt
           ( T.Tuple,
             { T.regions = []; types; const_generics = []; trait_refs = [] } ) )
       ->
diff --git a/compiler/InterpreterPaths.mli b/compiler/InterpreterPaths.mli
index 0ff8063f..a493ad69 100644
--- a/compiler/InterpreterPaths.mli
+++ b/compiler/InterpreterPaths.mli
@@ -55,12 +55,15 @@ val write_place :
  *)
 val compute_expanded_bottom_tuple_value : T.ety list -> V.typed_value
 
-(** Compute an expanded ADT ⊥ value *)
+(** Compute an expanded ADT ⊥ value.
+
+    The types in the generics should use erased regions.
+  *)
 val compute_expanded_bottom_adt_value :
   C.eval_ctx ->
   T.TypeDeclId.id ->
   T.VariantId.id option ->
-  T.egeneric_args ->
+  T.generic_args ->
   V.typed_value
 
 (** Drop (end) outer loans at a given place, which should be seen as an l-value
diff --git a/compiler/InterpreterProjectors.ml b/compiler/InterpreterProjectors.ml
index 9e0c2b75..70a77be5 100644
--- a/compiler/InterpreterProjectors.ml
+++ b/compiler/InterpreterProjectors.ml
@@ -12,20 +12,21 @@ open InterpreterBorrowsCore
 (** The local logger *)
 let log = L.projectors_log
 
+(** [ty] shouldn't contain erased regions *)
 let rec apply_proj_borrows_on_shared_borrow (ctx : C.eval_ctx)
     (fresh_reborrow : V.BorrowId.id -> V.BorrowId.id)
     (regions : T.RegionId.Set.t) (v : V.typed_value) (ty : T.rty) :
     V.abstract_shared_borrows =
-  (* Sanity check - TODO: move this elsewhere (here we perform the check at every
+  (* Sanity check - TODO: move those elsewhere (here we perform the check at every
    * recursive call which is a bit overkill...) *)
   let ety = Subst.erase_regions ty in
-  assert (ety = v.V.ty);
+  assert (ty_is_rty ty && ety = v.V.ty);
   (* Project - if there are no regions from the abstraction in the type, return [_] *)
   if not (ty_has_regions_in_set regions ty) then []
   else
     match (v.V.value, ty) with
-    | V.Literal _, T.Literal _ -> []
-    | V.Adt adt, T.Adt (id, generics) ->
+    | V.VLiteral _, T.TLiteral _ -> []
+    | V.VAdt adt, T.TAdt (id, generics) ->
         (* Retrieve the types of the fields *)
         let field_types =
           Assoc.ctx_adt_value_get_inst_norm_field_rtypes ctx adt id generics
@@ -97,14 +98,14 @@ let rec apply_proj_borrows (check_symbolic_no_ended : bool) (ctx : C.eval_ctx)
   (* Sanity check - TODO: move this elsewhere (here we perform the check at every
    * recursive call which is a bit overkill...) *)
   let ety = Substitute.erase_regions ty in
-  assert (ety = v.V.ty);
+  assert (ty_is_rty ty && ety = v.V.ty);
   (* Project - if there are no regions from the abstraction in the type, return [_] *)
   if not (ty_has_regions_in_set regions ty) then { V.value = V.AIgnored; ty }
   else
     let value : V.avalue =
       match (v.V.value, ty) with
-      | V.Literal _, T.Literal _ -> V.AIgnored
-      | V.Adt adt, T.Adt (id, generics) ->
+      | V.VLiteral _, T.TLiteral _ -> V.AIgnored
+      | V.VAdt adt, T.TAdt (id, generics) ->
           (* Retrieve the types of the fields *)
           let field_types =
             Assoc.ctx_adt_value_get_inst_norm_field_rtypes ctx adt id generics
@@ -208,10 +209,10 @@ let rec apply_proj_borrows (check_symbolic_no_ended : bool) (ctx : C.eval_ctx)
             let rset2 = regions in
             log#ldebug
               (lazy
-                ("projections_intersect:" ^ "\n- ty1: " ^ rty_to_string ctx ty1
-               ^ "\n- rset1: "
+                ("projections_intersect:" ^ "\n- ty1: "
+               ^ PA.ty_to_string ctx ty1 ^ "\n- rset1: "
                 ^ T.RegionId.Set.to_string None rset1
-                ^ "\n- ty2: " ^ rty_to_string ctx ty2 ^ "\n- rset2: "
+                ^ "\n- ty2: " ^ PA.ty_to_string ctx ty2 ^ "\n- rset2: "
                 ^ T.RegionId.Set.to_string None rset2
                 ^ "\n"));
             assert (not (projections_intersect ty1 rset1 ty2 rset2)));
@@ -221,7 +222,7 @@ let rec apply_proj_borrows (check_symbolic_no_ended : bool) (ctx : C.eval_ctx)
             (lazy
               ("apply_proj_borrows: unexpected inputs:\n- input value: "
               ^ typed_value_to_string ctx v
-              ^ "\n- proj rty: " ^ rty_to_string ctx ty));
+              ^ "\n- proj rty: " ^ PA.ty_to_string ctx ty));
           raise (Failure "Unreachable")
     in
     { V.value; V.ty }
@@ -231,12 +232,12 @@ let symbolic_expansion_non_borrow_to_value (sv : V.symbolic_value)
   let ty = Subst.erase_regions sv.V.sv_ty in
   let value =
     match see with
-    | SeLiteral cv -> V.Literal cv
+    | SeLiteral cv -> V.VLiteral cv
     | SeAdt (variant_id, field_values) ->
         let field_values =
           List.map mk_typed_value_from_symbolic_value field_values
         in
-        V.Adt { V.variant_id; V.field_values }
+        V.VAdt { V.variant_id; V.field_values }
     | SeMutRef (_, _) | SeSharedRef (_, _) ->
         raise (Failure "Unexpected symbolic reference expansion")
   in
@@ -265,10 +266,10 @@ let apply_proj_loans_on_symbolic_expansion (regions : T.RegionId.Set.t)
    * contain regions which we will project *)
   assert (ty_has_regions_in_set regions original_sv_ty);
   (* Match *)
-  let (value, ty) : V.avalue * T.rty =
+  let (value, ty) : V.avalue * T.ty =
     match (see, original_sv_ty) with
-    | SeLiteral _, T.Literal _ -> (V.AIgnored, original_sv_ty)
-    | SeAdt (variant_id, field_values), T.Adt (_id, _generics) ->
+    | SeLiteral _, T.TLiteral _ -> (V.AIgnored, original_sv_ty)
+    | SeAdt (variant_id, field_values), T.TAdt (_id, _generics) ->
         (* Project over the field values *)
         let field_values =
           List.map
@@ -493,9 +494,11 @@ let prepare_reborrows (config : C.config) (allow_reborrows : bool) :
   in
   (fresh_reborrow, apply_registered_reborrows)
 
+(** [ty] shouldn't have erased regions *)
 let apply_proj_borrows_on_input_value (config : C.config) (ctx : C.eval_ctx)
     (regions : T.RegionId.Set.t) (ancestors_regions : T.RegionId.Set.t)
     (v : V.typed_value) (ty : T.rty) : C.eval_ctx * V.typed_avalue =
+  assert (ty_is_rty ty);
   let check_symbolic_no_ended = true in
   let allow_reborrows = true in
   (* Prepare the reborrows *)
diff --git a/compiler/InterpreterProjectors.mli b/compiler/InterpreterProjectors.mli
index bcc3dee2..7cee9ee7 100644
--- a/compiler/InterpreterProjectors.mli
+++ b/compiler/InterpreterProjectors.mli
@@ -16,7 +16,7 @@ open InterpreterBorrowsCore
     [regions]
     [ancestor_regions]
     [see]
-    [original_sv_ty]
+    [original_sv_ty]: shouldn't have erased regions
 *)
 val apply_proj_loans_on_symbolic_expansion :
   T.RegionId.Set.t ->
@@ -121,8 +121,8 @@ val apply_proj_borrows :
     - [regions]: the regions to project
     - [ancestors_regions]
     - [v]: the value on which to apply the projection
-    - [ty]: the type (with regions) to use for the projection
-
+    - [ty]: the type (with regions) to use for the projection (shouldn't have
+      erased regions)
  *)
 val apply_proj_borrows_on_input_value :
   C.config ->
diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml
index e0c4703b..cdcea2cc 100644
--- a/compiler/InterpreterStatements.ml
+++ b/compiler/InterpreterStatements.ml
@@ -149,7 +149,7 @@ let eval_assertion_concrete (config : C.config) (assertion : A.assertion) :
   let eval_assert cf (v : V.typed_value) : m_fun =
    fun ctx ->
     match v.value with
-    | Literal (Bool b) ->
+    | VLiteral (VBool b) ->
         (* Branch *)
         if b = assertion.expected then cf Unit ctx else cf Panic ctx
     | _ ->
@@ -172,26 +172,26 @@ let eval_assertion (config : C.config) (assertion : A.assertion) : st_cm_fun =
   (* Evaluate the assertion *)
   let eval_assert cf (v : V.typed_value) : m_fun =
    fun ctx ->
-    assert (v.ty = T.Literal PV.Bool);
+    assert (v.ty = T.TLiteral PV.TBool);
     (* We make a choice here: we could completely decouple the concrete and
      * symbolic executions here but choose not to. In the case where we
      * know the concrete value of the boolean we test, we use this value
      * even if we are in symbolic mode. Note that this case should be
      * extremely rare... *)
     match v.value with
-    | Literal (Bool _) ->
+    | VLiteral (VBool _) ->
         (* Delegate to the concrete evaluation function *)
         eval_assertion_concrete config assertion cf ctx
     | Symbolic sv ->
         assert (config.mode = C.SymbolicMode);
-        assert (sv.V.sv_ty = T.Literal PV.Bool);
+        assert (sv.V.sv_ty = T.TLiteral PV.TBool);
         (* We continue the execution as if the test had succeeded, and thus
          * perform the symbolic expansion: sv ~~> true.
          * We will of course synthesize an assertion in the generated code
          * (see below). *)
         let ctx =
           apply_symbolic_expansion_non_borrow config sv
-            (V.SeLiteral (PV.Bool true)) ctx
+            (V.SeLiteral (PV.VBool true)) ctx
         in
         (* Continue *)
         let expr = cf Unit ctx in
@@ -232,7 +232,7 @@ let set_discriminant (config : C.config) (p : E.place)
   let update_value cf (v : V.typed_value) : m_fun =
    fun ctx ->
     match (v.V.ty, v.V.value) with
-    | T.Adt ((T.AdtId _ as type_id), generics), V.Adt av -> (
+    | T.TAdt ((T.AdtId _ as type_id), generics), V.VAdt av -> (
         (* There are two situations:
            - either the discriminant is already the proper one (in which case we
              don't do anything)
@@ -254,7 +254,7 @@ let set_discriminant (config : C.config) (p : E.place)
                 | _ -> raise (Failure "Unreachable")
               in
               assign_to_place config bottom_v p (cf Unit) ctx)
-    | T.Adt ((T.AdtId _ as type_id), generics), V.Bottom ->
+    | T.TAdt ((T.AdtId _ as type_id), generics), V.Bottom ->
         let bottom_v =
           match type_id with
           | T.AdtId def_id ->
@@ -273,8 +273,8 @@ let set_discriminant (config : C.config) (p : E.place)
          * setting a discriminant should only be used to initialize a value,
          * or reset an already initialized value, really. *)
         raise (Failure "Unexpected value")
-    | _, (V.Adt _ | V.Bottom) -> raise (Failure "Inconsistent state")
-    | _, (V.Literal _ | V.Borrow _ | V.Loan _) ->
+    | _, (V.VAdt _ | V.Bottom) -> raise (Failure "Inconsistent state")
+    | _, (V.VLiteral _ | V.Borrow _ | V.Loan _) ->
         raise (Failure "Unexpected value")
   in
   (* Compose and apply *)
@@ -282,7 +282,7 @@ let set_discriminant (config : C.config) (p : E.place)
 
 (** Push a frame delimiter in the context's environment *)
 let ctx_push_frame (ctx : C.eval_ctx) : C.eval_ctx =
-  { ctx with env = Frame :: ctx.env }
+  { ctx with env = EFrame :: ctx.env }
 
 (** Push a frame delimiter in the context's environment *)
 let push_frame : cm_fun = fun cf ctx -> cf (ctx_push_frame ctx)
@@ -291,7 +291,7 @@ let push_frame : cm_fun = fun cf ctx -> cf (ctx_push_frame ctx)
     instantiation of an assumed function.
  *)
 let get_assumed_function_return_type (ctx : C.eval_ctx) (fid : A.assumed_fun_id)
-    (generics : T.egeneric_args) : T.ety =
+    (generics : T.generic_args) : T.ety =
   assert (generics.trait_refs = []);
   (* [Box::free] has a special treatment *)
   match fid with
@@ -305,17 +305,16 @@ let get_assumed_function_return_type (ctx : C.eval_ctx) (fid : A.assumed_fun_id)
       let sg = Assumed.get_assumed_fun_sig fid in
       (* Instantiate the return type  *)
       (* There shouldn't be any reference to Self *)
-      let tr_self : T.erased_region T.trait_instance_id =
-        T.UnknownTrait __FUNCTION__
-      in
+      let tr_self : T.trait_instance_id = T.UnknownTrait __FUNCTION__ in
+      let generics = Subst.generic_args_erase_regions generics in
       let { Subst.r_subst = _; ty_subst; cg_subst; tr_subst; tr_self } =
-        Subst.make_esubst_from_generics sg.generics generics tr_self
+        Subst.make_subst_from_generics sg.generics generics tr_self
       in
       let ty =
         Subst.erase_regions_substitute_types ty_subst cg_subst tr_subst tr_self
           sg.output
       in
-      Assoc.ctx_normalize_ety ctx ty
+      Assoc.ctx_normalize_erase_ty ctx ty
 
 let move_return_value (config : C.config) (pop_return_value : bool)
     (cf : V.typed_value option -> m_fun) : m_fun =
@@ -337,12 +336,12 @@ let pop_frame (config : C.config) (pop_return_value : bool)
   let rec list_locals env =
     match env with
     | [] -> raise (Failure "Inconsistent environment")
-    | C.Abs _ :: env -> list_locals env
-    | C.Var (DummyBinder _, _) :: env -> list_locals env
-    | C.Var (VarBinder var, _) :: env ->
+    | C.EAbs _ :: env -> list_locals env
+    | C.EBinding (BDummy _, _) :: env -> list_locals env
+    | C.EBinding (BVar var, _) :: env ->
         let locals = list_locals env in
         if var.index <> ret_vid then var.index :: locals else locals
-    | C.Frame :: _ -> []
+    | C.EFrame :: _ -> []
   in
   let locals : E.VarId.id list = list_locals ctx.env in
   (* Debug *)
@@ -392,11 +391,11 @@ let pop_frame (config : C.config) (pop_return_value : bool)
   let rec pop env =
     match env with
     | [] -> raise (Failure "Inconsistent environment")
-    | C.Abs abs :: env -> C.Abs abs :: pop env
-    | C.Var (_, v) :: env ->
+    | C.EAbs abs :: env -> C.EAbs abs :: pop env
+    | C.EBinding (_, v) :: env ->
         let vid = C.fresh_dummy_var_id () in
-        C.Var (C.DummyBinder vid, v) :: pop env
-    | C.Frame :: env -> (* Stop here *) env
+        C.EBinding (C.BDummy vid, v) :: pop env
+    | C.EFrame :: env -> (* Stop here *) env
   in
   let cf_pop cf (ret_value : V.typed_value option) : m_fun =
    fun ctx ->
@@ -416,7 +415,7 @@ let pop_frame_assign (config : C.config) (dest : E.place) : cm_fun =
   comp cf_pop cf_assign
 
 (** Auxiliary function - see {!eval_assumed_function_call} *)
-let eval_box_new_concrete (config : C.config) (generics : T.egeneric_args) :
+let eval_box_new_concrete (config : C.config) (generics : T.generic_args) :
     cm_fun =
  fun cf ctx ->
   (* Check and retrieve the arguments *)
@@ -426,9 +425,9 @@ let eval_box_new_concrete (config : C.config) (generics : T.egeneric_args) :
   | ( [],
       [ boxed_ty ],
       [],
-      Var (VarBinder input_var, input_value)
-      :: Var (_ret_var, _)
-      :: C.Frame :: _ ) ->
+      EBinding (BVar input_var, input_value)
+      :: EBinding (_ret_var, _)
+      :: C.EFrame :: _ ) ->
       (* Required type checking *)
       assert (input_value.V.ty = boxed_ty);
 
@@ -441,9 +440,9 @@ let eval_box_new_concrete (config : C.config) (generics : T.egeneric_args) :
       let cf_create cf (moved_input_value : V.typed_value) : m_fun =
         (* Create the box value *)
         let generics = TypesUtils.mk_generic_args_from_types [ boxed_ty ] in
-        let box_ty = T.Adt (T.Assumed T.Box, generics) in
+        let box_ty = T.TAdt (T.TAssumed T.TBox, generics) in
         let box_v =
-          V.Adt { variant_id = None; field_values = [ moved_input_value ] }
+          V.VAdt { variant_id = None; field_values = [ moved_input_value ] }
         in
         let box_v = mk_typed_value box_ty box_v in
 
@@ -478,7 +477,7 @@ let eval_box_new_concrete (config : C.config) (generics : T.egeneric_args) :
     It thus updates the box value (by calling {!drop_value}) and updates
     the destination (by setting it to [()]).
 *)
-let eval_box_free (config : C.config) (generics : T.egeneric_args)
+let eval_box_free (config : C.config) (generics : T.generic_args)
     (args : E.operand list) (dest : E.place) : cm_fun =
  fun cf ctx ->
   match (generics.regions, generics.types, generics.const_generics, args) with
@@ -657,7 +656,7 @@ let create_push_abstractions_from_abs_region_groups
     (* Add the avalues to the abstraction *)
     let abs = { abs with avalues } in
     (* Insert the abstraction in the context *)
-    let ctx = { ctx with env = Abs abs :: ctx.env } in
+    let ctx = { ctx with env = EAbs abs :: ctx.env } in
     (* Return *)
     ctx
   in
@@ -768,7 +767,7 @@ and eval_global (config : C.config) (dest : E.place) (gid : LA.GlobalDeclId.id)
       (* Treat the evaluation of the global as a call to the global body (without arguments) *)
       let func =
         {
-          E.func = FunId (Regular global.body_id);
+          E.func = FunId (FRegular global.body_id);
           generics = TypesUtils.mk_empty_generic_args;
           trait_and_method_generic_args = None;
         }
@@ -779,9 +778,8 @@ and eval_global (config : C.config) (dest : E.place) (gid : LA.GlobalDeclId.id)
   | SymbolicMode ->
       (* Generate a fresh symbolic value. In the translation, this fresh symbolic value will be
        * defined as equal to the value of the global (see {!S.synthesize_global_eval}). *)
-      let sval =
-        mk_fresh_symbolic_value V.Global (ety_no_regions_to_rty global.ty)
-      in
+      assert (ty_no_regions global.ty);
+      let sval = mk_fresh_symbolic_value V.Global global.ty in
       let cc =
         assign_to_place config (mk_typed_value_from_symbolic_value sval) dest
       in
@@ -810,7 +808,7 @@ and eval_switch (config : C.config) (switch : A.switch) : st_cm_fun =
         let cf_if (cf : st_m_fun) (op_v : V.typed_value) : m_fun =
          fun ctx ->
           match op_v.value with
-          | V.Literal (PV.Bool b) ->
+          | V.VLiteral (PV.VBool b) ->
               (* Evaluate the if and the branch body *)
               let cf_branch cf : m_fun =
                 (* Branch *)
@@ -838,7 +836,7 @@ and eval_switch (config : C.config) (switch : A.switch) : st_cm_fun =
         let cf_switch (cf : st_m_fun) (op_v : V.typed_value) : m_fun =
          fun ctx ->
           match op_v.value with
-          | V.Literal (PV.Scalar sv) ->
+          | V.VLiteral (PV.VScalar sv) ->
               (* Evaluate the branch *)
               let cf_eval_branch cf =
                 (* Sanity check *)
@@ -893,7 +891,7 @@ and eval_switch (config : C.config) (switch : A.switch) : st_cm_fun =
           let p_v = value_strip_shared_loans p_v in
           (* Match *)
           match p_v.value with
-          | V.Adt adt -> (
+          | V.VAdt adt -> (
               (* Evaluate the discriminant *)
               let dv = Option.get adt.variant_id in
               (* Find the branch, evaluate and continue *)
@@ -931,9 +929,9 @@ and eval_function_call_concrete (config : C.config) (call : A.call) : st_cm_fun
     =
  fun cf ctx ->
   match call.func.func with
-  | FunId (Regular fid) ->
+  | FunId (FRegular fid) ->
       eval_transparent_function_call_concrete config fid call cf ctx
-  | FunId (Assumed fid) ->
+  | FunId (FAssumed fid) ->
       (* Continue - note that we do as if the function call has been successful,
        * by giving {!Unit} to the continuation, because we place us in the case
        * where we haven't panicked. Of course, the translation needs to take the
@@ -944,9 +942,9 @@ and eval_function_call_concrete (config : C.config) (call : A.call) : st_cm_fun
 and eval_function_call_symbolic (config : C.config) (call : A.call) : st_cm_fun
     =
   match call.func.func with
-  | FunId (Regular _) | TraitMethod _ ->
+  | FunId (FRegular _) | TraitMethod _ ->
       eval_transparent_function_call_symbolic config call
-  | FunId (Assumed fid) -> eval_assumed_function_call_symbolic config fid call
+  | FunId (FAssumed fid) -> eval_assumed_function_call_symbolic config fid call
 
 (** Evaluate a local (i.e., non-assumed) function call in concrete mode *)
 and eval_transparent_function_call_concrete (config : C.config)
@@ -975,7 +973,7 @@ and eval_transparent_function_call_concrete (config : C.config)
     (* There shouldn't be any reference to Self *)
     let tr_self = T.UnknownTrait __FUNCTION__ in
     let subst =
-      Subst.make_esubst_from_generics def.A.signature.generics generics tr_self
+      Subst.make_subst_from_generics def.A.signature.generics generics tr_self
     in
     let locals, body_st = Subst.fun_body_substitute_in_body subst body in
 
@@ -1106,13 +1104,13 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
   *)
   let func, generics, def, inst_sg =
     match call.func.func with
-    | FunId (Regular fid) ->
+    | FunId (FRegular fid) ->
         let def = C.ctx_lookup_fun_decl ctx fid in
         log#ldebug
           (lazy
             ("fun call:\n- call: " ^ call_to_string ctx call
            ^ "\n- call.generics:\n"
-            ^ egeneric_args_to_string ctx call.func.generics
+            ^ PA.generic_args_to_string ctx call.func.generics
             ^ "\n- def.signature:\n"
             ^ fun_sig_to_string ctx def.A.signature));
         let tr_self = T.UnknownTrait __FUNCTION__ in
@@ -1120,7 +1118,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
           instantiate_fun_sig ctx call.func.generics tr_self def.A.signature
         in
         (call.func.func, call.func.generics, def, inst_sg)
-    | FunId (Assumed _) ->
+    | FunId (FAssumed _) ->
         (* Unreachable: must be a transparent function *)
         raise (Failure "Unreachable")
     | TraitMethod (trait_ref, method_name, _) -> (
@@ -1128,9 +1126,9 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
           (lazy
             ("trait method call:\n- call: " ^ call_to_string ctx call
            ^ "\n- method name: " ^ method_name ^ "\n- call.generics:\n"
-            ^ egeneric_args_to_string ctx call.func.generics
+            ^ PA.generic_args_to_string ctx call.func.generics
             ^ "\n- trait and method generics:\n"
-            ^ egeneric_args_to_string ctx
+            ^ PA.generic_args_to_string ctx
                 (Option.get call.func.trait_and_method_generic_args)));
         (* When instantiating, we need to group the generics for the trait ref
            and the method *)
@@ -1155,9 +1153,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
                 (* This is a required method *)
                 let method_def = C.ctx_lookup_fun_decl ctx id in
                 (* Instantiate *)
-                let tr_self =
-                  T.TraitRef (etrait_ref_no_regions_to_gr_trait_ref trait_ref)
-                in
+                let tr_self = T.TraitRef trait_ref in
                 let inst_sg =
                   instantiate_fun_sig ctx generics tr_self
                     method_def.A.signature
@@ -1168,7 +1164,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
                    which implements the method. In order to do this properly,
                    we also need to update the generics.
                 *)
-                let func = E.FunId (Regular id) in
+                let func = E.FunId (FRegular id) in
                 (func, generics, method_def, inst_sg)
             | None ->
                 (* If not found, lookup the methods provided by the trait *declaration*
@@ -1210,13 +1206,11 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
                   (lazy
                     ("provided method call:" ^ "\n- method name: " ^ method_name
                    ^ "\n- all_generics:\n"
-                    ^ egeneric_args_to_string ctx all_generics
+                    ^ PA.generic_args_to_string ctx all_generics
                     ^ "\n- parent params info: "
                     ^ Print.option_to_string A.show_params_info
                         method_def.signature.parent_params_info));
-                let tr_self =
-                  T.TraitRef (etrait_ref_no_regions_to_gr_trait_ref trait_ref)
-                in
+                let tr_self = T.TraitRef trait_ref in
                 let inst_sg =
                   instantiate_fun_sig ctx all_generics tr_self
                     method_def.A.signature
@@ -1243,10 +1237,6 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
             log#ldebug (lazy ("method:\n" ^ fun_decl_to_string ctx method_def));
             (* Instantiate *)
             let tr_self = T.TraitRef trait_ref in
-            let tr_self =
-              TypesUtils.etrait_instance_id_no_regions_to_gr_trait_instance_id
-                tr_self
-            in
             let inst_sg =
               instantiate_fun_sig ctx generics tr_self method_def.A.signature
             in
@@ -1271,7 +1261,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call)
  *)
 and eval_function_call_symbolic_from_inst_sig (config : C.config)
     (fid : A.fun_id_or_trait_method_ref) (inst_sg : A.inst_fun_sig)
-    (generics : T.egeneric_args) (args : E.operand list) (dest : E.place) :
+    (generics : T.generic_args) (args : E.operand list) (dest : E.place) :
     st_cm_fun =
  fun cf ctx ->
   log#ldebug
@@ -1281,7 +1271,7 @@ and eval_function_call_symbolic_from_inst_sig (config : C.config)
       ^ "\n- inst_sg:\n"
       ^ inst_fun_sig_to_string ctx inst_sg
       ^ "\n- call.generics:\n"
-      ^ egeneric_args_to_string ctx generics
+      ^ PA.generic_args_to_string ctx generics
       ^ "\n- args:\n"
       ^ String.concat ", " (List.map (operand_to_string ctx) args)
       ^ "\n- dest:\n" ^ place_to_string ctx dest));
@@ -1454,7 +1444,7 @@ and eval_assumed_function_call_symbolic (config : C.config)
       in
 
       (* Evaluate the function call *)
-      eval_function_call_symbolic_from_inst_sig config (FunId (Assumed fid))
+      eval_function_call_symbolic_from_inst_sig config (FunId (FAssumed fid))
         inst_sig generics args dest cf ctx
 
 (** Evaluate a statement seen as a function body *)
diff --git a/compiler/InterpreterUtils.ml b/compiler/InterpreterUtils.ml
index 6e08e553..6f62b577 100644
--- a/compiler/InterpreterUtils.ml
+++ b/compiler/InterpreterUtils.ml
@@ -31,8 +31,6 @@ let get_cf_ctx_no_synth (f : cm_fun) (ctx : C.eval_ctx) : C.eval_ctx =
 
 let eval_ctx_to_string_no_filter = Print.Contexts.eval_ctx_to_string_no_filter
 let eval_ctx_to_string = Print.Contexts.eval_ctx_to_string
-let ety_to_string = PA.ety_to_string
-let rty_to_string = PA.rty_to_string
 let symbolic_value_to_string = PA.symbolic_value_to_string
 let borrow_content_to_string = PA.borrow_content_to_string
 let loan_content_to_string = PA.loan_content_to_string
@@ -43,8 +41,6 @@ let typed_value_to_string = PA.typed_value_to_string
 let typed_avalue_to_string = PA.typed_avalue_to_string
 let place_to_string = PA.place_to_string
 let operand_to_string = PA.operand_to_string
-let egeneric_args_to_string = PA.egeneric_args_to_string
-let rtrait_instance_id_to_string = PA.rtrait_instance_id_to_string
 let fun_sig_to_string = PA.fun_sig_to_string
 let inst_fun_sig_to_string = PA.inst_fun_sig_to_string
 
@@ -66,8 +62,7 @@ let abs_to_string ctx = PA.abs_to_string ctx "" "  "
 let same_symbolic_id (sv0 : V.symbolic_value) (sv1 : V.symbolic_value) : bool =
   sv0.V.sv_id = sv1.V.sv_id
 
-let mk_var (index : E.VarId.id) (name : string option) (var_ty : T.ety) : A.var
-    =
+let mk_var (index : E.VarId.id) (name : string option) (var_ty : T.ty) : A.var =
   { A.index; name; var_ty }
 
 (** Small helper - TODO: move *)
@@ -75,25 +70,32 @@ let mk_place_from_var_id (var_id : E.VarId.id) : E.place =
   { var_id; projection = [] }
 
 (** Create a fresh symbolic value *)
-let mk_fresh_symbolic_value (sv_kind : V.sv_kind) (ty : T.rty) :
-    V.symbolic_value =
+let mk_fresh_symbolic_value (sv_kind : V.sv_kind) (ty : T.ty) : V.symbolic_value
+    =
+  (* Sanity check *)
+  assert (ty_is_rty ty);
   let sv_id = C.fresh_symbolic_value_id () in
   let svalue = { V.sv_kind; V.sv_id; V.sv_ty = ty } in
   svalue
 
+let mk_fresh_symbolic_value_from_no_regions_ty (sv_kind : V.sv_kind) (ty : T.ty)
+    : V.symbolic_value =
+  assert (ty_no_regions ty);
+  mk_fresh_symbolic_value sv_kind ty
+
 (** Create a fresh symbolic value *)
-let mk_fresh_symbolic_typed_value (sv_kind : V.sv_kind) (rty : T.rty) :
+let mk_fresh_symbolic_typed_value (sv_kind : V.sv_kind) (rty : T.ty) :
     V.typed_value =
+  assert (ty_is_rty rty);
   let ty = Subst.erase_regions rty in
   (* Generate the fresh a symbolic value *)
   let value = mk_fresh_symbolic_value sv_kind rty in
   let value = V.Symbolic value in
   { V.value; V.ty }
 
-(** Create a fresh symbolic value *)
-let mk_fresh_symbolic_typed_value_from_ety (sv_kind : V.sv_kind) (ety : T.ety) :
-    V.typed_value =
-  let ty = TypesUtils.ety_no_regions_to_rty ety in
+let mk_fresh_symbolic_typed_value_from_no_regions_ty (sv_kind : V.sv_kind)
+    (ty : T.ty) : V.typed_value =
+  assert (ty_no_regions ty);
   mk_fresh_symbolic_typed_value sv_kind ty
 
 (** Create a typed value from a symbolic value. *)
@@ -122,7 +124,8 @@ let mk_aproj_loans_value_from_symbolic_value (regions : T.RegionId.Set.t)
 
 (** Create a borrows projector from a symbolic value *)
 let mk_aproj_borrows_from_symbolic_value (proj_regions : T.RegionId.Set.t)
-    (svalue : V.symbolic_value) (proj_ty : T.rty) : V.aproj =
+    (svalue : V.symbolic_value) (proj_ty : T.ty) : V.aproj =
+  assert (ty_is_rty proj_ty);
   if ty_has_regions_in_set proj_regions proj_ty then
     V.AProjBorrows (svalue, proj_ty)
   else V.AIgnoredProjBorrows
@@ -193,7 +196,7 @@ exception FoundGBorrowContent of g_borrow_content
 exception FoundGLoanContent of g_loan_content
 
 (** Utility exception *)
-exception FoundAProjBorrows of V.symbolic_value * T.rty
+exception FoundAProjBorrows of V.symbolic_value * T.ty
 
 let symbolic_value_id_in_ctx (sv_id : V.SymbolicValueId.id) (ctx : C.eval_ctx) :
     bool =
@@ -235,7 +238,7 @@ let symbolic_value_id_in_ctx (sv_id : V.SymbolicValueId.id) (ctx : C.eval_ctx) :
 *)
 let symbolic_value_has_ended_regions (ended_regions : T.RegionId.Set.t)
     (s : V.symbolic_value) : bool =
-  let regions = rty_regions s.V.sv_ty in
+  let regions = ty_regions s.V.sv_ty in
   not (T.RegionId.Set.disjoint regions ended_regions)
 
 (** Check if a {!type:V.value} contains [⊥].
@@ -435,7 +438,7 @@ let initialize_eval_context (ctx : C.decls_ctx)
     T.ConstGenericVarId.Map.of_list
       (List.map
          (fun (cg : T.const_generic_var) ->
-           let ty = TypesUtils.ety_no_regions_to_rty (T.Literal cg.ty) in
+           let ty = T.TLiteral cg.ty in
            let cv = mk_fresh_symbolic_typed_value V.ConstGeneric ty in
            (cg.index, cv))
          const_generic_vars)
@@ -450,28 +453,27 @@ let initialize_eval_context (ctx : C.decls_ctx)
     C.type_vars;
     C.const_generic_vars;
     C.const_generic_vars_map;
-    C.norm_trait_etypes = C.ETraitTypeRefMap.empty (* Empty for now *);
-    C.norm_trait_rtypes = C.RTraitTypeRefMap.empty (* Empty for now *);
-    C.norm_trait_stypes = C.STraitTypeRefMap.empty (* Empty for now *);
-    C.env = [ C.Frame ];
+    C.norm_trait_types = C.TraitTypeRefMap.empty (* Empty for now *);
+    C.env = [ C.EFrame ];
     C.ended_regions = T.RegionId.Set.empty;
   }
 
 (** Instantiate a function signature, introducing **fresh** abstraction ids and
     region ids. This is mostly used in preparation of function calls (when
     evaluating in symbolic mode).
-
-    Note: there are no region parameters, because they should be erased.
  *)
-let instantiate_fun_sig (ctx : C.eval_ctx) (generics : T.egeneric_args)
-    (tr_self : T.rtrait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig =
+let instantiate_fun_sig (ctx : C.eval_ctx) (generics : T.generic_args)
+    (tr_self : T.trait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig =
   log#ldebug
     (lazy
       ("instantiate_fun_sig:" ^ "\n- generics: "
-      ^ egeneric_args_to_string ctx generics
+      ^ PA.generic_args_to_string ctx generics
       ^ "\n- tr_self: "
-      ^ rtrait_instance_id_to_string ctx tr_self
+      ^ PA.trait_instance_id_to_string ctx tr_self
       ^ "\n- sg: " ^ fun_sig_to_string ctx sg));
+  (* Erase the regions in the generics we use for the instantiation *)
+  let generics = Subst.generic_args_erase_regions generics in
+  let tr_self = Subst.trait_instance_id_erase_regions tr_self in
   (* Generate fresh abstraction ids and create a substitution from region
    * group ids to abstraction ids *)
   let rg_abs_ids_bindings =
@@ -492,29 +494,20 @@ let instantiate_fun_sig (ctx : C.eval_ctx) (generics : T.egeneric_args)
   (* Generate fresh regions and their substitutions *)
   let _, rsubst, _ = Subst.fresh_regions_with_substs sg.generics.regions in
   (* Generate the type substitution
-   * Note that we need the substitution to map the type variables to
-   * {!rty} types (not {!ety}). In order to do that, we convert the
-   * type parameters to types with regions. This is possible only
-   * if those types don't contain any regions.
-   * This is a current limitation of the analysis: there is still some
-   * work to do to properly handle full type parametrization.
-   * *)
-  let rtype_params = List.map ety_no_regions_to_rty generics.types in
-  let tsubst = Subst.make_type_subst_from_vars sg.generics.types rtype_params in
+     Note that for now we don't support instantiating the type parameters with
+     types containing regions. *)
+  assert (List.for_all TypesUtils.ty_no_regions generics.types);
+  assert (TypesUtils.trait_instance_id_no_regions tr_self);
+  let tsubst =
+    Subst.make_type_subst_from_vars sg.generics.types generics.types
+  in
   let cgsubst =
     Subst.make_const_generic_subst_from_vars sg.generics.const_generics
       generics.const_generics
   in
-  (* TODO: something annoying with the trait ref subst: we need to use region
-     types, but the arguments use erased regions. For now we use the fact
-     that no regions should appear inside. In the future: we should merge
-     ety and rty. *)
-  let trait_refs =
-    List.map TypesUtils.etrait_ref_no_regions_to_gr_trait_ref
-      generics.trait_refs
-  in
   let tr_subst =
-    Subst.make_trait_subst_from_clauses sg.generics.trait_clauses trait_refs
+    Subst.make_trait_subst_from_clauses sg.generics.trait_clauses
+      generics.trait_refs
   in
   (* Substitute the signature *)
   let inst_sig =
diff --git a/compiler/Invariants.ml b/compiler/Invariants.ml
index 5c8ec7af..01de6fd0 100644
--- a/compiler/Invariants.ml
+++ b/compiler/Invariants.ml
@@ -138,13 +138,13 @@ let check_loans_borrows_relation_invariant (ctx : C.eval_ctx) : unit =
     object
       inherit [_] C.iter_eval_ctx as super
 
-      method! visit_Var _ binder v =
+      method! visit_EBinding _ binder v =
         let inside_abs = false in
-        super#visit_Var inside_abs binder v
+        super#visit_EBinding inside_abs binder v
 
-      method! visit_Abs _ abs =
+      method! visit_EAbs _ abs =
         let inside_abs = true in
-        super#visit_Abs inside_abs abs
+        super#visit_EAbs inside_abs abs
 
       method! visit_loan_content inside_abs lc =
         (* Register the loan *)
@@ -380,8 +380,8 @@ let check_borrowed_values_invariant (ctx : C.eval_ctx) : unit =
 
 let check_literal_type (cv : V.literal) (ty : PV.literal_type) : unit =
   match (cv, ty) with
-  | PV.Scalar sv, PV.Integer int_ty -> assert (sv.int_ty = int_ty)
-  | PV.Bool _, PV.Bool | PV.Char _, PV.Char -> ()
+  | PV.VScalar sv, PV.TInteger int_ty -> assert (sv.int_ty = int_ty)
+  | PV.VBool _, PV.TBool | PV.VChar _, PV.TChar -> ()
   | _ -> raise (Failure "Erroneous typing")
 
 let check_typing_invariant (ctx : C.eval_ctx) : unit =
@@ -389,10 +389,10 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
    * of the shape [& (mut) T] where they should have type [T]...
    * This messes a bit the type invariant checks when checking the
    * children. In order to isolate the problem (for future modifications)
-   * we introduce function, so that we can easily spot all the involved
+   * we introduce this function, so that we can easily spot all the involved
    * places.
    * *)
-  let aloan_get_expected_child_type (ty : 'r T.ty) : 'r T.ty =
+  let aloan_get_expected_child_type (ty : T.ty) : T.ty =
     let _, ty, _ = ty_get_ref ty in
     ty
   in
@@ -402,12 +402,24 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
       inherit [_] C.iter_eval_ctx as super
       method! visit_abs _ abs = super#visit_abs (Some abs) abs
 
+      method! visit_EBinding info binder v =
+        (* We also check that the regions are erased *)
+        assert (ty_is_ety v.ty);
+        super#visit_EBinding info binder v
+
+      method! visit_symbolic_value inside_abs v =
+        (* Check that the types have regions *)
+        assert (ty_is_rty v.sv_ty);
+        super#visit_symbolic_value inside_abs v
+
       method! visit_typed_value info tv =
+        (* Check that the types have erased regions *)
+        assert (ty_is_ety tv.ty);
         (* Check the current pair (value, type) *)
         (match (tv.V.value, tv.V.ty) with
-        | V.Literal cv, T.Literal ty -> check_literal_type cv ty
+        | V.VLiteral cv, T.TLiteral ty -> check_literal_type cv ty
         (* ADT case *)
-        | V.Adt av, T.Adt (T.AdtId def_id, generics) ->
+        | V.VAdt av, T.TAdt (T.AdtId def_id, generics) ->
             (* Retrieve the definition to check the variant id, the number of
              * parameters, etc. *)
             let def = C.ctx_lookup_type_decl ctx def_id in
@@ -430,10 +442,10 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
               List.combine av.V.field_values field_types
             in
             List.iter
-              (fun ((v, ty) : V.typed_value * T.ety) -> assert (v.V.ty = ty))
+              (fun ((v, ty) : V.typed_value * T.ty) -> assert (v.V.ty = ty))
               fields_with_types
         (* Tuple case *)
-        | V.Adt av, T.Adt (T.Tuple, generics) ->
+        | V.VAdt av, T.TAdt (T.Tuple, generics) ->
             assert (generics.regions = []);
             assert (generics.const_generics = []);
             assert (av.V.variant_id = None);
@@ -443,10 +455,10 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
               List.combine av.V.field_values generics.types
             in
             List.iter
-              (fun ((v, ty) : V.typed_value * T.ety) -> assert (v.V.ty = ty))
+              (fun ((v, ty) : V.typed_value * T.ty) -> assert (v.V.ty = ty))
               fields_with_types
         (* Assumed type case *)
-        | V.Adt av, T.Adt (T.Assumed aty_id, generics) -> (
+        | V.VAdt av, T.TAdt (T.TAssumed aty_id, generics) -> (
             assert (av.V.variant_id = None);
             match
               ( aty_id,
@@ -456,9 +468,9 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
                 generics.const_generics )
             with
             (* Box *)
-            | T.Box, [ inner_value ], [], [ inner_ty ], [] ->
+            | T.TBox, [ inner_value ], [], [ inner_ty ], [] ->
                 assert (inner_value.V.ty = inner_ty)
-            | T.Array, inner_values, _, [ inner_ty ], [ cg ] ->
+            | T.TArray, inner_values, _, [ inner_ty ], [ cg ] ->
                 (* *)
                 assert (
                   List.for_all
@@ -471,7 +483,7 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
                     .value
                 in
                 assert (Z.of_int (List.length inner_values) = len)
-            | (T.Slice | T.Str), _, _, _, _ -> raise (Failure "Unexpected")
+            | (T.TSlice | T.TStr), _, _, _, _ -> raise (Failure "Unexpected")
             | _ -> raise (Failure "Erroneous type"))
         | V.Bottom, _ -> (* Nothing to check *) ()
         | V.Borrow bc, T.Ref (_, ref_ty, rkind) -> (
@@ -516,10 +528,12 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
        * so the cost of maintenance should be pretty low.
        * *)
       method! visit_typed_avalue info atv =
+        (* Check that the types have regions *)
+        assert (ty_is_rty atv.ty);
         (* Check the current pair (value, type) *)
         (match (atv.V.value, atv.V.ty) with
         (* ADT case *)
-        | V.AAdt av, T.Adt (T.AdtId def_id, generics) ->
+        | V.AAdt av, T.TAdt (T.AdtId def_id, generics) ->
             (* Retrieve the definition to check the variant id, the number of
              * parameters, etc. *)
             let def = C.ctx_lookup_type_decl ctx def_id in
@@ -545,10 +559,10 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
               List.combine av.V.field_values field_types
             in
             List.iter
-              (fun ((v, ty) : V.typed_avalue * T.rty) -> assert (v.V.ty = ty))
+              (fun ((v, ty) : V.typed_avalue * T.ty) -> assert (v.V.ty = ty))
               fields_with_types
         (* Tuple case *)
-        | V.AAdt av, T.Adt (T.Tuple, generics) ->
+        | V.AAdt av, T.TAdt (T.Tuple, generics) ->
             assert (generics.regions = []);
             assert (generics.const_generics = []);
             assert (av.V.variant_id = None);
@@ -558,10 +572,10 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
               List.combine av.V.field_values generics.types
             in
             List.iter
-              (fun ((v, ty) : V.typed_avalue * T.rty) -> assert (v.V.ty = ty))
+              (fun ((v, ty) : V.typed_avalue * T.ty) -> assert (v.V.ty = ty))
               fields_with_types
         (* Assumed type case *)
-        | V.AAdt av, T.Adt (T.Assumed aty_id, generics) -> (
+        | V.AAdt av, T.TAdt (T.TAssumed aty_id, generics) -> (
             assert (av.V.variant_id = None);
             match
               ( aty_id,
@@ -571,7 +585,7 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
                 generics.const_generics )
             with
             (* Box *)
-            | T.Box, [ boxed_value ], [], [ boxed_ty ], [] ->
+            | T.TBox, [ boxed_value ], [], [ boxed_ty ], [] ->
                 assert (boxed_value.V.ty = boxed_ty)
             | _ -> raise (Failure "Erroneous type"))
         | V.ABottom, _ -> (* Nothing to check *) ()
@@ -663,7 +677,8 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
                 ("Erroneous typing:" ^ "\n- raw value: "
                ^ V.show_typed_avalue atv ^ "\n- value: "
                 ^ typed_avalue_to_string ctx atv
-                ^ "\n- type: " ^ rty_to_string ctx atv.V.ty));
+                ^ "\n- type: "
+                ^ PA.ty_to_string ctx atv.V.ty));
             raise (Failure "Erroneous typing"));
         (* Continue exploring to inspect the subterms *)
         super#visit_typed_avalue info atv
@@ -674,7 +689,7 @@ let check_typing_invariant (ctx : C.eval_ctx) : unit =
 type proj_borrows_info = {
   abs_id : V.AbstractionId.id;
   regions : T.RegionId.Set.t;
-  proj_ty : T.rty;
+  proj_ty : T.rty;  (** The regions shouldn't be erased *)
   as_shared_value : bool;  (** True if the value is below a shared borrow *)
 }
 [@@deriving show]
@@ -686,7 +701,7 @@ type proj_loans_info = {
 [@@deriving show]
 
 type sv_info = {
-  ty : T.rty;
+  ty : T.rty;  (** The regions shouldn't be erased *)
   env_count : int;
   aproj_borrows : proj_borrows_info list;
   aproj_loans : proj_loans_info list;
diff --git a/compiler/LlbcAst.ml b/compiler/LlbcAst.ml
index 2db859b2..9772671e 100644
--- a/compiler/LlbcAst.ml
+++ b/compiler/LlbcAst.ml
@@ -2,16 +2,13 @@ open Types
 open Values
 include Charon.LlbcAst
 
-type abs_region_group = (AbstractionId.id, RegionId.id) g_region_group
-[@@deriving show]
-
-type abs_region_groups = (AbstractionId.id, RegionId.id) g_region_groups
-[@@deriving show]
+type abs_region_group = AbstractionId.id g_region_group [@@deriving show]
+type abs_region_groups = abs_region_group list [@@deriving show]
 
 (** A function signature, after instantiation *)
 type inst_fun_sig = {
   regions_hierarchy : abs_region_groups;
-  trait_type_constraints : rtrait_type_constraint list;
+  trait_type_constraints : trait_type_constraint list;
   inputs : rty list;
   output : rty;
 }
diff --git a/compiler/LlbcAstUtils.ml b/compiler/LlbcAstUtils.ml
index 0ab4ed94..46b36851 100644
--- a/compiler/LlbcAstUtils.ml
+++ b/compiler/LlbcAstUtils.ml
@@ -4,14 +4,14 @@ include Charon.LlbcAstUtils
 let lookup_fun_sig (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
     fun_sig =
   match fun_id with
-  | Regular id -> (FunDeclId.Map.find id fun_decls).signature
-  | Assumed aid -> Assumed.get_assumed_fun_sig aid
+  | FRegular id -> (FunDeclId.Map.find id fun_decls).signature
+  | FAssumed aid -> Assumed.get_assumed_fun_sig aid
 
 let lookup_fun_name (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
     Names.fun_name =
   match fun_id with
-  | Regular id -> (FunDeclId.Map.find id fun_decls).name
-  | Assumed aid -> Assumed.get_assumed_fun_name aid
+  | FRegular id -> (FunDeclId.Map.find id fun_decls).name
+  | FAssumed aid -> Assumed.get_assumed_fun_name aid
 
 (** Return the opaque declarations found in the crate, which are also *not builtin*.
 
diff --git a/compiler/Print.ml b/compiler/Print.ml
index 7f0d95ff..dd24767e 100644
--- a/compiler/Print.ml
+++ b/compiler/Print.ml
@@ -15,8 +15,7 @@ let bool_to_string (b : bool) : string = if b then "true" else "false"
 (** Pretty-printing for values *)
 module Values = struct
   type value_formatter = {
-    rvar_to_string : T.RegionVarId.id -> string;
-    r_to_string : T.RegionId.id -> string;
+    region_id_to_string : T.RegionId.id -> string;
     type_var_id_to_string : T.TypeVarId.id -> string;
     type_decl_id_to_string : T.TypeDeclId.id -> string;
     const_generic_var_id_to_string : T.ConstGenericVarId.id -> string;
@@ -30,33 +29,9 @@ module Values = struct
       T.TypeDeclId.id -> T.VariantId.id option -> string list option;
   }
 
-  let value_to_etype_formatter (fmt : value_formatter) : PT.etype_formatter =
+  let value_to_type_formatter (fmt : value_formatter) : PT.type_formatter =
     {
-      PT.r_to_string = PT.erased_region_to_string;
-      PT.type_var_id_to_string = fmt.type_var_id_to_string;
-      PT.type_decl_id_to_string = fmt.type_decl_id_to_string;
-      PT.const_generic_var_id_to_string = fmt.const_generic_var_id_to_string;
-      PT.global_decl_id_to_string = fmt.global_decl_id_to_string;
-      PT.trait_decl_id_to_string = fmt.trait_decl_id_to_string;
-      PT.trait_impl_id_to_string = fmt.trait_impl_id_to_string;
-      PT.trait_clause_id_to_string = fmt.trait_clause_id_to_string;
-    }
-
-  let value_to_rtype_formatter (fmt : value_formatter) : PT.rtype_formatter =
-    {
-      PT.r_to_string = PT.region_to_string fmt.r_to_string;
-      PT.type_var_id_to_string = fmt.type_var_id_to_string;
-      PT.type_decl_id_to_string = fmt.type_decl_id_to_string;
-      PT.const_generic_var_id_to_string = fmt.const_generic_var_id_to_string;
-      PT.global_decl_id_to_string = fmt.global_decl_id_to_string;
-      PT.trait_decl_id_to_string = fmt.trait_decl_id_to_string;
-      PT.trait_impl_id_to_string = fmt.trait_impl_id_to_string;
-      PT.trait_clause_id_to_string = fmt.trait_clause_id_to_string;
-    }
-
-  let value_to_stype_formatter (fmt : value_formatter) : PT.stype_formatter =
-    {
-      PT.r_to_string = PT.region_to_string fmt.rvar_to_string;
+      PT.region_id_to_string = fmt.region_id_to_string;
       PT.type_var_id_to_string = fmt.type_var_id_to_string;
       PT.type_decl_id_to_string = fmt.type_decl_id_to_string;
       PT.const_generic_var_id_to_string = fmt.const_generic_var_id_to_string;
@@ -72,17 +47,17 @@ module Values = struct
   let symbolic_value_id_to_string (id : V.SymbolicValueId.id) : string =
     "s@" ^ V.SymbolicValueId.to_string id
 
-  let symbolic_value_to_string (fmt : PT.rtype_formatter)
-      (sv : V.symbolic_value) : string =
-    symbolic_value_id_to_string sv.sv_id ^ " : " ^ PT.rty_to_string fmt sv.sv_ty
+  let symbolic_value_to_string (fmt : PT.type_formatter) (sv : V.symbolic_value)
+      : string =
+    symbolic_value_id_to_string sv.sv_id ^ " : " ^ PT.ty_to_string fmt sv.sv_ty
 
   let symbolic_value_proj_to_string (fmt : value_formatter)
-      (sv : V.symbolic_value) (rty : T.rty) : string =
+      (sv : V.symbolic_value) (rty : T.ty) : string =
+    let ty_fmt = value_to_type_formatter fmt in
     symbolic_value_id_to_string sv.sv_id
     ^ " : "
-    ^ PT.ty_to_string (value_to_rtype_formatter fmt) sv.sv_ty
-    ^ " <: "
-    ^ PT.ty_to_string (value_to_rtype_formatter fmt) rty
+    ^ PT.ty_to_string ty_fmt sv.sv_ty
+    ^ " <: " ^ PT.ty_to_string ty_fmt rty
 
   (* TODO: it may be a good idea to try to factorize this function with
    * typed_avalue_to_string. At some point we had done it, because [typed_value]
@@ -90,18 +65,18 @@ module Values = struct
    * but then we removed this general type because it proved to be a bad idea. *)
   let rec typed_value_to_string (fmt : value_formatter) (v : V.typed_value) :
       string =
-    let ty_fmt : PT.etype_formatter = value_to_etype_formatter fmt in
+    let ty_fmt : PT.type_formatter = value_to_type_formatter fmt in
     match v.value with
-    | Literal cv -> PPV.literal_to_string cv
-    | Adt av -> (
+    | VLiteral cv -> PPV.literal_to_string cv
+    | VAdt av -> (
         let field_values =
           List.map (typed_value_to_string fmt) av.field_values
         in
         match v.ty with
-        | T.Adt (T.Tuple, _) ->
+        | T.TAdt (T.Tuple, _) ->
             (* Tuple *)
             "(" ^ String.concat ", " field_values ^ ")"
-        | T.Adt (T.AdtId def_id, _) ->
+        | T.TAdt (T.AdtId def_id, _) ->
             (* "Regular" ADT *)
             let adt_ident =
               match av.variant_id with
@@ -123,11 +98,11 @@ module Values = struct
                   let field_values = String.concat " " field_values in
                   adt_ident ^ " { " ^ field_values ^ " }"
             else adt_ident
-        | T.Adt (T.Assumed aty, _) -> (
+        | T.TAdt (T.TAssumed aty, _) -> (
             (* Assumed type *)
             match (aty, field_values) with
-            | Box, [ bv ] -> "@Box(" ^ bv ^ ")"
-            | Array, _ ->
+            | TBox, [ bv ] -> "@Box(" ^ bv ^ ")"
+            | TArray, _ ->
                 (* Happens when we aggregate values *)
                 "@Array[" ^ String.concat ", " field_values ^ "]"
             | _ ->
@@ -136,7 +111,7 @@ module Values = struct
     | Bottom -> "⊥ : " ^ PT.ty_to_string ty_fmt v.ty
     | Borrow bc -> borrow_content_to_string fmt bc
     | Loan lc -> loan_content_to_string fmt lc
-    | Symbolic s -> symbolic_value_to_string (value_to_rtype_formatter fmt) s
+    | Symbolic s -> symbolic_value_to_string ty_fmt s
 
   and borrow_content_to_string (fmt : value_formatter) (bc : V.borrow_content) :
       string =
@@ -180,7 +155,7 @@ module Values = struct
             " (" ^ String.concat "," given_back ^ ") "
         in
         "⌊"
-        ^ symbolic_value_to_string (value_to_rtype_formatter fmt) sv
+        ^ symbolic_value_to_string (value_to_type_formatter fmt) sv
         ^ given_back ^ "⌋"
     | AProjBorrows (sv, rty) ->
         "(" ^ symbolic_value_proj_to_string fmt sv rty ^ ")"
@@ -195,17 +170,17 @@ module Values = struct
 
   let rec typed_avalue_to_string (fmt : value_formatter) (v : V.typed_avalue) :
       string =
-    let ty_fmt : PT.rtype_formatter = value_to_rtype_formatter fmt in
+    let ty_fmt : PT.type_formatter = value_to_type_formatter fmt in
     match v.value with
     | AAdt av -> (
         let field_values =
           List.map (typed_avalue_to_string fmt) av.field_values
         in
         match v.ty with
-        | T.Adt (T.Tuple, _) ->
+        | T.TAdt (T.Tuple, _) ->
             (* Tuple *)
             "(" ^ String.concat ", " field_values ^ ")"
-        | T.Adt (T.AdtId def_id, _) ->
+        | T.TAdt (T.AdtId def_id, _) ->
             (* "Regular" ADT *)
             let adt_ident =
               match av.variant_id with
@@ -227,10 +202,10 @@ module Values = struct
                   let field_values = String.concat " " field_values in
                   adt_ident ^ " { " ^ field_values ^ " }"
             else adt_ident
-        | T.Adt (T.Assumed aty, _) -> (
+        | T.TAdt (T.TAssumed aty, _) -> (
             (* Assumed type *)
             match (aty, field_values) with
-            | Box, [ bv ] -> "@Box(" ^ bv ^ ")"
+            | TBox, [ bv ] -> "@Box(" ^ bv ^ ")"
             | _ -> raise (Failure "Inconsistent value"))
         | _ -> raise (Failure "Inconsistent typed value"))
     | ABottom -> "⊥ : " ^ PT.ty_to_string ty_fmt v.ty
@@ -352,7 +327,7 @@ module Values = struct
   let inst_fun_sig_to_string (fmt : value_formatter) (sg : LlbcAst.inst_fun_sig)
       : string =
     (* TODO: print the trait type constraints? *)
-    let ty_fmt = value_to_rtype_formatter fmt in
+    let ty_fmt = value_to_type_formatter fmt in
     let ty_to_string = PT.ty_to_string ty_fmt in
 
     let inputs =
@@ -376,23 +351,23 @@ module Contexts = struct
 
   let binder_to_string (bv : C.binder) : string =
     match bv with
-    | VarBinder b -> var_binder_to_string b
-    | DummyBinder bid -> dummy_var_id_to_string bid
+    | BVar b -> var_binder_to_string b
+    | BDummy bid -> dummy_var_id_to_string bid
 
   let env_elem_to_string (fmt : PV.value_formatter) (verbose : bool)
       (with_var_types : bool) (indent : string) (indent_incr : string)
       (ev : C.env_elem) : string =
     match ev with
-    | Var (var, tv) ->
+    | EBinding (var, tv) ->
         let bv = binder_to_string var in
         let ty =
           if with_var_types then
-            " : " ^ PT.ty_to_string (PV.value_to_etype_formatter fmt) tv.V.ty
+            " : " ^ PT.ty_to_string (PV.value_to_type_formatter fmt) tv.V.ty
           else ""
         in
         indent ^ bv ^ ty ^ " -> " ^ PV.typed_value_to_string fmt tv ^ " ;"
-    | Abs abs -> PV.abs_to_string fmt verbose indent indent_incr abs
-    | Frame -> raise (Failure "Can't print a Frame element")
+    | EAbs abs -> PV.abs_to_string fmt verbose indent indent_incr abs
+    | EFrame -> raise (Failure "Can't print a Frame element")
 
   let opt_env_elem_to_string (fmt : PV.value_formatter) (verbose : bool)
       (with_var_types : bool) (indent : string) (indent_incr : string)
@@ -413,10 +388,10 @@ module Contexts = struct
      *)
     let filter_elem (ev : C.env_elem) : C.env_elem option =
       match ev with
-      | Var (VarBinder _, tv) ->
+      | EBinding (BVar _, tv) ->
           (* Not a dummy binding: check if the value is ⊥ *)
           if VU.is_bottom tv.value then None else Some ev
-      | Var (DummyBinder _, tv) ->
+      | EBinding (BDummy _, tv) ->
           (* Dummy binding: check if the value contains borrows or loans *)
           if VU.borrows_in_value tv || VU.loans_in_value tv then Some ev
           else None
@@ -456,8 +431,7 @@ module Contexts = struct
 
   let ast_to_ctx_formatter (fmt : PA.ast_formatter) : ctx_formatter =
     {
-      PV.rvar_to_string = fmt.rvar_to_string;
-      PV.r_to_string = fmt.r_to_string;
+      PV.region_id_to_string = fmt.region_id_to_string;
       PV.type_var_id_to_string = fmt.type_var_id_to_string;
       PV.type_decl_id_to_string = fmt.type_decl_id_to_string;
       PV.const_generic_var_id_to_string = fmt.const_generic_var_id_to_string;
@@ -473,22 +447,11 @@ module Contexts = struct
   let ast_to_value_formatter (fmt : PA.ast_formatter) : PV.value_formatter =
     ast_to_ctx_formatter fmt
 
-  let ctx_to_etype_formatter (fmt : ctx_formatter) : PT.etype_formatter =
-    PV.value_to_etype_formatter fmt
-
-  let ctx_to_rtype_formatter (fmt : ctx_formatter) : PT.rtype_formatter =
-    PV.value_to_rtype_formatter fmt
-
-  let ctx_to_stype_formatter (fmt : ctx_formatter) : PT.stype_formatter =
-    PV.value_to_stype_formatter fmt
+  let ctx_to_type_formatter (fmt : ctx_formatter) : PT.type_formatter =
+    PV.value_to_type_formatter fmt
 
   let eval_ctx_to_ctx_formatter (ctx : C.eval_ctx) : ctx_formatter =
-    let rvar_to_string r =
-      (* In theory we shouldn't use rvar_to_string, but it can happen
-         when printing definitions for instance... *)
-      T.RegionVarId.to_string r
-    in
-    let r_to_string r = PT.region_id_to_string r in
+    let region_id_to_string r = PT.region_id_to_string r in
 
     let type_var_id_to_string vid =
       (* The context may be invalid *)
@@ -529,8 +492,7 @@ module Contexts = struct
       PT.type_ctx_to_adt_field_names_fun ctx.type_context.type_decls
     in
     {
-      rvar_to_string;
-      r_to_string;
+      region_id_to_string;
       type_var_id_to_string;
       type_decl_id_to_string;
       const_generic_var_id_to_string;
@@ -566,8 +528,7 @@ module Contexts = struct
     in
     let trait_clause_id_to_string id = PT.trait_clause_id_to_pretty_string id in
     {
-      rvar_to_string = ctx_fmt.PV.rvar_to_string;
-      r_to_string = ctx_fmt.PV.r_to_string;
+      region_id_to_string = ctx_fmt.PV.region_id_to_string;
       type_var_id_to_string = ctx_fmt.PV.type_var_id_to_string;
       type_decl_id_to_string = ctx_fmt.PV.type_decl_id_to_string;
       const_generic_var_id_to_string = ctx_fmt.PV.const_generic_var_id_to_string;
@@ -593,7 +554,7 @@ module Contexts = struct
       match env with
       | [] ->
           if List.length curr_frame > 0 then curr_frame :: frames else frames
-      | Frame :: env' -> split_aux (curr_frame :: frames) [] env'
+      | EFrame :: env' -> split_aux (curr_frame :: frames) [] env'
       | ev :: env' -> split_aux frames (ev :: curr_frame) env'
     in
     let frames = split_aux [] [] env in
@@ -613,9 +574,9 @@ module Contexts = struct
           List.iter
             (fun ev ->
               match ev with
-              | C.Var (DummyBinder _, _) -> num_dummies := !num_abs + 1
-              | C.Var (VarBinder _, _) -> num_bindings := !num_bindings + 1
-              | C.Abs _ -> num_abs := !num_abs + 1
+              | C.EBinding (BDummy _, _) -> num_dummies := !num_abs + 1
+              | C.EBinding (BVar _, _) -> num_bindings := !num_bindings + 1
+              | C.EAbs _ -> num_abs := !num_abs + 1
               | _ -> raise (Failure "Unreachable"))
             f;
           "\n# Frame " ^ string_of_int i ^ ":" ^ "\n- locals: "
@@ -645,77 +606,32 @@ module PC = Contexts (* local module *)
 
 (** Pretty-printing for LLBC ASTs (functions based on an evaluation context) *)
 module EvalCtxLlbcAst = struct
-  let ety_to_string (ctx : C.eval_ctx) (t : T.ety) : string =
+  let ty_to_string (ctx : C.eval_ctx) (t : T.ty) : string =
     let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_etype_formatter fmt in
-    PT.ety_to_string fmt t
-
-  let rty_to_string (ctx : C.eval_ctx) (t : T.rty) : string =
-    let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_rtype_formatter fmt in
-    PT.rty_to_string fmt t
-
-  let sty_to_string (ctx : C.eval_ctx) (t : T.sty) : string =
-    let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_stype_formatter fmt in
-    PT.sty_to_string fmt t
+    let fmt = PC.ctx_to_type_formatter fmt in
+    PT.ty_to_string fmt t
 
   let generic_params_to_strings (ctx : C.eval_ctx) (x : T.generic_params) :
       string list * string list =
     let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_stype_formatter fmt in
+    let fmt = PC.ctx_to_type_formatter fmt in
     PT.generic_params_to_strings fmt x
 
-  let egeneric_args_to_string (ctx : C.eval_ctx) (x : T.egeneric_args) : string
-      =
-    let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_etype_formatter fmt in
-    PT.egeneric_args_to_string fmt x
-
-  let rgeneric_args_to_string (ctx : C.eval_ctx) (x : T.rgeneric_args) : string
-      =
-    let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_rtype_formatter fmt in
-    PT.rgeneric_args_to_string fmt x
-
-  let sgeneric_args_to_string (ctx : C.eval_ctx) (x : T.sgeneric_args) : string
-      =
+  let generic_args_to_string (ctx : C.eval_ctx) (x : T.generic_args) : string =
     let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_stype_formatter fmt in
-    PT.sgeneric_args_to_string fmt x
+    let fmt = PC.ctx_to_type_formatter fmt in
+    PT.generic_args_to_string fmt x
 
-  let etrait_ref_to_string (ctx : C.eval_ctx) (x : T.etrait_ref) : string =
+  let trait_ref_to_string (ctx : C.eval_ctx) (x : T.trait_ref) : string =
     let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_etype_formatter fmt in
-    PT.etrait_ref_to_string fmt x
+    let fmt = PC.ctx_to_type_formatter fmt in
+    PT.trait_ref_to_string fmt x
 
-  let rtrait_ref_to_string (ctx : C.eval_ctx) (x : T.rtrait_ref) : string =
-    let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_rtype_formatter fmt in
-    PT.rtrait_ref_to_string fmt x
-
-  let strait_ref_to_string (ctx : C.eval_ctx) (x : T.strait_ref) : string =
-    let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_stype_formatter fmt in
-    PT.strait_ref_to_string fmt x
-
-  let etrait_instance_id_to_string (ctx : C.eval_ctx) (x : T.etrait_instance_id)
-      : string =
-    let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_etype_formatter fmt in
-    PT.etrait_instance_id_to_string fmt x
-
-  let rtrait_instance_id_to_string (ctx : C.eval_ctx) (x : T.rtrait_instance_id)
-      : string =
-    let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_rtype_formatter fmt in
-    PT.rtrait_instance_id_to_string fmt x
-
-  let strait_instance_id_to_string (ctx : C.eval_ctx) (x : T.strait_instance_id)
-      : string =
+  let trait_instance_id_to_string (ctx : C.eval_ctx) (x : T.trait_instance_id) :
+      string =
     let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_stype_formatter fmt in
-    PT.strait_instance_id_to_string fmt x
+    let fmt = PC.ctx_to_type_formatter fmt in
+    PT.trait_instance_id_to_string fmt x
 
   let borrow_content_to_string (ctx : C.eval_ctx) (bc : V.borrow_content) :
       string =
@@ -743,7 +659,7 @@ module EvalCtxLlbcAst = struct
   let symbolic_value_to_string (ctx : C.eval_ctx) (sv : V.symbolic_value) :
       string =
     let fmt = PC.eval_ctx_to_ctx_formatter ctx in
-    let fmt = PC.ctx_to_rtype_formatter fmt in
+    let fmt = PC.ctx_to_type_formatter fmt in
     PV.symbolic_value_to_string fmt sv
 
   let typed_value_to_string (ctx : C.eval_ctx) (v : V.typed_value) : string =
diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml
index ec75fcfd..cd156215 100644
--- a/compiler/PrintPure.ml
+++ b/compiler/PrintPure.ml
@@ -205,7 +205,7 @@ let type_id_to_string (fmt : type_formatter) (id : type_id) : string =
   match id with
   | AdtId id -> fmt.type_decl_id_to_string id
   | Tuple -> ""
-  | Assumed aty -> assumed_ty_to_string aty
+  | TAssumed aty -> assumed_ty_to_string aty
 
 (* TODO: duplicates  Charon.PrintTypes.const_generic_to_string *)
 let const_generic_to_string (fmt : type_formatter) (cg : T.const_generic) :
@@ -217,12 +217,12 @@ let const_generic_to_string (fmt : type_formatter) (cg : T.const_generic) :
 
 let rec ty_to_string (fmt : type_formatter) (inside : bool) (ty : ty) : string =
   match ty with
-  | Adt (id, generics) -> (
+  | TAdt (id, generics) -> (
       match id with
       | Tuple ->
           let generics = generic_args_to_strings fmt false generics in
           "(" ^ String.concat " * " generics ^ ")"
-      | AdtId _ | Assumed _ ->
+      | AdtId _ | TAssumed _ ->
           let generics = generic_args_to_strings fmt true generics in
           let generics_s =
             if generics = [] then "" else " " ^ String.concat " " generics
@@ -230,7 +230,7 @@ let rec ty_to_string (fmt : type_formatter) (inside : bool) (ty : ty) : string =
           let ty_s = type_id_to_string fmt id ^ generics_s in
           if generics <> [] && inside then "(" ^ ty_s ^ ")" else ty_s)
   | TypeVar tv -> fmt.type_var_id_to_string tv
-  | Literal lty -> literal_type_to_string lty
+  | TLiteral lty -> literal_type_to_string lty
   | Arrow (arg_ty, ret_ty) ->
       let ty =
         ty_to_string fmt true arg_ty ^ " -> " ^ ty_to_string fmt false ret_ty
@@ -384,7 +384,7 @@ let adt_variant_to_string (fmt : value_formatter) (adt_id : type_id)
       match variant_id with
       | Some vid -> fmt.adt_variant_to_string def_id vid
       | None -> fmt.type_decl_id_to_string def_id)
-  | Assumed aty -> (
+  | TAssumed aty -> (
       (* Assumed type *)
       match aty with
       | State | Array | Slice | Str | RawPtr _ ->
@@ -419,7 +419,7 @@ let adt_field_to_string (fmt : value_formatter) (adt_id : type_id)
       match fields with
       | None -> FieldId.to_string field_id
       | Some fields -> FieldId.nth fields field_id)
-  | Assumed aty -> (
+  | TAssumed aty -> (
       (* Assumed type *)
       match aty with
       | State | Fuel | Array | Slice | Str ->
@@ -437,10 +437,10 @@ let adt_g_value_to_string (fmt : value_formatter)
     (field_values : 'v list) (ty : ty) : string =
   let field_values = List.map value_to_string field_values in
   match ty with
-  | Adt (Tuple, _) ->
+  | TAdt (Tuple, _) ->
       (* Tuple *)
       "(" ^ String.concat ", " field_values ^ ")"
-  | Adt (AdtId def_id, _) ->
+  | TAdt (AdtId def_id, _) ->
       (* "Regular" ADT *)
       let adt_ident =
         match variant_id with
@@ -462,7 +462,7 @@ let adt_g_value_to_string (fmt : value_formatter)
             let field_values = String.concat " " field_values in
             adt_ident ^ " { " ^ field_values ^ " }"
       else adt_ident
-  | Adt (Assumed aty, _) -> (
+  | TAdt (TAssumed aty, _) -> (
       (* Assumed type *)
       match aty with
       | State | RawPtr _ ->
@@ -585,8 +585,8 @@ let regular_fun_id_to_string (fmt : ast_formatter) (fun_id : fun_id) : string =
   | FromLlbc (fid, lp_id, rg_id) ->
       let f =
         match fid with
-        | FunId (Regular fid) -> fmt.fun_decl_id_to_string fid
-        | FunId (Assumed fid) -> llbc_assumed_fun_id_to_string fid
+        | FunId (FRegular fid) -> fmt.fun_decl_id_to_string fid
+        | FunId (FAssumed fid) -> llbc_assumed_fun_id_to_string fid
         | TraitMethod (trait_ref, method_name, _) ->
             let fmt = ast_to_type_formatter fmt in
             trait_ref_to_string fmt true trait_ref ^ "." ^ method_name
@@ -664,7 +664,7 @@ let rec texpression_to_string (fmt : ast_formatter) (inside : bool)
           in
           let bl = if fields = [] then "" else "\n" ^ indent in
           "{" ^ s ^ String.concat "" fields ^ bl ^ "}"
-      | Assumed Array ->
+      | TAssumed Array ->
           let fields =
             List.map
               (fun (_, fe) ->
diff --git a/compiler/Pure.ml b/compiler/Pure.ml
index e6a3dab5..ffbd1f09 100644
--- a/compiler/Pure.ml
+++ b/compiler/Pure.ml
@@ -64,6 +64,8 @@ type mutability = Mut | Const [@@deriving show, ord]
       - [State]: the type of the state, when using state-error monads. Note that
         this state is opaque to Aeneas (the user can define it, or leave it as
         assumed)
+
+    TODO: add a prefix "T"
   *)
 type assumed_ty =
   | State
@@ -144,7 +146,7 @@ class virtual ['self] mapreduce_type_id_base =
       fun _ x -> (x, self#zero)
   end
 
-type type_id = AdtId of type_decl_id | Tuple | Assumed of assumed_ty
+type type_id = AdtId of type_decl_id | Tuple | TAssumed of assumed_ty
 [@@deriving
   show,
     ord,
@@ -190,7 +192,6 @@ class ['self] iter_ty_base =
   object (_self : 'self)
     inherit [_] iter_type_id
     inherit! [_] T.iter_const_generic
-    inherit! [_] PV.iter_literal_type
     method visit_type_var_id : 'env -> type_var_id -> unit = fun _ _ -> ()
     method visit_trait_decl_id : 'env -> trait_decl_id -> unit = fun _ _ -> ()
     method visit_trait_impl_id : 'env -> trait_impl_id -> unit = fun _ _ -> ()
@@ -207,7 +208,6 @@ class ['self] map_ty_base =
   object (_self : 'self)
     inherit [_] map_type_id
     inherit! [_] T.map_const_generic
-    inherit! [_] PV.map_literal_type
     method visit_type_var_id : 'env -> type_var_id -> type_var_id = fun _ x -> x
 
     method visit_trait_decl_id : 'env -> trait_decl_id -> trait_decl_id =
@@ -228,7 +228,6 @@ class virtual ['self] reduce_ty_base =
   object (self : 'self)
     inherit [_] reduce_type_id
     inherit! [_] T.reduce_const_generic
-    inherit! [_] PV.reduce_literal_type
     method visit_type_var_id : 'env -> type_var_id -> 'a = fun _ _ -> self#zero
 
     method visit_trait_decl_id : 'env -> trait_decl_id -> 'a =
@@ -249,7 +248,6 @@ class virtual ['self] mapreduce_ty_base =
   object (self : 'self)
     inherit [_] mapreduce_type_id
     inherit! [_] T.mapreduce_const_generic
-    inherit! [_] PV.mapreduce_literal_type
 
     method visit_type_var_id : 'env -> type_var_id -> type_var_id * 'a =
       fun _ x -> (x, self#zero)
@@ -270,7 +268,7 @@ class virtual ['self] mapreduce_ty_base =
   end
 
 type ty =
-  | Adt of type_id * generic_args
+  | TAdt of type_id * generic_args
       (** {!Adt} encodes ADTs and tuples and assumed types.
 
           TODO: what about the ended regions? (ADTs may be parameterized
@@ -279,7 +277,7 @@ type ty =
           such "partial" ADTs.
        *)
   | TypeVar of type_var_id
-  | Literal of literal_type
+  | TLiteral of literal_type
   | Arrow of ty * ty
   | TraitType of trait_ref * generic_args * string
       (** The string is for the name of the associated type *)
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index f3e6cbe2..d62a028e 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -791,7 +791,7 @@ let expression_contains_child_call_in_all_paths (ctx : trans_ctx)
                     let id0 =
                       match id0 with
                       | FunId fun_id -> fun_id
-                      | TraitMethod (_, _, fun_decl_id) -> Regular fun_decl_id
+                      | TraitMethod (_, _, fun_decl_id) -> FRegular fun_decl_id
                     in
                     LlbcAstUtils.lookup_fun_sig id0 ctx.fun_ctx.fun_decls
                   in
@@ -1527,7 +1527,7 @@ let eliminate_box_functions (ctx : trans_ctx) (def : fun_decl) : fun_decl =
              * could have: [box_new f x])
              * *)
             match fun_id with
-            | Fun (FromLlbc (FunId (Assumed aid), _lp_id, rg_id)) -> (
+            | Fun (FromLlbc (FunId (FAssumed aid), _lp_id, rg_id)) -> (
                 match (aid, rg_id) with
                 | BoxNew, _ ->
                     assert (rg_id = None);
@@ -1541,7 +1541,7 @@ let eliminate_box_functions (ctx : trans_ctx) (def : fun_decl) : fun_decl =
                     | ArrayRepeat | SliceLen ),
                     _ ) ->
                     super#visit_texpression env e)
-            | Fun (FromLlbc (FunId (Regular fid), _lp_id, rg_id)) -> (
+            | Fun (FromLlbc (FunId (FRegular fid), _lp_id, rg_id)) -> (
                 (* Lookup the function name *)
                 let def = FunDeclId.Map.find fid ctx.fun_ctx.fun_decls in
                 match
@@ -2050,7 +2050,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) :
     let inputs_set = VarId.Set.of_list (List.map var_get_id inputs_prefix) in
     assert (Option.is_some decl.loop_id);
 
-    let fun_id = (E.Regular decl.def_id, decl.loop_id) in
+    let fun_id = (E.FRegular decl.def_id, decl.loop_id) in
 
     let set_used vid =
       used := List.map (fun (vid', b) -> (vid', b || vid = vid')) !used
@@ -2134,7 +2134,7 @@ let filter_loop_inputs (transl : pure_fun_translation list) :
   (* We then apply the filtering to all the function definitions at once *)
   let filter_in_one (decl : fun_decl) : fun_decl =
     (* Filter the function signature *)
-    let fun_id = (E.Regular decl.def_id, decl.loop_id) in
+    let fun_id = (E.FRegular decl.def_id, decl.loop_id) in
     let decl =
       match FunLoopIdMap.find_opt fun_id !used_map with
       | None -> (* Nothing to filter *) decl
diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml
index 2ad942bb..f8b5de6a 100644
--- a/compiler/PureTypeCheck.ml
+++ b/compiler/PureTypeCheck.ml
@@ -22,7 +22,7 @@ let get_adt_field_types (type_decls : type_decl TypeDeclId.Map.t)
       (* "Regular" ADT *)
       let def = TypeDeclId.Map.find def_id type_decls in
       type_decl_get_instantiated_fields_types def variant_id generics
-  | Assumed aty -> (
+  | TAssumed aty -> (
       (* Assumed type *)
       match aty with
       | State ->
@@ -63,8 +63,8 @@ type tc_ctx = {
 
 let check_literal (v : literal) (ty : literal_type) : unit =
   match (ty, v) with
-  | Integer int_ty, PV.Scalar sv -> assert (int_ty = sv.PV.int_ty)
-  | Bool, Bool _ | Char, Char _ -> ()
+  | TInteger int_ty, PV.VScalar sv -> assert (int_ty = sv.PV.int_ty)
+  | TBool, VBool _ | TChar, VChar _ -> ()
   | _ -> raise (Failure "Inconsistent type")
 
 let rec check_typed_pattern (ctx : tc_ctx) (v : typed_pattern) : tc_ctx =
@@ -156,7 +156,7 @@ let rec check_texpression (ctx : tc_ctx) (e : texpression) : unit =
           let field_tys, adt_ty = destruct_arrows e.ty in
           assert (expected_field_tys = field_tys);
           match adt_ty with
-          | Adt (type_id, generics) ->
+          | TAdt (type_id, generics) ->
               assert (type_id = id.adt_id);
               assert (generics = qualif.generics)
           | _ -> raise (Failure "Unreachable")))
@@ -174,7 +174,7 @@ let rec check_texpression (ctx : tc_ctx) (e : texpression) : unit =
       check_texpression ctx scrut;
       match switch_body with
       | If (e_then, e_else) ->
-          assert (scrut.ty = Literal Bool);
+          assert (scrut.ty = TLiteral TBool);
           assert (e_then.ty = e.ty);
           assert (e_else.ty = e.ty);
           check_texpression ctx e_then;
@@ -219,7 +219,7 @@ let rec check_texpression (ctx : tc_ctx) (e : texpression) : unit =
               assert (expected_field_ty = fe.ty);
               check_texpression ctx fe)
             supd.updates
-      | Assumed Array ->
+      | TAssumed Array ->
           let expected_field_ty =
             Collections.List.to_cons_nil adt_generics.types
           in
diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml
index 3aeabffe..5e46d551 100644
--- a/compiler/PureUtils.ml
+++ b/compiler/PureUtils.ml
@@ -64,14 +64,14 @@ let dest_arrow_ty (ty : ty) : ty * ty =
 
 let compute_literal_type (cv : literal) : literal_type =
   match cv with
-  | PV.Scalar sv -> Integer sv.PV.int_ty
-  | Bool _ -> Bool
-  | Char _ -> Char
+  | PV.VScalar sv -> TInteger sv.PV.int_ty
+  | VBool _ -> TBool
+  | VChar _ -> TChar
 
 let var_get_id (v : var) : VarId.id = v.id
 
 let mk_typed_pattern_from_literal (cv : literal) : typed_pattern =
-  let ty = Literal (compute_literal_type cv) in
+  let ty = TLiteral (compute_literal_type cv) in
   { value = PatConstant cv; ty }
 
 let mk_let (monadic : bool) (lv : typed_pattern) (re : texpression)
@@ -232,7 +232,7 @@ let is_const (e : texpression) : bool =
 
 let ty_as_adt (ty : ty) : type_id * generic_args =
   match ty with
-  | Adt (id, generics) -> (id, generics)
+  | TAdt (id, generics) -> (id, generics)
   | _ -> raise (Failure "Unreachable")
 
 (** Remove the external occurrences of {!Meta} *)
@@ -340,7 +340,7 @@ let opt_destruct_function_call (e : texpression) :
 
 let opt_destruct_result (ty : ty) : ty option =
   match ty with
-  | Adt (Assumed Result, generics) ->
+  | TAdt (TAssumed Result, generics) ->
       assert (generics.const_generics = []);
       assert (generics.trait_refs = []);
       Some (Collections.List.to_cons_nil generics.types)
@@ -350,7 +350,7 @@ let destruct_result (ty : ty) : ty = Option.get (opt_destruct_result ty)
 
 let opt_destruct_tuple (ty : ty) : ty list option =
   match ty with
-  | Adt (Tuple, generics) ->
+  | TAdt (Tuple, generics) ->
       assert (generics.const_generics = []);
       assert (generics.trait_refs = []);
       Some generics.types
@@ -408,7 +408,7 @@ let iter_switch_body_branches (f : texpression -> unit) (sb : switch_body) :
 let mk_switch (scrut : texpression) (sb : switch_body) : texpression =
   (* Sanity check: the scrutinee has the proper type *)
   (match sb with
-  | If (_, _) -> assert (scrut.ty = Literal Bool)
+  | If (_, _) -> assert (scrut.ty = TLiteral TBool)
   | Match branches ->
       List.iter
         (fun (b : match_branch) -> assert (b.pat.ty = scrut.ty))
@@ -427,10 +427,10 @@ let mk_switch (scrut : texpression) (sb : switch_body) : texpression =
 let mk_simpl_tuple_ty (tys : ty list) : ty =
   match tys with
   | [ ty ] -> ty
-  | _ -> Adt (Tuple, mk_generic_args_from_types tys)
+  | _ -> TAdt (Tuple, mk_generic_args_from_types tys)
 
-let mk_bool_ty : ty = Literal Bool
-let mk_unit_ty : ty = Adt (Tuple, empty_generic_args)
+let mk_bool_ty : ty = TLiteral TBool
+let mk_unit_ty : ty = TAdt (Tuple, empty_generic_args)
 
 let mk_unit_rvalue : texpression =
   let id = AdtCons { adt_id = Tuple; variant_id = None } in
@@ -474,7 +474,7 @@ let mk_simpl_tuple_pattern (vl : typed_pattern list) : typed_pattern =
   | [ v ] -> v
   | _ ->
       let tys = List.map (fun (v : typed_pattern) -> v.ty) vl in
-      let ty = Adt (Tuple, mk_generic_args_from_types tys) in
+      let ty = TAdt (Tuple, mk_generic_args_from_types tys) in
       let value = PatAdt { variant_id = None; field_values = vl } in
       { value; ty }
 
@@ -485,7 +485,7 @@ let mk_simpl_tuple_texpression (vl : texpression list) : texpression =
   | _ ->
       (* Compute the types of the fields, and the type of the tuple constructor *)
       let tys = List.map (fun (v : texpression) -> v.ty) vl in
-      let ty = Adt (Tuple, mk_generic_args_from_types tys) in
+      let ty = TAdt (Tuple, mk_generic_args_from_types tys) in
       let ty = mk_arrows tys ty in
       (* Construct the tuple constructor qualifier *)
       let id = AdtCons { adt_id = Tuple; variant_id = None } in
@@ -501,40 +501,40 @@ let mk_adt_pattern (adt_ty : ty) (variant_id : VariantId.id option)
 
 let ty_as_integer (t : ty) : T.integer_type =
   match t with
-  | Literal (Integer int_ty) -> int_ty
+  | TLiteral (TInteger int_ty) -> int_ty
   | _ -> raise (Failure "Unreachable")
 
 let ty_as_literal (t : ty) : T.literal_type =
-  match t with Literal ty -> ty | _ -> raise (Failure "Unreachable")
+  match t with TLiteral ty -> ty | _ -> raise (Failure "Unreachable")
 
-let mk_state_ty : ty = Adt (Assumed State, empty_generic_args)
+let mk_state_ty : ty = TAdt (TAssumed State, empty_generic_args)
 
 let mk_result_ty (ty : ty) : ty =
-  Adt (Assumed Result, mk_generic_args_from_types [ ty ])
+  TAdt (TAssumed Result, mk_generic_args_from_types [ ty ])
 
-let mk_error_ty : ty = Adt (Assumed Error, empty_generic_args)
-let mk_fuel_ty : ty = Adt (Assumed Fuel, empty_generic_args)
+let mk_error_ty : ty = TAdt (TAssumed Error, empty_generic_args)
+let mk_fuel_ty : ty = TAdt (TAssumed Fuel, empty_generic_args)
 
 let mk_error (error : VariantId.id) : texpression =
   let ty = mk_error_ty in
-  let id = AdtCons { adt_id = Assumed Error; variant_id = Some error } in
+  let id = AdtCons { adt_id = TAssumed Error; variant_id = Some error } in
   let qualif = { id; generics = empty_generic_args } in
   let e = Qualif qualif in
   { e; ty }
 
 let unwrap_result_ty (ty : ty) : ty =
   match ty with
-  | Adt
-      (Assumed Result, { types = [ ty ]; const_generics = []; trait_refs = [] })
+  | TAdt
+      (TAssumed Result, { types = [ ty ]; const_generics = []; trait_refs = [] })
     ->
       ty
   | _ -> raise (Failure "not a result type")
 
 let mk_result_fail_texpression (error : texpression) (ty : ty) : texpression =
   let type_args = [ ty ] in
-  let ty = Adt (Assumed Result, mk_generic_args_from_types type_args) in
+  let ty = TAdt (TAssumed Result, mk_generic_args_from_types type_args) in
   let id =
-    AdtCons { adt_id = Assumed Result; variant_id = Some result_fail_id }
+    AdtCons { adt_id = TAssumed Result; variant_id = Some result_fail_id }
   in
   let qualif = { id; generics = mk_generic_args_from_types type_args } in
   let cons_e = Qualif qualif in
@@ -549,9 +549,9 @@ let mk_result_fail_texpression_with_error_id (error : VariantId.id) (ty : ty) :
 
 let mk_result_return_texpression (v : texpression) : texpression =
   let type_args = [ v.ty ] in
-  let ty = Adt (Assumed Result, mk_generic_args_from_types type_args) in
+  let ty = TAdt (TAssumed Result, mk_generic_args_from_types type_args) in
   let id =
-    AdtCons { adt_id = Assumed Result; variant_id = Some result_return_id }
+    AdtCons { adt_id = TAssumed Result; variant_id = Some result_return_id }
   in
   let qualif = { id; generics = mk_generic_args_from_types type_args } in
   let cons_e = Qualif qualif in
@@ -562,7 +562,7 @@ let mk_result_return_texpression (v : texpression) : texpression =
 (** Create a [Fail err] pattern which captures the error *)
 let mk_result_fail_pattern (error_pat : pattern) (ty : ty) : typed_pattern =
   let error_pat : typed_pattern = { value = error_pat; ty = mk_error_ty } in
-  let ty = Adt (Assumed Result, mk_generic_args_from_types [ ty ]) in
+  let ty = TAdt (TAssumed Result, mk_generic_args_from_types [ ty ]) in
   let value =
     PatAdt { variant_id = Some result_fail_id; field_values = [ error_pat ] }
   in
@@ -574,7 +574,7 @@ let mk_result_fail_pattern_ignore_error (ty : ty) : typed_pattern =
   mk_result_fail_pattern error_pat ty
 
 let mk_result_return_pattern (v : typed_pattern) : typed_pattern =
-  let ty = Adt (Assumed Result, mk_generic_args_from_types [ v.ty ]) in
+  let ty = TAdt (TAssumed Result, mk_generic_args_from_types [ v.ty ]) in
   let value =
     PatAdt { variant_id = Some result_return_id; field_values = [ v ] }
   in
diff --git a/compiler/ReorderDecls.ml b/compiler/ReorderDecls.ml
index 10b68da3..c82d625f 100644
--- a/compiler/ReorderDecls.ml
+++ b/compiler/ReorderDecls.ml
@@ -46,8 +46,8 @@ let compute_body_fun_deps (e : texpression) : FunIdSet.t =
             | Pure _ -> ()
             | FromLlbc (fid, lp_id, rg_id) -> (
                 match fid with
-                | FunId (Assumed _) -> ()
-                | TraitMethod (_, _, fid) | FunId (Regular fid) ->
+                | FunId (FAssumed _) -> ()
+                | TraitMethod (_, _, fid) | FunId (FRegular fid) ->
                     let id = { def_id = fid; lp_id; rg_id } in
                     ids := FunIdSet.add id !ids))
     end
diff --git a/compiler/Substitute.ml b/compiler/Substitute.ml
index 23f618e2..b4eee9f8 100644
--- a/compiler/Substitute.ml
+++ b/compiler/Substitute.ml
@@ -9,20 +9,20 @@ module E = Expressions
 module A = LlbcAst
 module C = Contexts
 
-type ('r1, 'r2) subst = {
-  r_subst : 'r1 -> 'r2;
-  ty_subst : T.TypeVarId.id -> 'r2 T.ty;
+type subst = {
+  r_subst : T.region -> T.region;
+  ty_subst : T.TypeVarId.id -> T.ty;
   cg_subst : T.ConstGenericVarId.id -> T.const_generic;
       (** Substitution from *local* trait clause to trait instance *)
-  tr_subst : T.TraitClauseId.id -> 'r2 T.trait_instance_id;
+  tr_subst : T.TraitClauseId.id -> T.trait_instance_id;
       (** Substitution for the [Self] trait instance *)
-  tr_self : 'r2 T.trait_instance_id;
+  tr_self : T.trait_instance_id;
 }
 
-let ty_substitute_visitor (subst : ('r1, 'r2) subst) =
+let st_substitute_visitor (subst : subst) =
   object
-    inherit [_] T.map_ty
-    method visit_'r _ r = subst.r_subst r
+    inherit [_] A.map_statement
+    method! visit_region _ r = subst.r_subst r
     method! visit_TypeVar _ id = subst.ty_subst id
 
     method! visit_type_var_id _ _ =
@@ -43,25 +43,30 @@ let ty_substitute_visitor (subst : ('r1, 'r2) subst) =
 
     **IMPORTANT**: this doesn't normalize the types.
  *)
-let ty_substitute (subst : ('r1, 'r2) subst) (ty : 'r1 T.ty) : 'r2 T.ty =
-  let visitor = ty_substitute_visitor subst in
+let ty_substitute (subst : subst) (ty : T.ty) : T.ty =
+  let visitor = st_substitute_visitor subst in
   visitor#visit_ty () ty
 
 (** **IMPORTANT**: this doesn't normalize the types. *)
-let trait_ref_substitute (subst : ('r1, 'r2) subst) (tr : 'r1 T.trait_ref) :
-    'r2 T.trait_ref =
-  let visitor = ty_substitute_visitor subst in
+let trait_ref_substitute (subst : subst) (tr : T.trait_ref) : T.trait_ref =
+  let visitor = st_substitute_visitor subst in
   visitor#visit_trait_ref () tr
 
 (** **IMPORTANT**: this doesn't normalize the types. *)
-let generic_args_substitute (subst : ('r1, 'r2) subst) (g : 'r1 T.generic_args)
-    : 'r2 T.generic_args =
-  let visitor = ty_substitute_visitor subst in
+let trait_instance_id_substitute (subst : subst) (tr : T.trait_instance_id) :
+    T.trait_instance_id =
+  let visitor = st_substitute_visitor subst in
+  visitor#visit_trait_instance_id () tr
+
+(** **IMPORTANT**: this doesn't normalize the types. *)
+let generic_args_substitute (subst : subst) (g : T.generic_args) :
+    T.generic_args =
+  let visitor = st_substitute_visitor subst in
   visitor#visit_generic_args () g
 
-let erase_regions_subst : ('r, T.erased_region) subst =
+let erase_regions_subst : subst =
   {
-    r_subst = (fun _ -> T.Erased);
+    r_subst = (fun _ -> T.RErased);
     ty_subst = (fun vid -> T.TypeVar vid);
     cg_subst = (fun id -> T.ConstGenericVar id);
     tr_subst = (fun id -> T.Clause id);
@@ -69,11 +74,18 @@ let erase_regions_subst : ('r, T.erased_region) subst =
   }
 
 (** Convert an {!T.rty} to an {!T.ety} by erasing the region variables *)
-let erase_regions (ty : 'r T.ty) : T.ety = ty_substitute erase_regions_subst ty
+let erase_regions (ty : T.ty) : T.ty = ty_substitute erase_regions_subst ty
 
-let trait_ref_erase_regions (tr : 'r T.trait_ref) : T.etrait_ref =
+let trait_ref_erase_regions (tr : T.trait_ref) : T.trait_ref =
   trait_ref_substitute erase_regions_subst tr
 
+let trait_instance_id_erase_regions (tr : T.trait_instance_id) :
+    T.trait_instance_id =
+  trait_instance_id_substitute erase_regions_subst tr
+
+let generic_args_erase_regions (tr : T.generic_args) : T.generic_args =
+  generic_args_substitute erase_regions_subst tr
+
 (** Generate fresh regions for region variables.
 
     Return the list of new regions and appropriate substitutions from the
@@ -83,60 +95,62 @@ let trait_ref_erase_regions (tr : 'r T.trait_ref) : T.etrait_ref =
   *)
 let fresh_regions_with_substs (region_vars : T.region_var list) :
     T.RegionId.id list
-    * (T.RegionVarId.id -> T.RegionId.id)
-    * (T.RegionVarId.id T.region -> T.RegionId.id T.region) =
+    * (T.RegionId.id -> T.RegionId.id)
+    * (T.region -> T.region) =
   (* Generate fresh regions *)
   let fresh_region_ids = List.map (fun _ -> C.fresh_region_id ()) region_vars in
   (* Generate the map from region var ids to regions *)
   let ls = List.combine region_vars fresh_region_ids in
   let rid_map =
     List.fold_left
-      (fun mp ((k : T.region_var), v) -> T.RegionVarId.Map.add k.T.index v mp)
-      T.RegionVarId.Map.empty ls
+      (fun mp ((k : T.region_var), v) -> T.RegionId.Map.add k.T.index v mp)
+      T.RegionId.Map.empty ls
   in
   (* Generate the substitution from region var id to region *)
-  let rid_subst id = T.RegionVarId.Map.find id rid_map in
+  let rid_subst id = T.RegionId.Map.find id rid_map in
   (* Generate the substitution from region to region *)
-  let r_subst r =
-    match r with T.Static -> T.Static | T.Var id -> T.Var (rid_subst id)
+  let r_subst (r : T.region) =
+    match r with
+    | T.RStatic | T.RErased -> r
+    | T.RVar id -> T.RVar (rid_subst id)
   in
   (* Return *)
   (fresh_region_ids, rid_subst, r_subst)
 
 (** Erase the regions in a type and perform a substitution *)
-let erase_regions_substitute_types (ty_subst : T.TypeVarId.id -> T.ety)
+let erase_regions_substitute_types (ty_subst : T.TypeVarId.id -> T.ty)
     (cg_subst : T.ConstGenericVarId.id -> T.const_generic)
-    (tr_subst : T.TraitClauseId.id -> T.etrait_instance_id)
-    (tr_self : T.etrait_instance_id) (ty : 'r T.ty) : T.ety =
-  let r_subst (_ : 'r) : T.erased_region = T.Erased in
+    (tr_subst : T.TraitClauseId.id -> T.trait_instance_id)
+    (tr_self : T.trait_instance_id) (ty : T.ty) : T.ty =
+  let r_subst (_ : T.region) : T.region = T.RErased in
   let subst = { r_subst; ty_subst; cg_subst; tr_subst; tr_self } in
   ty_substitute subst ty
 
 (** Create a region substitution from a list of region variable ids and a list of
     regions (with which to substitute the region variable ids *)
-let make_region_subst (var_ids : T.RegionVarId.id list)
-    (regions : 'r T.region list) : T.RegionVarId.id T.region -> 'r T.region =
+let make_region_subst (var_ids : T.RegionId.id list) (regions : T.region list) :
+    T.region -> T.region =
   let ls = List.combine var_ids regions in
   let mp =
     List.fold_left
-      (fun mp (k, v) -> T.RegionVarId.Map.add k v mp)
-      T.RegionVarId.Map.empty ls
+      (fun mp (k, v) -> T.RegionId.Map.add k v mp)
+      T.RegionId.Map.empty ls
   in
   fun r ->
     match r with
-    | T.Static -> T.Static
-    | T.Var id -> T.RegionVarId.Map.find id mp
+    | T.RStatic | T.RErased -> r
+    | T.RVar id -> T.RegionId.Map.find id mp
 
 let make_region_subst_from_vars (vars : T.region_var list)
-    (regions : 'r T.region list) : T.RegionVarId.id T.region -> 'r T.region =
+    (regions : T.region list) : T.region -> T.region =
   make_region_subst
     (List.map (fun (x : T.region_var) -> x.T.index) vars)
     regions
 
 (** Create a type substitution from a list of type variable ids and a list of
     types (with which to substitute the type variable ids) *)
-let make_type_subst (var_ids : T.TypeVarId.id list) (tys : 'r T.ty list) :
-    T.TypeVarId.id -> 'r T.ty =
+let make_type_subst (var_ids : T.TypeVarId.id list) (tys : T.ty list) :
+    T.TypeVarId.id -> T.ty =
   let ls = List.combine var_ids tys in
   let mp =
     List.fold_left
@@ -145,8 +159,8 @@ let make_type_subst (var_ids : T.TypeVarId.id list) (tys : 'r T.ty list) :
   in
   fun id -> T.TypeVarId.Map.find id mp
 
-let make_type_subst_from_vars (vars : T.type_var list) (tys : 'r T.ty list) :
-    T.TypeVarId.id -> 'r T.ty =
+let make_type_subst_from_vars (vars : T.type_var list) (tys : T.ty list) :
+    T.TypeVarId.id -> T.ty =
   make_type_subst (List.map (fun (x : T.type_var) -> x.T.index) vars) tys
 
 (** Create a const generic substitution from a list of const generic variable ids and a list of
@@ -170,7 +184,7 @@ let make_const_generic_subst_from_vars (vars : T.const_generic_var list)
 (** Create a trait substitution from a list of trait clause ids and a list of
     trait refs *)
 let make_trait_subst (clause_ids : T.TraitClauseId.id list)
-    (trs : 'r T.trait_ref list) : T.TraitClauseId.id -> 'r T.trait_instance_id =
+    (trs : T.trait_ref list) : T.TraitClauseId.id -> T.trait_instance_id =
   let ls = List.combine clause_ids trs in
   let mp =
     List.fold_left
@@ -180,15 +194,13 @@ let make_trait_subst (clause_ids : T.TraitClauseId.id list)
   fun id -> T.TraitClauseId.Map.find id mp
 
 let make_trait_subst_from_clauses (clauses : T.trait_clause list)
-    (trs : 'r T.trait_ref list) : T.TraitClauseId.id -> 'r T.trait_instance_id =
+    (trs : T.trait_ref list) : T.TraitClauseId.id -> T.trait_instance_id =
   make_trait_subst
     (List.map (fun (x : T.trait_clause) -> x.T.clause_id) clauses)
     trs
 
-let make_subst_from_generics (params : T.generic_params)
-    (args : 'r T.region T.generic_args)
-    (tr_self : 'r T.region T.trait_instance_id) :
-    (T.region_var_id T.region, 'r T.region) subst =
+let make_subst_from_generics (params : T.generic_params) (args : T.generic_args)
+    (tr_self : T.trait_instance_id) : subst =
   let r_subst = make_region_subst_from_vars params.T.regions args.T.regions in
   let ty_subst = make_type_subst_from_vars params.T.types args.T.types in
   let cg_subst =
@@ -200,36 +212,12 @@ let make_subst_from_generics (params : T.generic_params)
   in
   { r_subst; ty_subst; cg_subst; tr_subst; tr_self }
 
-let make_subst_from_generics_no_regions :
-      'r.
-      T.generic_params ->
-      'r T.generic_args ->
-      'r T.trait_instance_id ->
-      (T.region_var_id T.region, 'r) subst =
- fun params args tr_self ->
-  let r_subst _ = raise (Failure "Unexpected region") in
-  let ty_subst = make_type_subst_from_vars params.T.types args.T.types in
-  let cg_subst =
-    make_const_generic_subst_from_vars params.T.const_generics
-      args.T.const_generics
-  in
-  let tr_subst =
-    make_trait_subst_from_clauses params.T.trait_clauses args.T.trait_refs
-  in
-  { r_subst; ty_subst; cg_subst; tr_subst; tr_self }
-
-let make_esubst_from_generics (params : T.generic_params)
-    (generics : T.egeneric_args) (tr_self : T.etrait_instance_id) =
-  let r_subst _ = T.Erased in
-  let ty_subst = make_type_subst_from_vars params.types generics.T.types in
-  let cg_subst =
-    make_const_generic_subst_from_vars params.const_generics
-      generics.T.const_generics
-  in
-  let tr_subst =
-    make_trait_subst_from_clauses params.trait_clauses generics.T.trait_refs
-  in
-  { r_subst; ty_subst; cg_subst; tr_subst; tr_self }
+let make_subst_from_generics_erase_regions (params : T.generic_params)
+    (generics : T.generic_args) (tr_self : T.trait_instance_id) =
+  let generics = generic_args_erase_regions generics in
+  let tr_self = trait_instance_id_erase_regions tr_self in
+  let subst = make_subst_from_generics params generics tr_self in
+  { subst with r_subst = (fun _ -> T.RErased) }
 
 (** Instantiate the type variables in an ADT definition, and return, for
     every variant, the list of the types of its fields.
@@ -237,8 +225,8 @@ let make_esubst_from_generics (params : T.generic_params)
     **IMPORTANT**: this function doesn't normalize the types, you may want to
     use the [AssociatedTypes] equivalent instead.
 *)
-let type_decl_get_instantiated_variants_fields_rtypes (def : T.type_decl)
-    (generics : T.rgeneric_args) : (T.VariantId.id option * T.rty list) list =
+let type_decl_get_instantiated_variants_fields_types (def : T.type_decl)
+    (generics : T.generic_args) : (T.VariantId.id option * T.ty list) list =
   (* There shouldn't be any reference to Self *)
   let tr_self = T.UnknownTrait __FUNCTION__ in
   let subst = make_subst_from_generics def.T.generics generics tr_self in
@@ -266,9 +254,9 @@ let type_decl_get_instantiated_variants_fields_rtypes (def : T.type_decl)
     **IMPORTANT**: this function doesn't normalize the types, you may want to
     use the [AssociatedTypes] equivalent instead.
 *)
-let type_decl_get_instantiated_field_rtypes (def : T.type_decl)
-    (opt_variant_id : T.VariantId.id option) (generics : T.rgeneric_args) :
-    T.rty list =
+let type_decl_get_instantiated_field_types (def : T.type_decl)
+    (opt_variant_id : T.VariantId.id option) (generics : T.generic_args) :
+    T.ty list =
   (* For now, check that there are no clauses - otherwise we might need
      to normalize the types *)
   assert (def.generics.trait_clauses = []);
@@ -284,11 +272,11 @@ let type_decl_get_instantiated_field_rtypes (def : T.type_decl)
     **IMPORTANT**: this function doesn't normalize the types, you may want to
     use the [AssociatedTypes] equivalent instead.
 *)
-let ctx_adt_get_instantiated_field_rtypes (ctx : C.eval_ctx)
+let ctx_adt_get_instantiated_field_types (ctx : C.eval_ctx)
     (def_id : T.TypeDeclId.id) (opt_variant_id : T.VariantId.id option)
-    (generics : T.rgeneric_args) : T.rty list =
+    (generics : T.generic_args) : T.ty list =
   let def = C.ctx_lookup_type_decl ctx def_id in
-  type_decl_get_instantiated_field_rtypes def opt_variant_id generics
+  type_decl_get_instantiated_field_types def opt_variant_id generics
 
 (** Return the types of the properly instantiated ADT value (note that
     here, ADT is understood in its broad meaning: ADT, assumed value or tuple).
@@ -296,122 +284,55 @@ let ctx_adt_get_instantiated_field_rtypes (ctx : C.eval_ctx)
     **IMPORTANT**: this function doesn't normalize the types, you may want to
     use the [AssociatedTypes] equivalent instead.
  *)
-let ctx_adt_value_get_instantiated_field_rtypes (ctx : C.eval_ctx)
-    (adt : V.adt_value) (id : T.type_id) (generics : T.rgeneric_args) :
-    T.rty list =
+let ctx_adt_value_get_instantiated_field_types (ctx : C.eval_ctx)
+    (adt : V.adt_value) (id : T.type_id) (generics : T.generic_args) : T.ty list
+    =
   match id with
   | T.AdtId id ->
       (* Retrieve the types of the fields *)
-      ctx_adt_get_instantiated_field_rtypes ctx id adt.V.variant_id generics
+      ctx_adt_get_instantiated_field_types ctx id adt.V.variant_id generics
   | T.Tuple ->
       assert (generics.regions = []);
       generics.types
-  | T.Assumed aty -> (
+  | T.TAssumed aty -> (
       match aty with
-      | T.Box ->
+      | T.TBox ->
           assert (generics.regions = []);
           assert (List.length generics.types = 1);
           assert (generics.const_generics = []);
           generics.types
-      | T.Array | T.Slice | T.Str ->
+      | T.TArray | T.TSlice | T.TStr ->
           (* Those types don't have fields *)
           raise (Failure "Unreachable"))
 
-(** Instantiate the type variables in an ADT definition, and return the list
-    of types of the fields for the chosen variant.
-
-    **IMPORTANT**: this function doesn't normalize the types, you may want to
-    use the [AssociatedTypes] equivalent instead.
-*)
-let type_decl_get_instantiated_field_etypes (def : T.type_decl)
-    (opt_variant_id : T.VariantId.id option) (generics : T.egeneric_args) :
-    T.ety list =
-  (* For now, check that there are no clauses - otherwise we might need
-     to normalize the types *)
-  assert (def.generics.trait_clauses = []);
-  (* There shouldn't be any reference to Self *)
-  let tr_self : T.erased_region T.trait_instance_id =
-    T.UnknownTrait __FUNCTION__
-  in
-  let { r_subst = _; ty_subst; cg_subst; tr_subst; tr_self } =
-    make_esubst_from_generics def.T.generics generics tr_self
-  in
-  let fields = TU.type_decl_get_fields def opt_variant_id in
-  List.map
-    (fun (f : T.field) ->
-      erase_regions_substitute_types ty_subst cg_subst tr_subst tr_self
-        f.T.field_ty)
-    fields
-
-(** Return the types of the properly instantiated ADT's variant, provided a
-    context.
-
-    **IMPORTANT**: this function doesn't normalize the types, you may want to
-    use the [AssociatedTypes] equivalent instead.
- *)
-let ctx_adt_get_instantiated_field_etypes (ctx : C.eval_ctx)
-    (def_id : T.TypeDeclId.id) (opt_variant_id : T.VariantId.id option)
-    (generics : T.egeneric_args) : T.ety list =
-  let def = C.ctx_lookup_type_decl ctx def_id in
-  type_decl_get_instantiated_field_etypes def opt_variant_id generics
-
-let statement_substitute_visitor
-    (subst : (T.erased_region, T.erased_region) subst) =
-  (* Keep in synch with [ty_substitute_visitor] *)
-  object
-    inherit [_] A.map_statement
-    method! visit_'r _ r = subst.r_subst r
-    method! visit_TypeVar _ id = subst.ty_subst id
-
-    method! visit_type_var_id _ _ =
-      (* We should never get here because we reimplemented [visit_TypeVar] *)
-      raise (Failure "Unexpected")
-
-    method! visit_ConstGenericVar _ id = subst.cg_subst id
-
-    method! visit_const_generic_var_id _ _ =
-      (* We should never get here because we reimplemented [visit_Var] *)
-      raise (Failure "Unexpected")
-
-    method! visit_Clause _ id = subst.tr_subst id
-    method! visit_Self _ = subst.tr_self
-  end
-
 (** Apply a type substitution to a place *)
-let place_substitute (subst : (T.erased_region, T.erased_region) subst)
-    (p : E.place) : E.place =
+let place_substitute (subst : subst) (p : E.place) : E.place =
   (* There is in fact nothing to do *)
-  (statement_substitute_visitor subst)#visit_place () p
+  (st_substitute_visitor subst)#visit_place () p
 
 (** Apply a type substitution to an operand *)
-let operand_substitute (subst : (T.erased_region, T.erased_region) subst)
-    (op : E.operand) : E.operand =
-  (statement_substitute_visitor subst)#visit_operand () op
+let operand_substitute (subst : subst) (op : E.operand) : E.operand =
+  (st_substitute_visitor subst)#visit_operand () op
 
 (** Apply a type substitution to an rvalue *)
-let rvalue_substitute (subst : (T.erased_region, T.erased_region) subst)
-    (rv : E.rvalue) : E.rvalue =
-  (statement_substitute_visitor subst)#visit_rvalue () rv
+let rvalue_substitute (subst : subst) (rv : E.rvalue) : E.rvalue =
+  (st_substitute_visitor subst)#visit_rvalue () rv
 
 (** Apply a type substitution to an assertion *)
-let assertion_substitute (subst : (T.erased_region, T.erased_region) subst)
-    (a : A.assertion) : A.assertion =
-  (statement_substitute_visitor subst)#visit_assertion () a
+let assertion_substitute (subst : subst) (a : A.assertion) : A.assertion =
+  (st_substitute_visitor subst)#visit_assertion () a
 
 (** Apply a type substitution to a call *)
-let call_substitute (subst : (T.erased_region, T.erased_region) subst)
-    (call : A.call) : A.call =
-  (statement_substitute_visitor subst)#visit_call () call
+let call_substitute (subst : subst) (call : A.call) : A.call =
+  (st_substitute_visitor subst)#visit_call () call
 
 (** Apply a type substitution to a statement *)
-let statement_substitute (subst : (T.erased_region, T.erased_region) subst)
-    (st : A.statement) : A.statement =
-  (statement_substitute_visitor subst)#visit_statement () st
+let statement_substitute (subst : subst) (st : A.statement) : A.statement =
+  (st_substitute_visitor subst)#visit_statement () st
 
 (** Apply a type substitution to a function body. Return the local variables
     and the body. *)
-let fun_body_substitute_in_body
-    (subst : (T.erased_region, T.erased_region) subst) (body : A.fun_body) :
+let fun_body_substitute_in_body (subst : subst) (body : A.fun_body) :
     A.var list * A.statement =
   let locals =
     List.map
@@ -421,10 +342,10 @@ let fun_body_substitute_in_body
   let body = statement_substitute subst body.body in
   (locals, body)
 
-let trait_type_constraint_substitute (subst : ('r1, 'r2) subst)
-    (ttc : 'r1 T.trait_type_constraint) : 'r2 T.trait_type_constraint =
+let trait_type_constraint_substitute (subst : subst)
+    (ttc : T.trait_type_constraint) : T.trait_type_constraint =
   let { T.trait_ref; generics; type_name; ty } = ttc in
-  let visitor = ty_substitute_visitor subst in
+  let visitor = st_substitute_visitor subst in
   let trait_ref = visitor#visit_trait_ref () trait_ref in
   let generics = visitor#visit_generic_args () generics in
   let ty = visitor#visit_ty () ty in
@@ -435,22 +356,24 @@ let trait_type_constraint_substitute (subst : ('r1, 'r2) subst)
     **IMPORTANT:** this function doesn't normalize the types.
  *)
 let substitute_signature (asubst : T.RegionGroupId.id -> V.AbstractionId.id)
-    (r_subst : T.RegionVarId.id -> T.RegionId.id)
-    (ty_subst : T.TypeVarId.id -> T.rty)
+    (r_subst : T.RegionId.id -> T.RegionId.id)
+    (ty_subst : T.TypeVarId.id -> T.ty)
     (cg_subst : T.ConstGenericVarId.id -> T.const_generic)
-    (tr_subst : T.TraitClauseId.id -> T.rtrait_instance_id)
-    (tr_self : T.rtrait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig =
-  let r_subst' (r : T.RegionVarId.id T.region) : T.RegionId.id T.region =
-    match r with T.Static -> T.Static | T.Var rid -> T.Var (r_subst rid)
+    (tr_subst : T.TraitClauseId.id -> T.trait_instance_id)
+    (tr_self : T.trait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig =
+  let r_subst' (r : T.region) : T.region =
+    match r with
+    | T.RStatic | T.RErased -> r
+    | T.RVar rid -> T.RVar (r_subst rid)
   in
   let subst = { r_subst = r_subst'; ty_subst; cg_subst; tr_subst; tr_self } in
   let inputs = List.map (ty_substitute subst) sg.A.inputs in
   let output = ty_substitute subst sg.A.output in
-  let subst_region_group (rg : T.region_var_group) : A.abs_region_group =
+  let subst_region_group (rg : T.region_group) : A.abs_region_group =
     let id = asubst rg.id in
     let regions = List.map r_subst rg.regions in
     let parents = List.map asubst rg.parents in
-    { id; regions; parents }
+    ({ id; regions; parents } : A.abs_region_group)
   in
   let regions_hierarchy = List.map subst_region_group sg.A.regions_hierarchy in
   let trait_type_constraints =
@@ -461,9 +384,9 @@ let substitute_signature (asubst : T.RegionGroupId.id -> V.AbstractionId.id)
   { A.inputs; output; regions_hierarchy; trait_type_constraints }
 
 (** Substitute variable identifiers in a type *)
-let ty_substitute_ids (ty_subst : T.TypeVarId.id -> T.TypeVarId.id)
-    (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ty : 'r T.ty)
-    : 'r T.ty =
+let statement_substitute_ids (ty_subst : T.TypeVarId.id -> T.TypeVarId.id)
+    (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id) (ty : T.ty) :
+    T.ty =
   let open T in
   let visitor =
     object
@@ -476,80 +399,39 @@ let ty_substitute_ids (ty_subst : T.TypeVarId.id -> T.TypeVarId.id)
 
   visitor#visit_ty () ty
 
-(* This visitor is a mess...
-
-   We want to write a class which visits abstractions, values, etc. *and their
-   types* to substitute identifiers.
-
-   The issue is that we derive two specialized types (ety and rty) from a
-   polymorphic type (ty). Because of this, there are typing issues with
-   [visit_'r] if we define a class which visits objects of types [ety] and [rty]
-   while inheriting a class which visit [ty]...
-*)
 let subst_ids_visitor (r_subst : T.RegionId.id -> T.RegionId.id)
-    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id)
     (ty_subst : T.TypeVarId.id -> T.TypeVarId.id)
     (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id)
     (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id)
     (bsubst : V.BorrowId.id -> V.BorrowId.id)
     (asubst : V.AbstractionId.id -> V.AbstractionId.id) =
-  let subst_rty =
-    object
-      inherit [_] T.map_ty
-
-      method visit_'r _ r =
-        match r with T.Static -> T.Static | T.Var rid -> T.Var (r_subst rid)
-
-      method! visit_type_var_id _ id = ty_subst id
-      method! visit_const_generic_var_id _ id = cg_subst id
-    end
-  in
-
-  let visitor =
-    object (self : 'self)
-      inherit [_] C.map_env
-      method! visit_borrow_id _ bid = bsubst bid
-      method! visit_loan_id _ bid = bsubst bid
-      method! visit_ety _ ty = ty_substitute_ids ty_subst cg_subst ty
-      method! visit_rty env ty = subst_rty#visit_ty env ty
-      method! visit_symbolic_value_id _ id = ssubst id
-
-      (** We *do* visit meta-values *)
-      method! visit_msymbolic_value env sv = self#visit_symbolic_value env sv
-
-      (** We *do* visit meta-values *)
-      method! visit_mvalue env v = self#visit_typed_value env v
-
-      method! visit_region_id _ id = r_subst id
-      method! visit_region_var_id _ id = rvsubst id
-      method! visit_abstraction_id _ id = asubst id
-    end
-  in
-
-  object
-    method visit_ety (x : T.ety) : T.ety = visitor#visit_ety () x
-    method visit_rty (x : T.rty) : T.rty = visitor#visit_rty () x
-
-    method visit_typed_value (x : V.typed_value) : V.typed_value =
-      visitor#visit_typed_value () x
-
-    method visit_typed_avalue (x : V.typed_avalue) : V.typed_avalue =
-      visitor#visit_typed_avalue () x
-
-    method visit_abs (x : V.abs) : V.abs = visitor#visit_abs () x
-    method visit_env (env : C.env) : C.env = visitor#visit_env () env
+  object (self : 'self)
+    inherit [_] C.map_env
+    method! visit_type_var_id _ id = ty_subst id
+    method! visit_const_generic_var_id _ id = cg_subst id
+    method! visit_region_id _ rid = r_subst rid
+    method! visit_borrow_id _ bid = bsubst bid
+    method! visit_loan_id _ bid = bsubst bid
+    method! visit_symbolic_value_id _ id = ssubst id
+
+    (** We *do* visit meta-values *)
+    method! visit_msymbolic_value env sv = self#visit_symbolic_value env sv
+
+    (** We *do* visit meta-values *)
+    method! visit_mvalue env v = self#visit_typed_value env v
+
+    method! visit_abstraction_id _ id = asubst id
   end
 
 let typed_value_subst_ids (r_subst : T.RegionId.id -> T.RegionId.id)
-    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id)
     (ty_subst : T.TypeVarId.id -> T.TypeVarId.id)
     (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id)
     (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id)
     (bsubst : V.BorrowId.id -> V.BorrowId.id) (v : V.typed_value) :
     V.typed_value =
   let asubst _ = raise (Failure "Unreachable") in
-  (subst_ids_visitor r_subst rvsubst ty_subst cg_subst ssubst bsubst asubst)
-    #visit_typed_value v
+  let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in
+  vis#visit_typed_value () v
 
 let typed_value_subst_rids (r_subst : T.RegionId.id -> T.RegionId.id)
     (v : V.typed_value) : V.typed_value =
@@ -558,61 +440,57 @@ let typed_value_subst_rids (r_subst : T.RegionId.id -> T.RegionId.id)
     (fun x -> x)
     (fun x -> x)
     (fun x -> x)
-    (fun x -> x)
     v
 
 let typed_avalue_subst_ids (r_subst : T.RegionId.id -> T.RegionId.id)
-    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id)
     (ty_subst : T.TypeVarId.id -> T.TypeVarId.id)
     (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id)
     (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id)
     (bsubst : V.BorrowId.id -> V.BorrowId.id) (v : V.typed_avalue) :
     V.typed_avalue =
   let asubst _ = raise (Failure "Unreachable") in
-  (subst_ids_visitor r_subst rvsubst ty_subst cg_subst ssubst bsubst asubst)
-    #visit_typed_avalue v
+  let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in
+  vis#visit_typed_avalue () v
 
 let abs_subst_ids (r_subst : T.RegionId.id -> T.RegionId.id)
-    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id)
     (ty_subst : T.TypeVarId.id -> T.TypeVarId.id)
     (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id)
     (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id)
     (bsubst : V.BorrowId.id -> V.BorrowId.id)
     (asubst : V.AbstractionId.id -> V.AbstractionId.id) (x : V.abs) : V.abs =
-  (subst_ids_visitor r_subst rvsubst ty_subst cg_subst ssubst bsubst asubst)
-    #visit_abs x
+  let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in
+  vis#visit_abs () x
 
 let env_subst_ids (r_subst : T.RegionId.id -> T.RegionId.id)
-    (rvsubst : T.RegionVarId.id -> T.RegionVarId.id)
     (ty_subst : T.TypeVarId.id -> T.TypeVarId.id)
     (cg_subst : T.ConstGenericVarId.id -> T.ConstGenericVarId.id)
     (ssubst : V.SymbolicValueId.id -> V.SymbolicValueId.id)
     (bsubst : V.BorrowId.id -> V.BorrowId.id)
     (asubst : V.AbstractionId.id -> V.AbstractionId.id) (x : C.env) : C.env =
-  (subst_ids_visitor r_subst rvsubst ty_subst cg_subst ssubst bsubst asubst)
-    #visit_env x
+  let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in
+  vis#visit_env () x
 
 let typed_avalue_subst_rids (r_subst : T.RegionId.id -> T.RegionId.id)
     (x : V.typed_avalue) : V.typed_avalue =
   let asubst _ = raise (Failure "Unreachable") in
-  (subst_ids_visitor r_subst
-     (fun x -> x)
-     (fun x -> x)
-     (fun x -> x)
-     (fun x -> x)
-     (fun x -> x)
-     asubst)
-    #visit_typed_avalue
-    x
+  let vis =
+    subst_ids_visitor r_subst
+      (fun x -> x)
+      (fun x -> x)
+      (fun x -> x)
+      (fun x -> x)
+      asubst
+  in
+  vis#visit_typed_avalue () x
 
 let env_subst_rids (r_subst : T.RegionId.id -> T.RegionId.id) (x : C.env) :
     C.env =
-  (subst_ids_visitor r_subst
-     (fun x -> x)
-     (fun x -> x)
-     (fun x -> x)
-     (fun x -> x)
-     (fun x -> x)
-     (fun x -> x))
-    #visit_env
-    x
+  let vis =
+    subst_ids_visitor r_subst
+      (fun x -> x)
+      (fun x -> x)
+      (fun x -> x)
+      (fun x -> x)
+      (fun x -> x)
+  in
+  vis#visit_env () x
diff --git a/compiler/SymbolicAst.ml b/compiler/SymbolicAst.ml
index 4df8fec7..927544b2 100644
--- a/compiler/SymbolicAst.ml
+++ b/compiler/SymbolicAst.ml
@@ -43,7 +43,7 @@ type call = {
           borrows (we need to perform lookups).
        *)
   abstractions : V.AbstractionId.id list;
-  generics : T.egeneric_args;
+  generics : T.generic_args;
   args : V.typed_value list;
   args_places : mplace option list;  (** Meta information *)
   dest : V.symbolic_value;
@@ -65,30 +65,22 @@ type global_decl_id = A.GlobalDeclId.id [@@deriving show]
 type 'a symbolic_value_id_map = 'a V.SymbolicValueId.Map.t [@@deriving show]
 type 'a region_group_id_map = 'a T.RegionGroupId.Map.t [@@deriving show]
 
-(** Ancestor for {!expression} iter visitor *)
+(** Ancestor for {!expression} iter visitor.
+
+    We could make it inherit the visitor for {!eval_ctx}, but in all the uses
+    of this visitor we don't need to explore {!eval_ctx}, so we make it inherit
+    the abstraction visitors instead.
+ *)
 class ['self] iter_expression_base =
   object (self : 'self)
-    inherit [_] VisitorsRuntime.iter
+    inherit [_] V.iter_abs
     method visit_eval_ctx : 'env -> Contexts.eval_ctx -> unit = fun _ _ -> ()
-    method visit_typed_value : 'env -> V.typed_value -> unit = fun _ _ -> ()
     method visit_call : 'env -> call -> unit = fun _ _ -> ()
-    method visit_abs : 'env -> V.abs -> unit = fun _ _ -> ()
     method visit_loop_id : 'env -> V.loop_id -> unit = fun _ _ -> ()
-    method visit_variant_id : 'env -> variant_id -> unit = fun _ _ -> ()
-
-    method visit_const_generic_var_id : 'env -> T.const_generic_var_id -> unit =
-      fun _ _ -> ()
-
-    method visit_symbolic_value_id : 'env -> V.symbolic_value_id -> unit =
-      fun _ _ -> ()
-
-    method visit_symbolic_value : 'env -> V.symbolic_value -> unit =
-      fun _ _ -> ()
 
     method visit_region_group_id : 'env -> T.RegionGroupId.id -> unit =
       fun _ _ -> ()
 
-    method visit_global_decl_id : 'env -> global_decl_id -> unit = fun _ _ -> ()
     method visit_mplace : 'env -> mplace -> unit = fun _ _ -> ()
     method visit_meta : 'env -> meta -> unit = fun _ _ -> ()
 
@@ -115,14 +107,8 @@ class ['self] iter_expression_base =
       fun env s ->
         V.SymbolicValueId.Set.iter (self#visit_symbolic_value_id env) s
 
-    method visit_integer_type : 'env -> T.integer_type -> unit = fun _ _ -> ()
-    method visit_scalar_value : 'env -> V.scalar_value -> unit = fun _ _ -> ()
-
     method visit_symbolic_expansion : 'env -> V.symbolic_expansion -> unit =
       fun _ _ -> ()
-
-    method visit_etrait_ref : 'env -> T.etrait_ref -> unit = fun _ _ -> ()
-    method visit_egeneric_args : 'env -> T.egeneric_args -> unit = fun _ _ -> ()
   end
 
 (** **Rem.:** here, {!expression} is not at all equivalent to the expressions
@@ -224,7 +210,7 @@ and loop = {
   fresh_svalues : V.symbolic_value_id_set;
       (** The symbolic values introduced by the loop fixed-point *)
   rg_to_given_back_tys :
-    ((T.RegionId.Set.t * T.rty list) T.RegionGroupId.Map.t[@opaque]);
+    ((T.RegionId.Set.t * T.ty list) T.RegionGroupId.Map.t[@opaque]);
       (** The map from region group ids to the types of the values given back
           by the corresponding loop abstractions.
        *)
@@ -254,13 +240,13 @@ and expansion =
 (* Remark: this type doesn't have to be mutually recursive with the other
    types, but it makes it easy to generate the visitors *)
 and value_aggregate =
-  | SingleValue of V.typed_value  (** Regular case *)
-  | Array of V.typed_value list
+  | VaSingleValue of V.typed_value  (** Regular case *)
+  | VaArray of V.typed_value list
       (** This is used when introducing array aggregates *)
-  | ConstGenericValue of T.const_generic_var_id
+  | VaConstGenericValue of T.const_generic_var_id
       (** This is used when evaluating a const generic value: in the interpreter,
           we introduce a fresh symbolic value. *)
-  | TraitConstValue of T.etrait_ref * T.egeneric_args * string
+  | VaTraitConstValue of T.trait_ref * T.generic_args * string
       (** A trait constant value *)
 [@@deriving
   show,
diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index 2ce8c706..97755438 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -213,14 +213,12 @@ let bs_ctx_to_ast_formatter (ctx : bs_ctx) : Print.Ast.ast_formatter =
     ctx.trait_decls_ctx ctx.trait_impls_ctx ctx.fun_decl
 
 let bs_ctx_to_ctx_formatter (ctx : bs_ctx) : Print.Contexts.ctx_formatter =
-  let rvar_to_string = Print.Types.region_var_id_to_string in
-  let r_to_string = Print.Types.region_id_to_string in
+  let region_id_to_string = Print.Types.region_id_to_string in
   let type_var_id_to_string = Print.Types.type_var_id_to_string in
   let var_id_to_string = Print.Expressions.var_id_to_string in
   let ast_fmt = bs_ctx_to_ast_formatter ctx in
   {
-    Print.Values.rvar_to_string;
-    r_to_string;
+    Print.Values.region_id_to_string;
     type_var_id_to_string;
     type_decl_id_to_string = ast_fmt.type_decl_id_to_string;
     const_generic_var_id_to_string = ast_fmt.const_generic_var_id_to_string;
@@ -242,30 +240,29 @@ let bs_ctx_to_pp_ast_formatter (ctx : bs_ctx) : PrintPure.ast_formatter =
     ctx.trait_decls_ctx ctx.trait_impls_ctx generics.types
     generics.const_generics
 
-let ctx_egeneric_args_to_string (ctx : bs_ctx) (args : T.egeneric_args) : string
-    =
+let ctx_generic_args_to_string (ctx : bs_ctx) (args : T.generic_args) : string =
   let fmt = bs_ctx_to_ctx_formatter ctx in
-  let fmt = Print.PC.ctx_to_etype_formatter fmt in
-  Print.PT.egeneric_args_to_string fmt args
+  let fmt = Print.PC.ctx_to_type_formatter fmt in
+  Print.PT.generic_args_to_string fmt args
 
 let symbolic_value_to_string (ctx : bs_ctx) (sv : V.symbolic_value) : string =
   let fmt = bs_ctx_to_ctx_formatter ctx in
-  let fmt = Print.PC.ctx_to_rtype_formatter fmt in
+  let fmt = Print.PC.ctx_to_type_formatter fmt in
   Print.PV.symbolic_value_to_string fmt sv
 
 let typed_value_to_string (ctx : bs_ctx) (v : V.typed_value) : string =
   let fmt = bs_ctx_to_ctx_formatter ctx in
   Print.PV.typed_value_to_string fmt v
 
-let ty_to_string (ctx : bs_ctx) (ty : ty) : string =
+let pure_ty_to_string (ctx : bs_ctx) (ty : ty) : string =
   let fmt = bs_ctx_to_pp_ast_formatter ctx in
   let fmt = PrintPure.ast_to_type_formatter fmt in
   PrintPure.ty_to_string fmt false ty
 
-let rty_to_string (ctx : bs_ctx) (ty : T.rty) : string =
+let ty_to_string (ctx : bs_ctx) (ty : T.ty) : string =
   let fmt = bs_ctx_to_ctx_formatter ctx in
-  let fmt = Print.PC.ctx_to_rtype_formatter fmt in
-  Print.PT.rty_to_string fmt ty
+  let fmt = Print.PC.ctx_to_type_formatter fmt in
+  Print.PT.ty_to_string fmt ty
 
 let type_decl_to_string (ctx : bs_ctx) (def : type_decl) : string =
   let type_decls = ctx.type_context.llbc_type_decls in
@@ -343,13 +340,13 @@ let bs_ctx_lookup_llbc_fun_decl (id : A.FunDeclId.id) (ctx : bs_ctx) :
 (* TODO: move *)
 let bs_ctx_lookup_local_function_sig (def_id : A.FunDeclId.id)
     (back_id : T.RegionGroupId.id option) (ctx : bs_ctx) : fun_sig =
-  let id = (E.Regular def_id, back_id) in
+  let id = (E.FRegular def_id, back_id) in
   (RegularFunIdNotLoopMap.find id ctx.fun_context.fun_sigs).sg
 
 (* Some generic translation functions (we need to translate different "flavours"
-   of types: sty, forward types, backward types, etc.) *)
-let rec translate_generic_args (translate_ty : 'r T.ty -> ty)
-    (generics : 'r T.generic_args) : generic_args =
+   of types: forward types, backward types, etc.) *)
+let rec translate_generic_args (translate_ty : T.ty -> ty)
+    (generics : T.generic_args) : generic_args =
   (* We ignore the regions: if they didn't cause trouble for the symbolic execution,
      then everything's fine *)
   let types = List.map translate_ty generics.types in
@@ -359,7 +356,7 @@ let rec translate_generic_args (translate_ty : 'r T.ty -> ty)
   in
   { types; const_generics; trait_refs }
 
-and translate_trait_ref (translate_ty : 'r T.ty -> ty) (tr : 'r T.trait_ref) :
+and translate_trait_ref (translate_ty : T.ty -> ty) (tr : T.trait_ref) :
     trait_ref =
   let trait_id = translate_trait_instance_id translate_ty tr.trait_id in
   let generics = translate_generic_args translate_ty tr.generics in
@@ -368,13 +365,13 @@ and translate_trait_ref (translate_ty : 'r T.ty -> ty) (tr : 'r T.trait_ref) :
   in
   { trait_id; generics; trait_decl_ref }
 
-and translate_trait_decl_ref (translate_ty : 'r T.ty -> ty)
-    (tr : 'r T.trait_decl_ref) : trait_decl_ref =
+and translate_trait_decl_ref (translate_ty : T.ty -> ty) (tr : T.trait_decl_ref)
+    : trait_decl_ref =
   let decl_generics = translate_generic_args translate_ty tr.decl_generics in
   { trait_decl_id = tr.trait_decl_id; decl_generics }
 
-and translate_trait_instance_id (translate_ty : 'r T.ty -> ty)
-    (id : 'r T.trait_instance_id) : trait_instance_id =
+and translate_trait_instance_id (translate_ty : T.ty -> ty)
+    (id : T.trait_instance_id) : trait_instance_id =
   let translate_trait_instance_id = translate_trait_instance_id translate_ty in
   match id with
   | T.Self -> Self
@@ -393,19 +390,20 @@ and translate_trait_instance_id (translate_ty : 'r T.ty -> ty)
   | FnPointer _ -> raise (Failure "TODO")
   | UnknownTrait s -> raise (Failure ("Unknown trait found: " ^ s))
 
-let rec translate_sty (ty : T.sty) : ty =
+(** Translate a signature type - TODO: factor out the different translation functions *)
+let rec translate_sty (ty : T.ty) : ty =
   let translate = translate_sty in
   match ty with
-  | T.Adt (type_id, generics) -> (
+  | T.TAdt (type_id, generics) -> (
       let generics = translate_sgeneric_args generics in
       match type_id with
-      | T.AdtId adt_id -> Adt (AdtId adt_id, generics)
+      | T.AdtId adt_id -> TAdt (AdtId adt_id, generics)
       | T.Tuple ->
           assert (generics.const_generics = []);
           mk_simpl_tuple_ty generics.types
-      | T.Assumed aty -> (
+      | T.TAssumed aty -> (
           match aty with
-          | T.Box -> (
+          | T.TBox -> (
               (* Eliminate the boxes *)
               match generics.types with
               | [ ty ] -> ty
@@ -414,31 +412,31 @@ let rec translate_sty (ty : T.sty) : ty =
                     (Failure
                        "Box/vec/option type with incorrect number of arguments")
               )
-          | T.Array -> Adt (Assumed Array, generics)
-          | T.Slice -> Adt (Assumed Slice, generics)
-          | T.Str -> Adt (Assumed Str, generics)))
+          | T.TArray -> TAdt (TAssumed Array, generics)
+          | T.TSlice -> TAdt (TAssumed Slice, generics)
+          | T.TStr -> TAdt (TAssumed Str, generics)))
   | TypeVar vid -> TypeVar vid
-  | Literal ty -> Literal ty
+  | TLiteral ty -> TLiteral ty
   | Never -> raise (Failure "Unreachable")
   | Ref (_, rty, _) -> translate rty
   | RawPtr (ty, rkind) ->
       let mut = match rkind with Mut -> Mut | Shared -> Const in
       let ty = translate ty in
       let generics = { types = [ ty ]; const_generics = []; trait_refs = [] } in
-      Adt (Assumed (RawPtr mut), generics)
+      TAdt (TAssumed (RawPtr mut), generics)
   | TraitType (trait_ref, generics, type_name) ->
       let trait_ref = translate_strait_ref trait_ref in
       let generics = translate_sgeneric_args generics in
       TraitType (trait_ref, generics, type_name)
   | Arrow _ -> raise (Failure "TODO")
 
-and translate_sgeneric_args (generics : T.sgeneric_args) : generic_args =
+and translate_sgeneric_args (generics : T.generic_args) : generic_args =
   translate_generic_args translate_sty generics
 
-and translate_strait_ref (tr : T.strait_ref) : trait_ref =
+and translate_strait_ref (tr : T.trait_ref) : trait_ref =
   translate_trait_ref translate_sty tr
 
-and translate_strait_instance_id (id : T.strait_instance_id) : trait_instance_id
+and translate_strait_instance_id (id : T.trait_instance_id) : trait_instance_id
     =
   translate_trait_instance_id translate_sty id
 
@@ -447,7 +445,7 @@ let translate_trait_clause (clause : T.trait_clause) : trait_clause =
   let generics = translate_sgeneric_args generics in
   { clause_id; trait_id; generics }
 
-let translate_strait_type_constraint (ttc : T.strait_type_constraint) :
+let translate_strait_type_constraint (ttc : T.trait_type_constraint) :
     trait_type_constraint =
   let { T.trait_ref; generics; type_name; ty } = ttc in
   let trait_ref = translate_strait_ref trait_ref in
@@ -509,38 +507,43 @@ let translate_type_decl (def : T.type_decl) : type_decl =
 let translate_type_id (id : T.type_id) : type_id =
   match id with
   | AdtId adt_id -> AdtId adt_id
-  | T.Assumed aty ->
+  | T.TAssumed aty ->
       let aty =
         match aty with
-        | T.Array -> Array
-        | T.Slice -> Slice
-        | T.Str -> Str
-        | T.Box ->
+        | T.TArray -> Array
+        | T.TSlice -> Slice
+        | T.TStr -> Str
+        | T.TBox ->
             (* Boxes have to be eliminated: this type id shouldn't
                be translated *)
             raise (Failure "Unreachable")
       in
-      Assumed aty
+      TAssumed aty
   | T.Tuple -> Tuple
 
 (** Translate a type, seen as an input/output of a forward function
-    (preserve all borrows, etc.)
+    (preserve all borrows, etc.).
+
+    Remark: it doesn't matter whether the types has regions or erased regions
+    (both cases happen, actually).
+
+    TODO: factor out the various translation functions.
 *)
-let rec translate_fwd_ty (type_infos : TA.type_infos) (ty : 'r T.ty) : ty =
+let rec translate_fwd_ty (type_infos : TA.type_infos) (ty : T.ty) : ty =
   let translate = translate_fwd_ty type_infos in
   match ty with
-  | T.Adt (type_id, generics) -> (
+  | T.TAdt (type_id, generics) -> (
       let t_generics = translate_fwd_generic_args type_infos generics in
       (* Eliminate boxes and simplify tuples *)
       match type_id with
-      | AdtId _ | T.Assumed (T.Array | T.Slice | T.Str) ->
+      | AdtId _ | T.TAssumed (T.TArray | T.TSlice | T.TStr) ->
           let type_id = translate_type_id type_id in
-          Adt (type_id, t_generics)
+          TAdt (type_id, t_generics)
       | Tuple ->
           (* Note that if there is exactly one type, [mk_simpl_tuple_ty] is the
              identity *)
           mk_simpl_tuple_ty t_generics.types
-      | T.Assumed T.Box -> (
+      | T.TAssumed T.TBox -> (
           (* We eliminate boxes *)
           (* No general parametricity for now *)
           assert (
@@ -557,13 +560,13 @@ let rec translate_fwd_ty (type_infos : TA.type_infos) (ty : 'r T.ty) : ty =
                     parameter")))
   | TypeVar vid -> TypeVar vid
   | Never -> raise (Failure "Unreachable")
-  | Literal lty -> Literal lty
+  | TLiteral lty -> TLiteral lty
   | Ref (_, rty, _) -> translate rty
   | RawPtr (ty, rkind) ->
       let mut = match rkind with Mut -> Mut | Shared -> Const in
       let ty = translate ty in
       let generics = { types = [ ty ]; const_generics = []; trait_refs = [] } in
-      Adt (Assumed (RawPtr mut), generics)
+      TAdt (TAssumed (RawPtr mut), generics)
   | TraitType (trait_ref, generics, type_name) ->
       let trait_ref = translate_fwd_trait_ref type_infos trait_ref in
       let generics = translate_fwd_generic_args type_infos generics in
@@ -571,25 +574,25 @@ let rec translate_fwd_ty (type_infos : TA.type_infos) (ty : 'r T.ty) : ty =
   | Arrow _ -> raise (Failure "TODO")
 
 and translate_fwd_generic_args (type_infos : TA.type_infos)
-    (generics : 'r T.generic_args) : generic_args =
+    (generics : T.generic_args) : generic_args =
   translate_generic_args (translate_fwd_ty type_infos) generics
 
-and translate_fwd_trait_ref (type_infos : TA.type_infos) (tr : 'r T.trait_ref) :
+and translate_fwd_trait_ref (type_infos : TA.type_infos) (tr : T.trait_ref) :
     trait_ref =
   translate_trait_ref (translate_fwd_ty type_infos) tr
 
 and translate_fwd_trait_instance_id (type_infos : TA.type_infos)
-    (id : 'r T.trait_instance_id) : trait_instance_id =
+    (id : T.trait_instance_id) : trait_instance_id =
   translate_trait_instance_id (translate_fwd_ty type_infos) id
 
 (** Simply calls [translate_fwd_ty] *)
-let ctx_translate_fwd_ty (ctx : bs_ctx) (ty : 'r T.ty) : ty =
+let ctx_translate_fwd_ty (ctx : bs_ctx) (ty : T.ty) : ty =
   let type_infos = ctx.type_context.type_infos in
   translate_fwd_ty type_infos ty
 
 (** Simply calls [translate_fwd_generic_args] *)
-let ctx_translate_fwd_generic_args (ctx : bs_ctx) (generics : 'r T.generic_args)
-    : generic_args =
+let ctx_translate_fwd_generic_args (ctx : bs_ctx) (generics : T.generic_args) :
+    generic_args =
   let type_infos = ctx.type_context.type_infos in
   translate_fwd_generic_args type_infos generics
 
@@ -600,20 +603,21 @@ let ctx_translate_fwd_generic_args (ctx : bs_ctx) (generics : 'r T.generic_args)
     [inside_mut]: are we inside a mutable borrow?
  *)
 let rec translate_back_ty (type_infos : TA.type_infos)
-    (keep_region : 'r -> bool) (inside_mut : bool) (ty : 'r T.ty) : ty option =
+    (keep_region : T.region -> bool) (inside_mut : bool) (ty : T.ty) : ty option
+    =
   let translate = translate_back_ty type_infos keep_region inside_mut in
   (* A small helper for "leave" types *)
   let wrap ty = if inside_mut then Some ty else None in
   match ty with
-  | T.Adt (type_id, generics) -> (
+  | T.TAdt (type_id, generics) -> (
       match type_id with
-      | T.AdtId _ | Assumed (T.Array | T.Slice | T.Str) ->
+      | T.AdtId _ | TAssumed (T.TArray | T.TSlice | T.TStr) ->
           let type_id = translate_type_id type_id in
           if inside_mut then
             (* We do not want to filter anything, so we translate the generics
                as "forward" types *)
             let generics = translate_fwd_generic_args type_infos generics in
-            Some (Adt (type_id, generics))
+            Some (TAdt (type_id, generics))
           else
             (* If not inside a mutable reference: check if at least one
                of the generics contains a mutable reference (i.e., is not
@@ -624,9 +628,9 @@ let rec translate_back_ty (type_infos : TA.type_infos)
             let types = List.filter_map translate generics.types in
             if types <> [] then
               let generics = translate_fwd_generic_args type_infos generics in
-              Some (Adt (type_id, generics))
+              Some (TAdt (type_id, generics))
             else None
-      | Assumed T.Box -> (
+      | TAssumed T.TBox -> (
           (* Don't accept ADTs (which are not tuples) with borrows for now *)
           assert (not (TypesUtils.ty_has_borrows type_infos ty));
           (* Eliminate the box *)
@@ -647,7 +651,7 @@ let rec translate_back_ty (type_infos : TA.type_infos)
               Some (mk_simpl_tuple_ty tys_t)))
   | TypeVar vid -> wrap (TypeVar vid)
   | Never -> raise (Failure "Unreachable")
-  | Literal lty -> wrap (Literal lty)
+  | TLiteral lty -> wrap (TLiteral lty)
   | Ref (r, rty, rkind) -> (
       match rkind with
       | T.Shared ->
@@ -673,7 +677,7 @@ let rec translate_back_ty (type_infos : TA.type_infos)
 
 (** Simply calls [translate_back_ty] *)
 let ctx_translate_back_ty (ctx : bs_ctx) (keep_region : 'r -> bool)
-    (inside_mut : bool) (ty : 'r T.ty) : ty option =
+    (inside_mut : bool) (ty : T.ty) : ty option =
   let type_infos = ctx.type_context.type_infos in
   translate_back_ty type_infos keep_region inside_mut ty
 
@@ -682,7 +686,7 @@ let mk_type_check_ctx (ctx : bs_ctx) : PureTypeCheck.tc_ctx =
     T.ConstGenericVarId.Map.of_list
       (List.map
          (fun (cg : T.const_generic_var) ->
-           (cg.index, ctx_translate_fwd_ty ctx (T.Literal cg.ty)))
+           (cg.index, ctx_translate_fwd_ty ctx (T.TLiteral cg.ty)))
          ctx.sg.generics.const_generics)
   in
   let env = VarId.Map.empty in
@@ -807,7 +811,7 @@ let get_fun_effect_info (fun_infos : FA.fun_info A.FunDeclId.Map.t)
     (fun_id : A.fun_id_or_trait_method_ref) (lid : V.LoopId.id option)
     (gid : T.RegionGroupId.id option) : fun_effect_info =
   match fun_id with
-  | TraitMethod (_, _, fid) | FunId (Regular fid) ->
+  | TraitMethod (_, _, fid) | FunId (FRegular fid) ->
       let info = A.FunDeclId.Map.find fid fun_infos in
       let stateful_group = info.stateful in
       let stateful =
@@ -820,7 +824,7 @@ let get_fun_effect_info (fun_infos : FA.fun_info A.FunDeclId.Map.t)
         can_diverge = info.can_diverge;
         is_rec = info.is_rec || Option.is_some lid;
       }
-  | FunId (Assumed aid) ->
+  | FunId (FAssumed aid) ->
       assert (lid = None);
       {
         can_fail = Assumed.assumed_fun_can_fail aid;
@@ -861,21 +865,21 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id)
   (* Create the context *)
   let ctx =
     let region_groups =
-      List.map (fun (g : T.region_var_group) -> g.id) sg.regions_hierarchy
+      List.map (fun (g : T.region_group) -> g.id) sg.regions_hierarchy
     in
     let ctx =
       InterpreterUtils.initialize_eval_context decls_ctx region_groups
         sg.generics.types sg.generics.const_generics
     in
     (* Compute the normalization map for the *sty* types and add it to the context *)
-    AssociatedTypes.ctx_add_norm_trait_stypes_from_preds ctx
+    AssociatedTypes.ctx_add_norm_trait_types_from_preds ctx
       sg.preds.trait_type_constraints
   in
 
   (* Normalize the signature *)
   let sg =
     let ({ A.inputs; output; _ } : A.fun_sig) = sg in
-    let norm = AssociatedTypes.ctx_normalize_sty ctx in
+    let norm = AssociatedTypes.ctx_normalize_ty ctx in
     let inputs = List.map norm inputs in
     let output = norm output in
     { sg with A.inputs; output }
@@ -893,14 +897,14 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id)
    * so just check that there aren't parent regions *)
   assert (T.RegionGroupId.Set.is_empty parents);
   (* Small helper to translate types for backward functions *)
-  let translate_back_ty_for_gid (gid : T.RegionGroupId.id) : T.sty -> ty option
-      =
+  let translate_back_ty_for_gid (gid : T.RegionGroupId.id) : T.ty -> ty option =
     let rg = T.RegionGroupId.nth sg.regions_hierarchy gid in
-    let regions = T.RegionVarId.Set.of_list rg.regions in
+    let regions = T.RegionId.Set.of_list rg.regions in
     let keep_region r =
       match r with
-      | T.Static -> raise Unimplemented
-      | T.Var r -> T.RegionVarId.Set.mem r regions
+      | T.RStatic -> raise Unimplemented
+      | T.RErased -> raise (Failure "Unexpected erased region")
+      | T.RVar r -> T.RegionId.Set.mem r regions
     in
     let inside_mut = false in
     translate_back_ty type_infos keep_region inside_mut
@@ -1042,7 +1046,7 @@ let bs_ctx_fresh_state_var (ctx : bs_ctx) : bs_ctx * typed_pattern =
   (* Return *)
   (ctx, state_pat)
 
-let fresh_var_llbc_ty (basename : string option) (ty : 'r T.ty) (ctx : bs_ctx) :
+let fresh_var_llbc_ty (basename : string option) (ty : T.ty) (ctx : bs_ctx) :
     bs_ctx * var =
   (* Generate the fresh variable *)
   let id, var_counter = VarId.fresh ctx.var_counter in
@@ -1106,7 +1110,7 @@ let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : var =
 (** Peel boxes as long as the value is of the form [Box<T>] *)
 let rec unbox_typed_value (v : V.typed_value) : V.typed_value =
   match (v.value, v.ty) with
-  | V.Adt av, T.Adt (T.Assumed T.Box, _) -> (
+  | V.VAdt av, T.TAdt (T.TAssumed T.TBox, _) -> (
       match av.field_values with
       | [ bv ] -> unbox_typed_value bv
       | _ -> raise (Failure "Unreachable"))
@@ -1145,13 +1149,13 @@ let rec typed_value_to_texpression (ctx : bs_ctx) (ectx : C.eval_ctx)
   (* Translate the value *)
   let value =
     match v.value with
-    | V.Literal cv -> { e = Const cv; ty }
-    | Adt av -> (
+    | V.VLiteral cv -> { e = Const cv; ty }
+    | VAdt av -> (
         let variant_id = av.variant_id in
         let field_values = List.map translate av.field_values in
         (* Eliminate the tuple wrapper if it is a tuple with exactly one field *)
         match v.ty with
-        | T.Adt (T.Tuple, _) ->
+        | T.TAdt (T.Tuple, _) ->
             assert (variant_id = None);
             mk_simpl_tuple_texpression field_values
         | _ ->
@@ -1229,7 +1233,7 @@ let rec typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx)
         (* For now, only tuples can contain borrows *)
         let adt_id, _ = TypesUtils.ty_as_adt av.ty in
         match adt_id with
-        | T.AdtId _ | T.Assumed (T.Box | T.Array | T.Slice | T.Str) ->
+        | T.AdtId _ | T.TAssumed (T.TBox | T.TArray | T.TSlice | T.TStr) ->
             assert (field_values = []);
             None
         | T.Tuple ->
@@ -1374,7 +1378,7 @@ let rec typed_avalue_to_given_back (mp : mplace option) (av : V.typed_avalue)
          * vector value upon visiting the "abstraction borrow" node *)
         let adt_id, _ = TypesUtils.ty_as_adt av.ty in
         match adt_id with
-        | T.AdtId _ | T.Assumed (T.Box | T.Array | T.Slice | T.Str) ->
+        | T.AdtId _ | T.TAssumed (T.TBox | T.TArray | T.TSlice | T.TStr) ->
             assert (field_values = []);
             (ctx, None)
         | T.Tuple ->
@@ -1645,7 +1649,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) :
   log#ldebug
     (lazy
       ("translate_function_call:\n"
-      ^ ctx_egeneric_args_to_string ctx call.generics));
+      ^ ctx_generic_args_to_string ctx call.generics));
   (* Translate the function call *)
   let generics = ctx_translate_fwd_generic_args ctx call.generics in
   let args =
@@ -1845,11 +1849,12 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs)
       ("translate_end_abstraction_synth_input:"
      ^ "\n\n- given back variables types:\n"
       ^ Print.list_to_string
-          (fun (v : var) -> ty_to_string ctx v.ty)
+          (fun (v : var) -> pure_ty_to_string ctx v.ty)
           given_back_variables
       ^ "\n\n- consumed values:\n"
       ^ Print.list_to_string
-          (fun e -> texpression_to_string ctx e ^ " : " ^ ty_to_string ctx e.ty)
+          (fun e ->
+            texpression_to_string ctx e ^ " : " ^ pure_ty_to_string ctx e.ty)
           consumed_values
       ^ "\n"));
 
@@ -1948,7 +1953,8 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs)
              ^ "\n- inst_sg.inputs ("
              ^ string_of_int (List.length inst_sg.inputs)
              ^ "): "
-             ^ String.concat ", " (List.map (ty_to_string ctx) inst_sg.inputs)));
+             ^ String.concat ", "
+                 (List.map (pure_ty_to_string ctx) inst_sg.inputs)));
          List.iter
            (fun (x, ty) -> assert ((x : texpression).ty = ty))
            (List.combine inputs inst_sg.inputs);
@@ -2070,8 +2076,9 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs)
       log#ldebug
         (lazy
           ("\n- given_back ty: "
-          ^ ty_to_string ctx given_back.ty
-          ^ "\n- sig input ty: " ^ ty_to_string ctx input.ty));
+          ^ pure_ty_to_string ctx given_back.ty
+          ^ "\n- sig input ty: "
+          ^ pure_ty_to_string ctx input.ty));
       assert (given_back.ty = input.ty))
     given_back_inputs;
   (* Translate the next expression *)
@@ -2098,7 +2105,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs)
       (* Actually the same case as [SynthInput] *)
       translate_end_abstraction_synth_input ectx abs e ctx rg_id
   | V.LoopCall ->
-      let fun_id = E.Regular ctx.fun_decl.A.def_id in
+      let fun_id = E.FRegular ctx.fun_decl.A.def_id in
       let effect_info =
         get_fun_effect_info ctx.fun_context.fun_infos (FunId fun_id)
           (Some vloop_id) (Some rg_id)
@@ -2229,7 +2236,7 @@ and translate_assertion (ectx : C.eval_ctx) (v : V.typed_value)
   let func =
     { id = FunOrOp (Fun (Pure Assert)); generics = empty_generic_args }
   in
-  let func_ty = mk_arrow (Literal Bool) mk_unit_ty in
+  let func_ty = mk_arrow (TLiteral TBool) mk_unit_ty in
   let func = { e = Qualif func; ty = func_ty } in
   let assertion = mk_apps func args in
   mk_let monadic (mk_dummy_pattern mk_unit_ty) assertion next_e
@@ -2325,12 +2332,12 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value)
         (* We don't need to update the context: we don't introduce any
            * new values/variables *)
         let branch = translate_expression branch_e ctx in
-        let pat = mk_typed_pattern_from_literal (PV.Scalar v) in
+        let pat = mk_typed_pattern_from_literal (PV.VScalar v) in
         { pat; branch }
       in
       let branches = List.map translate_branch branches in
       let otherwise = translate_expression otherwise ctx in
-      let pat_ty = Literal (Integer int_ty) in
+      let pat_ty = TLiteral (TInteger int_ty) in
       let otherwise_pat : typed_pattern = { value = PatDummy; ty = pat_ty } in
       let otherwise : match_branch =
         { pat = otherwise_pat; branch = otherwise }
@@ -2433,7 +2440,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value)
         (mk_simpl_tuple_pattern vars)
         (mk_opt_mplace_texpression scrutinee_mplace scrutinee)
         branch
-  | T.Assumed T.Box ->
+  | T.TAssumed T.TBox ->
       (* There should be exactly one variable *)
       let var =
         match vars with [ v ] -> v | _ -> raise (Failure "Unreachable")
@@ -2445,7 +2452,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value)
         (mk_typed_pattern_from_var var None)
         (mk_opt_mplace_texpression scrutinee_mplace scrutinee)
         branch
-  | T.Assumed (T.Array | T.Slice | T.Str) ->
+  | T.TAssumed (T.TArray | T.TSlice | T.TStr) ->
       (* We can't expand those values: we can access the fields only
        * through the functions provided by the API (note that we don't
        * know how to expand values like vectors or arrays, because they have a variable number
@@ -2469,19 +2476,19 @@ and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option)
   *)
   let v =
     match v with
-    | SingleValue v -> typed_value_to_texpression ctx ectx v
-    | Array values ->
+    | VaSingleValue v -> typed_value_to_texpression ctx ectx v
+    | VaArray values ->
         (* We use a struct update to encode the array aggregate, in order
            to preserve the structure and allow generating code of the shape
            `[x0, ...., xn]` *)
         let values = List.map (typed_value_to_texpression ctx ectx) values in
         let values = FieldId.mapi (fun fid v -> (fid, v)) values in
         let su : struct_update =
-          { struct_id = Assumed Array; init = None; updates = values }
+          { struct_id = TAssumed Array; init = None; updates = values }
         in
         { e = StructUpdate su; ty = var.ty }
-    | ConstGenericValue cg_id -> { e = CVar cg_id; ty = var.ty }
-    | TraitConstValue (trait_ref, generics, const_name) ->
+    | VaConstGenericValue cg_id -> { e = CVar cg_id; ty = var.ty }
+    | VaTraitConstValue (trait_ref, generics, const_name) ->
         let type_infos = ctx.type_context.type_infos in
         let trait_ref = translate_fwd_trait_ref type_infos trait_ref in
         let generics = translate_fwd_generic_args type_infos generics in
@@ -2558,7 +2565,7 @@ and translate_forward_end (ectx : C.eval_ctx)
       let org_args = args in
 
       (* Lookup the effect info for the loop function *)
-      let fid = E.Regular ctx.fun_decl.A.def_id in
+      let fid = E.FRegular ctx.fun_decl.A.def_id in
       let effect_info =
         get_fun_effect_info ctx.fun_context.fun_infos (FunId fid) None ctx.bid
       in
@@ -2661,7 +2668,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression =
         ^ T.RegionGroupId.Map.show
             (fun (rids, tys) ->
               "(" ^ T.RegionId.Set.show rids ^ ", "
-              ^ Print.list_to_string (rty_to_string ctx) tys
+              ^ Print.list_to_string (ty_to_string ctx) tys
               ^ ")")
             loop.rg_to_given_back_tys
         ^ "\n"));
@@ -2925,8 +2932,8 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl =
     | None -> None
     | Some body ->
         let effect_info =
-          get_fun_effect_info ctx.fun_context.fun_infos (FunId (Regular def_id))
-            None bid
+          get_fun_effect_info ctx.fun_context.fun_infos
+            (FunId (FRegular def_id)) None bid
         in
         let body = translate_expression body ctx in
         (* Add a match over the fuel, if necessary *)
@@ -2999,8 +3006,8 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl =
             ^ "\n- back_state: "
             ^ String.concat ", " (List.map show_var back_state)
             ^ "\n- signature.inputs: "
-            ^ String.concat ", " (List.map (ty_to_string ctx) signature.inputs)
-            ));
+            ^ String.concat ", "
+                (List.map (pure_ty_to_string ctx) signature.inputs)));
         (* TODO: we need to normalize the types *)
         if !Config.type_check_pure_code then
           assert (
@@ -3070,7 +3077,7 @@ let translate_fun_signatures (decls_ctx : C.decls_ctx)
     (* The backward functions *)
     let back_sgs =
       List.map
-        (fun (rg : T.region_var_group) ->
+        (fun (rg : T.region_group) ->
           let tsg =
             translate_fun_sig decls_ctx fun_id sg input_names (Some rg.id)
           in
diff --git a/compiler/SynthesizeSymbolic.ml b/compiler/SynthesizeSymbolic.ml
index 9dd65c84..edd67749 100644
--- a/compiler/SynthesizeSymbolic.ml
+++ b/compiler/SynthesizeSymbolic.ml
@@ -32,16 +32,16 @@ let synthesize_symbolic_expansion (sv : V.symbolic_value)
       (* Match on the symbolic value type to know which can of expansion happened *)
       let expansion =
         match sv.V.sv_ty with
-        | T.Literal PV.Bool -> (
+        | T.TLiteral PV.TBool -> (
             (* Boolean expansion: there should be two branches *)
             match ls with
             | [
-             (Some (V.SeLiteral (PV.Bool true)), true_exp);
-             (Some (V.SeLiteral (PV.Bool false)), false_exp);
+             (Some (V.SeLiteral (PV.VBool true)), true_exp);
+             (Some (V.SeLiteral (PV.VBool false)), false_exp);
             ] ->
                 ExpandBool (true_exp, false_exp)
             | _ -> raise (Failure "Ill-formed boolean expansion"))
-        | T.Literal (PV.Integer int_ty) ->
+        | T.TLiteral (PV.TInteger int_ty) ->
             (* Switch over an integer: split between the "regular" branches
                and the "otherwise" branch (which should be the last branch) *)
             let branches, otherwise = C.List.pop_last ls in
@@ -50,7 +50,7 @@ let synthesize_symbolic_expansion (sv : V.symbolic_value)
             let get_scalar (see : V.symbolic_expansion option) : V.scalar_value
                 =
               match see with
-              | Some (V.SeLiteral (PV.Scalar cv)) ->
+              | Some (V.SeLiteral (PV.VScalar cv)) ->
                   assert (cv.PV.int_ty = int_ty);
                   cv
               | _ -> raise (Failure "Unreachable")
@@ -64,7 +64,7 @@ let synthesize_symbolic_expansion (sv : V.symbolic_value)
             assert (otherwise_see = None);
             (* Return *)
             ExpandInt (int_ty, branches, otherwise)
-        | T.Adt (_, _) ->
+        | T.TAdt (_, _) ->
             (* Branching: it is necessarily an enumeration expansion *)
             let get_variant (see : V.symbolic_expansion option) :
                 T.VariantId.id option * V.symbolic_value list =
@@ -86,7 +86,7 @@ let synthesize_symbolic_expansion (sv : V.symbolic_value)
             | [ (Some see, exp) ] -> ExpandNoBranch (see, exp)
             | _ -> raise (Failure "Ill-formed borrow expansion"))
         | T.TypeVar _
-        | T.Literal Char
+        | T.TLiteral TChar
         | Never | T.TraitType _ | T.Arrow _ | T.RawPtr _ ->
             raise (Failure "Ill-formed symbolic expansion")
       in
@@ -99,7 +99,7 @@ let synthesize_symbolic_expansion_no_branching (sv : V.symbolic_value)
   synthesize_symbolic_expansion sv place [ Some see ] el
 
 let synthesize_function_call (call_id : call_id) (ctx : Contexts.eval_ctx)
-    (abstractions : V.AbstractionId.id list) (generics : T.egeneric_args)
+    (abstractions : V.AbstractionId.id list) (generics : T.generic_args)
     (args : V.typed_value list) (args_places : mplace option list)
     (dest : V.symbolic_value) (dest_place : mplace option)
     (e : expression option) : expression option =
@@ -126,7 +126,7 @@ let synthesize_global_eval (gid : A.GlobalDeclId.id) (dest : V.symbolic_value)
 
 let synthesize_regular_function_call (fun_id : A.fun_id_or_trait_method_ref)
     (call_id : V.FunCallId.id) (ctx : Contexts.eval_ctx)
-    (abstractions : V.AbstractionId.id list) (generics : T.egeneric_args)
+    (abstractions : V.AbstractionId.id list) (generics : T.generic_args)
     (args : V.typed_value list) (args_places : mplace option list)
     (dest : V.symbolic_value) (dest_place : mplace option)
     (e : expression option) : expression option =
@@ -171,7 +171,7 @@ let synthesize_loop (loop_id : V.LoopId.id)
     (input_svalues : V.symbolic_value list)
     (fresh_svalues : V.SymbolicValueId.Set.t)
     (rg_to_given_back_tys :
-      (T.RegionId.Set.t * T.rty list) T.RegionGroupId.Map.t)
+      (T.RegionId.Set.t * T.ty list) T.RegionGroupId.Map.t)
     (end_expr : expression option) (loop_expr : expression option) :
     expression option =
   match (end_expr, loop_expr) with
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index a3d96023..9a6addee 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -61,7 +61,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
 
   (* Initialize the context *)
   let forward_sig =
-    RegularFunIdNotLoopMap.find (E.Regular def_id, None) fun_sigs
+    RegularFunIdNotLoopMap.find (E.FRegular def_id, None) fun_sigs
   in
   let sv_to_var = V.SymbolicValueId.Map.empty in
   let var_counter = Pure.VarId.generator_zero in
@@ -188,7 +188,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
   in
 
   (* Translate the backward functions *)
-  let translate_backward (rg : T.region_var_group) : Pure.fun_decl =
+  let translate_backward (rg : T.region_group) : Pure.fun_decl =
     (* For the backward inputs/outputs initialization: we use the fact that
      * there are no nested borrows for now, and so that the region groups
      * can't have parents *)
@@ -200,7 +200,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
         (* Initialize the context - note that the ret_ty is not really
          * useful as we don't translate a body *)
         let backward_sg =
-          RegularFunIdNotLoopMap.find (Regular def_id, Some back_id) fun_sigs
+          RegularFunIdNotLoopMap.find (FRegular def_id, Some back_id) fun_sigs
         in
         let ctx = { ctx with bid = Some back_id; sg = backward_sg.sg } in
 
@@ -211,7 +211,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
            variables required by the backward function.
         *)
         let backward_sg =
-          RegularFunIdNotLoopMap.find (Regular def_id, Some back_id) fun_sigs
+          RegularFunIdNotLoopMap.find (FRegular def_id, Some back_id) fun_sigs
         in
         (* We need to ignore the forward inputs, and the state input (if there is) *)
         let backward_inputs =
@@ -298,7 +298,7 @@ let translate_crate_to_pure (crate : A.crate) :
   let assumed_sigs =
     List.map
       (fun (info : Assumed.assumed_fun_info) ->
-        ( E.Assumed info.fun_id,
+        ( E.FAssumed info.fun_id,
           List.map (fun _ -> None) info.fun_sig.inputs,
           info.fun_sig ))
       Assumed.assumed_fun_infos
@@ -314,7 +314,7 @@ let translate_crate_to_pure (crate : A.crate) :
                 (fun (v : A.var) -> v.name)
                 (LlbcAstUtils.fun_body_get_input_vars body)
         in
-        (E.Regular fdef.def_id, input_names, fdef.signature))
+        (E.FRegular fdef.def_id, input_names, fdef.signature))
       (A.FunDeclId.Map.values crate.functions)
   in
   let sigs = List.append assumed_sigs local_sigs in
diff --git a/compiler/TypesAnalysis.ml b/compiler/TypesAnalysis.ml
index 38d350b1..6318c624 100644
--- a/compiler/TypesAnalysis.ml
+++ b/compiler/TypesAnalysis.ml
@@ -77,9 +77,8 @@ let partial_type_info_to_type_decl_info (info : partial_type_info) :
 let partial_type_info_to_ty_info (info : partial_type_info) : ty_info =
   info.borrows_info
 
-let analyze_full_ty (r_is_static : 'r -> bool) (updated : bool ref)
-    (infos : type_infos) (ty_info : partial_type_info) (ty : 'r ty) :
-    partial_type_info =
+let analyze_full_ty (updated : bool ref) (infos : type_infos)
+    (ty_info : partial_type_info) (ty : ty) : partial_type_info =
   (* Small utility *)
   let check_update_bool (original : bool) (nv : bool) : bool =
     if nv && not original then (
@@ -87,6 +86,7 @@ let analyze_full_ty (r_is_static : 'r -> bool) (updated : bool ref)
       nv)
     else original
   in
+  let r_is_static (r : region) : bool = r = RStatic in
 
   (* Update a partial_type_info, while registering if we actually performed an update *)
   let update_ty_info (ty_info : partial_type_info)
@@ -119,9 +119,9 @@ let analyze_full_ty (r_is_static : 'r -> bool) (updated : bool ref)
 
   (* The recursive function which explores the type *)
   let rec analyze (expl_info : expl_info) (ty_info : partial_type_info)
-      (ty : 'r ty) : partial_type_info =
+      (ty : ty) : partial_type_info =
     match ty with
-    | Literal _ | Never | TraitType _ -> ty_info
+    | TLiteral _ | Never | TraitType _ -> ty_info
     | TypeVar var_id -> (
         (* Update the information for the proper parameter, if necessary *)
         match ty_info.param_infos with
@@ -171,12 +171,12 @@ let analyze_full_ty (r_is_static : 'r -> bool) (updated : bool ref)
     | RawPtr (rty, _) ->
         (* TODO: not sure what to do here *)
         analyze expl_info ty_info rty
-    | Adt ((Tuple | Assumed (Box | Slice | Array | Str)), generics) ->
+    | TAdt ((Tuple | TAssumed (TBox | TSlice | TArray | TStr)), generics) ->
         (* Nothing to update: just explore the type parameters *)
         List.fold_left
           (fun ty_info ty -> analyze expl_info ty_info ty)
           ty_info generics.types
-    | Adt (AdtId adt_id, generics) ->
+    | TAdt (AdtId adt_id, generics) ->
         (* Lookup the information for this type definition *)
         let adt_info = TypeDeclId.Map.find adt_id infos in
         (* Update the type info with the information from the adt *)
@@ -255,7 +255,7 @@ let analyze_type_decl (updated : bool ref) (infos : type_infos)
   if type_decl_is_opaque def then infos
   else
     (* Retrieve all the types of all the fields of all the variants *)
-    let fields_tys : sty list =
+    let fields_tys : ty list =
       match def.kind with
       | Struct fields -> List.map (fun f -> f.field_ty) fields
       | Enum variants ->
@@ -266,13 +266,12 @@ let analyze_type_decl (updated : bool ref) (infos : type_infos)
       | Opaque -> raise (Failure "unreachable")
     in
     (* Explore the types and accumulate information *)
-    let r_is_static r = r = Static in
     let type_decl_info = TypeDeclId.Map.find def.def_id infos in
     let type_decl_info = type_decl_info_to_partial_type_info type_decl_info in
     let type_decl_info =
       List.fold_left
         (fun type_decl_info ty ->
-          analyze_full_ty r_is_static updated infos type_decl_info ty)
+          analyze_full_ty updated infos type_decl_info ty)
         type_decl_info fields_tys
     in
     let type_decl_info = partial_type_info_to_type_decl_info type_decl_info in
@@ -324,12 +323,11 @@ let analyze_type_declarations (type_decls : type_decl TypeDeclId.Map.t)
 (** Analyze a type to check whether it contains borrows, etc., provided
     we have already analyzed the type definitions in the context.
  *)
-let analyze_ty (infos : type_infos) (ty : 'r ty) : ty_info =
+let analyze_ty (infos : type_infos) (ty : ty) : ty_info =
   (* We don't use [updated] but need to give it as parameter *)
   let updated = ref false in
   (* We don't need to compute whether the type contains 'static or not *)
-  let r_is_static _ = false in
   let ty_info = initialize_g_type_info None in
-  let ty_info = analyze_full_ty r_is_static updated infos ty_info ty in
+  let ty_info = analyze_full_ty updated infos ty_info ty in
   (* Convert the ty_info *)
   partial_type_info_to_ty_info ty_info
diff --git a/compiler/TypesUtils.ml b/compiler/TypesUtils.ml
index c7f0fbc3..54a12023 100644
--- a/compiler/TypesUtils.ml
+++ b/compiler/TypesUtils.ml
@@ -1,4 +1,5 @@
 open Types
+open Utils
 include Charon.TypesUtils
 module TA = TypesAnalysis
 
@@ -8,7 +9,7 @@ module TA = TypesAnalysis
     we erase the lists of regions (by replacing them with [[]] when using {!Types.ety},
     and when a type uses 'static this region doesn't appear in the region parameters.
  *)
-let ty_has_borrows (infos : TA.type_infos) (ty : 'r ty) : bool =
+let ty_has_borrows (infos : TA.type_infos) (ty : ty) : bool =
   let info = TA.analyze_ty infos ty in
   info.TA.contains_borrow
 
@@ -18,11 +19,91 @@ let ty_has_borrows (infos : TA.type_infos) (ty : 'r ty) : bool =
     we erase the lists of regions (by replacing them with [[]] when using {!Types.ety},
     and when a type uses 'static this region doesn't appear in the region parameters.
  *)
-let ty_has_nested_borrows (infos : TA.type_infos) (ty : 'r ty) : bool =
+let ty_has_nested_borrows (infos : TA.type_infos) (ty : ty) : bool =
   let info = TA.analyze_ty infos ty in
   info.TA.contains_nested_borrows
 
 (** Retuns true if the type contains a borrow under a mutable borrow *)
-let ty_has_borrow_under_mut (infos : TA.type_infos) (ty : 'r ty) : bool =
+let ty_has_borrow_under_mut (infos : TA.type_infos) (ty : ty) : bool =
   let info = TA.analyze_ty infos ty in
   info.TA.contains_borrow_under_mut
+
+(** Small helper *)
+let raise_if_erased_ty_visitor =
+  object
+    inherit [_] iter_ty
+    method! visit_RErased _ = raise Found
+  end
+
+(** Return [true] if the type is a region type (i.e., it doesn't contain erased regions) *)
+let ty_is_rty (ty : ty) : bool =
+  try
+    raise_if_erased_ty_visitor#visit_ty () ty;
+    true
+  with Found -> false
+
+(** Small helper *)
+let raise_if_not_erased_ty_visitor =
+  object
+    inherit [_] iter_ty
+    method! visit_RStatic _ = raise Found
+    method! visit_RVar _ = raise Found
+  end
+
+(** Return [true] if the type is a region type (i.e., it doesn't contain erased regions) *)
+let ty_is_ety (ty : ty) : bool =
+  try
+    raise_if_not_erased_ty_visitor#visit_ty () ty;
+    true
+  with Found -> false
+
+let generic_args_only_erased_regions (x : generic_args) : bool =
+  try
+    raise_if_not_erased_ty_visitor#visit_generic_args () x;
+    true
+  with Found -> false
+
+(** Small helper *)
+let raise_if_region_ty_visitor =
+  object
+    inherit [_] iter_ty
+    method! visit_region _ _ = raise Found
+  end
+
+(** Return [true] if the type doesn't contain regions (including erased regions) *)
+let ty_no_regions (ty : ty) : bool =
+  try
+    raise_if_region_ty_visitor#visit_ty () ty;
+    true
+  with Found -> false
+
+(** Return [true] if the trait ref doesn't contain regions (including erased regions) *)
+let trait_ref_no_regions (x : trait_ref) : bool =
+  try
+    raise_if_region_ty_visitor#visit_trait_ref () x;
+    true
+  with Found -> false
+
+(** Return [true] if the trait instance id doesn't contain regions (including erased regions) *)
+let trait_instance_id_no_regions (x : trait_instance_id) : bool =
+  try
+    raise_if_region_ty_visitor#visit_trait_instance_id () x;
+    true
+  with Found -> false
+
+(** Return [true] if the generic args don't contain regions (including erased regions) *)
+let generic_args_no_regions (x : generic_args) : bool =
+  try
+    raise_if_region_ty_visitor#visit_generic_args () x;
+    true
+  with Found -> false
+
+(** Return [true] if the trait type constraint doesn't contain regions (including erased regions) *)
+let trait_type_constraint_no_regions (x : trait_type_constraint) : bool =
+  try
+    let { trait_ref; generics; type_name = _; ty } = x in
+    raise_if_region_ty_visitor#visit_trait_ref () trait_ref;
+    raise_if_region_ty_visitor#visit_generic_args () generics;
+    raise_if_region_ty_visitor#visit_ty () ty;
+    true
+  with Found -> false
diff --git a/compiler/Values.ml b/compiler/Values.ml
index de27e7a9..8526ea66 100644
--- a/compiler/Values.ml
+++ b/compiler/Values.ml
@@ -58,55 +58,6 @@ type sv_kind =
       (** A symbolic value we introduce when evaluating a trait associated constant *)
 [@@deriving show, ord]
 
-(** Ancestor for {!symbolic_value} iter visitor *)
-class ['self] iter_symbolic_value_base =
-  object (_self : 'self)
-    inherit [_] VisitorsRuntime.iter
-    method visit_sv_kind : 'env -> sv_kind -> unit = fun _ _ -> ()
-    method visit_rty : 'env -> rty -> unit = fun _ _ -> ()
-
-    method visit_symbolic_value_id : 'env -> symbolic_value_id -> unit =
-      fun _ _ -> ()
-  end
-
-(** Ancestor for {!symbolic_value} map visitor for *)
-class ['self] map_symbolic_value_base =
-  object (_self : 'self)
-    inherit [_] VisitorsRuntime.map
-    method visit_sv_kind : 'env -> sv_kind -> sv_kind = fun _ x -> x
-    method visit_rty : 'env -> rty -> rty = fun _ x -> x
-
-    method visit_symbolic_value_id
-        : 'env -> symbolic_value_id -> symbolic_value_id =
-      fun _ x -> x
-  end
-
-(** A symbolic value *)
-type symbolic_value = {
-  sv_kind : sv_kind;
-  sv_id : symbolic_value_id;
-  sv_ty : rty;
-}
-[@@deriving
-  show,
-    ord,
-    visitors
-      {
-        name = "iter_symbolic_value";
-        variety = "iter";
-        ancestors = [ "iter_symbolic_value_base" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      },
-    visitors
-      {
-        name = "map_symbolic_value";
-        variety = "map";
-        ancestors = [ "map_symbolic_value_base" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      }]
-
 type borrow_id = BorrowId.id [@@deriving show, ord]
 type borrow_id_set = BorrowId.Set.t [@@deriving show, ord]
 type loan_id = BorrowId.id [@@deriving show, ord]
@@ -115,11 +66,13 @@ type loan_id_set = BorrowId.Set.t [@@deriving show, ord]
 (** Ancestor for {!typed_value} iter visitor *)
 class ['self] iter_typed_value_base =
   object (self : 'self)
-    inherit [_] iter_symbolic_value
-    method visit_literal : 'env -> literal -> unit = fun _ _ -> ()
-    method visit_erased_region : 'env -> erased_region -> unit = fun _ _ -> ()
+    inherit [_] iter_ty
+    method visit_sv_kind : 'env -> sv_kind -> unit = fun _ _ -> ()
+
+    method visit_symbolic_value_id : 'env -> symbolic_value_id -> unit =
+      fun _ _ -> ()
+
     method visit_variant_id : 'env -> variant_id -> unit = fun _ _ -> ()
-    method visit_ety : 'env -> ety -> unit = fun _ _ -> ()
     method visit_borrow_id : 'env -> borrow_id -> unit = fun _ _ -> ()
     method visit_loan_id : 'env -> loan_id -> unit = fun _ _ -> ()
 
@@ -133,13 +86,13 @@ class ['self] iter_typed_value_base =
 (** Ancestor for {!typed_value} map visitor for *)
 class ['self] map_typed_value_base =
   object (self : 'self)
-    inherit [_] map_symbolic_value
-    method visit_literal : 'env -> literal -> literal = fun _ cv -> cv
+    inherit [_] map_ty
+    method visit_sv_kind : 'env -> sv_kind -> sv_kind = fun _ x -> x
 
-    method visit_erased_region : 'env -> erased_region -> erased_region =
-      fun _ r -> r
+    method visit_symbolic_value_id
+        : 'env -> symbolic_value_id -> symbolic_value_id =
+      fun _ x -> x
 
-    method visit_ety : 'env -> ety -> ety = fun _ ty -> ty
     method visit_variant_id : 'env -> variant_id -> variant_id = fun _ x -> x
     method visit_borrow_id : 'env -> borrow_id -> borrow_id = fun _ id -> id
     method visit_loan_id : 'env -> loan_id -> loan_id = fun _ id -> id
@@ -151,10 +104,17 @@ class ['self] map_typed_value_base =
       fun env ids -> BorrowId.Set.map (self#visit_loan_id env) ids
   end
 
-(** An untyped value, used in the environments *)
-type value =
-  | Literal of literal  (** Non-symbolic primitive value *)
-  | Adt of adt_value  (** Enumerations and structures *)
+(** A symbolic value *)
+type symbolic_value = {
+  sv_kind : sv_kind;
+  sv_id : symbolic_value_id;
+  sv_ty : ty;  (** This should be a type with regions *)
+}
+
+(** An untyped value, used in the environments - TODO: prefix the names with "V" *)
+and value =
+  | VLiteral of literal  (** Non-symbolic primitive value *)
+  | VAdt of adt_value  (** Enumerations and structures *)
   | Bottom  (** No value (uninitialized or moved value) *)
   | Borrow of borrow_content  (** A borrowed value *)
   | Loan of loan_content  (** A loaned value *)
@@ -215,25 +175,14 @@ and loan_content =
   | SharedLoan of loan_id_set * typed_value
   | MutLoan of loan_id
 
-(** "Meta"-value: information we store for the synthesis.
-
-     Note that we never automatically visit the meta-values with the
-     visitors: they really are meta information, and shouldn't be considered
-     as part of the environment during a symbolic execution.
-     
-     TODO: we may want to create wrappers, to prevent accidently mixing meta
-     values and regular values.
- *)
-and mvalue = typed_value
-
 (** "Regular" typed value (we map variables to typed values) *)
-and typed_value = { value : value; ty : ety }
+and typed_value = { value : value; ty : ty }
 [@@deriving
   show,
     ord,
     visitors
       {
-        name = "iter_typed_value_visit_mvalue";
+        name = "iter_typed_value";
         variety = "iter";
         ancestors = [ "iter_typed_value_base" ];
         nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
@@ -241,13 +190,24 @@ and typed_value = { value : value; ty : ety }
       },
     visitors
       {
-        name = "map_typed_value_visit_mvalue";
+        name = "map_typed_value";
         variety = "map";
         ancestors = [ "map_typed_value_base" ];
         nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
         concrete = true;
       }]
 
+(** "Meta"-value: information we store for the synthesis.
+
+     Note that we never automatically visit the meta-values with the
+     visitors: they really are meta information, and shouldn't be considered
+     as part of the environment during a symbolic execution.
+
+     TODO: we may want to create wrappers, to prevent accidently mixing meta
+     values and regular values.
+ *)
+type mvalue = typed_value [@@deriving show, ord]
+
 (** "Meta"-symbolic value.
 
      See the explanations for {!mvalue}
@@ -257,28 +217,47 @@ and typed_value = { value : value; ty : ety }
  *)
 type msymbolic_value = symbolic_value [@@deriving show, ord]
 
-class ['self] iter_typed_value =
-  object (_self : 'self)
-    inherit [_] iter_typed_value_visit_mvalue
+type region_id = RegionId.id [@@deriving show, ord]
+type region_id_set = RegionId.Set.t [@@deriving show, ord]
+type abstraction_id = AbstractionId.id [@@deriving show, ord]
+type abstraction_id_set = AbstractionId.Set.t [@@deriving show, ord]
 
-    (** We have to override the {!iter_typed_value_visit_mvalue.visit_mvalue} method,
-        to ignore meta-values *)
-    method! visit_mvalue : 'env -> mvalue -> unit = fun _ _ -> ()
+(** Ancestor for {!typed_avalue} iter visitor *)
+class ['self] iter_typed_avalue_base =
+  object (self : 'self)
+    inherit [_] iter_typed_value
+    method visit_mvalue : 'env -> mvalue -> unit = fun _ _ -> ()
 
     method visit_msymbolic_value : 'env -> msymbolic_value -> unit =
       fun _ _ -> ()
-  end
 
-class ['self] map_typed_value =
-  object (_self : 'self)
-    inherit [_] map_typed_value_visit_mvalue
+    method visit_region_id_set : 'env -> region_id_set -> unit =
+      fun env ids -> RegionId.Set.iter (self#visit_region_id env) ids
+
+    method visit_abstraction_id : 'env -> abstraction_id -> unit = fun _ _ -> ()
 
-    (** We have to override the {!iter_typed_value_visit_mvalue.visit_mvalue} method,
-        to ignore meta-values *)
-    method! visit_mvalue : 'env -> mvalue -> mvalue = fun _ x -> x
+    method visit_abstraction_id_set : 'env -> abstraction_id_set -> unit =
+      fun env ids -> AbstractionId.Set.iter (self#visit_abstraction_id env) ids
+  end
+
+(** Ancestor for {!typed_avalue} map visitor *)
+class ['self] map_typed_avalue_base =
+  object (self : 'self)
+    inherit [_] map_typed_value
+    method visit_mvalue : 'env -> mvalue -> mvalue = fun _ x -> x
 
     method visit_msymbolic_value : 'env -> msymbolic_value -> msymbolic_value =
       fun _ m -> m
+
+    method visit_region_id_set : 'env -> region_id_set -> region_id_set =
+      fun env ids -> RegionId.Set.map (self#visit_region_id env) ids
+
+    method visit_abstraction_id : 'env -> abstraction_id -> abstraction_id =
+      fun _ x -> x
+
+    method visit_abstraction_id_set
+        : 'env -> abstraction_id_set -> abstraction_id_set =
+      fun env ids -> AbstractionId.Set.map (self#visit_abstraction_id env) ids
   end
 
 (** When giving shared borrows to functions (i.e., inserting shared borrows inside
@@ -297,62 +276,12 @@ class ['self] map_typed_value =
 *)
 type abstract_shared_borrow =
   | AsbBorrow of borrow_id
-  | AsbProjReborrows of symbolic_value * rty
-[@@deriving
-  show,
-    ord,
-    visitors
-      {
-        name = "iter_abstract_shared_borrow";
-        variety = "iter";
-        ancestors = [ "iter_typed_value" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      },
-    visitors
-      {
-        name = "map_abstract_shared_borrow";
-        variety = "map";
-        ancestors = [ "map_typed_value" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      }]
+  | AsbProjReborrows of symbolic_value * ty
 
 (** A set of abstract shared borrows *)
-type abstract_shared_borrows = abstract_shared_borrow list
-[@@deriving
-  show,
-    ord,
-    visitors
-      {
-        name = "iter_abstract_shared_borrows";
-        variety = "iter";
-        ancestors = [ "iter_abstract_shared_borrow" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      },
-    visitors
-      {
-        name = "map_abstract_shared_borrows";
-        variety = "map";
-        ancestors = [ "map_abstract_shared_borrow" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      }]
-
-(** Ancestor for {!aproj} iter visitor *)
-class ['self] iter_aproj_base =
-  object (_self : 'self)
-    inherit [_] iter_abstract_shared_borrows
-  end
-
-(** Ancestor for {!aproj} map visitor *)
-class ['self] map_aproj_base =
-  object (_self : 'self)
-    inherit [_] map_abstract_shared_borrows
-  end
+and abstract_shared_borrows = abstract_shared_borrow list
 
-type aproj =
+and aproj =
   | AProjLoans of symbolic_value * (msymbolic_value * aproj) list
       (** A projector of loans over a symbolic value.
       
@@ -393,7 +322,7 @@ type aproj =
           anywhere in the context below a projector of borrows which intersects
           this projector of loans.
        *)
-  | AProjBorrows of symbolic_value * rty
+  | AProjBorrows of symbolic_value * ty
       (** Note that an AProjBorrows only operates on a value which is not below
           a shared loan: under a shared loan, we use {!abstract_shared_borrow}.
           
@@ -414,82 +343,6 @@ type aproj =
           ending the borrow.
        *)
   | AIgnoredProjBorrows
-[@@deriving
-  show,
-    ord,
-    visitors
-      {
-        name = "iter_aproj";
-        variety = "iter";
-        ancestors = [ "iter_aproj_base" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      },
-    visitors
-      {
-        name = "map_aproj";
-        variety = "map";
-        ancestors = [ "map_aproj_base" ];
-        nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
-        concrete = true;
-      }]
-
-type region = RegionVarId.id Types.region [@@deriving show, ord]
-type region_var_id = RegionVarId.id [@@deriving show, ord]
-type region_id = RegionId.id [@@deriving show, ord]
-type region_id_set = RegionId.Set.t [@@deriving show, ord]
-type abstraction_id = AbstractionId.id [@@deriving show, ord]
-type abstraction_id_set = AbstractionId.Set.t [@@deriving show, ord]
-
-(** Ancestor for {!typed_avalue} iter visitor *)
-class ['self] iter_typed_avalue_base =
-  object (self : 'self)
-    inherit [_] iter_aproj
-    method visit_region_var_id : 'env -> region_var_id -> unit = fun _ _ -> ()
-
-    method visit_region : 'env -> region -> unit =
-      fun env r ->
-        match r with
-        | Static -> ()
-        | Var rid -> self#visit_region_var_id env rid
-
-    method visit_region_id : 'env -> region_id -> unit = fun _ _ -> ()
-
-    method visit_region_id_set : 'env -> region_id_set -> unit =
-      fun env ids -> RegionId.Set.iter (self#visit_region_id env) ids
-
-    method visit_abstraction_id : 'env -> abstraction_id -> unit = fun _ _ -> ()
-
-    method visit_abstraction_id_set : 'env -> abstraction_id_set -> unit =
-      fun env ids -> AbstractionId.Set.iter (self#visit_abstraction_id env) ids
-  end
-
-(** Ancestor for {!typed_avalue} map visitor *)
-class ['self] map_typed_avalue_base =
-  object (self : 'self)
-    inherit [_] map_aproj
-
-    method visit_region_var_id : 'env -> region_var_id -> region_var_id =
-      fun _ x -> x
-
-    method visit_region : 'env -> region -> region =
-      fun env r ->
-        match r with
-        | Static -> Static
-        | Var rid -> Var (self#visit_region_var_id env rid)
-
-    method visit_region_id : 'env -> region_id -> region_id = fun _ x -> x
-
-    method visit_region_id_set : 'env -> region_id_set -> region_id_set =
-      fun env ids -> RegionId.Set.map (self#visit_region_id env) ids
-
-    method visit_abstraction_id : 'env -> abstraction_id -> abstraction_id =
-      fun _ x -> x
-
-    method visit_abstraction_id_set
-        : 'env -> abstraction_id_set -> abstraction_id_set =
-      fun env ids -> AbstractionId.Set.map (self#visit_abstraction_id env) ids
-  end
 
 (** Abstraction values are used inside of abstractions to properly model
     borrowing relations introduced by function calls.
@@ -497,7 +350,7 @@ class ['self] map_typed_avalue_base =
     When calling a function, we lose information about the borrow graph:
     part of it is thus "abstracted" away.
 *)
-type avalue =
+and avalue =
   | AAdt of adt_avalue
   | ABottom (* TODO: remove once we change the way internal borrows are ended *)
   | ALoan of aloan_content
@@ -875,7 +728,10 @@ and aborrow_content =
     To be more precise, shared aloans have the borrow type (i.e., a shared aloan
     has type [& (mut) T] instead of [T]).
  *)
-and typed_avalue = { value : avalue; ty : rty }
+and typed_avalue = {
+  value : avalue;
+  ty : ty;  (** This should be a type with regions *)
+}
 [@@deriving
   show,
     ord,
diff --git a/compiler/ValuesUtils.ml b/compiler/ValuesUtils.ml
index 527434c1..24485002 100644
--- a/compiler/ValuesUtils.ml
+++ b/compiler/ValuesUtils.ml
@@ -9,13 +9,27 @@ include PrimitiveValuesUtils
 exception FoundSymbolicValue of symbolic_value
 
 let mk_unit_value : typed_value =
-  { value = Adt { variant_id = None; field_values = [] }; ty = mk_unit_ty }
+  { value = VAdt { variant_id = None; field_values = [] }; ty = mk_unit_ty }
 
-let mk_typed_value (ty : ety) (value : value) : typed_value = { value; ty }
-let mk_typed_avalue (ty : rty) (value : avalue) : typed_avalue = { value; ty }
-let mk_bottom (ty : ety) : typed_value = { value = Bottom; ty }
-let mk_abottom (ty : rty) : typed_avalue = { value = ABottom; ty }
-let mk_aignored (ty : rty) : typed_avalue = { value = AIgnored; ty }
+let mk_typed_value (ty : ty) (value : value) : typed_value =
+  assert (ty_is_ety ty);
+  { value; ty }
+
+let mk_typed_avalue (ty : ty) (value : avalue) : typed_avalue =
+  assert (ty_is_rty ty);
+  { value; ty }
+
+let mk_bottom (ty : ty) : typed_value =
+  assert (ty_is_ety ty);
+  { value = Bottom; ty }
+
+let mk_abottom (ty : ty) : typed_avalue =
+  assert (ty_is_rty ty);
+  { value = ABottom; ty }
+
+let mk_aignored (ty : ty) : typed_avalue =
+  assert (ty_is_rty ty);
+  { value = AIgnored; ty }
 
 let value_as_symbolic (v : value) : symbolic_value =
   match v with Symbolic v -> v | _ -> raise (Failure "Unexpected")
@@ -23,7 +37,7 @@ let value_as_symbolic (v : value) : symbolic_value =
 (** Box a value *)
 let mk_box_value (v : typed_value) : typed_value =
   let box_ty = mk_box_ty v.ty in
-  let box_v = Adt { variant_id = None; field_values = [ v ] } in
+  let box_v = VAdt { variant_id = None; field_values = [ v ] } in
   mk_typed_value box_ty box_v
 
 let is_bottom (v : value) : bool = match v with Bottom -> true | _ -> false
@@ -46,7 +60,7 @@ let is_unit (v : typed_value) : bool =
   ty_is_unit v.ty
   &&
   match v.value with
-  | Adt av -> av.variant_id = None && av.field_values = []
+  | VAdt av -> av.variant_id = None && av.field_values = []
   | _ -> false
 
 (** Check if a value contains a *concrete* borrow (i.e., a [Borrow] value -
-- 
cgit v1.3.1


From 6c88d30031255c0ac612b67bb5b3c20c2f07e563 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 13 Nov 2023 13:27:02 +0100
Subject: Add RegionsHierarchy.ml

---
 compiler/AssociatedTypes.ml       |   5 +-
 compiler/Assumed.ml               |  18 +--
 compiler/Contexts.ml              |   2 +
 compiler/ExtractBase.ml           |   8 +-
 compiler/Interpreter.ml           |  28 +++--
 compiler/InterpreterStatements.ml |   2 +-
 compiler/InterpreterUtils.ml      |   9 +-
 compiler/LlbcAstUtils.ml          |  13 ++
 compiler/PureMicroPasses.ml       |   9 +-
 compiler/RegionsHierarchy.ml      | 243 ++++++++++++++++++++++++++++++++++++++
 compiler/ReorderDecls.ml          |  97 +--------------
 compiler/SCC.ml                   | 121 +++++++++++++++++--
 compiler/Substitute.ml            |  12 +-
 compiler/SymbolicToPure.ml        |  25 ++--
 compiler/Translate.ml             |   7 +-
 compiler/dune                     |   1 +
 16 files changed, 453 insertions(+), 147 deletions(-)
 create mode 100644 compiler/RegionsHierarchy.ml

(limited to 'compiler/Translate.ml')

diff --git a/compiler/AssociatedTypes.ml b/compiler/AssociatedTypes.ml
index d5c9596e..27e08495 100644
--- a/compiler/AssociatedTypes.ml
+++ b/compiler/AssociatedTypes.ml
@@ -521,10 +521,11 @@ let ctx_subst_norm_signature (ctx : C.eval_ctx)
     (ty_subst : T.TypeVarId.id -> T.ty)
     (cg_subst : T.ConstGenericVarId.id -> T.const_generic)
     (tr_subst : T.TraitClauseId.id -> T.trait_instance_id)
-    (tr_self : T.trait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig =
+    (tr_self : T.trait_instance_id) (sg : A.fun_sig)
+    (regions_hierarchy : T.region_groups) : A.inst_fun_sig =
   let sg =
     Subst.substitute_signature asubst r_subst ty_subst cg_subst tr_subst tr_self
-      sg
+      sg regions_hierarchy
   in
   let { A.regions_hierarchy; inputs; output; trait_type_constraints } = sg in
   let inputs = List.map (ctx_normalize_ty ctx) inputs in
diff --git a/compiler/Assumed.ml b/compiler/Assumed.ml
index cf81502c..aa0cfccf 100644
--- a/compiler/Assumed.ml
+++ b/compiler/Assumed.ml
@@ -79,7 +79,7 @@ module Sig = struct
   let mk_slice_ty (ty : T.ty) : T.ty =
     TAdt (TAssumed TSlice, mk_generic_args [] [ ty ] [])
 
-  let mk_sig generics regions_hierarchy inputs output : A.fun_sig =
+  let mk_sig generics inputs output : A.fun_sig =
     let preds : T.predicates =
       { regions_outlive = []; types_outlive = []; trait_type_constraints = [] }
     in
@@ -88,7 +88,6 @@ module Sig = struct
       generics;
       preds;
       parent_params_info = None;
-      regions_hierarchy;
       inputs;
       output;
     }
@@ -96,18 +95,16 @@ module Sig = struct
   (** [fn<T>(T) -> Box<T>] *)
   let box_new_sig : A.fun_sig =
     let generics = mk_generic_params [] [ type_param_0 ] [] (* <T> *) in
-    let regions_hierarchy = [] in
     let inputs = [ tvar_0 (* T *) ] in
     let output = mk_box_ty tvar_0 (* Box<T> *) in
-    mk_sig generics regions_hierarchy inputs output
+    mk_sig generics inputs output
 
   (** [fn<T>(Box<T>) -> ()] *)
   let box_free_sig : A.fun_sig =
     let generics = mk_generic_params [] [ type_param_0 ] [] (* <T> *) in
-    let regions_hierarchy = [] in
     let inputs = [ mk_box_ty tvar_0 (* Box<T> *) ] in
     let output = mk_unit_ty (* () *) in
-    mk_sig generics regions_hierarchy inputs output
+    mk_sig generics inputs output
 
   (** Array/slice functions *)
 
@@ -129,7 +126,6 @@ module Sig = struct
     let generics =
       mk_generic_params [ region_param_0 ] [ type_param_0 ] cgs (* <'a, T> *)
     in
-    let regions_hierarchy = [ region_group_0 ] (* <'a> *) in
     let inputs =
       [
         mk_ref_ty rvar_0
@@ -145,7 +141,7 @@ module Sig = struct
         (output_ty type_param_0.index)
         is_mut (* &'a (mut) output_ty<T> *)
     in
-    mk_sig generics regions_hierarchy inputs output
+    mk_sig generics inputs output
 
   let mk_array_slice_index_sig (is_array : bool) (is_mut : bool) : A.fun_sig =
     (* Array<T, N> *)
@@ -176,13 +172,12 @@ module Sig = struct
       (* <T, N> *)
       mk_generic_params [] [ type_param_0 ] [ cg_param_0 ]
     in
-    let regions_hierarchy = [] (* <> *) in
     let inputs = [ tvar_0 (* T *) ] in
     let output =
       (* [T; N] *)
       mk_array_ty tvar_0 cgvar_0
     in
-    mk_sig generics regions_hierarchy inputs output
+    mk_sig generics inputs output
 
   (** Helper:
       [fn<T>(&'a [T]) -> usize]
@@ -191,12 +186,11 @@ module Sig = struct
     let generics =
       mk_generic_params [ region_param_0 ] [ type_param_0 ] [] (* <'a, T> *)
     in
-    let regions_hierarchy = [ region_group_0 ] (* <'a> *) in
     let inputs =
       [ mk_ref_ty rvar_0 (mk_slice_ty tvar_0) false (* &'a [T] *) ]
     in
     let output = mk_usize_ty (* usize *) in
-    mk_sig generics regions_hierarchy inputs output
+    mk_sig generics inputs output
 end
 
 type raw_assumed_fun_info =
diff --git a/compiler/Contexts.ml b/compiler/Contexts.ml
index 9a20a6cc..12927aab 100644
--- a/compiler/Contexts.ml
+++ b/compiler/Contexts.ml
@@ -2,6 +2,7 @@ open Types
 open Expressions
 open Values
 open LlbcAst
+open LlbcAstUtils
 module V = Values
 open ValuesUtils
 open Identifiers
@@ -190,6 +191,7 @@ type type_context = {
 type fun_context = {
   fun_decls : fun_decl FunDeclId.Map.t;
   fun_infos : FunsAnalysis.fun_info FunDeclId.Map.t;
+  regions_hierarchies : T.region_groups FunIdMap.t;
 }
 [@@deriving show]
 
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index d5eac6f4..4ce1e9f1 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1188,14 +1188,18 @@ let ctx_compute_fun_name (trans_group : pure_fun_translation) (def : fun_decl)
   let def_id = def.def_id in
   let llbc_def = A.FunDeclId.Map.find def_id ctx.trans_ctx.fun_ctx.fun_decls in
   let sg = llbc_def.signature in
-  let num_rgs = List.length sg.regions_hierarchy in
+  let regions_hierarchy =
+    LlbcAstUtils.FunIdMap.find (FRegular def_id)
+      ctx.trans_ctx.fun_ctx.regions_hierarchies
+  in
+  let num_rgs = List.length regions_hierarchy in
   let { keep_fwd; fwd = _; backs } = trans_group in
   let num_backs = List.length backs in
   let rg_info =
     match def.back_id with
     | None -> None
     | Some rg_id ->
-        let rg = T.RegionGroupId.nth sg.regions_hierarchy rg_id in
+        let rg = T.RegionGroupId.nth regions_hierarchy rg_id in
         let region_names =
           List.map
             (fun rid -> (T.RegionId.nth sg.generics.regions rid).name)
diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml
index 395c0c80..69c9af62 100644
--- a/compiler/Interpreter.ml
+++ b/compiler/Interpreter.ml
@@ -29,7 +29,10 @@ let compute_contexts (m : A.crate) : C.decls_ctx =
   let fun_infos =
     FunsAnalysis.analyze_module m fun_decls global_decls !Config.use_state
   in
-  let fun_ctx = { C.fun_decls; fun_infos } in
+  let regions_hierarchies =
+    RegionsHierarchy.compute_regions_hierarchies type_decls fun_decls
+  in
+  let fun_ctx = { C.fun_decls; fun_infos; regions_hierarchies } in
   let global_ctx = { C.global_decls } in
   let trait_decls_ctx = { C.trait_decls } in
   let trait_impls_ctx = { C.trait_impls } in
@@ -124,8 +127,8 @@ let symbolic_instantiate_fun_sig (ctx : C.eval_ctx) (sg : A.fun_sig)
       List.fold_left_map
         (fun tr_map (c : T.trait_clause) ->
           let subst = mk_subst tr_map in
-          let { T.trait_id = trait_decl_id; generics; _ } = c in
-          let generics = Subst.generic_args_substitute subst generics in
+          let { T.trait_id = trait_decl_id; clause_generics; _ } = c in
+          let generics = Subst.generic_args_substitute subst clause_generics in
           let trait_decl_ref = { T.trait_decl_id; decl_generics = generics } in
           (* Note that because we directly refer to the clause, we give it
              empty generics *)
@@ -183,8 +186,11 @@ let initialize_symbolic_context_for_fun (ctx : C.decls_ctx) (fdef : A.fun_decl)
    * *)
   let sg = fdef.signature in
   (* Create the context *)
+  let regions_hierarchy =
+    FunIdMap.find (FRegular fdef.def_id) ctx.fun_ctx.regions_hierarchies
+  in
   let region_groups =
-    List.map (fun (g : T.region_group) -> g.id) sg.regions_hierarchy
+    List.map (fun (g : T.region_group) -> g.id) regions_hierarchy
   in
   let ctx =
     initialize_eval_context ctx region_groups sg.generics.types
@@ -269,7 +275,6 @@ let evaluate_function_symbolic_synthesize_backward_from_return
    * the return type. Note that it is important to re-generate
    * an instantiation of the signature, so that we use fresh
    * region ids for the return abstractions. *)
-  let sg = fdef.signature in
   let _, ret_inst_sg =
     symbolic_instantiate_fun_sig ctx fdef.signature fdef.kind
   in
@@ -282,7 +287,10 @@ let evaluate_function_symbolic_synthesize_backward_from_return
    * will end - this will allow us to, first, mark the other return
    * regions as non-endable, and, second, end those parent regions in
    * proper order. *)
-  let parent_rgs = list_ancestor_region_groups sg back_id in
+  let regions_hierarchy =
+    FunIdMap.find (FRegular fdef.def_id) ctx.fun_context.regions_hierarchies
+  in
+  let parent_rgs = list_ancestor_region_groups regions_hierarchy back_id in
   let parent_input_abs_ids =
     T.RegionGroupId.mapi
       (fun rg_id rg ->
@@ -455,6 +463,10 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : C.decls_ctx)
   (* Create the evaluation context *)
   let ctx, input_svs, inst_sg = initialize_symbolic_context_for_fun ctx fdef in
 
+  let regions_hierarchy =
+    FunIdMap.find (FRegular fdef.def_id) ctx.fun_context.regions_hierarchies
+  in
+
   (* Create the continuation to finish the evaluation *)
   let config = C.mk_config C.SymbolicMode in
   let cf_finish res ctx =
@@ -511,7 +523,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : C.decls_ctx)
           let back_el =
             T.RegionGroupId.mapi
               (fun gid _ -> (gid, finish_back_eval gid))
-              fdef.signature.regions_hierarchy
+              regions_hierarchy
           in
           let back_el = T.RegionGroupId.Map.of_list back_el in
           (* Put everything together *)
@@ -555,7 +567,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : C.decls_ctx)
           let back_el =
             T.RegionGroupId.mapi
               (fun gid _ -> (gid, finish_back_eval gid))
-              fdef.signature.regions_hierarchy
+              regions_hierarchy
           in
           let back_el = T.RegionGroupId.Map.of_list back_el in
           (* Put everything together *)
diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml
index cbc09c29..3627490d 100644
--- a/compiler/InterpreterStatements.ml
+++ b/compiler/InterpreterStatements.ml
@@ -1434,7 +1434,7 @@ and eval_assumed_function_call_symbolic (config : C.config)
       let inst_sig =
         match fid with
         | BoxFree ->
-            (* should have been treated above *)
+            (* Should have been treated above *)
             raise (Failure "Unreachable")
         | _ ->
             (* There shouldn't be any reference to Self *)
diff --git a/compiler/InterpreterUtils.ml b/compiler/InterpreterUtils.ml
index 60747b2a..5e2746c5 100644
--- a/compiler/InterpreterUtils.ml
+++ b/compiler/InterpreterUtils.ml
@@ -474,6 +474,11 @@ let instantiate_fun_sig (ctx : C.eval_ctx) (generics : T.generic_args)
   (* Erase the regions in the generics we use for the instantiation *)
   let generics = Subst.generic_args_erase_regions generics in
   let tr_self = Subst.trait_instance_id_erase_regions tr_self in
+  (* Compute the regions hierarchy *)
+  let regions_hierarchy =
+    RegionsHierarchy.compute_regions_hierarchy_for_sig
+      ctx.type_context.type_decls sg
+  in
   (* Generate fresh abstraction ids and create a substitution from region
    * group ids to abstraction ids *)
   let rg_abs_ids_bindings =
@@ -481,7 +486,7 @@ let instantiate_fun_sig (ctx : C.eval_ctx) (generics : T.generic_args)
       (fun rg ->
         let abs_id = C.fresh_abstraction_id () in
         (rg.T.id, abs_id))
-      sg.regions_hierarchy
+      regions_hierarchy
   in
   let asubst_map : V.AbstractionId.id T.RegionGroupId.Map.t =
     List.fold_left
@@ -512,7 +517,7 @@ let instantiate_fun_sig (ctx : C.eval_ctx) (generics : T.generic_args)
   (* Substitute the signature *)
   let inst_sig =
     AssociatedTypes.ctx_subst_norm_signature ctx asubst rsubst tsubst cgsubst
-      tr_subst tr_self sg
+      tr_subst tr_self sg regions_hierarchy
   in
   (* Return *)
   inst_sig
diff --git a/compiler/LlbcAstUtils.ml b/compiler/LlbcAstUtils.ml
index 46b36851..de46320b 100644
--- a/compiler/LlbcAstUtils.ml
+++ b/compiler/LlbcAstUtils.ml
@@ -1,5 +1,18 @@
 open LlbcAst
 include Charon.LlbcAstUtils
+open Collections
+
+module FunIdOrderedType : OrderedType with type t = fun_id = struct
+  type t = fun_id
+
+  let compare = compare_fun_id
+  let to_string = show_fun_id
+  let pp_t = pp_fun_id
+  let show_t = show_fun_id
+end
+
+module FunIdMap = Collections.MakeMap (FunIdOrderedType)
+module FunIdSet = Collections.MakeSet (FunIdOrderedType)
 
 let lookup_fun_sig (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
     fun_sig =
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index 8872571f..d2747a4b 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -786,18 +786,19 @@ let expression_contains_child_call_in_all_paths (ctx : trans_ctx)
                 if rg_id0 = rg_id1 then true
                 else
                   (* We need to use the regions hierarchy *)
-                  (* First, lookup the signature of the LLBC function *)
-                  let sg =
+                  let regions_hierarchy =
                     let id0 =
                       match id0 with
                       | FunId fun_id -> fun_id
                       | TraitMethod (_, _, fun_decl_id) -> FRegular fun_decl_id
                     in
-                    LlbcAstUtils.lookup_fun_sig id0 ctx.fun_ctx.fun_decls
+                    LlbcAstUtils.FunIdMap.find id0
+                      ctx.fun_ctx.regions_hierarchies
                   in
                   (* Compute the set of ancestors of the function in call1 *)
                   let call1_ancestors =
-                    LlbcAstUtils.list_ancestor_region_groups sg rg_id1
+                    LlbcAstUtils.list_ancestor_region_groups regions_hierarchy
+                      rg_id1
                   in
                   (* Check if the function used in call0 is inside *)
                   T.RegionGroupId.Set.mem rg_id0 call1_ancestors
diff --git a/compiler/RegionsHierarchy.ml b/compiler/RegionsHierarchy.ml
new file mode 100644
index 00000000..dd566426
--- /dev/null
+++ b/compiler/RegionsHierarchy.ml
@@ -0,0 +1,243 @@
+(** This module analyzes function signatures to compute the
+    hierarchy between regions.
+
+    Note that we don't need to analyze the types: when there is a non-trivial
+    relation between lifetimes in a type definition, the Rust compiler will
+    automatically introduce the relevant where clauses. For instance, in the
+    definition below:
+
+    {[
+      struct Wrapper<'a, 'b, T> {
+        x : &'a mut &'b mut T,
+      }
+    ]}
+    
+    the Rust compiler will introduce the where clauses:
+    {[
+      'b : 'a
+      T : 'b
+    ]}
+
+    However, it doesn't do so for the function signatures, which means we have
+    to compute the constraints between the lifetimes ourselves, then that we
+    have to compute the SCCs of the lifetimes (two lifetimes 'a and 'b may
+    satisfy 'a : 'b and 'b : 'a, meaning they are actually equal and should
+    be grouped together).
+ *)
+
+open Types
+open TypesUtils
+open Expressions
+open LlbcAst
+open LlbcAstUtils
+open Assumed
+open SCC
+module Subst = Substitute
+
+let compute_regions_hierarchy_for_sig (type_decls : type_decl TypeDeclId.Map.t)
+    (sg : fun_sig) : region_groups =
+  (* Create the dependency graph.
+
+     An edge from 'short to 'long means that 'long outlives 'short (that is
+     we have 'long : 'short,  using Rust notations).
+  *)
+  (* First initialize the regions map.
+
+     We add:
+     - the region variables
+     - the static region
+     - edges from the region variables to the static region
+  *)
+  let g : RegionSet.t RegionMap.t ref =
+    let s_set = RegionSet.singleton RStatic in
+    let m =
+      List.map
+        (fun (r : region_var) -> (RVar r.index, s_set))
+        sg.generics.regions
+    in
+    let s = (RStatic, RegionSet.empty) in
+    ref (RegionMap.of_list (s :: m))
+  in
+
+  let add_edge ~(short : region) ~(long : region) =
+    let m = !g in
+    let s = RegionMap.find short !g in
+    let s = RegionSet.add long s in
+    g := RegionMap.add short s m
+  in
+
+  let add_edge_from_region_constraint ((long, short) : region_outlives) =
+    add_edge ~short ~long
+  in
+
+  let add_edges ~(long : region) ~(shorts : region list) =
+    List.iter (fun short -> add_edge ~short ~long) shorts
+  in
+
+  (* Explore the clauses - we only explore the "region outlives" clause,
+     not the "type outlives" clauses *)
+  List.iter add_edge_from_region_constraint sg.preds.regions_outlive;
+
+  (* Explore the types in the signature to add the edges *)
+  let rec explore_ty (outer : region list) (ty : ty) =
+    match ty with
+    | TAdt (id, generics) ->
+        (* Add constraints coming from the type clauses *)
+        (match id with
+        | TAdtId id ->
+            (* Lookup the type declaration *)
+            let decl = TypeDeclId.Map.find id type_decls in
+            (* Instantiate the predicates *)
+            let tr_self =
+              UnknownTrait ("Unexpected, introduced by " ^ __FUNCTION__)
+            in
+            let subst =
+              Subst.make_subst_from_generics decl.generics generics tr_self
+            in
+            let predicates = Subst.predicates_substitute subst decl.preds in
+            (* Note that because we also explore the generics below, we may
+               explore several times the same type - this is ok *)
+            List.iter
+              (fun (long, short) -> add_edges ~long ~shorts:(short :: outer))
+              predicates.regions_outlive;
+            List.iter
+              (fun (ty, short) -> explore_ty (short :: outer) ty)
+              predicates.types_outlive
+        | TTuple -> (* No clauses for tuples *) ()
+        | TAssumed aid -> (
+            match aid with
+            | TBox | TArray | TSlice | TStr -> (* No clauses for those *) ()));
+        (* Explore the generics *)
+        explore_generics outer generics
+    | TVar _ | TLiteral _ | TNever -> ()
+    | TRef (r, ty, _) ->
+        (* Add the constraints for r *)
+        add_edges ~long:r ~shorts:outer;
+        (* Add r to the outer regions *)
+        let outer = r :: outer in
+        (* Continue *)
+        explore_ty outer ty
+    | TRawPtr (ty, _) -> explore_ty outer ty
+    | TTraitType (trait_ref, _generic_args, _) ->
+        (* The trait should reference a clause, and not an implementation
+           (otherwise it should have been normalized) *)
+        assert (
+          AssociatedTypes.trait_instance_id_is_local_clause trait_ref.trait_id);
+        (* We have nothing to do *)
+        ()
+    | TArrow (inputs, output) ->
+        (* TODO: this may be too constraining *)
+        List.iter (explore_ty outer) (output :: inputs)
+  and explore_generics (outer : region list) (generics : generic_args) =
+    let { regions; types; const_generics = _; trait_refs = _ } = generics in
+    List.iter (fun long -> add_edges ~long ~shorts:outer) regions;
+    List.iter (explore_ty outer) types
+  in
+
+  List.iter (explore_ty []) (sg.output :: sg.inputs);
+
+  (* Compute the ordered SCCs *)
+  let module Scc = SCC.Make (RegionOrderedType) in
+  let sccs = Scc.compute (RegionMap.bindings !g) in
+
+  (* Remove the SCC containing the static region.
+
+     For now, we don't handle cases where regions different from 'static
+     can live as long as 'static, so we check that if the group contains
+     'static then it is the only region it contains, and then we filter
+     the group.
+     TODO: general support for 'static
+  *)
+  let sccs =
+    (* Find the SCC which contains the static region *)
+    let static_gr_id, static_scc =
+      List.find
+        (fun (_, scc) -> List.mem RStatic scc)
+        (SccId.Map.bindings sccs.sccs)
+    in
+    (* The SCC should only contain the 'static *)
+    assert (static_scc = [ RStatic ]);
+    (* Remove the group as well as references to this group from the
+       other SCCs *)
+    let { sccs; scc_deps } = sccs in
+    (* We have to change the indexing:
+       - if id < static_gr_id: we leave the id as it is
+       - if id = static_gr_id: we remove id
+       - if id > static_gr_id: we decrement it by one
+    *)
+    let static_i = SccId.to_int static_gr_id in
+    let convert_id (id : SccId.id) : SccId.id option =
+      let i = SccId.to_int id in
+      if i < static_i then Some id
+      else if i = static_i then None
+      else Some (SccId.of_int (i - 1))
+    in
+    let sccs =
+      SccId.Map.of_list
+        (List.filter_map
+           (fun (id, rg_ids) ->
+             match convert_id id with
+             | None -> None
+             | Some id -> Some (id, rg_ids))
+           (SccId.Map.bindings sccs))
+    in
+
+    let scc_deps =
+      List.filter_map
+        (fun (id, deps) ->
+          match convert_id id with
+          | None -> None
+          | Some id ->
+              let deps = List.filter_map convert_id (SccId.Set.elements deps) in
+              Some (id, SccId.Set.of_list deps))
+        (SccId.Map.bindings scc_deps)
+    in
+    let scc_deps = SccId.Map.of_list scc_deps in
+
+    { sccs; scc_deps }
+  in
+
+  (*
+   * Compute the regions hierarchy
+   *)
+  List.filter_map
+    (fun (scc_id, scc) ->
+      (* The region id *)
+      let i = SccId.to_int scc_id in
+      let id = RegionGroupId.of_int i in
+
+      (* Retrieve the set of regions in the group *)
+      let regions =
+        List.map
+          (fun r ->
+            match r with RVar r -> r | _ -> raise (Failure "Unreachable"))
+          scc
+      in
+
+      (* Compute the set of parent region groups *)
+      let parents =
+        List.map
+          (fun id -> RegionGroupId.of_int (SccId.to_int id))
+          (SccId.Set.elements (SccId.Map.find scc_id sccs.scc_deps))
+      in
+
+      (* Put together *)
+      Some { id; regions; parents })
+    (SccId.Map.bindings sccs.sccs)
+
+let compute_regions_hierarchies (type_decls : type_decl TypeDeclId.Map.t)
+    (fun_decls : fun_decl FunDeclId.Map.t) : region_groups FunIdMap.t =
+  let regular =
+    List.map
+      (fun (fid, d) -> (FRegular fid, d.signature))
+      (FunDeclId.Map.bindings fun_decls)
+  in
+  let assumed =
+    List.map
+      (fun (info : assumed_fun_info) -> (FAssumed info.fun_id, info.fun_sig))
+      assumed_fun_infos
+  in
+  FunIdMap.of_list
+    (List.map
+       (fun (fid, sg) -> (fid, compute_regions_hierarchy_for_sig type_decls sg))
+       (regular @ assumed))
diff --git a/compiler/ReorderDecls.ml b/compiler/ReorderDecls.ml
index c82d625f..53c94ff4 100644
--- a/compiler/ReorderDecls.ml
+++ b/compiler/ReorderDecls.ml
@@ -1,4 +1,3 @@
-open Graph
 open Collections
 open SCC
 open Pure
@@ -99,99 +98,9 @@ let group_reorder_fun_decls (decls : fun_decl list) :
       decls
   in
 
-  (*
-   * Create the dependency graph
-   *)
-  (* Convert the ids to vertices (i.e., injectively map ids to integers, and create
-     vertices labeled with those integers).
-
-     Rem.: [Graph.create] is *imperative*: it generates a new vertex every time
-     it is called (!!).
-  *)
-  let module Graph = Pack.Digraph in
-  let id_to_vertex : Graph.V.t FunIdMap.t =
-    let cnt = ref 0 in
-    FunIdMap.of_list
-      (List.map
-         (fun id ->
-           let lbl = !cnt in
-           cnt := !cnt + 1;
-           (* We create a vertex *)
-           let v = Graph.V.create lbl in
-           (id, v))
-         idl)
-  in
-  let vertex_to_id : fun_id IntMap.t =
-    IntMap.of_list
-      (List.map
-         (fun (fid, v) -> (Graph.V.label v, fid))
-         (FunIdMap.bindings id_to_vertex))
-  in
-
-  let to_v id = FunIdMap.find id id_to_vertex in
-  let to_id v = IntMap.find (Graph.V.label v) vertex_to_id in
-
-  let g = Graph.create () in
-
-  (* Add the edges, first from the vertices to themselves, then between vertices *)
-  List.iter
-    (fun (fun_id, deps) ->
-      let v = to_v fun_id in
-      Graph.add_edge g v v;
-      FunIdSet.iter (fun dep_id -> Graph.add_edge g v (to_v dep_id)) deps)
-    deps;
-
-  (* Compute the SCCs *)
-  let module Comp = Components.Make (Graph) in
-  let sccs = Comp.scc_list g in
-
-  (* Convert the vertices to ids *)
-  let sccs = List.map (List.map to_id) sccs in
-
-  log#ldebug
-    (lazy
-      ("group_reorder_fun_decls: SCCs:\n"
-      ^ Print.list_to_string (Print.list_to_string FunIdOrderedType.show_t) sccs
-      ));
-
-  (* Sanity check *)
-  let _ =
-    (* Check that the SCCs are pairwise disjoint *)
-    assert (FunIdSet.pairwise_disjoint (List.map FunIdSet.of_list sccs));
-    (* Check that all the ids are in the sccs *)
-    let scc_ids = FunIdSet.of_list (List.concat sccs) in
-
-    log#ldebug
-      (lazy
-        ("group_reorder_fun_decls: sanity check:" ^ "\n- ids    : "
-       ^ FunIdSet.show ids ^ "\n- scc_ids: " ^ FunIdSet.show scc_ids));
-
-    assert (FunIdSet.equal scc_ids ids)
-  in
-
-  log#ldebug
-    (lazy
-      ("group_reorder_fun_decls: reordered SCCs:\n"
-      ^ Print.list_to_string (Print.list_to_string FunIdOrderedType.show_t) sccs
-      ));
-
-  (* Reorder *)
-  let module Reorder = SCC.Make (FunIdOrderedType) in
-  let id_deps =
-    FunIdMap.of_list
-      (List.map (fun (fid, deps) -> (fid, FunIdSet.elements deps)) deps)
-  in
-  let sccs = Reorder.reorder_sccs id_deps idl sccs in
-
-  (* Sanity check *)
-  let _ =
-    (* Check that the SCCs are pairwise disjoint *)
-    let sccs = List.map snd (SccId.Map.bindings sccs.sccs) in
-    assert (FunIdSet.pairwise_disjoint (List.map FunIdSet.of_list sccs));
-    (* Check that all the ids are in the sccs *)
-    let scc_ids = FunIdSet.of_list (List.concat sccs) in
-    assert (FunIdSet.equal scc_ids ids)
-  in
+  (* Compute the ordered SCCs *)
+  let module Scc = SCC.Make (FunIdOrderedType) in
+  let sccs = Scc.compute deps in
 
   (* Group the declarations *)
   let deps = FunIdMap.of_list deps in
diff --git a/compiler/SCC.ml b/compiler/SCC.ml
index d9a4cd3e..150821ad 100644
--- a/compiler/SCC.ml
+++ b/compiler/SCC.ml
@@ -6,8 +6,15 @@ module SccId = Identifiers.IdGen ()
 (** The local logger *)
 let log = Logging.scc_log
 
+(** A structure containing information about SCCs (strongly connected components) *)
+type 'id sccs = {
+  sccs : 'id list SccId.Map.t;
+  scc_deps : SccId.Set.t SccId.Map.t;  (** The dependencies between sccs *)
+}
+[@@deriving show]
+
 (** A functor which provides functions to work on strongly connected components *)
-module Make (Id : OrderedType) = struct
+module MakeReorder (Id : OrderedType) = struct
   module IdMap = MakeMap (Id)
   module IdSet = MakeSet (Id)
 
@@ -15,13 +22,6 @@ module Make (Id : OrderedType) = struct
 
   let pp_id = Id.pp_t
 
-  (** A structure containing information about SCCs (strongly connected components) *)
-  type sccs = {
-    sccs : id list SccId.Map.t;
-    scc_deps : SccId.Set.t SccId.Map.t;  (** The dependencies between sccs *)
-  }
-  [@@deriving show]
-
   (** The order in which Tarjan's algorithm generates the SCCs is arbitrary,
       while we want to keep as much as possible the original order (the order
       in which the user generated the ids). For this, we iterate through
@@ -93,7 +93,7 @@ module Make (Id : OrderedType) = struct
       Charon project.
   *)
   let reorder_sccs (id_deps : Id.t list IdMap.t) (ids : Id.t list)
-      (sccs : Id.t list list) : sccs =
+      (sccs : Id.t list list) : id sccs =
     (* Map the identifiers to the SCC indices *)
     let id_to_scc =
       IdMap.of_list
@@ -168,13 +168,114 @@ module Make (Id : OrderedType) = struct
     { sccs = tgt_sccs; scc_deps = tgt_deps }
 end
 
+module Make (Id : OrderedType) = struct
+  module M = MakeMap (Id)
+  module S = MakeSet (Id)
+
+  (** Compute the ordered SCC components for a graph, which is a map
+      from identifier to set of identifiers (which represent the set
+      of edges starting from an identifier).
+   *)
+  let compute (m : (Id.t * S.t) list) : Id.t sccs =
+    (*
+     * Create the dependency graph
+     *)
+    (* Compute the list/set of identifiers *)
+    let idl = List.map fst m in
+    let ids = S.of_list idl in
+
+    (* Convert the ids to vertices (i.e., injectively map ids to integers,
+       and create vertices labeled with those integers).
+
+       Rem.: [Graph.create] is *imperative*: it generates a new vertex every
+       time it is called (!!). For this reason, we first add all the vertices
+       we need, then add the edges.
+    *)
+    let open Graph in
+    let module IntMap = MakeMap (OrderedInt) in
+    let module Graph = Pack.Digraph in
+    let id_to_vertex : Graph.V.t M.t =
+      let cnt = ref 0 in
+      M.of_list
+        (List.map
+           (fun id ->
+             let lbl = !cnt in
+             cnt := !cnt + 1;
+             (* We create a vertex *)
+             let v = Graph.V.create lbl in
+             (id, v))
+           idl)
+    in
+    let vertex_to_id : Id.t IntMap.t =
+      IntMap.of_list
+        (List.map
+           (fun (fid, v) -> (Graph.V.label v, fid))
+           (M.bindings id_to_vertex))
+    in
+
+    let to_v id = M.find id id_to_vertex in
+    let to_id v = IntMap.find (Graph.V.label v) vertex_to_id in
+
+    let g = Graph.create () in
+
+    (* Add the edges, first from the vertices to themselves, then between
+       vertices. *)
+    List.iter
+      (fun (id, deps) ->
+        let v = to_v id in
+        Graph.add_edge g v v;
+        S.iter (fun dep_id -> Graph.add_edge g v (to_v dep_id)) deps)
+      m;
+
+    (* Compute the SCCs *)
+    let module Comp = Components.Make (Graph) in
+    let sccs = Comp.scc_list g in
+
+    (* Convert the vertices to ids *)
+    let sccs = List.map (List.map to_id) sccs in
+
+    (* Sanity check *)
+    let _ =
+      (* Check that the SCCs are pairwise disjoint *)
+      assert (S.pairwise_disjoint (List.map S.of_list sccs));
+      (* Check that all the ids are in the sccs *)
+      let scc_ids = S.of_list (List.concat sccs) in
+
+      log#ldebug
+        (lazy
+          ("group_reorder_fun_decls: sanity check:" ^ "\n- ids    : "
+         ^ S.show ids ^ "\n- scc_ids: " ^ S.show scc_ids));
+
+      assert (S.equal scc_ids ids)
+    in
+
+    (* Reorder *)
+    let module Reorder = MakeReorder (Id) in
+    let id_deps =
+      M.of_list (List.map (fun (fid, deps) -> (fid, S.elements deps)) m)
+    in
+    let sccs = Reorder.reorder_sccs id_deps idl sccs in
+
+    (* Sanity check *)
+    let _ =
+      (* Check that the SCCs are pairwise disjoint *)
+      let sccs = List.map snd (SccId.Map.bindings sccs.sccs) in
+      assert (S.pairwise_disjoint (List.map S.of_list sccs));
+      (* Check that all the ids are in the sccs *)
+      let scc_ids = S.of_list (List.concat sccs) in
+      assert (S.equal scc_ids ids)
+    in
+
+    sccs
+end
+
 (** Test - TODO: make "real" unit tests *)
 let _ =
   (* Check that some SCCs are correctly reordered *)
   let check_sccs (id_deps : (int * int list) list) (ids : int list)
       (sccs : int list list) (tgt_sccs : int list list) : unit =
     let module Ord = OrderedInt in
-    let module Reorder = Make (Ord) in
+    let module Reorder = MakeReorder (Ord) in
     let module Map = MakeMap (Ord) in
     let id_deps = Map.of_list id_deps in
 
diff --git a/compiler/Substitute.ml b/compiler/Substitute.ml
index 166c237a..45edc602 100644
--- a/compiler/Substitute.ml
+++ b/compiler/Substitute.ml
@@ -64,6 +64,10 @@ let generic_args_substitute (subst : subst) (g : T.generic_args) :
   let visitor = st_substitute_visitor subst in
   visitor#visit_generic_args () g
 
+let predicates_substitute (subst : subst) (p : T.predicates) : T.predicates =
+  let visitor = st_substitute_visitor subst in
+  visitor#visit_predicates () p
+
 let erase_regions_subst : subst =
   {
     r_subst = (fun _ -> T.RErased);
@@ -351,7 +355,8 @@ let trait_type_constraint_substitute (subst : subst)
   let ty = visitor#visit_ty () ty in
   { T.trait_ref; generics; type_name; ty }
 
-(** Substitute a function signature.
+(** Substitute a function signature, together with the regions hierarchy
+    associated to that signature.
 
     **IMPORTANT:** this function doesn't normalize the types.
  *)
@@ -360,7 +365,8 @@ let substitute_signature (asubst : T.RegionGroupId.id -> V.AbstractionId.id)
     (ty_subst : T.TypeVarId.id -> T.ty)
     (cg_subst : T.ConstGenericVarId.id -> T.const_generic)
     (tr_subst : T.TraitClauseId.id -> T.trait_instance_id)
-    (tr_self : T.trait_instance_id) (sg : A.fun_sig) : A.inst_fun_sig =
+    (tr_self : T.trait_instance_id) (sg : A.fun_sig)
+    (regions_hierarchy : T.region_groups) : A.inst_fun_sig =
   let r_subst' (r : T.region) : T.region =
     match r with
     | T.RStatic | T.RErased -> r
@@ -375,7 +381,7 @@ let substitute_signature (asubst : T.RegionGroupId.id -> V.AbstractionId.id)
     let parents = List.map asubst rg.parents in
     ({ id; regions; parents } : A.abs_region_group)
   in
-  let regions_hierarchy = List.map subst_region_group sg.A.regions_hierarchy in
+  let regions_hierarchy = List.map subst_region_group regions_hierarchy in
   let trait_type_constraints =
     List.map
       (trait_type_constraint_substitute subst)
diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index 258b1cf2..922aa307 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -47,6 +47,7 @@ type fun_context = {
   llbc_fun_decls : A.fun_decl A.FunDeclId.Map.t;
   fun_sigs : fun_sig_named_outputs RegularFunIdNotLoopMap.t;  (** *)
   fun_infos : FA.fun_info A.FunDeclId.Map.t;
+  regions_hierarchies : T.region_groups FunIdMap.t;
 }
 [@@deriving show]
 
@@ -441,8 +442,8 @@ and translate_strait_instance_id (id : T.trait_instance_id) : trait_instance_id
   translate_trait_instance_id translate_sty id
 
 let translate_trait_clause (clause : T.trait_clause) : trait_clause =
-  let { T.clause_id; meta = _; trait_id; generics } = clause in
-  let generics = translate_sgeneric_args generics in
+  let { T.clause_id; meta = _; trait_id; clause_generics } = clause in
+  let generics = translate_sgeneric_args clause_generics in
   { clause_id; trait_id; generics }
 
 let translate_strait_type_constraint (ttc : T.trait_type_constraint) :
@@ -848,11 +849,14 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id)
   let fun_infos = decls_ctx.fun_ctx.fun_infos in
   let type_infos = decls_ctx.type_ctx.type_infos in
   (* Retrieve the list of parent backward functions *)
+  let regions_hierarchy =
+    FunIdMap.find fun_id decls_ctx.fun_ctx.regions_hierarchies
+  in
   let gid, parents =
     match bid with
     | None -> (None, T.RegionGroupId.Set.empty)
     | Some bid ->
-        let parents = list_ancestor_region_groups sg bid in
+        let parents = list_ancestor_region_groups regions_hierarchy bid in
         (Some bid, parents)
   in
   (* Is the function stateful, and can it fail? *)
@@ -865,7 +869,7 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id)
   (* Create the context *)
   let ctx =
     let region_groups =
-      List.map (fun (g : T.region_group) -> g.id) sg.regions_hierarchy
+      List.map (fun (g : T.region_group) -> g.id) regions_hierarchy
     in
     let ctx =
       InterpreterUtils.initialize_eval_context decls_ctx region_groups
@@ -898,7 +902,7 @@ let translate_fun_sig (decls_ctx : C.decls_ctx) (fun_id : A.fun_id)
   assert (T.RegionGroupId.Set.is_empty parents);
   (* Small helper to translate types for backward functions *)
   let translate_back_ty_for_gid (gid : T.RegionGroupId.id) : T.ty -> ty option =
-    let rg = T.RegionGroupId.nth sg.regions_hierarchy gid in
+    let rg = T.RegionGroupId.nth regions_hierarchy gid in
     let regions = T.RegionId.Set.of_list rg.regions in
     let keep_region r =
       match r with
@@ -2924,6 +2928,9 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl =
   let basename = def.name in
   (* Retrieve the signature *)
   let signature = ctx.sg in
+  let regions_hierarchy =
+    FunIdMap.find (FRegular def_id) ctx.fun_context.regions_hierarchies
+  in
   (* Translate the body, if there is *)
   let body =
     match body with
@@ -2965,7 +2972,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl =
           | None -> []
           | Some back_id ->
               let parents_ids =
-                list_ordered_ancestor_region_groups def.signature back_id
+                list_ordered_ancestor_region_groups regions_hierarchy back_id
               in
               let backward_ids = List.append parents_ids [ back_id ] in
               List.concat
@@ -3069,6 +3076,10 @@ let translate_fun_signatures (decls_ctx : C.decls_ctx)
   let translate_one (fun_id : A.fun_id) (input_names : string option list)
       (sg : A.fun_sig) : (regular_fun_id_not_loop * fun_sig_named_outputs) list
       =
+    (* Retrieve the regions hierarchy *)
+    let regions_hierarchy =
+      FunIdMap.find fun_id decls_ctx.fun_ctx.regions_hierarchies
+    in
     (* The forward function *)
     let fwd_sg = translate_fun_sig decls_ctx fun_id sg input_names None in
     let fwd_id = (fun_id, None) in
@@ -3081,7 +3092,7 @@ let translate_fun_signatures (decls_ctx : C.decls_ctx)
           in
           let id = (fun_id, Some rg.id) in
           (id, tsg))
-        sg.regions_hierarchy
+        regions_hierarchy
     in
     (* Return *)
     (fwd_id, fwd_sg) :: back_sgs
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 9a6addee..2aedb544 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -91,6 +91,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
       SymbolicToPure.llbc_fun_decls = trans_ctx.fun_ctx.fun_decls;
       fun_sigs;
       fun_infos = trans_ctx.fun_ctx.fun_infos;
+      regions_hierarchies = trans_ctx.fun_ctx.regions_hierarchies;
     }
   in
   let global_context =
@@ -263,9 +264,11 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
         (* Translate *)
         SymbolicToPure.translate_fun_decl ctx (Some symbolic)
   in
-  let pure_backwards =
-    List.map translate_backward fdef.signature.regions_hierarchy
+  let regions_hierarchy =
+    LlbcAstUtils.FunIdMap.find (FRegular fdef.def_id)
+      fun_context.regions_hierarchies
   in
+  let pure_backwards = List.map translate_backward regions_hierarchy in
 
   (* Return *)
   (pure_forward, pure_backwards)
diff --git a/compiler/dune b/compiler/dune
index 648c7325..bc3cc718 100644
--- a/compiler/dune
+++ b/compiler/dune
@@ -57,6 +57,7 @@
   Pure
   PureTypeCheck
   PureUtils
+  RegionsHierarchy
   ReorderDecls
   SCC
   Scalars
-- 
cgit v1.3.1


From a27efd1ed08bc9583752445d9eda7a693c0c7379 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 16 Nov 2023 10:13:28 +0100
Subject: Finish propagating the changes to the names and cleaning

---
 compiler/Contexts.ml        |   2 +-
 compiler/Driver.ml          |  21 +++---
 compiler/Extract.ml         |  40 +++++------
 compiler/ExtractTypes.ml    | 155 +++++++++++++++++++++++++++++-------------
 compiler/FunsAnalysis.ml    |   4 +-
 compiler/Print.ml           |   1 -
 compiler/Pure.ml            |   1 +
 compiler/PureMicroPasses.ml |  29 ++++----
 compiler/SymbolicToPure.ml  |   6 +-
 compiler/Translate.ml       | 159 ++++++++++++++++++++++----------------------
 compiler/TranslateCore.ml   |   3 +
 compiler/TypesAnalysis.ml   |   2 +-
 12 files changed, 244 insertions(+), 179 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Contexts.ml b/compiler/Contexts.ml
index 41c84141..a2ae4f16 100644
--- a/compiler/Contexts.ml
+++ b/compiler/Contexts.ml
@@ -525,7 +525,7 @@ let ctx_set_abs_can_end (ctx : eval_ctx) (abs_id : AbstractionId.id)
 
 let ctx_type_decl_is_rec (ctx : eval_ctx) (id : TypeDeclId.id) : bool =
   let decl_group = TypeDeclId.Map.find id ctx.type_context.type_decls_groups in
-  match decl_group with Rec _ -> true | NonRec _ -> false
+  match decl_group with RecGroup _ -> true | NonRecGroup _ -> false
 
 (** Visitor to iterate over the values in the *current* frame *)
 class ['self] iter_frame =
diff --git a/compiler/Driver.ml b/compiler/Driver.ml
index aa293469..94e50a08 100644
--- a/compiler/Driver.ml
+++ b/compiler/Driver.ml
@@ -1,15 +1,10 @@
 open Aeneas.LlbcOfJson
 open Aeneas.Logging
-module T = Aeneas.Types
-module A = Aeneas.LlbcAst
-module I = Aeneas.Interpreter
+open Aeneas.LlbcAst
+open Aeneas.Interpreter
 module EL = Easy_logging.Logging
-module TA = Aeneas.TypesAnalysis
-module Micro = Aeneas.PureMicroPasses
-module Print = Aeneas.Print
-module PrePasses = Aeneas.PrePasses
-module Translate = Aeneas.Translate
 open Aeneas.Config
+open Aeneas
 
 (** The local logger *)
 let log = main_log
@@ -227,7 +222,9 @@ let () =
       if
         !backend = Lean && !extract_decreases_clauses
         && List.exists
-             (function Aeneas.LlbcAst.Fun (Rec (_ :: _)) -> true | _ -> false)
+             (function
+               | Aeneas.LlbcAst.FunGroup (RecGroup (_ :: _)) -> true
+               | _ -> false)
              m.declarations
       then (
         log#error
@@ -237,15 +234,15 @@ let () =
         fail ());
 
       (* Apply the pre-passes *)
-      let m = PrePasses.apply_passes m in
+      let m = Aeneas.PrePasses.apply_passes m in
 
       (* Some options for the execution *)
 
       (* Test the unit functions with the concrete interpreter *)
-      if !test_unit_functions then I.Test.test_unit_functions m;
+      if !test_unit_functions then Test.test_unit_functions m;
 
       (* Translate the functions *)
-      Translate.translate_crate filename dest_dir m;
+      Aeneas.Translate.translate_crate filename dest_dir m;
 
       (* Print total elapsed time *)
       log#linfo
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index 04f6c2c3..cd62c15c 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -27,7 +27,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx)
       let builtin =
         let open ExtractBuiltin in
         let funs_map = builtin_funs_map () in
-        let sname = name_to_simple_name def.fwd.f.basename in
+        let sname = name_to_simple_name def.fwd.f.llbc_name in
         SimpleNameMap.find_opt sname funs_map
       in
       (* Use the builtin names if necessary *)
@@ -65,7 +65,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx)
                   raise
                     (Failure
                        ("Not found: "
-                       ^ Names.name_to_string f.basename
+                       ^ name_to_string ctx f.llbc_name
                        ^ ", "
                        ^ Print.option_to_string Pure.show_loop_id f.loop_id
                        ^ Print.option_to_string Pure.show_region_group_id
@@ -212,7 +212,7 @@ let fun_builtin_filter_types (id : FunDeclId.id) (types : 'a list)
         let decl = FunDeclId.Map.find id ctx.trans_funs in
         let err =
           "Ill-formed builtin information for function "
-          ^ Names.name_to_string decl.fwd.f.basename
+          ^ name_to_string ctx decl.fwd.f.llbc_name
           ^ ": "
           ^ string_of_int (List.length filter)
           ^ " filtering arguments provided for "
@@ -1137,7 +1137,7 @@ let extract_template_fstar_decreases_clause (ctx : extraction_ctx)
   F.pp_print_break fmt 0 0;
   (* Print a comment to link the extracted type to its original rust definition *)
   extract_comment fmt
-    [ "[" ^ Print.fun_name_to_string def.basename ^ "]: decreases clause" ];
+    [ "[" ^ name_to_string ctx def.llbc_name ^ "]: decreases clause" ];
   F.pp_print_space fmt ();
   (* Open a box for the definition, so that whenever possible it gets printed on
    * one line *)
@@ -1199,7 +1199,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx)
   F.pp_print_break fmt 0 0;
   (* Print a comment to link the extracted type to its original rust definition *)
   extract_comment fmt
-    [ "[" ^ Print.fun_name_to_string def.basename ^ "]: termination measure" ];
+    [ "[" ^ name_to_string ctx def.llbc_name ^ "]: termination measure" ];
   F.pp_print_space fmt ();
   (* Open a box for the definition, so that whenever possible it gets printed on
    * one line *)
@@ -1253,7 +1253,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx)
   (* syntax <def_name> term ... term : tactic *)
   F.pp_print_break fmt 0 0;
   extract_comment fmt
-    [ "[" ^ Print.fun_name_to_string def.basename ^ "]: decreases_by tactic" ];
+    [ "[" ^ name_to_string ctx def.llbc_name ^ "]: decreases_by tactic" ];
   F.pp_print_space fmt ();
   F.pp_open_hvbox fmt 0;
   F.pp_print_string fmt "syntax \"";
@@ -1289,7 +1289,7 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter)
       (Pure.FunId (FRegular def.def_id), def.loop_id, def.back_id)
       ctx.fun_name_info
   in
-  let comment_pre = "[" ^ Print.fun_name_to_string def.basename ^ "]: " in
+  let comment_pre = "[" ^ name_to_string ctx def.llbc_name ^ "]: " in
   let comment =
     let loop_comment =
       match def.loop_id with
@@ -1766,13 +1766,13 @@ let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter)
 
   (* Add a break then the name of the corresponding LLBC declaration *)
   F.pp_print_break fmt 0 0;
-  extract_comment fmt [ "[" ^ Print.global_name_to_string global.name ^ "]" ];
+  extract_comment fmt [ "[" ^ name_to_string ctx global.name ^ "]" ];
   F.pp_print_space fmt ();
 
   let decl_name = ctx_get_global global.def_id ctx in
   let body_name =
     ctx_get_function
-      (FromLlbc (Pure.FunId (FRegular global.body_id), None, None))
+      (FromLlbc (Pure.FunId (FRegular global.body), None, None))
       ctx
   in
 
@@ -1958,8 +1958,10 @@ let extract_trait_decl_method_names (ctx : extraction_ctx)
               =
             (* We do something special to reuse the [ctx_compute_fun_decl]
                function. TODO: make it cleaner. *)
-            let basename : name = [ Ident item_name ] in
-            let f = { f with basename } in
+            let llbc_name : Types.name =
+              [ Types.PeIdent (item_name, Disambiguator.zero) ]
+            in
+            let f = { f with llbc_name } in
             let trans = A.FunDeclId.Map.find f.def_id ctx.trans_funs in
             let name = ctx_compute_fun_name trans f ctx in
             (* Add a prefix if necessary *)
@@ -1991,7 +1993,7 @@ let extract_trait_decl_method_names (ctx : extraction_ctx)
               | None ->
                   let err =
                     "Ill-formed builtin information for trait decl \""
-                    ^ Names.name_to_string trait_decl.name
+                    ^ name_to_string ctx trait_decl.llbc_name
                     ^ "\", method \"" ^ item_name
                     ^ "\": could not find name for region "
                     ^ Print.option_to_string Pure.show_region_group_id
@@ -2022,7 +2024,7 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
     (trait_decl : trait_decl) : extraction_ctx =
   (* Lookup the information if this is a builtin trait *)
   let open ExtractBuiltin in
-  let sname = name_to_simple_name trait_decl.name in
+  let sname = name_to_simple_name trait_decl.llbc_name in
   let builtin_info =
     SimpleNameMap.find_opt sname (builtin_trait_decls_map ())
   in
@@ -2059,8 +2061,8 @@ let extract_trait_impl_register_names (ctx : extraction_ctx)
   (* Check if the trait implementation is builtin *)
   let builtin_info =
     let open ExtractBuiltin in
-    let type_sname = name_to_simple_name trait_impl.name in
-    let trait_sname = name_to_simple_name trait_decl.name in
+    let type_sname = name_to_simple_name trait_impl.llbc_name in
+    let trait_sname = name_to_simple_name trait_decl.llbc_name in
     SimpleNamePairMap.find_opt (type_sname, trait_sname)
       (builtin_trait_impls_map ())
   in
@@ -2185,7 +2187,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
   F.pp_print_break fmt 0 0;
   (* Print a comment to link the extracted type to its original rust definition *)
   extract_comment fmt
-    [ "Trait declaration: [" ^ Print.name_to_string decl.name ^ "]" ];
+    [ "Trait declaration: [" ^ name_to_string ctx decl.llbc_name ^ "]" ];
   F.pp_print_break fmt 0 0;
   (* Open two outer boxes for the definition, so that whenever possible it gets printed on
      one line and indents are correct.
@@ -2466,14 +2468,14 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter)
 (** Extract a trait implementation *)
 let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
     (impl : trait_impl) : unit =
-  log#ldebug (lazy ("extract_trait_impl: " ^ Names.name_to_string impl.name));
+  log#ldebug (lazy ("extract_trait_impl: " ^ name_to_string ctx impl.llbc_name));
   (* Retrieve the impl name *)
   let impl_name = ctx_get_trait_impl impl.def_id ctx in
   (* Add a break before *)
   F.pp_print_break fmt 0 0;
   (* Print a comment to link the extracted type to its original rust definition *)
   extract_comment fmt
-    [ "Trait implementation: [" ^ Print.name_to_string impl.name ^ "]" ];
+    [ "Trait implementation: [" ^ name_to_string ctx impl.llbc_name ^ "]" ];
   F.pp_print_break fmt 0 0;
 
   (* Open two outer boxes for the definition, so that whenever possible it gets printed on
@@ -2640,7 +2642,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter)
     F.pp_print_break fmt 0 0;
     (* Print a comment *)
     extract_comment fmt
-      [ "Unit test for [" ^ Print.fun_name_to_string def.basename ^ "]" ];
+      [ "Unit test for [" ^ name_to_string ctx def.llbc_name ^ "]" ];
     F.pp_print_space fmt ();
     (* Open a box for the test *)
     F.pp_open_hovbox fmt ctx.indent_incr;
diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml
index 553d5863..e4617d2c 100644
--- a/compiler/ExtractTypes.ml
+++ b/compiler/ExtractTypes.ml
@@ -309,7 +309,6 @@ let assumed_llbc_functions () :
         (SliceIndexShared, None, "slice_index_usize");
         (SliceIndexMut, None, "slice_index_usize");
         (SliceIndexMut, rg0, "slice_update_usize");
-        (SliceLen, None, "slice_len");
       ]
   | Lean ->
       [
@@ -323,7 +322,6 @@ let assumed_llbc_functions () :
         (SliceIndexShared, None, "Slice.index_usize");
         (SliceIndexMut, None, "Slice.index_usize");
         (SliceIndexMut, rg0, "Slice.update_usize");
-        (SliceLen, None, "Slice.len");
       ]
 
 let assumed_pure_functions () : (pure_assumed_fun_id * string) list =
@@ -538,6 +536,11 @@ let type_keyword () =
   | Coq | Lean -> "Type"
   | HOL4 -> raise (Failure "Unexpected")
 
+let name_last_elem_as_ident (n : llbc_name) : string =
+  match Collections.List.last n with
+  | PeIdent (s, _) -> s
+  | PeImpl _ -> raise (Failure "Unexpected")
+
 (**
    [ctx]: we use the context to lookup type definitions, to retrieve type names.
    This is used to compute variable names, when they have no basenames: in this
@@ -579,34 +582,90 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
   let int_name = int_name in
 
   (* Prepare a name.
-   * The first id elem is always the crate: if it is the local crate,
-   * we remove it.
-   * We also remove all the disambiguators, then convert everything to strings.
-   * **Rmk:** because we remove the disambiguators, there may be name collisions
-   * (which is ok, because we check for name collisions and fail if there is any).
-   *)
-  let get_name (name : name) : string list =
+     The first id elem is always the crate: if it is the local crate,
+     we remove it. We ignore disambiguators (there may be collisions, but we
+     check if there are).
+  *)
+  let rec name_to_simple_name (name : llbc_name) : string list =
     (* Rmk.: initially we only filtered the disambiguators equal to 0 *)
-    let name = Names.filter_disambiguators name in
     match name with
-    | Ident crate :: name ->
-        let name = if crate = crate_name then name else Ident crate :: name in
+    | (PeIdent (crate, _) as id) :: name ->
+        let name = if crate = crate_name then name else id :: name in
+        let open Types in
         let name =
           List.map
             (function
-              | Names.Ident s -> s
-              | Disambiguator d -> Names.Disambiguator.to_string d)
+              | PeIdent (s, _) -> s
+              | PeImpl impl -> impl_elem_to_simple_name impl)
             name
         in
         name
     | _ ->
-        raise (Failure ("Unexpected name shape: " ^ Print.name_to_string name))
+        raise
+          (Failure
+             ("Unexpected name shape: " ^ TranslateCore.name_to_string ctx name))
+  and impl_elem_to_simple_name (impl : Types.impl_elem) : string =
+    (* We do something simple for now.
+       TODO: we might want to do something different for impl elements which are
+       actually trait implementations, in order to prevent name collisions (it
+       is possible to define several times the same trait for the same type,
+       but with different instantiations of the type, or different trait
+       requirements *)
+    ty_to_simple_name impl.generics impl.ty
+  and ty_to_simple_name (generics : Types.generic_params) (ty : Types.ty) :
+      string =
+    (* We do something simple for now.
+       TODO: find a more principled way of converting types to names.
+       In particular, we might want to do something different for impl elements which are
+       actually trait implementations, in order to prevent name collisions (it
+       is possible to define several times the same trait for the same type,
+       but with different instantiations of the type, or different trait
+       requirements *)
+    match ty with
+    | TAdt (id, args) -> (
+        match id with
+        | TAdtId id ->
+            let def = TypeDeclId.Map.find id ctx.type_ctx.type_decls in
+            name_last_elem_as_ident def.name
+        | TTuple ->
+            (* TODO *)
+            "Tuple"
+            ^ String.concat ""
+                (List.map (ty_to_simple_name generics) args.types)
+        | TAssumed id -> Types.show_assumed_ty id)
+    | TVar vid ->
+        (* Use the variable name *)
+        (List.find (fun (v : type_var) -> v.index = vid) generics.types).name
+    | TLiteral lty ->
+        StringUtils.capitalize_first_letter
+          (Print.Types.literal_type_to_string lty)
+    | TNever -> raise (Failure "Unreachable")
+    | TRef (_, rty, rk) -> (
+        let rty = ty_to_simple_name generics rty in
+        match rk with
+        | RMut -> "MutBorrow" ^ rty
+        | RShared -> "SharedBorrow" ^ rty)
+    | TRawPtr (rty, rk) -> (
+        let rty = ty_to_simple_name generics rty in
+        match rk with RMut -> "MutPtr" ^ rty | RShared -> "ConstPtr" ^ rty)
+    | TTraitType (tr, _, name) ->
+        (* TODO: this is way too simple *)
+        let trait_decl =
+          TraitDeclId.Map.find tr.trait_decl_ref.trait_decl_id
+            ctx.trait_decls_ctx.trait_decls
+        in
+        name_last_elem_as_ident trait_decl.name ^ name
+    | TArrow (inputs, output) ->
+        "Arrow"
+        ^ String.concat ""
+            (List.map (ty_to_simple_name generics) (inputs @ [ output ]))
   in
   let flatten_name (name : string list) : string =
     match !backend with
     | FStar | Coq | HOL4 -> String.concat "_" name
     | Lean -> String.concat "." name
   in
+  let get_name name : string list = name_to_simple_name name in
   let get_type_name = get_name in
   let get_type_name_no_suffix name =
     match !backend with
@@ -620,7 +679,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     | Coq | HOL4 -> get_type_name_no_suffix name ^ "_t"
     | Lean -> get_type_name_no_suffix name
   in
-  let field_name (def_name : name) (field_id : FieldId.id)
+  let field_name (def_name : llbc_name) (field_id : FieldId.id)
       (field_name : string option) : string =
     let field_name_s =
       match field_name with
@@ -639,7 +698,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
       | Lean | HOL4 -> def_name
       | Coq | FStar -> StringUtils.lowercase_first_letter def_name
   in
-  let variant_name (def_name : name) (variant : string) : string =
+  let variant_name (def_name : llbc_name) (variant : string) : string =
     match !backend with
     | FStar | Coq | HOL4 ->
         let variant = to_camel_case variant in
@@ -649,7 +708,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
         else variant
     | Lean -> variant
   in
-  let struct_constructor (basename : name) : string =
+  let struct_constructor (basename : llbc_name) : string =
     let tname = type_name basename in
     ExtractBuiltin.mk_struct_constructor tname
   in
@@ -661,15 +720,15 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     | FStar | Coq | HOL4 -> StringUtils.lowercase_first_letter fname
     | Lean -> fname
   in
-  let global_name (name : global_name) : string =
+  let global_name (name : llbc_name) : string =
     (* Converting to snake case also lowercases the letters (in Rust, global
      * names are written in capital letters). *)
     let parts = List.map to_snake_case (get_name name) in
     String.concat "_" parts
   in
-  let fun_name (fname : fun_name) (num_loops : int) (loop_id : LoopId.id option)
-      (num_rgs : int) (rg : region_group_info option) (filter_info : bool * int)
-      : string =
+  let fun_name (fname : llbc_name) (num_loops : int)
+      (loop_id : LoopId.id option) (num_rgs : int)
+      (rg : region_group_info option) (filter_info : bool * int) : string =
     let fname = get_fun_name fname in
     (* Compute the suffix *)
     let suffix = default_fun_suffix num_loops loop_id num_rgs rg filter_info in
@@ -678,7 +737,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
   in
 
   let trait_decl_name (trait_decl : trait_decl) : string =
-    type_name trait_decl.name
+    type_name trait_decl.llbc_name
   in
 
   let trait_impl_name (trait_decl : trait_decl) (trait_impl : trait_impl) :
@@ -686,12 +745,14 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     (* TODO: provisional: we concatenate the trait impl name (which is its type)
        with the trait decl name *)
     let trait_decl =
-      let name = trait_decl.name in
+      let name = trait_decl.llbc_name in
       let name = get_type_name_no_suffix name ^ "Inst" in
       (* Remove the occurrences of '.' *)
       String.concat "" (String.split_on_char '.' name)
     in
-    let name = flatten_name (get_type_name trait_impl.name @ [ trait_decl ]) in
+    let name =
+      flatten_name (get_type_name trait_impl.llbc_name @ [ trait_decl ])
+    in
     match !backend with
     | FStar -> StringUtils.lowercase_first_letter name
     | Coq | HOL4 | Lean -> name
@@ -745,7 +806,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     ^ TraitClauseId.to_string clause.clause_id
   in
 
-  let termination_measure_name (_fid : A.FunDeclId.id) (fname : fun_name)
+  let termination_measure_name (_fid : A.FunDeclId.id) (fname : llbc_name)
       (num_loops : int) (loop_id : LoopId.id option) : string =
     let fname = get_fun_name fname in
     let lp_suffix = default_fun_loop_suffix num_loops loop_id in
@@ -760,7 +821,7 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     fname ^ lp_suffix ^ suffix
   in
 
-  let decreases_proof_name (_fid : A.FunDeclId.id) (fname : fun_name)
+  let decreases_proof_name (_fid : A.FunDeclId.id) (fname : llbc_name)
       (num_loops : int) (loop_id : LoopId.id option) : string =
     let fname = get_fun_name fname in
     let lp_suffix = default_fun_loop_suffix num_loops loop_id in
@@ -815,12 +876,12 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
             | TAdtId adt_id ->
                 let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
                 (* Derive the var name from the last ident of the type name
-                 * Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm"
-                 *)
+                   Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm"
+                *)
                 (* The name shouldn't be empty, and its last element should
                  * be an ident *)
-                let cl = List.nth def.name (List.length def.name - 1) in
-                name_from_type_ident (Names.as_ident cl))
+                let cl = Collections.List.last def.name in
+                name_from_type_ident (TypesUtils.as_ident cl))
         | TVar _ -> (
             (* TODO: use "t" also for F* *)
             match !backend with
@@ -866,31 +927,31 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
     match cv with
     | VScalar sv -> (
         match !backend with
-        | FStar -> F.pp_print_string fmt (Z.to_string sv.PV.value)
+        | FStar -> F.pp_print_string fmt (Z.to_string sv.value)
         | Coq | HOL4 | Lean ->
             let print_brackets = inside && !backend = HOL4 in
             if print_brackets then F.pp_print_string fmt "(";
             (match !backend with
             | Coq | Lean -> ()
             | HOL4 ->
-                F.pp_print_string fmt ("int_to_" ^ int_name sv.PV.int_ty);
+                F.pp_print_string fmt ("int_to_" ^ int_name sv.int_ty);
                 F.pp_print_space fmt ()
             | _ -> raise (Failure "Unreachable"));
             (* We need to add parentheses if the value is negative *)
-            if sv.PV.value >= Z.of_int 0 then
-              F.pp_print_string fmt (Z.to_string sv.PV.value)
+            if sv.value >= Z.of_int 0 then
+              F.pp_print_string fmt (Z.to_string sv.value)
             else if !backend = Lean then
               (* TODO: parsing issues with Lean because there are ambiguous
                  interpretations between int values and nat values *)
               F.pp_print_string fmt
-                ("(-(" ^ Z.to_string (Z.neg sv.PV.value) ^ ":Int))")
-            else F.pp_print_string fmt ("(" ^ Z.to_string sv.PV.value ^ ")");
+                ("(-(" ^ Z.to_string (Z.neg sv.value) ^ ":Int))")
+            else F.pp_print_string fmt ("(" ^ Z.to_string sv.value ^ ")");
             (match !backend with
             | Coq ->
-                let iname = int_name sv.PV.int_ty in
+                let iname = int_name sv.int_ty in
                 F.pp_print_string fmt ("%" ^ iname)
             | Lean ->
-                let iname = String.lowercase_ascii (int_name sv.PV.int_ty) in
+                let iname = String.lowercase_ascii (int_name sv.int_ty) in
                 F.pp_print_string fmt ("#" ^ iname)
             | HOL4 -> ()
             | _ -> raise (Failure "Unreachable"));
@@ -1426,7 +1487,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
     extraction_ctx =
   (* Lookup the builtin information, if there is *)
   let open ExtractBuiltin in
-  let sname = name_to_simple_name def.name in
+  let sname = name_to_simple_name def.llbc_name in
   let info = SimpleNameMap.find_opt sname (builtin_types_map ()) in
   (* Register the filtering information, if there is *)
   let ctx =
@@ -1442,7 +1503,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
   (* Compute and register the type def name *)
   let def_name =
     match info with
-    | None -> ctx.fmt.type_name def.name
+    | None -> ctx.fmt.type_name def.llbc_name
     | Some info -> info.extract_name
   in
   let ctx = ctx_add (TypeId (TAdtId def.def_id)) def_name ctx in
@@ -1460,10 +1521,10 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
               let field_names =
                 FieldId.mapi
                   (fun fid (field : field) ->
-                    (fid, ctx.fmt.field_name def.name fid field.field_name))
+                    (fid, ctx.fmt.field_name def.llbc_name fid field.field_name))
                   fields
               in
-              let cons_name = ctx.fmt.struct_constructor def.name in
+              let cons_name = ctx.fmt.struct_constructor def.llbc_name in
               (field_names, cons_name)
           | Some { body_info = Some (Struct (cons_name, field_names)); _ } ->
               let field_names =
@@ -1499,12 +1560,12 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
               VariantId.mapi
                 (fun variant_id (variant : variant) ->
                   let name =
-                    ctx.fmt.variant_name def.name variant.variant_name
+                    ctx.fmt.variant_name def.llbc_name variant.variant_name
                   in
                   (* Add the type name prefix for Lean *)
                   let name =
                     if !Config.backend = Lean then
-                      let type_name = ctx.fmt.type_name def.name in
+                      let type_name = ctx.fmt.type_name def.llbc_name in
                       type_name ^ "." ^ name
                     else name
                   in
@@ -1648,7 +1709,7 @@ let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter)
   let print_variant _variant_id (v : variant) =
     (* We don't lookup the name, because it may have a prefix for the type
        id (in the case of Lean) *)
-    let cons_name = ctx.fmt.variant_name def.name v.variant_name in
+    let cons_name = ctx.fmt.variant_name def.llbc_name v.variant_name in
     let fields = v.fields in
     extract_type_decl_variant ctx fmt type_decl_group def_name type_params
       cg_params cons_name fields
@@ -2030,7 +2091,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
   if !backend <> HOL4 || not (decl_is_first_from_group kind) then
     F.pp_print_break fmt 0 0;
   (* Print a comment to link the extracted type to its original rust definition *)
-  extract_comment fmt [ "[" ^ Print.name_to_string def.name ^ "]" ];
+  extract_comment fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]" ];
   F.pp_print_break fmt 0 0;
   (* Open a box for the definition, so that whenever possible it gets printed on
    * one line. Note however that in the case of Lean line breaks are important
diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml
index 57aa9e12..a07ad35a 100644
--- a/compiler/FunsAnalysis.ml
+++ b/compiler/FunsAnalysis.ml
@@ -164,7 +164,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
 
   let analyze_fun_decl_group (d : fun_declaration_group) : unit =
     (* Retrieve the function declarations *)
-    let funs = match d with NonRec id -> [ id ] | Rec ids -> ids in
+    let funs = match d with NonRecGroup id -> [ id ] | RecGroup ids -> ids in
     let funs = List.map (fun id -> FunDeclId.Map.find id funs_map) funs in
     let fun_ids = List.map (fun (d : fun_decl) -> d.def_id) funs in
     let fun_ids = FunDeclId.Set.of_list fun_ids in
@@ -183,7 +183,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
     | GlobalGroup id :: decls' ->
         (* Analyze a global by analyzing its body function *)
         let global = GlobalDeclId.Map.find id globals_map in
-        analyze_fun_decl_group (NonRec global.body);
+        analyze_fun_decl_group (NonRecGroup global.body);
         analyze_decl_groups decls'
   in
 
diff --git a/compiler/Print.ml b/compiler/Print.ml
index cd83a589..48a5a20b 100644
--- a/compiler/Print.ml
+++ b/compiler/Print.ml
@@ -1,6 +1,5 @@
 include Charon.PrintUtils
 include Charon.PrintLlbcAst
-open Charon.PrintPrimitiveValues
 open Charon.PrintTypes
 open Charon.PrintExpressions
 open Charon.PrintLlbcAst.Ast
diff --git a/compiler/Pure.ml b/compiler/Pure.ml
index fa059499..40711e53 100644
--- a/compiler/Pure.ml
+++ b/compiler/Pure.ml
@@ -14,6 +14,7 @@ module GlobalDeclId = A.GlobalDeclId
 module TraitDeclId = T.TraitDeclId
 module TraitImplId = T.TraitImplId
 module TraitClauseId = T.TraitClauseId
+module Disambiguator = T.Disambiguator
 
 (** We redefine identifiers for loop: in {!Values}, the identifiers are global
     (they monotonically increase across functions) while in {!module:Pure} we want
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index d2747a4b..2106c206 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -3,10 +3,13 @@
 open Pure
 open PureUtils
 open TranslateCore
-module V = Values
 
 (** The local logger *)
-let log = L.pure_micro_passes_log
+let log = Logging.pure_micro_passes_log
+
+let fun_decl_to_string (ctx : trans_ctx) (def : Pure.fun_decl) : string =
+  let fmt = trans_ctx_to_pure_fmt_env ctx in
+  PrintPure.fun_decl_to_string fmt def
 
 (** Small utility.
 
@@ -597,8 +600,8 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl =
                     match
                       TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls_groups
                     with
-                    | NonRec _ -> false
-                    | Rec _ -> true
+                    | NonRecGroup _ -> false
+                    | RecGroup _ -> true
                   in
                   (* Convert, if possible - note that for now for Lean and Coq
                      we don't support the structure syntax on recursive structures *)
@@ -1420,14 +1423,15 @@ let decompose_loops (def : fun_decl) : fun_decl * fun_decl list =
 
             let loop_body = { inputs; inputs_lvs; body = loop_body } in
 
-            let loop_def =
+            let loop_def : fun_decl =
               {
                 def_id = def.def_id;
                 kind = def.kind;
                 num_loops;
                 loop_id = Some loop.loop_id;
                 back_id = def.back_id;
-                basename = def.basename;
+                llbc_name = def.llbc_name;
+                name = def.name;
                 signature = loop_sig;
                 is_global_decl_body = def.is_global_decl_body;
                 body = Some loop_body;
@@ -1539,10 +1543,12 @@ let eliminate_box_functions (ctx : trans_ctx) (def : fun_decl) : fun_decl =
                     mk_unit_rvalue
                 | ( ( SliceIndexShared | SliceIndexMut | ArrayIndexShared
                     | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut
-                    | ArrayRepeat | SliceLen ),
+                    | ArrayRepeat ),
                     _ ) ->
                     super#visit_texpression env e)
-            | Fun (FromLlbc (FunId (FRegular fid), _lp_id, rg_id)) -> (
+            | Fun (FromLlbc (FunId (FRegular fid), _lp_id, rg_id)) ->
+                failwith "TODO"
+                (*
                 (* Lookup the function name *)
                 let def = FunDeclId.Map.find fid ctx.fun_ctx.fun_decls in
                 match
@@ -1570,7 +1576,8 @@ let eliminate_box_functions (ctx : trans_ctx) (def : fun_decl) : fun_decl =
                       | _ -> raise (Failure "Unreachable")
                     in
                     mk_apps arg args
-                | _ -> super#visit_texpression env e)
+                | _ -> super#visit_texpression env e
+                       *)
             | _ -> super#visit_texpression env e)
         | _ -> super#visit_texpression env e
     end
@@ -1918,9 +1925,7 @@ let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) :
   (* Debug *)
   log#ldebug
     (lazy
-      ("PureMicroPasses.apply_passes_to_def: "
-      ^ Print.fun_name_to_string def.basename
-      ^ " ("
+      ("PureMicroPasses.apply_passes_to_def: " ^ def.name ^ " ("
       ^ Print.option_to_string T.RegionGroupId.to_string def.back_id
       ^ ")"));
 
diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index 2460e040..4e12d31e 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -3036,9 +3036,9 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl =
   (* return *)
   def
 
-let translate_type_decls (ctx : Contexts.decls_ctx)
-    (type_decls : T.type_decl list) : type_decl list =
-  List.map (translate_type_decl ctx) type_decls
+let translate_type_decls (ctx : Contexts.decls_ctx) : type_decl list =
+  List.map (translate_type_decl ctx)
+    (TypeDeclId.Map.values ctx.type_ctx.type_decls)
 
 (** Translates function signatures.
 
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 2aedb544..cf23fd44 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -1,11 +1,11 @@
-open InterpreterStatements
 open Interpreter
-module L = Logging
-module T = Types
-module A = LlbcAst
+open Expressions
+open Types
+open Values
+open LlbcAst
+open Contexts
 module SA = SymbolicAst
 module Micro = PureMicroPasses
-module C = Contexts
 open PureUtils
 open TranslateCore
 
@@ -16,18 +16,17 @@ let log = TranslateCore.log
     - the list of symbolic values used for the input values
     - the generated symbolic AST
 *)
-type symbolic_fun_translation = V.symbolic_value list * SA.expression
+type symbolic_fun_translation = symbolic_value list * SA.expression
 
 (** Execute the symbolic interpreter on a function to generate a list of symbolic ASTs,
     for the forward function and the backward functions.
 *)
-let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : A.fun_decl)
-    : symbolic_fun_translation option =
+let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : fun_decl) :
+    symbolic_fun_translation option =
   (* Debug *)
   log#ldebug
     (lazy
-      ("translate_function_to_symbolics: "
-      ^ Print.fun_name_to_string fdef.A.name));
+      ("translate_function_to_symbolics: " ^ name_to_string trans_ctx fdef.name));
 
   match fdef.body with
   | None -> None
@@ -45,12 +44,11 @@ let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : A.fun_decl)
 *)
 let translate_function_to_pure (trans_ctx : trans_ctx)
     (fun_sigs : SymbolicToPure.fun_sig_named_outputs RegularFunIdNotLoopMap.t)
-    (pure_type_decls : Pure.type_decl Pure.TypeDeclId.Map.t) (fdef : A.fun_decl)
-    : pure_fun_translation_no_loops =
+    (pure_type_decls : Pure.type_decl Pure.TypeDeclId.Map.t) (fdef : fun_decl) :
+    pure_fun_translation_no_loops =
   (* Debug *)
   log#ldebug
-    (lazy
-      ("translate_function_to_pure: " ^ Print.fun_name_to_string fdef.A.name));
+    (lazy ("translate_function_to_pure: " ^ name_to_string trans_ctx fdef.name));
 
   let def_id = fdef.def_id in
 
@@ -61,22 +59,24 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
 
   (* Initialize the context *)
   let forward_sig =
-    RegularFunIdNotLoopMap.find (E.FRegular def_id, None) fun_sigs
+    RegularFunIdNotLoopMap.find (FRegular def_id, None) fun_sigs
   in
-  let sv_to_var = V.SymbolicValueId.Map.empty in
+  let sv_to_var = SymbolicValueId.Map.empty in
   let var_counter = Pure.VarId.generator_zero in
   let state_var, var_counter = Pure.VarId.fresh var_counter in
   let back_state_var, var_counter = Pure.VarId.fresh var_counter in
   let fuel0, var_counter = Pure.VarId.fresh var_counter in
   let fuel, var_counter = Pure.VarId.fresh var_counter in
-  let calls = V.FunCallId.Map.empty in
-  let abstractions = V.AbstractionId.Map.empty in
+  let calls = FunCallId.Map.empty in
+  let abstractions = AbstractionId.Map.empty in
   let recursive_type_decls =
-    T.TypeDeclId.Set.of_list
+    TypeDeclId.Set.of_list
       (List.filter_map
          (fun (tid, g) ->
-           match g with Charon.GAst.NonRec _ -> None | Rec _ -> Some tid)
-         (T.TypeDeclId.Map.bindings trans_ctx.type_ctx.type_decls_groups))
+           match g with
+           | Charon.GAst.NonRecGroup _ -> None
+           | RecGroup _ -> Some tid)
+         (TypeDeclId.Map.bindings trans_ctx.type_ctx.type_decls_groups))
   in
   let type_context =
     {
@@ -104,9 +104,9 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
   *)
   let loop_ids_map =
     match symbolic_trans with
-    | None -> V.LoopId.Map.empty
+    | None -> LoopId.Map.empty
     | Some (_, ast) ->
-        let m = ref V.LoopId.Map.empty in
+        let m = ref LoopId.Map.empty in
         let _, fresh_loop_id = Pure.LoopId.fresh_stateful_generator () in
 
         let visitor =
@@ -115,10 +115,9 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
 
             method! visit_loop env loop =
               let _ =
-                match V.LoopId.Map.find_opt loop.loop_id !m with
+                match LoopId.Map.find_opt loop.loop_id !m with
                 | Some _ -> ()
-                | None ->
-                    m := V.LoopId.Map.add loop.loop_id (fresh_loop_id ()) !m
+                | None -> m := LoopId.Map.add loop.loop_id (fresh_loop_id ()) !m
               in
               super#visit_loop env loop
           end
@@ -148,9 +147,9 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
       fun_decl = fdef;
       forward_inputs = [];
       (* Empty for now *)
-      backward_inputs = T.RegionGroupId.Map.empty;
+      backward_inputs = RegionGroupId.Map.empty;
       (* Empty for now *)
-      backward_outputs = T.RegionGroupId.Map.empty;
+      backward_outputs = RegionGroupId.Map.empty;
       loop_backward_outputs = None;
       (* Empty for now *)
       calls;
@@ -171,7 +170,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
     | Some body, Some (input_svs, _) ->
         let forward_input_vars = LlbcAstUtils.fun_body_get_input_vars body in
         let forward_input_varnames =
-          List.map (fun (v : A.var) -> v.name) forward_input_vars
+          List.map (fun (v : var) -> v.name) forward_input_vars
         in
         let input_svs = List.combine forward_input_varnames input_svs in
         let ctx, forward_inputs =
@@ -189,7 +188,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
   in
 
   (* Translate the backward functions *)
-  let translate_backward (rg : T.region_group) : Pure.fun_decl =
+  let translate_backward (rg : region_group) : Pure.fun_decl =
     (* For the backward inputs/outputs initialization: we use the fact that
      * there are no nested borrows for now, and so that the region groups
      * can't have parents *)
@@ -244,10 +243,10 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
           SymbolicToPure.fresh_vars backward_outputs ctx
         in
         let backward_inputs =
-          T.RegionGroupId.Map.singleton back_id backward_inputs
+          RegionGroupId.Map.singleton back_id backward_inputs
         in
         let backward_outputs =
-          T.RegionGroupId.Map.singleton back_id backward_outputs
+          RegionGroupId.Map.singleton back_id backward_outputs
         in
 
         (* Put everything in the context *)
@@ -274,7 +273,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx)
   (pure_forward, pure_backwards)
 
 (* TODO: factor out the return type *)
-let translate_crate_to_pure (crate : A.crate) :
+let translate_crate_to_pure (crate : crate) :
     trans_ctx
     * Pure.type_decl list
     * pure_fun_translation list
@@ -287,9 +286,7 @@ let translate_crate_to_pure (crate : A.crate) :
   let trans_ctx = compute_contexts crate in
 
   (* Translate all the type definitions *)
-  let type_decls =
-    SymbolicToPure.translate_type_decls (T.TypeDeclId.Map.values crate.types)
-  in
+  let type_decls = SymbolicToPure.translate_type_decls trans_ctx in
 
   (* Compute the type definition map *)
   let type_decls_map =
@@ -301,24 +298,24 @@ let translate_crate_to_pure (crate : A.crate) :
   let assumed_sigs =
     List.map
       (fun (info : Assumed.assumed_fun_info) ->
-        ( E.FAssumed info.fun_id,
+        ( FAssumed info.fun_id,
           List.map (fun _ -> None) info.fun_sig.inputs,
           info.fun_sig ))
       Assumed.assumed_fun_infos
   in
   let local_sigs =
     List.map
-      (fun (fdef : A.fun_decl) ->
+      (fun (fdef : fun_decl) ->
         let input_names =
           match fdef.body with
           | None -> List.map (fun _ -> None) fdef.signature.inputs
           | Some body ->
               List.map
-                (fun (v : A.var) -> v.name)
+                (fun (v : var) -> v.name)
                 (LlbcAstUtils.fun_body_get_input_vars body)
         in
-        (E.FRegular fdef.def_id, input_names, fdef.signature))
-      (A.FunDeclId.Map.values crate.functions)
+        (FRegular fdef.def_id, input_names, fdef.signature))
+      (FunDeclId.Map.values crate.fun_decls)
   in
   let sigs = List.append assumed_sigs local_sigs in
   let fun_sigs = SymbolicToPure.translate_fun_signatures trans_ctx sigs in
@@ -327,22 +324,21 @@ let translate_crate_to_pure (crate : A.crate) :
   let pure_translations =
     List.map
       (translate_function_to_pure trans_ctx fun_sigs type_decls_map)
-      (A.FunDeclId.Map.values crate.functions)
+      (FunDeclId.Map.values crate.fun_decls)
   in
 
   (* Translate the trait declarations *)
-  let type_infos = trans_ctx.type_ctx.type_infos in
   let trait_decls =
     List.map
-      (SymbolicToPure.translate_trait_decl type_infos)
-      (T.TraitDeclId.Map.values trans_ctx.trait_decls_ctx.trait_decls)
+      (SymbolicToPure.translate_trait_decl trans_ctx)
+      (TraitDeclId.Map.values trans_ctx.trait_decls_ctx.trait_decls)
   in
 
   (* Translate the trait implementations *)
   let trait_impls =
     List.map
-      (SymbolicToPure.translate_trait_impl type_infos)
-      (T.TraitImplId.Map.values trans_ctx.trait_impls_ctx.trait_impls)
+      (SymbolicToPure.translate_trait_impl trans_ctx)
+      (TraitImplId.Map.values trans_ctx.trait_impls_ctx.trait_impls)
   in
 
   (* Apply the micro-passes *)
@@ -401,9 +397,9 @@ let crate_has_opaque_non_builtin_decls (ctx : gen_ctx) (filter_assumed : bool) :
   log#ldebug
     (lazy
       ("Opaque decls:" ^ "\n- types:\n"
-      ^ String.concat ",\n" (List.map T.show_type_decl types)
+      ^ String.concat ",\n" (List.map show_type_decl types)
       ^ "\n- functions:\n"
-      ^ String.concat ",\n" (List.map A.show_fun_decl funs)));
+      ^ String.concat ",\n" (List.map show_fun_decl funs)));
   (types <> [], funs <> [])
 
 (** Export a type declaration.
@@ -481,7 +477,7 @@ let export_types_group (fmt : Format.formatter) (config : gen_config)
     let types_map = builtin_types_map () in
     List.map
       (fun (def : Pure.type_decl) ->
-        let sname = name_to_simple_name def.name in
+        let sname = name_to_simple_name def.llbc_name in
         SimpleNameMap.find_opt sname types_map <> None)
       defs
   in
@@ -531,10 +527,10 @@ let export_types_group (fmt : Format.formatter) (config : gen_config)
     TODO: check correct behavior with opaque globals.
  *)
 let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
-    (id : A.GlobalDeclId.id) : unit =
+    (id : GlobalDeclId.id) : unit =
   let global_decls = ctx.trans_ctx.global_ctx.global_decls in
-  let global = A.GlobalDeclId.Map.find id global_decls in
-  let trans = A.FunDeclId.Map.find global.body_id ctx.trans_funs in
+  let global = GlobalDeclId.Map.find id global_decls in
+  let trans = FunDeclId.Map.find global.body ctx.trans_funs in
   assert (trans.fwd.loops = []);
   assert (trans.backs = []);
   let body = trans.fwd.f in
@@ -665,7 +661,7 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
     let funs_map = builtin_funs_map () in
     List.map
       (fun (trans : pure_fun_translation) ->
-        let sname = name_to_simple_name trans.fwd.f.basename in
+        let sname = name_to_simple_name trans.fwd.f.llbc_name in
         SimpleNameMap.find_opt sname funs_map <> None)
       pure_ls
   in
@@ -756,10 +752,10 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
 let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
     (ctx : gen_ctx) (trait_decl_id : Pure.trait_decl_id) (extract_decl : bool)
     (extract_extra_info : bool) : unit =
-  let trait_decl = T.TraitDeclId.Map.find trait_decl_id ctx.trans_trait_decls in
+  let trait_decl = TraitDeclId.Map.find trait_decl_id ctx.trans_trait_decls in
   (* Check if the trait declaration is builtin, in which case we ignore it *)
   let open ExtractBuiltin in
-  let sname = name_to_simple_name trait_decl.name in
+  let sname = name_to_simple_name trait_decl.llbc_name in
   if SimpleNameMap.find_opt sname (builtin_trait_decls_map ()) = None then (
     let ctx = { ctx with trait_decl_id = Some trait_decl.def_id } in
     if extract_decl then Extract.extract_trait_decl ctx fmt trait_decl;
@@ -771,7 +767,7 @@ let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
 let export_trait_impl (fmt : Format.formatter) (_config : gen_config)
     (ctx : gen_ctx) (trait_impl_id : Pure.trait_impl_id) : unit =
   (* Lookup the definition *)
-  let trait_impl = T.TraitImplId.Map.find trait_impl_id ctx.trans_trait_impls in
+  let trait_impl = TraitImplId.Map.find trait_impl_id ctx.trans_trait_impls in
   let trait_decl =
     Pure.TraitDeclId.Map.find trait_impl.impl_trait.trait_decl_id
       ctx.trans_trait_decls
@@ -779,8 +775,8 @@ let export_trait_impl (fmt : Format.formatter) (_config : gen_config)
   (* Check if the trait implementation is builtin *)
   let builtin_info =
     let open ExtractBuiltin in
-    let type_sname = name_to_simple_name trait_impl.name in
-    let trait_sname = name_to_simple_name trait_decl.name in
+    let type_sname = name_to_simple_name trait_impl.llbc_name in
+    let trait_sname = name_to_simple_name trait_decl.llbc_name in
     SimpleNamePairMap.find_opt (type_sname, trait_sname)
       (builtin_trait_impls_map ())
   in
@@ -817,14 +813,15 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
     Extract.extract_state_type fmt ctx kind
   in
 
-  let export_decl_group (dg : A.declaration_group) : unit =
+  let export_decl_group (dg : declaration_group) : unit =
     match dg with
-    | Type (NonRec id) ->
+    | TypeGroup (NonRecGroup id) ->
         if config.extract_types then export_types_group false [ id ]
-    | Type (Rec ids) -> if config.extract_types then export_types_group true ids
-    | Fun (NonRec id) -> (
+    | TypeGroup (RecGroup ids) ->
+        if config.extract_types then export_types_group true ids
+    | FunGroup (NonRecGroup id) -> (
         (* Lookup *)
-        let pure_fun = A.FunDeclId.Map.find id ctx.trans_funs in
+        let pure_fun = FunDeclId.Map.find id ctx.trans_funs in
         (* Special case: we skip trait method *declarations* (we will
            extract their type directly in the records we generate for
            the trait declarations themselves, there is no point in having
@@ -834,21 +831,21 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config)
         | _ ->
             (* Translate *)
             export_functions_group [ pure_fun ])
-    | Fun (Rec ids) ->
+    | FunGroup (RecGroup ids) ->
         (* General case of mutually recursive functions *)
         (* Lookup *)
         let pure_funs =
-          List.map (fun id -> A.FunDeclId.Map.find id ctx.trans_funs) ids
+          List.map (fun id -> FunDeclId.Map.find id ctx.trans_funs) ids
         in
         (* Translate *)
         export_functions_group pure_funs
-    | Global id -> export_global id
-    | TraitDecl id ->
+    | GlobalGroup id -> export_global id
+    | TraitDeclGroup id ->
         (* TODO: update to extract groups *)
         if config.extract_trait_decls && config.extract_transparent then (
           export_trait_decl_group id;
           export_trait_decl_group_extra_info id)
-    | TraitImpl id ->
+    | TraitImplGroup id ->
         if config.extract_trait_impls && config.extract_transparent then
           export_trait_impl id
   in
@@ -986,7 +983,7 @@ let extract_file (config : gen_config) (ctx : gen_ctx) (fi : extract_file_info)
   close_out out
 
 (** Translate a crate and write the synthesized code to an output file. *)
-let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
+let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
     unit =
   (* Translate the module to the pure AST *)
   let trans_ctx, trans_types, trans_funs, trans_trait_decls, trans_trait_impls =
@@ -1036,8 +1033,8 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
     Pure.TypeDeclId.Map.of_list
       (List.map (fun (d : Pure.type_decl) -> (d.def_id, d)) trans_types)
   in
-  let trans_funs : pure_fun_translation A.FunDeclId.Map.t =
-    A.FunDeclId.Map.of_list
+  let trans_funs : pure_fun_translation FunDeclId.Map.t =
+    FunDeclId.Map.of_list
       (List.map
          (fun (trans : pure_fun_translation) -> (trans.fwd.f.def_id, trans))
          trans_funs)
@@ -1046,13 +1043,13 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
   (* Put everything in the context *)
   let ctx =
     let trans_trait_decls =
-      T.TraitDeclId.Map.of_list
+      TraitDeclId.Map.of_list
         (List.map
            (fun (d : Pure.trait_decl) -> (d.def_id, d))
            trans_trait_decls)
     in
     let trans_trait_impls =
-      T.TraitImplId.Map.of_list
+      TraitImplId.Map.of_list
         (List.map
            (fun (d : Pure.trait_impl) -> (d.def_id, d))
            trans_trait_impls)
@@ -1107,12 +1104,12 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
         if is_global then ctx
         else Extract.extract_fun_decl_register_names ctx gen_decr_clause trans)
       ctx
-      (A.FunDeclId.Map.values trans_funs)
+      (FunDeclId.Map.values trans_funs)
   in
 
   let ctx =
     List.fold_left Extract.extract_global_decl_register_names ctx
-      (A.GlobalDeclId.Map.values crate.globals)
+      (GlobalDeclId.Map.values crate.global_decls)
   in
 
   let ctx =
@@ -1291,7 +1288,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
          namespace;
          in_namespace = true;
          crate_name;
-         rust_module_name = crate.A.name;
+         rust_module_name = crate.name;
          module_name = types_module;
          custom_msg = ": type definitions";
          custom_imports = [];
@@ -1319,7 +1316,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
             namespace;
             in_namespace = true;
             crate_name;
-            rust_module_name = crate.A.name;
+            rust_module_name = crate.name;
             module_name = template_clauses_module;
             custom_msg = ": templates for the decreases clauses";
             custom_imports = [ types_module ];
@@ -1369,7 +1366,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
              namespace;
              in_namespace = false;
              crate_name;
-             rust_module_name = crate.A.name;
+             rust_module_name = crate.name;
              module_name = opaque_module;
              custom_msg;
              custom_imports = [];
@@ -1408,7 +1405,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
          namespace;
          in_namespace = true;
          crate_name;
-         rust_module_name = crate.A.name;
+         rust_module_name = crate.name;
          module_name = fun_module;
          custom_msg = ": function definitions";
          custom_imports = [];
@@ -1441,7 +1438,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) :
          namespace;
          in_namespace = true;
          crate_name;
-         rust_module_name = crate.A.name;
+         rust_module_name = crate.name;
          module_name = crate_name;
          custom_msg = "";
          custom_imports = [];
diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml
index a148175d..a974cdee 100644
--- a/compiler/TranslateCore.ml
+++ b/compiler/TranslateCore.ml
@@ -26,3 +26,6 @@ let trans_ctx_to_fmt_env (ctx : trans_ctx) : Print.fmt_env =
 
 let trans_ctx_to_pure_fmt_env (ctx : trans_ctx) : PrintPure.fmt_env =
   PrintPure.decls_ctx_to_fmt_env ctx
+
+let name_to_string (ctx : trans_ctx) =
+  Print.Types.name_to_string (trans_ctx_to_fmt_env ctx)
diff --git a/compiler/TypesAnalysis.ml b/compiler/TypesAnalysis.ml
index 659eac59..5371a3d7 100644
--- a/compiler/TypesAnalysis.ml
+++ b/compiler/TypesAnalysis.ml
@@ -283,7 +283,7 @@ let analyze_type_decl (updated : bool ref) (infos : type_infos)
 let analyze_type_declaration_group (type_decls : type_decl TypeDeclId.Map.t)
     (infos : type_infos) (decl : A.type_declaration_group) : type_infos =
   (* Collect the identifiers used in the declaration group *)
-  let ids = match decl with NonRec id -> [ id ] | Rec ids -> ids in
+  let ids = match decl with NonRecGroup id -> [ id ] | RecGroup ids -> ids in
   (* Retrieve the type definitions *)
   let decl_defs = List.map (fun id -> TypeDeclId.Map.find id type_decls) ids in
   (* Initialize the type information for the current definitions *)
-- 
cgit v1.3.1


From 672ceef25203ebd5fcf5a55e294a4ebfe65648d6 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 20 Nov 2023 21:58:25 +0100
Subject: Use the name matcher implemented in Charon

---
 compiler/Assumed.ml                |   2 +-
 compiler/Extract.ml                |  18 +-
 compiler/ExtractBase.ml            |   3 +-
 compiler/ExtractBuiltin.ml         | 394 +++++++++++++------------------------
 compiler/ExtractName.ml            | 177 +++++++++++++++++
 compiler/ExtractTypes.ml           | 106 +++-------
 compiler/FunsAnalysis.ml           |  10 +-
 compiler/Interpreter.ml            |   2 +-
 compiler/InterpreterExpressions.ml |   2 +-
 compiler/LlbcAstUtils.ml           |  15 +-
 compiler/PrintPure.ml              |   6 +-
 compiler/PureUtils.ml              |   2 +-
 compiler/StringUtils.ml            | 112 +----------
 compiler/Substitute.ml             |   4 +-
 compiler/SymbolicAst.ml            |   2 +-
 compiler/SymbolicToPure.ml         |   4 +-
 compiler/Translate.ml              |  25 +--
 compiler/TranslateCore.ml          |  48 +++++
 compiler/dune                      |   3 +-
 19 files changed, 440 insertions(+), 495 deletions(-)
 create mode 100644 compiler/ExtractName.ml

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Assumed.ml b/compiler/Assumed.ml
index 6aec626a..48b7ee2b 100644
--- a/compiler/Assumed.ml
+++ b/compiler/Assumed.ml
@@ -42,7 +42,7 @@ module Sig = struct
   let tvar_id_0 = TypeVarId.of_int 0
   let tvar_0 : ty = TVar tvar_id_0
   let cgvar_id_0 = ConstGenericVarId.of_int 0
-  let cgvar_0 : const_generic = CGVar cgvar_id_0
+  let cgvar_0 : const_generic = CgVar cgvar_id_0
 
   (** Region 'a of id 0 *)
   let region_param_0 : region_var = { index = rvar_id_0; name = Some "'a" }
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index cd62c15c..fb3364f4 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -27,8 +27,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx)
       let builtin =
         let open ExtractBuiltin in
         let funs_map = builtin_funs_map () in
-        let sname = name_to_simple_name def.fwd.f.llbc_name in
-        SimpleNameMap.find_opt sname funs_map
+        match_name_find_opt ctx.trans_ctx def.fwd.f.llbc_name funs_map
       in
       (* Use the builtin names if necessary *)
       match builtin with
@@ -2024,9 +2023,9 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
     (trait_decl : trait_decl) : extraction_ctx =
   (* Lookup the information if this is a builtin trait *)
   let open ExtractBuiltin in
-  let sname = name_to_simple_name trait_decl.llbc_name in
   let builtin_info =
-    SimpleNameMap.find_opt sname (builtin_trait_decls_map ())
+    match_name_find_opt ctx.trans_ctx trait_decl.llbc_name
+      (builtin_trait_decls_map ())
   in
   let ctx =
     let trait_name, trait_constructor =
@@ -2061,9 +2060,14 @@ let extract_trait_impl_register_names (ctx : extraction_ctx)
   (* Check if the trait implementation is builtin *)
   let builtin_info =
     let open ExtractBuiltin in
-    let type_sname = name_to_simple_name trait_impl.llbc_name in
-    let trait_sname = name_to_simple_name trait_decl.llbc_name in
-    SimpleNamePairMap.find_opt (type_sname, trait_sname)
+    (* Lookup the original Rust impl to retrieve the original trait ref (we
+       use it to derive the name)*)
+    let trait_impl =
+      TraitImplId.Map.find trait_impl.def_id ctx.crate.trait_impls
+    in
+    let decl_ref = trait_impl.impl_trait in
+    match_name_with_generics_find_opt ctx.trans_ctx trait_decl.llbc_name
+      decl_ref.decl_generics
       (builtin_trait_impls_map ())
   in
   (* Register some builtin information (if necessary) *)
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index ae5a9a22..f1ba35a2 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1085,8 +1085,7 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
   (* Check if the global corresponds to an assumed global that we should map
      to a custom definition in our standard library (for instance, happens
      with "core::num::usize::MAX") *)
-  let sname = name_to_simple_name def.name in
-  match SimpleNameMap.find_opt sname builtin_globals_map with
+  match match_name_find_opt ctx.trans_ctx def.name builtin_globals_map with
   | Some name ->
       (* Yes: register the custom binding *)
       ctx_add decl name ctx
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index db942ff0..d15905a2 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -5,38 +5,8 @@
  *)
 
 open Config
-open Types
-
-type simple_name = string list [@@deriving show, ord]
-
-(* TODO: update *)
-let name_to_simple_name (s : name) : simple_name =
-  (* We simply ignore the disambiguators - TODO: update *)
-  List.map
-    (function
-      | PeIdent (id, _) -> id
-      | PeImpl i ->
-          (* TODO *)
-          show_impl_elem i)
-    s
-
-(** Small helper which cuts a string at the occurrences of "::" *)
-let string_to_simple_name (s : string) : simple_name =
-  (* No function to split by using string separator?? *)
-  let name = String.split_on_char ':' s in
-  List.filter (fun s -> s <> "") name
-
-module SimpleNameOrd = struct
-  type t = simple_name
-
-  let compare = compare_simple_name
-  let to_string = show_simple_name
-  let pp_t = pp_simple_name
-  let show_t = show_simple_name
-end
-
-module SimpleNameMap = Collections.MakeMap (SimpleNameOrd)
-module SimpleNameSet = Collections.MakeSet (SimpleNameOrd)
+open Charon.NameMatcher (* TODO: include? *)
+include ExtractName (* TODO: only open? *)
 
 (** Small utility to memoize some computations *)
 let mk_memoized (f : unit -> 'a) : unit -> 'a =
@@ -51,6 +21,9 @@ let mk_memoized (f : unit -> 'a) : unit -> 'a =
   in
   g
 
+let split_on_separator (s : string) : string list =
+  Str.split (Str.regexp "::") s
+
 (** Switch between two values depending on the target backend.
 
     We often compute the same value (typically: a name) if the target
@@ -62,36 +35,36 @@ let backend_choice (fstar_coq_hol4 : 'a) (lean : 'a) : 'a =
 let builtin_globals : (string * string) list =
   [
     (* Min *)
-    ("core::num::usize::MIN", "core_usize_min");
-    ("core::num::u8::MIN", "core_u8_min");
-    ("core::num::u16::MIN", "core_u16_min");
-    ("core::num::u32::MIN", "core_u32_min");
-    ("core::num::u64::MIN", "core_u64_min");
-    ("core::num::u128::MIN", "core_u128_min");
-    ("core::num::isize::MIN", "core_isize_min");
-    ("core::num::i8::MIN", "core_i8_min");
-    ("core::num::i16::MIN", "core_i16_min");
-    ("core::num::i32::MIN", "core_i32_min");
-    ("core::num::i64::MIN", "core_i64_min");
-    ("core::num::i128::MIN", "core_i128_min");
+    ("core::num::{usize}::MIN", "core_usize_min");
+    ("core::num::{u8}::MIN", "core_u8_min");
+    ("core::num::{u16}::MIN", "core_u16_min");
+    ("core::num::{u32}::MIN", "core_u32_min");
+    ("core::num::{u64}::MIN", "core_u64_min");
+    ("core::num::{u128}::MIN", "core_u128_min");
+    ("core::num::{isize}::MIN", "core_isize_min");
+    ("core::num::{i8}::MIN", "core_i8_min");
+    ("core::num::{i16}::MIN", "core_i16_min");
+    ("core::num::{i32}::MIN", "core_i32_min");
+    ("core::num::{i64}::MIN", "core_i64_min");
+    ("core::num::{i128}::MIN", "core_i128_min");
     (* Max *)
-    ("core::num::usize::MAX", "core_usize_max");
-    ("core::num::u8::MAX", "core_u8_max");
-    ("core::num::u16::MAX", "core_u16_max");
-    ("core::num::u32::MAX", "core_u32_max");
-    ("core::num::u64::MAX", "core_u64_max");
-    ("core::num::u128::MAX", "core_u128_max");
-    ("core::num::isize::MAX", "core_isize_max");
-    ("core::num::i8::MAX", "core_i8_max");
-    ("core::num::i16::MAX", "core_i16_max");
-    ("core::num::i32::MAX", "core_i32_max");
-    ("core::num::i64::MAX", "core_i64_max");
-    ("core::num::i128::MAX", "core_i128_max");
+    ("core::num::{usize}::MAX", "core_usize_max");
+    ("core::num::{u8}::MAX", "core_u8_max");
+    ("core::num::{u16}::MAX", "core_u16_max");
+    ("core::num::{u32}::MAX", "core_u32_max");
+    ("core::num::{u64}::MAX", "core_u64_max");
+    ("core::num::{u128}::MAX", "core_u128_max");
+    ("core::num::{isize}::MAX", "core_isize_max");
+    ("core::num::{i8}::MAX", "core_i8_max");
+    ("core::num::{i16}::MAX", "core_i16_max");
+    ("core::num::{i32}::MAX", "core_i32_max");
+    ("core::num::{i64}::MAX", "core_i64_max");
+    ("core::num::{i128}::MAX", "core_i128_max");
   ]
 
-let builtin_globals_map : string SimpleNameMap.t =
-  SimpleNameMap.of_list
-    (List.map (fun (x, y) -> (string_to_simple_name x, y)) builtin_globals)
+let builtin_globals_map : string NameMatcherMap.t =
+  NameMatcherMap.of_list
+    (List.map (fun (x, y) -> (parse_pattern x, y)) builtin_globals)
 
 type builtin_variant_info = { fields : (string * string) list }
 [@@deriving show]
@@ -111,7 +84,7 @@ type builtin_type_body_info =
 [@@deriving show]
 
 type builtin_type_info = {
-  rust_name : string list;
+  rust_name : pattern;
   extract_name : string;
   keep_params : bool list option;
       (** We might want to filter some of the type parameters.
@@ -143,11 +116,11 @@ let mk_struct_constructor (type_name : string) : string =
     a type parameter for the allocator to use, which we want to filter.
  *)
 let builtin_types () : builtin_type_info list =
-  let mk_type (rust_name : string list) ?(keep_params : bool list option = None)
+  let mk_type (rust_name : string) ?(keep_params : bool list option = None)
       ?(kind : type_variant_kind = KOpaque) () : builtin_type_info =
     let extract_name =
       let sep = backend_choice "_" "." in
-      String.concat sep rust_name
+      String.concat sep (split_on_separator rust_name)
     in
     let body_info : builtin_type_body_info option =
       match kind with
@@ -166,17 +139,17 @@ let builtin_types () : builtin_type_info list =
           Some (Struct (constructor, fields))
       | KEnum -> raise (Failure "TODO")
     in
+    let rust_name = parse_pattern rust_name in
     { rust_name; extract_name; keep_params; body_info }
   in
 
   [
     (* Alloc *)
-    mk_type [ "alloc"; "alloc"; "Global" ] ();
+    mk_type "alloc::alloc::Global" ();
     (* Vec *)
-    mk_type [ "alloc"; "vec"; "Vec" ] ~keep_params:(Some [ true; false ]) ();
+    mk_type "alloc::vec::Vec" ~keep_params:(Some [ true; false ]) ();
     (* Range *)
-    mk_type
-      [ "core"; "ops"; "range"; "Range" ]
+    mk_type "core::ops::range::Range"
       ~kind:(KStruct [ ("start", "start"); ("end", "end_") ])
       ();
     (* Option
@@ -185,7 +158,7 @@ let builtin_types () : builtin_type_info list =
        the target backend.
     *)
     {
-      rust_name = [ "core"; "option"; "Option" ];
+      rust_name = parse_pattern "core::option::Option";
       extract_name =
         (match !backend with
         | Lean -> "Option"
@@ -218,7 +191,7 @@ let builtin_types () : builtin_type_info list =
   ]
 
 let mk_builtin_types_map () =
-  SimpleNameMap.of_list
+  NameMatcherMap.of_list
     (List.map (fun info -> (info.rust_name, info)) (builtin_types ()))
 
 let builtin_types_map = mk_memoized mk_builtin_types_map
@@ -235,15 +208,22 @@ type builtin_fun_info = {
     parameters. For instance, in the case of the `Vec` functions, there is
     a type parameter for the allocator to use, which we want to filter.
  *)
-let builtin_funs () :
-    (string list * bool list option * builtin_fun_info list) list =
+let builtin_funs () : (pattern * bool list option * builtin_fun_info list) list
+    =
   let rg0 = Some Types.RegionGroupId.zero in
   (* Small utility *)
-  let mk_fun (name : string list) (extract_name : string list option)
+  let mk_fun (rust_name : string) (extract_name : string option)
       (filter : bool list option) (with_back : bool) (back_no_suffix : bool) :
-      string list * bool list option * builtin_fun_info list =
+      pattern * bool list option * builtin_fun_info list =
+    let rust_name =
+      try parse_pattern rust_name
+      with Failure _ ->
+        raise (Failure ("Could not parse pattern: " ^ rust_name))
+    in
     let extract_name =
-      match extract_name with None -> name | Some name -> name
+      match extract_name with
+      | None -> pattern_to_fun_extract_name rust_name
+      | Some name -> split_on_separator name
     in
     let basename =
       match !backend with
@@ -257,103 +237,55 @@ let builtin_funs () :
       if with_back then [ { rg = rg0; extract_name = basename ^ back_suffix } ]
       else []
     in
-    (name, filter, fwd @ back)
+    (rust_name, filter, fwd @ back)
   in
   [
-    mk_fun [ "core"; "mem"; "replace" ] None None true false;
-    mk_fun [ "alloc"; "vec"; "Vec"; "new" ] None None false false;
-    mk_fun
-      [ "alloc"; "vec"; "Vec"; "push" ]
-      None
+    mk_fun "core::mem::replace" None None true false;
+    mk_fun "alloc::vec::{alloc::vec::Vec<@T>}::new" None None false false;
+    mk_fun "alloc::vec::{alloc::vec::Vec<@T>}::push" None
       (Some [ true; false ])
       true true;
-    mk_fun
-      [ "alloc"; "vec"; "Vec"; "insert" ]
-      None
+    mk_fun "alloc::vec::{alloc::vec::Vec<@T>}::insert" None
       (Some [ true; false ])
       true true;
-    mk_fun
-      [ "alloc"; "vec"; "Vec"; "len" ]
-      None
+    mk_fun "alloc::vec::{alloc::vec::Vec<@T>}::len" None
       (Some [ true; false ])
       true false;
-    mk_fun
-      [ "alloc"; "vec"; "Vec"; "index" ]
-      None
+    mk_fun "alloc::vec::{alloc::vec::Vec<@T>}::index" None
       (Some [ true; true; false ])
       true false;
-    mk_fun
-      [ "alloc"; "vec"; "Vec"; "index_mut" ]
-      None
+    mk_fun "alloc::vec::{alloc::vec::Vec<@T>}::index_mut" None
       (Some [ true; true; false ])
       true false;
-    mk_fun
-      [ "alloc"; "boxed"; "Box"; "deref" ]
-      None
+    mk_fun "alloc::boxed::{Box<@T>}::deref" None
       (Some [ true; false ])
       true false;
-    mk_fun
-      [ "alloc"; "boxed"; "Box"; "deref_mut" ]
-      None
+    mk_fun "alloc::boxed::{Box<@T>}::deref_mut" None
       (Some [ true; false ])
       true false;
-    (* TODO: fix the same like "[T]" below *)
-    mk_fun
-      [ "core"; "slice"; "index"; "[T]"; "index" ]
-      (Some [ "core"; "slice"; "index"; "Slice"; "index" ])
-      None true false;
-    mk_fun
-      [ "core"; "slice"; "index"; "[T]"; "index_mut" ]
-      (Some [ "core"; "slice"; "index"; "Slice"; "index_mut" ])
-      None true false;
-    mk_fun
-      [ "core"; "array"; "[T; N]"; "index" ]
-      (Some [ "core"; "array"; "Array"; "index" ])
-      None true false;
-    mk_fun
-      [ "core"; "array"; "[T; N]"; "index_mut" ]
-      (Some [ "core"; "array"; "Array"; "index_mut" ])
-      None true false;
-    mk_fun [ "core"; "slice"; "index"; "Range"; "get" ] None None true false;
-    mk_fun [ "core"; "slice"; "index"; "Range"; "get_mut" ] None None true false;
-    mk_fun [ "core"; "slice"; "index"; "Range"; "index" ] None None true false;
-    mk_fun
-      [ "core"; "slice"; "index"; "Range"; "index_mut" ]
-      None None true false;
-    mk_fun
-      [ "core"; "slice"; "index"; "Range"; "get_unchecked" ]
-      None None false false;
-    mk_fun
-      [ "core"; "slice"; "index"; "Range"; "get_unchecked_mut" ]
-      None None false false;
-    mk_fun
-      [ "core"; "slice"; "index"; "usize"; "get" ]
-      (Some [ "core"; "slice"; "index"; "Usize"; "get" ])
-      None true false;
-    mk_fun
-      [ "core"; "slice"; "index"; "usize"; "get_mut" ]
-      (Some [ "core"; "slice"; "index"; "Usize"; "get_mut" ])
-      None true false;
-    mk_fun
-      [ "core"; "slice"; "index"; "usize"; "get_unchecked" ]
-      (Some [ "core"; "slice"; "index"; "Usize"; "get_unchecked" ])
-      None false false;
-    mk_fun
-      [ "core"; "slice"; "index"; "usize"; "get_unchecked_mut" ]
-      (Some [ "core"; "slice"; "index"; "Usize"; "get_unchecked_mut" ])
-      None false false;
-    mk_fun
-      [ "core"; "slice"; "index"; "usize"; "index" ]
-      (Some [ "core"; "slice"; "index"; "Usize"; "index" ])
-      None true false;
-    mk_fun
-      [ "core"; "slice"; "index"; "usize"; "index_mut" ]
-      (Some [ "core"; "slice"; "index"; "Usize"; "index_mut" ])
-      None true false;
+    mk_fun "core::slice::index::{[@T]}::index" None None true false;
+    mk_fun "core::slice::index::{[@T]}::index_mut" None None true false;
+    mk_fun "core::array::{[@T; @C]}::index" None None true false;
+    mk_fun "core::array::{[@T; @C]}::index_mut" None None true false;
+    mk_fun "core::slice::index::{Range<@T>}::get" None None true false;
+    mk_fun "core::slice::index::{Range<@T>}::get_mut" None None true false;
+    mk_fun "core::slice::index::{Range<@T>}::index" None None true false;
+    mk_fun "core::slice::index::{Range<@T>}::index_mut" None None true false;
+    mk_fun "core::slice::index::{Range<@T>}::get_unchecked" None None false
+      false;
+    mk_fun "core::slice::index::{Range<@T>}::get_unchecked_mut" None None false
+      false;
+    mk_fun "core::slice::index::{usize}::get" None None true false;
+    mk_fun "core::slice::index::{usize}::get_mut" None None true false;
+    mk_fun "core::slice::index::{usize}::get_unchecked" None None false false;
+    mk_fun "core::slice::index::{usize}::get_unchecked_mut" None None false
+      false;
+    mk_fun "core::slice::index::{usize}::index" None None true false;
+    mk_fun "core::slice::index::{usize}::index_mut" None None true false;
   ]
 
 let mk_builtin_funs_map () =
-  SimpleNameMap.of_list
+  NameMatcherMap.of_list
     (List.map
        (fun (name, filter, info) -> (name, (filter, info)))
        (builtin_funs ()))
@@ -385,17 +317,22 @@ let builtin_fun_effects =
   let int_funs =
     List.map
       (fun int_name ->
-        List.map (fun op -> "core::num::" ^ int_name ^ "::" ^ op) int_ops)
+        List.map
+          (fun op ->
+            "core::num::" ^ "{"
+            ^ StringUtils.capitalize_first_letter int_name
+            ^ "}::" ^ op)
+          int_ops)
       int_names
   in
   let int_funs = List.concat int_funs in
   let no_fail_no_state_funs =
     [
       (* TODO: redundancy with the funs information below *)
-      "alloc::vec::Vec::new";
-      "alloc::vec::Vec::len";
-      "alloc::boxed::Box::deref";
-      "alloc::boxed::Box::deref_mut";
+      "alloc::vec::{alloc::vec::Vec<@T>}::new";
+      "alloc::vec::{alloc::vec::Vec<@T>}::len";
+      "alloc::boxed::{Box<@T>}::deref";
+      "alloc::boxed::{Box<@T>}::deref_mut";
       "core::mem::replace";
       "core::mem::take";
     ]
@@ -409,10 +346,10 @@ let builtin_fun_effects =
   let no_state_funs =
     [
       (* TODO: redundancy with the funs information below *)
-      "alloc::vec::Vec::push";
-      "alloc::vec::Vec::index";
-      "alloc::vec::Vec::index_mut";
-      "alloc::vec::Vec::index_mut_back";
+      "alloc::vec::{alloc::vec::Vec<@T>}::push";
+      "alloc::vec::{alloc::vec::Vec<@T>}::index";
+      "alloc::vec::{alloc::vec::Vec<@T>}::index_mut";
+      "alloc::vec::{alloc::vec::Vec<@T>}::index_mut_back";
     ]
   in
   let no_state_funs =
@@ -421,11 +358,11 @@ let builtin_fun_effects =
   no_fail_no_state_funs @ no_state_funs
 
 let builtin_fun_effects_map =
-  SimpleNameMap.of_list
-    (List.map (fun (n, x) -> (string_to_simple_name n, x)) builtin_fun_effects)
+  NameMatcherMap.of_list
+    (List.map (fun (n, x) -> (parse_pattern n, x)) builtin_fun_effects)
 
 type builtin_trait_decl_info = {
-  rust_name : string;
+  rust_name : pattern;
   extract_name : string;
   constructor : string;
   parent_clauses : string list;
@@ -441,13 +378,15 @@ type builtin_trait_decl_info = {
 
 let builtin_trait_decls_info () =
   let rg0 = Some Types.RegionGroupId.zero in
-  let mk_trait (rust_name : string list) ?(extract_name : string option = None)
+  let mk_trait (rust_name : string) ?(extract_name : string option = None)
       ?(parent_clauses : string list = []) ?(types : string list = [])
       ?(methods : (string * bool) list = []) () : builtin_trait_decl_info =
+    let rust_name = parse_pattern rust_name in
     let extract_name =
       match extract_name with
       | Some n -> n
       | None -> (
+          let rust_name = pattern_to_fun_extract_name rust_name in
           match !backend with
           | Coq | FStar | HOL4 -> String.concat "_" rust_name
           | Lean -> String.concat "." rust_name)
@@ -487,7 +426,6 @@ let builtin_trait_decls_info () =
       in
       List.map mk_method methods
     in
-    let rust_name = String.concat "::" rust_name in
     {
       rust_name;
       extract_name;
@@ -500,34 +438,27 @@ let builtin_trait_decls_info () =
   in
   [
     (* Deref *)
-    mk_trait
-      [ "core"; "ops"; "deref"; "Deref" ]
-      ~types:[ "Target" ]
+    mk_trait "core::ops::deref::Deref" ~types:[ "Target" ]
       ~methods:[ ("deref", true) ]
       ();
     (* DerefMut *)
-    mk_trait
-      [ "core"; "ops"; "deref"; "DerefMut" ]
+    mk_trait "core::ops::deref::DerefMut"
       ~parent_clauses:[ backend_choice "deref_inst" "derefInst" ]
       ~methods:[ ("deref_mut", true) ]
       ();
     (* Index *)
-    mk_trait
-      [ "core"; "ops"; "index"; "Index" ]
-      ~types:[ "Output" ]
+    mk_trait "core::ops::index::Index" ~types:[ "Output" ]
       ~methods:[ ("index", true) ]
       ();
     (* IndexMut *)
-    mk_trait
-      [ "core"; "ops"; "index"; "IndexMut" ]
+    mk_trait "core::ops::index::IndexMut"
       ~parent_clauses:[ backend_choice "index_inst" "indexInst" ]
       ~methods:[ ("index_mut", true) ]
       ();
     (* Sealed *)
-    mk_trait [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ] ();
+    mk_trait "core::slice::index::private_slice_index::Sealed" ();
     (* SliceIndex *)
-    mk_trait
-      [ "core"; "slice"; "index"; "SliceIndex" ]
+    mk_trait "core::slice::index::SliceIndex"
       ~parent_clauses:[ backend_choice "sealed_inst" "sealedInst" ]
       ~types:[ "Output" ]
       ~methods:
@@ -543,113 +474,56 @@ let builtin_trait_decls_info () =
   ]
 
 let mk_builtin_trait_decls_map () =
-  SimpleNameMap.of_list
+  NameMatcherMap.of_list
     (List.map
-       (fun info -> (string_to_simple_name info.rust_name, info))
+       (fun info -> (info.rust_name, info))
        (builtin_trait_decls_info ()))
 
 let builtin_trait_decls_map = mk_memoized mk_builtin_trait_decls_map
 
-(* TODO: generalize this.
-
-   For now, the key is:
-   - name of the impl (ex.: "alloc.boxed.Boxed")
-   - name of the implemented trait (ex.: "core.ops.deref.Deref"
-*)
-type simple_name_pair = simple_name * simple_name [@@deriving show, ord]
-
-module SimpleNamePairOrd = struct
-  type t = simple_name_pair
-
-  let compare = compare_simple_name_pair
-  let to_string = show_simple_name_pair
-  let pp_t = pp_simple_name_pair
-  let show_t = show_simple_name_pair
-end
-
-module SimpleNamePairMap = Collections.MakeMap (SimpleNamePairOrd)
-
-let builtin_trait_impls_info () :
-    ((string list * string list) * (bool list option * string)) list =
-  let fmt (type_name : string list)
-      ?(extract_type_name : string list option = None)
-      (trait_name : string list) ?(filter : bool list option = None) () :
-      (string list * string list) * (bool list option * string) =
+let builtin_trait_impls_info () : (pattern * (bool list option * string)) list =
+  let fmt (rust_name : string) ?(filter : bool list option = None) () :
+      pattern * (bool list option * string) =
+    let rust_name = parse_pattern rust_name in
     let name =
-      let trait_name = String.concat "" trait_name ^ "Inst" in
+      let name = pattern_to_trait_impl_extract_name rust_name in
       let sep = backend_choice "_" "." in
-      let type_name =
-        match extract_type_name with
-        | Some type_name -> type_name
-        | None -> type_name
-      in
-      String.concat sep type_name ^ sep ^ trait_name
+      String.concat sep name
     in
-    ((type_name, trait_name), (filter, name))
+    (rust_name, (filter, name))
   in
-  (* TODO: fix the names like "[T]" below *)
   [
     (* core::ops::Deref<alloc::boxed::Box<T>> *)
-    fmt [ "alloc"; "boxed"; "Box" ] [ "core"; "ops"; "deref"; "Deref" ] ();
-    (* core::ops::DerefMut<alloc::boxed::Box<T>> *)
-    fmt [ "alloc"; "boxed"; "Box" ] [ "core"; "ops"; "deref"; "DerefMut" ] ();
+    fmt "core::ops::Deref<Box<@T>>" ();
+    (* core::ops::Deref<alloc::boxed::Box<T>> *)
+    fmt "core::ops::Deref<Box<@T>>" ();
     (* core::ops::index::Index<[T], I> *)
-    fmt
-      [ "core"; "slice"; "index"; "[T]" ]
-      ~extract_type_name:(Some [ "core"; "slice"; "index"; "Slice" ])
-      [ "core"; "ops"; "index"; "Index" ]
-      ();
+    fmt "core::ops::index::Index<[@T], @I>" ();
     (* core::ops::index::IndexMut<[T], I> *)
-    fmt
-      [ "core"; "slice"; "index"; "[T]" ]
-      ~extract_type_name:(Some [ "core"; "slice"; "index"; "Slice" ])
-      [ "core"; "ops"; "index"; "IndexMut" ]
-      ();
+    fmt "core::ops::index::IndexMut<[@T], @I>" ();
     (* core::slice::index::private_slice_index::Sealed<Range<usize>> *)
-    fmt
-      [ "core"; "slice"; "index"; "private_slice_index"; "Range" ]
-      [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ]
-      ();
+    fmt "core::slice::index::private_slice_index::Sealed<Range<usize>>" ();
     (* core::slice::index::SliceIndex<Range<usize>, [T]> *)
-    fmt
-      [ "core"; "slice"; "index"; "Range" ]
-      [ "core"; "slice"; "index"; "SliceIndex" ]
-      ();
+    fmt "core::slice::index::SliceIndex<Range<usize>, [@T]>" ();
     (* core::ops::index::Index<[T; N], I> *)
-    fmt
-      [ "core"; "array"; "[T; N]" ]
-      ~extract_type_name:(Some [ "core"; "array"; "Array" ])
-      [ "core"; "ops"; "index"; "Index" ]
-      ();
+    fmt "core::ops::index::Index<[@T; @N], @I>" ();
     (* core::ops::index::IndexMut<[T; N], I> *)
-    fmt
-      [ "core"; "array"; "[T; N]" ]
-      ~extract_type_name:(Some [ "core"; "array"; "Array" ])
-      [ "core"; "ops"; "index"; "IndexMut" ]
-      ();
+    fmt "core::ops::index::IndexMut<[@T; @N], @I>" ();
     (* core::slice::index::private_slice_index::Sealed<usize> *)
-    fmt
-      [ "core"; "slice"; "index"; "private_slice_index"; "usize" ]
-      [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ]
-      ();
+    fmt "core::slice::index::private_slice_index::Sealed<usize>" ();
     (* core::slice::index::SliceIndex<usize, [T]> *)
-    fmt
-      [ "core"; "slice"; "index"; "usize" ]
-      [ "core"; "slice"; "index"; "SliceIndex" ]
-      ();
-    (* core::ops::index::Index<Vec<T>, T> *)
-    fmt [ "alloc"; "vec"; "Vec" ]
-      [ "core"; "ops"; "index"; "Index" ]
+    fmt "core::slice::index::SliceIndex<usize, [@T]>" ();
+    (* core::ops::index::Index<alloc::vec::Vec<T>, T> *)
+    fmt "core::ops::index::Index<alloc::vec::Vec<@T>, @T>"
       ~filter:(Some [ true; true; false ])
       ();
-    (* core::ops::index::IndexMut<Vec<T>, T> *)
-    fmt [ "alloc"; "vec"; "Vec" ]
-      [ "core"; "ops"; "index"; "IndexMut" ]
+    (* core::ops::index::IndexMut<alloc::vec::Vec<T>, T> *)
+    fmt "core::ops::index::IndexMut<alloc::vec::Vec<@T>, @T>"
       ~filter:(Some [ true; true; false ])
       ();
   ]
 
 let mk_builtin_trait_impls_map () =
-  SimpleNamePairMap.of_list (builtin_trait_impls_info ())
+  NameMatcherMap.of_list (builtin_trait_impls_info ())
 
 let builtin_trait_impls_map = mk_memoized mk_builtin_trait_impls_map
diff --git a/compiler/ExtractName.ml b/compiler/ExtractName.ml
new file mode 100644
index 00000000..4f5ca0d1
--- /dev/null
+++ b/compiler/ExtractName.ml
@@ -0,0 +1,177 @@
+(** Utilities for extracting names *)
+
+open Charon.NameMatcher
+
+module NameMatcherMap = struct
+  type 'a t = (pattern * 'a) list
+
+  let config = { map_vars_to_vars = true }
+
+  let find_opt (ctx : ctx) (name : Types.name) (m : 'a t) : 'a option =
+    match List.find_opt (fun (pat, _) -> match_name ctx config pat name) m with
+    | None -> None
+    | Some (_, v) -> Some v
+
+  let find_with_generics_opt (ctx : ctx) (name : Types.name)
+      (g : Types.generic_args) (m : 'a t) : 'a option =
+    match
+      List.find_opt
+        (fun (pat, _) -> match_name_with_generics ctx config pat name g)
+        m
+    with
+    | None -> None
+    | Some (_, v) -> Some v
+
+  let mem (ctx : ctx) (name : Types.name) (m : 'a t) : bool =
+    find_opt ctx name m <> None
+
+  let of_list (ls : (pattern * 'a) list) : 'a t = ls
+end
+
+(** Helper to convert name patterns to names for extraction.
+
+    For impl blocks, we simply use the name of the type (without its arguments)
+    if all the arguments are variables.
+ *)
+let pattern_to_extract_name (is_trait_impl : bool) (name : pattern) :
+    string list =
+  let c = { tgt_kind = TkName } in
+  let is_var (g : generic_arg) : bool =
+    match g with
+    | GExpr (EVar _) -> true
+    | GRegion (RVar _) -> true
+    | _ -> false
+  in
+  let all_vars = List.for_all is_var in
+  let elem_to_string (e : pattern_elem) : string =
+    match e with
+    | PIdent _ -> pattern_elem_to_string c e
+    | PImpl ty -> (
+        match ty with
+        | EComp id -> (
+            (* Retrieve the last ident *)
+            let id = Collections.List.last id in
+            match id with
+            | PIdent (s, g) ->
+                if all_vars g then s else pattern_elem_to_string c id
+            | PImpl _ -> raise (Failure "Unreachable"))
+        | EPrimAdt (adt, g) ->
+            if all_vars g then
+              match adt with
+              | TTuple ->
+                  let l = List.length g in
+                  if l = 2 then "Pair" else expr_to_string c ty
+              | TArray -> "Array"
+              | TSlice -> "Slice"
+            else expr_to_string c ty
+        | ERef _ | EVar _ -> raise (Failure ""))
+  in
+  let rec pattern_to_string (n : pattern) : string list =
+    match n with
+    | [] -> raise (Failure "Unreachable")
+    | [ e ] ->
+        let e = elem_to_string e in
+        if is_trait_impl then [ e ^ "Inst" ] else [ e ]
+    | e :: n -> elem_to_string e :: pattern_to_string n
+  in
+  pattern_to_string name
+
+let pattern_to_fun_extract_name = pattern_to_extract_name false
+let pattern_to_trait_impl_extract_name = pattern_to_extract_name true
+
+(* TODO: this is provisional. We just want to make sure that the extraction
+   names we derive from the patterns (for the builtin definitions) are
+   consistent with the extraction names we derive from the Rust names *)
+let name_to_simple_name (ctx : ctx) (n : Types.name) : string list =
+  pattern_to_extract_name false (name_to_pattern ctx n)
+
+let name_with_generics_to_simple_name (ctx : ctx) (n : Types.name)
+    (p : Types.generic_params) (g : Types.generic_args) : string list =
+  pattern_to_extract_name true (name_with_generics_to_pattern ctx n p g)
+
+(*
+  (* Prepare a name.
+     The first id elem is always the crate: if it is the local crate,
+     we remove it. We ignore disambiguators (there may be collisions, but we
+     check if there are).
+  *)
+  let rec name_to_simple_name (name : llbc_name) : string list =
+    (* Rmk.: initially we only filtered the disambiguators equal to 0 *)
+    match name with
+    | (PeIdent (crate, _) as id) :: name ->
+        let name = if crate = crate_name then name else id :: name in
+        let open Types in
+        let name =
+          List.map
+            (function
+              | PeIdent (s, _) -> s
+              | PeImpl impl -> impl_elem_to_simple_name impl)
+            name
+        in
+        name
+    | _ ->
+        raise
+          (Failure
+             ("Unexpected name shape: " ^ TranslateCore.name_to_string ctx name))
+  and impl_elem_to_simple_name (impl : Types.impl_elem) : string =
+    (* We do something simple for now.
+       TODO: we might want to do something different for impl elements which are
+       actually trait implementations, in order to prevent name collisions (it
+       is possible to define several times the same trait for the same type,
+       but with different instantiations of the type, or different trait
+       requirements *)
+    ty_to_simple_name impl.generics impl.ty
+  and ty_to_simple_name (generics : Types.generic_params) (ty : Types.ty) :
+      string =
+    (* We do something simple for now.
+       TODO: find a more principled way of converting types to names.
+       In particular, we might want to do something different for impl elements which are
+       actually trait implementations, in order to prevent name collisions (it
+       is possible to define several times the same trait for the same type,
+       but with different instantiations of the type, or different trait
+       requirements *)
+    match ty with
+    | TAdt (id, args) -> (
+        match id with
+        | TAdtId id ->
+            let def = TypeDeclId.Map.find id ctx.type_ctx.type_decls in
+            name_last_elem_as_ident def.name
+        | TTuple ->
+            (* TODO *)
+            "Tuple"
+            ^ String.concat ""
+                (List.map (ty_to_simple_name generics) args.types)
+        | TAssumed id -> (
+            match id with
+            | Types.TBox -> "Box"
+            | Types.TArray -> "Array"
+            | Types.TSlice -> "Slice"
+            | Types.TStr -> "Str"))
+    | TVar vid ->
+        (* Use the variable name *)
+        (List.find (fun (v : type_var) -> v.index = vid) generics.types).name
+    | TLiteral lty ->
+        StringUtils.capitalize_first_letter
+          (Print.Types.literal_type_to_string lty)
+    | TNever -> raise (Failure "Unreachable")
+    | TRef (_, rty, rk) -> (
+        let rty = ty_to_simple_name generics rty in
+        match rk with
+        | RMut -> "MutBorrow" ^ rty
+        | RShared -> "SharedBorrow" ^ rty)
+    | TRawPtr (rty, rk) -> (
+        let rty = ty_to_simple_name generics rty in
+        match rk with RMut -> "MutPtr" ^ rty | RShared -> "ConstPtr" ^ rty)
+    | TTraitType (tr, _, name) ->
+        (* TODO: this is way too simple *)
+        let trait_decl =
+          TraitDeclId.Map.find tr.trait_decl_ref.trait_decl_id
+            ctx.trait_decls_ctx.trait_decls
+        in
+        name_last_elem_as_ident trait_decl.name ^ name
+    | TArrow (inputs, output) ->
+        "Arrow"
+        ^ String.concat ""
+            (List.map (ty_to_simple_name generics) (inputs @ [ output ]))
+  in
+*)
diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml
index de4ec735..a74bd532 100644
--- a/compiler/ExtractTypes.ml
+++ b/compiler/ExtractTypes.ml
@@ -586,84 +586,16 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
      we remove it. We ignore disambiguators (there may be collisions, but we
      check if there are).
   *)
-  let rec name_to_simple_name (name : llbc_name) : string list =
+  let name_to_simple_name (name : llbc_name) : string list =
     (* Rmk.: initially we only filtered the disambiguators equal to 0 *)
     match name with
     | (PeIdent (crate, _) as id) :: name ->
         let name = if crate = crate_name then name else id :: name in
-        let open Types in
-        let name =
-          List.map
-            (function
-              | PeIdent (s, _) -> s
-              | PeImpl impl -> impl_elem_to_simple_name impl)
-            name
-        in
-        name
+        name_to_simple_name ctx name
     | _ ->
         raise
           (Failure
              ("Unexpected name shape: " ^ TranslateCore.name_to_string ctx name))
-  and impl_elem_to_simple_name (impl : Types.impl_elem) : string =
-    (* We do something simple for now.
-       TODO: we might want to do something different for impl elements which are
-       actually trait implementations, in order to prevent name collisions (it
-       is possible to define several times the same trait for the same type,
-       but with different instantiations of the type, or different trait
-       requirements *)
-    ty_to_simple_name impl.generics impl.ty
-  and ty_to_simple_name (generics : Types.generic_params) (ty : Types.ty) :
-      string =
-    (* We do something simple for now.
-       TODO: find a more principled way of converting types to names.
-       In particular, we might want to do something different for impl elements which are
-       actually trait implementations, in order to prevent name collisions (it
-       is possible to define several times the same trait for the same type,
-       but with different instantiations of the type, or different trait
-       requirements *)
-    match ty with
-    | TAdt (id, args) -> (
-        match id with
-        | TAdtId id ->
-            let def = TypeDeclId.Map.find id ctx.type_ctx.type_decls in
-            name_last_elem_as_ident def.name
-        | TTuple ->
-            (* TODO *)
-            "Tuple"
-            ^ String.concat ""
-                (List.map (ty_to_simple_name generics) args.types)
-        | TAssumed id -> (
-            match id with
-            | Types.TBox -> "Box"
-            | Types.TArray -> "Array"
-            | Types.TSlice -> "Slice"
-            | Types.TStr -> "Str"))
-    | TVar vid ->
-        (* Use the variable name *)
-        (List.find (fun (v : type_var) -> v.index = vid) generics.types).name
-    | TLiteral lty ->
-        StringUtils.capitalize_first_letter
-          (Print.Types.literal_type_to_string lty)
-    | TNever -> raise (Failure "Unreachable")
-    | TRef (_, rty, rk) -> (
-        let rty = ty_to_simple_name generics rty in
-        match rk with
-        | RMut -> "MutBorrow" ^ rty
-        | RShared -> "SharedBorrow" ^ rty)
-    | TRawPtr (rty, rk) -> (
-        let rty = ty_to_simple_name generics rty in
-        match rk with RMut -> "MutPtr" ^ rty | RShared -> "ConstPtr" ^ rty)
-    | TTraitType (tr, _, name) ->
-        (* TODO: this is way too simple *)
-        let trait_decl =
-          TraitDeclId.Map.find tr.trait_decl_ref.trait_decl_id
-            ctx.trait_decls_ctx.trait_decls
-        in
-        name_last_elem_as_ident trait_decl.name ^ name
-    | TArrow (inputs, output) ->
-        "Arrow"
-        ^ String.concat ""
-            (List.map (ty_to_simple_name generics) (inputs @ [ output ]))
   in
   let flatten_name (name : string list) : string =
     match !backend with
@@ -747,17 +679,22 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string)
 
   let trait_impl_name (trait_decl : trait_decl) (trait_impl : trait_impl) :
       string =
-    (* TODO: provisional: we concatenate the trait impl name (which is its type)
-       with the trait decl name *)
-    let trait_decl =
-      let name = trait_decl.llbc_name in
-      let name = get_type_name_no_suffix name ^ "Inst" in
-      (* Remove the occurrences of '.' *)
-      String.concat "" (String.split_on_char '.' name)
-    in
+    (* We derive the trait impl name from the implemented trait.
+       For instance, if this implementation is an instance of `trait::Trait`
+       for `<foo::Foo, u32>`, we generate the name: "trait.TraitFooFooU32Inst".
+       Importantly, it is to be noted that the name is independent of the place
+       where the instance has been defined (it is indepedent of the file, etc.).
+    *)
     let name =
-      flatten_name (get_type_name trait_impl.llbc_name @ [ trait_decl ])
+      (* We need to lookup the LLBC definitions, to have the original instantiation *)
+      let trait_impl =
+        TraitImplId.Map.find trait_impl.def_id ctx.trait_impls_ctx.trait_impls
+      in
+      let params = trait_impl.generics in
+      let args = trait_impl.impl_trait.decl_generics in
+      name_with_generics_to_simple_name ctx trait_decl.llbc_name params args
     in
+    let name = flatten_name name in
     match !backend with
     | FStar -> StringUtils.lowercase_first_letter name
     | Coq | HOL4 | Lean -> name
@@ -1185,11 +1122,11 @@ let extract_arrow (fmt : F.formatter) () : unit =
 let extract_const_generic (ctx : extraction_ctx) (fmt : F.formatter)
     (inside : bool) (cg : const_generic) : unit =
   match cg with
-  | CGGlobal id ->
+  | CgGlobal id ->
       let s = ctx_get_global id ctx in
       F.pp_print_string fmt s
-  | CGValue v -> ctx.fmt.extract_literal fmt inside v
-  | CGVar id ->
+  | CgValue v -> ctx.fmt.extract_literal fmt inside v
+  | CgVar id ->
       let s = ctx_get_const_generic_var id ctx in
       F.pp_print_string fmt s
 
@@ -1492,8 +1429,9 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
     extraction_ctx =
   (* Lookup the builtin information, if there is *)
   let open ExtractBuiltin in
-  let sname = name_to_simple_name def.llbc_name in
-  let info = SimpleNameMap.find_opt sname (builtin_types_map ()) in
+  let info =
+    match_name_find_opt ctx.trans_ctx def.llbc_name (builtin_types_map ())
+  in
   (* Register the filtering information, if there is *)
   let ctx =
     match info with
diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml
index a07ad35a..9ae6ce86 100644
--- a/compiler/FunsAnalysis.ml
+++ b/compiler/FunsAnalysis.ml
@@ -58,6 +58,13 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
     let can_diverge = ref false in
     let is_rec = ref false in
     let group_has_builtin_info = ref false in
+    let name_matcher_ctx : Charon.NameMatcher.ctx =
+      {
+        type_decls = m.type_decls;
+        global_decls = m.global_decls;
+        trait_decls = m.trait_decls;
+      }
+    in
 
     (* We have some specialized knowledge of some library functions; we don't
        have any more custom treatment than this, and these functions can be modeled
@@ -65,8 +72,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t)
        way. *)
     let get_builtin_info (f : fun_decl) : ExtractBuiltin.effect_info option =
       let open ExtractBuiltin in
-      let name = name_to_simple_name f.name in
-      SimpleNameMap.find_opt name builtin_fun_effects_map
+      NameMatcherMap.find_opt name_matcher_ctx f.name builtin_fun_effects_map
     in
 
     (* JP: Why not use a reduce visitor here with a tuple of the values to be
diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml
index 5b2db90d..c2e47da9 100644
--- a/compiler/Interpreter.ml
+++ b/compiler/Interpreter.ml
@@ -80,7 +80,7 @@ let symbolic_instantiate_fun_sig (ctx : eval_ctx) (sg : fun_sig)
     let regions = List.map (fun _ -> RErased) regions in
     let types = List.map (fun (v : type_var) -> TVar v.index) types in
     let const_generics =
-      List.map (fun (v : const_generic_var) -> CGVar v.index) const_generics
+      List.map (fun (v : const_generic_var) -> CgVar v.index) const_generics
     in
     (* Annoying that we have to generate this substitution here *)
     let r_subst _ = raise (Failure "Unexpected region") in
diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml
index 1e28fd4b..38620be0 100644
--- a/compiler/InterpreterExpressions.ml
+++ b/compiler/InterpreterExpressions.ml
@@ -321,7 +321,7 @@ let eval_operand_no_reorganize (config : config) (op : operand)
                    ( ctx0,
                      None,
                      value_as_symbolic v.value,
-                     SymbolicAst.VaCGValue vid,
+                     SymbolicAst.VaCgValue vid,
                      e )))
       | CFnPtr _ -> raise (Failure "TODO"))
   | Copy p ->
diff --git a/compiler/LlbcAstUtils.ml b/compiler/LlbcAstUtils.ml
index 01216157..ffdce481 100644
--- a/compiler/LlbcAstUtils.ml
+++ b/compiler/LlbcAstUtils.ml
@@ -31,21 +31,26 @@ let lookup_fun_sig (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) :
 let crate_get_opaque_non_builtin_decls (k : crate) (filter_assumed : bool) :
     type_decl list * fun_decl list =
   let open ExtractBuiltin in
+  let ctx : Charon.NameMatcher.ctx =
+    {
+      type_decls = k.type_decls;
+      global_decls = k.global_decls;
+      trait_decls = k.trait_decls;
+    }
+  in
   let is_opaque_fun (d : fun_decl) : bool =
-    let sname = name_to_simple_name d.name in
     d.body = None
     (* Something to pay attention to: we must ignore trait method *declarations*
        (which don't have a body but must not be considered as opaque) *)
     && (match d.kind with TraitMethodDecl _ -> false | _ -> true)
     && ((not filter_assumed)
-       || (not (SimpleNameMap.mem sname builtin_globals_map))
-          && not (SimpleNameMap.mem sname (builtin_funs_map ())))
+       || (not (NameMatcherMap.mem ctx d.name builtin_globals_map))
+          && not (NameMatcherMap.mem ctx d.name (builtin_funs_map ())))
   in
   let is_opaque_type (d : type_decl) : bool =
-    let sname = name_to_simple_name d.name in
     d.kind = Opaque
     && ((not filter_assumed)
-       || not (SimpleNameMap.mem sname (builtin_types_map ())))
+       || not (NameMatcherMap.mem ctx d.name (builtin_types_map ())))
   in
   (* Note that by checking the function bodies we also the globals *)
   ( List.filter is_opaque_type (TypeDeclId.Map.values k.type_decls),
diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml
index e6686951..a7ec9336 100644
--- a/compiler/PrintPure.ml
+++ b/compiler/PrintPure.ml
@@ -128,9 +128,9 @@ let type_id_to_string (env : fmt_env) (id : type_id) : string =
 (* TODO: duplicates  Charon.PrintTypes.const_generic_to_string *)
 let const_generic_to_string (env : fmt_env) (cg : const_generic) : string =
   match cg with
-  | CGGlobal id -> global_decl_id_to_string env id
-  | CGVar id -> const_generic_var_id_to_string env id
-  | CGValue lit -> literal_to_string lit
+  | CgGlobal id -> global_decl_id_to_string env id
+  | CgVar id -> const_generic_var_id_to_string env id
+  | CgValue lit -> literal_to_string lit
 
 let rec ty_to_string (env : fmt_env) (inside : bool) (ty : ty) : string =
   match ty with
diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml
index 5f92d18a..06270621 100644
--- a/compiler/PureUtils.ml
+++ b/compiler/PureUtils.ml
@@ -111,7 +111,7 @@ let ty_substitute (subst : subst) (ty : ty) : ty =
     object
       inherit [_] map_ty
       method! visit_TVar _ var_id = subst.ty_subst var_id
-      method! visit_CGVar _ var_id = subst.cg_subst var_id
+      method! visit_CgVar _ var_id = subst.cg_subst var_id
       method! visit_Clause _ id = subst.tr_subst id
       method! visit_Self _ = subst.tr_self
     end
diff --git a/compiler/StringUtils.ml b/compiler/StringUtils.ml
index 161df27b..3ab4e808 100644
--- a/compiler/StringUtils.ml
+++ b/compiler/StringUtils.ml
@@ -1,111 +1 @@
-(** Utilities to work on strings, character per character.
-
-    They operate on ASCII strings, and are used by the project to convert
-    Rust names: Rust names are not fancy, so it shouldn't be a problem.
-    
-    Rk.: the poor support of OCaml for char manipulation is really annoying...
- *)
-
-let code_0 = 48
-let code_9 = 57
-let code_A = 65
-let code_Z = 90
-let code_a = 97
-let code_z = 122
-
-let is_lowercase_ascii (c : char) : bool =
-  let c = Char.code c in
-  code_a <= c && c <= code_z
-
-let is_uppercase_ascii (c : char) : bool =
-  let c = Char.code c in
-  code_A <= c && c <= code_Z
-
-let is_letter_ascii (c : char) : bool =
-  is_lowercase_ascii c || is_uppercase_ascii c
-
-let is_digit_ascii (c : char) : bool =
-  let c = Char.code c in
-  code_0 <= c && c <= code_9
-
-let lowercase_ascii = Char.lowercase_ascii
-let uppercase_ascii = Char.uppercase_ascii
-
-(** Using buffers as per:
-    {{: https://stackoverflow.com/questions/29957418/how-to-convert-char-list-to-string-in-ocaml} stackoverflow}
- *)
-let string_of_chars (chars : char list) : string =
-  let buf = Buffer.create (List.length chars) in
-  List.iter (Buffer.add_char buf) chars;
-  Buffer.contents buf
-
-let string_to_chars (s : string) : char list =
-  let length = String.length s in
-  let rec apply i =
-    if i = length then [] else String.get s i :: apply (i + 1)
-  in
-  apply 0
-
-(** This operates on ASCII *)
-let to_camel_case (s : string) : string =
-  (* Note that we rebuild the string in reverse order *)
-  let apply ((prev_is_under, acc) : bool * char list) (c : char) :
-      bool * char list =
-    if c = '_' then (true, acc)
-    else
-      let c = if prev_is_under then uppercase_ascii c else c in
-      (false, c :: acc)
-  in
-  let _, chars = List.fold_left apply (true, []) (string_to_chars s) in
-  string_of_chars (List.rev chars)
-
-(** This operates on ASCII *)
-let to_snake_case (s : string) : string =
-  (* Note that we rebuild the string in reverse order *)
-  let apply ((prev_is_low, prev_is_digit, acc) : bool * bool * char list)
-      (c : char) : bool * bool * char list =
-    let acc =
-      if c = '_' then acc
-      else if prev_is_digit then if is_letter_ascii c then '_' :: acc else acc
-      else if prev_is_low then
-        if (is_lowercase_ascii c || is_digit_ascii c) && c <> '_' then acc
-        else '_' :: acc
-      else acc
-    in
-    let prev_is_low = is_lowercase_ascii c in
-    let prev_is_digit = is_digit_ascii c in
-    let c = lowercase_ascii c in
-    (prev_is_low, prev_is_digit, c :: acc)
-  in
-  let _, _, chars =
-    List.fold_left apply (false, false, []) (string_to_chars s)
-  in
-  string_of_chars (List.rev chars)
-
-(** Applies a map operation.
-
-    This is very inefficient, but shouldn't be used much.
- *)
-let map (f : char -> string) (s : string) : string =
-  let sl = List.map f (string_to_chars s) in
-  let sl = List.map string_to_chars sl in
-  string_of_chars (List.concat sl)
-
-let capitalize_first_letter (s : string) : string =
-  let s = string_to_chars s in
-  let s = match s with [] -> s | c :: s' -> uppercase_ascii c :: s' in
-  string_of_chars s
-
-let lowercase_first_letter (s : string) : string =
-  let s = string_to_chars s in
-  let s = match s with [] -> s | c :: s' -> lowercase_ascii c :: s' in
-  string_of_chars s
-
-(** Unit tests *)
-let _ =
-  assert (to_camel_case "hello_world" = "HelloWorld");
-  assert (to_snake_case "HelloWorld36Hello" = "hello_world36_hello");
-  assert (to_snake_case "HELLO" = "hello");
-  assert (to_snake_case "T1" = "t1");
-  assert (to_camel_case "list" = "List");
-  assert (to_snake_case "is_cons" = "is_cons")
+include Charon.StringUtils
diff --git a/compiler/Substitute.ml b/compiler/Substitute.ml
index 01509dec..73e7f71d 100644
--- a/compiler/Substitute.ml
+++ b/compiler/Substitute.ml
@@ -29,7 +29,7 @@ let st_substitute_visitor (subst : subst) =
       (* We should never get here because we reimplemented [visit_TypeVar] *)
       raise (Failure "Unexpected")
 
-    method! visit_CGVar _ id = subst.cg_subst id
+    method! visit_CgVar _ id = subst.cg_subst id
 
     method! visit_const_generic_var_id _ _ =
       (* We should never get here because we reimplemented [visit_Var] *)
@@ -71,7 +71,7 @@ let erase_regions_subst : subst =
   {
     r_subst = (fun _ -> RErased);
     ty_subst = (fun vid -> TVar vid);
-    cg_subst = (fun id -> CGVar id);
+    cg_subst = (fun id -> CgVar id);
     tr_subst = (fun id -> Clause id);
     tr_self = Self;
   }
diff --git a/compiler/SymbolicAst.ml b/compiler/SymbolicAst.ml
index 7c5d28a7..c9820ba5 100644
--- a/compiler/SymbolicAst.ml
+++ b/compiler/SymbolicAst.ml
@@ -240,7 +240,7 @@ and value_aggregate =
   | VaSingleValue of typed_value  (** Regular case *)
   | VaArray of typed_value list
       (** This is used when introducing array aggregates *)
-  | VaCGValue of const_generic_var_id
+  | VaCgValue of const_generic_var_id
       (** This is used when evaluating a const generic value: in the interpreter,
           we introduce a fresh symbolic value. *)
   | VaTraitConstValue of trait_ref * generic_args * string
diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index 7dad54e1..69ff4df1 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -2475,7 +2475,7 @@ and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option)
           { struct_id = TAssumed TArray; init = None; updates = values }
         in
         { e = StructUpdate su; ty = var.ty }
-    | VaCGValue cg_id -> { e = CVar cg_id; ty = var.ty }
+    | VaCgValue cg_id -> { e = CVar cg_id; ty = var.ty }
     | VaTraitConstValue (trait_ref, generics, const_name) ->
         let type_infos = ctx.type_context.type_infos in
         let trait_ref = translate_fwd_trait_ref type_infos trait_ref in
@@ -2726,7 +2726,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression =
       let types = List.map (fun (ty : T.type_var) -> TVar ty.T.index) types in
       let const_generics =
         List.map
-          (fun (cg : T.const_generic_var) -> T.CGVar cg.T.index)
+          (fun (cg : T.const_generic_var) -> T.CgVar cg.T.index)
           const_generics
       in
       let trait_refs =
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index cf23fd44..271d19ad 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -477,8 +477,7 @@ let export_types_group (fmt : Format.formatter) (config : gen_config)
     let types_map = builtin_types_map () in
     List.map
       (fun (def : Pure.type_decl) ->
-        let sname = name_to_simple_name def.llbc_name in
-        SimpleNameMap.find_opt sname types_map <> None)
+        match_name_find_opt ctx.trans_ctx def.llbc_name types_map <> None)
       defs
   in
 
@@ -545,9 +544,9 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx)
   (* Check if it is a builtin global - if yes, we ignore it because we
      map the definition to one in the standard library *)
   let open ExtractBuiltin in
-  let sname = name_to_simple_name global.name in
   let extract =
-    extract && SimpleNameMap.find_opt sname builtin_globals_map = None
+    extract
+    && match_name_find_opt ctx.trans_ctx global.name builtin_globals_map = None
   in
   if extract then
     (* We don't wrap global declaration groups between calls to functions
@@ -661,8 +660,7 @@ let export_functions_group (fmt : Format.formatter) (config : gen_config)
     let funs_map = builtin_funs_map () in
     List.map
       (fun (trans : pure_fun_translation) ->
-        let sname = name_to_simple_name trans.fwd.f.llbc_name in
-        SimpleNameMap.find_opt sname funs_map <> None)
+        match_name_find_opt ctx.trans_ctx trans.fwd.f.llbc_name funs_map <> None)
       pure_ls
   in
 
@@ -755,8 +753,11 @@ let export_trait_decl (fmt : Format.formatter) (_config : gen_config)
   let trait_decl = TraitDeclId.Map.find trait_decl_id ctx.trans_trait_decls in
   (* Check if the trait declaration is builtin, in which case we ignore it *)
   let open ExtractBuiltin in
-  let sname = name_to_simple_name trait_decl.llbc_name in
-  if SimpleNameMap.find_opt sname (builtin_trait_decls_map ()) = None then (
+  if
+    match_name_find_opt ctx.trans_ctx trait_decl.llbc_name
+      (builtin_trait_decls_map ())
+    = None
+  then (
     let ctx = { ctx with trait_decl_id = Some trait_decl.def_id } in
     if extract_decl then Extract.extract_trait_decl ctx fmt trait_decl;
     if extract_extra_info then
@@ -775,9 +776,11 @@ let export_trait_impl (fmt : Format.formatter) (_config : gen_config)
   (* Check if the trait implementation is builtin *)
   let builtin_info =
     let open ExtractBuiltin in
-    let type_sname = name_to_simple_name trait_impl.llbc_name in
-    let trait_sname = name_to_simple_name trait_decl.llbc_name in
-    SimpleNamePairMap.find_opt (type_sname, trait_sname)
+    let trait_impl =
+      TraitImplId.Map.find trait_impl.def_id ctx.crate.trait_impls
+    in
+    match_name_with_generics_find_opt ctx.trans_ctx trait_decl.llbc_name
+      trait_impl.impl_trait.decl_generics
       (builtin_trait_impls_map ())
   in
   match builtin_info with
diff --git a/compiler/TranslateCore.ml b/compiler/TranslateCore.ml
index a974cdee..f251e169 100644
--- a/compiler/TranslateCore.ml
+++ b/compiler/TranslateCore.ml
@@ -1,6 +1,7 @@
 (** Some utilities for the translation *)
 
 open Contexts
+open ExtractName
 
 (** The local logger *)
 let log = Logging.translate_log
@@ -29,3 +30,50 @@ let trans_ctx_to_pure_fmt_env (ctx : trans_ctx) : PrintPure.fmt_env =
 
 let name_to_string (ctx : trans_ctx) =
   Print.Types.name_to_string (trans_ctx_to_fmt_env ctx)
+
+let match_name_find_opt (ctx : trans_ctx) (name : Types.name)
+    (m : 'a NameMatcherMap.t) : 'a option =
+  let open Charon.NameMatcher in
+  let open ExtractBuiltin in
+  let mctx : ctx =
+    {
+      type_decls = ctx.type_ctx.type_decls;
+      global_decls = ctx.global_ctx.global_decls;
+      trait_decls = ctx.trait_decls_ctx.trait_decls;
+    }
+  in
+  NameMatcherMap.find_opt mctx name m
+
+let match_name_with_generics_find_opt (ctx : trans_ctx) (name : Types.name)
+    (generics : Types.generic_args) (m : 'a NameMatcherMap.t) : 'a option =
+  let open Charon.NameMatcher in
+  let open ExtractBuiltin in
+  let mctx : ctx =
+    {
+      type_decls = ctx.type_ctx.type_decls;
+      global_decls = ctx.global_ctx.global_decls;
+      trait_decls = ctx.trait_decls_ctx.trait_decls;
+    }
+  in
+  NameMatcherMap.find_with_generics_opt mctx name generics m
+
+let name_to_simple_name (ctx : trans_ctx) (n : Types.name) : string list =
+  let mctx : Charon.NameMatcher.ctx =
+    {
+      type_decls = ctx.type_ctx.type_decls;
+      global_decls = ctx.global_ctx.global_decls;
+      trait_decls = ctx.trait_decls_ctx.trait_decls;
+    }
+  in
+  name_to_simple_name mctx n
+
+let name_with_generics_to_simple_name (ctx : trans_ctx) (n : Types.name)
+    (p : Types.generic_params) (g : Types.generic_args) : string list =
+  let mctx : Charon.NameMatcher.ctx =
+    {
+      type_decls = ctx.type_ctx.type_decls;
+      global_decls = ctx.global_ctx.global_decls;
+      trait_decls = ctx.trait_decls_ctx.trait_decls;
+    }
+  in
+  name_with_generics_to_simple_name mctx n p g
diff --git a/compiler/dune b/compiler/dune
index 43ce86c8..39ad6260 100644
--- a/compiler/dune
+++ b/compiler/dune
@@ -10,7 +10,7 @@
  (public_name aeneas) ;; The name as revealed to the projects importing this library
  (preprocess
   (pps ppx_deriving.show ppx_deriving.ord visitors.ppx))
- (libraries charon core_unix unionFind ocamlgraph)
+ (libraries charon core_unix unionFind ocamlgraph str)
  (modules
   AssociatedTypes
   Assumed
@@ -24,6 +24,7 @@
   Extract
   ExtractBase
   ExtractBuiltin
+  ExtractName
   ExtractTypes
   FunsAnalysis
   Identifiers
-- 
cgit v1.3.1


From b916f696c5265dc4f5af4a67b118b005a7ed8612 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 21 Nov 2023 17:24:50 +0100
Subject: Reorganize the "Extract" files

---
 compiler/Config.ml         |   27 +
 compiler/Extract.ml        |   47 +-
 compiler/ExtractBase.ml    | 1643 ++++++++++++++++++++++++++++++--------------
 compiler/ExtractBuiltin.ml |   25 +-
 compiler/ExtractTypes.ml   |  980 +++-----------------------
 compiler/Main.ml           |    5 +-
 compiler/Translate.ml      |   19 +-
 7 files changed, 1303 insertions(+), 1443 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Config.ml b/compiler/Config.ml
index a487f9e2..fe110ee4 100644
--- a/compiler/Config.ml
+++ b/compiler/Config.ml
@@ -336,3 +336,30 @@ let type_check_pure_code = ref false
 (** Shall we fail hard if we encounter an issue, or should we attempt to go
     as far as possible while leaving "holes" in the generated code? *)
 let fail_hard = ref true
+
+(** if true, add the type name as a prefix
+    to the variant names.
+    Ex.:
+    In Rust:
+      {[
+        enum List = {
+          Cons(u32, Box<List>),x
+          Nil,
+        }
+      ]}
+
+    F*, if option activated:
+      {[
+        type list =
+        | ListCons : u32 -> list -> list
+        | ListNil : list
+      ]}
+
+    F*, if option not activated:
+      {[
+        type list =
+        | Cons : u32 -> list -> list
+        | Nil : list
+      ]}
+ *)
+let variant_concatenate_type_name = ref true
diff --git a/compiler/Extract.ml b/compiler/Extract.ml
index d7b4c152..16262c91 100644
--- a/compiler/Extract.ml
+++ b/compiler/Extract.ml
@@ -6,7 +6,6 @@
 open Pure
 open PureUtils
 open TranslateCore
-open ExtractBase
 open Config
 include ExtractTypes
 
@@ -236,12 +235,10 @@ let rec extract_typed_pattern (ctx : extraction_ctx) (fmt : F.formatter)
     (is_let : bool) (inside : bool) (v : typed_pattern) : extraction_ctx =
   match v.value with
   | PatConstant cv ->
-      ctx.fmt.extract_literal fmt inside cv;
+      extract_literal fmt inside cv;
       ctx
   | PatVar (v, _) ->
-      let vname =
-        ctx.fmt.var_basename ctx.names_maps.names_map.names_set v.basename v.ty
-      in
+      let vname = ctx_compute_var_basename ctx v.basename v.ty in
       let ctx, vname = ctx_add_var vname v.id ctx in
       F.pp_print_string fmt vname;
       ctx
@@ -274,7 +271,7 @@ let rec extract_texpression (ctx : extraction_ctx) (fmt : F.formatter)
   | CVar var_id ->
       let var_name = ctx_get_const_generic_var var_id ctx in
       F.pp_print_string fmt var_name
-  | Const cv -> ctx.fmt.extract_literal fmt inside cv
+  | Const cv -> extract_literal fmt inside cv
   | App _ ->
       let app, args = destruct_apps e in
       extract_App ctx fmt inside app args
@@ -354,10 +351,10 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter)
        * Note that the way we generate the translation, we shouldn't get the
        * case where we have no argument (all functions are fully instantiated,
        * and no AST transformation introduces partial calls). *)
-      ctx.fmt.extract_unop (extract_texpression ctx fmt) fmt inside unop arg
+      extract_unop (extract_texpression ctx fmt) fmt inside unop arg
   | Binop (binop, int_ty), [ arg0; arg1 ] ->
       (* Number of arguments: similar to unop *)
-      ctx.fmt.extract_binop
+      extract_binop
         (extract_texpression ctx fmt)
         fmt inside binop int_ty arg0 arg1
   | Fun fun_id, _ ->
@@ -1359,7 +1356,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
     is_opaque_coq && def.signature.generics <> empty_generic_params
   in
   (* Print the qualifier ("assume", etc.). *)
-  let qualif = ctx.fmt.fun_decl_kind_to_qualif kind in
+  let qualif = fun_decl_kind_to_qualif kind in
   (match qualif with
   | Some qualif ->
       F.pp_print_string fmt qualif;
@@ -1655,7 +1652,7 @@ let extract_global_decl_body_gen (ctx : extraction_ctx) (fmt : F.formatter)
   (* Open "QUALIF NAME : TYPE =" box (depth=1) *)
   F.pp_open_hovbox fmt ctx.indent_incr;
   (* Print "QUALIF NAME " *)
-  (match ctx.fmt.fun_decl_kind_to_qualif kind with
+  (match fun_decl_kind_to_qualif kind with
   | Some qualif ->
       F.pp_print_string fmt qualif;
       F.pp_print_space fmt ()
@@ -1824,11 +1821,11 @@ let extract_trait_decl_register_parent_clause_names (ctx : extraction_ctx)
     | None ->
         List.map
           (fun (c : trait_clause) ->
-            let name = ctx.fmt.trait_parent_clause_name trait_decl c in
+            let name = ctx_compute_trait_parent_clause_name ctx trait_decl c in
             (* Add a prefix if necessary *)
             let name =
               if !Config.record_fields_short_names then name
-              else ctx.fmt.trait_decl_name trait_decl ^ name
+              else ctx_compute_trait_decl_name ctx trait_decl ^ name
             in
             (c.clause_id, name))
           trait_decl.parent_clauses
@@ -1855,11 +1852,11 @@ let extract_trait_decl_register_constant_names (ctx : extraction_ctx)
     | None ->
         List.map
           (fun (item_name, _) ->
-            let name = ctx.fmt.trait_const_name trait_decl item_name in
+            let name = ctx_compute_trait_const_name ctx trait_decl item_name in
             (* Add a prefix if necessary *)
             let name =
               if !Config.record_fields_short_names then name
-              else ctx.fmt.trait_decl_name trait_decl ^ name
+              else ctx_compute_trait_decl_name ctx trait_decl ^ name
             in
             (item_name, name))
           consts
@@ -1887,19 +1884,21 @@ let extract_trait_decl_type_names (ctx : extraction_ctx)
     match builtin_info with
     | None ->
         let compute_type_name (item_name : string) : string =
-          let type_name = ctx.fmt.trait_type_name trait_decl item_name in
+          let type_name =
+            ctx_compute_trait_type_name ctx trait_decl item_name
+          in
           if !Config.record_fields_short_names then type_name
-          else ctx.fmt.trait_decl_name trait_decl ^ type_name
+          else ctx_compute_trait_decl_name ctx trait_decl ^ type_name
         in
         let compute_clause_name (item_name : string) (clause : trait_clause) :
             TraitClauseId.id * string =
           let name =
-            ctx.fmt.trait_type_clause_name trait_decl item_name clause
+            ctx_compute_trait_type_clause_name ctx trait_decl item_name clause
           in
           (* Add a prefix if necessary *)
           let name =
             if !Config.record_fields_short_names then name
-            else ctx.fmt.trait_decl_name trait_decl ^ name
+            else ctx_compute_trait_decl_name ctx trait_decl ^ name
           in
           (clause.clause_id, name)
         in
@@ -1971,7 +1970,7 @@ let extract_trait_decl_method_names (ctx : extraction_ctx)
             (* Add a prefix if necessary *)
             let name =
               if !Config.record_fields_short_names then name
-              else ctx.fmt.trait_decl_name trait_decl ^ "_" ^ name
+              else ctx_compute_trait_decl_name ctx trait_decl ^ "_" ^ name
             in
             (f.back_id, name)
           in
@@ -2036,8 +2035,8 @@ let extract_trait_decl_register_names (ctx : extraction_ctx)
     let trait_name, trait_constructor =
       match builtin_info with
       | None ->
-          ( ctx.fmt.trait_decl_name trait_decl,
-            ctx.fmt.trait_decl_constructor trait_decl )
+          ( ctx_compute_trait_decl_name ctx trait_decl,
+            ctx_compute_trait_decl_constructor ctx trait_decl )
       | Some info -> (info.extract_name, info.constructor)
     in
     let ctx = ctx_add (TraitDeclId trait_decl.def_id) trait_name ctx in
@@ -2101,7 +2100,7 @@ let extract_trait_impl_register_names (ctx : extraction_ctx)
   (* Compute the name *)
   let name =
     match builtin_info with
-    | None -> ctx.fmt.trait_impl_name trait_decl trait_impl
+    | None -> ctx_compute_trait_impl_name ctx trait_decl trait_impl
     | Some name -> name
   in
   ctx_add (TraitImplId trait_impl.def_id) name ctx
@@ -2214,7 +2213,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter)
   (* Open the box for the name + generics *)
   F.pp_open_hovbox fmt ctx.indent_incr;
   let qualif =
-    Option.get (ctx.fmt.type_decl_kind_to_qualif SingleNonRec (Some Struct))
+    Option.get (type_decl_kind_to_qualif SingleNonRec (Some Struct))
   in
   (* When checking if the trait declaration is empty: we ignore the provided
      methods, because for now they are extracted separately *)
@@ -2505,7 +2504,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter)
   (* `let (....) : Trait ... =` *)
   (* Open the box for the name + generics *)
   F.pp_open_hovbox fmt ctx.indent_incr;
-  (match ctx.fmt.fun_decl_kind_to_qualif SingleNonRec with
+  (match fun_decl_kind_to_qualif SingleNonRec with
   | Some qualif ->
       F.pp_print_string fmt qualif;
       F.pp_print_space fmt ()
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index f1ba35a2..0b9908b2 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -2,9 +2,11 @@
 
 open Contexts
 open Pure
-open TranslateCore
+open StringUtils
+open Config
 module F = Format
 open ExtractBuiltin
+open TranslateCore
 
 (** The local logger *)
 let log = Logging.extract_log
@@ -109,225 +111,6 @@ let decl_is_not_last_from_group (kind : decl_kind) : bool =
 
 type type_decl_kind = Enum | Struct [@@deriving show]
 
-(* TODO: this should be a module we give to a functor! *)
-
-(** A formatter's role is twofold:
-    1. Come up with name suggestions.
-    For instance, provided some information about a function (its basename,
-    information about the region group, etc.) it should come up with an
-    appropriate name for the forward/backward function.
-
-    It can of course apply many transformations, like changing to camel case/
-    snake case, adding prefixes/suffixes, etc.
-
-    2. Format some specific terms, like constants.
-
-    TODO: unclear that this is useful now that all the backends are so much
-    entangled in Extract.ml
- *)
-type formatter = {
-  bool_name : string;
-  char_name : string;
-  int_name : integer_type -> string;
-  str_name : string;
-  type_decl_kind_to_qualif :
-    decl_kind -> type_decl_kind option -> string option;
-      (** Compute the qualified for a type definition/declaration.
-
-          For instance: "type", "and", etc.
-
-          Remark: can return [None] for some backends like HOL4.
-       *)
-  fun_decl_kind_to_qualif : decl_kind -> string option;
-      (** Compute the qualified for a function definition/declaration.
-
-          For instance: "let", "let rec", "and", etc.
-
-          Remark: can return [None] for some backends like HOL4.
-       *)
-  field_name : llbc_name -> FieldId.id -> string option -> string;
-      (** Inputs:
-          - type name
-          - field id
-          - field name
-
-          Note that fields don't always have names, but we still need to
-          generate some names if we want to extract the structures to records...
-          We might want to extract such structures to tuples, later, but field
-          access then causes trouble because not all provers accept syntax like
-          [x.3] where [x] is a tuple.
-       *)
-  variant_name : llbc_name -> string -> string;
-      (** Inputs:
-          - type name
-          - variant name
-       *)
-  struct_constructor : llbc_name -> string;
-      (** Structure constructors are used when constructing structure values.
-
-          For instance, in F*:
-          {[
-            type pair = { x : nat; y : nat }
-            let p : pair = Mkpair 0 1
-          ]}
-
-          Inputs:
-          - type name
-      *)
-  type_name : llbc_name -> string;
-      (** Provided a basename, compute a type name. *)
-  global_name : llbc_name -> string;
-      (** Provided a basename, compute a global name. *)
-  fun_name :
-    llbc_name ->
-    int ->
-    LoopId.id option ->
-    int ->
-    region_group_info option ->
-    bool * int ->
-    string;
-      (** Compute the name of a regular (non-assumed) function.
-
-          Inputs:
-          - function basename (TODO: shouldn't appear for assumed functions?...)
-          - number of loops in the function (useful to check if we need to use
-            indices to derive unique names for the loops for instance - if there is
-            exactly one loop, we don't need to use indices)
-          - loop id (if pertinent)
-          - number of region groups
-          - region group information in case of a backward function
-            ([None] if forward function)
-          - pair:
-            - do we generate the forward function (it may have been filtered)?
-            - the number of *extracted backward functions* (same comment as for
-              the number of loops)
-              The number of extracted backward functions if not necessarily
-              equal to the number of region groups, because we may have
-              filtered some of them.
-          TODO: use the fun id for the assumed functions.
-       *)
-  termination_measure_name :
-    A.FunDeclId.id -> llbc_name -> int -> LoopId.id option -> string;
-      (** Generates the name of the termination measure used to prove/reason about
-          termination. The generated code uses this clause where needed,
-          but its body must be defined by the user.
-
-          F* and Lean only.
-
-          Inputs:
-          - function id: this is especially useful to identify whether the
-            function is an assumed function or a local function
-          - function basename
-          - the number of loops in the parent function. This is used for
-            the same purpose as in {!field:llbc_name}.
-          - loop identifier, if this is for a loop
-       *)
-  decreases_proof_name :
-    A.FunDeclId.id -> llbc_name -> int -> LoopId.id option -> string;
-      (** Generates the name of the proof used to prove/reason about
-          termination. The generated code uses this clause where needed,
-          but its body must be defined by the user.
-
-          Lean only.
-
-          Inputs:
-          - function id: this is especially useful to identify whether the
-            function is an assumed function or a local function
-          - function basename
-          - the number of loops in the parent function. This is used for
-            the same purpose as in {!field:llbc_name}.
-          - loop identifier, if this is for a loop
-       *)
-  trait_decl_name : trait_decl -> string;
-  trait_impl_name : trait_decl -> trait_impl -> string;
-  trait_decl_constructor : trait_decl -> string;
-  trait_parent_clause_name : trait_decl -> trait_clause -> string;
-  trait_const_name : trait_decl -> string -> string;
-  trait_type_name : trait_decl -> string -> string;
-  trait_method_name : trait_decl -> string -> string;
-  trait_type_clause_name : trait_decl -> string -> trait_clause -> string;
-  var_basename : StringSet.t -> string option -> ty -> string;
-      (** Generates a variable basename.
-
-          Inputs:
-          - the set of names used in the context so far
-          - the basename we got from the symbolic execution, if we have one
-          - the type of the variable (can be useful for heuristics, in order
-            not to always use "x" for instance, whenever naming anonymous
-            variables)
-
-          Note that once the formatter generated a basename, we add an index
-          if necessary to prevent name clashes: the burden of name clashes checks
-          is thus on the caller's side.
-       *)
-  type_var_basename : StringSet.t -> string -> string;
-      (** Generates a type variable basename. *)
-  const_generic_var_basename : StringSet.t -> string -> string;
-      (** Generates a const generic variable basename. *)
-  trait_self_clause_basename : string;
-  trait_clause_basename : StringSet.t -> trait_clause -> string;
-      (** Return a base name for a trait clause. We might add a suffix to prevent
-          collisions.
-
-          In the traduction we explicitely manipulate the trait clause instances,
-          that is we introduce one input variable for each trait clause.
-       *)
-  append_index : string -> int -> string;
-      (** Appends an index to a name - we use this to generate unique
-          names: when doing so, the role of the formatter is just to concatenate
-          indices to names, the responsability of finding a proper index is
-          delegated to helper functions.
-       *)
-  extract_literal : F.formatter -> bool -> literal -> unit;
-      (** Format a constant value.
-
-          Inputs:
-          - formatter
-          - [inside]: if [true], the value should be wrapped in parentheses
-            if it is made of an application (ex.: [U32 3])
-          - the constant value
-       *)
-  extract_unop :
-    (bool -> texpression -> unit) ->
-    F.formatter ->
-    bool ->
-    unop ->
-    texpression ->
-    unit;
-      (** Format a unary operation
-
-          Inputs:
-          - a formatter for expressions (called on the argument of the unop)
-          - extraction context (see below)
-          - formatter
-          - expression formatter
-          - [inside]
-          - unop
-          - argument
-       *)
-  extract_binop :
-    (bool -> texpression -> unit) ->
-    F.formatter ->
-    bool ->
-    E.binop ->
-    integer_type ->
-    texpression ->
-    texpression ->
-    unit;
-      (** Format a binary operation
-
-          Inputs:
-          - a formatter for expressions (called on the arguments of the binop)
-          - extraction context (see below)
-          - formatter
-          - expression formatter
-          - [inside]
-          - binop
-          - argument 0
-          - argument 1
-       *)
-}
-
 (** We use identifiers to look for name clashes *)
 type id =
   | GlobalId of A.GlobalDeclId.id
@@ -590,6 +373,152 @@ type names_maps = {
        *)
 }
 
+(** Return [true] if we are strict on collisions for this id (i.e., we forbid
+    collisions even with the ids in the unsafe names map) *)
+let strict_collisions (id : id) : bool =
+  match id with UnknownId | TypeId _ -> true | _ -> false
+
+(** We might not check for collisions for some specific ids (ex.: field names) *)
+let allow_collisions (id : id) : bool =
+  match id with
+  | FieldId _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitItemId _
+  | TraitMethodId _ ->
+      !Config.record_fields_short_names
+  | FunId (Pure _ | FromLlbc (FunId (FAssumed _), _, _)) ->
+      (* We map several assumed functions to the same id *)
+      true
+  | _ -> false
+
+(** The [id_to_string] function to print nice debugging messages if there are
+    collisions *)
+let names_maps_add (id_to_string : id -> string) (id : id) (name : string)
+    (nm : names_maps) : names_maps =
+  (* We do not use the same name map if we allow/disallow collisions.
+     We notably use it for field names: some backends like Lean can use the
+     type information to disambiguate field projections.
+
+     Remark: we still need to check that those "unsafe" ids don't collide with
+     the ids that we mark as "strict on collision".
+
+     For instance, we don't allow naming a field "let". We enforce this by
+     not checking collision between ids for which we permit collisions (ex.:
+     between fields), but still checking collisions between those ids and the
+     others (ex.: fields and keywords).
+  *)
+  if allow_collisions id then (
+    (* Check with the ids which are considered to be strict on collisions *)
+    names_map_check_collision id_to_string id name nm.strict_names_map;
+    {
+      nm with
+      unsafe_names_map = unsafe_names_map_add id name nm.unsafe_names_map;
+    })
+  else
+    (* Remark: if we are strict on collisions:
+       - we add the id to the strict collisions map
+       - we check that the id doesn't collide with the unsafe map
+       TODO: we might not check that:
+       - a user defined function doesn't collide with an assumed function
+       - two trait decl items don't collide with each other
+    *)
+    let strict_names_map =
+      if strict_collisions id then
+        names_map_add id_to_string id name nm.strict_names_map
+      else nm.strict_names_map
+    in
+    let names_map = names_map_add id_to_string id name nm.names_map in
+    { nm with strict_names_map; names_map }
+
+(** The [id_to_string] function to print nice debugging messages if there are
+    collisions *)
+let names_maps_get (id_to_string : id -> string) (id : id) (nm : names_maps) :
+    string =
+  (* We do not use the same name map if we allow/disallow collisions *)
+  let map_to_string (m : string IdMap.t) : string =
+    "[\n"
+    ^ String.concat ","
+        (List.map
+           (fun (id, n) -> "\n  " ^ id_to_string id ^ " -> " ^ n)
+           (IdMap.bindings m))
+    ^ "\n]"
+  in
+  if allow_collisions id then (
+    let m = nm.unsafe_names_map.id_to_name in
+    match IdMap.find_opt id m with
+    | Some s -> s
+    | None ->
+        let err =
+          "Could not find: " ^ id_to_string id ^ "\nNames map:\n"
+          ^ map_to_string m
+        in
+        log#serror err;
+        if !Config.fail_hard then raise (Failure err)
+        else "(%%%ERROR: unknown identifier\": " ^ id_to_string id ^ "\"%%%)")
+  else
+    let m = nm.names_map.id_to_name in
+    match IdMap.find_opt id m with
+    | Some s -> s
+    | None ->
+        let err =
+          "Could not find: " ^ id_to_string id ^ "\nNames map:\n"
+          ^ map_to_string m
+        in
+        log#serror err;
+        if !Config.fail_hard then raise (Failure err)
+        else "(ERROR: \"" ^ id_to_string id ^ "\")"
+
+type names_map_init = {
+  keywords : string list;
+  assumed_adts : (assumed_ty * string) list;
+  assumed_structs : (assumed_ty * string) list;
+  assumed_variants : (assumed_ty * VariantId.id * string) list;
+  assumed_llbc_functions :
+    (A.assumed_fun_id * RegionGroupId.id option * string) list;
+  assumed_pure_functions : (pure_assumed_fun_id * string) list;
+}
+
+let names_maps_add_assumed_type (id_to_string : id -> string) (id : assumed_ty)
+    (name : string) (nm : names_maps) : names_maps =
+  names_maps_add id_to_string (TypeId (TAssumed id)) name nm
+
+let names_maps_add_assumed_struct (id_to_string : id -> string)
+    (id : assumed_ty) (name : string) (nm : names_maps) : names_maps =
+  names_maps_add id_to_string (StructId (TAssumed id)) name nm
+
+let names_maps_add_assumed_variant (id_to_string : id -> string)
+    (id : assumed_ty) (variant_id : VariantId.id) (name : string)
+    (nm : names_maps) : names_maps =
+  names_maps_add id_to_string (VariantId (TAssumed id, variant_id)) name nm
+
+let names_maps_add_function (id_to_string : id -> string) (fid : fun_id)
+    (name : string) (nm : names_maps) : names_maps =
+  names_maps_add id_to_string (FunId fid) name nm
+
+let bool_name () = if !backend = Lean then "Bool" else "bool"
+let char_name () = if !backend = Lean then "Char" else "char"
+let str_name () = if !backend = Lean then "String" else "string"
+
+(** Small helper to compute the name of an int type *)
+let int_name (int_ty : integer_type) =
+  let isize, usize, i_format, u_format =
+    match !backend with
+    | FStar | Coq | HOL4 ->
+        ("isize", "usize", format_of_string "i%d", format_of_string "u%d")
+    | Lean -> ("Isize", "Usize", format_of_string "I%d", format_of_string "U%d")
+  in
+  match int_ty with
+  | Isize -> isize
+  | I8 -> Printf.sprintf i_format 8
+  | I16 -> Printf.sprintf i_format 16
+  | I32 -> Printf.sprintf i_format 32
+  | I64 -> Printf.sprintf i_format 64
+  | I128 -> Printf.sprintf i_format 128
+  | Usize -> usize
+  | U8 -> Printf.sprintf u_format 8
+  | U16 -> Printf.sprintf u_format 16
+  | U32 -> Printf.sprintf u_format 32
+  | U64 -> Printf.sprintf u_format 64
+  | U128 -> Printf.sprintf u_format 128
+
 (** Extraction context.
 
     Note that the extraction context contains information coming from the
@@ -601,7 +530,6 @@ type extraction_ctx = {
   crate : A.crate;
   trans_ctx : trans_ctx;
   names_maps : names_maps;
-  fmt : formatter;
   indent_incr : int;
       (** The indent increment we insert whenever we need to indent more *)
   use_dep_ite : bool;
@@ -741,130 +669,20 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       ^ ", method name (" ^ fwd_back_kind ^ "): " ^ fun_name
   | TraitSelfClauseId -> "trait_self_clause"
 
-(** Return [true] if we are strict on collisions for this id (i.e., we forbid
-    collisions even with the ids in the unsafe names map) *)
-let strict_collisions (id : id) : bool =
-  match id with UnknownId | TypeId _ -> true | _ -> false
-
-(** We might not check for collisions for some specific ids (ex.: field names) *)
-let allow_collisions (id : id) : bool =
-  match id with
-  | FieldId _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitItemId _
-  | TraitMethodId _ ->
-      !Config.record_fields_short_names
-  | FunId (Pure _ | FromLlbc (FunId (FAssumed _), _, _)) ->
-      (* We map several assumed functions to the same id *)
-      true
-  | _ -> false
-
-(** The [id_to_string] function to print nice debugging messages if there are
-    collisions *)
-let names_maps_add (id_to_string : id -> string) (id : id) (name : string)
-    (nm : names_maps) : names_maps =
-  (* We do not use the same name map if we allow/disallow collisions.
-     We notably use it for field names: some backends like Lean can use the
-     type information to disambiguate field projections.
-
-     Remark: we still need to check that those "unsafe" ids don't collide with
-     the ids that we mark as "strict on collision".
-
-     For instance, we don't allow naming a field "let". We enforce this by
-     not checking collision between ids for which we permit collisions (ex.:
-     between fields), but still checking collisions between those ids and the
-     others (ex.: fields and keywords).
-  *)
-  if allow_collisions id then (
-    (* Check with the ids which are considered to be strict on collisions *)
-    names_map_check_collision id_to_string id name nm.strict_names_map;
-    {
-      nm with
-      unsafe_names_map = unsafe_names_map_add id name nm.unsafe_names_map;
-    })
-  else
-    (* Remark: if we are strict on collisions:
-       - we add the id to the strict collisions map
-       - we check that the id doesn't collide with the unsafe map
-       TODO: we might not check that:
-       - a user defined function doesn't collide with an assumed function
-       - two trait decl items don't collide with each other
-    *)
-    let strict_names_map =
-      if strict_collisions id then
-        names_map_add id_to_string id name nm.strict_names_map
-      else nm.strict_names_map
-    in
-    let names_map = names_map_add id_to_string id name nm.names_map in
-    { nm with strict_names_map; names_map }
-
 let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx =
   let id_to_string (id : id) : string = id_to_string id ctx in
   let names_maps = names_maps_add id_to_string id name ctx.names_maps in
   { ctx with names_maps }
 
-(** The [id_to_string] function to print nice debugging messages if there are
-    collisions *)
-let names_maps_get (id_to_string : id -> string) (id : id) (nm : names_maps) :
-    string =
-  (* We do not use the same name map if we allow/disallow collisions *)
-  let map_to_string (m : string IdMap.t) : string =
-    "[\n"
-    ^ String.concat ","
-        (List.map
-           (fun (id, n) -> "\n  " ^ id_to_string id ^ " -> " ^ n)
-           (IdMap.bindings m))
-    ^ "\n]"
-  in
-  if allow_collisions id then (
-    let m = nm.unsafe_names_map.id_to_name in
-    match IdMap.find_opt id m with
-    | Some s -> s
-    | None ->
-        let err =
-          "Could not find: " ^ id_to_string id ^ "\nNames map:\n"
-          ^ map_to_string m
-        in
-        log#serror err;
-        if !Config.fail_hard then raise (Failure err)
-        else "(%%%ERROR: unknown identifier\": " ^ id_to_string id ^ "\"%%%)")
-  else
-    let m = nm.names_map.id_to_name in
-    match IdMap.find_opt id m with
-    | Some s -> s
-    | None ->
-        let err =
-          "Could not find: " ^ id_to_string id ^ "\nNames map:\n"
-          ^ map_to_string m
-        in
-        log#serror err;
-        if !Config.fail_hard then raise (Failure err)
-        else "(ERROR: \"" ^ id_to_string id ^ "\")"
-
 let ctx_get (id : id) (ctx : extraction_ctx) : string =
   let id_to_string (id : id) : string = id_to_string id ctx in
   names_maps_get id_to_string id ctx.names_maps
 
-let names_maps_add_assumed_type (id_to_string : id -> string) (id : assumed_ty)
-    (name : string) (nm : names_maps) : names_maps =
-  names_maps_add id_to_string (TypeId (TAssumed id)) name nm
+let ctx_get_global (id : A.GlobalDeclId.id) (ctx : extraction_ctx) : string =
+  ctx_get (GlobalId id) ctx
 
-let names_maps_add_assumed_struct (id_to_string : id -> string)
-    (id : assumed_ty) (name : string) (nm : names_maps) : names_maps =
-  names_maps_add id_to_string (StructId (TAssumed id)) name nm
-
-let names_maps_add_assumed_variant (id_to_string : id -> string)
-    (id : assumed_ty) (variant_id : VariantId.id) (name : string)
-    (nm : names_maps) : names_maps =
-  names_maps_add id_to_string (VariantId (TAssumed id, variant_id)) name nm
-
-let names_maps_add_function (id_to_string : id -> string) (fid : fun_id)
-    (name : string) (nm : names_maps) : names_maps =
-  names_maps_add id_to_string (FunId fid) name nm
-
-let ctx_get_global (id : A.GlobalDeclId.id) (ctx : extraction_ctx) : string =
-  ctx_get (GlobalId id) ctx
-
-let ctx_get_function (id : fun_id) (ctx : extraction_ctx) : string =
-  ctx_get (FunId id) ctx
+let ctx_get_function (id : fun_id) (ctx : extraction_ctx) : string =
+  ctx_get (FunId id) ctx
 
 let ctx_get_local_function (id : A.FunDeclId.id) (lp : LoopId.id option)
     (rg : RegionGroupId.id option) (ctx : extraction_ctx) : string =
@@ -950,15 +768,970 @@ let ctx_get_termination_measure (def_id : A.FunDeclId.id)
     (loop_id : LoopId.id option) (ctx : extraction_ctx) : string =
   ctx_get (TerminationMeasureId (FRegular def_id, loop_id)) ctx
 
+(** Small helper to compute the name of a unary operation *)
+let unop_name (unop : unop) : string =
+  match unop with
+  | Not -> (
+      match !backend with FStar | Lean -> "not" | Coq -> "negb" | HOL4 -> "~")
+  | Neg (int_ty : integer_type) -> (
+      match !backend with Lean -> "-" | _ -> int_name int_ty ^ "_neg")
+  | Cast _ ->
+      (* We never directly use the unop name in this case *)
+      raise (Failure "Unsupported")
+
+(** Small helper to compute the name of a binary operation (note that many
+    binary operations like "less than" are extracted to primitive operations,
+    like [<]).
+ *)
+let named_binop_name (binop : E.binop) (int_ty : integer_type) : string =
+  let binop =
+    match binop with
+    | Div -> "div"
+    | Rem -> "rem"
+    | Add -> "add"
+    | Sub -> "sub"
+    | Mul -> "mul"
+    | Lt -> "lt"
+    | Le -> "le"
+    | Ge -> "ge"
+    | Gt -> "gt"
+    | BitXor -> "xor"
+    | BitAnd -> "and"
+    | BitOr -> "or"
+    | Shl -> "lsl"
+    | Shr ->
+        "asr"
+        (* NOTE: make sure arithmetic shift right is implemented, i.e. OCaml's asr operator, not lsr *)
+    | _ -> raise (Failure "Unreachable")
+  in
+  (* Remark: the Lean case is actually not used *)
+  match !backend with
+  | Lean -> int_name int_ty ^ "." ^ binop
+  | FStar | Coq | HOL4 -> int_name int_ty ^ "_" ^ binop
+
+(** A list of keywords/identifiers used by the backend and with which we
+    want to check collision.
+
+    Remark: this is useful mostly to look for collisions when generating
+    names for *variables*.
+ *)
+let keywords () =
+  let named_unops =
+    unop_name Not
+    :: List.map (fun it -> unop_name (Neg it)) T.all_signed_int_types
+  in
+  let named_binops = [ E.Div; Rem; Add; Sub; Mul ] in
+  let named_binops =
+    List.concat_map
+      (fun bn -> List.map (fun it -> named_binop_name bn it) T.all_int_types)
+      named_binops
+  in
+  let misc =
+    match !backend with
+    | FStar ->
+        [
+          "assert";
+          "assert_norm";
+          "assume";
+          "else";
+          "fun";
+          "fn";
+          "FStar";
+          "FStar.Mul";
+          "if";
+          "in";
+          "include";
+          "int";
+          "let";
+          "list";
+          "match";
+          "open";
+          "rec";
+          "scalar_cast";
+          "then";
+          "type";
+          "Type0";
+          "Type";
+          "unit";
+          "val";
+          "with";
+        ]
+    | Coq ->
+        [
+          "assert";
+          "Arguments";
+          "Axiom";
+          "char_of_byte";
+          "Check";
+          "Declare";
+          "Definition";
+          "else";
+          "End";
+          "fun";
+          "Fixpoint";
+          "if";
+          "in";
+          "int";
+          "Inductive";
+          "Import";
+          "let";
+          "Lemma";
+          "match";
+          "Module";
+          "not";
+          "Notation";
+          "Proof";
+          "Qed";
+          "rec";
+          "Record";
+          "Require";
+          "Scope";
+          "Search";
+          "SearchPattern";
+          "Set";
+          "then";
+          (* [tt] is unit *)
+          "tt";
+          "type";
+          "Type";
+          "unit";
+          "with";
+        ]
+    | Lean ->
+        [
+          "by";
+          "class";
+          "decreasing_by";
+          "def";
+          "deriving";
+          "do";
+          "else";
+          "end";
+          "for";
+          "have";
+          "if";
+          "inductive";
+          "instance";
+          "import";
+          "let";
+          "macro";
+          "match";
+          "namespace";
+          "opaque";
+          "open";
+          "run_cmd";
+          "set_option";
+          "simp";
+          "structure";
+          "syntax";
+          "termination_by";
+          "then";
+          "Type";
+          "unsafe";
+          "where";
+          "with";
+          "opaque_defs";
+        ]
+    | HOL4 ->
+        [
+          "Axiom";
+          "case";
+          "Definition";
+          "else";
+          "End";
+          "fix";
+          "fix_exec";
+          "fn";
+          "fun";
+          "if";
+          "in";
+          "int";
+          "Inductive";
+          "let";
+          "of";
+          "Proof";
+          "QED";
+          "then";
+          "Theorem";
+        ]
+  in
+  List.concat [ named_unops; named_binops; misc ]
+
+let assumed_adts () : (assumed_ty * string) list =
+  match !backend with
+  | Lean ->
+      [
+        (TState, "State");
+        (TResult, "Result");
+        (TError, "Error");
+        (TFuel, "Nat");
+        (TArray, "Array");
+        (TSlice, "Slice");
+        (TStr, "Str");
+        (TRawPtr Mut, "MutRawPtr");
+        (TRawPtr Const, "ConstRawPtr");
+      ]
+  | Coq | FStar | HOL4 ->
+      [
+        (TState, "state");
+        (TResult, "result");
+        (TError, "error");
+        (TFuel, if !backend = HOL4 then "num" else "nat");
+        (TArray, "array");
+        (TSlice, "slice");
+        (TStr, "str");
+        (TRawPtr Mut, "mut_raw_ptr");
+        (TRawPtr Const, "const_raw_ptr");
+      ]
+
+let assumed_struct_constructors () : (assumed_ty * string) list =
+  match !backend with
+  | Lean -> [ (TArray, "Array.make") ]
+  | Coq -> [ (TArray, "mk_array") ]
+  | FStar -> [ (TArray, "mk_array") ]
+  | HOL4 -> [ (TArray, "mk_array") ]
+
+let assumed_variants () : (assumed_ty * VariantId.id * string) list =
+  match !backend with
+  | FStar ->
+      [
+        (TResult, result_return_id, "Return");
+        (TResult, result_fail_id, "Fail");
+        (TError, error_failure_id, "Failure");
+        (TError, error_out_of_fuel_id, "OutOfFuel");
+        (* No Fuel::Zero on purpose *)
+        (* No Fuel::Succ on purpose *)
+      ]
+  | Coq ->
+      [
+        (TResult, result_return_id, "Return");
+        (TResult, result_fail_id, "Fail_");
+        (TError, error_failure_id, "Failure");
+        (TError, error_out_of_fuel_id, "OutOfFuel");
+        (TFuel, fuel_zero_id, "O");
+        (TFuel, fuel_succ_id, "S");
+      ]
+  | Lean ->
+      [
+        (TResult, result_return_id, "ret");
+        (TResult, result_fail_id, "fail");
+        (TError, error_failure_id, "panic");
+        (* No Fuel::Zero on purpose *)
+        (* No Fuel::Succ on purpose *)
+      ]
+  | HOL4 ->
+      [
+        (TResult, result_return_id, "Return");
+        (TResult, result_fail_id, "Fail");
+        (TError, error_failure_id, "Failure");
+        (* No Fuel::Zero on purpose *)
+        (* No Fuel::Succ on purpose *)
+      ]
+
+let assumed_llbc_functions () :
+    (A.assumed_fun_id * T.RegionGroupId.id option * string) list =
+  let rg0 = Some T.RegionGroupId.zero in
+  match !backend with
+  | FStar | Coq | HOL4 ->
+      [
+        (ArrayIndexShared, None, "array_index_usize");
+        (ArrayIndexMut, None, "array_index_usize");
+        (ArrayIndexMut, rg0, "array_update_usize");
+        (ArrayToSliceShared, None, "array_to_slice");
+        (ArrayToSliceMut, None, "array_to_slice");
+        (ArrayToSliceMut, rg0, "array_from_slice");
+        (ArrayRepeat, None, "array_repeat");
+        (SliceIndexShared, None, "slice_index_usize");
+        (SliceIndexMut, None, "slice_index_usize");
+        (SliceIndexMut, rg0, "slice_update_usize");
+      ]
+  | Lean ->
+      [
+        (ArrayIndexShared, None, "Array.index_usize");
+        (ArrayIndexMut, None, "Array.index_usize");
+        (ArrayIndexMut, rg0, "Array.update_usize");
+        (ArrayToSliceShared, None, "Array.to_slice");
+        (ArrayToSliceMut, None, "Array.to_slice");
+        (ArrayToSliceMut, rg0, "Array.from_slice");
+        (ArrayRepeat, None, "Array.repeat");
+        (SliceIndexShared, None, "Slice.index_usize");
+        (SliceIndexMut, None, "Slice.index_usize");
+        (SliceIndexMut, rg0, "Slice.update_usize");
+      ]
+
+let assumed_pure_functions () : (pure_assumed_fun_id * string) list =
+  match !backend with
+  | FStar ->
+      [
+        (Return, "return");
+        (Fail, "fail");
+        (Assert, "massert");
+        (FuelDecrease, "decrease");
+        (FuelEqZero, "is_zero");
+      ]
+  | Coq ->
+      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
+      [ (Return, "return_"); (Fail, "fail_"); (Assert, "massert") ]
+  | Lean ->
+      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
+      [ (Return, "return"); (Fail, "fail_"); (Assert, "massert") ]
+  | HOL4 ->
+      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
+      [ (Return, "return"); (Fail, "fail"); (Assert, "massert") ]
+
+let names_map_init () : names_map_init =
+  {
+    keywords = keywords ();
+    assumed_adts = assumed_adts ();
+    assumed_structs = assumed_struct_constructors ();
+    assumed_variants = assumed_variants ();
+    assumed_llbc_functions = assumed_llbc_functions ();
+    assumed_pure_functions = assumed_pure_functions ();
+  }
+
+(** Initialize names maps with a proper set of keywords/names coming from the
+    target language/prover. *)
+let initialize_names_maps () : names_maps =
+  let init = names_map_init () in
+  let int_names = List.map int_name T.all_int_types in
+  let keywords =
+    List.concat
+      [ [ bool_name (); char_name (); str_name () ]; int_names; init.keywords ]
+  in
+  let names_set = StringSet.empty in
+  let name_to_id = StringMap.empty in
+  (* We fist initialize [id_to_name] as empty, because the id of a keyword is [UnknownId].
+   * Also note that we don't need this mapping for keywords: we insert keywords only
+   * to check collisions. *)
+  let id_to_name = IdMap.empty in
+  let names_map = { id_to_name; name_to_id; names_set } in
+  let unsafe_names_map = empty_unsafe_names_map in
+  let strict_names_map = empty_names_map in
+  (* For debugging - we are creating bindings for assumed types and functions, so
+   * it is ok if we simply use the "show" function (those aren't simply identified
+   * by numbers) *)
+  let id_to_string = show_id in
+  (* Add the keywords as strict collisions *)
+  let strict_names_map =
+    List.fold_left
+      (fun nm name ->
+        (* There is duplication in the keywords so we don't check the collisions
+           while registering them (what is important is that there are no collisions
+           between keywords and user-defined identifiers) *)
+        names_map_add_unchecked UnknownId name nm)
+      strict_names_map keywords
+  in
+  let nm = { names_map; unsafe_names_map; strict_names_map } in
+  (* Then we add:
+   * - the assumed types
+   * - the assumed struct constructors
+   * - the assumed variants
+   * - the assumed functions
+   *)
+  let nm =
+    List.fold_left
+      (fun nm (type_id, name) ->
+        names_maps_add_assumed_type id_to_string type_id name nm)
+      nm init.assumed_adts
+  in
+  let nm =
+    List.fold_left
+      (fun nm (type_id, name) ->
+        names_maps_add_assumed_struct id_to_string type_id name nm)
+      nm init.assumed_structs
+  in
+  let nm =
+    List.fold_left
+      (fun nm (type_id, variant_id, name) ->
+        names_maps_add_assumed_variant id_to_string type_id variant_id name nm)
+      nm init.assumed_variants
+  in
+  let assumed_functions =
+    List.map
+      (fun (fid, rg, name) ->
+        (FromLlbc (Pure.FunId (FAssumed fid), None, rg), name))
+      init.assumed_llbc_functions
+    @ List.map (fun (fid, name) -> (Pure fid, name)) init.assumed_pure_functions
+  in
+  let nm =
+    List.fold_left
+      (fun nm (fid, name) -> names_maps_add_function id_to_string fid name nm)
+      nm assumed_functions
+  in
+  (* Return *)
+  nm
+
+(** Compute the qualified for a type definition/declaration.
+
+    For instance: "type", "and", etc.
+
+    Remark: can return [None] for some backends like HOL4.
+ *)
+let type_decl_kind_to_qualif (kind : decl_kind)
+    (type_kind : type_decl_kind option) : string option =
+  match !backend with
+  | FStar -> (
+      match kind with
+      | SingleNonRec -> Some "type"
+      | SingleRec -> Some "type"
+      | MutRecFirst -> Some "type"
+      | MutRecInner -> Some "and"
+      | MutRecLast -> Some "and"
+      | Assumed -> Some "assume type"
+      | Declared -> Some "val")
+  | Coq -> (
+      match (kind, type_kind) with
+      | SingleNonRec, Some Enum -> Some "Inductive"
+      | SingleNonRec, Some Struct -> Some "Record"
+      | (SingleRec | MutRecFirst), Some _ -> Some "Inductive"
+      | (MutRecInner | MutRecLast), Some _ ->
+          (* Coq doesn't support groups of mutually recursive definitions which mix
+           * records and inducties: we convert everything to records if this happens
+           *)
+          Some "with"
+      | (Assumed | Declared), None -> Some "Axiom"
+      | SingleNonRec, None ->
+          (* This is for traits *)
+          Some "Record"
+      | _ ->
+          raise
+            (Failure
+               ("Unexpected: (" ^ show_decl_kind kind ^ ", "
+               ^ Print.option_to_string show_type_decl_kind type_kind
+               ^ ")")))
+  | Lean -> (
+      match kind with
+      | SingleNonRec ->
+          if type_kind = Some Struct then Some "structure" else Some "inductive"
+      | SingleRec -> Some "inductive"
+      | MutRecFirst -> Some "inductive"
+      | MutRecInner -> Some "inductive"
+      | MutRecLast -> Some "inductive"
+      | Assumed -> Some "axiom"
+      | Declared -> Some "axiom")
+  | HOL4 -> None
+
+(** Compute the qualified for a function definition/declaration.
+
+    For instance: "let", "let rec", "and", etc.
+
+    Remark: can return [None] for some backends like HOL4.
+ *)
+let fun_decl_kind_to_qualif (kind : decl_kind) : string option =
+  match !backend with
+  | FStar -> (
+      match kind with
+      | SingleNonRec -> Some "let"
+      | SingleRec -> Some "let rec"
+      | MutRecFirst -> Some "let rec"
+      | MutRecInner -> Some "and"
+      | MutRecLast -> Some "and"
+      | Assumed -> Some "assume val"
+      | Declared -> Some "val")
+  | Coq -> (
+      match kind with
+      | SingleNonRec -> Some "Definition"
+      | SingleRec -> Some "Fixpoint"
+      | MutRecFirst -> Some "Fixpoint"
+      | MutRecInner -> Some "with"
+      | MutRecLast -> Some "with"
+      | Assumed -> Some "Axiom"
+      | Declared -> Some "Axiom")
+  | Lean -> (
+      match kind with
+      | SingleNonRec -> Some "def"
+      | SingleRec -> Some "divergent def"
+      | MutRecFirst -> Some "mutual divergent def"
+      | MutRecInner -> Some "divergent def"
+      | MutRecLast -> Some "divergent def"
+      | Assumed -> Some "axiom"
+      | Declared -> Some "axiom")
+  | HOL4 -> None
+
+(** The type of types.
+
+    TODO: move inside the formatter?
+ *)
+let type_keyword () =
+  match !backend with
+  | FStar -> "Type0"
+  | Coq | Lean -> "Type"
+  | HOL4 -> raise (Failure "Unexpected")
+
+(** Helper *)
+let name_last_elem_as_ident (n : llbc_name) : string =
+  match Collections.List.last n with
+  | PeIdent (s, _) -> s
+  | PeImpl _ -> raise (Failure "Unexpected")
+
+(** Helper
+
+    Prepare a name.
+    The first id elem is always the crate: if it is the local crate,
+    we remove it. We ignore disambiguators (there may be collisions, but we
+    check if there are).
+ *)
+let ctx_compute_simple_name (ctx : extraction_ctx) (name : llbc_name) :
+    string list =
+  (* Rmk.: initially we only filtered the disambiguators equal to 0 *)
+  match name with
+  | (PeIdent (crate, _) as id) :: name ->
+      let name = if crate = ctx.crate.name then name else id :: name in
+      name_to_simple_name ctx.trans_ctx name
+  | _ ->
+      raise
+        (Failure
+           ("Unexpected name shape: "
+           ^ TranslateCore.name_to_string ctx.trans_ctx name))
+
+(** Helper *)
+let ctx_compute_simple_type_name = ctx_compute_simple_name
+
+(** Helper *)
+let ctx_compute_type_name_no_suffix (ctx : extraction_ctx) (name : llbc_name) :
+    string =
+  flatten_name (ctx_compute_simple_type_name ctx name)
+
+(** Provided a basename, compute a type name. *)
+let ctx_compute_type_name (ctx : extraction_ctx) (name : llbc_name) =
+  let name = ctx_compute_type_name_no_suffix ctx name in
+  match !backend with
+  | FStar -> StringUtils.lowercase_first_letter (name ^ "_t")
+  | Coq | HOL4 -> name ^ "_t"
+  | Lean -> name
+
+(** Inputs:
+    - type name
+    - field id
+    - field name
+
+    Note that fields don't always have names, but we still need to
+    generate some names if we want to extract the structures to records...
+    We might want to extract such structures to tuples, later, but field
+    access then causes trouble because not all provers accept syntax like
+    [x.3] where [x] is a tuple.
+ *)
+let ctx_compute_field_name (ctx : extraction_ctx) (def_name : llbc_name)
+    (field_id : FieldId.id) (field_name : string option) : string =
+  let field_name_s =
+    match field_name with
+    | Some field_name -> field_name
+    | None ->
+        (* TODO: extract structs with no field names to tuples *)
+        FieldId.to_string field_id
+  in
+  if !Config.record_fields_short_names then
+    if field_name = None then (* TODO: this is a bit ugly *)
+      "_" ^ field_name_s
+    else field_name_s
+  else
+    let def_name =
+      ctx_compute_type_name_no_suffix ctx def_name ^ "_" ^ field_name_s
+    in
+    match !backend with
+    | Lean | HOL4 -> def_name
+    | Coq | FStar -> StringUtils.lowercase_first_letter def_name
+
+(** Inputs:
+    - type name
+    - variant name
+ *)
+let ctx_compute_variant_name (ctx : extraction_ctx) (def_name : llbc_name)
+    (variant : string) : string =
+  match !backend with
+  | FStar | Coq | HOL4 ->
+      let variant = to_camel_case variant in
+      if !variant_concatenate_type_name then
+        StringUtils.capitalize_first_letter
+          (ctx_compute_type_name_no_suffix ctx def_name ^ "_" ^ variant)
+      else variant
+  | Lean -> variant
+
+(** Structure constructors are used when constructing structure values.
+
+    For instance, in F*:
+    {[
+      type pair = { x : nat; y : nat }
+      let p : pair = Mkpair 0 1
+    ]}
+
+    Inputs:
+    - type name
+*)
+let ctx_compute_struct_constructor (ctx : extraction_ctx) (basename : llbc_name)
+    : string =
+  let tname = ctx_compute_type_name ctx basename in
+  ExtractBuiltin.mk_struct_constructor tname
+
+let ctx_compute_fun_name_no_suffix (ctx : extraction_ctx) (fname : llbc_name) :
+    string =
+  let fname = ctx_compute_simple_name ctx fname in
+  (* TODO: don't convert to snake case for Coq, HOL4, F* *)
+  let fname = flatten_name fname in
+  match !backend with
+  | FStar | Coq | HOL4 -> StringUtils.lowercase_first_letter fname
+  | Lean -> fname
+
+(** Provided a basename, compute the name of a global declaration. *)
+let ctx_compute_global_name (ctx : extraction_ctx) (name : llbc_name) : string =
+  (* Converting to snake case also lowercases the letters (in Rust, global
+   * names are written in capital letters). *)
+  let parts = List.map to_snake_case (ctx_compute_simple_name ctx name) in
+  String.concat "_" parts
+
+(** Helper function: generate a suffix for a function name, i.e., generates
+    a suffix like "_loop", "loop1", etc. to append to a function name.
+ *)
+let default_fun_loop_suffix (num_loops : int) (loop_id : LoopId.id option) :
+    string =
+  match loop_id with
+  | None -> ""
+  | Some loop_id ->
+      (* If this is for a loop, generally speaking, we append the loop index.
+         If this function admits only one loop, we omit it. *)
+      if num_loops = 1 then "_loop" else "_loop" ^ LoopId.to_string loop_id
+
+(** A helper function: generates a function suffix from a region group
+    information.
+    TODO: move all those helpers.
+*)
+let default_fun_suffix (num_loops : int) (loop_id : LoopId.id option)
+    (num_region_groups : int) (rg : region_group_info option)
+    ((keep_fwd, num_backs) : bool * int) : string =
+  let lp_suff = default_fun_loop_suffix num_loops loop_id in
+
+  (* There are several cases:
+     - [rg] is [Some]: this is a forward function:
+       - we add "_fwd"
+     - [rg] is [None]: this is a backward function:
+       - this function has one extracted backward function:
+         - if the forward function has been filtered, we add "_fwd_back":
+           the forward function is useless, so the unique backward function
+           takes its place, in a way
+         - otherwise we add "_back"
+       - this function has several backward functions: we add "_back" and an
+         additional suffix to identify the precise backward function
+     Note that we always add a suffix (in case there are no region groups,
+     we could not add the "_fwd" suffix) to prevent name clashes between
+     definitions (in particular between type and function definitions).
+  *)
+  let rg_suff =
+    (* TODO: make all the backends match what is done for Lean *)
+    match rg with
+    | None ->
+        if
+          (* In order to avoid name conflicts:
+           * - if the forward is eliminated, we add the suffix "_fwd" (it won't be used)
+           * - otherwise, no suffix (because the backward functions will have a suffix)
+           *)
+          num_backs = 1 && not keep_fwd
+        then "_fwd"
+        else ""
+    | Some rg ->
+        assert (num_region_groups > 0 && num_backs > 0);
+        if num_backs = 1 then
+          (* Exactly one backward function *)
+          if not keep_fwd then "" else "_back"
+        else if
+          (* Several region groups/backward functions:
+             - if all the regions in the group have names, we use those names
+             - otherwise we use an index
+          *)
+          List.for_all Option.is_some rg.region_names
+        then
+          (* Concatenate the region names *)
+          "_back" ^ String.concat "" (List.map Option.get rg.region_names)
+        else (* Use the region index *)
+          "_back" ^ RegionGroupId.to_string rg.id
+  in
+  lp_suff ^ rg_suff
+
+(** Compute the name of a regular (non-assumed) function.
+
+    Inputs:
+    - function basename (TODO: shouldn't appear for assumed functions?...)
+    - number of loops in the function (useful to check if we need to use
+      indices to derive unique names for the loops for instance - if there is
+      exactly one loop, we don't need to use indices)
+    - loop id (if pertinent)
+    - number of region groups
+    - region group information in case of a backward function
+      ([None] if forward function)
+    - pair:
+      - do we generate the forward function (it may have been filtered)?
+      - the number of *extracted backward functions* (same comment as for
+        the number of loops)
+        The number of extracted backward functions if not necessarily
+        equal to the number of region groups, because we may have
+        filtered some of them.
+    TODO: use the fun id for the assumed functions.
+ *)
+let ctx_compute_fun_name (ctx : extraction_ctx) (fname : llbc_name)
+    (num_loops : int) (loop_id : LoopId.id option) (num_rgs : int)
+    (rg : region_group_info option) (filter_info : bool * int) : string =
+  let fname = ctx_compute_fun_name_no_suffix ctx fname in
+  (* Compute the suffix *)
+  let suffix = default_fun_suffix num_loops loop_id num_rgs rg filter_info in
+  (* Concatenate *)
+  fname ^ suffix
+
+let ctx_compute_trait_decl_name (ctx : extraction_ctx) (trait_decl : trait_decl)
+    : string =
+  ctx_compute_type_name ctx trait_decl.llbc_name
+
+let ctx_compute_trait_impl_name (ctx : extraction_ctx) (trait_decl : trait_decl)
+    (trait_impl : trait_impl) : string =
+  (* We derive the trait impl name from the implemented trait.
+     For instance, if this implementation is an instance of `trait::Trait`
+     for `<foo::Foo, u32>`, we generate the name: "trait.TraitFooFooU32Inst".
+     Importantly, it is to be noted that the name is independent of the place
+     where the instance has been defined (it is indepedent of the file, etc.).
+  *)
+  let name =
+    (* We need to lookup the LLBC definitions, to have the original instantiation *)
+    let trait_impl =
+      TraitImplId.Map.find trait_impl.def_id
+        ctx.trans_ctx.trait_impls_ctx.trait_impls
+    in
+    let params = trait_impl.generics in
+    let args = trait_impl.impl_trait.decl_generics in
+    name_with_generics_to_simple_name ctx.trans_ctx trait_decl.llbc_name params
+      args
+  in
+  let name = flatten_name name in
+  match !backend with
+  | FStar -> StringUtils.lowercase_first_letter name
+  | Coq | HOL4 | Lean -> name
+
+let ctx_compute_trait_decl_constructor (ctx : extraction_ctx)
+    (trait_decl : trait_decl) : string =
+  let name = ctx_compute_trait_decl_name ctx trait_decl in
+  ExtractBuiltin.mk_struct_constructor name
+
+let ctx_compute_trait_parent_clause_name (ctx : extraction_ctx)
+    (trait_decl : trait_decl) (clause : trait_clause) : string =
+  (* TODO: improve - it would be better to not use indices *)
+  let clause = "parent_clause_" ^ TraitClauseId.to_string clause.clause_id in
+  if !Config.record_fields_short_names then clause
+  else ctx_compute_trait_decl_name ctx trait_decl ^ "_" ^ clause
+
+let ctx_compute_trait_type_name (ctx : extraction_ctx) (trait_decl : trait_decl)
+    (item : string) : string =
+  let name =
+    if !Config.record_fields_short_names then item
+    else ctx_compute_trait_decl_name ctx trait_decl ^ "_" ^ item
+  in
+  (* Constants are usually all capital letters.
+     Some backends do not support field names starting with a capital letter,
+     and it may be weird to lowercase everything (especially as it may lead
+     to more name collisions): we add a prefix when necessary.
+     For instance, it gives: "U" -> "tU"
+     Note that for some backends we prepend the type name (because those backends
+     can't disambiguate fields coming from different ADTs if they have the same
+     names), and thus don't need to add a prefix starting with a lowercase.
+  *)
+  match !backend with FStar -> "t" ^ name | Coq | Lean | HOL4 -> name
+
+let ctx_compute_trait_const_name (ctx : extraction_ctx)
+    (trait_decl : trait_decl) (item : string) : string =
+  let name =
+    if !Config.record_fields_short_names then item
+    else ctx_compute_trait_decl_name ctx trait_decl ^ "_" ^ item
+  in
+  (* See [trait_type_name] *)
+  match !backend with FStar -> "c" ^ name | Coq | Lean | HOL4 -> name
+
+let ctx_compute_trait_method_name (ctx : extraction_ctx)
+    (trait_decl : trait_decl) (item : string) : string =
+  if !Config.record_fields_short_names then item
+  else ctx_compute_trait_decl_name ctx trait_decl ^ "_" ^ item
+
+let ctx_compute_trait_type_clause_name (ctx : extraction_ctx)
+    (trait_decl : trait_decl) (item : string) (clause : trait_clause) : string =
+  (* TODO: improve - it would be better to not use indices *)
+  ctx_compute_trait_type_name ctx trait_decl item
+  ^ "_clause_"
+  ^ TraitClauseId.to_string clause.clause_id
+
+(** Generates the name of the termination measure used to prove/reason about
+    termination. The generated code uses this clause where needed,
+    but its body must be defined by the user.
+
+    F* and Lean only.
+
+    Inputs:
+    - function id: this is especially useful to identify whether the
+      function is an assumed function or a local function
+    - function basename
+    - the number of loops in the parent function. This is used for
+      the same purpose as in {!field:llbc_name}.
+    - loop identifier, if this is for a loop
+ *)
+let ctx_compute_termination_measure_name (ctx : extraction_ctx)
+    (_fid : A.FunDeclId.id) (fname : llbc_name) (num_loops : int)
+    (loop_id : LoopId.id option) : string =
+  let fname = ctx_compute_fun_name_no_suffix ctx fname in
+  let lp_suffix = default_fun_loop_suffix num_loops loop_id in
+  (* Compute the suffix *)
+  let suffix =
+    match !Config.backend with
+    | FStar -> "_decreases"
+    | Lean -> "_terminates"
+    | Coq | HOL4 -> raise (Failure "Unexpected")
+  in
+  (* Concatenate *)
+  fname ^ lp_suffix ^ suffix
+
+(** Generates the name of the proof used to prove/reason about
+    termination. The generated code uses this clause where needed,
+    but its body must be defined by the user.
+
+    Lean only.
+
+    Inputs:
+    - function id: this is especially useful to identify whether the
+      function is an assumed function or a local function
+    - function basename
+    - the number of loops in the parent function. This is used for
+      the same purpose as in {!field:llbc_name}.
+    - loop identifier, if this is for a loop
+ *)
+let ctx_compute_decreases_proof_name (ctx : extraction_ctx)
+    (_fid : A.FunDeclId.id) (fname : llbc_name) (num_loops : int)
+    (loop_id : LoopId.id option) : string =
+  let fname = ctx_compute_fun_name_no_suffix ctx fname in
+  let lp_suffix = default_fun_loop_suffix num_loops loop_id in
+  (* Compute the suffix *)
+  let suffix =
+    match !Config.backend with
+    | Lean -> "_decreases"
+    | FStar | Coq | HOL4 -> raise (Failure "Unexpected")
+  in
+  (* Concatenate *)
+  fname ^ lp_suffix ^ suffix
+
+(** Generates a variable basename.
+
+    Inputs:
+    - the set of names used in the context so far
+    - the basename we got from the symbolic execution, if we have one
+    - the type of the variable (can be useful for heuristics, in order
+      not to always use "x" for instance, whenever naming anonymous
+      variables)
+
+    Note that once the formatter generated a basename, we add an index
+    if necessary to prevent name clashes: the burden of name clashes checks
+    is thus on the caller's side.
+ *)
+let ctx_compute_var_basename (ctx : extraction_ctx) (basename : string option)
+    (ty : ty) : string =
+  (* Small helper to derive var names from ADT type names.
+
+     We do the following:
+     - convert the type name to snake case
+     - take the first letter of every "letter group"
+     Ex.: "HashMap" -> "hash_map" -> "hm"
+  *)
+  let name_from_type_ident (name : string) : string =
+    let cl = to_snake_case name in
+    let cl = String.split_on_char '_' cl in
+    let cl = List.filter (fun s -> String.length s > 0) cl in
+    assert (List.length cl > 0);
+    let cl = List.map (fun s -> s.[0]) cl in
+    StringUtils.string_of_chars cl
+  in
+  (* If there is a basename, we use it *)
+  match basename with
+  | Some basename ->
+      (* This should be a no-op *)
+      to_snake_case basename
+  | None -> (
+      (* No basename: we use the first letter of the type *)
+      match ty with
+      | TAdt (type_id, generics) -> (
+          match type_id with
+          | TTuple ->
+              (* The "pair" case is frequent enough to have its special treatment *)
+              if List.length generics.types = 2 then "p" else "t"
+          | TAssumed TResult -> "r"
+          | TAssumed TError -> ConstStrings.error_basename
+          | TAssumed TFuel -> ConstStrings.fuel_basename
+          | TAssumed TArray -> "a"
+          | TAssumed TSlice -> "s"
+          | TAssumed TStr -> "s"
+          | TAssumed TState -> ConstStrings.state_basename
+          | TAssumed (TRawPtr _) -> "p"
+          | TAdtId adt_id ->
+              let def =
+                TypeDeclId.Map.find adt_id ctx.trans_ctx.type_ctx.type_decls
+              in
+              (* Derive the var name from the last ident of the type name
+                 Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm"
+              *)
+              (* The name shouldn't be empty, and its last element should
+               * be an ident *)
+              let cl = Collections.List.last def.name in
+              name_from_type_ident (TypesUtils.as_ident cl))
+      | TVar _ -> (
+          (* TODO: use "t" also for F* *)
+          match !backend with
+          | FStar -> "x" (* lacking inspiration here... *)
+          | Coq | Lean | HOL4 -> "t" (* lacking inspiration here... *))
+      | TLiteral lty -> (
+          match lty with TBool -> "b" | TChar -> "c" | TInteger _ -> "i")
+      | TArrow _ -> "f"
+      | TTraitType (_, _, name) -> name_from_type_ident name)
+
+(** Generates a type variable basename. *)
+let ctx_compute_type_var_basename (_ctx : extraction_ctx) (basename : string) :
+    string =
+  (* Rust type variables are snake-case and start with a capital letter *)
+  match !backend with
+  | FStar ->
+      (* This is *not* a no-op: this removes the capital letter *)
+      to_snake_case basename
+  | HOL4 ->
+      (* In HOL4, type variable names must start with "'" *)
+      "'" ^ to_snake_case basename
+  | Coq | Lean -> basename
+
+(** Generates a const generic variable basename. *)
+let ctx_compute_const_generic_var_basename (_ctx : extraction_ctx)
+    (basename : string) : string =
+  (* Rust type variables are snake-case and start with a capital letter *)
+  match !backend with
+  | FStar | HOL4 ->
+      (* This is *not* a no-op: this removes the capital letter *)
+      to_snake_case basename
+  | Coq | Lean -> basename
+
+(** Return a base name for a trait clause. We might add a suffix to prevent
+    collisions.
+
+    In the traduction we explicitely manipulate the trait clause instances,
+    that is we introduce one input variable for each trait clause.
+ *)
+let ctx_compute_trait_clause_basename (_ctx : extraction_ctx)
+    (_clause : trait_clause) : string =
+  (* TODO: actually use the clause to derive the name *)
+  "inst"
+
+let trait_self_clause_basename = "self_clause"
+
+(** Appends an index to a name - we use this to generate unique
+    names: when doing so, the role of the formatter is just to concatenate
+    indices to names, the responsability of finding a proper index is
+    delegated to helper functions.
+ *)
+let name_append_index (basename : string) (i : int) : string =
+  basename ^ string_of_int i
+
 (** Generate a unique type variable name and add it to the context *)
 let ctx_add_type_var (basename : string) (id : TypeVarId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
+  let name = ctx_compute_type_var_basename ctx basename in
   let name =
-    ctx.fmt.type_var_basename ctx.names_maps.names_map.names_set basename
-  in
-  let name =
-    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
-      name
+    basename_to_unique ctx.names_maps.names_map.names_set name_append_index name
   in
   let ctx = ctx_add (TypeVarId id) name ctx in
   (ctx, name)
@@ -966,13 +1739,9 @@ let ctx_add_type_var (basename : string) (id : TypeVarId.id)
 (** Generate a unique const generic variable name and add it to the context *)
 let ctx_add_const_generic_var (basename : string) (id : ConstGenericVarId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
+  let name = ctx_compute_const_generic_var_basename ctx basename in
   let name =
-    ctx.fmt.const_generic_var_basename ctx.names_maps.names_map.names_set
-      basename
-  in
-  let name =
-    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
-      name
+    basename_to_unique ctx.names_maps.names_map.names_set name_append_index name
   in
   let ctx = ctx_add (ConstGenericVarId id) name ctx in
   (ctx, name)
@@ -988,7 +1757,7 @@ let ctx_add_type_vars (vars : (string * TypeVarId.id) list)
 let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) :
     extraction_ctx * string =
   let name =
-    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
+    basename_to_unique ctx.names_maps.names_map.names_set name_append_index
       basename
   in
   let ctx = ctx_add (VarId id) name ctx in
@@ -996,9 +1765,9 @@ let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) :
 
 (** Generate a unique variable name for the trait self clause and add it to the context *)
 let ctx_add_trait_self_clause (ctx : extraction_ctx) : extraction_ctx * string =
-  let basename = ctx.fmt.trait_self_clause_basename in
+  let basename = trait_self_clause_basename in
   let name =
-    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
+    basename_to_unique ctx.names_maps.names_map.names_set name_append_index
       basename
   in
   let ctx = ctx_add TraitSelfClauseId name ctx in
@@ -1008,7 +1777,7 @@ let ctx_add_trait_self_clause (ctx : extraction_ctx) : extraction_ctx * string =
 let ctx_add_local_trait_clause (basename : string) (id : TraitClauseId.id)
     (ctx : extraction_ctx) : extraction_ctx * string =
   let name =
-    basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index
+    basename_to_unique ctx.names_maps.names_map.names_set name_append_index
       basename
   in
   let ctx = ctx_add (LocalTraitClauseId id) name ctx in
@@ -1019,9 +1788,7 @@ let ctx_add_vars (vars : var list) (ctx : extraction_ctx) :
     extraction_ctx * string list =
   List.fold_left_map
     (fun ctx (v : var) ->
-      let name =
-        ctx.fmt.var_basename ctx.names_maps.names_map.names_set v.basename v.ty
-      in
+      let name = ctx_compute_var_basename ctx v.basename v.ty in
       ctx_add_var name v.id ctx)
     ctx vars
 
@@ -1042,9 +1809,7 @@ let ctx_add_local_trait_clauses (clauses : trait_clause list)
     (ctx : extraction_ctx) : extraction_ctx * string list =
   List.fold_left_map
     (fun ctx (c : trait_clause) ->
-      let basename =
-        ctx.fmt.trait_clause_basename ctx.names_maps.names_map.names_set c
-      in
+      let basename = ctx_compute_trait_clause_basename ctx c in
       ctx_add_local_trait_clause basename c.clause_id ctx)
     ctx clauses
 
@@ -1064,7 +1829,7 @@ let ctx_add_generic_params (generics : generic_params) (ctx : extraction_ctx) :
 let ctx_add_decreases_proof (def : fun_decl) (ctx : extraction_ctx) :
     extraction_ctx =
   let name =
-    ctx.fmt.decreases_proof_name def.def_id def.llbc_name def.num_loops
+    ctx_compute_decreases_proof_name ctx def.def_id def.llbc_name def.num_loops
       def.loop_id
   in
   ctx_add (DecreasesProofId (FRegular def.def_id, def.loop_id)) name ctx
@@ -1072,8 +1837,8 @@ let ctx_add_decreases_proof (def : fun_decl) (ctx : extraction_ctx) :
 let ctx_add_termination_measure (def : fun_decl) (ctx : extraction_ctx) :
     extraction_ctx =
   let name =
-    ctx.fmt.termination_measure_name def.def_id def.llbc_name def.num_loops
-      def.loop_id
+    ctx_compute_termination_measure_name ctx def.def_id def.llbc_name
+      def.num_loops def.loop_id
   in
   ctx_add (TerminationMeasureId (FRegular def.def_id, def.loop_id)) name ctx
 
@@ -1091,7 +1856,7 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) :
       ctx_add decl name ctx
   | None ->
       (* Not the case: "standard" registration *)
-      let name = ctx.fmt.global_name def.name in
+      let name = ctx_compute_global_name ctx def.name in
       let body = FunId (FromLlbc (FunId (FRegular def.body), None, None)) in
       let ctx = ctx_add decl (name ^ "_c") ctx in
       let ctx = ctx_add body (name ^ "_body") ctx in
@@ -1123,8 +1888,8 @@ let ctx_compute_fun_name (trans_group : pure_fun_translation) (def : fun_decl)
         Some { id = rg_id; region_names }
   in
   (* Add the function name *)
-  ctx.fmt.fun_name def.llbc_name def.num_loops def.loop_id num_rgs rg_info
-    (keep_fwd, num_backs)
+  ctx_compute_fun_name ctx def.llbc_name def.num_loops def.loop_id num_rgs
+    rg_info (keep_fwd, num_backs)
 
 (* TODO: move to Extract *)
 let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
@@ -1148,156 +1913,6 @@ let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
         ctx.fun_name_info;
   }
 
-type names_map_init = {
-  keywords : string list;
-  assumed_adts : (assumed_ty * string) list;
-  assumed_structs : (assumed_ty * string) list;
-  assumed_variants : (assumed_ty * VariantId.id * string) list;
-  assumed_llbc_functions :
-    (A.assumed_fun_id * RegionGroupId.id option * string) list;
-  assumed_pure_functions : (pure_assumed_fun_id * string) list;
-}
-
-(** Initialize names maps with a proper set of keywords/names coming from the
-    target language/prover. *)
-let initialize_names_maps (fmt : formatter) (init : names_map_init) : names_maps
+let ctx_compute_type_decl_name (ctx : extraction_ctx) (def : type_decl) : string
     =
-  let int_names = List.map fmt.int_name T.all_int_types in
-  let keywords =
-    List.concat
-      [
-        [ fmt.bool_name; fmt.char_name; fmt.str_name ]; int_names; init.keywords;
-      ]
-  in
-  let names_set = StringSet.empty in
-  let name_to_id = StringMap.empty in
-  (* We fist initialize [id_to_name] as empty, because the id of a keyword is [UnknownId].
-   * Also note that we don't need this mapping for keywords: we insert keywords only
-   * to check collisions. *)
-  let id_to_name = IdMap.empty in
-  let names_map = { id_to_name; name_to_id; names_set } in
-  let unsafe_names_map = empty_unsafe_names_map in
-  let strict_names_map = empty_names_map in
-  (* For debugging - we are creating bindings for assumed types and functions, so
-   * it is ok if we simply use the "show" function (those aren't simply identified
-   * by numbers) *)
-  let id_to_string = show_id in
-  (* Add the keywords as strict collisions *)
-  let strict_names_map =
-    List.fold_left
-      (fun nm name ->
-        (* There is duplication in the keywords so we don't check the collisions
-           while registering them (what is important is that there are no collisions
-           between keywords and user-defined identifiers) *)
-        names_map_add_unchecked UnknownId name nm)
-      strict_names_map keywords
-  in
-  let nm = { names_map; unsafe_names_map; strict_names_map } in
-  (* Then we add:
-   * - the assumed types
-   * - the assumed struct constructors
-   * - the assumed variants
-   * - the assumed functions
-   *)
-  let nm =
-    List.fold_left
-      (fun nm (type_id, name) ->
-        names_maps_add_assumed_type id_to_string type_id name nm)
-      nm init.assumed_adts
-  in
-  let nm =
-    List.fold_left
-      (fun nm (type_id, name) ->
-        names_maps_add_assumed_struct id_to_string type_id name nm)
-      nm init.assumed_structs
-  in
-  let nm =
-    List.fold_left
-      (fun nm (type_id, variant_id, name) ->
-        names_maps_add_assumed_variant id_to_string type_id variant_id name nm)
-      nm init.assumed_variants
-  in
-  let assumed_functions =
-    List.map
-      (fun (fid, rg, name) ->
-        (FromLlbc (Pure.FunId (FAssumed fid), None, rg), name))
-      init.assumed_llbc_functions
-    @ List.map (fun (fid, name) -> (Pure fid, name)) init.assumed_pure_functions
-  in
-  let nm =
-    List.fold_left
-      (fun nm (fid, name) -> names_maps_add_function id_to_string fid name nm)
-      nm assumed_functions
-  in
-  (* Return *)
-  nm
-
-let compute_type_decl_name (fmt : formatter) (def : type_decl) : string =
-  fmt.type_name def.llbc_name
-
-(** Helper function: generate a suffix for a function name, i.e., generates
-    a suffix like "_loop", "loop1", etc. to append to a function name.
- *)
-let default_fun_loop_suffix (num_loops : int) (loop_id : LoopId.id option) :
-    string =
-  match loop_id with
-  | None -> ""
-  | Some loop_id ->
-      (* If this is for a loop, generally speaking, we append the loop index.
-         If this function admits only one loop, we omit it. *)
-      if num_loops = 1 then "_loop" else "_loop" ^ LoopId.to_string loop_id
-
-(** A helper function: generates a function suffix from a region group
-    information.
-    TODO: move all those helpers.
-*)
-let default_fun_suffix (num_loops : int) (loop_id : LoopId.id option)
-    (num_region_groups : int) (rg : region_group_info option)
-    ((keep_fwd, num_backs) : bool * int) : string =
-  let lp_suff = default_fun_loop_suffix num_loops loop_id in
-
-  (* There are several cases:
-     - [rg] is [Some]: this is a forward function:
-       - we add "_fwd"
-     - [rg] is [None]: this is a backward function:
-       - this function has one extracted backward function:
-         - if the forward function has been filtered, we add "_fwd_back":
-           the forward function is useless, so the unique backward function
-           takes its place, in a way
-         - otherwise we add "_back"
-       - this function has several backward functions: we add "_back" and an
-         additional suffix to identify the precise backward function
-     Note that we always add a suffix (in case there are no region groups,
-     we could not add the "_fwd" suffix) to prevent name clashes between
-     definitions (in particular between type and function definitions).
-  *)
-  let rg_suff =
-    (* TODO: make all the backends match what is done for Lean *)
-    match rg with
-    | None ->
-        if
-          (* In order to avoid name conflicts:
-           * - if the forward is eliminated, we add the suffix "_fwd" (it won't be used)
-           * - otherwise, no suffix (because the backward functions will have a suffix)
-           *)
-          num_backs = 1 && not keep_fwd
-        then "_fwd"
-        else ""
-    | Some rg ->
-        assert (num_region_groups > 0 && num_backs > 0);
-        if num_backs = 1 then
-          (* Exactly one backward function *)
-          if not keep_fwd then "" else "_back"
-        else if
-          (* Several region groups/backward functions:
-             - if all the regions in the group have names, we use those names
-             - otherwise we use an index
-          *)
-          List.for_all Option.is_some rg.region_names
-        then
-          (* Concatenate the region names *)
-          "_back" ^ String.concat "" (List.map Option.get rg.region_names)
-        else (* Use the region index *)
-          "_back" ^ RegionGroupId.to_string rg.id
-  in
-  lp_suff ^ rg_suff
+  ctx_compute_type_name ctx def.llbc_name
diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml
index b0a5159f..ef746ddf 100644
--- a/compiler/ExtractBuiltin.ml
+++ b/compiler/ExtractBuiltin.ml
@@ -26,6 +26,11 @@ let mk_memoized (f : unit -> 'a) : unit -> 'a =
 let split_on_separator (s : string) : string list =
   Str.split (Str.regexp "\\(::\\|\\.\\)") s
 
+let flatten_name (name : string list) : string =
+  match !backend with
+  | FStar | Coq | HOL4 -> String.concat "_" name
+  | Lean -> String.concat "." name
+
 let () =
   assert (split_on_separator "x::y::z" = [ "x"; "y"; "z" ]);
   assert (split_on_separator "x.y.z" = [ "x"; "y"; "z" ])
@@ -124,10 +129,7 @@ let mk_struct_constructor (type_name : string) : string =
 let builtin_types () : builtin_type_info list =
   let mk_type (rust_name : string) ?(keep_params : bool list option = None)
       ?(kind : type_variant_kind = KOpaque) () : builtin_type_info =
-    let extract_name =
-      let sep = backend_choice "_" "." in
-      String.concat sep (split_on_separator rust_name)
-    in
+    let extract_name = flatten_name (split_on_separator rust_name) in
     let body_info : builtin_type_body_info option =
       match kind with
       | KOpaque -> None
@@ -231,11 +233,7 @@ let builtin_funs () : (pattern * bool list option * builtin_fun_info list) list
       | None -> pattern_to_fun_extract_name rust_name
       | Some name -> split_on_separator name
     in
-    let basename =
-      match !backend with
-      | FStar | Coq | HOL4 -> String.concat "_" extract_name
-      | Lean -> String.concat "." extract_name
-    in
+    let basename = flatten_name extract_name in
     let fwd_suffix = if with_back && back_no_suffix then "_fwd" else "" in
     let fwd = [ { rg = None; extract_name = basename ^ fwd_suffix } ] in
     let back_suffix = if with_back && back_no_suffix then "" else "_back" in
@@ -400,11 +398,9 @@ let builtin_trait_decls_info () =
     let extract_name =
       match extract_name with
       | Some n -> n
-      | None -> (
+      | None ->
           let rust_name = pattern_to_fun_extract_name rust_name in
-          match !backend with
-          | Coq | FStar | HOL4 -> String.concat "_" rust_name
-          | Lean -> String.concat "." rust_name)
+          flatten_name rust_name
     in
     let constructor = mk_struct_constructor extract_name in
     let consts = [] in
@@ -502,13 +498,12 @@ let builtin_trait_impls_info () : (pattern * (bool list option * string)) list =
       pattern * (bool list option * string) =
     let rust_name = parse_pattern rust_name in
     let name =
-      let sep = backend_choice "_" "." in
       let name =
         match extract_name with
         | None -> pattern_to_trait_impl_extract_name rust_name
         | Some name -> split_on_separator name
       in
-      String.concat sep name
+      flatten_name name
     in
     (rust_name, (filter, name))
   in
diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml
index 3a81e6fe..c9be5abe 100644
--- a/compiler/ExtractTypes.ml
+++ b/compiler/ExtractTypes.ml
@@ -6,354 +6,88 @@
 open Pure
 open PureUtils
 open TranslateCore
-open ExtractBase
-open StringUtils
 open Config
-module F = Format
+include ExtractBase
 
-(** Small helper to compute the name of an int type *)
-let int_name (int_ty : integer_type) =
-  let isize, usize, i_format, u_format =
-    match !backend with
-    | FStar | Coq | HOL4 ->
-        ("isize", "usize", format_of_string "i%d", format_of_string "u%d")
-    | Lean -> ("Isize", "Usize", format_of_string "I%d", format_of_string "U%d")
-  in
-  match int_ty with
-  | Isize -> isize
-  | I8 -> Printf.sprintf i_format 8
-  | I16 -> Printf.sprintf i_format 16
-  | I32 -> Printf.sprintf i_format 32
-  | I64 -> Printf.sprintf i_format 64
-  | I128 -> Printf.sprintf i_format 128
-  | Usize -> usize
-  | U8 -> Printf.sprintf u_format 8
-  | U16 -> Printf.sprintf u_format 16
-  | U32 -> Printf.sprintf u_format 32
-  | U64 -> Printf.sprintf u_format 64
-  | U128 -> Printf.sprintf u_format 128
-
-(** Small helper to compute the name of a unary operation *)
-let unop_name (unop : unop) : string =
-  match unop with
-  | Not -> (
-      match !backend with FStar | Lean -> "not" | Coq -> "negb" | HOL4 -> "~")
-  | Neg (int_ty : integer_type) -> (
-      match !backend with Lean -> "-" | _ -> int_name int_ty ^ "_neg")
-  | Cast _ ->
-      (* We never directly use the unop name in this case *)
-      raise (Failure "Unsupported")
-
-(** Small helper to compute the name of a binary operation (note that many
-    binary operations like "less than" are extracted to primitive operations,
-    like [<]).
- *)
-let named_binop_name (binop : E.binop) (int_ty : integer_type) : string =
-  let binop =
-    match binop with
-    | Div -> "div"
-    | Rem -> "rem"
-    | Add -> "add"
-    | Sub -> "sub"
-    | Mul -> "mul"
-    | Lt -> "lt"
-    | Le -> "le"
-    | Ge -> "ge"
-    | Gt -> "gt"
-    | BitXor -> "xor"
-    | BitAnd -> "and"
-    | BitOr -> "or"
-    | Shl -> "lsl"
-    | Shr ->
-        "asr"
-        (* NOTE: make sure arithmetic shift right is implemented, i.e. OCaml's asr operator, not lsr *)
-    | _ -> raise (Failure "Unreachable")
-  in
-  (* Remark: the Lean case is actually not used *)
-  match !backend with
-  | Lean -> int_name int_ty ^ "." ^ binop
-  | FStar | Coq | HOL4 -> int_name int_ty ^ "_" ^ binop
+(** Format a constant value.
 
-(** A list of keywords/identifiers used by the backend and with which we
-    want to check collision.
-
-    Remark: this is useful mostly to look for collisions when generating
-    names for *variables*.
+    Inputs:
+    - formatter
+    - [inside]: if [true], the value should be wrapped in parentheses
+      if it is made of an application (ex.: [U32 3])
+    - the constant value
  *)
-let keywords () =
-  let named_unops =
-    unop_name Not
-    :: List.map (fun it -> unop_name (Neg it)) T.all_signed_int_types
-  in
-  let named_binops = [ E.Div; Rem; Add; Sub; Mul ] in
-  let named_binops =
-    List.concat_map
-      (fun bn -> List.map (fun it -> named_binop_name bn it) T.all_int_types)
-      named_binops
-  in
-  let misc =
-    match !backend with
-    | FStar ->
-        [
-          "assert";
-          "assert_norm";
-          "assume";
-          "else";
-          "fun";
-          "fn";
-          "FStar";
-          "FStar.Mul";
-          "if";
-          "in";
-          "include";
-          "int";
-          "let";
-          "list";
-          "match";
-          "open";
-          "rec";
-          "scalar_cast";
-          "then";
-          "type";
-          "Type0";
-          "Type";
-          "unit";
-          "val";
-          "with";
-        ]
-    | Coq ->
-        [
-          "assert";
-          "Arguments";
-          "Axiom";
-          "char_of_byte";
-          "Check";
-          "Declare";
-          "Definition";
-          "else";
-          "End";
-          "fun";
-          "Fixpoint";
-          "if";
-          "in";
-          "int";
-          "Inductive";
-          "Import";
-          "let";
-          "Lemma";
-          "match";
-          "Module";
-          "not";
-          "Notation";
-          "Proof";
-          "Qed";
-          "rec";
-          "Record";
-          "Require";
-          "Scope";
-          "Search";
-          "SearchPattern";
-          "Set";
-          "then";
-          (* [tt] is unit *)
-          "tt";
-          "type";
-          "Type";
-          "unit";
-          "with";
-        ]
-    | Lean ->
-        [
-          "by";
-          "class";
-          "decreasing_by";
-          "def";
-          "deriving";
-          "do";
-          "else";
-          "end";
-          "for";
-          "have";
-          "if";
-          "inductive";
-          "instance";
-          "import";
-          "let";
-          "macro";
-          "match";
-          "namespace";
-          "opaque";
-          "open";
-          "run_cmd";
-          "set_option";
-          "simp";
-          "structure";
-          "syntax";
-          "termination_by";
-          "then";
-          "Type";
-          "unsafe";
-          "where";
-          "with";
-          "opaque_defs";
-        ]
-    | HOL4 ->
-        [
-          "Axiom";
-          "case";
-          "Definition";
-          "else";
-          "End";
-          "fix";
-          "fix_exec";
-          "fn";
-          "fun";
-          "if";
-          "in";
-          "int";
-          "Inductive";
-          "let";
-          "of";
-          "Proof";
-          "QED";
-          "then";
-          "Theorem";
-        ]
-  in
-  List.concat [ named_unops; named_binops; misc ]
+let extract_literal (fmt : F.formatter) (inside : bool) (cv : literal) : unit =
+  match cv with
+  | VScalar sv -> (
+      match !backend with
+      | FStar -> F.pp_print_string fmt (Z.to_string sv.value)
+      | Coq | HOL4 | Lean ->
+          let print_brackets = inside && !backend = HOL4 in
+          if print_brackets then F.pp_print_string fmt "(";
+          (match !backend with
+          | Coq | Lean -> ()
+          | HOL4 ->
+              F.pp_print_string fmt ("int_to_" ^ int_name sv.int_ty);
+              F.pp_print_space fmt ()
+          | _ -> raise (Failure "Unreachable"));
+          (* We need to add parentheses if the value is negative *)
+          if sv.value >= Z.of_int 0 then
+            F.pp_print_string fmt (Z.to_string sv.value)
+          else if !backend = Lean then
+            (* TODO: parsing issues with Lean because there are ambiguous
+               interpretations between int values and nat values *)
+            F.pp_print_string fmt
+              ("(-(" ^ Z.to_string (Z.neg sv.value) ^ ":Int))")
+          else F.pp_print_string fmt ("(" ^ Z.to_string sv.value ^ ")");
+          (match !backend with
+          | Coq ->
+              let iname = int_name sv.int_ty in
+              F.pp_print_string fmt ("%" ^ iname)
+          | Lean ->
+              let iname = String.lowercase_ascii (int_name sv.int_ty) in
+              F.pp_print_string fmt ("#" ^ iname)
+          | HOL4 -> ()
+          | _ -> raise (Failure "Unreachable"));
+          if print_brackets then F.pp_print_string fmt ")")
+  | VBool b ->
+      let b =
+        match !backend with
+        | HOL4 -> if b then "T" else "F"
+        | Coq | FStar | Lean -> if b then "true" else "false"
+      in
+      F.pp_print_string fmt b
+  | VChar c -> (
+      match !backend with
+      | HOL4 ->
+          (* [#"a"] is a notation for [CHR 97] (97 is the ASCII code for 'a') *)
+          F.pp_print_string fmt ("#\"" ^ String.make 1 c ^ "\"")
+      | FStar | Lean -> F.pp_print_string fmt ("'" ^ String.make 1 c ^ "'")
+      | Coq ->
+          if inside then F.pp_print_string fmt "(";
+          F.pp_print_string fmt "char_of_byte";
+          F.pp_print_space fmt ();
+          (* Convert the the char to ascii *)
+          let c =
+            let i = Char.code c in
+            let x0 = i / 16 in
+            let x1 = i mod 16 in
+            "Coq.Init.Byte.x" ^ string_of_int x0 ^ string_of_int x1
+          in
+          F.pp_print_string fmt c;
+          if inside then F.pp_print_string fmt ")")
 
-let assumed_adts () : (assumed_ty * string) list =
-  match !backend with
-  | Lean ->
-      [
-        (TState, "State");
-        (TResult, "Result");
-        (TError, "Error");
-        (TFuel, "Nat");
-        (TArray, "Array");
-        (TSlice, "Slice");
-        (TStr, "Str");
-        (TRawPtr Mut, "MutRawPtr");
-        (TRawPtr Const, "ConstRawPtr");
-      ]
-  | Coq | FStar | HOL4 ->
-      [
-        (TState, "state");
-        (TResult, "result");
-        (TError, "error");
-        (TFuel, if !backend = HOL4 then "num" else "nat");
-        (TArray, "array");
-        (TSlice, "slice");
-        (TStr, "str");
-        (TRawPtr Mut, "mut_raw_ptr");
-        (TRawPtr Const, "const_raw_ptr");
-      ]
-
-let assumed_struct_constructors () : (assumed_ty * string) list =
-  match !backend with
-  | Lean -> [ (TArray, "Array.make") ]
-  | Coq -> [ (TArray, "mk_array") ]
-  | FStar -> [ (TArray, "mk_array") ]
-  | HOL4 -> [ (TArray, "mk_array") ]
-
-let assumed_variants () : (assumed_ty * VariantId.id * string) list =
-  match !backend with
-  | FStar ->
-      [
-        (TResult, result_return_id, "Return");
-        (TResult, result_fail_id, "Fail");
-        (TError, error_failure_id, "Failure");
-        (TError, error_out_of_fuel_id, "OutOfFuel");
-        (* No Fuel::Zero on purpose *)
-        (* No Fuel::Succ on purpose *)
-      ]
-  | Coq ->
-      [
-        (TResult, result_return_id, "Return");
-        (TResult, result_fail_id, "Fail_");
-        (TError, error_failure_id, "Failure");
-        (TError, error_out_of_fuel_id, "OutOfFuel");
-        (TFuel, fuel_zero_id, "O");
-        (TFuel, fuel_succ_id, "S");
-      ]
-  | Lean ->
-      [
-        (TResult, result_return_id, "ret");
-        (TResult, result_fail_id, "fail");
-        (TError, error_failure_id, "panic");
-        (* No Fuel::Zero on purpose *)
-        (* No Fuel::Succ on purpose *)
-      ]
-  | HOL4 ->
-      [
-        (TResult, result_return_id, "Return");
-        (TResult, result_fail_id, "Fail");
-        (TError, error_failure_id, "Failure");
-        (* No Fuel::Zero on purpose *)
-        (* No Fuel::Succ on purpose *)
-      ]
-
-let assumed_llbc_functions () :
-    (A.assumed_fun_id * T.RegionGroupId.id option * string) list =
-  let rg0 = Some T.RegionGroupId.zero in
-  match !backend with
-  | FStar | Coq | HOL4 ->
-      [
-        (ArrayIndexShared, None, "array_index_usize");
-        (ArrayIndexMut, None, "array_index_usize");
-        (ArrayIndexMut, rg0, "array_update_usize");
-        (ArrayToSliceShared, None, "array_to_slice");
-        (ArrayToSliceMut, None, "array_to_slice");
-        (ArrayToSliceMut, rg0, "array_from_slice");
-        (ArrayRepeat, None, "array_repeat");
-        (SliceIndexShared, None, "slice_index_usize");
-        (SliceIndexMut, None, "slice_index_usize");
-        (SliceIndexMut, rg0, "slice_update_usize");
-      ]
-  | Lean ->
-      [
-        (ArrayIndexShared, None, "Array.index_usize");
-        (ArrayIndexMut, None, "Array.index_usize");
-        (ArrayIndexMut, rg0, "Array.update_usize");
-        (ArrayToSliceShared, None, "Array.to_slice");
-        (ArrayToSliceMut, None, "Array.to_slice");
-        (ArrayToSliceMut, rg0, "Array.from_slice");
-        (ArrayRepeat, None, "Array.repeat");
-        (SliceIndexShared, None, "Slice.index_usize");
-        (SliceIndexMut, None, "Slice.index_usize");
-        (SliceIndexMut, rg0, "Slice.update_usize");
-      ]
-
-let assumed_pure_functions () : (pure_assumed_fun_id * string) list =
-  match !backend with
-  | FStar ->
-      [
-        (Return, "return");
-        (Fail, "fail");
-        (Assert, "massert");
-        (FuelDecrease, "decrease");
-        (FuelEqZero, "is_zero");
-      ]
-  | Coq ->
-      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
-      [ (Return, "return_"); (Fail, "fail_"); (Assert, "massert") ]
-  | Lean ->
-      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
-      [ (Return, "return"); (Fail, "fail_"); (Assert, "massert") ]
-  | HOL4 ->
-      (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *)
-      [ (Return, "return"); (Fail, "fail"); (Assert, "massert") ]
-
-let names_map_init () : names_map_init =
-  {
-    keywords = keywords ();
-    assumed_adts = assumed_adts ();
-    assumed_structs = assumed_struct_constructors ();
-    assumed_variants = assumed_variants ();
-    assumed_llbc_functions = assumed_llbc_functions ();
-    assumed_pure_functions = assumed_pure_functions ();
-  }
+(** Format a unary operation
 
+    Inputs:
+    - a formatter for expressions (called on the argument of the unop)
+    - extraction context (see below)
+    - formatter
+    - expression formatter
+    - [inside]
+    - unop
+    - argument
+ *)
 let extract_unop (extract_expr : bool -> texpression -> unit)
     (fmt : F.formatter) (inside : bool) (unop : unop) (arg : texpression) : unit
     =
@@ -409,7 +143,18 @@ let extract_unop (extract_expr : bool -> texpression -> unit)
           extract_expr true arg;
           if inside then F.pp_print_string fmt ")")
 
-(** [extract_expr] : the boolean argument is [inside] *)
+(** Format a binary operation
+
+    Inputs:
+    - a formatter for expressions (called on the arguments of the binop)
+    - extraction context (see below)
+    - formatter
+    - expression formatter
+    - [inside]
+    - binop
+    - argument 0
+    - argument 1
+ *)
 let extract_binop (extract_expr : bool -> texpression -> unit)
     (fmt : F.formatter) (inside : bool) (binop : E.binop)
     (int_ty : integer_type) (arg0 : texpression) (arg1 : texpression) : unit =
@@ -451,523 +196,6 @@ let extract_binop (extract_expr : bool -> texpression -> unit)
       extract_expr true arg1);
   if inside then F.pp_print_string fmt ")"
 
-let type_decl_kind_to_qualif (kind : decl_kind)
-    (type_kind : type_decl_kind option) : string option =
-  match !backend with
-  | FStar -> (
-      match kind with
-      | SingleNonRec -> Some "type"
-      | SingleRec -> Some "type"
-      | MutRecFirst -> Some "type"
-      | MutRecInner -> Some "and"
-      | MutRecLast -> Some "and"
-      | Assumed -> Some "assume type"
-      | Declared -> Some "val")
-  | Coq -> (
-      match (kind, type_kind) with
-      | SingleNonRec, Some Enum -> Some "Inductive"
-      | SingleNonRec, Some Struct -> Some "Record"
-      | (SingleRec | MutRecFirst), Some _ -> Some "Inductive"
-      | (MutRecInner | MutRecLast), Some _ ->
-          (* Coq doesn't support groups of mutually recursive definitions which mix
-           * records and inducties: we convert everything to records if this happens
-           *)
-          Some "with"
-      | (Assumed | Declared), None -> Some "Axiom"
-      | SingleNonRec, None ->
-          (* This is for traits *)
-          Some "Record"
-      | _ ->
-          raise
-            (Failure
-               ("Unexpected: (" ^ show_decl_kind kind ^ ", "
-               ^ Print.option_to_string show_type_decl_kind type_kind
-               ^ ")")))
-  | Lean -> (
-      match kind with
-      | SingleNonRec ->
-          if type_kind = Some Struct then Some "structure" else Some "inductive"
-      | SingleRec -> Some "inductive"
-      | MutRecFirst -> Some "inductive"
-      | MutRecInner -> Some "inductive"
-      | MutRecLast -> Some "inductive"
-      | Assumed -> Some "axiom"
-      | Declared -> Some "axiom")
-  | HOL4 -> None
-
-let fun_decl_kind_to_qualif (kind : decl_kind) : string option =
-  match !backend with
-  | FStar -> (
-      match kind with
-      | SingleNonRec -> Some "let"
-      | SingleRec -> Some "let rec"
-      | MutRecFirst -> Some "let rec"
-      | MutRecInner -> Some "and"
-      | MutRecLast -> Some "and"
-      | Assumed -> Some "assume val"
-      | Declared -> Some "val")
-  | Coq -> (
-      match kind with
-      | SingleNonRec -> Some "Definition"
-      | SingleRec -> Some "Fixpoint"
-      | MutRecFirst -> Some "Fixpoint"
-      | MutRecInner -> Some "with"
-      | MutRecLast -> Some "with"
-      | Assumed -> Some "Axiom"
-      | Declared -> Some "Axiom")
-  | Lean -> (
-      match kind with
-      | SingleNonRec -> Some "def"
-      | SingleRec -> Some "divergent def"
-      | MutRecFirst -> Some "mutual divergent def"
-      | MutRecInner -> Some "divergent def"
-      | MutRecLast -> Some "divergent def"
-      | Assumed -> Some "axiom"
-      | Declared -> Some "axiom")
-  | HOL4 -> None
-
-(** The type of types.
-
-    TODO: move inside the formatter?
- *)
-let type_keyword () =
-  match !backend with
-  | FStar -> "Type0"
-  | Coq | Lean -> "Type"
-  | HOL4 -> raise (Failure "Unexpected")
-
-let name_last_elem_as_ident (n : llbc_name) : string =
-  match Collections.List.last n with
-  | PeIdent (s, _) -> s
-  | PeImpl _ -> raise (Failure "Unexpected")
-
-(**
-   [ctx]: we use the context to lookup type definitions, to retrieve type names.
-   This is used to compute variable names, when they have no basenames: in this
-   case we use the first letter of the type name.
-
-   [variant_concatenate_type_name]: if true, add the type name as a prefix
-   to the variant names.
-   Ex.:
-   In Rust:
-     {[
-       enum List = {
-         Cons(u32, Box<List>),x
-         Nil,
-       }
-     ]}
-
-   F*, if option activated:
-     {[
-       type list =
-       | ListCons : u32 -> list -> list
-       | ListNil : list
-     ]}
-
-   F*, if option not activated:
-     {[
-       type list =
-       | Cons : u32 -> list -> list
-       | Nil : list
-     ]}
-
-   Rk.: this should be true by default, because in Rust all the variant names
-   are actively uniquely identifier by the type name [List::Cons(...)], while
-   in other languages it is not necessarily the case, and thus clashes can mess
-   up type checking. Note that some languages actually forbids the name clashes
-   (it is the case of F* ).
- *)
-let mk_formatter (ctx : trans_ctx) (crate_name : string)
-    (variant_concatenate_type_name : bool) : formatter =
-  let int_name = int_name in
-
-  (* Prepare a name.
-     The first id elem is always the crate: if it is the local crate,
-     we remove it. We ignore disambiguators (there may be collisions, but we
-     check if there are).
-  *)
-  let name_to_simple_name (name : llbc_name) : string list =
-    (* Rmk.: initially we only filtered the disambiguators equal to 0 *)
-    match name with
-    | (PeIdent (crate, _) as id) :: name ->
-        let name = if crate = crate_name then name else id :: name in
-        name_to_simple_name ctx name
-    | _ ->
-        raise
-          (Failure
-             ("Unexpected name shape: " ^ TranslateCore.name_to_string ctx name))
-  in
-  let flatten_name (name : string list) : string =
-    match !backend with
-    | FStar | Coq | HOL4 -> String.concat "_" name
-    | Lean -> String.concat "." name
-  in
-  let get_name name : string list = name_to_simple_name name in
-  let get_type_name = get_name in
-  let get_type_name_no_suffix name =
-    match !backend with
-    | FStar | Coq | HOL4 -> String.concat "_" (get_type_name name)
-    | Lean -> String.concat "." (get_type_name name)
-  in
-  let type_name name =
-    match !backend with
-    | FStar ->
-        StringUtils.lowercase_first_letter (get_type_name_no_suffix name ^ "_t")
-    | Coq | HOL4 -> get_type_name_no_suffix name ^ "_t"
-    | Lean -> get_type_name_no_suffix name
-  in
-  let field_name (def_name : llbc_name) (field_id : FieldId.id)
-      (field_name : string option) : string =
-    let field_name_s =
-      match field_name with
-      | Some field_name -> field_name
-      | None ->
-          (* TODO: extract structs with no field names to tuples *)
-          FieldId.to_string field_id
-    in
-    if !Config.record_fields_short_names then
-      if field_name = None then (* TODO: this is a bit ugly *)
-        "_" ^ field_name_s
-      else field_name_s
-    else
-      let def_name = get_type_name_no_suffix def_name ^ "_" ^ field_name_s in
-      match !backend with
-      | Lean | HOL4 -> def_name
-      | Coq | FStar -> StringUtils.lowercase_first_letter def_name
-  in
-  let variant_name (def_name : llbc_name) (variant : string) : string =
-    match !backend with
-    | FStar | Coq | HOL4 ->
-        let variant = to_camel_case variant in
-        if variant_concatenate_type_name then
-          StringUtils.capitalize_first_letter
-            (get_type_name_no_suffix def_name ^ "_" ^ variant)
-        else variant
-    | Lean -> variant
-  in
-  let struct_constructor (basename : llbc_name) : string =
-    let tname = type_name basename in
-    ExtractBuiltin.mk_struct_constructor tname
-  in
-  let get_fun_name fname =
-    let fname = get_name fname in
-    (* TODO: don't convert to snake case for Coq, HOL4, F* *)
-    let fname = flatten_name fname in
-    match !backend with
-    | FStar | Coq | HOL4 -> StringUtils.lowercase_first_letter fname
-    | Lean -> fname
-  in
-  let global_name (name : llbc_name) : string =
-    (* Converting to snake case also lowercases the letters (in Rust, global
-     * names are written in capital letters). *)
-    let parts = List.map to_snake_case (get_name name) in
-    String.concat "_" parts
-  in
-  let fun_name (fname : llbc_name) (num_loops : int)
-      (loop_id : LoopId.id option) (num_rgs : int)
-      (rg : region_group_info option) (filter_info : bool * int) : string =
-    let fname = get_fun_name fname in
-    (* Compute the suffix *)
-    let suffix = default_fun_suffix num_loops loop_id num_rgs rg filter_info in
-    (* Concatenate *)
-    fname ^ suffix
-  in
-
-  let trait_decl_name (trait_decl : trait_decl) : string =
-    type_name trait_decl.llbc_name
-  in
-
-  let trait_impl_name (trait_decl : trait_decl) (trait_impl : trait_impl) :
-      string =
-    (* We derive the trait impl name from the implemented trait.
-       For instance, if this implementation is an instance of `trait::Trait`
-       for `<foo::Foo, u32>`, we generate the name: "trait.TraitFooFooU32Inst".
-       Importantly, it is to be noted that the name is independent of the place
-       where the instance has been defined (it is indepedent of the file, etc.).
-    *)
-    let name =
-      (* We need to lookup the LLBC definitions, to have the original instantiation *)
-      let trait_impl =
-        TraitImplId.Map.find trait_impl.def_id ctx.trait_impls_ctx.trait_impls
-      in
-      let params = trait_impl.generics in
-      let args = trait_impl.impl_trait.decl_generics in
-      name_with_generics_to_simple_name ctx trait_decl.llbc_name params args
-    in
-    let name = flatten_name name in
-    match !backend with
-    | FStar -> StringUtils.lowercase_first_letter name
-    | Coq | HOL4 | Lean -> name
-  in
-
-  let trait_decl_constructor (trait_decl : trait_decl) : string =
-    let name = trait_decl_name trait_decl in
-    ExtractBuiltin.mk_struct_constructor name
-  in
-
-  let trait_parent_clause_name (trait_decl : trait_decl) (clause : trait_clause)
-      : string =
-    (* TODO: improve - it would be better to not use indices *)
-    let clause = "parent_clause_" ^ TraitClauseId.to_string clause.clause_id in
-    if !Config.record_fields_short_names then clause
-    else trait_decl_name trait_decl ^ "_" ^ clause
-  in
-  let trait_type_name (trait_decl : trait_decl) (item : string) : string =
-    let name =
-      if !Config.record_fields_short_names then item
-      else trait_decl_name trait_decl ^ "_" ^ item
-    in
-    (* Constants are usually all capital letters.
-       Some backends do not support field names starting with a capital letter,
-       and it may be weird to lowercase everything (especially as it may lead
-       to more name collisions): we add a prefix when necessary.
-       For instance, it gives: "U" -> "tU"
-       Note that for some backends we prepend the type name (because those backends
-       can't disambiguate fields coming from different ADTs if they have the same
-       names), and thus don't need to add a prefix starting with a lowercase.
-    *)
-    match !backend with FStar -> "t" ^ name | Coq | Lean | HOL4 -> name
-  in
-  let trait_const_name (trait_decl : trait_decl) (item : string) : string =
-    let name =
-      if !Config.record_fields_short_names then item
-      else trait_decl_name trait_decl ^ "_" ^ item
-    in
-    (* See [trait_type_name] *)
-    match !backend with FStar -> "c" ^ name | Coq | Lean | HOL4 -> name
-  in
-  let trait_method_name (trait_decl : trait_decl) (item : string) : string =
-    if !Config.record_fields_short_names then item
-    else trait_decl_name trait_decl ^ "_" ^ item
-  in
-  let trait_type_clause_name (trait_decl : trait_decl) (item : string)
-      (clause : trait_clause) : string =
-    (* TODO: improve - it would be better to not use indices *)
-    trait_type_name trait_decl item
-    ^ "_clause_"
-    ^ TraitClauseId.to_string clause.clause_id
-  in
-
-  let termination_measure_name (_fid : A.FunDeclId.id) (fname : llbc_name)
-      (num_loops : int) (loop_id : LoopId.id option) : string =
-    let fname = get_fun_name fname in
-    let lp_suffix = default_fun_loop_suffix num_loops loop_id in
-    (* Compute the suffix *)
-    let suffix =
-      match !Config.backend with
-      | FStar -> "_decreases"
-      | Lean -> "_terminates"
-      | Coq | HOL4 -> raise (Failure "Unexpected")
-    in
-    (* Concatenate *)
-    fname ^ lp_suffix ^ suffix
-  in
-
-  let decreases_proof_name (_fid : A.FunDeclId.id) (fname : llbc_name)
-      (num_loops : int) (loop_id : LoopId.id option) : string =
-    let fname = get_fun_name fname in
-    let lp_suffix = default_fun_loop_suffix num_loops loop_id in
-    (* Compute the suffix *)
-    let suffix =
-      match !Config.backend with
-      | Lean -> "_decreases"
-      | FStar | Coq | HOL4 -> raise (Failure "Unexpected")
-    in
-    (* Concatenate *)
-    fname ^ lp_suffix ^ suffix
-  in
-
-  let var_basename (_varset : StringSet.t) (basename : string option) (ty : ty)
-      : string =
-    (* Small helper to derive var names from ADT type names.
-
-       We do the following:
-       - convert the type name to snake case
-       - take the first letter of every "letter group"
-       Ex.: "HashMap" -> "hash_map" -> "hm"
-    *)
-    let name_from_type_ident (name : string) : string =
-      let cl = to_snake_case name in
-      let cl = String.split_on_char '_' cl in
-      let cl = List.filter (fun s -> String.length s > 0) cl in
-      assert (List.length cl > 0);
-      let cl = List.map (fun s -> s.[0]) cl in
-      StringUtils.string_of_chars cl
-    in
-    (* If there is a basename, we use it *)
-    match basename with
-    | Some basename ->
-        (* This should be a no-op *)
-        to_snake_case basename
-    | None -> (
-        (* No basename: we use the first letter of the type *)
-        match ty with
-        | TAdt (type_id, generics) -> (
-            match type_id with
-            | TTuple ->
-                (* The "pair" case is frequent enough to have its special treatment *)
-                if List.length generics.types = 2 then "p" else "t"
-            | TAssumed TResult -> "r"
-            | TAssumed TError -> ConstStrings.error_basename
-            | TAssumed TFuel -> ConstStrings.fuel_basename
-            | TAssumed TArray -> "a"
-            | TAssumed TSlice -> "s"
-            | TAssumed TStr -> "s"
-            | TAssumed TState -> ConstStrings.state_basename
-            | TAssumed (TRawPtr _) -> "p"
-            | TAdtId adt_id ->
-                let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in
-                (* Derive the var name from the last ident of the type name
-                   Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm"
-                *)
-                (* The name shouldn't be empty, and its last element should
-                 * be an ident *)
-                let cl = Collections.List.last def.name in
-                name_from_type_ident (TypesUtils.as_ident cl))
-        | TVar _ -> (
-            (* TODO: use "t" also for F* *)
-            match !backend with
-            | FStar -> "x" (* lacking inspiration here... *)
-            | Coq | Lean | HOL4 -> "t" (* lacking inspiration here... *))
-        | TLiteral lty -> (
-            match lty with TBool -> "b" | TChar -> "c" | TInteger _ -> "i")
-        | TArrow _ -> "f"
-        | TTraitType (_, _, name) -> name_from_type_ident name)
-  in
-  let type_var_basename (_varset : StringSet.t) (basename : string) : string =
-    (* Rust type variables are snake-case and start with a capital letter *)
-    match !backend with
-    | FStar ->
-        (* This is *not* a no-op: this removes the capital letter *)
-        to_snake_case basename
-    | HOL4 ->
-        (* In HOL4, type variable names must start with "'" *)
-        "'" ^ to_snake_case basename
-    | Coq | Lean -> basename
-  in
-  let const_generic_var_basename (_varset : StringSet.t) (basename : string) :
-      string =
-    (* Rust type variables are snake-case and start with a capital letter *)
-    match !backend with
-    | FStar | HOL4 ->
-        (* This is *not* a no-op: this removes the capital letter *)
-        to_snake_case basename
-    | Coq | Lean -> basename
-  in
-  let trait_clause_basename (_varset : StringSet.t) (_clause : trait_clause) :
-      string =
-    (* TODO: actually use the clause to derive the name *)
-    "inst"
-  in
-  let trait_self_clause_basename = "self_clause" in
-  let append_index (basename : string) (i : int) : string =
-    basename ^ string_of_int i
-  in
-
-  let extract_literal (fmt : F.formatter) (inside : bool) (cv : literal) : unit
-      =
-    match cv with
-    | VScalar sv -> (
-        match !backend with
-        | FStar -> F.pp_print_string fmt (Z.to_string sv.value)
-        | Coq | HOL4 | Lean ->
-            let print_brackets = inside && !backend = HOL4 in
-            if print_brackets then F.pp_print_string fmt "(";
-            (match !backend with
-            | Coq | Lean -> ()
-            | HOL4 ->
-                F.pp_print_string fmt ("int_to_" ^ int_name sv.int_ty);
-                F.pp_print_space fmt ()
-            | _ -> raise (Failure "Unreachable"));
-            (* We need to add parentheses if the value is negative *)
-            if sv.value >= Z.of_int 0 then
-              F.pp_print_string fmt (Z.to_string sv.value)
-            else if !backend = Lean then
-              (* TODO: parsing issues with Lean because there are ambiguous
-                 interpretations between int values and nat values *)
-              F.pp_print_string fmt
-                ("(-(" ^ Z.to_string (Z.neg sv.value) ^ ":Int))")
-            else F.pp_print_string fmt ("(" ^ Z.to_string sv.value ^ ")");
-            (match !backend with
-            | Coq ->
-                let iname = int_name sv.int_ty in
-                F.pp_print_string fmt ("%" ^ iname)
-            | Lean ->
-                let iname = String.lowercase_ascii (int_name sv.int_ty) in
-                F.pp_print_string fmt ("#" ^ iname)
-            | HOL4 -> ()
-            | _ -> raise (Failure "Unreachable"));
-            if print_brackets then F.pp_print_string fmt ")")
-    | VBool b ->
-        let b =
-          match !backend with
-          | HOL4 -> if b then "T" else "F"
-          | Coq | FStar | Lean -> if b then "true" else "false"
-        in
-        F.pp_print_string fmt b
-    | VChar c -> (
-        match !backend with
-        | HOL4 ->
-            (* [#"a"] is a notation for [CHR 97] (97 is the ASCII code for 'a') *)
-            F.pp_print_string fmt ("#\"" ^ String.make 1 c ^ "\"")
-        | FStar | Lean -> F.pp_print_string fmt ("'" ^ String.make 1 c ^ "'")
-        | Coq ->
-            if inside then F.pp_print_string fmt "(";
-            F.pp_print_string fmt "char_of_byte";
-            F.pp_print_space fmt ();
-            (* Convert the the char to ascii *)
-            let c =
-              let i = Char.code c in
-              let x0 = i / 16 in
-              let x1 = i mod 16 in
-              "Coq.Init.Byte.x" ^ string_of_int x0 ^ string_of_int x1
-            in
-            F.pp_print_string fmt c;
-            if inside then F.pp_print_string fmt ")")
-  in
-  let bool_name = if !backend = Lean then "Bool" else "bool" in
-  let char_name = if !backend = Lean then "Char" else "char" in
-  let str_name = if !backend = Lean then "String" else "string" in
-  {
-    bool_name;
-    char_name;
-    int_name;
-    str_name;
-    type_decl_kind_to_qualif;
-    fun_decl_kind_to_qualif;
-    field_name;
-    variant_name;
-    struct_constructor;
-    type_name;
-    global_name;
-    fun_name;
-    termination_measure_name;
-    decreases_proof_name;
-    trait_decl_name;
-    trait_impl_name;
-    trait_decl_constructor;
-    trait_parent_clause_name;
-    trait_const_name;
-    trait_type_name;
-    trait_method_name;
-    trait_type_clause_name;
-    var_basename;
-    type_var_basename;
-    const_generic_var_basename;
-    trait_self_clause_basename;
-    trait_clause_basename;
-    append_index;
-    extract_literal;
-    extract_unop;
-    extract_binop;
-  }
-
-let mk_formatter_and_names_maps (ctx : trans_ctx) (crate_name : string)
-    (variant_concatenate_type_name : bool) : formatter * names_maps =
-  let fmt = mk_formatter ctx crate_name variant_concatenate_type_name in
-  let names_maps = initialize_names_maps fmt (names_map_init ()) in
-  (fmt, names_maps)
-
 let is_single_opaque_fun_decl_group (dg : Pure.fun_decl list) : bool =
   match dg with [ d ] -> d.body = None | _ -> false
 
@@ -1125,17 +353,17 @@ let extract_const_generic (ctx : extraction_ctx) (fmt : F.formatter)
   | CgGlobal id ->
       let s = ctx_get_global id ctx in
       F.pp_print_string fmt s
-  | CgValue v -> ctx.fmt.extract_literal fmt inside v
+  | CgValue v -> extract_literal fmt inside v
   | CgVar id ->
       let s = ctx_get_const_generic_var id ctx in
       F.pp_print_string fmt s
 
-let extract_literal_type (ctx : extraction_ctx) (fmt : F.formatter)
+let extract_literal_type (_ctx : extraction_ctx) (fmt : F.formatter)
     (ty : literal_type) : unit =
   match ty with
-  | TBool -> F.pp_print_string fmt ctx.fmt.bool_name
-  | TChar -> F.pp_print_string fmt ctx.fmt.char_name
-  | TInteger int_ty -> F.pp_print_string fmt (ctx.fmt.int_name int_ty)
+  | TBool -> F.pp_print_string fmt (bool_name ())
+  | TChar -> F.pp_print_string fmt (char_name ())
+  | TInteger int_ty -> F.pp_print_string fmt (int_name int_ty)
 
 (** [inside] constrols whether we should add parentheses or not around type
     applications (if [true] we add parentheses).
@@ -1446,7 +674,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
   (* Compute and register the type def name *)
   let def_name =
     match info with
-    | None -> ctx.fmt.type_name def.llbc_name
+    | None -> ctx_compute_type_name ctx def.llbc_name
     | Some info -> info.extract_name
   in
   let ctx = ctx_add (TypeId (TAdtId def.def_id)) def_name ctx in
@@ -1464,10 +692,14 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
               let field_names =
                 FieldId.mapi
                   (fun fid (field : field) ->
-                    (fid, ctx.fmt.field_name def.llbc_name fid field.field_name))
+                    ( fid,
+                      ctx_compute_field_name ctx def.llbc_name fid
+                        field.field_name ))
                   fields
               in
-              let cons_name = ctx.fmt.struct_constructor def.llbc_name in
+              let cons_name =
+                ctx_compute_struct_constructor ctx def.llbc_name
+              in
               (field_names, cons_name)
           | Some { body_info = Some (Struct (cons_name, field_names)); _ } ->
               let field_names =
@@ -1503,12 +735,13 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) :
               VariantId.mapi
                 (fun variant_id (variant : variant) ->
                   let name =
-                    ctx.fmt.variant_name def.llbc_name variant.variant_name
+                    ctx_compute_variant_name ctx def.llbc_name
+                      variant.variant_name
                   in
                   (* Add the type name prefix for Lean *)
                   let name =
                     if !Config.backend = Lean then
-                      let type_name = ctx.fmt.type_name def.llbc_name in
+                      let type_name = ctx_compute_type_name ctx def.llbc_name in
                       type_name ^ "." ^ name
                     else name
                   in
@@ -1570,8 +803,7 @@ let extract_type_decl_variant (ctx : extraction_ctx) (fmt : F.formatter)
           | Some field_name ->
               let var_id = VarId.of_int (FieldId.to_int fid) in
               let field_name =
-                ctx.fmt.var_basename ctx.names_maps.names_map.names_set
-                  (Some field_name) f.field_ty
+                ctx_compute_var_basename ctx (Some field_name) f.field_ty
               in
               let ctx, field_name = ctx_add_var field_name var_id ctx in
               F.pp_print_string fmt (field_name ^ " :");
@@ -1652,7 +884,7 @@ let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter)
   let print_variant _variant_id (v : variant) =
     (* We don't lookup the name, because it may have a prefix for the type
        id (in the case of Lean) *)
-    let cons_name = ctx.fmt.variant_name def.llbc_name v.variant_name in
+    let cons_name = ctx_compute_variant_name ctx def.llbc_name v.variant_name in
     let fields = v.fields in
     extract_type_decl_variant ctx fmt type_decl_group def_name type_params
       cg_params cons_name fields
@@ -2059,7 +1291,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter)
   (* Open a box for "type TYPE_NAME (TYPE_PARAMS CONST_GEN_PARAMS) =" *)
   F.pp_open_hovbox fmt ctx.indent_incr;
   (* > "type TYPE_NAME" *)
-  let qualif = ctx.fmt.type_decl_kind_to_qualif kind type_kind in
+  let qualif = type_decl_kind_to_qualif kind type_kind in
   (match qualif with
   | Some qualif -> F.pp_print_string fmt (qualif ^ " " ^ def_name)
   | None -> F.pp_print_string fmt def_name);
diff --git a/compiler/Main.ml b/compiler/Main.ml
index 0daf454d..e350da8a 100644
--- a/compiler/Main.ml
+++ b/compiler/Main.ml
@@ -178,7 +178,10 @@ let () =
           log#error "The Lean backend doesn't support the -use-fuel option";
           fail ());
         (* Lean can disambiguate the field names *)
-        record_fields_short_names := true
+        record_fields_short_names := true;
+        (* We exploit the fact that the variant name should always be
+           prefixed with the type name to prevent collisions *)
+        variant_concatenate_type_name := false
     | HOL4 ->
         (* We don't support fuel for the HOL4 backend *)
         if !use_fuel then (
diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 271d19ad..05e48af5 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -993,20 +993,10 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
     translate_crate_to_pure crate
   in
 
-  (* Initialize the extraction context - for now we extract only to F*.
-   * We initialize the names map by registering the keywords used in the
-   * language, as well as some primitive names ("u32", etc.) *)
-  let variant_concatenate_type_name =
-    (* For Lean, we exploit the fact that the variant name should always be
-       prefixed with the type name to prevent collisions *)
-    match !Config.backend with Coq | FStar | HOL4 -> true | Lean -> false
-  in
-  (* Initialize the names map (we insert the names of the "primitives"
-     declarations, and insert the names of the local declarations later) *)
-  let fmt, names_maps =
-    Extract.mk_formatter_and_names_maps trans_ctx crate.name
-      variant_concatenate_type_name
-  in
+  (* Initialize the names map by registering the keywords used in the
+     language, as well as some primitive names ("u32", etc.).
+     We insert the names of the local declarations later. *)
+  let names_maps = Extract.initialize_names_maps () in
 
   (* We need to compute which functions are recursive, in order to know
    * whether we should generate a decrease clause or not. *)
@@ -1061,7 +1051,6 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
       ExtractBase.crate;
       trans_ctx;
       names_maps;
-      fmt;
       indent_incr = 2;
       use_dep_ite = !Config.backend = Lean && !Config.extract_decreases_clauses;
       fun_name_info = PureUtils.RegularFunIdMap.empty;
-- 
cgit v1.3.1


From 959d6fce38c8d8ca6eaed3ad6f458b87f91a9abc Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 27 Nov 2023 09:37:31 +0100
Subject: Update the generation of files for external definitions and
 regenerate the tests

---
 compiler/Translate.ml                              | 23 ++++++-----
 tests/coq/betree/BetreeMain_Funs.v                 |  4 +-
 tests/coq/betree/BetreeMain_FunsExternal.v         | 46 ++++++++++++++++++++++
 .../coq/betree/BetreeMain_FunsExternal_Template.v  | 46 ++++++++++++++++++++++
 tests/coq/betree/BetreeMain_Opaque.v               | 45 ---------------------
 tests/coq/betree/_CoqProject                       |  3 +-
 tests/coq/hashmap_on_disk/HashmapMain_Funs.v       |  4 +-
 .../coq/hashmap_on_disk/HashmapMain_FunsExternal.v | 25 ++++++++++++
 .../HashmapMain_FunsExternal_Template.v            | 26 ++++++++++++
 tests/coq/hashmap_on_disk/HashmapMain_Opaque.v     | 25 ------------
 tests/coq/hashmap_on_disk/_CoqProject              |  3 +-
 tests/coq/misc/External_Funs.v                     |  4 +-
 tests/coq/misc/External_FunsExternal.v             | 43 ++++++++++++++++++++
 tests/coq/misc/External_FunsExternal_Template.v    | 44 +++++++++++++++++++++
 tests/coq/misc/External_Opaque.v                   | 43 --------------------
 tests/coq/misc/_CoqProject                         |  3 +-
 tests/fstar/betree/BetreeMain.Funs.fst             |  2 +-
 tests/fstar/betree/BetreeMain.FunsExternal.fsti    | 35 ++++++++++++++++
 tests/fstar/betree/BetreeMain.Opaque.fsti          | 35 ----------------
 .../fstar/betree_back_stateful/BetreeMain.Funs.fst |  2 +-
 .../BetreeMain.FunsExternal.fsti                   | 35 ++++++++++++++++
 .../betree_back_stateful/BetreeMain.Opaque.fsti    | 35 ----------------
 tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst   |  2 +-
 .../hashmap_on_disk/HashmapMain.FunsExternal.fsti  | 18 +++++++++
 .../fstar/hashmap_on_disk/HashmapMain.Opaque.fsti  | 18 ---------
 tests/fstar/misc/External.Funs.fst                 |  2 +-
 tests/fstar/misc/External.FunsExternal.fsti        | 32 +++++++++++++++
 tests/fstar/misc/External.Opaque.fsti              | 32 ---------------
 28 files changed, 380 insertions(+), 255 deletions(-)
 create mode 100644 tests/coq/betree/BetreeMain_FunsExternal.v
 create mode 100644 tests/coq/betree/BetreeMain_FunsExternal_Template.v
 delete mode 100644 tests/coq/betree/BetreeMain_Opaque.v
 create mode 100644 tests/coq/hashmap_on_disk/HashmapMain_FunsExternal.v
 create mode 100644 tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v
 delete mode 100644 tests/coq/hashmap_on_disk/HashmapMain_Opaque.v
 create mode 100644 tests/coq/misc/External_FunsExternal.v
 create mode 100644 tests/coq/misc/External_FunsExternal_Template.v
 delete mode 100644 tests/coq/misc/External_Opaque.v
 create mode 100644 tests/fstar/betree/BetreeMain.FunsExternal.fsti
 delete mode 100644 tests/fstar/betree/BetreeMain.Opaque.fsti
 create mode 100644 tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti
 delete mode 100644 tests/fstar/betree_back_stateful/BetreeMain.Opaque.fsti
 create mode 100644 tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti
 delete mode 100644 tests/fstar/hashmap_on_disk/HashmapMain.Opaque.fsti
 create mode 100644 tests/fstar/misc/External.FunsExternal.fsti
 delete mode 100644 tests/fstar/misc/External.Opaque.fsti

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 05e48af5..31cb4b32 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -977,7 +977,7 @@ let extract_file (config : gen_config) (ctx : gen_ctx) (fi : extract_file_info)
   | FStar -> ()
   | Lean -> if fi.in_namespace then Printf.fprintf out "end %s\n" fi.namespace
   | HOL4 -> Printf.fprintf out "val _ = export_theory ()\n"
-  | Coq -> Printf.fprintf out "End %s .\n" fi.module_name);
+  | Coq -> Printf.fprintf out "End %s.\n" fi.module_name);
 
   (* Some logging *)
   log#linfo (lazy ("Generated: " ^ fi.filename));
@@ -1320,13 +1320,20 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
      (* Extract the opaque declarations, if needed *)
      let opaque_funs_module =
        if has_opaque_funs then (
-         (* In the case of Lean we generate a template file *)
+         (* For F*, we generate an .fsti, and let the user write the .fst.
+            For the other backends, we generate a template file as a model
+            for the file the user has to provide. *)
          let module_suffix, opaque_imported_suffix, custom_msg =
            match !Config.backend with
-           | FStar | Coq | HOL4 ->
-               ("Opaque", "Opaque", ": external function declarations")
-           | Lean ->
-               ( "FunsExternal_Template",
+           | FStar ->
+               ( "FunsExternal",
+                 "FunsExternal",
+                 ": external function declarations" )
+           | HOL4 | Coq | Lean ->
+               ( (* The name of the file we generate *)
+                 "FunsExternal_Template",
+                 (* The name of the file that will be imported by the Funs
+                    module, and that the user has to provide. *)
                  "FunsExternal",
                  ": external functions.\n\
                   -- This is a template file: rename it to \
@@ -1337,9 +1344,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
          in
          let opaque_module = crate_name ^ module_delimiter ^ module_suffix in
          let opaque_imported_module =
-           if !Config.backend = Lean then
-             crate_name ^ module_delimiter ^ opaque_imported_suffix
-           else opaque_module
+           crate_name ^ module_delimiter ^ opaque_imported_suffix
          in
          let opaque_config =
            {
diff --git a/tests/coq/betree/BetreeMain_Funs.v b/tests/coq/betree/BetreeMain_Funs.v
index 8e48b17d..ede82492 100644
--- a/tests/coq/betree/BetreeMain_Funs.v
+++ b/tests/coq/betree/BetreeMain_Funs.v
@@ -8,8 +8,8 @@ Import ListNotations.
 Local Open Scope Primitives_scope.
 Require Export BetreeMain_Types.
 Import BetreeMain_Types.
-Require Export BetreeMain_Opaque.
-Import BetreeMain_Opaque.
+Require Export BetreeMain_FunsExternal.
+Import BetreeMain_FunsExternal.
 Module BetreeMain_Funs.
 
 (** [betree_main::betree::load_internal_node]: forward function
diff --git a/tests/coq/betree/BetreeMain_FunsExternal.v b/tests/coq/betree/BetreeMain_FunsExternal.v
new file mode 100644
index 00000000..07dba263
--- /dev/null
+++ b/tests/coq/betree/BetreeMain_FunsExternal.v
@@ -0,0 +1,46 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: external functions.
+-- This is a template file: rename it to "FunsExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Require Export BetreeMain_Types.
+Import BetreeMain_Types.
+Module BetreeMain_FunsExternal.
+
+(** [betree_main::betree_utils::load_internal_node]: forward function
+    Source: 'src/betree_utils.rs', lines 98:0-98:63 *)
+Axiom betree_utils_load_internal_node
+  : u64 -> state -> result (state * (betree_List_t (u64 * betree_Message_t)))
+.
+
+(** [betree_main::betree_utils::store_internal_node]: forward function
+    Source: 'src/betree_utils.rs', lines 115:0-115:71 *)
+Axiom betree_utils_store_internal_node
+  :
+  u64 -> betree_List_t (u64 * betree_Message_t) -> state -> result (state *
+    unit)
+.
+
+(** [betree_main::betree_utils::load_leaf_node]: forward function
+    Source: 'src/betree_utils.rs', lines 132:0-132:55 *)
+Axiom betree_utils_load_leaf_node
+  : u64 -> state -> result (state * (betree_List_t (u64 * u64)))
+.
+
+(** [betree_main::betree_utils::store_leaf_node]: forward function
+    Source: 'src/betree_utils.rs', lines 145:0-145:63 *)
+Axiom betree_utils_store_leaf_node
+  : u64 -> betree_List_t (u64 * u64) -> state -> result (state * unit)
+.
+
+(** [core::option::{core::option::Option<T>}::unwrap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
+Axiom core_option_Option_unwrap :
+  forall(T : Type), option T -> state -> result (state * T)
+.
+
+End BetreeMain_FunsExternal.
diff --git a/tests/coq/betree/BetreeMain_FunsExternal_Template.v b/tests/coq/betree/BetreeMain_FunsExternal_Template.v
new file mode 100644
index 00000000..4898acd4
--- /dev/null
+++ b/tests/coq/betree/BetreeMain_FunsExternal_Template.v
@@ -0,0 +1,46 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: external functions.
+-- This is a template file: rename it to "FunsExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Require Export BetreeMain_Types.
+Import BetreeMain_Types.
+Module BetreeMain_FunsExternal_Template.
+
+(** [betree_main::betree_utils::load_internal_node]: forward function
+    Source: 'src/betree_utils.rs', lines 98:0-98:63 *)
+Axiom betree_utils_load_internal_node
+  : u64 -> state -> result (state * (betree_List_t (u64 * betree_Message_t)))
+.
+
+(** [betree_main::betree_utils::store_internal_node]: forward function
+    Source: 'src/betree_utils.rs', lines 115:0-115:71 *)
+Axiom betree_utils_store_internal_node
+  :
+  u64 -> betree_List_t (u64 * betree_Message_t) -> state -> result (state *
+    unit)
+.
+
+(** [betree_main::betree_utils::load_leaf_node]: forward function
+    Source: 'src/betree_utils.rs', lines 132:0-132:55 *)
+Axiom betree_utils_load_leaf_node
+  : u64 -> state -> result (state * (betree_List_t (u64 * u64)))
+.
+
+(** [betree_main::betree_utils::store_leaf_node]: forward function
+    Source: 'src/betree_utils.rs', lines 145:0-145:63 *)
+Axiom betree_utils_store_leaf_node
+  : u64 -> betree_List_t (u64 * u64) -> state -> result (state * unit)
+.
+
+(** [core::option::{core::option::Option<T>}::unwrap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
+Axiom core_option_Option_unwrap :
+  forall(T : Type), option T -> state -> result (state * T)
+.
+
+End BetreeMain_FunsExternal_Template .
diff --git a/tests/coq/betree/BetreeMain_Opaque.v b/tests/coq/betree/BetreeMain_Opaque.v
deleted file mode 100644
index a065c8a3..00000000
--- a/tests/coq/betree/BetreeMain_Opaque.v
+++ /dev/null
@@ -1,45 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [betree_main]: external function declarations *)
-Require Import Primitives.
-Import Primitives.
-Require Import Coq.ZArith.ZArith.
-Require Import List.
-Import ListNotations.
-Local Open Scope Primitives_scope.
-Require Export BetreeMain_Types.
-Import BetreeMain_Types.
-Module BetreeMain_Opaque.
-
-(** [betree_main::betree_utils::load_internal_node]: forward function
-    Source: 'src/betree_utils.rs', lines 98:0-98:63 *)
-Axiom betree_utils_load_internal_node
-  : u64 -> state -> result (state * (betree_List_t (u64 * betree_Message_t)))
-.
-
-(** [betree_main::betree_utils::store_internal_node]: forward function
-    Source: 'src/betree_utils.rs', lines 115:0-115:71 *)
-Axiom betree_utils_store_internal_node
-  :
-  u64 -> betree_List_t (u64 * betree_Message_t) -> state -> result (state *
-    unit)
-.
-
-(** [betree_main::betree_utils::load_leaf_node]: forward function
-    Source: 'src/betree_utils.rs', lines 132:0-132:55 *)
-Axiom betree_utils_load_leaf_node
-  : u64 -> state -> result (state * (betree_List_t (u64 * u64)))
-.
-
-(** [betree_main::betree_utils::store_leaf_node]: forward function
-    Source: 'src/betree_utils.rs', lines 145:0-145:63 *)
-Axiom betree_utils_store_leaf_node
-  : u64 -> betree_List_t (u64 * u64) -> state -> result (state * unit)
-.
-
-(** [core::option::{core::option::Option<T>}::unwrap]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
-Axiom core_option_Option_unwrap :
-  forall(T : Type), option T -> state -> result (state * T)
-.
-
-End BetreeMain_Opaque .
diff --git a/tests/coq/betree/_CoqProject b/tests/coq/betree/_CoqProject
index 42c62421..9ab8ea9f 100644
--- a/tests/coq/betree/_CoqProject
+++ b/tests/coq/betree/_CoqProject
@@ -5,5 +5,6 @@
 
 BetreeMain_Types.v
 Primitives.v
+BetreeMain_FunsExternal_Template.v
 BetreeMain_Funs.v
-BetreeMain_Opaque.v
+BetreeMain_FunsExternal.v
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
index 46d3ee29..188c98b3 100644
--- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
+++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
@@ -8,8 +8,8 @@ Import ListNotations.
 Local Open Scope Primitives_scope.
 Require Export HashmapMain_Types.
 Import HashmapMain_Types.
-Require Export HashmapMain_Opaque.
-Import HashmapMain_Opaque.
+Require Export HashmapMain_FunsExternal.
+Import HashmapMain_FunsExternal.
 Module HashmapMain_Funs.
 
 (** [hashmap_main::hashmap::hash_key]: forward function
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal.v b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal.v
new file mode 100644
index 00000000..a03dc407
--- /dev/null
+++ b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal.v
@@ -0,0 +1,25 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [hashmap_main]: external function declarations *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Require Export HashmapMain_Types.
+Import HashmapMain_Types.
+Module HashmapMain_FunsExternal.
+
+(** [hashmap_main::hashmap_utils::deserialize]: forward function
+    Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *)
+Axiom hashmap_utils_deserialize
+  : state -> result (state * (hashmap_HashMap_t u64))
+.
+
+(** [hashmap_main::hashmap_utils::serialize]: forward function
+    Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *)
+Axiom hashmap_utils_serialize
+  : hashmap_HashMap_t u64 -> state -> result (state * unit)
+.
+
+End HashmapMain_FunsExternal.
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v
new file mode 100644
index 00000000..b5a4a101
--- /dev/null
+++ b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v
@@ -0,0 +1,26 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [hashmap_main]: external functions.
+-- This is a template file: rename it to "FunsExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Require Export HashmapMain_Types.
+Import HashmapMain_Types.
+Module HashmapMain_FunsExternal_Template.
+
+(** [hashmap_main::hashmap_utils::deserialize]: forward function
+    Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *)
+Axiom hashmap_utils_deserialize
+  : state -> result (state * (hashmap_HashMap_t u64))
+.
+
+(** [hashmap_main::hashmap_utils::serialize]: forward function
+    Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *)
+Axiom hashmap_utils_serialize
+  : hashmap_HashMap_t u64 -> state -> result (state * unit)
+.
+
+End HashmapMain_FunsExternal_Template .
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Opaque.v b/tests/coq/hashmap_on_disk/HashmapMain_Opaque.v
deleted file mode 100644
index a0e9003d..00000000
--- a/tests/coq/hashmap_on_disk/HashmapMain_Opaque.v
+++ /dev/null
@@ -1,25 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [hashmap_main]: external function declarations *)
-Require Import Primitives.
-Import Primitives.
-Require Import Coq.ZArith.ZArith.
-Require Import List.
-Import ListNotations.
-Local Open Scope Primitives_scope.
-Require Export HashmapMain_Types.
-Import HashmapMain_Types.
-Module HashmapMain_Opaque.
-
-(** [hashmap_main::hashmap_utils::deserialize]: forward function
-    Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *)
-Axiom hashmap_utils_deserialize
-  : state -> result (state * (hashmap_HashMap_t u64))
-.
-
-(** [hashmap_main::hashmap_utils::serialize]: forward function
-    Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *)
-Axiom hashmap_utils_serialize
-  : hashmap_HashMap_t u64 -> state -> result (state * unit)
-.
-
-End HashmapMain_Opaque .
diff --git a/tests/coq/hashmap_on_disk/_CoqProject b/tests/coq/hashmap_on_disk/_CoqProject
index b78c7b5f..a85fa1fe 100644
--- a/tests/coq/hashmap_on_disk/_CoqProject
+++ b/tests/coq/hashmap_on_disk/_CoqProject
@@ -6,4 +6,5 @@
 HashmapMain_Types.v
 Primitives.v
 HashmapMain_Funs.v
-HashmapMain_Opaque.v
+HashmapMain_FunsExternal_Template.v
+HashmapMain_FunsExternal.v
diff --git a/tests/coq/misc/External_Funs.v b/tests/coq/misc/External_Funs.v
index 0a14c7d1..8a3360bb 100644
--- a/tests/coq/misc/External_Funs.v
+++ b/tests/coq/misc/External_Funs.v
@@ -8,8 +8,8 @@ Import ListNotations.
 Local Open Scope Primitives_scope.
 Require Export External_Types.
 Import External_Types.
-Require Export External_Opaque.
-Import External_Opaque.
+Require Export External_FunsExternal.
+Import External_FunsExternal.
 Module External_Funs.
 
 (** [external::swap]: forward function
diff --git a/tests/coq/misc/External_FunsExternal.v b/tests/coq/misc/External_FunsExternal.v
new file mode 100644
index 00000000..07d43061
--- /dev/null
+++ b/tests/coq/misc/External_FunsExternal.v
@@ -0,0 +1,43 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [external]: external function declarations *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Require Export External_Types.
+Import External_Types.
+Module External_FunsExternal.
+
+(** [core::mem::swap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+Axiom core_mem_swap :
+  forall(T : Type), T -> T -> state -> result (state * unit)
+.
+
+(** [core::mem::swap]: backward function 0
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+Axiom core_mem_swap_back0 :
+  forall(T : Type), T -> T -> state -> state -> result (state * T)
+.
+
+(** [core::mem::swap]: backward function 1
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+Axiom core_mem_swap_back1 :
+  forall(T : Type), T -> T -> state -> state -> result (state * T)
+.
+
+(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *)
+Axiom core_num_nonzero_NonZeroU32_new
+  : u32 -> state -> result (state * (option core_num_nonzero_NonZeroU32_t))
+.
+
+(** [core::option::{core::option::Option<T>}::unwrap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
+Axiom core_option_Option_unwrap :
+  forall(T : Type), option T -> state -> result (state * T)
+.
+
+End External_FunsExternal.
diff --git a/tests/coq/misc/External_FunsExternal_Template.v b/tests/coq/misc/External_FunsExternal_Template.v
new file mode 100644
index 00000000..0977c3ae
--- /dev/null
+++ b/tests/coq/misc/External_FunsExternal_Template.v
@@ -0,0 +1,44 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [external]: external functions.
+-- This is a template file: rename it to "FunsExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Require Export External_Types.
+Import External_Types.
+Module External_FunsExternal_Template.
+
+(** [core::mem::swap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+Axiom core_mem_swap :
+  forall(T : Type), T -> T -> state -> result (state * unit)
+.
+
+(** [core::mem::swap]: backward function 0
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+Axiom core_mem_swap_back0 :
+  forall(T : Type), T -> T -> state -> state -> result (state * T)
+.
+
+(** [core::mem::swap]: backward function 1
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+Axiom core_mem_swap_back1 :
+  forall(T : Type), T -> T -> state -> state -> result (state * T)
+.
+
+(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *)
+Axiom core_num_nonzero_NonZeroU32_new
+  : u32 -> state -> result (state * (option core_num_nonzero_NonZeroU32_t))
+.
+
+(** [core::option::{core::option::Option<T>}::unwrap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
+Axiom core_option_Option_unwrap :
+  forall(T : Type), option T -> state -> result (state * T)
+.
+
+End External_FunsExternal_Template .
diff --git a/tests/coq/misc/External_Opaque.v b/tests/coq/misc/External_Opaque.v
deleted file mode 100644
index b482431f..00000000
--- a/tests/coq/misc/External_Opaque.v
+++ /dev/null
@@ -1,43 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [external]: external function declarations *)
-Require Import Primitives.
-Import Primitives.
-Require Import Coq.ZArith.ZArith.
-Require Import List.
-Import ListNotations.
-Local Open Scope Primitives_scope.
-Require Export External_Types.
-Import External_Types.
-Module External_Opaque.
-
-(** [core::mem::swap]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
-Axiom core_mem_swap :
-  forall(T : Type), T -> T -> state -> result (state * unit)
-.
-
-(** [core::mem::swap]: backward function 0
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
-Axiom core_mem_swap_back0 :
-  forall(T : Type), T -> T -> state -> state -> result (state * T)
-.
-
-(** [core::mem::swap]: backward function 1
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
-Axiom core_mem_swap_back1 :
-  forall(T : Type), T -> T -> state -> state -> result (state * T)
-.
-
-(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *)
-Axiom core_num_nonzero_NonZeroU32_new
-  : u32 -> state -> result (state * (option core_num_nonzero_NonZeroU32_t))
-.
-
-(** [core::option::{core::option::Option<T>}::unwrap]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
-Axiom core_option_Option_unwrap :
-  forall(T : Type), option T -> state -> result (state * T)
-.
-
-End External_Opaque .
diff --git a/tests/coq/misc/_CoqProject b/tests/coq/misc/_CoqProject
index db6c2742..6884d5d9 100644
--- a/tests/coq/misc/_CoqProject
+++ b/tests/coq/misc/_CoqProject
@@ -10,5 +10,6 @@ Constants.v
 PoloniusList.v
 External_Types.v
 NoNestedBorrows.v
-External_Opaque.v
+External_FunsExternal.v
+External_FunsExternal_Template.v
 Paper.v
diff --git a/tests/fstar/betree/BetreeMain.Funs.fst b/tests/fstar/betree/BetreeMain.Funs.fst
index 537ec32e..fef8a8e1 100644
--- a/tests/fstar/betree/BetreeMain.Funs.fst
+++ b/tests/fstar/betree/BetreeMain.Funs.fst
@@ -3,7 +3,7 @@
 module BetreeMain.Funs
 open Primitives
 include BetreeMain.Types
-include BetreeMain.Opaque
+include BetreeMain.FunsExternal
 include BetreeMain.Clauses
 
 #set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
diff --git a/tests/fstar/betree/BetreeMain.FunsExternal.fsti b/tests/fstar/betree/BetreeMain.FunsExternal.fsti
new file mode 100644
index 00000000..cd2f956f
--- /dev/null
+++ b/tests/fstar/betree/BetreeMain.FunsExternal.fsti
@@ -0,0 +1,35 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: external function declarations *)
+module BetreeMain.FunsExternal
+open Primitives
+include BetreeMain.Types
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** [betree_main::betree_utils::load_internal_node]: forward function
+    Source: 'src/betree_utils.rs', lines 98:0-98:63 *)
+val betree_utils_load_internal_node
+  : u64 -> state -> result (state & (betree_List_t (u64 & betree_Message_t)))
+
+(** [betree_main::betree_utils::store_internal_node]: forward function
+    Source: 'src/betree_utils.rs', lines 115:0-115:71 *)
+val betree_utils_store_internal_node
+  :
+  u64 -> betree_List_t (u64 & betree_Message_t) -> state -> result (state &
+    unit)
+
+(** [betree_main::betree_utils::load_leaf_node]: forward function
+    Source: 'src/betree_utils.rs', lines 132:0-132:55 *)
+val betree_utils_load_leaf_node
+  : u64 -> state -> result (state & (betree_List_t (u64 & u64)))
+
+(** [betree_main::betree_utils::store_leaf_node]: forward function
+    Source: 'src/betree_utils.rs', lines 145:0-145:63 *)
+val betree_utils_store_leaf_node
+  : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit)
+
+(** [core::option::{core::option::Option<T>}::unwrap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
+val core_option_Option_unwrap
+  (t : Type0) : option t -> state -> result (state & t)
+
diff --git a/tests/fstar/betree/BetreeMain.Opaque.fsti b/tests/fstar/betree/BetreeMain.Opaque.fsti
deleted file mode 100644
index b89c8718..00000000
--- a/tests/fstar/betree/BetreeMain.Opaque.fsti
+++ /dev/null
@@ -1,35 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [betree_main]: external function declarations *)
-module BetreeMain.Opaque
-open Primitives
-include BetreeMain.Types
-
-#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
-
-(** [betree_main::betree_utils::load_internal_node]: forward function
-    Source: 'src/betree_utils.rs', lines 98:0-98:63 *)
-val betree_utils_load_internal_node
-  : u64 -> state -> result (state & (betree_List_t (u64 & betree_Message_t)))
-
-(** [betree_main::betree_utils::store_internal_node]: forward function
-    Source: 'src/betree_utils.rs', lines 115:0-115:71 *)
-val betree_utils_store_internal_node
-  :
-  u64 -> betree_List_t (u64 & betree_Message_t) -> state -> result (state &
-    unit)
-
-(** [betree_main::betree_utils::load_leaf_node]: forward function
-    Source: 'src/betree_utils.rs', lines 132:0-132:55 *)
-val betree_utils_load_leaf_node
-  : u64 -> state -> result (state & (betree_List_t (u64 & u64)))
-
-(** [betree_main::betree_utils::store_leaf_node]: forward function
-    Source: 'src/betree_utils.rs', lines 145:0-145:63 *)
-val betree_utils_store_leaf_node
-  : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit)
-
-(** [core::option::{core::option::Option<T>}::unwrap]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
-val core_option_Option_unwrap
-  (t : Type0) : option t -> state -> result (state & t)
-
diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst
index a2586431..b912a316 100644
--- a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst
+++ b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst
@@ -3,7 +3,7 @@
 module BetreeMain.Funs
 open Primitives
 include BetreeMain.Types
-include BetreeMain.Opaque
+include BetreeMain.FunsExternal
 include BetreeMain.Clauses
 
 #set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
diff --git a/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti b/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti
new file mode 100644
index 00000000..cd2f956f
--- /dev/null
+++ b/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti
@@ -0,0 +1,35 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: external function declarations *)
+module BetreeMain.FunsExternal
+open Primitives
+include BetreeMain.Types
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** [betree_main::betree_utils::load_internal_node]: forward function
+    Source: 'src/betree_utils.rs', lines 98:0-98:63 *)
+val betree_utils_load_internal_node
+  : u64 -> state -> result (state & (betree_List_t (u64 & betree_Message_t)))
+
+(** [betree_main::betree_utils::store_internal_node]: forward function
+    Source: 'src/betree_utils.rs', lines 115:0-115:71 *)
+val betree_utils_store_internal_node
+  :
+  u64 -> betree_List_t (u64 & betree_Message_t) -> state -> result (state &
+    unit)
+
+(** [betree_main::betree_utils::load_leaf_node]: forward function
+    Source: 'src/betree_utils.rs', lines 132:0-132:55 *)
+val betree_utils_load_leaf_node
+  : u64 -> state -> result (state & (betree_List_t (u64 & u64)))
+
+(** [betree_main::betree_utils::store_leaf_node]: forward function
+    Source: 'src/betree_utils.rs', lines 145:0-145:63 *)
+val betree_utils_store_leaf_node
+  : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit)
+
+(** [core::option::{core::option::Option<T>}::unwrap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
+val core_option_Option_unwrap
+  (t : Type0) : option t -> state -> result (state & t)
+
diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Opaque.fsti b/tests/fstar/betree_back_stateful/BetreeMain.Opaque.fsti
deleted file mode 100644
index b89c8718..00000000
--- a/tests/fstar/betree_back_stateful/BetreeMain.Opaque.fsti
+++ /dev/null
@@ -1,35 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [betree_main]: external function declarations *)
-module BetreeMain.Opaque
-open Primitives
-include BetreeMain.Types
-
-#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
-
-(** [betree_main::betree_utils::load_internal_node]: forward function
-    Source: 'src/betree_utils.rs', lines 98:0-98:63 *)
-val betree_utils_load_internal_node
-  : u64 -> state -> result (state & (betree_List_t (u64 & betree_Message_t)))
-
-(** [betree_main::betree_utils::store_internal_node]: forward function
-    Source: 'src/betree_utils.rs', lines 115:0-115:71 *)
-val betree_utils_store_internal_node
-  :
-  u64 -> betree_List_t (u64 & betree_Message_t) -> state -> result (state &
-    unit)
-
-(** [betree_main::betree_utils::load_leaf_node]: forward function
-    Source: 'src/betree_utils.rs', lines 132:0-132:55 *)
-val betree_utils_load_leaf_node
-  : u64 -> state -> result (state & (betree_List_t (u64 & u64)))
-
-(** [betree_main::betree_utils::store_leaf_node]: forward function
-    Source: 'src/betree_utils.rs', lines 145:0-145:63 *)
-val betree_utils_store_leaf_node
-  : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit)
-
-(** [core::option::{core::option::Option<T>}::unwrap]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
-val core_option_Option_unwrap
-  (t : Type0) : option t -> state -> result (state & t)
-
diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst
index fa570309..f2d09a38 100644
--- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst
+++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst
@@ -3,7 +3,7 @@
 module HashmapMain.Funs
 open Primitives
 include HashmapMain.Types
-include HashmapMain.Opaque
+include HashmapMain.FunsExternal
 include HashmapMain.Clauses
 
 #set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti b/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti
new file mode 100644
index 00000000..b00bbcde
--- /dev/null
+++ b/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti
@@ -0,0 +1,18 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [hashmap_main]: external function declarations *)
+module HashmapMain.FunsExternal
+open Primitives
+include HashmapMain.Types
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** [hashmap_main::hashmap_utils::deserialize]: forward function
+    Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *)
+val hashmap_utils_deserialize
+  : state -> result (state & (hashmap_HashMap_t u64))
+
+(** [hashmap_main::hashmap_utils::serialize]: forward function
+    Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *)
+val hashmap_utils_serialize
+  : hashmap_HashMap_t u64 -> state -> result (state & unit)
+
diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Opaque.fsti b/tests/fstar/hashmap_on_disk/HashmapMain.Opaque.fsti
deleted file mode 100644
index 1f47eb33..00000000
--- a/tests/fstar/hashmap_on_disk/HashmapMain.Opaque.fsti
+++ /dev/null
@@ -1,18 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [hashmap_main]: external function declarations *)
-module HashmapMain.Opaque
-open Primitives
-include HashmapMain.Types
-
-#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
-
-(** [hashmap_main::hashmap_utils::deserialize]: forward function
-    Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *)
-val hashmap_utils_deserialize
-  : state -> result (state & (hashmap_HashMap_t u64))
-
-(** [hashmap_main::hashmap_utils::serialize]: forward function
-    Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *)
-val hashmap_utils_serialize
-  : hashmap_HashMap_t u64 -> state -> result (state & unit)
-
diff --git a/tests/fstar/misc/External.Funs.fst b/tests/fstar/misc/External.Funs.fst
index 4d13fb71..00995634 100644
--- a/tests/fstar/misc/External.Funs.fst
+++ b/tests/fstar/misc/External.Funs.fst
@@ -3,7 +3,7 @@
 module External.Funs
 open Primitives
 include External.Types
-include External.Opaque
+include External.FunsExternal
 
 #set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
 
diff --git a/tests/fstar/misc/External.FunsExternal.fsti b/tests/fstar/misc/External.FunsExternal.fsti
new file mode 100644
index 00000000..923a1101
--- /dev/null
+++ b/tests/fstar/misc/External.FunsExternal.fsti
@@ -0,0 +1,32 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [external]: external function declarations *)
+module External.FunsExternal
+open Primitives
+include External.Types
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** [core::mem::swap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+val core_mem_swap (t : Type0) : t -> t -> state -> result (state & unit)
+
+(** [core::mem::swap]: backward function 0
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+val core_mem_swap_back0
+  (t : Type0) : t -> t -> state -> state -> result (state & t)
+
+(** [core::mem::swap]: backward function 1
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
+val core_mem_swap_back1
+  (t : Type0) : t -> t -> state -> state -> result (state & t)
+
+(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *)
+val core_num_nonzero_NonZeroU32_new
+  : u32 -> state -> result (state & (option core_num_nonzero_NonZeroU32_t))
+
+(** [core::option::{core::option::Option<T>}::unwrap]: forward function
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
+val core_option_Option_unwrap
+  (t : Type0) : option t -> state -> result (state & t)
+
diff --git a/tests/fstar/misc/External.Opaque.fsti b/tests/fstar/misc/External.Opaque.fsti
deleted file mode 100644
index ea1a70c2..00000000
--- a/tests/fstar/misc/External.Opaque.fsti
+++ /dev/null
@@ -1,32 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [external]: external function declarations *)
-module External.Opaque
-open Primitives
-include External.Types
-
-#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
-
-(** [core::mem::swap]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
-val core_mem_swap (t : Type0) : t -> t -> state -> result (state & unit)
-
-(** [core::mem::swap]: backward function 0
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
-val core_mem_swap_back0
-  (t : Type0) : t -> t -> state -> state -> result (state & t)
-
-(** [core::mem::swap]: backward function 1
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *)
-val core_mem_swap_back1
-  (t : Type0) : t -> t -> state -> state -> result (state & t)
-
-(** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *)
-val core_num_nonzero_NonZeroU32_new
-  : u32 -> state -> result (state & (option core_num_nonzero_NonZeroU32_t))
-
-(** [core::option::{core::option::Option<T>}::unwrap]: forward function
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *)
-val core_option_Option_unwrap
-  (t : Type0) : option t -> state -> result (state & t)
-
-- 
cgit v1.3.1


From bef2bd34fcb0817f1b7d16b95122bcc3c6f05c72 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 27 Nov 2023 10:29:25 +0100
Subject: Generate a dedicated file for the external types

---
 compiler/Translate.ml                              | 114 ++++++++++++++++++---
 tests/coq/array/Array.v                            |   2 +-
 tests/coq/betree/BetreeMain_Funs.v                 |  10 +-
 .../coq/betree/BetreeMain_FunsExternal_Template.v  |   6 +-
 tests/coq/betree/BetreeMain_Types.v                |   7 +-
 tests/coq/betree/BetreeMain_TypesExternal.v        |  15 +++
 .../coq/betree/BetreeMain_TypesExternal_Template.v |  15 +++
 tests/coq/betree/_CoqProject                       |   2 +
 tests/coq/hashmap/Hashmap_Funs.v                   |   6 +-
 tests/coq/hashmap/Hashmap_Types.v                  |   2 +-
 tests/coq/hashmap_on_disk/HashmapMain_Funs.v       |  10 +-
 .../HashmapMain_FunsExternal_Template.v            |   6 +-
 tests/coq/hashmap_on_disk/HashmapMain_Types.v      |   7 +-
 .../hashmap_on_disk/HashmapMain_TypesExternal.v    |  15 +++
 .../HashmapMain_TypesExternal_Template.v           |  15 +++
 tests/coq/hashmap_on_disk/_CoqProject              |   2 +
 tests/coq/misc/Constants.v                         |   2 +-
 tests/coq/misc/External_Funs.v                     |  10 +-
 tests/coq/misc/External_FunsExternal.v             |   2 +-
 tests/coq/misc/External_FunsExternal_Template.v    |   6 +-
 tests/coq/misc/External_Types.v                    |  11 +-
 tests/coq/misc/External_TypesExternal.v            |  19 ++++
 tests/coq/misc/External_TypesExternal_Template.v   |  19 ++++
 tests/coq/misc/Loops.v                             |   2 +-
 tests/coq/misc/NoNestedBorrows.v                   |   2 +-
 tests/coq/misc/Paper.v                             |   2 +-
 tests/coq/misc/PoloniusList.v                      |   2 +-
 tests/coq/misc/_CoqProject                         |   6 +-
 tests/coq/traits/Traits.v                          |   2 +-
 tests/fstar/betree/BetreeMain.Types.fst            |  61 +++++++++++
 tests/fstar/betree/BetreeMain.Types.fsti           |  63 ------------
 tests/fstar/betree/BetreeMain.TypesExternal.fsti   |  10 ++
 .../betree_back_stateful/BetreeMain.Types.fst      |  61 +++++++++++
 .../betree_back_stateful/BetreeMain.Types.fsti     |  63 ------------
 .../BetreeMain.TypesExternal.fsti                  |  10 ++
 tests/fstar/hashmap_on_disk/HashmapMain.Types.fst  |  24 +++++
 tests/fstar/hashmap_on_disk/HashmapMain.Types.fsti |  26 -----
 .../hashmap_on_disk/HashmapMain.TypesExternal.fsti |  10 ++
 tests/fstar/misc/External.Types.fst                |   8 ++
 tests/fstar/misc/External.Types.fsti               |  14 ---
 tests/fstar/misc/External.TypesExternal.fsti       |  14 +++
 tests/lean/BetreeMain/Types.lean                   |   4 +-
 tests/lean/BetreeMain/TypesExternal.lean           |   7 ++
 tests/lean/BetreeMain/TypesExternal_Template.lean  |   9 ++
 tests/lean/External/Types.lean                     |   8 +-
 tests/lean/External/TypesExternal.lean             |  11 ++
 tests/lean/External/TypesExternal_Template.lean    |  13 +++
 tests/lean/HashmapMain/Types.lean                  |   4 +-
 tests/lean/HashmapMain/TypesExternal.lean          |   7 ++
 tests/lean/HashmapMain/TypesExternal_Template.lean |   9 ++
 50 files changed, 510 insertions(+), 245 deletions(-)
 create mode 100644 tests/coq/betree/BetreeMain_TypesExternal.v
 create mode 100644 tests/coq/betree/BetreeMain_TypesExternal_Template.v
 create mode 100644 tests/coq/hashmap_on_disk/HashmapMain_TypesExternal.v
 create mode 100644 tests/coq/hashmap_on_disk/HashmapMain_TypesExternal_Template.v
 create mode 100644 tests/coq/misc/External_TypesExternal.v
 create mode 100644 tests/coq/misc/External_TypesExternal_Template.v
 create mode 100644 tests/fstar/betree/BetreeMain.Types.fst
 delete mode 100644 tests/fstar/betree/BetreeMain.Types.fsti
 create mode 100644 tests/fstar/betree/BetreeMain.TypesExternal.fsti
 create mode 100644 tests/fstar/betree_back_stateful/BetreeMain.Types.fst
 delete mode 100644 tests/fstar/betree_back_stateful/BetreeMain.Types.fsti
 create mode 100644 tests/fstar/betree_back_stateful/BetreeMain.TypesExternal.fsti
 create mode 100644 tests/fstar/hashmap_on_disk/HashmapMain.Types.fst
 delete mode 100644 tests/fstar/hashmap_on_disk/HashmapMain.Types.fsti
 create mode 100644 tests/fstar/hashmap_on_disk/HashmapMain.TypesExternal.fsti
 create mode 100644 tests/fstar/misc/External.Types.fst
 delete mode 100644 tests/fstar/misc/External.Types.fsti
 create mode 100644 tests/fstar/misc/External.TypesExternal.fsti
 create mode 100644 tests/lean/BetreeMain/TypesExternal.lean
 create mode 100644 tests/lean/BetreeMain/TypesExternal_Template.lean
 create mode 100644 tests/lean/External/TypesExternal.lean
 create mode 100644 tests/lean/External/TypesExternal_Template.lean
 create mode 100644 tests/lean/HashmapMain/TypesExternal.lean
 create mode 100644 tests/lean/HashmapMain/TypesExternal_Template.lean

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index 31cb4b32..cc84b9fb 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -481,9 +481,19 @@ let export_types_group (fmt : Format.formatter) (config : gen_config)
       defs
   in
 
+  let dont_extract (d : Pure.type_decl) : bool =
+    match d.kind with
+    | Enum _ | Struct _ -> not config.extract_transparent
+    | Opaque -> not config.extract_opaque
+  in
+
   if List.exists (fun b -> b) builtin then
     (* Sanity check *)
     assert (List.for_all (fun b -> b) builtin)
+  else if List.exists dont_extract defs then
+    (* Check if we have to ignore declarations *)
+    (* Sanity check *)
+    assert (List.for_all dont_extract defs)
   else (
     (* Extract the type declarations.
 
@@ -873,6 +883,7 @@ type extract_file_info = {
   filename : string;
   namespace : string;
   in_namespace : bool;
+  open_namespace : bool;
   crate_name : string;
   rust_module_name : string;
   module_name : string;
@@ -931,8 +942,22 @@ let extract_file (config : gen_config) (ctx : gen_ctx) (fi : extract_file_info)
       (* Add the custom includes *)
       List.iter
         (fun m ->
-          Printf.fprintf out "Require Export %s.\n" m;
-          Printf.fprintf out "Import %s.\n" m)
+          (* TODO: I don't really understand how the "Require Export",
+             "Require Import", "Include" work.
+             I used to have:
+             {[
+               Require Export %s.
+               Import %s.
+             ]}
+
+             I now have:
+             {[
+               Require Import %s.
+               Include %s.
+             ]}
+          *)
+          Printf.fprintf out "Require Import %s.\n" m;
+          Printf.fprintf out "Include %s.\n" m)
         fi.custom_includes;
       Printf.fprintf out "Module %s.\n" fi.module_name
   | Lean ->
@@ -943,9 +968,10 @@ let extract_file (config : gen_config) (ctx : gen_ctx) (fi : extract_file_info)
       List.iter (fun m -> Printf.fprintf out "import %s\n" m) fi.custom_includes;
       (* Always open the Primitives namespace *)
       Printf.fprintf out "open Primitives\n";
-      (* If we are inside the namespace: declare it, otherwise: open it *)
-      if fi.in_namespace then Printf.fprintf out "\nnamespace %s\n" fi.namespace
-      else Printf.fprintf out "open %s\n" fi.namespace
+      (* If we are inside the namespace: declare it *)
+      if fi.in_namespace then Printf.fprintf out "\nnamespace %s\n" fi.namespace;
+      (* We might need to open the namespace *)
+      if fi.open_namespace then Printf.fprintf out "open %s\n" fi.namespace
   | HOL4 ->
       Printf.fprintf out "open primitivesLib divDefLib\n";
       (* Add the custom imports and includes *)
@@ -1250,12 +1276,72 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
      in
      let has_opaque_types = has_opaque_types || !Config.use_state in
 
-     (* Extract the types *)
+     (*
+      * Extract the types
+      *)
      (* If there are opaque types, we extract in an interface *)
-     (* TODO: for Lean and Coq: generate a template file *)
+     (* Extract the opaque type declarations, if needed *)
+     let opaque_types_module =
+       if has_opaque_types then (
+         (* For F*, we generate an .fsti, and let the user write the .fst.
+            For the other backends, we generate a template file as a model
+            for the file the user has to provide. *)
+         let module_suffix, opaque_imported_suffix, custom_msg =
+           match !Config.backend with
+           | FStar ->
+               ("TypesExternal", "TypesExternal", ": external type declarations")
+           | HOL4 | Coq | Lean ->
+               ( (* The name of the file we generate *)
+                 "TypesExternal_Template",
+                 (* The name of the file that will be imported by the Types
+                    module, and that the user has to provide. *)
+                 "TypesExternal",
+                 ": external types.\n\
+                  -- This is a template file: rename it to \
+                  \"TypesExternal.lean\" and fill the holes." )
+         in
+         let opaque_filename =
+           extract_filebasename ^ file_delimiter ^ module_suffix ^ opaque_ext
+         in
+         let opaque_module = crate_name ^ module_delimiter ^ module_suffix in
+         let opaque_imported_module =
+           crate_name ^ module_delimiter ^ opaque_imported_suffix
+         in
+         let opaque_config =
+           {
+             base_gen_config with
+             extract_opaque = true;
+             extract_transparent = false;
+             extract_types = true;
+             extract_trait_decls = true;
+             extract_state_type = !Config.use_state;
+             interface = true;
+           }
+         in
+         let file_info =
+           {
+             filename = opaque_filename;
+             namespace;
+             in_namespace = false;
+             open_namespace = false;
+             crate_name;
+             rust_module_name = crate.name;
+             module_name = opaque_module;
+             custom_msg;
+             custom_imports = [];
+             custom_includes = [];
+           }
+         in
+         extract_file opaque_config ctx file_info;
+         (* Return the additional dependencies *)
+         [ opaque_imported_module ])
+       else []
+     in
+
+     (* Extract the non opaque types *)
      let types_filename_ext =
        match !Config.backend with
-       | FStar -> if has_opaque_types then ".fsti" else ".fst"
+       | FStar -> ".fst"
        | Coq -> ".v"
        | Lean -> ".lean"
        | HOL4 -> "Script.sml"
@@ -1269,8 +1355,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
          base_gen_config with
          extract_types = true;
          extract_trait_decls = true;
-         extract_opaque = true;
-         extract_state_type = !Config.use_state;
+         extract_opaque = false;
          interface = has_opaque_types;
        }
      in
@@ -1279,12 +1364,13 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
          filename = types_filename;
          namespace;
          in_namespace = true;
+         open_namespace = false;
          crate_name;
          rust_module_name = crate.name;
          module_name = types_module;
          custom_msg = ": type definitions";
          custom_imports = [];
-         custom_includes = [];
+         custom_includes = opaque_types_module;
        }
      in
      extract_file types_config ctx file_info;
@@ -1307,6 +1393,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
             filename = template_clauses_filename;
             namespace;
             in_namespace = true;
+            open_namespace = false;
             crate_name;
             rust_module_name = crate.name;
             module_name = template_clauses_module;
@@ -1317,7 +1404,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
         in
         extract_file template_clauses_config ctx file_info);
 
-     (* Extract the opaque declarations, if needed *)
+     (* Extract the opaque fun declarations, if needed *)
      let opaque_funs_module =
        if has_opaque_funs then (
          (* For F*, we generate an .fsti, and let the user write the .fst.
@@ -1362,6 +1449,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
              filename = opaque_filename;
              namespace;
              in_namespace = false;
+             open_namespace = true;
              crate_name;
              rust_module_name = crate.name;
              module_name = opaque_module;
@@ -1401,6 +1489,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
          filename = fun_filename;
          namespace;
          in_namespace = true;
+         open_namespace = false;
          crate_name;
          rust_module_name = crate.name;
          module_name = fun_module;
@@ -1434,6 +1523,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
          filename = extract_filebasename ^ ext;
          namespace;
          in_namespace = true;
+         open_namespace = false;
          crate_name;
          rust_module_name = crate.name;
          module_name = crate_name;
diff --git a/tests/coq/array/Array.v b/tests/coq/array/Array.v
index 99ff3b03..105ce21f 100644
--- a/tests/coq/array/Array.v
+++ b/tests/coq/array/Array.v
@@ -528,4 +528,4 @@ Definition ite : result unit :=
   Return tt
 .
 
-End Array .
+End Array.
diff --git a/tests/coq/betree/BetreeMain_Funs.v b/tests/coq/betree/BetreeMain_Funs.v
index ede82492..aadaa20d 100644
--- a/tests/coq/betree/BetreeMain_Funs.v
+++ b/tests/coq/betree/BetreeMain_Funs.v
@@ -6,10 +6,10 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
-Require Export BetreeMain_Types.
-Import BetreeMain_Types.
-Require Export BetreeMain_FunsExternal.
-Import BetreeMain_FunsExternal.
+Require Import BetreeMain_Types.
+Include BetreeMain_Types.
+Require Import BetreeMain_FunsExternal.
+Include BetreeMain_FunsExternal.
 Module BetreeMain_Funs.
 
 (** [betree_main::betree::load_internal_node]: forward function
@@ -1230,4 +1230,4 @@ Definition main : result unit :=
 (** Unit test for [betree_main::main] *)
 Check (main )%return.
 
-End BetreeMain_Funs .
+End BetreeMain_Funs.
diff --git a/tests/coq/betree/BetreeMain_FunsExternal_Template.v b/tests/coq/betree/BetreeMain_FunsExternal_Template.v
index 4898acd4..36022a20 100644
--- a/tests/coq/betree/BetreeMain_FunsExternal_Template.v
+++ b/tests/coq/betree/BetreeMain_FunsExternal_Template.v
@@ -7,8 +7,8 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
-Require Export BetreeMain_Types.
-Import BetreeMain_Types.
+Require Import BetreeMain_Types.
+Include BetreeMain_Types.
 Module BetreeMain_FunsExternal_Template.
 
 (** [betree_main::betree_utils::load_internal_node]: forward function
@@ -43,4 +43,4 @@ Axiom core_option_Option_unwrap :
   forall(T : Type), option T -> state -> result (state * T)
 .
 
-End BetreeMain_FunsExternal_Template .
+End BetreeMain_FunsExternal_Template.
diff --git a/tests/coq/betree/BetreeMain_Types.v b/tests/coq/betree/BetreeMain_Types.v
index b729d1c3..22989256 100644
--- a/tests/coq/betree/BetreeMain_Types.v
+++ b/tests/coq/betree/BetreeMain_Types.v
@@ -6,6 +6,8 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
+Require Import BetreeMain_TypesExternal.
+Include BetreeMain_TypesExternal.
 Module BetreeMain_Types.
 
 (** [betree_main::betree::List]
@@ -113,7 +115,4 @@ mkbetree_BeTree_t {
 }
 .
 
-(** The state type used in the state-error monad *)
-Axiom state : Type.
-
-End BetreeMain_Types .
+End BetreeMain_Types.
diff --git a/tests/coq/betree/BetreeMain_TypesExternal.v b/tests/coq/betree/BetreeMain_TypesExternal.v
new file mode 100644
index 00000000..50c4a4f8
--- /dev/null
+++ b/tests/coq/betree/BetreeMain_TypesExternal.v
@@ -0,0 +1,15 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Module BetreeMain_TypesExternal.
+
+(** The state type used in the state-error monad *)
+Axiom state : Type.
+
+End BetreeMain_TypesExternal.
diff --git a/tests/coq/betree/BetreeMain_TypesExternal_Template.v b/tests/coq/betree/BetreeMain_TypesExternal_Template.v
new file mode 100644
index 00000000..651de2b7
--- /dev/null
+++ b/tests/coq/betree/BetreeMain_TypesExternal_Template.v
@@ -0,0 +1,15 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Module BetreeMain_TypesExternal_Template.
+
+(** The state type used in the state-error monad *)
+Axiom state : Type.
+
+End BetreeMain_TypesExternal_Template.
diff --git a/tests/coq/betree/_CoqProject b/tests/coq/betree/_CoqProject
index 9ab8ea9f..13e4b9c1 100644
--- a/tests/coq/betree/_CoqProject
+++ b/tests/coq/betree/_CoqProject
@@ -4,7 +4,9 @@
 -arg all
 
 BetreeMain_Types.v
+BetreeMain_TypesExternal_Template.v
 Primitives.v
 BetreeMain_FunsExternal_Template.v
 BetreeMain_Funs.v
+BetreeMain_TypesExternal.v
 BetreeMain_FunsExternal.v
diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v
index c08f7f7d..64de44a6 100644
--- a/tests/coq/hashmap/Hashmap_Funs.v
+++ b/tests/coq/hashmap/Hashmap_Funs.v
@@ -6,8 +6,8 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
-Require Export Hashmap_Types.
-Import Hashmap_Types.
+Require Import Hashmap_Types.
+Include Hashmap_Types.
 Module Hashmap_Funs.
 
 (** [hashmap::hash_key]: forward function
@@ -668,4 +668,4 @@ Definition test1 (n : nat) : result unit :=
       end))
 .
 
-End Hashmap_Funs .
+End Hashmap_Funs.
diff --git a/tests/coq/hashmap/Hashmap_Types.v b/tests/coq/hashmap/Hashmap_Types.v
index bfb5ae4b..80a43593 100644
--- a/tests/coq/hashmap/Hashmap_Types.v
+++ b/tests/coq/hashmap/Hashmap_Types.v
@@ -35,4 +35,4 @@ Arguments hashMap_max_load_factor { _ }.
 Arguments hashMap_max_load { _ }.
 Arguments hashMap_slots { _ }.
 
-End Hashmap_Types .
+End Hashmap_Types.
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
index 188c98b3..faba0afe 100644
--- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
+++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
@@ -6,10 +6,10 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
-Require Export HashmapMain_Types.
-Import HashmapMain_Types.
-Require Export HashmapMain_FunsExternal.
-Import HashmapMain_FunsExternal.
+Require Import HashmapMain_Types.
+Include HashmapMain_Types.
+Require Import HashmapMain_FunsExternal.
+Include HashmapMain_FunsExternal.
 Module HashmapMain_Funs.
 
 (** [hashmap_main::hashmap::hash_key]: forward function
@@ -717,4 +717,4 @@ Definition insert_on_disk
 Definition main : result unit :=
   Return tt.
 
-End HashmapMain_Funs .
+End HashmapMain_Funs.
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v
index b5a4a101..e10d02f6 100644
--- a/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v
+++ b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v
@@ -7,8 +7,8 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
-Require Export HashmapMain_Types.
-Import HashmapMain_Types.
+Require Import HashmapMain_Types.
+Include HashmapMain_Types.
 Module HashmapMain_FunsExternal_Template.
 
 (** [hashmap_main::hashmap_utils::deserialize]: forward function
@@ -23,4 +23,4 @@ Axiom hashmap_utils_serialize
   : hashmap_HashMap_t u64 -> state -> result (state * unit)
 .
 
-End HashmapMain_FunsExternal_Template .
+End HashmapMain_FunsExternal_Template.
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Types.v b/tests/coq/hashmap_on_disk/HashmapMain_Types.v
index 039b7e72..8d3d72aa 100644
--- a/tests/coq/hashmap_on_disk/HashmapMain_Types.v
+++ b/tests/coq/hashmap_on_disk/HashmapMain_Types.v
@@ -6,6 +6,8 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
+Require Import HashmapMain_TypesExternal.
+Include HashmapMain_TypesExternal.
 Module HashmapMain_Types.
 
 (** [hashmap_main::hashmap::List]
@@ -35,7 +37,4 @@ Arguments hashmap_HashMap_max_load_factor { _ }.
 Arguments hashmap_HashMap_max_load { _ }.
 Arguments hashmap_HashMap_slots { _ }.
 
-(** The state type used in the state-error monad *)
-Axiom state : Type.
-
-End HashmapMain_Types .
+End HashmapMain_Types.
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_TypesExternal.v b/tests/coq/hashmap_on_disk/HashmapMain_TypesExternal.v
new file mode 100644
index 00000000..87568232
--- /dev/null
+++ b/tests/coq/hashmap_on_disk/HashmapMain_TypesExternal.v
@@ -0,0 +1,15 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [hashmap_main]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Module HashmapMain_TypesExternal.
+
+(** The state type used in the state-error monad *)
+Axiom state : Type.
+
+End HashmapMain_TypesExternal.
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_TypesExternal_Template.v b/tests/coq/hashmap_on_disk/HashmapMain_TypesExternal_Template.v
new file mode 100644
index 00000000..391b2775
--- /dev/null
+++ b/tests/coq/hashmap_on_disk/HashmapMain_TypesExternal_Template.v
@@ -0,0 +1,15 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [hashmap_main]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Module HashmapMain_TypesExternal_Template.
+
+(** The state type used in the state-error monad *)
+Axiom state : Type.
+
+End HashmapMain_TypesExternal_Template.
diff --git a/tests/coq/hashmap_on_disk/_CoqProject b/tests/coq/hashmap_on_disk/_CoqProject
index a85fa1fe..41945494 100644
--- a/tests/coq/hashmap_on_disk/_CoqProject
+++ b/tests/coq/hashmap_on_disk/_CoqProject
@@ -6,5 +6,7 @@
 HashmapMain_Types.v
 Primitives.v
 HashmapMain_Funs.v
+HashmapMain_TypesExternal.v
 HashmapMain_FunsExternal_Template.v
 HashmapMain_FunsExternal.v
+HashmapMain_TypesExternal_Template.v
diff --git a/tests/coq/misc/Constants.v b/tests/coq/misc/Constants.v
index 20edb2b1..ad899f25 100644
--- a/tests/coq/misc/Constants.v
+++ b/tests/coq/misc/Constants.v
@@ -157,4 +157,4 @@ Definition s3_c : Pair_t u32 u32 := s3_body%global.
 Definition s4_body : result (Pair_t u32 u32) := mk_pair1 7%u32 8%u32.
 Definition s4_c : Pair_t u32 u32 := s4_body%global.
 
-End Constants .
+End Constants.
diff --git a/tests/coq/misc/External_Funs.v b/tests/coq/misc/External_Funs.v
index 8a3360bb..e9d39f66 100644
--- a/tests/coq/misc/External_Funs.v
+++ b/tests/coq/misc/External_Funs.v
@@ -6,10 +6,10 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
-Require Export External_Types.
-Import External_Types.
-Require Export External_FunsExternal.
-Import External_FunsExternal.
+Require Import External_Types.
+Include External_Types.
+Require Import External_FunsExternal.
+Include External_FunsExternal.
 Module External_Funs.
 
 (** [external::swap]: forward function
@@ -115,4 +115,4 @@ Definition test_swap_non_zero (x : u32) (st : state) : result (state * u32) :=
   if x0 s= 0%u32 then Fail_ Failure else Return (st1, x0)
 .
 
-End External_Funs .
+End External_Funs.
diff --git a/tests/coq/misc/External_FunsExternal.v b/tests/coq/misc/External_FunsExternal.v
index 07d43061..a8c5756a 100644
--- a/tests/coq/misc/External_FunsExternal.v
+++ b/tests/coq/misc/External_FunsExternal.v
@@ -7,7 +7,7 @@ Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
 Require Export External_Types.
-Import External_Types.
+Include External_Types.
 Module External_FunsExternal.
 
 (** [core::mem::swap]: forward function
diff --git a/tests/coq/misc/External_FunsExternal_Template.v b/tests/coq/misc/External_FunsExternal_Template.v
index 0977c3ae..31e69c39 100644
--- a/tests/coq/misc/External_FunsExternal_Template.v
+++ b/tests/coq/misc/External_FunsExternal_Template.v
@@ -7,8 +7,8 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
-Require Export External_Types.
-Import External_Types.
+Require Import External_Types.
+Include External_Types.
 Module External_FunsExternal_Template.
 
 (** [core::mem::swap]: forward function
@@ -41,4 +41,4 @@ Axiom core_option_Option_unwrap :
   forall(T : Type), option T -> state -> result (state * T)
 .
 
-End External_FunsExternal_Template .
+End External_FunsExternal_Template.
diff --git a/tests/coq/misc/External_Types.v b/tests/coq/misc/External_Types.v
index c638670c..b42c2ecf 100644
--- a/tests/coq/misc/External_Types.v
+++ b/tests/coq/misc/External_Types.v
@@ -6,13 +6,8 @@ Require Import Coq.ZArith.ZArith.
 Require Import List.
 Import ListNotations.
 Local Open Scope Primitives_scope.
+Require Import External_TypesExternal.
+Include External_TypesExternal.
 Module External_Types.
 
-(** [core::num::nonzero::NonZeroU32]
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 *)
-Axiom core_num_nonzero_NonZeroU32_t : Type.
-
-(** The state type used in the state-error monad *)
-Axiom state : Type.
-
-End External_Types .
+End External_Types.
diff --git a/tests/coq/misc/External_TypesExternal.v b/tests/coq/misc/External_TypesExternal.v
new file mode 100644
index 00000000..3f02b839
--- /dev/null
+++ b/tests/coq/misc/External_TypesExternal.v
@@ -0,0 +1,19 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [external]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Module External_TypesExternal.
+
+(** [core::num::nonzero::NonZeroU32]
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 *)
+Axiom core_num_nonzero_NonZeroU32_t : Type.
+
+(** The state type used in the state-error monad *)
+Axiom state : Type.
+
+End External_TypesExternal.
diff --git a/tests/coq/misc/External_TypesExternal_Template.v b/tests/coq/misc/External_TypesExternal_Template.v
new file mode 100644
index 00000000..7ba79d8e
--- /dev/null
+++ b/tests/coq/misc/External_TypesExternal_Template.v
@@ -0,0 +1,19 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [external]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes. *)
+Require Import Primitives.
+Import Primitives.
+Require Import Coq.ZArith.ZArith.
+Require Import List.
+Import ListNotations.
+Local Open Scope Primitives_scope.
+Module External_TypesExternal_Template.
+
+(** [core::num::nonzero::NonZeroU32]
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 *)
+Axiom core_num_nonzero_NonZeroU32_t : Type.
+
+(** The state type used in the state-error monad *)
+Axiom state : Type.
+
+End External_TypesExternal_Template.
diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v
index 4929ddd0..83c249c1 100644
--- a/tests/coq/misc/Loops.v
+++ b/tests/coq/misc/Loops.v
@@ -914,4 +914,4 @@ Definition list_nth_shared_mut_loop_pair_merge_back
   list_nth_shared_mut_loop_pair_merge_loop_back T n ls0 ls1 i ret
 .
 
-End Loops .
+End Loops.
diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v
index b044d24f..16a2e816 100644
--- a/tests/coq/misc/NoNestedBorrows.v
+++ b/tests/coq/misc/NoNestedBorrows.v
@@ -586,4 +586,4 @@ Definition test_shared_borrow_enum1 (l : List_t u32) : result u32 :=
 Definition test_shared_borrow_enum2 : result u32 :=
   Return 0%u32.
 
-End NoNestedBorrows .
+End NoNestedBorrows.
diff --git a/tests/coq/misc/Paper.v b/tests/coq/misc/Paper.v
index 4a49096f..6b110193 100644
--- a/tests/coq/misc/Paper.v
+++ b/tests/coq/misc/Paper.v
@@ -128,4 +128,4 @@ Definition call_choose (p : (u32 * u32)) : result u32 :=
   Return px0
 .
 
-End Paper .
+End Paper.
diff --git a/tests/coq/misc/PoloniusList.v b/tests/coq/misc/PoloniusList.v
index a0820e40..2371b1cc 100644
--- a/tests/coq/misc/PoloniusList.v
+++ b/tests/coq/misc/PoloniusList.v
@@ -41,4 +41,4 @@ Fixpoint get_list_at_x_back
   end
 .
 
-End PoloniusList .
+End PoloniusList.
diff --git a/tests/coq/misc/_CoqProject b/tests/coq/misc/_CoqProject
index 6884d5d9..0828bced 100644
--- a/tests/coq/misc/_CoqProject
+++ b/tests/coq/misc/_CoqProject
@@ -4,12 +4,14 @@
 -arg all
 
 Loops.v
+External_Types.v
 Primitives.v
 External_Funs.v
+Paper.v
+External_TypesExternal.v
 Constants.v
 PoloniusList.v
-External_Types.v
 NoNestedBorrows.v
 External_FunsExternal.v
+External_TypesExternal_Template.v
 External_FunsExternal_Template.v
-Paper.v
diff --git a/tests/coq/traits/Traits.v b/tests/coq/traits/Traits.v
index 50eaf848..ebdca4ec 100644
--- a/tests/coq/traits/Traits.v
+++ b/tests/coq/traits/Traits.v
@@ -611,4 +611,4 @@ Arguments CFn_t_call_mut { _ _ }.
 Definition incr_u32 (x : u32) : result u32 :=
   u32_add x 1%u32.
 
-End Traits .
+End Traits.
diff --git a/tests/fstar/betree/BetreeMain.Types.fst b/tests/fstar/betree/BetreeMain.Types.fst
new file mode 100644
index 00000000..b87219b2
--- /dev/null
+++ b/tests/fstar/betree/BetreeMain.Types.fst
@@ -0,0 +1,61 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: type definitions *)
+module BetreeMain.Types
+open Primitives
+include BetreeMain.TypesExternal
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** [betree_main::betree::List]
+    Source: 'src/betree.rs', lines 17:0-17:23 *)
+type betree_List_t (t : Type0) =
+| Betree_List_Cons : t -> betree_List_t t -> betree_List_t t
+| Betree_List_Nil : betree_List_t t
+
+(** [betree_main::betree::UpsertFunState]
+    Source: 'src/betree.rs', lines 63:0-63:23 *)
+type betree_UpsertFunState_t =
+| Betree_UpsertFunState_Add : u64 -> betree_UpsertFunState_t
+| Betree_UpsertFunState_Sub : u64 -> betree_UpsertFunState_t
+
+(** [betree_main::betree::Message]
+    Source: 'src/betree.rs', lines 69:0-69:23 *)
+type betree_Message_t =
+| Betree_Message_Insert : u64 -> betree_Message_t
+| Betree_Message_Delete : betree_Message_t
+| Betree_Message_Upsert : betree_UpsertFunState_t -> betree_Message_t
+
+(** [betree_main::betree::Leaf]
+    Source: 'src/betree.rs', lines 167:0-167:11 *)
+type betree_Leaf_t = { id : u64; size : u64; }
+
+(** [betree_main::betree::Internal]
+    Source: 'src/betree.rs', lines 156:0-156:15 *)
+type betree_Internal_t =
+{
+  id : u64; pivot : u64; left : betree_Node_t; right : betree_Node_t;
+}
+
+(** [betree_main::betree::Node]
+    Source: 'src/betree.rs', lines 179:0-179:9 *)
+and betree_Node_t =
+| Betree_Node_Internal : betree_Internal_t -> betree_Node_t
+| Betree_Node_Leaf : betree_Leaf_t -> betree_Node_t
+
+(** [betree_main::betree::Params]
+    Source: 'src/betree.rs', lines 187:0-187:13 *)
+type betree_Params_t = { min_flush_size : u64; split_size : u64; }
+
+(** [betree_main::betree::NodeIdCounter]
+    Source: 'src/betree.rs', lines 201:0-201:20 *)
+type betree_NodeIdCounter_t = { next_node_id : u64; }
+
+(** [betree_main::betree::BeTree]
+    Source: 'src/betree.rs', lines 218:0-218:17 *)
+type betree_BeTree_t =
+{
+  params : betree_Params_t;
+  node_id_cnt : betree_NodeIdCounter_t;
+  root : betree_Node_t;
+}
+
diff --git a/tests/fstar/betree/BetreeMain.Types.fsti b/tests/fstar/betree/BetreeMain.Types.fsti
deleted file mode 100644
index a098ec19..00000000
--- a/tests/fstar/betree/BetreeMain.Types.fsti
+++ /dev/null
@@ -1,63 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [betree_main]: type definitions *)
-module BetreeMain.Types
-open Primitives
-
-#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
-
-(** [betree_main::betree::List]
-    Source: 'src/betree.rs', lines 17:0-17:23 *)
-type betree_List_t (t : Type0) =
-| Betree_List_Cons : t -> betree_List_t t -> betree_List_t t
-| Betree_List_Nil : betree_List_t t
-
-(** [betree_main::betree::UpsertFunState]
-    Source: 'src/betree.rs', lines 63:0-63:23 *)
-type betree_UpsertFunState_t =
-| Betree_UpsertFunState_Add : u64 -> betree_UpsertFunState_t
-| Betree_UpsertFunState_Sub : u64 -> betree_UpsertFunState_t
-
-(** [betree_main::betree::Message]
-    Source: 'src/betree.rs', lines 69:0-69:23 *)
-type betree_Message_t =
-| Betree_Message_Insert : u64 -> betree_Message_t
-| Betree_Message_Delete : betree_Message_t
-| Betree_Message_Upsert : betree_UpsertFunState_t -> betree_Message_t
-
-(** [betree_main::betree::Leaf]
-    Source: 'src/betree.rs', lines 167:0-167:11 *)
-type betree_Leaf_t = { id : u64; size : u64; }
-
-(** [betree_main::betree::Internal]
-    Source: 'src/betree.rs', lines 156:0-156:15 *)
-type betree_Internal_t =
-{
-  id : u64; pivot : u64; left : betree_Node_t; right : betree_Node_t;
-}
-
-(** [betree_main::betree::Node]
-    Source: 'src/betree.rs', lines 179:0-179:9 *)
-and betree_Node_t =
-| Betree_Node_Internal : betree_Internal_t -> betree_Node_t
-| Betree_Node_Leaf : betree_Leaf_t -> betree_Node_t
-
-(** [betree_main::betree::Params]
-    Source: 'src/betree.rs', lines 187:0-187:13 *)
-type betree_Params_t = { min_flush_size : u64; split_size : u64; }
-
-(** [betree_main::betree::NodeIdCounter]
-    Source: 'src/betree.rs', lines 201:0-201:20 *)
-type betree_NodeIdCounter_t = { next_node_id : u64; }
-
-(** [betree_main::betree::BeTree]
-    Source: 'src/betree.rs', lines 218:0-218:17 *)
-type betree_BeTree_t =
-{
-  params : betree_Params_t;
-  node_id_cnt : betree_NodeIdCounter_t;
-  root : betree_Node_t;
-}
-
-(** The state type used in the state-error monad *)
-val state : Type0
-
diff --git a/tests/fstar/betree/BetreeMain.TypesExternal.fsti b/tests/fstar/betree/BetreeMain.TypesExternal.fsti
new file mode 100644
index 00000000..1b2c53a6
--- /dev/null
+++ b/tests/fstar/betree/BetreeMain.TypesExternal.fsti
@@ -0,0 +1,10 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: external type declarations *)
+module BetreeMain.TypesExternal
+open Primitives
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** The state type used in the state-error monad *)
+val state : Type0
+
diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Types.fst b/tests/fstar/betree_back_stateful/BetreeMain.Types.fst
new file mode 100644
index 00000000..b87219b2
--- /dev/null
+++ b/tests/fstar/betree_back_stateful/BetreeMain.Types.fst
@@ -0,0 +1,61 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: type definitions *)
+module BetreeMain.Types
+open Primitives
+include BetreeMain.TypesExternal
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** [betree_main::betree::List]
+    Source: 'src/betree.rs', lines 17:0-17:23 *)
+type betree_List_t (t : Type0) =
+| Betree_List_Cons : t -> betree_List_t t -> betree_List_t t
+| Betree_List_Nil : betree_List_t t
+
+(** [betree_main::betree::UpsertFunState]
+    Source: 'src/betree.rs', lines 63:0-63:23 *)
+type betree_UpsertFunState_t =
+| Betree_UpsertFunState_Add : u64 -> betree_UpsertFunState_t
+| Betree_UpsertFunState_Sub : u64 -> betree_UpsertFunState_t
+
+(** [betree_main::betree::Message]
+    Source: 'src/betree.rs', lines 69:0-69:23 *)
+type betree_Message_t =
+| Betree_Message_Insert : u64 -> betree_Message_t
+| Betree_Message_Delete : betree_Message_t
+| Betree_Message_Upsert : betree_UpsertFunState_t -> betree_Message_t
+
+(** [betree_main::betree::Leaf]
+    Source: 'src/betree.rs', lines 167:0-167:11 *)
+type betree_Leaf_t = { id : u64; size : u64; }
+
+(** [betree_main::betree::Internal]
+    Source: 'src/betree.rs', lines 156:0-156:15 *)
+type betree_Internal_t =
+{
+  id : u64; pivot : u64; left : betree_Node_t; right : betree_Node_t;
+}
+
+(** [betree_main::betree::Node]
+    Source: 'src/betree.rs', lines 179:0-179:9 *)
+and betree_Node_t =
+| Betree_Node_Internal : betree_Internal_t -> betree_Node_t
+| Betree_Node_Leaf : betree_Leaf_t -> betree_Node_t
+
+(** [betree_main::betree::Params]
+    Source: 'src/betree.rs', lines 187:0-187:13 *)
+type betree_Params_t = { min_flush_size : u64; split_size : u64; }
+
+(** [betree_main::betree::NodeIdCounter]
+    Source: 'src/betree.rs', lines 201:0-201:20 *)
+type betree_NodeIdCounter_t = { next_node_id : u64; }
+
+(** [betree_main::betree::BeTree]
+    Source: 'src/betree.rs', lines 218:0-218:17 *)
+type betree_BeTree_t =
+{
+  params : betree_Params_t;
+  node_id_cnt : betree_NodeIdCounter_t;
+  root : betree_Node_t;
+}
+
diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Types.fsti b/tests/fstar/betree_back_stateful/BetreeMain.Types.fsti
deleted file mode 100644
index a098ec19..00000000
--- a/tests/fstar/betree_back_stateful/BetreeMain.Types.fsti
+++ /dev/null
@@ -1,63 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [betree_main]: type definitions *)
-module BetreeMain.Types
-open Primitives
-
-#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
-
-(** [betree_main::betree::List]
-    Source: 'src/betree.rs', lines 17:0-17:23 *)
-type betree_List_t (t : Type0) =
-| Betree_List_Cons : t -> betree_List_t t -> betree_List_t t
-| Betree_List_Nil : betree_List_t t
-
-(** [betree_main::betree::UpsertFunState]
-    Source: 'src/betree.rs', lines 63:0-63:23 *)
-type betree_UpsertFunState_t =
-| Betree_UpsertFunState_Add : u64 -> betree_UpsertFunState_t
-| Betree_UpsertFunState_Sub : u64 -> betree_UpsertFunState_t
-
-(** [betree_main::betree::Message]
-    Source: 'src/betree.rs', lines 69:0-69:23 *)
-type betree_Message_t =
-| Betree_Message_Insert : u64 -> betree_Message_t
-| Betree_Message_Delete : betree_Message_t
-| Betree_Message_Upsert : betree_UpsertFunState_t -> betree_Message_t
-
-(** [betree_main::betree::Leaf]
-    Source: 'src/betree.rs', lines 167:0-167:11 *)
-type betree_Leaf_t = { id : u64; size : u64; }
-
-(** [betree_main::betree::Internal]
-    Source: 'src/betree.rs', lines 156:0-156:15 *)
-type betree_Internal_t =
-{
-  id : u64; pivot : u64; left : betree_Node_t; right : betree_Node_t;
-}
-
-(** [betree_main::betree::Node]
-    Source: 'src/betree.rs', lines 179:0-179:9 *)
-and betree_Node_t =
-| Betree_Node_Internal : betree_Internal_t -> betree_Node_t
-| Betree_Node_Leaf : betree_Leaf_t -> betree_Node_t
-
-(** [betree_main::betree::Params]
-    Source: 'src/betree.rs', lines 187:0-187:13 *)
-type betree_Params_t = { min_flush_size : u64; split_size : u64; }
-
-(** [betree_main::betree::NodeIdCounter]
-    Source: 'src/betree.rs', lines 201:0-201:20 *)
-type betree_NodeIdCounter_t = { next_node_id : u64; }
-
-(** [betree_main::betree::BeTree]
-    Source: 'src/betree.rs', lines 218:0-218:17 *)
-type betree_BeTree_t =
-{
-  params : betree_Params_t;
-  node_id_cnt : betree_NodeIdCounter_t;
-  root : betree_Node_t;
-}
-
-(** The state type used in the state-error monad *)
-val state : Type0
-
diff --git a/tests/fstar/betree_back_stateful/BetreeMain.TypesExternal.fsti b/tests/fstar/betree_back_stateful/BetreeMain.TypesExternal.fsti
new file mode 100644
index 00000000..1b2c53a6
--- /dev/null
+++ b/tests/fstar/betree_back_stateful/BetreeMain.TypesExternal.fsti
@@ -0,0 +1,10 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [betree_main]: external type declarations *)
+module BetreeMain.TypesExternal
+open Primitives
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** The state type used in the state-error monad *)
+val state : Type0
+
diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Types.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Types.fst
new file mode 100644
index 00000000..afebcde3
--- /dev/null
+++ b/tests/fstar/hashmap_on_disk/HashmapMain.Types.fst
@@ -0,0 +1,24 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [hashmap_main]: type definitions *)
+module HashmapMain.Types
+open Primitives
+include HashmapMain.TypesExternal
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** [hashmap_main::hashmap::List]
+    Source: 'src/hashmap.rs', lines 19:0-19:16 *)
+type hashmap_List_t (t : Type0) =
+| Hashmap_List_Cons : usize -> t -> hashmap_List_t t -> hashmap_List_t t
+| Hashmap_List_Nil : hashmap_List_t t
+
+(** [hashmap_main::hashmap::HashMap]
+    Source: 'src/hashmap.rs', lines 35:0-35:21 *)
+type hashmap_HashMap_t (t : Type0) =
+{
+  num_entries : usize;
+  max_load_factor : (usize & usize);
+  max_load : usize;
+  slots : alloc_vec_Vec (hashmap_List_t t);
+}
+
diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Types.fsti b/tests/fstar/hashmap_on_disk/HashmapMain.Types.fsti
deleted file mode 100644
index e77954ad..00000000
--- a/tests/fstar/hashmap_on_disk/HashmapMain.Types.fsti
+++ /dev/null
@@ -1,26 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [hashmap_main]: type definitions *)
-module HashmapMain.Types
-open Primitives
-
-#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
-
-(** [hashmap_main::hashmap::List]
-    Source: 'src/hashmap.rs', lines 19:0-19:16 *)
-type hashmap_List_t (t : Type0) =
-| Hashmap_List_Cons : usize -> t -> hashmap_List_t t -> hashmap_List_t t
-| Hashmap_List_Nil : hashmap_List_t t
-
-(** [hashmap_main::hashmap::HashMap]
-    Source: 'src/hashmap.rs', lines 35:0-35:21 *)
-type hashmap_HashMap_t (t : Type0) =
-{
-  num_entries : usize;
-  max_load_factor : (usize & usize);
-  max_load : usize;
-  slots : alloc_vec_Vec (hashmap_List_t t);
-}
-
-(** The state type used in the state-error monad *)
-val state : Type0
-
diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.TypesExternal.fsti b/tests/fstar/hashmap_on_disk/HashmapMain.TypesExternal.fsti
new file mode 100644
index 00000000..75747408
--- /dev/null
+++ b/tests/fstar/hashmap_on_disk/HashmapMain.TypesExternal.fsti
@@ -0,0 +1,10 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [hashmap_main]: external type declarations *)
+module HashmapMain.TypesExternal
+open Primitives
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** The state type used in the state-error monad *)
+val state : Type0
+
diff --git a/tests/fstar/misc/External.Types.fst b/tests/fstar/misc/External.Types.fst
new file mode 100644
index 00000000..4fbcec47
--- /dev/null
+++ b/tests/fstar/misc/External.Types.fst
@@ -0,0 +1,8 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [external]: type definitions *)
+module External.Types
+open Primitives
+include External.TypesExternal
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
diff --git a/tests/fstar/misc/External.Types.fsti b/tests/fstar/misc/External.Types.fsti
deleted file mode 100644
index 0cb9fd0e..00000000
--- a/tests/fstar/misc/External.Types.fsti
+++ /dev/null
@@ -1,14 +0,0 @@
-(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
-(** [external]: type definitions *)
-module External.Types
-open Primitives
-
-#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
-
-(** [core::num::nonzero::NonZeroU32]
-    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 *)
-val core_num_nonzero_NonZeroU32_t : Type0
-
-(** The state type used in the state-error monad *)
-val state : Type0
-
diff --git a/tests/fstar/misc/External.TypesExternal.fsti b/tests/fstar/misc/External.TypesExternal.fsti
new file mode 100644
index 00000000..4bfbe0c5
--- /dev/null
+++ b/tests/fstar/misc/External.TypesExternal.fsti
@@ -0,0 +1,14 @@
+(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *)
+(** [external]: external type declarations *)
+module External.TypesExternal
+open Primitives
+
+#set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
+
+(** [core::num::nonzero::NonZeroU32]
+    Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 *)
+val core_num_nonzero_NonZeroU32_t : Type0
+
+(** The state type used in the state-error monad *)
+val state : Type0
+
diff --git a/tests/lean/BetreeMain/Types.lean b/tests/lean/BetreeMain/Types.lean
index 6e528437..877508f6 100644
--- a/tests/lean/BetreeMain/Types.lean
+++ b/tests/lean/BetreeMain/Types.lean
@@ -1,6 +1,7 @@
 -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS
 -- [betree_main]: type definitions
 import Base
+import BetreeMain.TypesExternal
 open Primitives
 
 namespace betree_main
@@ -63,7 +64,4 @@ structure betree.BeTree where
   node_id_cnt : betree.NodeIdCounter
   root : betree.Node
 
-/- The state type used in the state-error monad -/
-axiom State : Type
-
 end betree_main
diff --git a/tests/lean/BetreeMain/TypesExternal.lean b/tests/lean/BetreeMain/TypesExternal.lean
new file mode 100644
index 00000000..1701eaaf
--- /dev/null
+++ b/tests/lean/BetreeMain/TypesExternal.lean
@@ -0,0 +1,7 @@
+-- [betree_main]: external types.
+import Base
+open Primitives
+
+/- The state type used in the state-error monad -/
+axiom State : Type
+
diff --git a/tests/lean/BetreeMain/TypesExternal_Template.lean b/tests/lean/BetreeMain/TypesExternal_Template.lean
new file mode 100644
index 00000000..bbac7e99
--- /dev/null
+++ b/tests/lean/BetreeMain/TypesExternal_Template.lean
@@ -0,0 +1,9 @@
+-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS
+-- [betree_main]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes.
+import Base
+open Primitives
+
+/- The state type used in the state-error monad -/
+axiom State : Type
+
diff --git a/tests/lean/External/Types.lean b/tests/lean/External/Types.lean
index 40f20cda..961f3e8a 100644
--- a/tests/lean/External/Types.lean
+++ b/tests/lean/External/Types.lean
@@ -1,15 +1,9 @@
 -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS
 -- [external]: type definitions
 import Base
+import External.TypesExternal
 open Primitives
 
 namespace external
 
-/- [core::num::nonzero::NonZeroU32]
-   Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 -/
-axiom core.num.nonzero.NonZeroU32 : Type
-
-/- The state type used in the state-error monad -/
-axiom State : Type
-
 end external
diff --git a/tests/lean/External/TypesExternal.lean b/tests/lean/External/TypesExternal.lean
new file mode 100644
index 00000000..7c30f792
--- /dev/null
+++ b/tests/lean/External/TypesExternal.lean
@@ -0,0 +1,11 @@
+-- [external]: external types.
+import Base
+open Primitives
+
+/- [core::num::nonzero::NonZeroU32]
+   Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 -/
+axiom core.num.nonzero.NonZeroU32 : Type
+
+/- The state type used in the state-error monad -/
+axiom State : Type
+
diff --git a/tests/lean/External/TypesExternal_Template.lean b/tests/lean/External/TypesExternal_Template.lean
new file mode 100644
index 00000000..85fef236
--- /dev/null
+++ b/tests/lean/External/TypesExternal_Template.lean
@@ -0,0 +1,13 @@
+-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS
+-- [external]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes.
+import Base
+open Primitives
+
+/- [core::num::nonzero::NonZeroU32]
+   Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 -/
+axiom core.num.nonzero.NonZeroU32 : Type
+
+/- The state type used in the state-error monad -/
+axiom State : Type
+
diff --git a/tests/lean/HashmapMain/Types.lean b/tests/lean/HashmapMain/Types.lean
index f7be6719..ae9ac999 100644
--- a/tests/lean/HashmapMain/Types.lean
+++ b/tests/lean/HashmapMain/Types.lean
@@ -1,6 +1,7 @@
 -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS
 -- [hashmap_main]: type definitions
 import Base
+import HashmapMain.TypesExternal
 open Primitives
 
 namespace hashmap_main
@@ -19,7 +20,4 @@ structure hashmap.HashMap (T : Type) where
   max_load : Usize
   slots : alloc.vec.Vec (hashmap.List T)
 
-/- The state type used in the state-error monad -/
-axiom State : Type
-
 end hashmap_main
diff --git a/tests/lean/HashmapMain/TypesExternal.lean b/tests/lean/HashmapMain/TypesExternal.lean
new file mode 100644
index 00000000..4e1cdbe9
--- /dev/null
+++ b/tests/lean/HashmapMain/TypesExternal.lean
@@ -0,0 +1,7 @@
+-- [hashmap_main]: external types.
+import Base
+open Primitives
+
+/- The state type used in the state-error monad -/
+axiom State : Type
+
diff --git a/tests/lean/HashmapMain/TypesExternal_Template.lean b/tests/lean/HashmapMain/TypesExternal_Template.lean
new file mode 100644
index 00000000..cfa8bbb1
--- /dev/null
+++ b/tests/lean/HashmapMain/TypesExternal_Template.lean
@@ -0,0 +1,9 @@
+-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS
+-- [hashmap_main]: external types.
+-- This is a template file: rename it to "TypesExternal.lean" and fill the holes.
+import Base
+open Primitives
+
+/- The state type used in the state-error monad -/
+axiom State : Type
+
-- 
cgit v1.3.1


From a17eef1053909117d75c9ea8eeaad786626cc05d Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 27 Nov 2023 14:15:01 +0100
Subject: Update the way the Primitives file is copied

---
 compiler/Translate.ml | 33 ++++++++++++++++++++-------------
 1 file changed, 20 insertions(+), 13 deletions(-)

(limited to 'compiler/Translate.ml')

diff --git a/compiler/Translate.ml b/compiler/Translate.ml
index cc84b9fb..37f58140 100644
--- a/compiler/Translate.ml
+++ b/compiler/Translate.ml
@@ -1206,20 +1206,27 @@ let translate_crate (filename : string) (dest_dir : string) (crate : crate) :
     match primitives_src_dest with
     | None -> ()
     | Some (primitives_src, primitives_destname) -> (
-        let src = open_in (exe_dir ^ primitives_src) in
-        let tgt_filename = Filename.concat dest_dir primitives_destname in
-        let tgt = open_out tgt_filename in
-        (* Very annoying: I couldn't find a "cp" function in the OCaml libraries... *)
         try
-          while true do
-            (* We copy line by line *)
-            let line = input_line src in
-            Printf.fprintf tgt "%s\n" line
-          done
-        with End_of_file ->
-          close_in src;
-          close_out tgt;
-          log#linfo (lazy ("Copied:    " ^ tgt_filename)))
+          (* TODO: stop copying the primitives file *)
+          let src = open_in (exe_dir ^ primitives_src) in
+          let tgt_filename = Filename.concat dest_dir primitives_destname in
+          let tgt = open_out tgt_filename in
+          (* Very annoying: I couldn't find a "cp" function in the OCaml libraries... *)
+          try
+            while true do
+              (* We copy line by line *)
+              let line = input_line src in
+              Printf.fprintf tgt "%s\n" line
+            done
+          with End_of_file ->
+            close_in src;
+            close_out tgt;
+            log#linfo (lazy ("Copied:    " ^ tgt_filename))
+        with Sys_error _ ->
+          log#error
+            "Could not copy the primitives file: %s.\n\
+             You will have to copy it/set up the project by hand."
+            primitives_src)
   in
 
   (* Extract the file(s) *)
-- 
cgit v1.3.1