Renaming: more customisation

in particular, this avoids regression with reused struct fields getting renamed
with indices, which would have required changes in e.g.
`french_law/ocaml/bench.ml`

compiler/lcalc/to_ocaml.ml

@@ -735,7 +735,7 @@ let format_program
       ~reserved:ocaml_keywords
         (* TODO: add catala runtime built-ins as reserved as well ? *)
       ~reset_context_for_closed_terms:true ~skip_constant_binders:true
-      ~constant_binder_name:(Some "_")
+      ~constant_binder_name:(Some "_") ~namespaced_fields_constrs:true
   in
   let type_ordering =
     let open Scopelang.Dependency.TVertex in

compiler/lcalc/to_ocaml.mli

@@ -17,6 +17,8 @@
 open Catala_utils
 open Shared_ast
 
+val ocaml_keywords : string list
+
 (** Formats a lambda calculus program into a valid OCaml program *)
 
 val typ_needs_parens : typ -> bool

compiler/plugins/api_web.ml

@@ -37,16 +37,18 @@ module To_jsoo = struct
      other modules: here everything is flattened in the current namespace *)
   let format_struct_name ppf name =
     StructName.to_string name
+    |> String.to_ascii
+    |> String.uncapitalize_ascii
     |> String.map (function '.' -> '_' | c -> c)
-    |> String.to_snake_case
     |> Format.pp_print_string ppf
 
   (* Supersedes [To_ocaml.format_enum_name], which can refer to enums from other
      modules: here everything is flattened in the current namespace *)
   let format_enum_name ppf name =
     EnumName.to_string name
+    |> String.to_ascii
+    |> String.uncapitalize_ascii
     |> String.map (function '.' -> '_' | c -> c)
-    |> String.to_snake_case
     |> Format.pp_print_string ppf
 
   let format_tlit (fmt : Format.formatter) (l : typ_lit) : unit =
@@ -477,6 +479,19 @@ let run
     Driver.Passes.lcalc options ~includes ~optimize ~check_invariants
       ~closure_conversion ~typed:Expr.typed ~monomorphize_types
   in
+  let prg, ren_ctx =
+    Program.rename_ids prg ~reserved:To_ocaml.ocaml_keywords
+      ~reset_context_for_closed_terms:true ~skip_constant_binders:true
+      ~constant_binder_name:None ~namespaced_fields_constrs:true
+  in
+  let type_ordering =
+    let open Scopelang.Dependency.TVertex in
+    List.map
+      (function
+        | Struct s -> Struct (Expr.Renaming.struct_name ren_ctx s)
+        | Enum e -> Enum (Expr.Renaming.enum_name ren_ctx e))
+      type_ordering
+  in
   let jsoo_output_file, with_formatter =
     Driver.Commands.get_output_format options ~ext:"_api_web.ml" output
   in

compiler/plugins/explain.ml

