Renaming idents, second stage: use proper renaming in scalc and Python (

#666)

compiler/driver.ml

@@ -228,8 +228,11 @@ module Passes = struct
       ~check_invariants
       ~(typed : ty mark)
       ~closure_conversion
-      ~monomorphize_types :
-      typed Lcalc.Ast.program * Scopelang.Dependency.TVertex.t list =
+      ~monomorphize_types
+      ~renaming :
+      typed Lcalc.Ast.program
+      * Scopelang.Dependency.TVertex.t list
+      * Renaming.context option =
     let prg, type_ordering =
       dcalc options ~includes ~optimize ~check_invariants ~typed
     in
@@ -275,7 +278,19 @@ module Passes = struct
         prg, type_ordering)
       else prg, type_ordering
     in
-    prg, type_ordering
+    match renaming with
+    | None -> prg, type_ordering, None
+    | Some renaming ->
+      let prg, ren_ctx = Renaming.apply renaming prg in
+      let type_ordering =
+        let open Scopelang.Dependency.TVertex in
+        List.map
+          (function
+            | Struct s -> Struct (Renaming.struct_name ren_ctx s)
+            | Enum e -> Enum (Renaming.enum_name ren_ctx e))
+          type_ordering
+      in
+      prg, type_ordering, Some ren_ctx
 
   let scalc
       options
@@ -286,17 +301,39 @@ module Passes = struct
       ~keep_special_ops
       ~dead_value_assignment
       ~no_struct_literals
-      ~monomorphize_types :
-      Scalc.Ast.program * Scopelang.Dependency.TVertex.t list =
-    let prg, type_ordering =
+      ~monomorphize_types
+      ~renaming :
+      Scalc.Ast.program * Scopelang.Dependency.TVertex.t list * Renaming.context
+      =
+    let prg, type_ordering, renaming_context =
       lcalc options ~includes ~optimize ~check_invariants ~typed:Expr.typed
-        ~closure_conversion ~monomorphize_types
+        ~closure_conversion ~monomorphize_types ~renaming
+    in
+    let renaming_context =
+      match renaming_context with
+      | None ->
+        Renaming.get_ctx
+          {
+            reserved = [];
+            sanitize_varname = Fun.id;
+            reset_context_for_closed_terms = true;
+            skip_constant_binders = true;
+            constant_binder_name = None;
+          }
+      | Some r -> r
     in
     debug_pass_name "scalc";
     ( Scalc.From_lcalc.translate_program
-        ~config:{ keep_special_ops; dead_value_assignment; no_struct_literals }
+        ~config:
+          {
+            keep_special_ops;
+            dead_value_assignment;
+            no_struct_literals;
+            renaming_context;
+          }
         prg,
-      type_ordering )
+      type_ordering,
+      renaming_context )
 end
 
 module Commands = struct
@@ -711,9 +748,9 @@ module Commands = struct
       closure_conversion
       monomorphize_types
       ex_scope_opt =
-    let prg, _ =
+    let prg, _, _ =
       Passes.lcalc options ~includes ~optimize ~check_invariants
-        ~closure_conversion ~typed ~monomorphize_types
+        ~closure_conversion ~typed ~monomorphize_types ~renaming:None
     in
     let _output_file, with_output = get_output_format options output in
     with_output
@@ -759,9 +796,9 @@ module Commands = struct
       optimize
       check_invariants
       ex_scope_opt =
-    let prg, _ =
+    let prg, _, _ =
       Passes.lcalc options ~includes ~optimize ~check_invariants
-        ~closure_conversion ~monomorphize_types ~typed
+        ~closure_conversion ~monomorphize_types ~typed ~renaming:None
     in
     Interpreter.load_runtime_modules
       ~hashf:(Hash.finalise ~closure_conversion ~monomorphize_types)
@@ -809,9 +846,10 @@ module Commands = struct
       check_invariants
       closure_conversion
       ex_scope_opt =
-    let prg, type_ordering =
+    let prg, type_ordering, _ =
       Passes.lcalc options ~includes ~optimize ~check_invariants
         ~typed:Expr.typed ~closure_conversion ~monomorphize_types:false
+        ~renaming:(Some Lcalc.To_ocaml.renaming)
     in
     let output_file, with_output =
       get_output_format options ~ext:".ml" output
@@ -851,10 +889,10 @@ module Commands = struct
       no_struct_literals
       monomorphize_types
       ex_scope_opt =
-    let prg, _ =
+    let prg, _, _ =
       Passes.scalc options ~includes ~optimize ~check_invariants
         ~closure_conversion ~keep_special_ops ~dead_value_assignment
-        ~no_struct_literals ~monomorphize_types
+        ~no_struct_literals ~monomorphize_types ~renaming:None
     in
     let _output_file, with_output = get_output_format options output in
     with_output
@@ -900,10 +938,11 @@ module Commands = struct
       optimize
       check_invariants
       closure_conversion =
-    let prg, type_ordering =
+    let prg, type_ordering, _ren_ctx =
       Passes.scalc options ~includes ~optimize ~check_invariants
         ~closure_conversion ~keep_special_ops:false ~dead_value_assignment:true
         ~no_struct_literals:false ~monomorphize_types:false
+        ~renaming:(Some Scalc.To_python.renaming)
     in
 
     let output_file, with_output =
@@ -929,11 +968,11 @@ module Commands = struct
         $ Cli.Flags.closure_conversion)
 
   let c options includes output optimize check_invariants =
