From c61b32393508479657b51b777a0b4816815a55a5 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 31 Aug 2023 19:10:00 +0200
Subject: Make progress on Extract and ExtractBase

---
 compiler/ExtractBase.ml | 33 ++++++++++++++++++++++-----------
 1 file changed, 22 insertions(+), 11 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index d733c763..96ecfd42 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -586,6 +586,8 @@ type extraction_ctx = {
           in case a Rust function only has one backward translation
           and we filter the forward function because it returns unit.
         *)
+  trait_decl_id : trait_decl_id option;
+      (** If we are extracting a trait declaration, identifies it *)
 }
 
 (** Debugging function, used when communicating name collisions to the user,
@@ -885,12 +887,24 @@ let ctx_add_const_generic_params (vars : const_generic_var list)
       ctx_add_const_generic_var var.name var.index ctx)
     ctx vars
 
-let ctx_add_type_const_generic_params (tvars : type_var list)
-    (cgvars : const_generic_var list) (ctx : extraction_ctx) :
-    extraction_ctx * string list * string list =
-  let ctx, tys = ctx_add_type_params tvars ctx in
-  let ctx, cgs = ctx_add_const_generic_params cgvars ctx in
-  (ctx, tys, cgs)
+let ctx_add_trait_clauses (clauses : trait_clause list) (ctx : extraction_ctx) :
+    extraction_ctx * string list =
+  List.fold_left_map
+    (fun ctx (c : trait_clause) -> ctx_add_trait_clause c ctx)
+    ctx clauses
+
+(** Returns the lists of names for:
+    - the type variables
+    - the const generic variables
+    - the trait clauses
+  *)
+let ctx_add_generic_params (generics : generic_params) (ctx : extraction_ctx) :
+    extraction_ctx * string list * string list * string list =
+  let { types; const_generics; trait_clauses } = generics in
+  let ctx, tys = ctx_add_type_params types ctx in
+  let ctx, cgs = ctx_add_const_generic_params const_generics ctx in
+  let ctx, tcs = ctx_add_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 =
@@ -1003,14 +1017,11 @@ let ctx_add_fun_decl (trans_group : bool * pure_fun_translation)
     | None -> None
     | Some rg_id ->
         let rg = T.RegionGroupId.nth sg.regions_hierarchy rg_id in
-        let regions =
+        let region_names =
           List.map
-            (fun rid -> T.RegionVarId.nth sg.region_params rid)
+            (fun rid -> (T.RegionVarId.nth sg.generics.regions rid).name)
             rg.regions
         in
-        let region_names =
-          List.map (fun (r : T.region_var) -> r.name) regions
-        in
         Some { id = rg_id; region_names }
   in
   let is_opaque = def.body = None in
-- 
cgit v1.2.3


From 0023f814ce638cd9b04ead9ec2e0c194d5efaefd Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Fri, 1 Sep 2023 18:22:15 +0200
Subject: Make good progress on Extract.ml

---
 compiler/ExtractBase.ml | 47 ++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 44 insertions(+), 3 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 96ecfd42..2c704d3e 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -111,10 +111,10 @@ let decl_is_first_from_group (kind : decl_kind) : bool =
 let decl_is_not_last_from_group (kind : decl_kind) : bool =
   not (decl_is_last_from_group kind)
 
-(* TODO: this should a module we give to a functor! *)
-
 type type_decl_kind = Enum | Struct
 