@@ -624,6 +624,7 @@ let program_to_graph
               (Expr.Renaming.get_ctx
                  {
                    Expr.Renaming.reserved = [];
+                   sanitize_varname = String.to_snake_case;
                    reset_context_for_closed_terms = false;
                    skip_constant_binders = false;
                    constant_binder_name = None;

compiler/shared_ast/expr.ml

@@ -879,6 +879,7 @@ module Renaming = struct
 
   type config = {
     reserved : string list;
+    sanitize_varname : string -> string;
     reset_context_for_closed_terms : bool;
     skip_constant_binders : bool;
     constant_binder_name : string option;
@@ -887,6 +888,7 @@ module Renaming = struct
   type context = {
     bindCtx : (module BindlibCtxt);
     bcontext : DefaultBindlibCtxRename.ctxt;
+    vars : string -> string;
     scopes : ScopeName.t -> ScopeName.t;
     topdefs : TopdefName.t -> TopdefName.t;
     structs : StructName.t -> StructName.t;
@@ -956,6 +958,7 @@ module Renaming = struct
         List.fold_left
           (fun ctx name -> DefaultBindlibCtxRename.reserve_name name ctx)
           BindCtx.empty_ctxt cfg.reserved;
+      vars = cfg.sanitize_varname;
       scopes = Fun.id;
       topdefs = Fun.id;
       structs = Fun.id;
@@ -976,7 +979,7 @@ module Renaming = struct
     | EExternal { name = External_value d, pos }, m ->
       eexternal ~name:(External_value (ctx.topdefs d), pos) m
     | EAbs { binder; tys }, m ->
-      let vars, body, ctx = unmbind_in ctx ~fname:String.to_snake_case binder in
+      let vars, body, ctx = unmbind_in ctx ~fname:ctx.vars binder in
       let body = expr ctx body in
       let binder = bind vars body in
       eabs binder (List.map (typ ctx) tys) m

compiler/shared_ast/expr.mli

@@ -398,6 +398,7 @@ val remove_logging_calls :
 module Renaming : sig
   type config = {
     reserved : string list;  (** Use for keywords and built-ins *)
+    sanitize_varname : string -> string;  (** Typically String.to_snake_case *)
     reset_context_for_closed_terms : bool;  (** See [Bindlib.Rename] *)
     skip_constant_binders : bool;  (** See [Bindlib.Rename] *)
     constant_binder_name : string option;  (** See [Bindlib.Rename] *)

compiler/shared_ast/program.ml

@@ -97,19 +97,28 @@ let modules_to_list (mt : module_tree) =
   in
   List.rev (aux [] mt)
 
-(* Todo? - add handling for specific naming constraints (automatically convert
+let cap s = String.to_ascii s |> String.capitalize_ascii
-   to camel/snake-case, etc.) - register module names as reserved names *)
+let uncap s = String.to_ascii s |> String.uncapitalize_ascii
+
+(* Todo? - handle separate namespaces ? (e.g. allow a field and var to have the
+   same name for backends that support it) - register module names as reserved
+   names *)
 let rename_ids
     ~reserved
     ~reset_context_for_closed_terms
     ~skip_constant_binders
     ~constant_binder_name
+    ~namespaced_fields_constrs
+    ?(f_var = String.to_snake_case)
+    ?(f_struct = cap)
+    ?(f_field = uncap)
+    ?(f_enum = cap)
+    ?(f_constr = cap)
     p =
-  let cap s = String.to_camel_case s in
-  let uncap s = String.to_snake_case s in
   let cfg =
     {
       Expr.Renaming.reserved;
+      sanitize_varname = f_var;
       reset_context_for_closed_terms;
       skip_constant_binders;
       constant_binder_name;
@@ -119,6 +128,7 @@ let rename_ids
   (* Each module needs its separate ctx since resolution is qualified ; and name
      resolution in a given module must be processed consistently independently
      on the current context. *)
+  let ctx0 = ctx in
   let module PathMap = Map.Make (Uid.Path) in
   let pctxmap = PathMap.singleton [] ctx in
   let pctxmap, structs_map, fields_map, ctx_structs =
@@ -134,20 +144,23 @@ let rename_ids
           try pctxmap, PathMap.find path pctxmap
           with PathMap.Not_found _ -> PathMap.add path ctx pctxmap, ctx
         in
-        let id, ctx = Expr.Renaming.new_id ctx (cap str) in
+        let id, ctx = Expr.Renaming.new_id ctx (f_struct str) in
         let new_name = StructName.fresh path (id, pos) in
-        let ctx, fields_map, ctx_fields =
+        let ctx1, fields_map, ctx_fields =
           StructField.Map.fold
             (fun name ty (ctx, fields_map, ctx_fields) ->
               let str, pos = StructField.get_info name in
-              let id, ctx = Expr.Renaming.new_id ctx (uncap str) in
+              let id, ctx = Expr.Renaming.new_id ctx (f_field str) in
               let new_name = StructField.fresh (id, pos) in
               ( ctx,
                 StructField.Map.add name new_name fields_map,
                 StructField.Map.add new_name ty ctx_fields ))
             fields
-            (ctx, fields_map, StructField.Map.empty)
+            ( (if namespaced_fields_constrs then ctx0 else ctx),
+              fields_map,
+              StructField.Map.empty )
         in
+        let ctx = if namespaced_fields_constrs then ctx else ctx1 in
         ( PathMap.add path ctx pctxmap,
           StructName.Map.add name new_name structs_map,
           fields_map,
@@ -167,20 +180,23 @@ let rename_ids
           try pctxmap, PathMap.find path pctxmap
           with Not_found -> PathMap.add path ctx pctxmap, ctx
         in
-        let id, ctx = Expr.Renaming.new_id ctx (cap str) in
+        let id, ctx = Expr.Renaming.new_id ctx (f_enum str) in
         let new_name = EnumName.fresh path (id, pos) in
-        let ctx, constrs_map, ctx_constrs =
+        let ctx1, constrs_map, ctx_constrs =
           EnumConstructor.Map.fold
             (fun name ty (ctx, constrs_map, ctx_constrs) ->
               let str, pos = EnumConstructor.get_info name in
-              let id, ctx = Expr.Renaming.new_id ctx (cap str) in
+              let id, ctx = Expr.Renaming.new_id ctx (f_constr str) in
               let new_name = EnumConstructor.fresh (id, pos) in
               ( ctx,
                 EnumConstructor.Map.add name new_name constrs_map,
                 EnumConstructor.Map.add new_name ty ctx_constrs ))
             constrs
-            (ctx, constrs_map, EnumConstructor.Map.empty)
+            ( (if namespaced_fields_constrs then ctx0 else ctx),
+              constrs_map,
+              EnumConstructor.Map.empty )
         in
+        let ctx = if namespaced_fields_constrs then ctx else ctx1 in
         ( PathMap.add path ctx pctxmap,
           EnumName.Map.add name new_name enums_map,
           constrs_map,
@@ -218,7 +234,7 @@ let rename_ids
             try pctxmap, PathMap.find path pctxmap
             with Not_found -> PathMap.add path ctx pctxmap, ctx
           in
-          let id, ctx = Expr.Renaming.new_id ctx (uncap str) in
+          let id, ctx = Expr.Renaming.new_id ctx (f_var str) in
           let new_name = ScopeName.fresh path (id, pos) in
           ( PathMap.add path ctx pctxmap,
             ScopeName.Map.add name new_name scopes_map,
@@ -243,7 +259,7 @@ let rename_ids
             try pctxmap, PathMap.find path pctxmap
             with Not_found -> PathMap.add path ctx pctxmap, ctx
           in
-          let id, ctx = Expr.Renaming.new_id ctx (uncap str) in
+          let id, ctx = Expr.Renaming.new_id ctx (f_var str) in
           let new_name = TopdefName.fresh path (id, pos) in
           ( PathMap.add path ctx pctxmap,
             TopdefName.Map.add name new_name topdefs_map,

compiler/shared_ast/program.mli

@@ -62,12 +62,26 @@ val rename_ids :
   reset_context_for_closed_terms:bool ->
   skip_constant_binders:bool ->
   constant_binder_name:string option ->
+  namespaced_fields_constrs:bool ->
+  ?f_var:(string -> string) ->
+  ?f_struct:(string -> string) ->
+  ?f_field:(string -> string) ->
+  ?f_enum:(string -> string) ->
+  ?f_constr:(string -> string) ->
   ('a, 't) gexpr program ->
   ('a, 't) gexpr program * Expr.Renaming.context
 (** Renames all idents (variables, types, struct and enum names, fields and
     constructors) to dispel ambiguities in the target language. Names in
     [reserved], typically keywords and built-ins, will be avoided ; the meaning
-    of the flags is described in [Bindlib.Renaming].
+    of the following three flags is described in [Bindlib.Renaming].
+
+    if [namespaced_fields_constrs] is true, then struct fields and enum
+    constructors can reuse names from other fields/constructors or other idents.
+
+    The [f_*] optional arguments sanitize the different kinds of ids. The
+    default is what is used for OCaml: project to ASCII, capitalise structs,
+    enums (both modules in the backend) and constructors, lowercase fields, and
+    rewrite variables to snake case.
 
     In the returned program, it is safe to directly use `Bindlib.name_of` on
     variables for printing. The same is true for `StructName.get_info` etc. *)

tests/modules/good/output/mod_def.ml

@@ -19,13 +19,13 @@ module Str1 = struct
   type t = {fld1: Enum1.t; fld2: integer}
 end
 
-module SIn = struct
+module S_in = struct
   type t = unit
 end
 
 
-let s (s_in: SIn.t) : S.t =
+let s (s_in: S_in.t) : S.t =
-  let sr1: money =
+  let sr: money =
     match
       (match
          (handle_exceptions
@@ -56,7 +56,7 @@ let s (s_in: SIn.t) : S.t =
                                                  end_line=16; end_column=12;
                                                  law_headings=["Test modules + inclusions 1"]}])))
     | Eoption.ESome arg -> arg in
-  let e2: Enum1.t =
+  let e1: Enum1.t =
     match
       (match
          (handle_exceptions
@@ -86,7 +86,7 @@ let s (s_in: SIn.t) : S.t =
                                                  end_line=17; end_column=12;
                                                  law_headings=["Test modules + inclusions 1"]}])))
     | Eoption.ESome arg -> arg in
-  {S.sr = sr1; S.e1 = e2}
+  {S.sr = sr; S.e1 = e1}
 
 let half : integer -> decimal =
   fun (x: integer) ->

tests/name_resolution/good/let_in2.catala_en

@@ -45,20 +45,20 @@ module S = struct
   type t = {a: bool}
 end
 
-module SIn = struct
+module S_in = struct
   type t = {a_in: unit -> (bool) Eoption.t}
 end
 
 
-let s (s_in: SIn.t) : S.t =
+let s (s_in: S_in.t) : S.t =
-  let a1: unit -> (bool) Eoption.t = s_in.SIn.a_in in
+  let a: unit -> (bool) Eoption.t = s_in.S_in.a_in in
-  let a2: bool =
+  let a1: bool =
     match
       (match
          (handle_exceptions
             [|{filename="tests/name_resolution/good/let_in2.catala_en";
                start_line=7; start_column=18; end_line=7; end_column=19;
-               law_headings=["Article"]}|] ([|(a1 ())|]))
+               law_headings=["Article"]}|] ([|(a ())|]))
        with
        | Eoption.ENone _ ->
            ( if true then
@@ -79,11 +79,11 @@ let s (s_in: SIn.t) : S.t =
                               with
                               | Eoption.ENone _1 ->
                                   ( if true then
-                                     (Eoption.ESome (let a2 : bool = false
+                                     (Eoption.ESome (let a1 : bool = false
                                         in
-                                        (let a3 : bool = (o_or a2 true)
+                                        (let a2 : bool = (o_or a1 true)
                                         in
-                                        a3))) else (Eoption.ENone ()))
+                                        a2))) else (Eoption.ENone ()))
                               | Eoption.ESome x -> (Eoption.ESome x))|]))
                      with
                      | Eoption.ENone _1 ->
