Add monomorphizing option

compiler/catala_utils/cli.ml

@@ -403,6 +403,15 @@ module Flags = struct
           "During the Lcalc->Scalc translation, uses special AST nodes for \
            higher-order operators rather than nested closures (useful for C)."
 
+  let monomorphize_types =
+    value
+    & flag
+    & info ["monomorphize-types"]
+        ~doc:
+          "In LCalc, replaces the polymorphic option type by monomorphized \
+           versions of the enumeration, and transform tuples into named \
+           structs. "
+
   let dead_value_assignment =
     value
     & flag

compiler/catala_utils/cli.mli

@@ -130,6 +130,7 @@ module Flags : sig
   val avoid_exceptions : bool Term.t
   val closure_conversion : bool Term.t
   val keep_special_ops : bool Term.t
+  val monomorphize_types : bool Term.t
   val dead_value_assignment : bool Term.t
   val no_struct_literals : bool Term.t
   val include_dirs : raw_file list Term.t

compiler/driver.ml

@@ -222,7 +222,8 @@ module Passes = struct
       ~check_invariants
       ~(typed : ty mark)
       ~avoid_exceptions
-      ~closure_conversion :
+      ~closure_conversion
+      ~monomorphize_types :
       untyped Lcalc.Ast.program * Scopelang.Dependency.TVertex.t list =
     let prg, type_ordering =
       dcalc options ~includes ~optimize ~check_invariants ~typed
@@ -267,17 +268,14 @@ module Passes = struct
             Optimizations.optimize_program prg)
           else prg
         in
-        match typed with
-        | Untyped _ -> prg
-        | Typed _ ->
-          Message.emit_debug "Retyping lambda calculus...";
-          let prg =
-            Program.untype (Typing.program ~leave_unresolved:true prg)
-          in
-          prg
-        | Custom _ -> assert false)
+        prg)
     in
-    prg, type_ordering
+    Message.emit_debug "Retyping lambda calculus...";
+    let prg = Typing.program ~leave_unresolved:true prg in
+    let prg =
+      if monomorphize_types then Lcalc.Monomorphize.program prg else prg
+    in
+    Program.untype prg, type_ordering
 
   let scalc
       options
@@ -288,11 +286,12 @@ module Passes = struct
       ~closure_conversion
       ~keep_special_ops
       ~dead_value_assignment
-      ~no_struct_literals :
+      ~no_struct_literals
+      ~monomorphize_types :
       Scalc.Ast.program * Scopelang.Dependency.TVertex.t list =
     let prg, type_ordering =
       lcalc options ~includes ~optimize ~check_invariants ~typed:Expr.untyped
-        ~avoid_exceptions ~closure_conversion
+        ~avoid_exceptions ~closure_conversion ~monomorphize_types
     in
     Message.emit_debug "Retyping lambda calculus...";
     let prg = Typing.program ~leave_unresolved:true prg in
@@ -718,10 +717,11 @@ module Commands = struct
       check_invariants
       avoid_exceptions
       closure_conversion
+      monomorphize_types
       ex_scope_opt =
     let prg, _ =
       Passes.lcalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion ~typed
+        ~avoid_exceptions ~closure_conversion ~typed ~monomorphize_types
     in
     let _output_file, with_output = get_output_format options output in
     with_output
@@ -756,6 +756,7 @@ module Commands = struct
         $ Cli.Flags.check_invariants
         $ Cli.Flags.avoid_exceptions
         $ Cli.Flags.closure_conversion
+        $ Cli.Flags.monomorphize_types
         $ Cli.Flags.ex_scope_opt)
 
   let interpret_lcalc
@@ -766,10 +767,11 @@ module Commands = struct
       check_invariants
       avoid_exceptions
       closure_conversion
+      monomorphize_types
       ex_scope =
     let prg, _ =
       Passes.lcalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion ~typed
+        ~avoid_exceptions ~closure_conversion ~monomorphize_types ~typed
     in
     Interpreter.load_runtime_modules prg;
     print_interpretation_results options Interpreter.interpret_program_lcalc prg