+(* 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,
@@ -125,6 +125,9 @@ type type_decl_kind = Enum | Struct
     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;
@@ -288,6 +291,13 @@ type formatter = {
       (** Generates a type variable basename. *)
   const_generic_var_basename : StringSet.t -> string -> string;
       (** Generates a const generic variable basename. *)
+  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
@@ -396,6 +406,9 @@ type id =
   | TypeVarId of TypeVarId.id
   | ConstGenericVarId of ConstGenericVarId.id
   | VarId of VarId.id
+  | TraitDeclId of TraitDeclId.id
+  | TraitImplId of TraitImplId.id
+  | TraitClauseId of TraitClauseId.id
   | UnknownId
       (** Used for stored various strings like keywords, definitions which
           should always be in context, etc. and which can't be linked to one
@@ -718,6 +731,9 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | ConstGenericVarId id ->
       "const_generic_var_id: " ^ ConstGenericVarId.to_string id
   | VarId id -> "var_id: " ^ VarId.to_string id
+  | TraitDeclId id -> "trait_decl_id: " ^ TraitDeclId.to_string id
+  | TraitImplId id -> "trait_impl_id: " ^ TraitImplId.to_string id
+  | TraitClauseId id -> "trait_clause_id: " ^ TraitClauseId.to_string id
 
 (** We might not check for collisions for some specific ids (ex.: field names) *)
 let allow_collisions (id : id) : bool =
@@ -787,6 +803,14 @@ 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_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_impl (with_opaque_pre : bool) (id : trait_impl_id)
+    (ctx : extraction_ctx) : string =
+  ctx_get with_opaque_pre (TraitImplId id) ctx
+
 let ctx_get_var (id : VarId.id) (ctx : extraction_ctx) : string =
   let is_opaque = false in
   ctx_get is_opaque (VarId id) ctx
@@ -800,6 +824,11 @@ let ctx_get_const_generic_var (id : ConstGenericVarId.id) (ctx : extraction_ctx)
   let is_opaque = false in
   ctx_get is_opaque (ConstGenericVarId id) ctx
 
+let ctx_get_trait_clause_var (id : TraitClauseId.id) (ctx : extraction_ctx) :
+    string =
+  let is_opaque = false in
+  ctx_get is_opaque (TraitClauseId id) ctx
+
 let ctx_get_field (type_id : type_id) (field_id : FieldId.id)
     (ctx : extraction_ctx) : string =
   let is_opaque = false in
@@ -865,6 +894,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 trait clause name and add it to the context *)
+let ctx_add_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 (TraitClauseId id) name ctx in
+  (ctx, name)
+
 (** See {!ctx_add_var} *)
 let ctx_add_vars (vars : var list) (ctx : extraction_ctx) :
     extraction_ctx * string list =
@@ -890,7 +929,9 @@ let ctx_add_const_generic_params (vars : const_generic_var list)
 let ctx_add_trait_clauses (clauses : trait_clause list) (ctx : extraction_ctx) :
     extraction_ctx * string list =
   List.fold_left_map
-    (fun ctx (c : trait_clause) -> ctx_add_trait_clause c ctx)
+    (fun ctx (c : trait_clause) ->
+      let basename = ctx.fmt.trait_clause_basename ctx.names_map.names_set c in
+      ctx_add_trait_clause basename c.clause_id ctx)
     ctx clauses
 
 (** Returns the lists of names for:
-- 
cgit v1.2.3


From 4cf1217f593b46a17130403df85b5f39f9e3eb85 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 10:04:14 +0200
Subject: Improve the collision detection

---
 compiler/ExtractBase.ml | 70 ++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 54 insertions(+), 16 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 2c704d3e..02ff266e 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -458,21 +458,34 @@ type names_map = {
        *)
 }
 
-let names_map_add (id_to_string : id -> string) (is_opaque : bool) (id : id)
-    (name : string) (nm : names_map) : names_map =
-  (* Check if there is a clash *)
-  (match StringMap.find_opt name nm.name_to_id with
+(** Small helper to report name collision *)
+let report_name_collision (id_to_string : id -> string) (id1 : id) (id2 : id)
+    (name : string) : unit =
+  let id1 = "\n- " ^ id_to_string id1 in
+  let id2 = "\n- " ^ id_to_string id2 in
+  let err =
+    "Name clash detected: the following identifiers are bound to the same name \
+     \"" ^ name ^ "\":" ^ id1 ^ id2
+    ^ "\nYou may want to rename some of your definitions, or report an issue."
+  in
+  log#serror err;
+  raise (Failure err)
+
+let names_map_get_id_from_name (name : string) (nm : names_map) : id option =
+  StringMap.find_opt name nm.name_to_id
+
+let names_map_check_collision (id_to_string : id -> string) (id : id)
+    (name : string) (nm : names_map) : unit =
+  match names_map_get_id_from_name name nm with
   | None -> () (* Ok *)
   | Some clash ->
       (* There is a clash: print a nice debugging message for the user *)
-      let id1 = "\n- " ^ id_to_string clash in
-      let id2 = "\n- " ^ id_to_string id in
-      let err =
-        "Name clash detected: the following identifiers are bound to the same \
-         name \"" ^ name ^ "\":" ^ id1 ^ id2
-      in
-      log#serror err;
-      raise (Failure err));
+      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 =
+  (* Check if there is a clash *)
+  names_map_check_collision id_to_string id name nm;
   (* Sanity check *)
   assert (not (StringSet.mem name nm.names_set));
   (* Insert *)
@@ -743,17 +756,42 @@ let allow_collisions (id : id) : bool =
 
 let ctx_add (is_opaque : bool) (id : id) (name : string) (ctx : extraction_ctx)
     : extraction_ctx =
-  (* We do not use the same name map if we allow/disallow collisions *)
+  (* 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
+  (* 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: 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
+     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 (
     assert (not is_opaque);
+    (* Check with the other ids *)
+    names_map_check_collision id_to_string id name ctx.names_map;
     {
       ctx with
       unsafe_names_map = unsafe_names_map_add id name ctx.unsafe_names_map;
     })
   else
-    (* 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
+    (* 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.
+    *)
     let names_map =
       names_map_add id_to_string is_opaque id name ctx.names_map
     in
-- 
cgit v1.2.3


From 0cafb31dd42c95f22e0b6680531c27fa0508e376 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 13:32:43 +0200
Subject: Make progress on the extraction

---
 compiler/ExtractBase.ml | 57 ++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 47 insertions(+), 10 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 02ff266e..697b1027 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -408,7 +408,11 @@ type id =
   | VarId of VarId.id
   | TraitDeclId of TraitDeclId.id
   | TraitImplId of TraitImplId.id
-  | TraitClauseId of TraitClauseId.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
   | UnknownId
       (** Used for stored various strings like keywords, definitions which
           should always be in context, etc. and which can't be linked to one
@@ -746,7 +750,20 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | VarId id -> "var_id: " ^ VarId.to_string id
   | TraitDeclId id -> "trait_decl_id: " ^ TraitDeclId.to_string id
   | TraitImplId id -> "trait_impl_id: " ^ TraitImplId.to_string id
-  | TraitClauseId id -> "trait_clause_id: " ^ TraitClauseId.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: "
+      ^ TraitClauseId.to_string clause_id
+  | TraitItemClauseId (id, item_name, clause_id) ->
+      "trait_item_clause_id: decl_id:" ^ TraitDeclId.to_string id
+      ^ ", item name: " ^ item_name ^ ", clause_id: "
+      ^ TraitClauseId.to_string clause_id
+  | TraitAssocTypeId (id, type_name) ->
+      "trait_assoc_type_id: decl_id:" ^ TraitDeclId.to_string id
+      ^ ", type name: " ^ type_name
 
 (** We might not check for collisions for some specific ids (ex.: field names) *)
 let allow_collisions (id : id) : bool =
@@ -849,6 +866,26 @@ 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_assoc_type (id : trait_decl_id) (type_name : string)
+    (ctx : extraction_ctx) : 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
+  ctx_get with_opaque_pre (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
+
 let ctx_get_var (id : VarId.id) (ctx : extraction_ctx) : string =
   let is_opaque = false in
   ctx_get is_opaque (VarId id) ctx
@@ -862,10 +899,10 @@ let ctx_get_const_generic_var (id : ConstGenericVarId.id) (ctx : extraction_ctx)
   let is_opaque = false in
   ctx_get is_opaque (ConstGenericVarId id) ctx
 
-let ctx_get_trait_clause_var (id : TraitClauseId.id) (ctx : extraction_ctx) :
+let ctx_get_local_trait_clause (id : TraitClauseId.id) (ctx : extraction_ctx) :
     string =
   let is_opaque = false in
-  ctx_get is_opaque (TraitClauseId id) ctx
+  ctx_get is_opaque (LocalTraitClauseId id) ctx
 
 let ctx_get_field (type_id : type_id) (field_id : FieldId.id)
     (ctx : extraction_ctx) : string =
@@ -933,13 +970,13 @@ let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) :
   (ctx, name)
 
 (** Generate a unique trait clause name and add it to the context *)
-let ctx_add_trait_clause (basename : string) (id : TraitClauseId.id)
+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 (TraitClauseId id) name ctx in
+  let ctx = ctx_add is_opaque (LocalTraitClauseId id) name ctx in
   (ctx, name)
 
 (** See {!ctx_add_var} *)
@@ -964,12 +1001,12 @@ let ctx_add_const_generic_params (vars : const_generic_var list)
       ctx_add_const_generic_var var.name var.index ctx)
     ctx vars
 
-let ctx_add_trait_clauses (clauses : trait_clause list) (ctx : extraction_ctx) :
-    extraction_ctx * string list =
+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
-      ctx_add_trait_clause basename c.clause_id ctx)
+      ctx_add_local_trait_clause basename c.clause_id ctx)
     ctx clauses
 
 (** Returns the lists of names for:
@@ -982,7 +1019,7 @@ let ctx_add_generic_params (generics : generic_params) (ctx : extraction_ctx) :
   let { types; const_generics; trait_clauses } = generics in
   let ctx, tys = ctx_add_type_params types ctx in
   let ctx, cgs = ctx_add_const_generic_params const_generics ctx in
-  let ctx, tcs = ctx_add_trait_clauses trait_clauses ctx in
+  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) :
-- 
cgit v1.2.3


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/ExtractBase.ml | 63 ++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 55 insertions(+), 8 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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 =
-- 
cgit v1.2.3


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

(limited to 'compiler/ExtractBase.ml')

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,
-- 
cgit v1.2.3


From 0c0b7692cc3d95adf21bccf83d5bb2f81487ca4f Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 17:56:35 +0200
Subject: Register the names for the trait decls

---
 compiler/ExtractBase.ml | 78 ++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 70 insertions(+), 8 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 2855b3b9..7e6a2d40 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -242,6 +242,13 @@ type formatter = {
             the same purpose as in {!field:fun_name}.
           - loop identifier, if this is for a loop
        *)
+  trait_decl_name : trait_decl -> string;
+  trait_impl_name : trait_impl -> 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;
   opaque_pre : unit -> string;
       (** TODO: obsolete, remove.
 
@@ -410,7 +417,7 @@ type id =
   | TraitDeclId of TraitDeclId.id
   | TraitImplId of TraitImplId.id
   | LocalTraitClauseId of TraitClauseId.id
-  | TraitAssocTypeId of TraitDeclId.id * string  (** A trait associated type *)
+  | TraitItemId of TraitDeclId.id * string  (** A trait associated item *)
   | TraitParentClauseId of TraitDeclId.id * TraitClauseId.id
   | TraitItemClauseId of TraitDeclId.id * string * TraitClauseId.id
   | TraitSelfClauseId
@@ -798,16 +805,15 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       "trait_item_clause_id: decl_id:" ^ TraitDeclId.to_string id
       ^ ", item name: " ^ item_name ^ ", clause_id: "
       ^ TraitClauseId.to_string clause_id
-  | TraitAssocTypeId (id, type_name) ->
-      "trait_assoc_type_id: decl_id:" ^ TraitDeclId.to_string id
-      ^ ", type name: " ^ type_name
+  | TraitItemId (id, name) ->
+      "trait_item_id: decl_id:" ^ TraitDeclId.to_string id ^ ", type name: "
+      ^ 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 _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitAssocTypeId _
-    ->
+  | FieldId _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitItemId _ ->
       !Config.record_fields_short_names
   | _ -> false
 
@@ -910,10 +916,22 @@ 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_assoc_type (id : trait_decl_id) (type_name : string)
+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 (TraitAssocTypeId (id, type_name)) ctx
+  ctx_get is_opaque (TraitItemId (id, item_name)) ctx
+
+let ctx_get_trait_const (id : trait_decl_id) (item_name : string)
+    (ctx : extraction_ctx) : string =
+  ctx_get_trait_item id item_name ctx
+
+let ctx_get_trait_type (id : trait_decl_id) (item_name : string)
+    (ctx : extraction_ctx) : string =
+  ctx_get_trait_item id item_name ctx
+
+let ctx_get_trait_method (id : trait_decl_id) (item_name : string)
+    (ctx : extraction_ctx) : string =
+  ctx_get_trait_item id item_name ctx
 
 let ctx_get_trait_parent_clause (id : trait_decl_id) (clause : trait_clause_id)
     (ctx : extraction_ctx) : string =
@@ -1205,6 +1223,50 @@ let ctx_add_fun_decl (trans_group : bool * pure_fun_translation)
         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
+    =
+  let is_opaque = false in
+  let name = ctx.fmt.trait_impl_name 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
+  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
+  ctx_add is_opaque (TraitItemId (d.def_id, item)) name ctx
+
+let ctx_add_trait_method (d : trait_decl) (item : string) (ctx : extraction_ctx)
+    : extraction_ctx =
+  let is_opaque = false in
+  let name = ctx.fmt.trait_method_name d item in
+  ctx_add is_opaque (TraitItemId (d.def_id, item)) 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
+  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
+  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;
-- 
cgit v1.2.3


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/ExtractBase.ml | 4 ++++
 1 file changed, 4 insertions(+)

(limited to 'compiler/ExtractBase.ml')

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;
 }
-- 
cgit v1.2.3


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/ExtractBase.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/ExtractBase.ml')

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
-- 
cgit v1.2.3


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 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/ExtractBase.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;
-- 
cgit v1.2.3


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/ExtractBase.ml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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
-- 
cgit v1.2.3


From fcd1fbe048b55a89bd8ed34afa8ed2295798d3ec Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 20:12:59 +0200
Subject: Make progress registering the trait decl method names

---
 compiler/ExtractBase.ml | 74 +++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 60 insertions(+), 14 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 17f5b693..e4d1fb7b 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -417,7 +417,14 @@ type id =
   | TraitDeclId of TraitDeclId.id
   | TraitImplId of TraitImplId.id
   | LocalTraitClauseId of TraitClauseId.id
-  | TraitItemId of TraitDeclId.id * string  (** A trait associated item *)
+  | TraitMethodId of
+      TraitDeclId.id * string * LoopId.id option * 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
+          items per method.
+       *)
+  | TraitItemId of TraitDeclId.id * string
+      (** A trait associated item which is not a method *)
   | TraitParentClauseId of TraitDeclId.id * TraitClauseId.id
   | TraitItemClauseId of TraitDeclId.id * string * TraitClauseId.id
   | TraitSelfClauseId
@@ -677,6 +684,7 @@ 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
   (* TODO: factorize the pretty-printing with what is in PrintPure *)
   let get_type_name (id : type_id) : string =
     match id with
@@ -812,6 +820,24 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | TraitItemId (id, name) ->
       "trait_item_id: decl_id:" ^ TraitDeclId.to_string id ^ ", type name: "
       ^ name
+  | TraitMethodId (trait_decl_id, fun_name, lp_id, rg_id) ->
+      let trait_name =
+        Print.fun_name_to_string
+          (A.TraitDeclId.Map.find trait_decl_id trait_decls).name
+      in
+      let lp_kind =
+        match lp_id with
+        | None -> ""
+        | Some lp_id -> "loop " ^ LoopId.to_string lp_id ^ ", "
+      in
+
+      let fwd_back_kind =
+        match rg_id with
+        | None -> "forward"
+        | Some rg_id -> "backward " ^ RegionGroupId.to_string rg_id
+      in
+      "trait " ^ trait_name ^ " method name (" ^ lp_kind ^ fwd_back_kind ^ "): "
+      ^ fun_name
   | TraitSelfClauseId -> "trait_self_clause"
 
 (** We might not check for collisions for some specific ids (ex.: field names) *)
@@ -1185,11 +1211,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 : 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);
+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 =
@@ -1211,12 +1234,22 @@ let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
         in
         Some { id = rg_id; region_names }
   in
+  (* Add the function name *)
+  ctx.fmt.fun_name def.basename def.num_loops def.loop_id num_rgs rg_info
+    (keep_fwd, num_backs)
+
+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);
+  (* Lookup the LLBC def to compute the region group information *)
+  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.fmt.fun_name def.basename def.num_loops def.loop_id num_rgs rg_info
-      (keep_fwd, num_backs)
-  in
+  let def_name = ctx_compute_fun_name trans_group def ctx in
   let fun_id = (A.Regular def_id, def.loop_id, def.back_id) in
   let ctx = ctx_add is_opaque (FunId (FromLlbc fun_id)) def_name ctx in
   (* Add the name info *)
