From 85bbb7be1c39680bc63838e336bf21c035609506 Mon Sep 17 00:00:00 2001 From: Denis Merigoux Date: Tue, 19 Dec 2023 15:01:06 +0100 Subject: [PATCH] Add monomorphizing option --- compiler/catala_utils/cli.ml | 9 +++++++ compiler/catala_utils/cli.mli | 1 + compiler/driver.ml | 45 +++++++++++++++++++-------------- compiler/driver.mli | 2 ++ compiler/lcalc/monomorphize.ml | 20 +++++++++++++++ compiler/lcalc/monomorphize.mli | 21 +++++++++++++++ compiler/plugins/api_web.ml | 3 +++ compiler/plugins/json_schema.ml | 3 +++ compiler/plugins/python.ml | 1 + compiler/scalc/to_c.mli | 21 +++++++++++++++ 10 files changed, 107 insertions(+), 19 deletions(-) create mode 100644 compiler/lcalc/monomorphize.ml create mode 100644 compiler/lcalc/monomorphize.mli create mode 100644 compiler/scalc/to_c.mli diff --git a/compiler/catala_utils/cli.ml b/compiler/catala_utils/cli.ml index f77dda46..5a279e61 100644 --- a/compiler/catala_utils/cli.ml +++ b/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 diff --git a/compiler/catala_utils/cli.mli b/compiler/catala_utils/cli.mli index 783ec88a..2289fd42 100644 --- a/compiler/catala_utils/cli.mli +++ b/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 diff --git a/compiler/driver.ml b/compiler/driver.ml index 1db54ef0..3b412703 100644 --- a/compiler/driver.ml +++ b/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..."; diff --git a/compiler/driver.mli b/compiler/driver.mli index fa256891..2d4b3b2e 100644 --- a/compiler/driver.mli +++ b/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 diff --git a/compiler/lcalc/monomorphize.ml b/compiler/lcalc/monomorphize.ml new file mode 100644 index 00000000..f6a84391 --- /dev/null +++ b/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 + + 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 diff --git a/compiler/lcalc/monomorphize.mli b/compiler/lcalc/monomorphize.mli new file mode 100644 index 00000000..dadd64dd --- /dev/null +++ b/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 + + 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. *) diff --git a/compiler/plugins/api_web.ml b/compiler/plugins/api_web.ml index 99f27f94..7092bfc7 100644 --- a/compiler/plugins/api_web.ml +++ b/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 diff --git a/compiler/plugins/json_schema.ml b/compiler/plugins/json_schema.ml index 1582e0ea..358ba8ab 100644 --- a/compiler/plugins/json_schema.ml +++ b/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 () = diff --git a/compiler/plugins/python.ml b/compiler/plugins/python.ml index 4dfb8f7a..6c33511d 100644 --- a/compiler/plugins/python.ml +++ b/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 diff --git a/compiler/scalc/to_c.mli b/compiler/scalc/to_c.mli new file mode 100644 index 00000000..1a9a15e5 --- /dev/null +++ b/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 + + 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] *)