@@ -795,6 +797,7 @@ module Commands = struct
         $ Cli.Flags.check_invariants
         $ Cli.Flags.avoid_exceptions
         $ Cli.Flags.closure_conversion
+        $ Cli.Flags.monomorphize_types
         $ Cli.Flags.ex_scope)
 
   let ocaml
@@ -804,11 +807,11 @@ module Commands = struct
       optimize
       check_invariants
       avoid_exceptions
-      closure_conversion
       ex_scope_opt =
     let prg, type_ordering =
       Passes.lcalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion ~typed:Expr.typed
+        ~avoid_exceptions ~typed:Expr.typed ~closure_conversion:false
+        ~monomorphize_types:false
     in
     let output_file, with_output =
       get_output_format options ~ext:".ml" output
@@ -833,7 +836,6 @@ module Commands = struct
         $ Cli.Flags.optimize
         $ Cli.Flags.check_invariants
         $ Cli.Flags.avoid_exceptions
-        $ Cli.Flags.closure_conversion
         $ Cli.Flags.ex_scope_opt)
 
   let scalc
@@ -847,11 +849,12 @@ module Commands = struct
       keep_special_ops
       dead_value_assignment
       no_struct_literals
+      monomorphize_types
       ex_scope_opt =
     let prg, _ =
       Passes.scalc options ~includes ~optimize ~check_invariants
         ~avoid_exceptions ~closure_conversion ~keep_special_ops
-        ~dead_value_assignment ~no_struct_literals
+        ~dead_value_assignment ~no_struct_literals ~monomorphize_types
     in
     let _output_file, with_output = get_output_format options output in
     with_output
@@ -888,6 +891,7 @@ module Commands = struct
         $ Cli.Flags.keep_special_ops
         $ Cli.Flags.dead_value_assignment
         $ Cli.Flags.no_struct_literals
+        $ Cli.Flags.monomorphize_types
         $ Cli.Flags.ex_scope_opt)
 
   let python
@@ -902,6 +906,7 @@ module Commands = struct
       Passes.scalc options ~includes ~optimize ~check_invariants
         ~avoid_exceptions ~closure_conversion ~keep_special_ops:false
         ~dead_value_assignment:true ~no_struct_literals:false
+        ~monomorphize_types:false
     in
 
     let output_file, with_output =
@@ -932,6 +937,7 @@ module Commands = struct
       Passes.scalc options ~includes ~optimize ~check_invariants
         ~avoid_exceptions:false ~closure_conversion ~keep_special_ops:false
         ~dead_value_assignment:false ~no_struct_literals:false
+        ~monomorphize_types:false
     in
 
     let output_file, with_output = get_output_format options ~ext:".r" output in
@@ -957,6 +963,7 @@ module Commands = struct
       Passes.scalc options ~includes ~optimize ~check_invariants
         ~avoid_exceptions:true ~closure_conversion:true ~keep_special_ops:true
         ~dead_value_assignment:false ~no_struct_literals:true
+        ~monomorphize_types:true
     in
     let output_file, with_output = get_output_format options ~ext:".c" output in
     Message.emit_debug "Compiling program into C...";

compiler/driver.mli

@@ -53,6 +53,7 @@ module Passes : sig
     typed:'m Shared_ast.mark ->
     avoid_exceptions:bool ->
     closure_conversion:bool ->
+    monomorphize_types:bool ->
     Shared_ast.untyped Lcalc.Ast.program * Scopelang.Dependency.TVertex.t list
 
   val scalc :
@@ -65,6 +66,7 @@ module Passes : sig
     keep_special_ops:bool ->
     dead_value_assignment:bool ->
     no_struct_literals:bool ->
+    monomorphize_types:bool ->
     Scalc.Ast.program * Scopelang.Dependency.TVertex.t list
 end
 

compiler/lcalc/monomorphize.ml