@@ -1251,11 +1284,24 @@ let ctx_add_trait_type (d : trait_decl) (item : string) (ctx : extraction_ctx) :
   let name = ctx.fmt.trait_type_name d item in
   ctx_add is_opaque (TraitItemId (d.def_id, item)) name ctx
 
-let ctx_add_trait_method (d : trait_decl) (item : string) (ctx : extraction_ctx)
-    : extraction_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
   let is_opaque = false in
-  let name = ctx.fmt.trait_method_name d item in
-  ctx_add is_opaque (TraitItemId (d.def_id, item)) name ctx
+  ctx_add is_opaque
+    (TraitMethodId (d.def_id, item_name, f.loop_id, f.back_id))
+    name ctx
 
 let ctx_add_trait_parent_clause (d : trait_decl) (clause : trait_clause)
     (ctx : extraction_ctx) : extraction_ctx =
-- 
cgit v1.2.3


From fd17736cbdb312578b2ea6de9a58febf83bd96c8 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 3 Sep 2023 20:41:42 +0200
Subject: Extract the trait decl methods

---
 compiler/ExtractBase.ml | 22 +++++++---------------
 1 file changed, 7 insertions(+), 15 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index e4d1fb7b..435aa10c 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -417,8 +417,7 @@ type id =
   | TraitDeclId of TraitDeclId.id
   | TraitImplId of TraitImplId.id
   | LocalTraitClauseId of TraitClauseId.id
