CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Command-line: use a record for the options

Browse Source 
Should make it much easier and less error-prone to add new options. There is
still a bit of boiler-plate, but at least it's contained in the Cli.options
function and doesn't transpire in the interfaces.
This commit is contained in:
Louis Gesbert 2022-03-04 19:25:06 +01:00
parent 5a186f8cfd
commit 071ec35234
6 changed files with 2249 additions and 2339 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/catala_web_interpreter.ml
View File

@ -8,9 +8,19 @@ let _ =
(language : Js.js_string Js.t) (trace : bool) = (language : Js.js_string Js.t) (trace : bool) =
driver driver
(Contents (Js.to_string contents)) (Contents (Js.to_string contents))
false false false false "Interpret" {
(Some (Js.to_string language)) Utils.Cli.debug = false;
None trace false false unstyled = false;
(Some (Js.to_string scope)) wrap_weaved_output = false;
None avoid_exceptions = false;
backend = "Interpret";
plugins_dirs = [];
language = Some (Js.to_string language);
max_prec_digits = None;
trace = false;
disable_counterexamples = false;
optimize = false;
ex_scope = Some (Js.to_string scope);
output_file = None;
}
end) end)

61
compiler/driver.ml
View File

@ -24,25 +24,16 @@ let languages = [ ("en", Cli.En); ("fr", Cli.Fr); ("pl", Cli.Pl) ]
let extensions = [ (".catala_fr", "fr"); (".catala_en", "en"); (".catala_pl", "pl") ] let extensions = [ (".catala_fr", "fr"); (".catala_en", "en"); (".catala_pl", "pl") ]
(** Entry function for the executable. Returns a negative number in case of error. Usage: (** Entry function for the executable. Returns a negative number in case of error. Usage:
[driver source_file debug dcalc unstyled wrap_weaved_output backend language max_prec_digits trace optimize scope_to_execute output_file]*) [driver source_file debug dcalc unstyled wrap_weaved_output backend plugins_dirs language max_prec_digits trace optimize scope_to_execute output_file]*)
let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool) let driver source_file (options : Cli.options) : int =
(wrap_weaved_output : bool) (avoid_exceptions : bool) (backend : string)
(language : string option) (max_prec_digits : int option) (trace : bool)
(disable_counterexamples : bool) (optimize : bool) (ex_scope : string option)
(output_file : string option) : int =
try try
Cli.debug_flag := debug; Cli.set_option_globals options;
Cli.style_flag := not unstyled;
Cli.trace_flag := trace;
Cli.optimize_flag := optimize;
Cli.disable_counterexamples := disable_counterexamples;
Cli.avoid_exceptions_flag := avoid_exceptions;
Cli.debug_print "Reading files..."; Cli.debug_print "Reading files...";
let filename = ref "" in let filename = ref "" in
(match source_file with FileName f -> filename := f | Contents c -> Cli.contents := c); (match source_file with Pos.FileName f -> filename := f | Contents c -> Cli.contents := c);
(match max_prec_digits with None -> () | Some i -> Cli.max_prec_digits := i); (match options.max_prec_digits with None -> () | Some i -> Cli.max_prec_digits := i);
let l = let l =
match language with match options.language with
| Some l -> l | Some l -> l
| None -> ( | None -> (
(* Try to infer the language from the intput file extension. *) (* Try to infer the language from the intput file extension. *)
@ -60,6 +51,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
Errors.raise_error "The selected language (%s) is not supported by Catala" l Errors.raise_error "The selected language (%s) is not supported by Catala" l
in in
Cli.locale_lang := language; Cli.locale_lang := language;
let backend = options.backend in
let backend = let backend =
let backend = String.lowercase_ascii backend in let backend = String.lowercase_ascii backend in
if backend = "makefile" then Cli.Makefile if backend = "makefile" then Cli.Makefile
@ -88,7 +80,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
Errors.raise_error "The Makefile backend does not work if the input is not a file" Errors.raise_error "The Makefile backend does not work if the input is not a file"
in in
let output_file = let output_file =
match output_file with match options.output_file with
| Some f -> f | Some f -> f
| None -> Filename.remove_extension source_file ^ ".d" | None -> Filename.remove_extension source_file ^ ".d"
in in
@ -117,7 +109,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
| Cli.Html -> "HTML" | Cli.Html -> "HTML"
| _ -> assert false (* should not happen *)); | _ -> assert false (* should not happen *));
let output_file = let output_file =
match output_file with match options.output_file with
| Some f -> f | Some f -> f
| None -> ( | None -> (
Filename.remove_extension source_file Filename.remove_extension source_file
@ -135,7 +127,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
in in
Cli.debug_print "Writing to %s" output_file; Cli.debug_print "Writing to %s" output_file;
let fmt = Format.formatter_of_out_channel oc in let fmt = Format.formatter_of_out_channel oc in
if wrap_weaved_output then if options.wrap_weaved_output then
match backend with match backend with
| Cli.Latex -> | Cli.Latex ->
Literate.Latex.wrap_latex prgm.Surface.Ast.program_source_files language fmt Literate.Latex.wrap_latex prgm.Surface.Ast.program_source_files language fmt
@ -151,7 +143,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
Cli.debug_print "Name resolution..."; Cli.debug_print "Name resolution...";
let ctxt = Surface.Name_resolution.form_context prgm in let ctxt = Surface.Name_resolution.form_context prgm in
let scope_uid = let scope_uid =
match (ex_scope, backend) with match (options.ex_scope, backend) with
| None, Cli.Interpret -> Errors.raise_error "No scope was provided for execution." | None, Cli.Interpret -> Errors.raise_error "No scope was provided for execution."
| None, _ -> | None, _ ->
snd snd
@ -168,13 +160,13 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
let prgm = Desugared.Desugared_to_scope.translate_program prgm in let prgm = Desugared.Desugared_to_scope.translate_program prgm in
if backend = Cli.Scopelang then begin if backend = Cli.Scopelang then begin
let fmt, at_end = let fmt, at_end =
match output_file with match options.output_file with
| Some f -> | Some f ->
let oc = open_out f in let oc = open_out f in
(Format.formatter_of_out_channel oc, fun _ -> close_out oc) (Format.formatter_of_out_channel oc, fun _ -> close_out oc)
| None -> (Format.std_formatter, fun _ -> ()) | None -> (Format.std_formatter, fun _ -> ())
in in
if Option.is_some ex_scope then if Option.is_some options.ex_scope then
Format.fprintf fmt "%a\n" Scopelang.Print.format_scope Format.fprintf fmt "%a\n" Scopelang.Print.format_scope
(scope_uid, Scopelang.Ast.ScopeMap.find scope_uid prgm.program_scopes) (scope_uid, Scopelang.Ast.ScopeMap.find scope_uid prgm.program_scopes)
else Format.fprintf fmt "%a\n" Scopelang.Print.format_program prgm; else Format.fprintf fmt "%a\n" Scopelang.Print.format_program prgm;
@ -184,7 +176,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
Cli.debug_print "Translating to default calculus..."; Cli.debug_print "Translating to default calculus...";
let prgm, type_ordering = Scopelang.Scope_to_dcalc.translate_program prgm in let prgm, type_ordering = Scopelang.Scope_to_dcalc.translate_program prgm in
let prgm = let prgm =
if optimize then begin if options.optimize then begin
Cli.debug_print "Optimizing default calculus..."; Cli.debug_print "Optimizing default calculus...";
Dcalc.Optimizations.optimize_program prgm Dcalc.Optimizations.optimize_program prgm
end end
@ -193,15 +185,15 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
let prgrm_dcalc_expr = Bindlib.unbox (Dcalc.Ast.build_whole_program_expr prgm scope_uid) in let prgrm_dcalc_expr = Bindlib.unbox (Dcalc.Ast.build_whole_program_expr prgm scope_uid) in
if backend = Cli.Dcalc then begin if backend = Cli.Dcalc then begin
let fmt, at_end = let fmt, at_end =
match output_file with match options.output_file with
| Some f -> | Some f ->
let oc = open_out f in let oc = open_out f in
(Format.formatter_of_out_channel oc, fun _ -> close_out oc) (Format.formatter_of_out_channel oc, fun _ -> close_out oc)
| None -> (Format.std_formatter, fun _ -> ()) | None -> (Format.std_formatter, fun _ -> ())
in in
if Option.is_some ex_scope then if Option.is_some options.ex_scope then
Format.fprintf fmt "%a\n" Format.fprintf fmt "%a\n"
(Dcalc.Print.format_scope ~debug prgm.decl_ctx) (Dcalc.Print.format_scope ~debug:options.debug prgm.decl_ctx)
(let _, _, s = List.find (fun (name, _, _) -> name = scope_uid) prgm.scopes in (let _, _, s = List.find (fun (name, _, _) -> name = scope_uid) prgm.scopes in
(scope_uid, s)) (scope_uid, s))
else Format.fprintf fmt "%a\n" (Dcalc.Print.format_expr prgm.decl_ctx) prgrm_dcalc_expr; else Format.fprintf fmt "%a\n" (Dcalc.Print.format_expr prgm.decl_ctx) prgrm_dcalc_expr;
@ -248,11 +240,12 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
| Cli.OCaml | Cli.Python | Cli.Lcalc | Cli.Scalc -> | Cli.OCaml | Cli.Python | Cli.Lcalc | Cli.Scalc ->
Cli.debug_print "Compiling program into lambda calculus..."; Cli.debug_print "Compiling program into lambda calculus...";
let prgm = let prgm =
if avoid_exceptions then Lcalc.Compile_without_exceptions.translate_program prgm if options.avoid_exceptions then
Lcalc.Compile_without_exceptions.translate_program prgm
else Lcalc.Compile_with_exceptions.translate_program prgm else Lcalc.Compile_with_exceptions.translate_program prgm
in in
let prgm = let prgm =
if optimize then begin if options.optimize then begin
Cli.debug_print "Optimizing lambda calculus..."; Cli.debug_print "Optimizing lambda calculus...";
Lcalc.Optimizations.optimize_program prgm Lcalc.Optimizations.optimize_program prgm
end end
@ -260,15 +253,15 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
in in
if backend = Cli.Lcalc then begin if backend = Cli.Lcalc then begin
let fmt, at_end = let fmt, at_end =
match output_file with match options.output_file with
| Some f -> | Some f ->
let oc = open_out f in let oc = open_out f in
(Format.formatter_of_out_channel oc, fun _ -> close_out oc) (Format.formatter_of_out_channel oc, fun _ -> close_out oc)
| None -> (Format.std_formatter, fun _ -> ()) | None -> (Format.std_formatter, fun _ -> ())
in in
if Option.is_some ex_scope then if Option.is_some options.ex_scope then
Format.fprintf fmt "%a\n" Format.fprintf fmt "%a\n"
(Lcalc.Print.format_scope ~debug prgm.decl_ctx) (Lcalc.Print.format_scope ~debug:options.debug prgm.decl_ctx)
(let body = (let body =
List.find (fun body -> body.Lcalc.Ast.scope_body_name = scope_uid) prgm.scopes List.find (fun body -> body.Lcalc.Ast.scope_body_name = scope_uid) prgm.scopes
in in
@ -289,7 +282,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
Errors.raise_error "This backend does not work if the input is not a file" Errors.raise_error "This backend does not work if the input is not a file"
in in
let new_output_file (extension : string) : string = let new_output_file (extension : string) : string =
match output_file with match options.output_file with
| Some f -> f | Some f -> f
| None -> Filename.remove_extension source_file ^ extension | None -> Filename.remove_extension source_file ^ extension
in in
@ -306,15 +299,15 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
let prgm = Scalc.Compile_from_lambda.translate_program prgm in let prgm = Scalc.Compile_from_lambda.translate_program prgm in
if backend = Cli.Scalc then begin if backend = Cli.Scalc then begin
let fmt, at_end = let fmt, at_end =
match output_file with match options.output_file with
| Some f -> | Some f ->
let oc = open_out f in let oc = open_out f in
(Format.formatter_of_out_channel oc, fun _ -> close_out oc) (Format.formatter_of_out_channel oc, fun _ -> close_out oc)
| None -> (Format.std_formatter, fun _ -> ()) | None -> (Format.std_formatter, fun _ -> ())
in in
if Option.is_some ex_scope then if Option.is_some options.ex_scope then
Format.fprintf fmt "%a\n" Format.fprintf fmt "%a\n"
(Scalc.Print.format_scope ~debug prgm.decl_ctx) (Scalc.Print.format_scope ~debug:options.debug prgm.decl_ctx)
(let body = (let body =
List.find List.find
(fun body -> body.Scalc.Ast.scope_body_name = scope_uid) (fun body -> body.Scalc.Ast.scope_body_name = scope_uid)

19
compiler/driver.mli Normal file
View File

@ -0,0 +1,19 @@
(* This file is part of the Catala compiler, a specification language for tax and social benefits
computation rules. Copyright (C) 2020 Inria, contributors: Denis Merigoux
<denis.merigoux@inria.fr>, Emile Rolley <emile.rolley@tuta.io>
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. *)
val driver : Utils.Pos.input_file -> Utils.Cli.options -> int
(** Entry function for the executable. Returns a negative number in case of error. *)
val main : unit -> unit
(** Main program entry point, including command-line parsing and return code *)

46
compiler/utils/cli.ml
View File

@ -131,11 +131,53 @@ let output =
"$(i, OUTPUT) is the file that will contain the output of the compiler. Defaults to \ "$(i, OUTPUT) is the file that will contain the output of the compiler. Defaults to \
$(i,FILE).$(i,EXT) where $(i,EXT) depends on the chosen backend.") $(i,FILE).$(i,EXT) where $(i,EXT) depends on the chosen backend.")
let catala_t f = type options = {
debug : bool;
unstyled : bool;
wrap_weaved_output : bool;
avoid_exceptions : bool;
backend : string;
language : string option;
max_prec_digits : int option;
trace : bool;
disable_counterexamples : bool;
optimize : bool;
ex_scope : string option;
output_file : string option;
}
let options =
let make debug unstyled wrap_weaved_output avoid_exceptions backend language max_prec_digits trace
disable_counterexamples optimize ex_scope output_file : options =
{
debug;
unstyled;
wrap_weaved_output;
avoid_exceptions;
backend;
language;
max_prec_digits;
trace;
disable_counterexamples;
optimize;
ex_scope;
output_file;
}
in
Term.( Term.(
const f $ file $ debug $ unstyled $ wrap_weaved_output $ avoid_exceptions $ backend $ language const make $ debug $ unstyled $ wrap_weaved_output $ avoid_exceptions $ backend $ language
$ max_prec_digits_opt $ trace_opt $ disable_counterexamples_opt $ optimize $ ex_scope $ output) $ max_prec_digits_opt $ trace_opt $ disable_counterexamples_opt $ optimize $ ex_scope $ output)
let catala_t f = Term.(const f $ file $ options)
let set_option_globals options : unit =
debug_flag := options.debug;
style_flag := not options.unstyled;
trace_flag := options.trace;
optimize_flag := options.optimize;
disable_counterexamples := options.disable_counterexamples;
avoid_exceptions_flag := options.avoid_exceptions
let version = "0.5.0" let version = "0.5.0"
let info = let info =

40
compiler/utils/cli.mli
View File

@ -77,24 +77,28 @@ val ex_scope : string option Cmdliner.Term.t
val output : string option Cmdliner.Term.t val output : string option Cmdliner.Term.t
val catala_t : type options = {
(string -> debug : bool;
bool -> unstyled : bool;
bool -> wrap_weaved_output : bool;
bool -> avoid_exceptions : bool;
bool -> backend : string;
string -> language : string option;
string option -> max_prec_digits : int option;
int option -> trace : bool;
bool -> disable_counterexamples : bool;
bool -> optimize : bool;
bool -> ex_scope : string option;
string option -> output_file : string option;
string option -> }
'a) -> (** {2 Command-line application} *)
'a Cmdliner.Term.t
(** Main entry point: val options : options Cmdliner.Term.t
[catala_t file debug unstyled wrap_weaved_output avoid_exceptions backend language max_prec_digits_opt trace_opt disable_counterexamples optimize ex_scope output] *)
val catala_t : (string -> options -> 'a) -> 'a Cmdliner.Term.t
(** Main entry point: [catala_t file options] *)
val set_option_globals : options -> unit
val version : string val version : string

4402
french_law/js/french_law.js generated
View File

File diff suppressed because one or more lines are too long