@@ -106,7 +106,7 @@ let s (s_in: SIn.t) : S.t =
                                                  end_line=7; end_column=19;
                                                  law_headings=["Article"]}])))
     | Eoption.ESome arg -> arg in
-  {S.a = a2}
+  {S.a = a1}
 
 let () =
   Runtime_ocaml.Runtime.register_module "Let_in2"

tests/scope/good/191_fix_record_name_confusion.catala_en

@@ -41,26 +41,26 @@ module ScopeA = struct
 end
 
 module ScopeB = struct
-  type t = {a1: bool}
+  type t = {a: bool}
 end
 
-module ScopeAIn = struct
+module ScopeA_in = struct
   type t = unit
 end
 
-module ScopeBIn = struct
+module ScopeB_in = struct
   type t = unit
 end
 
 
-let scope_a (scope_a_in: ScopeAIn.t) : ScopeA.t =
+let scope_a (scope_a_in: ScopeA_in.t) : ScopeA.t =
-  let a2: bool = true in
+  let a: bool = true in
-  {ScopeA.a = a2}
+  {ScopeA.a = a}
 
-let scope_b (scope_b_in: ScopeBIn.t) : ScopeB.t =
+let scope_b (scope_b_in: ScopeB_in.t) : ScopeB.t =
   let scope_a1: ScopeA.t = {ScopeA.a = ((scope_a (())).ScopeA.a)} in
-  let a2: bool = scope_a1.ScopeA.a in
+  let a: bool = scope_a1.ScopeA.a in
-  {ScopeB.a1 = a2}
+  {ScopeB.a = a}
 
 
 let entry_scopes = [