-  | TraitMethodId of
-      TraitDeclId.id * string * LoopId.id option * T.RegionGroupId.id option
+  | 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
           items per method.
@@ -820,23 +819,17 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | TraitItemId (id, name) ->
       "trait_item_id: decl_id:" ^ TraitDeclId.to_string id ^ ", type name: "
       ^ name
-  | TraitMethodId (trait_decl_id, fun_name, lp_id, rg_id) ->
+  | TraitMethodId (trait_decl_id, fun_name, rg_id) ->
       let trait_name =
         Print.fun_name_to_string
           (A.TraitDeclId.Map.find trait_decl_id trait_decls).name
       in
-      let lp_kind =
-        match lp_id with
-        | None -> ""
-        | Some lp_id -> "loop " ^ LoopId.to_string lp_id ^ ", "
-      in
-
       let fwd_back_kind =
         match rg_id with
         | None -> "forward"
         | Some rg_id -> "backward " ^ RegionGroupId.to_string rg_id
       in
-      "trait " ^ trait_name ^ " method name (" ^ lp_kind ^ fwd_back_kind ^ "): "
+      "trait " ^ trait_name ^ " method name (" ^ fwd_back_kind ^ "): "
       ^ fun_name
   | TraitSelfClauseId -> "trait_self_clause"
 
