From 7c1f4cc02d4e8612b3a6a77904d5d0db583db9b0 Mon Sep 17 00:00:00 2001 From: Emile Rolley Date: Tue, 8 Mar 2022 15:52:26 +0100 Subject: [PATCH 1/2] refactor: group common functions related to backend_option in the Cli module --- build_system/clerk_driver.ml | 27 ++++------------- compiler/driver.ml | 21 ++++--------- compiler/lcalc/ast.ml | 4 +-- compiler/utils/cli.ml | 58 +++++++++++++++++++++++++++--------- compiler/utils/cli.mli | 37 +++++++++++++---------- 5 files changed, 78 insertions(+), 69 deletions(-) diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index c0d5fe7ee..015fbc0bf 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -130,21 +130,6 @@ let info = (**{1 Testing}*) -let catala_backend_to_string (backend : Cli.backend_option) : string = - match backend with - | Cli.Dcalc -> "Dcalc" - | Cli.Html -> "Html" - | Cli.Interpret -> "Interpret" - | Cli.Latex -> "Latex" - | Cli.Lcalc -> "Lcalc" - | Cli.Makefile -> "Makefile" - | Cli.OCaml -> "OCaml" - | Cli.Proof -> "Proof" - | Cli.Python -> "Python" - | Cli.Scalc -> "Scalc" - | Cli.Scopelang -> "Scopelang" - | Cli.Typecheck -> "Typecheck" - type expected_output_descr = { base_filename : string; output_dir : string; @@ -421,7 +406,8 @@ let collect_all_ninja_build let vars = [ ( "catala_cmd", - Nj.Expr.Lit (catala_backend_to_string expected_output.backend) + Nj.Expr.Lit + (Cli.catala_backend_option_to_string expected_output.backend) ); ("tested_file", Nj.Expr.Lit tested_file); ( "expected_output", @@ -429,12 +415,9 @@ let collect_all_ninja_build (expected_output.output_dir ^ expected_output.complete_filename) ); ] - in - let output_build_kind = - if reset_test_outputs then "reset" else "test" - in - let catala_backend = - catala_backend_to_string expected_output.backend + and output_build_kind = if reset_test_outputs then "reset" else "test" + and catala_backend = + Cli.catala_backend_option_to_string expected_output.backend in let get_rule_infos ?(rule_postfix = "") : diff --git a/compiler/driver.ml b/compiler/driver.ml index b03d402cd..4e5ac1962 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -80,22 +80,11 @@ let driver in Cli.locale_lang := language; let backend = - let backend = String.lowercase_ascii backend in - if backend = "makefile" then Cli.Makefile - else if backend = "latex" then Cli.Latex - else if backend = "html" then Cli.Html - else if backend = "interpret" then Cli.Interpret - else if backend = "ocaml" then Cli.OCaml - else if backend = "dcalc" then Cli.Dcalc - else if backend = "scopelang" then Cli.Scopelang - else if backend = "python" then Cli.Python - else if backend = "proof" then Cli.Proof - else if backend = "typecheck" then Cli.Typecheck - else if backend = "lcalc" then Cli.Lcalc - else if backend = "scalc" then Cli.Scalc - else - Errors.raise_error - "The selected backend (%s) is not supported by Catala" backend + match Cli.catala_backend_option_of_string backend with + | Some b -> b + | None -> + Errors.raise_error + "The selected backend (%s) is not supported by Catala" backend in let prgm = Surface.Parser_driver.parse_top_level_file source_file language diff --git a/compiler/lcalc/ast.ml b/compiler/lcalc/ast.ml index 0d8335986..cbc826037 100644 --- a/compiler/lcalc/ast.ml +++ b/compiler/lcalc/ast.ml @@ -121,7 +121,7 @@ let make_none (pos : Pos.t) : expr Pos.marked Bindlib.box = let make_some (e : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box = let pos = Pos.get_position @@ Bindlib.unbox e in let mark : 'a -> 'a Pos.marked = Pos.mark pos in - let+ e = e in + let+ e in mark @@ EInj (e, 1, option_enum, [ (D.TLit D.TUnit, pos); (D.TAny, pos) ]) (** [make_matchopt_with_abs_arms arg e_none e_some] build an expression @@ -134,7 +134,7 @@ let make_matchopt_with_abs_arms let pos = Pos.get_position @@ Bindlib.unbox arg in let mark : 'a -> 'a Pos.marked = Pos.mark pos in - let+ arg = arg and+ e_none = e_none and+ e_some = e_some in + let+ arg and+ e_none and+ e_some in mark @@ EMatch (arg, [ e_none; e_some ], option_enum) diff --git a/compiler/utils/cli.ml b/compiler/utils/cli.ml index 9e312571a..be230824a 100644 --- a/compiler/utils/cli.ml +++ b/compiler/utils/cli.ml @@ -17,6 +17,50 @@ type backend_lang = En | Fr | Pl +type backend_option = + | Dcalc + | Html + | Interpret + | Latex + | Lcalc + | Makefile + | OCaml + | Proof + | Python + | Scalc + | Scopelang + | Typecheck + +let catala_backend_option_to_string = function + | Dcalc -> "Dcalc" + | Html -> "Html" + | Interpret -> "Interpret" + | Latex -> "Latex" + | Lcalc -> "Lcalc" + | Makefile -> "Makefile" + | OCaml -> "OCaml" + | Proof -> "Proof" + | Python -> "Python" + | Scalc -> "Scalc" + | Scopelang -> "Scopelang" + | Typecheck -> "Typecheck" + +let catala_backend_option_of_string backend = + match String.lowercase_ascii backend with + | "dcalc" -> Some Dcalc + | "html" -> Some Html + | "interpret" -> Some Interpret + | "latex" -> Some Latex + | "lcalc" -> Some Lcalc + | "makefile" -> Some Makefile + | "ocaml" -> Some OCaml + | "proof" -> Some Proof + | "python" -> Some Python + | "scalc" -> Some Scalc + | "scopelang" -> Some Scopelang + | "typecheck" -> Some Typecheck + | _ -> None + (** Source files to be compiled *) let source_files : string list ref = ref [] @@ -85,20 +129,6 @@ let backend = ~doc: "Backend selection (see the list of commands for available options).") -type backend_option = - | Dcalc - | Html - | Interpret - | Latex - | Lcalc - | Makefile - | OCaml - | Proof - | Python - | Scalc - | Scopelang - | Typecheck - let language = Arg.( value diff --git a/compiler/utils/cli.mli b/compiler/utils/cli.mli index fd9bbdf9e..bc9d7d9c8 100644 --- a/compiler/utils/cli.mli +++ b/compiler/utils/cli.mli @@ -17,6 +17,28 @@ type backend_lang = En | Fr | Pl +type backend_option = + | Dcalc + | Html + | Interpret + | Latex + | Lcalc + | Makefile + | OCaml + | Proof + | Python + | Scalc + | Scopelang + | Typecheck + +val catala_backend_option_to_string : backend_option -> string +(** [catala_backend_to_string backend] returns the string representation of the + given [backend].*) + +val catala_backend_option_of_string : string -> backend_option option +(** [catala_backend_option_of_string backend] returns the {!type: + backend_option} corresponding to the [backend] string. *) + (** {2 Configuration globals} *) val source_files : string list ref @@ -50,21 +72,6 @@ val unstyled : bool Cmdliner.Term.t val trace_opt : bool Cmdliner.Term.t val wrap_weaved_output : bool Cmdliner.Term.t val backend : string Cmdliner.Term.t - -type backend_option = - | Dcalc - | Html - | Interpret - | Latex - | Lcalc - | Makefile - | OCaml - | Proof - | Python - | Scalc - | Scopelang - | Typecheck - val language : string option Cmdliner.Term.t val max_prec_digits_opt : int option Cmdliner.Term.t val ex_scope : string option Cmdliner.Term.t From 709d4e5ae5f0ae3c645755c4a55ecec08bd81487 Mon Sep 17 00:00:00 2001 From: Emile Rolley Date: Tue, 8 Mar 2022 16:13:47 +0100 Subject: [PATCH 2/2] fix(lcalc): disable ocamlformat for let+ expressions --- compiler/lcalc/ast.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/compiler/lcalc/ast.ml b/compiler/lcalc/ast.ml index cbc826037..c71bb70f1 100644 --- a/compiler/lcalc/ast.ml +++ b/compiler/lcalc/ast.ml @@ -121,7 +121,8 @@ let make_none (pos : Pos.t) : expr Pos.marked Bindlib.box = let make_some (e : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box = let pos = Pos.get_position @@ Bindlib.unbox e in let mark : 'a -> 'a Pos.marked = Pos.mark pos in - let+ e in + let+ e = e [@ocamlformat "disable"] in + mark @@ EInj (e, 1, option_enum, [ (D.TLit D.TUnit, pos); (D.TAny, pos) ]) (** [make_matchopt_with_abs_arms arg e_none e_some] build an expression @@ -133,8 +134,7 @@ let make_matchopt_with_abs_arms (e_some : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box = let pos = Pos.get_position @@ Bindlib.unbox arg in let mark : 'a -> 'a Pos.marked = Pos.mark pos in - - let+ arg and+ e_none and+ e_some in + let+ arg = arg and+ e_none = e_none and+ e_some = e_some [@ocamlformat "disable"] in mark @@ EMatch (arg, [ e_none; e_some ], option_enum)