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) =
driver
(Contents (Js.to_string contents))
false false false false "Interpret"
(Some (Js.to_string language))
None trace false false
(Some (Js.to_string scope))
None
{
Utils.Cli.debug = false;
unstyled = false;
wrap_weaved_output = false;
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)

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") ]
(** 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]*)
let driver (source_file : Pos.input_file) (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) : int =
[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 (options : Cli.options) : int =
try
Cli.debug_flag := debug;
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.set_option_globals options;
Cli.debug_print "Reading files...";
let filename = ref "" in
(match source_file with FileName f -> filename := f | Contents c -> Cli.contents := c);
(match max_prec_digits with None -> () | Some i -> Cli.max_prec_digits := i);
(match source_file with Pos.FileName f -> filename := f | Contents c -> Cli.contents := c);
(match options.max_prec_digits with None -> () | Some i -> Cli.max_prec_digits := i);
let l =
match language with
match options.language with
| Some l -> l
| None -> (
(* 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
in
Cli.locale_lang := language;
let backend = options.backend in
let backend =
let backend = String.lowercase_ascii backend in
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"
in
let output_file =
match output_file with
match options.output_file with
| Some f -> f
| None -> Filename.remove_extension source_file ^ ".d"
in
@ -117,7 +109,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
| Cli.Html -> "HTML"
| _ -> assert false (* should not happen *));
let output_file =
match output_file with
match options.output_file with
| Some f -> f
| None -> (
Filename.remove_extension source_file
@ -135,7 +127,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
in
Cli.debug_print "Writing to %s" output_file;
let fmt = Format.formatter_of_out_channel oc in
if wrap_weaved_output then
if options.wrap_weaved_output then
match backend with
| Cli.Latex ->
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...";
let ctxt = Surface.Name_resolution.form_context prgm in
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, _ ->
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
if backend = Cli.Scopelang then begin
let fmt, at_end =
match output_file with
match options.output_file with
| Some f ->
let oc = open_out f in
(Format.formatter_of_out_channel oc, fun _ -> close_out oc)
| None -> (Format.std_formatter, fun _ -> ())
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
(scope_uid, Scopelang.Ast.ScopeMap.find scope_uid prgm.program_scopes)
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...";
let prgm, type_ordering = Scopelang.Scope_to_dcalc.translate_program prgm in
let prgm =
if optimize then begin
if options.optimize then begin
Cli.debug_print "Optimizing default calculus...";
Dcalc.Optimizations.optimize_program prgm
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
if backend = Cli.Dcalc then begin
let fmt, at_end =
match output_file with
match options.output_file with
| Some f ->
let oc = open_out f in
(Format.formatter_of_out_channel oc, fun _ -> close_out oc)
| None -> (Format.std_formatter, fun _ -> ())
in
if Option.is_some ex_scope then
if Option.is_some options.ex_scope then
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
(scope_uid, s))
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.debug_print "Compiling program into lambda calculus...";
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
in
let prgm =
if optimize then begin
if options.optimize then begin
Cli.debug_print "Optimizing lambda calculus...";
Lcalc.Optimizations.optimize_program prgm
end
@ -260,15 +253,15 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
in
if backend = Cli.Lcalc then begin
let fmt, at_end =
match output_file with
match options.output_file with
| Some f ->
let oc = open_out f in
(Format.formatter_of_out_channel oc, fun _ -> close_out oc)
| None -> (Format.std_formatter, fun _ -> ())
in
if Option.is_some ex_scope then
if Option.is_some options.ex_scope then
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 =
List.find (fun body -> body.Lcalc.Ast.scope_body_name = scope_uid) prgm.scopes
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"
in
let new_output_file (extension : string) : string =
match output_file with
match options.output_file with
| Some f -> f
| None -> Filename.remove_extension source_file ^ extension
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
if backend = Cli.Scalc then begin
let fmt, at_end =
match output_file with
match options.output_file with
| Some f ->
let oc = open_out f in
(Format.formatter_of_out_channel oc, fun _ -> close_out oc)
| None -> (Format.std_formatter, fun _ -> ())
in
if Option.is_some ex_scope then
if Option.is_some options.ex_scope then
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 =
List.find
(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,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.(
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)
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 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 catala_t :
(string ->
bool ->
bool ->
bool ->
bool ->
string ->
string option ->
int option ->
bool ->
bool ->
bool ->
string option ->
string option ->
'a) ->
'a Cmdliner.Term.t
(** Main entry point:
[catala_t file debug unstyled wrap_weaved_output avoid_exceptions backend language max_prec_digits_opt trace_opt disable_counterexamples optimize ex_scope output] *)
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;
}
(** {2 Command-line application} *)
val options : options Cmdliner.Term.t
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

4402
french_law/js/french_law.js generated
View File

File diff suppressed because one or more lines are too long