@@ -960,8 +953,9 @@ let ctx_get_trait_type (id : trait_decl_id) (item_name : string)
   ctx_get_trait_item id item_name ctx
 
 let ctx_get_trait_method (id : trait_decl_id) (item_name : string)
-    (ctx : extraction_ctx) : string =
-  ctx_get_trait_item id item_name ctx
+    (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
 
 let ctx_get_trait_parent_clause (id : trait_decl_id) (clause : trait_clause_id)
     (ctx : extraction_ctx) : string =
@@ -1299,9 +1293,7 @@ let ctx_add_trait_method (d : trait_decl) (item_name : string) (f : fun_decl)
   let trans = A.FunDeclId.Map.find f.def_id ctx.trans_funs in
   let name = ctx_compute_fun_name trans f ctx in
   let is_opaque = false in
-  ctx_add is_opaque
-    (TraitMethodId (d.def_id, item_name, f.loop_id, f.back_id))
-    name ctx
+  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 =
-- 
cgit v1.2.3


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

---
 compiler/ExtractBase.ml | 22 +++++++++++++++++-----
 1 file changed, 17 insertions(+), 5 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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 =
-- 
cgit v1.2.3


From 5921be8e2e8955db5101354d8bf29ae6a3693f48 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 11 Sep 2023 06:35:07 +0200
Subject: Make progress on correctly handling trait method calls in the
 symbolic execution

---
 compiler/ExtractBase.ml | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 9c9e08a5..438a3475 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -703,10 +703,13 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       | FromLlbc (fid, lp_id, rg_id) ->
           let fun_name =
             match fid with
-            | Regular fid ->
+            | FunId (Regular fid) ->
                 Print.fun_name_to_string
                   (A.FunDeclId.Map.find fid fun_decls).name
-            | Assumed aid -> A.show_assumed_fun_id aid
+            | FunId (Assumed aid) -> A.show_assumed_fun_id aid
+            | TraitMethod _ ->
+                (* Shouldn't happen *)
+                raise (Failure "Unexpected")
           in
 
           let lp_kind =
@@ -908,7 +911,7 @@ let ctx_get_function (with_opaque_pre : bool) (id : fun_id)
 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 (Regular id, lp, rg)) ctx
+  ctx_get_function with_opaque_pre (FromLlbc (FunId (Regular id), lp, rg)) ctx
 
 let ctx_get_type (with_opaque_pre : bool) (id : type_id) (ctx : extraction_ctx)
     : string =
@@ -1212,7 +1215,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 (Regular def.body_id, None, None)) 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
       ctx