@@ -0,0 +1,20 @@
+(* This file is part of the Catala compiler, a specification language for tax
+   and social benefits computation rules. Copyright (C) 2023 Inria, contributor:
+   Denis Merigoux <denis.merigoux@inria.fr>
+
+   Licensed under the Apache License, Version 2.0 (the "License"); you may not
+   use this file except in compliance with the License. You may obtain a copy of
+   the License at
+
+   http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+   License for the specific language governing permissions and limitations under
+   the License. *)
+
+open Shared_ast
+open Ast
+
+let program (_prg : typed program) : typed program = assert false

compiler/lcalc/monomorphize.mli

@@ -0,0 +1,21 @@
+(* This file is part of the Catala compiler, a specification language for tax
+   and social benefits computation rules. Copyright (C) 2023 Inria, contributor:
+   Denis Merigoux <denis.merigoux@inria.fr>
+
+   Licensed under the Apache License, Version 2.0 (the "License"); you may not
+   use this file except in compliance with the License. You may obtain a copy of
+   the License at
+
+   http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+   License for the specific language governing permissions and limitations under
+   the License. *)
+
+open Shared_ast
+open Ast
+
+val program : typed program -> typed program
+(** This function performs type monomorphization in a Catala program. *)

compiler/plugins/api_web.ml

@@ -436,12 +436,14 @@ let run
     check_invariants
     avoid_exceptions
     closure_conversion
+    monomorphize_types
     options =
   if not options.Cli.trace then
     Message.raise_error "This plugin requires the --trace flag.";
   let prg, type_ordering =
     Driver.Passes.lcalc options ~includes ~optimize ~check_invariants
       ~avoid_exceptions ~closure_conversion ~typed:Expr.typed
+      ~monomorphize_types
   in
   let modname =
     (* TODO: module directive support *)
@@ -480,6 +482,7 @@ let term =
   $ Cli.Flags.check_invariants
   $ Cli.Flags.avoid_exceptions
   $ Cli.Flags.closure_conversion
+  $ Cli.Flags.monomorphize_types
 
 let () =
   Driver.Plugin.register "api_web" term

compiler/plugins/json_schema.ml

@@ -212,11 +212,13 @@ let run
     check_invariants
     avoid_exceptions
     closure_conversion
+    monomorphize_types
     ex_scope
     options =
   let prg, _ =
     Driver.Passes.lcalc options ~includes ~optimize ~check_invariants
       ~avoid_exceptions ~closure_conversion ~typed:Expr.typed
+      ~monomorphize_types
   in
   let output_file, with_output =
     Driver.Commands.get_output_format options ~ext:"_schema.json" output
@@ -239,6 +241,7 @@ let term =
   $ Cli.Flags.check_invariants
   $ Cli.Flags.avoid_exceptions
   $ Cli.Flags.closure_conversion
+  $ Cli.Flags.monomorphize_types
   $ Cli.Flags.ex_scope
 
 let () =

compiler/plugins/python.ml

@@ -35,6 +35,7 @@ let run
     Driver.Passes.scalc options ~includes ~optimize ~check_invariants
       ~avoid_exceptions ~closure_conversion ~keep_special_ops:false
       ~dead_value_assignment:true ~no_struct_literals:false
+      ~monomorphize_types:false
   in
 
   let output_file, with_output = get_output_format options ~ext:".py" output in

compiler/scalc/to_c.mli

@@ -0,0 +1,21 @@
+(* This file is part of the Catala compiler, a specification language for tax
+   and social benefits computation rules. Copyright (C) 2023 Inria, contributor:
+   Denis Merigoux <denis.merigoux@inria.fr>
+
+   Licensed under the Apache License, Version 2.0 (the "License"); you may not
+   use this file except in compliance with the License. You may obtain a copy of
+   the License at
+
+   http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+   License for the specific language governing permissions and limitations under
+   the License. *)
+
+(** Formats a lambda calculus program into a valid C89 program *)
+
+val format_program :
+  Format.formatter -> Ast.program -> Scopelang.Dependency.TVertex.t list -> unit
+(** Usage [format_program fmt p type_dependencies_ordering] *)