-    let prg, type_ordering =
+    let prg, type_ordering, _ren_ctx =
       Passes.scalc options ~includes ~optimize ~check_invariants
         ~closure_conversion:true ~keep_special_ops:true
         ~dead_value_assignment:false ~no_struct_literals:true
-        ~monomorphize_types:true
+        ~monomorphize_types:true ~renaming:(Some Scalc.To_c.renaming)
     in
     let output_file, with_output = get_output_format options ~ext:".c" output in
     Message.debug "Compiling program into C...";

compiler/driver.mli

@@ -53,7 +53,10 @@ module Passes : sig
     typed:'m Shared_ast.mark ->
     closure_conversion:bool ->
     monomorphize_types:bool ->
-    Shared_ast.typed Lcalc.Ast.program * Scopelang.Dependency.TVertex.t list
+    renaming:Shared_ast.Renaming.t option ->
+    Shared_ast.typed Lcalc.Ast.program
+    * Scopelang.Dependency.TVertex.t list
+    * Shared_ast.Renaming.context option
 
   val scalc :
     Global.options ->
@@ -65,7 +68,10 @@ module Passes : sig
     dead_value_assignment:bool ->
     no_struct_literals:bool ->
     monomorphize_types:bool ->
-    Scalc.Ast.program * Scopelang.Dependency.TVertex.t list
+    renaming:Shared_ast.Renaming.t option ->
+    Scalc.Ast.program
+    * Scopelang.Dependency.TVertex.t list
+    * Shared_ast.Renaming.context
 end
 
 module Commands : sig

compiler/lcalc/to_ocaml.ml

@@ -130,6 +130,13 @@ let ocaml_keywords =
     "Oper";
   ]
 
+let renaming =
+  Renaming.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 "_") ~namespaced_fields_constrs:true
+
 let format_struct_name (fmt : Format.formatter) (v : StructName.t) : unit =
   (match StructName.path v with
   | [] -> ()
@@ -414,6 +421,7 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
       Print.runtime_error er format_pos (Expr.pos e)
   | _ -> .
 
+(* TODO: move [embed_foo] to [Foo.embed] to protect from name clashes *)
 let format_struct_embedding
     (fmt : Format.formatter)
     ((struct_name, struct_fields) : StructName.t * typ StructField.Map.t) =
@@ -730,21 +738,6 @@ let format_program
     ~(hashf : Hash.t -> Hash.full)
     (p : 'm Ast.program)
     (type_ordering : Scopelang.Dependency.TVertex.t list) : unit =
-  let p, ren_ctx =
-    Program.rename_ids p
-      ~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 "_") ~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
   Format.pp_open_vbox fmt 0;
   Format.pp_print_string fmt header;
   check_and_reexport_used_modules fmt ~hashf

compiler/lcalc/to_ocaml.mli

@@ -17,7 +17,7 @@
 open Catala_utils
 open Shared_ast
 
-val ocaml_keywords : string list
+val renaming : Renaming.t
 
 (** Formats a lambda calculus program into a valid OCaml program *)
 

compiler/plugins/api_web.ml

@@ -475,22 +475,10 @@ let run
     monomorphize_types
     _options =
   let options = Global.enforce_options ~trace:true () in
-  let prg, type_ordering =
+  let prg, type_ordering, _ =
     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
+      ~renaming:(Some Lcalc.To_ocaml.renaming)
   in
   let jsoo_output_file, with_formatter =
     Driver.Commands.get_output_format options ~ext:"_api_web.ml" output

compiler/plugins/explain.ml

@@ -620,10 +620,10 @@ let program_to_graph
           let e = customize (Expr.unbox e) in
           let e = Expr.remove_logging_calls (Expr.unbox e) in
           let e =
-            Expr.Renaming.expr
-              (Expr.Renaming.get_ctx
+            Renaming.expr
+              (Renaming.get_ctx
                  {
-                   Expr.Renaming.reserved = [];
+                   Renaming.reserved = [];
                    sanitize_varname = String.to_snake_case;
                    reset_context_for_closed_terms = false;
                    skip_constant_binders = false;

compiler/plugins/json_schema.ml

@@ -213,9 +213,10 @@ let run
     monomorphize_types
     ex_scope
     options =
-  let prg, _ =
+  let prg, _, _ =
     Driver.Passes.lcalc options ~includes ~optimize ~check_invariants
       ~closure_conversion ~typed:Expr.typed ~monomorphize_types
+      ~renaming:(Some Lcalc.To_ocaml.renaming)
   in
   let output_file, with_output =
     Driver.Commands.get_output_format options ~ext:"_schema.json" output

compiler/plugins/python.ml

@@ -24,10 +24,11 @@ open Catala_utils
 
 let run includes output optimize check_invariants closure_conversion options =
   let open Driver.Commands in
-  let prg, type_ordering =
+  let prg, type_ordering, _ =
     Driver.Passes.scalc options ~includes ~optimize ~check_invariants
       ~closure_conversion ~keep_special_ops:false ~dead_value_assignment:true
       ~no_struct_literals:false ~monomorphize_types:false
+      ~renaming:(Some Scalc.To_python.renaming)
   in
 
   let output_file, with_output = get_output_format options ~ext:".py" output in

compiler/scalc/ast.ml

@@ -70,8 +70,8 @@ type stmt =
   | SFatalError of Runtime.error
   | SIfThenElse of { if_expr : expr; then_block : block; else_block : block }
   | SSwitch of {
-      switch_expr : expr;
-      switch_expr_typ : typ;
+      switch_var : VarName.t;
+      switch_var_typ : typ;
       enum_name : EnumName.t;
       switch_cases : switch_case list;
     }