@@ -1256,7 +1259,7 @@ let ctx_add_fun_decl (trans_group : pure_fun_translation) (def : fun_decl)
   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 = (A.Regular def_id, def.loop_id, def.back_id) 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
   (* Add the name info *)
   {
@@ -1381,7 +1384,8 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map =
   in
   let assumed_functions =
     List.map
-      (fun (fid, rg, name) -> (FromLlbc (A.Assumed fid, None, rg), name))
+      (fun (fid, rg, name) ->
+        (FromLlbc (Pure.FunId (A.Assumed fid), None, rg), name))
       init.assumed_llbc_functions
     @ List.map (fun (fid, name) -> (Pure fid, name)) init.assumed_pure_functions
   in
-- 
cgit v1.2.3


From 378bfbd1be69ee54cfe7fad97ca3b09d0f80f62b Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 14 Sep 2023 00:24:29 +0200
Subject: Fix some issues with the name collisions

---
 compiler/ExtractBase.ml | 32 +++++++++++++++++++++++++++++---
 1 file changed, 29 insertions(+), 3 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 438a3475..6789b5b8 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -840,7 +840,8 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
 (** 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 _ ->
+  | FieldId _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitItemId _
+  | TraitMethodId _ ->
       !Config.record_fields_short_names
   | _ -> false
 
@@ -1285,19 +1286,29 @@ 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.
+     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
@@ -1307,6 +1318,11 @@ let ctx_add_trait_method (d : trait_decl) (item_name : string) (f : fun_decl)
   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
 
@@ -1314,12 +1330,22 @@ 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
-- 
cgit v1.2.3


From e8aa3804ef0134631cc16b257775ad8f98690c29 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 14 Sep 2023 00:42:46 +0200
Subject: Make progress on the extraction

---
 compiler/ExtractBase.ml | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 6789b5b8..612cf359 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -78,6 +78,7 @@ type decl_kind =
           F*:  [val x : Type0]
           Coq: [Axiom x : Type.]
        *)
+[@@deriving show]
 
 (** Return [true] if the declaration is the last from its group of declarations.
 
@@ -112,7 +113,7 @@ let decl_is_first_from_group (kind : decl_kind) : bool =
 let decl_is_not_last_from_group (kind : decl_kind) : bool =
   not (decl_is_last_from_group kind)
 
-type type_decl_kind = Enum | Struct
+type type_decl_kind = Enum | Struct [@@deriving show]
 
 (* TODO: this should be a module we give to a functor! *)
 
@@ -533,7 +534,8 @@ let names_map_check_collision (id_to_string : id -> string) (id : id)
   | None -> () (* Ok *)
   | Some clash ->
       (* There is a clash: print a nice debugging message for the user *)
-      report_name_collision id_to_string clash id name
+      if !Config.extract_fail_hard then
+        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 =
@@ -707,9 +709,12 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
                 Print.fun_name_to_string
                   (A.FunDeclId.Map.find fid fun_decls).name
             | FunId (Assumed aid) -> A.show_assumed_fun_id aid
-            | TraitMethod _ ->
+            | TraitMethod (_, method_name, _) ->
                 (* Shouldn't happen *)
-                raise (Failure "Unexpected")
+                if !Config.extract_fail_hard then raise (Failure "Unexpected")
+                else (
+                  log#serror ("Unexpected trait method: " ^ method_name);
+                  method_name)
           in
 
           let lp_kind =
@@ -899,7 +904,8 @@ let ctx_get (with_opaque_pre : bool) (id : id) (ctx : extraction_ctx) : string =
         if with_opaque_pre && is_opaque then ctx.fmt.opaque_pre () ^ s else s
     | None ->
         log#serror ("Could not find: " ^ id_to_string id ctx);
-        raise Not_found
+        if !Config.extract_fail_hard then raise (Failure "Not found")
+        else "(ERROR: \"" ^ id_to_string id ctx ^ "\")"
 
 let ctx_get_global (with_opaque_pre : bool) (id : A.GlobalDeclId.id)
     (ctx : extraction_ctx) : string =
-- 
cgit v1.2.3


From ee9de5ae43928fbd07d19200e6211168ed7552ab Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sat, 16 Sep 2023 21:41:44 +0200
Subject: Fix issues with name collisions

---
 compiler/ExtractBase.ml | 24 ++++++++++++++++++------
 1 file changed, 18 insertions(+), 6 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 612cf359..1996d38f 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -245,7 +245,7 @@ type formatter = {
           - loop identifier, if this is for a loop
        *)
   trait_decl_name : trait_decl -> string;
-  trait_impl_name : trait_impl -> string;
+  trait_impl_name : trait_decl -> trait_impl -> string;
   trait_parent_clause_name : trait_decl -> trait_clause -> string;
   trait_const_name : trait_decl -> string -> string;
   trait_type_name : trait_decl -> string -> string;
@@ -523,7 +523,8 @@ let report_name_collision (id_to_string : id -> string) (id1 : id) (id2 : id)
     ^ "\nYou may want to rename some of your definitions, or report an issue."
   in
   log#serror err;
-  raise (Failure err)
+  (* If we fail hard on errors, raise an exception *)
+  if !Config.extract_fail_hard then raise (Failure err)
 
 let names_map_get_id_from_name (name : string) (nm : names_map) : id option =
   StringMap.find_opt name nm.name_to_id
@@ -534,15 +535,21 @@ let names_map_check_collision (id_to_string : id -> string) (id : id)
   | None -> () (* Ok *)
   | Some clash ->
       (* There is a clash: print a nice debugging message for the user *)
-      if !Config.extract_fail_hard then
-        report_name_collision id_to_string clash id name
+      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 =
   (* Check if there is a clash *)
   names_map_check_collision id_to_string id name nm;
   (* Sanity check *)
-  assert (not (StringSet.mem name nm.names_set));
+  if StringSet.mem name nm.names_set then (
+    let err =
+      "Error when registering the name for id: " ^ id_to_string id
+      ^ ":\nThe chosen name is already in the names set: " ^ name
+    in
+    log#serror err;
+    (* If we fail hard on errors, raise an exception *)
+    if !Config.extract_fail_hard then raise (Failure err));
   (* Insert *)
   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
@@ -1284,8 +1291,13 @@ let ctx_add_trait_decl (d : trait_decl) (ctx : extraction_ctx) : extraction_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 d in
+  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)
-- 
cgit v1.2.3


From e6e749d47f05a6d48625c305b6af132440382efb Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sat, 16 Sep 2023 21:54:48 +0200
Subject: Fix more issues

---
 compiler/ExtractBase.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 1996d38f..28928325 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1339,7 +1339,7 @@ let ctx_add_trait_method (d : trait_decl) (item_name : string) (f : fun_decl)
   (* Add a prefix if necessary *)
   let name =
     if !Config.record_fields_short_names then name
-    else ctx.fmt.trait_decl_name d ^ 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
-- 
cgit v1.2.3


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 ++++++++++++++++++++++++++++++++++---------------
 1 file changed, 38 insertions(+), 17 deletions(-)

(limited to 'compiler/ExtractBase.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 =
-- 
cgit v1.2.3


From 8e86ab71527de2d997b6454dc61ab80d52bfdc56 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sat, 16 Sep 2023 23:36:29 +0200
Subject: Fix issues with name registration/lookup

---
 compiler/ExtractBase.ml | 77 +++++++++++++++++++++++++++++++++++--------------
 1 file changed, 55 insertions(+), 22 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 15acc492..4238d9af 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -713,6 +713,12 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   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 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
+    in
+    "trait_decl: " ^ trait_name ^ " (id: " ^ A.TraitDeclId.to_string id ^ ")"
+  in
   (* TODO: factorize the pretty-printing with what is in PrintPure *)
   let get_type_name (id : type_id) : string =
     match id with
@@ -735,12 +741,13 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
                 Print.fun_name_to_string
                   (A.FunDeclId.Map.find fid fun_decls).name
             | FunId (Assumed aid) -> A.show_assumed_fun_id aid
-            | TraitMethod (_, method_name, _) ->
+            | TraitMethod (trait_ref, method_name, _) ->
                 (* Shouldn't happen *)
                 if !Config.extract_fail_hard then raise (Failure "Unexpected")
-                else (
-                  log#serror ("Unexpected trait method: " ^ method_name);
-                  method_name)
+                else
+                  "Trait method: decl: "
+                  ^ TraitDeclId.to_string trait_ref.trait_decl_ref.trait_decl_id
+                  ^ ", method_name: " ^ method_name
           in
 
           let lp_kind =
@@ -800,8 +807,16 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
             if variant_id = option_some_id then "@option::Some"
             else if variant_id = option_none_id then "@option::None"
             else raise (Failure "Unreachable")
-        | Assumed (State | Vec | Fuel | Array | Slice | Str | Range) ->
-            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) ->
+            raise
+              (Failure
+                 ("Unreachable: variant id ("
+                 ^ VariantId.to_string variant_id
+                 ^ ") for " ^ show_type_id id))
         | AdtId id -> (
             let def = TypeDeclId.Map.find id type_decls in
             match def.kind with
@@ -844,28 +859,22 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
   | LocalTraitClauseId id ->
       "local_trait_clause_id: " ^ TraitClauseId.to_string id
   | TraitParentClauseId (id, clause_id) ->
-      "trait_parent_clause_id: decl_id:" ^ TraitDeclId.to_string id
-      ^ ", clause_id: "
+      "trait_parent_clause_id: " ^ trait_decl_id_to_string id ^ ", clause_id: "
       ^ TraitClauseId.to_string clause_id
   | TraitItemClauseId (id, item_name, clause_id) ->
-      "trait_item_clause_id: decl_id:" ^ TraitDeclId.to_string id
-      ^ ", item name: " ^ item_name ^ ", clause_id: "
+      "trait_item_clause_id: " ^ trait_decl_id_to_string id ^ ", item name: "
+      ^ item_name ^ ", clause_id: "
       ^ TraitClauseId.to_string clause_id
   | TraitItemId (id, name) ->
-      "trait_item_id: decl_id:" ^ TraitDeclId.to_string id ^ ", type name: "
-      ^ name
+      "trait_item_id: " ^ trait_decl_id_to_string id ^ ", type name: " ^ name
   | TraitMethodId (trait_decl_id, fun_name, rg_id) ->
-      let trait_name =
-        Print.fun_name_to_string
-          (A.TraitDeclId.Map.find trait_decl_id trait_decls).name
-      in
       let fwd_back_kind =
         match rg_id with
         | None -> "forward"
         | Some rg_id -> "backward " ^ RegionGroupId.to_string rg_id
       in
-      "trait " ^ trait_name ^ " method name (" ^ fwd_back_kind ^ "): "
-      ^ fun_name
+      trait_decl_id_to_string trait_decl_id
+      ^ ", 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
@@ -924,15 +933,39 @@ let ctx_add (is_opaque : bool) (id : id) (name : string) (ctx : extraction_ctx)
 (** [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 =
   (* We do not use the same name map if we allow/disallow collisions *)
-  if allow_collisions id then IdMap.find id ctx.unsafe_names_map.id_to_name
+  let map_to_string (m : string IdMap.t) : string =
+    "[\n"
+    ^ String.concat ","
+        (List.map
+           (fun (id, n) -> "\n  " ^ id_to_string id ctx ^ " -> " ^ n)
+           (IdMap.bindings m))
+    ^ "\n]"
+  in
+  if allow_collisions id then (
+    let m = ctx.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"
+          ^ 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
-    match IdMap.find_opt id ctx.names_map.id_to_name with
+    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
     | None ->
-        log#serror ("Could not find: " ^ id_to_string id ctx);
-        if !Config.extract_fail_hard then raise (Failure "Not found")
+        let err =
+          "Could not find: " ^ id_to_string id ctx ^ "\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 ^ "\")"
 
 let ctx_get_global (with_opaque_pre : bool) (id : A.GlobalDeclId.id)
-- 
cgit v1.2.3


From d2724812981075ab7edc9cf7fb3915908024410a Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Sun, 17 Sep 2023 00:30:32 +0200
Subject: Fix several issues with the extraction

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

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 4238d9af..a81ec052 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -952,7 +952,8 @@ let ctx_get (with_opaque_pre : bool) (id : id) (ctx : extraction_ctx) : string =
         in
         log#serror err;
         if !Config.extract_fail_hard then raise (Failure err)
-        else "(ERROR: \"" ^ id_to_string id ctx ^ "\")")
+        else
+          "(%%%ERROR: unknown identifier\": " ^ id_to_string id ctx ^ "\"%%%)")
   else
     let m = ctx.names_map.id_to_name in
     match IdMap.find_opt id m with
-- 
cgit v1.2.3


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/ExtractBase.ml | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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
-- 
cgit v1.2.3


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/ExtractBase.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/ExtractBase.ml')

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
-- 
cgit v1.2.3


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/ExtractBase.ml | 73 +++----------------------------------------------
 1 file changed, 4 insertions(+), 69 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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
-- 
cgit v1.2.3


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/ExtractBase.ml | 68 -------------------------------------------------
 1 file changed, 68 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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;
-- 
cgit v1.2.3


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/ExtractBase.ml | 1 +
 1 file changed, 1 insertion(+)

(limited to 'compiler/ExtractBase.ml')

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
-- 
cgit v1.2.3


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/ExtractBase.ml | 17 -----------------
 1 file changed, 17 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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;
-- 
cgit v1.2.3


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/ExtractBase.ml | 233 ++++++++++++------------------------------------
 1 file changed, 58 insertions(+), 175 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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 *)
-- 
cgit v1.2.3


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/ExtractBase.ml | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'compiler/ExtractBase.ml')

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,
-- 
cgit v1.2.3


From 9c230dddebb171ee1b3e0176838441163836b875 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 24 Oct 2023 18:16:53 +0200
Subject: Handle properly the builtin, non fallible functions

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

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index e004aba8..8f32ba44 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -22,8 +22,8 @@ type region_group_info = {
        *)
 }
 
-module StringSet = Collections.MakeSet (Collections.OrderedString)
-module StringMap = Collections.MakeMap (Collections.OrderedString)
+module StringSet = Collections.StringSet
+module StringMap = Collections.StringMap
 
 type name = Names.name
 type type_name = Names.type_name
-- 
cgit v1.2.3


From ece74df70f12790bab7ecfe0c590c2c637e89801 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Wed, 25 Oct 2023 11:40:31 +0200
Subject: Update following the addition of raw pointers

---
 compiler/ExtractBase.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 8f32ba44..3eef6b3b 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -758,7 +758,7 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
             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) ->
+        | Assumed (State | Array | Slice | Str | RawPtr _) ->
             raise
               (Failure
                  ("Unreachable: variant id ("
@@ -777,7 +777,8 @@ 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 | Array | Slice | Str) ->
+        | Assumed
+            (State | Result | Error | Fuel | Array | Slice | Str | RawPtr _) ->
             (* We can't directly have access to the fields of those types *)
             raise (Failure "Unreachable")
         | AdtId id -> (
-- 
cgit v1.2.3


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

---
 compiler/ExtractBase.ml | 2 ++
 1 file changed, 2 insertions(+)

(limited to 'compiler/ExtractBase.ml')

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,
-- 
cgit v1.2.3


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

---
 compiler/ExtractBase.ml | 165 ++++++++++++++++++++++++++++++------------------
 1 file changed, 102 insertions(+), 63 deletions(-)

(limited to 'compiler/ExtractBase.ml')

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 *)
-- 
cgit v1.2.3


From 1110b3da85e93ba0755a665edd5b8c986c54cef0 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 26 Oct 2023 16:15:35 +0200
Subject: Make minor modifications and update the array test for F*

---
 compiler/ExtractBase.ml | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 8f71116c..6faa40b2 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1332,22 +1332,20 @@ let default_fun_suffix (num_loops : int) (loop_id : LoopId.id option)
   let rg_suff =
     (* TODO: make all the backends match what is done for Lean *)
     match rg with
-    | None -> (
-        match !Config.backend with
-        | FStar | Coq | HOL4 -> "_fwd"
-        | Lean ->
-            (* 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)
-             *)
-            if num_backs = 1 && not keep_fwd then "_fwd" else "")
+    | 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 *)
-          match !Config.backend with
-          | FStar | Coq | HOL4 -> if not keep_fwd then "_fwd_back" else "_back"
-          | Lean -> if not keep_fwd then "" else "_back"
+          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
-- 
cgit v1.2.3


From b50498d74f8e0b4a5f53468200510edec9d9674a Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Fri, 27 Oct 2023 15:16:20 +0200
Subject: Fix minor issues in the name collision detection

---
 compiler/ExtractBase.ml | 32 +++++++++++++++++++++++---------
 1 file changed, 23 insertions(+), 9 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 6faa40b2..8ddb2ec6 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -501,6 +501,15 @@ 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
 
+(** Insert bindings in a names map without checking for collisions *)
+let names_map_add_unchecked (id : id) (name : string) (nm : names_map) :
+    names_map =
+  (* Insert *)
+  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
+  { id_to_name; name_to_id; names_set }
+
 let names_map_add (id_to_string : id -> string) (id : id) (name : string)
     (nm : names_map) : names_map =
   (* Check if there is a clash *)
@@ -515,10 +524,7 @@ let names_map_add (id_to_string : id -> string) (id : id) (name : string)
     (* If we fail hard on errors, raise an exception *)
     if !Config.extract_fail_hard then raise (Failure err));
   (* Insert *)
