Make progress

1 files changed, 23 insertions, 0 deletions

diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index bff6a360..3ba507a6 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -286,6 +286,8 @@ type formatter = {
        *)
   type_var_basename : StringSet.t -> string -> string;
       (** Generates a type variable basename. *)
+  const_generic_var_basename : StringSet.t -> string -> string;
+      (** Generates a const generic variable basename. *)
   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
@@ -392,6 +394,7 @@ type id =
           them here.
        *)
   | TypeVarId of TypeVarId.id
+  | ConstGenericVarId of ConstGenericVarId.id
   | VarId of VarId.id
   | UnknownId
       (** Used for stored various strings like keywords, definitions which
@@ -710,6 +713,8 @@ let id_to_string (id : id) (ctx : extraction_ctx) : string =
       "field name: " ^ field_name
   | UnknownId -> "keyword"
   | TypeVarId id -> "type_var_id: " ^ TypeVarId.to_string id
+  | ConstGenericVarId id ->
+      "const_generic_var_id: " ^ ConstGenericVarId.to_string id
   | VarId id -> "var_id: " ^ VarId.to_string id
 
 (** We might not check for collisions for some specific ids (ex.: field names) *)
@@ -788,6 +793,11 @@ let ctx_get_type_var (id : TypeVarId.id) (ctx : extraction_ctx) : string =
   let is_opaque = false in
   ctx_get is_opaque (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
+
 let ctx_get_field (type_id : type_id) (field_id : FieldId.id)
     (ctx : extraction_ctx) : string =
   let is_opaque = false in
@@ -823,6 +833,19 @@ let ctx_add_type_var (basename : string) (id : TypeVarId.id)
   let ctx = ctx_add is_opaque (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
+  (ctx, name)
+
 (** See {!ctx_add_type_var} *)
 let ctx_add_type_vars (vars : (string * TypeVarId.id) list)
     (ctx : extraction_ctx) : extraction_ctx * string list =