-  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
-  { id_to_name; name_to_id; names_set }
+  names_map_add_unchecked id 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
@@ -1235,10 +1241,8 @@ let initialize_names_maps (fmt : formatter) (init : names_map_init) : names_maps
         [ fmt.bool_name; fmt.char_name; fmt.str_name ]; int_names; init.keywords;
       ]
   in
-  let names_set = StringSet.of_list keywords in
-  let name_to_id =
-    StringMap.of_list (List.map (fun x -> (x, UnknownId)) 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. *)
@@ -1246,11 +1250,21 @@ let initialize_names_maps (fmt : formatter) (init : names_map_init) : names_maps
   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) *)
   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
-- 
cgit v1.2.3


From 9df1d191cfaf929b755e9d26d55811531acd939d Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Thu, 9 Nov 2023 11:21:53 +0100
Subject: Fix a small issue in AssociatedTypes

---
 compiler/ExtractBase.ml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

(limited to 'compiler/ExtractBase.ml')

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 8ddb2ec6..55b1bca3 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -8,7 +8,7 @@ module F = Format
 open ExtractBuiltin
 
 (** The local logger *)
-let log = L.pure_to_extract_log
+let log = L.extract_log
 
 type region_group_info = {
   id : RegionGroupId.id;
@@ -488,7 +488,7 @@ let report_name_collision (id_to_string : id -> string) (id1 : id) (id2 : id)
   in
   log#serror err;
   (* If we fail hard on errors, raise an exception *)
-  if !Config.extract_fail_hard then raise (Failure err)
+  if !Config.fail_hard then raise (Failure err)
 
 let names_map_get_id_from_name (name : string) (nm : names_map) : id option =
   StringMap.find_opt name nm.name_to_id
@@ -522,7 +522,7 @@ let names_map_add (id_to_string : id -> string) (id : id) (name : string)
     in
     log#serror err;
     (* If we fail hard on errors, raise an exception *)
-    if !Config.extract_fail_hard then raise (Failure err));
+    if !Config.fail_hard then raise (Failure err));
   (* Insert *)
   names_map_add_unchecked id name nm
 
@@ -691,7 +691,7 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
             | FunId (Assumed aid) -> A.show_assumed_fun_id aid
             | TraitMethod (trait_ref, method_name, _) ->
                 (* Shouldn't happen *)
-                if !Config.extract_fail_hard then raise (Failure "Unexpected")
+                if !Config.fail_hard then raise (Failure "Unexpected")
                 else
                   "Trait method: decl: "
                   ^ TraitDeclId.to_string trait_ref.trait_decl_ref.trait_decl_id
@@ -903,7 +903,7 @@ let names_maps_get (id_to_string : id -> string) (id : id) (nm : names_maps) :
           ^ map_to_string m
         in
         log#serror err;
-        if !Config.extract_fail_hard then raise (Failure 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
@@ -915,7 +915,7 @@ let names_maps_get (id_to_string : id -> string) (id : id) (nm : names_maps) :
           ^ map_to_string m
         in
         log#serror err;
-        if !Config.extract_fail_hard then raise (Failure err)
+        if !Config.fail_hard then raise (Failure err)
         else "(ERROR: \"" ^ id_to_string id ^ "\")"
 
 let ctx_get (id : id) (ctx : extraction_ctx) : string =
-- 
cgit v1.2.3


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

---
 compiler/ExtractBase.ml | 8 ++++++++
 1 file changed, 8 insertions(+)

(limited to 'compiler/ExtractBase.ml')

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
 
-- 
cgit v1.2.3