mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-16 14:57:13 +03:00
Refacter the main Driver module
- Use separate functions for successive passes in module `Driver.Passes` - Use other functions for end results printing in module `Driver.Commands` As a consequence, it is much more flexible to use by plugins or libs and we no longer need the complex polymorphic variant parameter. This patch leverages previous changes to use Cmdliner subcommands and effectively specialises the flags of each Catala subcommand. Other changes include: - an attempt to normalise the generic options and reduce the number of global references. Some are ok, like `debug` ; some would better be further cleaned up, e.g. the ones used by Proof backend were moved to a `Proof.globals` module and need discussion. The printer no longer relies on the global languages and prints money amounts in an agnostic way. - the plugin directory is automatically guessed and loaded even in dev setups. Plugins are shown by the main `catala` command and listed in `catala --help` - exception catching at the toplevel has been refactored a bit as well; return codes are normalised to follow the manpage and avoid codes >= 128 that are generally reserved for shells. Update tests
This commit is contained in:
Louis Gesbert
parent
b38f3da60d
commit
0f9ee2c72e
2
Makefile
2
Makefile
@ -45,6 +45,7 @@ $(PY_VENV_DIR)/stamp: \
|
||||
syntax_highlighting/fr/pygments/pyproject.toml \
|
||||
syntax_highlighting/pl/pygments/pyproject.toml
|
||||
test -d $(PY_VENV_DIR) || python3 -m venv $(PY_VENV_DIR)
|
||||
$(PY_VENV_ACTIVATE) python3 -m pip install -U pip
|
||||
$(PY_VENV_ACTIVATE) python3 -m pip install -U \
|
||||
-e runtimes/python/catala \
|
||||
-e syntax_highlighting/en/pygments \
|
||||
@ -102,7 +103,6 @@ runtimes:
|
||||
#> plugins : Builds the compiler backend plugins
|
||||
plugins: runtimes
|
||||
dune build compiler/plugins/
|
||||
@echo "define CATALA_PLUGINS=_build/default/compiler/plugins to test the plugins"
|
||||
|
||||
##########################################
|
||||
# Rules related to promoted files
|
||||
|
||||
@ -57,10 +57,10 @@ let ninja_output =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some string) None
|
||||
& info ["o"; "output"] ~docv:"OUTPUT"
|
||||
& info ["o"; "output"] ~docv:"FILE"
|
||||
~doc:
|
||||
"$(i, OUTPUT) is the file that will contain the build.ninja file \
|
||||
output. If not specified, the build.ninja file will be outputed in \
|
||||
"$(i,FILE) is the file that will contain the build.ninja file \
|
||||
output. If not specified, the build.ninja file will be output in \
|
||||
the temporary directory of the system.")
|
||||
|
||||
let scope =
|
||||
@ -384,8 +384,6 @@ let add_reset_rules_aux
|
||||
[
|
||||
Var.catala_cmd;
|
||||
Var.tested_file;
|
||||
Lit "--unstyled";
|
||||
Lit "--output=-";
|
||||
Lit redirect;
|
||||
Var.expected_output;
|
||||
Lit "2>&1";
|
||||
@ -422,8 +420,6 @@ let add_test_rules_aux
|
||||
:: [
|
||||
Var.catala_cmd;
|
||||
Var.tested_file;
|
||||
Lit "--unstyled";
|
||||
Lit "--output=-";
|
||||
Lit "2>&1 | colordiff -u -b";
|
||||
Var.expected_output;
|
||||
Lit "-";
|
||||
@ -630,16 +626,15 @@ let run_inline_tests
|
||||
let cmd_out_rd, cmd_out_wr = Unix.pipe () in
|
||||
let ic = Unix.in_channel_of_descr cmd_out_rd in
|
||||
let cmd =
|
||||
Array.of_list
|
||||
((catala_exe :: catala_opts)
|
||||
@ test.params
|
||||
@ [file; "--unstyled"; "--output=-"])
|
||||
Array.of_list ((catala_exe :: catala_opts) @ test.params @ [file])
|
||||
in
|
||||
let env =
|
||||
Unix.environment ()
|
||||
|> Array.to_seq
|
||||
|> Seq.filter (fun s ->
|
||||
not (String.starts_with ~prefix:"OCAMLRUNPARAM=" s))
|
||||
|> Seq.cons "CATALA_OUT=-"
|
||||
|> Seq.cons "CATALA_COLOR=never"
|
||||
|> Array.of_seq
|
||||
in
|
||||
let pid =
|
||||
@ -885,7 +880,7 @@ let driver
|
||||
(reset_test_outputs : bool)
|
||||
(ninja_output : string option) : int =
|
||||
try
|
||||
if debug then Cli.debug_flag := true;
|
||||
let _options = Cli.enforce_globals ~debug () in
|
||||
let ninja_flags = makeflags_to_ninja_flags makeflags in
|
||||
let files_or_folders = List.sort_uniq String.compare files_or_folders
|
||||
and catala_exe = Option.fold ~none:"catala" ~some:Fun.id catala_exe
|
||||
|
||||
@ -15,23 +15,12 @@
|
||||
License for the specific language governing permissions and limitations under
|
||||
the License. *)
|
||||
|
||||
type backend_lang = En | Fr | Pl
|
||||
(* Types used by flags & options *)
|
||||
|
||||
type backend_option =
|
||||
[ `Latex
|
||||
| `Makefile
|
||||
| `Html
|
||||
| `Interpret
|
||||
| `Interpret_Lcalc
|
||||
| `Typecheck
|
||||
| `OCaml
|
||||
| `Python
|
||||
| `Scalc
|
||||
| `Lcalc
|
||||
| `Dcalc
|
||||
| `Scopelang
|
||||
| `Exceptions
|
||||
| `Proof ]
|
||||
type backend_lang = En | Fr | Pl
|
||||
type when_enum = Auto | Always | Never
|
||||
type message_format_enum = Human | GNU
|
||||
type input_file = FileName of string | Contents of string
|
||||
|
||||
(** Associates a {!type: Cli.backend_lang} with its string represtation. *)
|
||||
let languages = ["en", En; "fr", Fr; "pl", Pl]
|
||||
@ -40,200 +29,275 @@ let language_code =
|
||||
let rl = List.map (fun (a, b) -> b, a) languages in
|
||||
fun l -> List.assoc l rl
|
||||
|
||||
(** Source files to be compiled *)
|
||||
let source_files : string list ref = ref []
|
||||
let message_format_opt = ["human", Human; "gnu", GNU]
|
||||
|
||||
let locale_lang : backend_lang ref = ref En
|
||||
let contents : string ref = ref ""
|
||||
type options = {
|
||||
mutable input_file : input_file;
|
||||
mutable language : backend_lang option;
|
||||
mutable debug : bool;
|
||||
mutable color : when_enum;
|
||||
mutable message_format : message_format_enum;
|
||||
mutable trace : bool;
|
||||
mutable plugins_dirs : string list;
|
||||
mutable disable_warnings : bool;
|
||||
mutable max_prec_digits : int;
|
||||
}
|
||||
|
||||
(** Prints debug information *)
|
||||
let debug_flag = ref false
|
||||
(* Note: we force that the global options (ie options common to all commands)
|
||||
and the options available through global refs are the same. While this is a
|
||||
bit arbitrary, it makes some sense code-wise and provides some safeguard
|
||||
against explosion of the number of global references. Reducing the number of
|
||||
globals further would be nice though. *)
|
||||
let globals =
|
||||
{
|
||||
input_file = Contents "";
|
||||
language = None;
|
||||
debug = false;
|
||||
color = Auto;
|
||||
message_format = Human;
|
||||
trace = false;
|
||||
plugins_dirs = [];
|
||||
disable_warnings = false;
|
||||
max_prec_digits = 20;
|
||||
}
|
||||
|
||||
type when_enum = Auto | Always | Never
|
||||
|
||||
(* Styles the terminal output *)
|
||||
let style_flag = ref Auto
|
||||
|
||||
(* Max number of digits to show for decimal results *)
|
||||
let max_prec_digits = ref 20
|
||||
let trace_flag = ref false
|
||||
let disable_warnings_flag = ref false
|
||||
let optimize_flag = ref false
|
||||
let disable_counterexamples = ref false
|
||||
let avoid_exceptions_flag = ref false
|
||||
let check_invariants_flag = ref false
|
||||
|
||||
type message_format_enum = Human | GNU
|
||||
|
||||
let message_format_flag = ref Human
|
||||
let enforce_globals
|
||||
?input_file
|
||||
?language
|
||||
?debug
|
||||
?color
|
||||
?message_format
|
||||
?trace
|
||||
?plugins_dirs
|
||||
?disable_warnings
|
||||
?max_prec_digits
|
||||
() =
|
||||
Option.iter (fun x -> globals.input_file <- x) input_file;
|
||||
Option.iter (fun x -> globals.language <- x) language;
|
||||
Option.iter (fun x -> globals.debug <- x) debug;
|
||||
Option.iter (fun x -> globals.color <- x) color;
|
||||
Option.iter (fun x -> globals.message_format <- x) message_format;
|
||||
Option.iter (fun x -> globals.trace <- x) trace;
|
||||
Option.iter (fun x -> globals.plugins_dirs <- x) plugins_dirs;
|
||||
Option.iter (fun x -> globals.disable_warnings <- x) disable_warnings;
|
||||
Option.iter (fun x -> globals.max_prec_digits <- x) max_prec_digits;
|
||||
globals
|
||||
|
||||
open Cmdliner
|
||||
|
||||
let file =
|
||||
Arg.(
|
||||
required
|
||||
& pos 0 (some file) None
|
||||
& info [] ~docv:"FILE" ~doc:"Catala master file to be compiled.")
|
||||
|
||||
let debug =
|
||||
Arg.(value & flag & info ["debug"; "d"] ~doc:"Prints debug information.")
|
||||
(* Arg converters for our custom types *)
|
||||
|
||||
let when_opt = Arg.enum ["auto", Auto; "always", Always; "never", Never]
|
||||
|
||||
let color =
|
||||
Arg.(
|
||||
value
|
||||
& opt ~vopt:Always when_opt Auto
|
||||
& info ["color"]
|
||||
~doc:
|
||||
"Allow output of colored and styled text. If set to $(i,auto), \
|
||||
enabled when the standard output is to a terminal.")
|
||||
(** CLI flags and options *)
|
||||
|
||||
let message_format_opt = Arg.enum ["human", Human; "gnu", GNU]
|
||||
module Flags = struct
|
||||
open Cmdliner
|
||||
open Arg
|
||||
|
||||
let message_format =
|
||||
Arg.(
|
||||
value
|
||||
& opt message_format_opt Human
|
||||
& info ["message_format"]
|
||||
~doc:
|
||||
"Selects the format of error and warning messages emitted by the \
|
||||
compiler. If set to $(i,human), the messages will be nicely \
|
||||
displayed and meant to be read by a human. If set to $(i, gnu), the \
|
||||
messages will be rendered according to the GNU coding standards.")
|
||||
module Global = struct
|
||||
let info = info ~docs:Manpage.s_common_options
|
||||
|
||||
let unstyled =
|
||||
Arg.(
|
||||
let input_file =
|
||||
let converter =
|
||||
conv ~docv:"FILE"
|
||||
( (fun s ->
|
||||
Result.map (fun f -> FileName f) (conv_parser non_dir_file s)),
|
||||
fun ppf -> function
|
||||
| FileName f -> conv_printer non_dir_file ppf f
|
||||
| _ -> assert false )
|
||||
in
|
||||
required
|
||||
& pos 0 (some converter) None
|
||||
& Arg.info [] ~docv:"FILE" ~docs:Manpage.s_arguments
|
||||
~doc:"Catala master file to be compiled."
|
||||
|
||||
let language =
|
||||
value
|
||||
& opt (some (enum languages)) None
|
||||
& info ["l"; "language"] ~docv:"LANG"
|
||||
~doc:
|
||||
"Locale variant of the input language to use when it can not be \
|
||||
inferred from the file extension."
|
||||
|
||||
let debug =
|
||||
value
|
||||
& flag
|
||||
& info ["debug"; "d"]
|
||||
~env:(Cmd.Env.info "CATALA_DEBUG")
|
||||
~doc:"Prints debug information."
|
||||
|
||||
let color =
|
||||
let unstyled =
|
||||
value
|
||||
& flag
|
||||
& info ["unstyled"]
|
||||
~doc:"Removes styling (colors, etc.) from terminal output."
|
||||
~deprecated:"Use $(b,--color=)$(i,never) instead"
|
||||
in
|
||||
let color =
|
||||
value
|
||||
& opt ~vopt:Always when_opt Auto
|
||||
& info ["color"]
|
||||
~env:(Cmd.Env.info "CATALA_COLOR")
|
||||
~doc:
|
||||
"Allow output of colored and styled text. Use $(i,auto), to \
|
||||
enable when the standard output is to a terminal, $(i,never) to \
|
||||
disable."
|
||||
in
|
||||
Term.(
|
||||
const (fun color unstyled -> if unstyled then Never else color)
|
||||
$ color
|
||||
$ unstyled)
|
||||
|
||||
let message_format =
|
||||
value
|
||||
& opt (enum message_format_opt) Human
|
||||
& info ["message_format"]
|
||||
~doc:
|
||||
"Selects the format of error and warning messages emitted by the \
|
||||
compiler. If set to $(i,human), the messages will be nicely \
|
||||
displayed and meant to be read by a human. If set to $(i, gnu), \
|
||||
the messages will be rendered according to the GNU coding \
|
||||
standards."
|
||||
|
||||
let trace =
|
||||
value
|
||||
& flag
|
||||
& info ["trace"; "t"]
|
||||
~doc:
|
||||
"Displays a trace of the interpreter's computation or generates \
|
||||
logging instructions in translate programs."
|
||||
|
||||
let plugins_dirs =
|
||||
let doc = "Set the given directory to be searched for backend plugins." in
|
||||
let env = Cmd.Env.info "CATALA_PLUGINS" in
|
||||
let default =
|
||||
let ( / ) = Filename.concat in
|
||||
[
|
||||
Filename.dirname Sys.executable_name
|
||||
/ Filename.parent_dir_name
|
||||
/ "lib"
|
||||
/ "catala"
|
||||
/ "plugins";
|
||||
"_build" / "default" / "compiler" / "plugins";
|
||||
]
|
||||
in
|
||||
value & opt_all dir default & info ["plugin-dir"] ~docv:"DIR" ~env ~doc
|
||||
|
||||
let disable_warnings =
|
||||
value
|
||||
& flag
|
||||
& info ["disable_warnings"]
|
||||
~doc:"Disable all the warnings emitted by the compiler."
|
||||
|
||||
let max_prec_digits =
|
||||
value
|
||||
& opt int 20
|
||||
& info
|
||||
["p"; "max_digits_printed"]
|
||||
~docv:"NUM"
|
||||
~doc:
|
||||
"Maximum number of significant digits printed for decimal results."
|
||||
|
||||
let flags =
|
||||
let make
|
||||
language
|
||||
debug
|
||||
color
|
||||
message_format
|
||||
trace
|
||||
plugins_dirs
|
||||
disable_warnings
|
||||
max_prec_digits : options =
|
||||
if debug then Printexc.record_backtrace true;
|
||||
(* This sets some global refs for convenience, but most importantly
|
||||
returns the options record. *)
|
||||
enforce_globals ~language ~debug ~color ~message_format ~trace
|
||||
~plugins_dirs ~disable_warnings ~max_prec_digits ()
|
||||
in
|
||||
Term.(
|
||||
const make
|
||||
$ language
|
||||
$ debug
|
||||
$ color
|
||||
$ message_format
|
||||
$ trace
|
||||
$ plugins_dirs
|
||||
$ disable_warnings
|
||||
$ max_prec_digits)
|
||||
|
||||
let options =
|
||||
let make input_file options : options =
|
||||
(* Set some global refs for convenience *)
|
||||
globals.input_file <- input_file;
|
||||
{ options with input_file }
|
||||
in
|
||||
Term.(const make $ input_file $ flags)
|
||||
end
|
||||
|
||||
let check_invariants =
|
||||
value
|
||||
& flag
|
||||
& info ["unstyled"]
|
||||
~doc:
|
||||
"Removes styling (colors, etc.) from terminal output. Equivalent to \
|
||||
$(b,--color=never)")
|
||||
& info ["check_invariants"] ~doc:"Check structural invariants on the AST."
|
||||
|
||||
let optimize =
|
||||
Arg.(value & flag & info ["optimize"; "O"] ~doc:"Run compiler optimizations.")
|
||||
|
||||
let trace_opt =
|
||||
Arg.(
|
||||
value
|
||||
& flag
|
||||
& info ["trace"; "t"]
|
||||
~doc:
|
||||
"Displays a trace of the interpreter's computation or generates \
|
||||
logging instructions in translate programs.")
|
||||
|
||||
let disable_warnings_opt =
|
||||
Arg.(
|
||||
value
|
||||
& flag
|
||||
& info ["disable_warnings"]
|
||||
~doc:"Disable all the warnings emitted by the compiler.")
|
||||
|
||||
let check_invariants_opt =
|
||||
Arg.(
|
||||
value
|
||||
& flag
|
||||
& info ["check_invariants"] ~doc:"Check structural invariants on the AST.")
|
||||
|
||||
let avoid_exceptions =
|
||||
Arg.(
|
||||
value
|
||||
& flag
|
||||
& info ["avoid_exceptions"]
|
||||
~doc:"Compiles the default calculus without exceptions.")
|
||||
|
||||
let closure_conversion =
|
||||
Arg.(
|
||||
value
|
||||
& flag
|
||||
& info ["closure_conversion"]
|
||||
~doc:"Performs closure conversion on the lambda calculus.")
|
||||
|
||||
let wrap_weaved_output =
|
||||
Arg.(
|
||||
let wrap_weaved_output =
|
||||
value
|
||||
& flag
|
||||
& info ["wrap"; "w"]
|
||||
~doc:"Wraps literate programming output with a minimal preamble.")
|
||||
~doc:"Wraps literate programming output with a minimal preamble."
|
||||
|
||||
let print_only_law =
|
||||
Arg.(
|
||||
let print_only_law =
|
||||
value
|
||||
& flag
|
||||
& info ["print_only_law"]
|
||||
~doc:
|
||||
"In literate programming output, skip all code and metadata sections \
|
||||
and print only the text of the law.")
|
||||
and print only the text of the law."
|
||||
|
||||
let plugins_dirs =
|
||||
let doc = "Set the given directory to be searched for backend plugins." in
|
||||
let env = Cmd.Env.info "CATALA_PLUGINS" ~doc in
|
||||
let default =
|
||||
let ( / ) = Filename.concat in
|
||||
[
|
||||
Filename.dirname Sys.executable_name
|
||||
/ Filename.parent_dir_name
|
||||
/ "lib"
|
||||
/ "catala"
|
||||
/ "plugins";
|
||||
]
|
||||
in
|
||||
Arg.(value & opt_all dir default & info ["plugin-dir"] ~docv:"DIR" ~env ~doc)
|
||||
let ex_scope =
|
||||
required
|
||||
& opt (some string) None
|
||||
& info ["s"; "scope"] ~docv:"SCOPE" ~doc:"Scope to be focused on."
|
||||
|
||||
let language =
|
||||
Arg.(
|
||||
let ex_scope_opt =
|
||||
value
|
||||
& opt (some string) None
|
||||
& info ["l"; "language"] ~docv:"LANG"
|
||||
~doc:"Input language among: en, fr, pl.")
|
||||
& info ["s"; "scope"] ~docv:"SCOPE" ~doc:"Scope to be focused on."
|
||||
|
||||
let max_prec_digits_opt =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some int) None
|
||||
& info
|
||||
["p"; "max_digits_printed"]
|
||||
~docv:"DIGITS"
|
||||
~doc:
|
||||
"Maximum number of significant digits printed for decimal results \
|
||||
(default 20).")
|
||||
|
||||
let disable_counterexamples_opt =
|
||||
Arg.(
|
||||
value
|
||||
& flag
|
||||
& info
|
||||
["disable_counterexamples"]
|
||||
~doc:
|
||||
"Disables the search for counterexamples in proof mode. Useful when \
|
||||
you want a deterministic output from the Catala compiler, since \
|
||||
provers can have some randomness in them.")
|
||||
|
||||
let ex_scope =
|
||||
Arg.(
|
||||
value
|
||||
let ex_variable =
|
||||
required
|
||||
& opt (some string) None
|
||||
& info ["s"; "scope"] ~docv:"SCOPE" ~doc:"Scope to be focused on.")
|
||||
& info ["v"; "variable"] ~docv:"VARIABLE" ~doc:"Variable to be focused on."
|
||||
|
||||
let ex_variable =
|
||||
Arg.(
|
||||
value
|
||||
& opt (some string) None
|
||||
& info ["v"; "variable"] ~docv:"VARIABLE" ~doc:"Variable to be focused on.")
|
||||
|
||||
let output =
|
||||
Arg.(
|
||||
let output =
|
||||
value
|
||||
& opt (some string) None
|
||||
& info ["output"; "o"] ~docv:"OUTPUT"
|
||||
~env:(Cmd.Env.info "CATALA_OUT")
|
||||
~doc:
|
||||
"$(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. Use $(b,-o -) for stdout.")
|
||||
the chosen backend. Use $(b,-o -) for stdout."
|
||||
|
||||
let link_modules =
|
||||
Arg.(
|
||||
let optimize =
|
||||
value & flag & info ["optimize"; "O"] ~doc:"Run compiler optimizations."
|
||||
|
||||
let avoid_exceptions =
|
||||
value
|
||||
& flag
|
||||
& info ["avoid_exceptions"]
|
||||
~doc:"Compiles the default calculus without exceptions."
|
||||
|
||||
let closure_conversion =
|
||||
value
|
||||
& flag
|
||||
& info ["closure_conversion"]
|
||||
~doc:
|
||||
"Performs closure conversion on the lambda calculus. Implies \
|
||||
$(b,--avoid-exceptions) and $(b,--optimize)."
|
||||
|
||||
let link_modules =
|
||||
value
|
||||
& opt_all file []
|
||||
& info ["use"; "u"] ~docv:"FILE"
|
||||
@ -242,207 +306,21 @@ let link_modules =
|
||||
$(i,FILE) must be a catala file with a metadata section expressing \
|
||||
what is exported ; for interpretation, a compiled OCaml shared \
|
||||
module by the same basename (either .cmo or .cmxs) will be \
|
||||
expected.")
|
||||
expected."
|
||||
|
||||
type global_options = {
|
||||
debug : bool;
|
||||
color : when_enum;
|
||||
message_format : message_format_enum;
|
||||
wrap_weaved_output : bool;
|
||||
avoid_exceptions : bool;
|
||||
plugins_dirs : string list;
|
||||
language : string option;
|
||||
max_prec_digits : int option;
|
||||
trace : bool;
|
||||
disable_warnings : bool;
|
||||
disable_counterexamples : bool;
|
||||
check_invariants : bool;
|
||||
optimize : bool;
|
||||
ex_scope : string option;
|
||||
ex_variable : string option;
|
||||
output_file : string option;
|
||||
closure_conversion : bool;
|
||||
print_only_law : bool;
|
||||
link_modules : string list;
|
||||
}
|
||||
|
||||
let global_options =
|
||||
let make
|
||||
debug
|
||||
color
|
||||
message_format
|
||||
unstyled
|
||||
wrap_weaved_output
|
||||
avoid_exceptions
|
||||
closure_conversion
|
||||
plugins_dirs
|
||||
language
|
||||
max_prec_digits
|
||||
disable_warnings
|
||||
trace
|
||||
disable_counterexamples
|
||||
optimize
|
||||
check_invariants
|
||||
ex_scope
|
||||
ex_variable
|
||||
output_file
|
||||
print_only_law
|
||||
link_modules : global_options =
|
||||
{
|
||||
debug;
|
||||
color = (if unstyled then Never else color);
|
||||
message_format;
|
||||
wrap_weaved_output;
|
||||
avoid_exceptions;
|
||||
plugins_dirs;
|
||||
language;
|
||||
max_prec_digits;
|
||||
disable_warnings;
|
||||
trace;
|
||||
disable_counterexamples;
|
||||
optimize;
|
||||
check_invariants;
|
||||
ex_scope;
|
||||
ex_variable;
|
||||
output_file;
|
||||
closure_conversion;
|
||||
print_only_law;
|
||||
link_modules;
|
||||
}
|
||||
in
|
||||
Term.(
|
||||
const make
|
||||
$ debug
|
||||
$ color
|
||||
$ message_format
|
||||
$ unstyled
|
||||
$ wrap_weaved_output
|
||||
$ avoid_exceptions
|
||||
$ closure_conversion
|
||||
$ plugins_dirs
|
||||
$ language
|
||||
$ max_prec_digits_opt
|
||||
$ disable_warnings_opt
|
||||
$ trace_opt
|
||||
$ disable_counterexamples_opt
|
||||
$ optimize
|
||||
$ check_invariants_opt
|
||||
$ ex_scope
|
||||
$ ex_variable
|
||||
$ output
|
||||
$ print_only_law
|
||||
$ link_modules)
|
||||
|
||||
let set_option_globals options : unit =
|
||||
debug_flag := options.debug;
|
||||
style_flag := options.color;
|
||||
(match options.max_prec_digits with
|
||||
| None -> ()
|
||||
| Some i -> max_prec_digits := i);
|
||||
disable_warnings_flag := options.disable_warnings;
|
||||
trace_flag := options.trace;
|
||||
optimize_flag := options.optimize;
|
||||
check_invariants_flag := options.check_invariants;
|
||||
disable_counterexamples := options.disable_counterexamples;
|
||||
avoid_exceptions_flag := options.avoid_exceptions;
|
||||
message_format_flag := options.message_format
|
||||
|
||||
let subcommands handler =
|
||||
[
|
||||
Cmd.v
|
||||
(Cmd.info "interpret"
|
||||
~doc:
|
||||
"Runs the interpreter on the Catala program, executing the scope \
|
||||
specified by the $(b,-s) option assuming no additional external \
|
||||
inputs.")
|
||||
Term.(const (handler `Interpret) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "interpret_lcalc"
|
||||
~doc:
|
||||
"Runs the interpreter on the lcalc pass on the Catala program, \
|
||||
executing the scope specified by the $(b,-s) option assuming no \
|
||||
additional external inputs.")
|
||||
Term.(const (handler `Interpret_Lcalc) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "typecheck"
|
||||
~doc:"Parses and typechecks a Catala program, without interpreting it.")
|
||||
Term.(const (handler `Typecheck) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "proof"
|
||||
~doc:
|
||||
"Generates and proves verification conditions about the \
|
||||
well-behaved execution of the Catala program.")
|
||||
Term.(const (handler `Proof) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "ocaml"
|
||||
~doc:"Generates an OCaml translation of the Catala program.")
|
||||
Term.(const (handler `OCaml) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "python"
|
||||
~doc:"Generates a Python translation of the Catala program.")
|
||||
Term.(const (handler `Python) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "latex"
|
||||
~doc:
|
||||
"Weaves a LaTeX literate programming output of the Catala program.")
|
||||
Term.(const (handler `Latex) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "html"
|
||||
~doc:
|
||||
"Weaves an HTML literate programming output of the Catala program.")
|
||||
Term.(const (handler `Html) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "makefile"
|
||||
~doc:
|
||||
"Generates a Makefile-compatible list of the file dependencies of a \
|
||||
Catala program.")
|
||||
Term.(const (handler `Makefile) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "scopelang"
|
||||
~doc:
|
||||
"Prints a debugging verbatim of the scope language intermediate \
|
||||
representation of the Catala program. Use the $(b,-s) option to \
|
||||
restrict the output to a particular scope.")
|
||||
Term.(const (handler `Scopelang) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "dcalc"
|
||||
~doc:
|
||||
"Prints a debugging verbatim of the default calculus intermediate \
|
||||
representation of the Catala program. Use the $(b,-s) option to \
|
||||
restrict the output to a particular scope.")
|
||||
Term.(const (handler `Dcalc) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "lcalc"
|
||||
~doc:
|
||||
"Prints a debugging verbatim of the lambda calculus intermediate \
|
||||
representation of the Catala program. Use the $(b,-s) option to \
|
||||
restrict the output to a particular scope.")
|
||||
Term.(const (handler `Lcalc) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "scalc"
|
||||
~doc:
|
||||
"Prints a debugging verbatim of the statement calculus intermediate \
|
||||
representation of the Catala program. Use the $(b,-s) option to \
|
||||
restrict the output to a particular scope.")
|
||||
Term.(const (handler `Scalc) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "exceptions"
|
||||
~doc:
|
||||
"Prints the exception tree for the definitions of a particular \
|
||||
variable, for debugging purposes. Use the $(b,-s) option to select \
|
||||
the scope and the $(b,-v) option to select the variable. Use \
|
||||
foo.bar to access state bar of variable foo or variable bar of \
|
||||
subscope foo.")
|
||||
Term.(const (handler `Exceptions) $ file $ global_options);
|
||||
Cmd.v
|
||||
(Cmd.info "pygmentize"
|
||||
~doc:
|
||||
"This special command is a wrapper around the $(b,pygmentize) \
|
||||
command that enables support for colorising Catala code.")
|
||||
Term.(const (fun _ -> assert false) $ file);
|
||||
]
|
||||
let disable_counterexamples =
|
||||
value
|
||||
& flag
|
||||
& info
|
||||
["disable_counterexamples"]
|
||||
~doc:
|
||||
"Disables the search for counterexamples. Useful when you want a \
|
||||
deterministic output from the Catala compiler, since provers can \
|
||||
have some randomness in them."
|
||||
end
|
||||
|
||||
let version = "0.8.0"
|
||||
let s_plugins = "INSTALLED PLUGINS"
|
||||
|
||||
let info =
|
||||
let doc =
|
||||
@ -451,18 +329,30 @@ let info =
|
||||
in
|
||||
let man =
|
||||
[
|
||||
`S Manpage.s_synopsis;
|
||||
`P "$(mname) [$(i,COMMAND)] $(i,FILE) [$(i,OPTION)]…";
|
||||
`P
|
||||
"Use $(mname) [$(i,COMMAND)] $(b,--hel)p for documentation on a \
|
||||
specific command";
|
||||
`S Manpage.s_description;
|
||||
`P
|
||||
"Catala is a domain-specific language for deriving \
|
||||
faithful-by-construction algorithms from legislative texts.";
|
||||
`S Manpage.s_commands;
|
||||
`S s_plugins;
|
||||
`S Manpage.s_authors;
|
||||
`P "The authors are listed by alphabetical order.";
|
||||
`P "Nicolas Chataing <nicolas.chataing@ens.fr>";
|
||||
`P "Alain Delaët-Tixeuil <alain.delaet--tixeuil@inria.fr>";
|
||||
`P "Aymeric Fromherz <aymeric.fromherz@inria.fr>";
|
||||
`P "Louis Gesbert <louis.gesbert@ocamlpro.com>";
|
||||
`P "Denis Merigoux <denis.merigoux@inria.fr>";
|
||||
`P "Emile Rolley <erolley@tutamail.com>";
|
||||
`P "The authors are listed by alphabetical order:";
|
||||
`P "Nicolas Chataing <$(i,nicolas.chataing@ens.fr)>";
|
||||
`Noblank;
|
||||
`P "Alain Delaët-Tixeuil <$(i,alain.delaet--tixeuil@inria.fr)>";
|
||||
`Noblank;
|
||||
`P "Aymeric Fromherz <$(i,aymeric.fromherz@inria.fr)>";
|
||||
`Noblank;
|
||||
`P "Louis Gesbert <$(i,louis.gesbert@ocamlpro.com)>";
|
||||
`Noblank;
|
||||
`P "Denis Merigoux <$(i,denis.merigoux@inria.fr)>";
|
||||
`Noblank;
|
||||
`P "Emile Rolley <$(i,erolley@tutamail.com)>";
|
||||
`S Manpage.s_examples;
|
||||
`Pre "catala Interpret -s Foo file.catala_en";
|
||||
`Pre "catala Ocaml -o target/file.ml file.catala_en";
|
||||
@ -474,4 +364,4 @@ let info =
|
||||
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
|
||||
Cmd.info "catala" ~version ~doc ~exits ~man
|
||||
|
||||
let catala_t ?(extra = []) handler = Cmd.group info (subcommands handler @ extra)
|
||||
exception Exit_with of int
|
||||
|
||||
@ -17,25 +17,15 @@
|
||||
|
||||
type backend_lang = En | Fr | Pl
|
||||
|
||||
type backend_option =
|
||||
[ `Latex
|
||||
| `Makefile
|
||||
| `Html
|
||||
| `Interpret
|
||||
| `Interpret_Lcalc
|
||||
| `Typecheck
|
||||
| `OCaml
|
||||
| `Python
|
||||
| `Scalc
|
||||
| `Lcalc
|
||||
| `Dcalc
|
||||
| `Scopelang
|
||||
| `Exceptions
|
||||
| `Proof ]
|
||||
|
||||
(** The usual auto/always/never option argument *)
|
||||
type when_enum = Auto | Always | Never
|
||||
|
||||
type message_format_enum =
|
||||
| Human
|
||||
| GNU (** Format of error and warning messages output by the compiler. *)
|
||||
|
||||
type input_file = FileName of string | Contents of string
|
||||
|
||||
val languages : (string * backend_lang) list
|
||||
|
||||
val language_code : backend_lang -> string
|
||||
@ -43,85 +33,82 @@ val language_code : backend_lang -> string
|
||||
|
||||
(** {2 Configuration globals} *)
|
||||
|
||||
val source_files : string list ref
|
||||
(** Source files to be compiled *)
|
||||
|
||||
val locale_lang : backend_lang ref
|
||||
val contents : string ref
|
||||
val debug_flag : bool ref
|
||||
|
||||
val style_flag : when_enum ref
|
||||
(** Styles the terminal output *)
|
||||
|
||||
val optimize_flag : bool ref
|
||||
|
||||
val max_prec_digits : int ref
|
||||
(** Max number of digits to show for decimal results *)
|
||||
|
||||
val trace_flag : bool ref
|
||||
val disable_warnings_flag : bool ref
|
||||
|
||||
val check_invariants_flag : bool ref
|
||||
(** Check structural invariants on the AST. *)
|
||||
|
||||
val disable_counterexamples : bool ref
|
||||
(** Disables model-generated counterexamples for proofs that fail. *)
|
||||
|
||||
val avoid_exceptions_flag : bool ref
|
||||
(** Avoids using [try ... with] exceptions when compiling the default calculus. *)
|
||||
|
||||
type message_format_enum =
|
||||
| Human
|
||||
| GNU (** Format of error and warning messages output by the compiler. *)
|
||||
|
||||
val message_format_flag : message_format_enum ref
|
||||
|
||||
(** {2 CLI terms} *)
|
||||
|
||||
val file : string Cmdliner.Term.t
|
||||
val debug : bool Cmdliner.Term.t
|
||||
val unstyled : bool Cmdliner.Term.t
|
||||
val trace_opt : bool Cmdliner.Term.t
|
||||
val check_invariants_opt : bool Cmdliner.Term.t
|
||||
val wrap_weaved_output : bool Cmdliner.Term.t
|
||||
val print_only_law : bool Cmdliner.Term.t
|
||||
val plugins_dirs : string list Cmdliner.Term.t
|
||||
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
|
||||
val output : string option Cmdliner.Term.t
|
||||
|
||||
type global_options = {
|
||||
debug : bool;
|
||||
color : when_enum;
|
||||
message_format : message_format_enum;
|
||||
wrap_weaved_output : bool;
|
||||
avoid_exceptions : bool;
|
||||
plugins_dirs : string list;
|
||||
language : string option;
|
||||
max_prec_digits : int option;
|
||||
trace : bool;
|
||||
disable_warnings : bool;
|
||||
disable_counterexamples : bool;
|
||||
check_invariants : bool;
|
||||
optimize : bool;
|
||||
ex_scope : string option;
|
||||
ex_variable : string option;
|
||||
output_file : string option;
|
||||
closure_conversion : bool;
|
||||
print_only_law : bool;
|
||||
link_modules : string list;
|
||||
type options = private {
|
||||
mutable input_file : input_file;
|
||||
mutable language : backend_lang option;
|
||||
mutable debug : bool;
|
||||
mutable color : when_enum;
|
||||
mutable message_format : message_format_enum;
|
||||
mutable trace : bool;
|
||||
mutable plugins_dirs : string list;
|
||||
mutable disable_warnings : bool;
|
||||
mutable max_prec_digits : int;
|
||||
}
|
||||
(** Global options, common to all subcommands (note: the fields are internally
|
||||
mutable only for purposes of the [globals] toplevel value defined below) *)
|
||||
|
||||
val globals : options
|
||||
(** A global definition to the global options is provided for convenience, e.g.
|
||||
choosing the proper output in formatting functions. Prefer the use of the
|
||||
options returned by the command-line parsing whenever possible. *)
|
||||
|
||||
val enforce_globals :
|
||||
?input_file:input_file ->
|
||||
?language:backend_lang option ->
|
||||
?debug:bool ->
|
||||
?color:when_enum ->
|
||||
?message_format:message_format_enum ->
|
||||
?trace:bool ->
|
||||
?plugins_dirs:string list ->
|
||||
?disable_warnings:bool ->
|
||||
?max_prec_digits:int ->
|
||||
unit ->
|
||||
options
|
||||
(** Sets up the global options (side-effect); for specific use-cases only, this
|
||||
should never be called from the compiler or when going through normal
|
||||
command-line parsing. Proper uses include setting up the compiler library
|
||||
when using it directly through a specific front-end. *)
|
||||
|
||||
(** {2 CLI flags and options} *)
|
||||
|
||||
module Flags : sig
|
||||
open Cmdliner
|
||||
|
||||
module Global : sig
|
||||
val flags : options Term.t
|
||||
(** Global flags available to all commands. Note that parsing this term also
|
||||
performs some side-effects into [GlobalRefs] and sets up signal/error
|
||||
processing. Sets [input_file] to [FileName "-"], use [options] for the
|
||||
full parser *)
|
||||
|
||||
val options : options Term.t
|
||||
(** [flags] plus an additional positional argument for the input file *)
|
||||
end
|
||||
|
||||
(** Parsers for all flags and options that commands can use *)
|
||||
|
||||
val check_invariants : bool Term.t
|
||||
val wrap_weaved_output : bool Term.t
|
||||
val print_only_law : bool Term.t
|
||||
val ex_scope : string Term.t
|
||||
val ex_scope_opt : string option Term.t
|
||||
val ex_variable : string Term.t
|
||||
val output : string option Term.t
|
||||
val optimize : bool Term.t
|
||||
val avoid_exceptions : bool Term.t
|
||||
val closure_conversion : bool Term.t
|
||||
val link_modules : string list Term.t
|
||||
val disable_counterexamples : bool Term.t
|
||||
end
|
||||
|
||||
(** {2 Command-line application} *)
|
||||
|
||||
val global_options : global_options Cmdliner.Term.t
|
||||
|
||||
val catala_t :
|
||||
?extra:int Cmdliner.Cmd.t list ->
|
||||
(backend_option -> string -> global_options -> int) ->
|
||||
int Cmdliner.Cmd.t
|
||||
(** Main entry point: [catala_t file options] *)
|
||||
|
||||
val set_option_globals : global_options -> unit
|
||||
val version : string
|
||||
val info : Cmdliner.Cmd.info
|
||||
|
||||
val s_plugins : string
|
||||
(** Manpage section name for the installed plugins *)
|
||||
|
||||
exception Exit_with of int
|
||||
(** Exit with a specific exit code (but less brutally than [Sys.exit] which
|
||||
would bypass all finalisers) *)
|
||||
|
||||
@ -28,7 +28,7 @@ let finally f k =
|
||||
|
||||
let temp_file pfx sfx =
|
||||
let f = Filename.temp_file pfx sfx in
|
||||
if not !Cli.debug_flag then
|
||||
if not Cli.globals.debug then
|
||||
at_exit (fun () -> try Sys.remove f with _ -> ());
|
||||
f
|
||||
|
||||
@ -58,7 +58,7 @@ let get_out_channel ~source_file ~output_file ?ext () =
|
||||
| Some f, _ -> Some f, with_out_channel f
|
||||
| None, Some ext ->
|
||||
let src =
|
||||
match source_file with Pos.FileName f -> f | Pos.Contents _ -> "a"
|
||||
match source_file with Cli.FileName f -> f | Cli.Contents _ -> "a"
|
||||
in
|
||||
let f = Filename.remove_extension src ^ ext in
|
||||
Some f, with_out_channel f
|
||||
@ -108,3 +108,11 @@ let process_out ?check_exit cmd args =
|
||||
done;
|
||||
assert false
|
||||
with End_of_file -> Buffer.contents buf
|
||||
|
||||
let check_directory d =
|
||||
try
|
||||
let d = Unix.realpath d in
|
||||
if Sys.is_directory d then Some d else None
|
||||
with Unix.Unix_error _ | Sys_error _ -> None
|
||||
|
||||
let ( / ) = Filename.concat
|
||||
|
||||
@ -42,7 +42,7 @@ val with_formatter_of_opt_file : string option -> (Format.formatter -> 'a) -> 'a
|
||||
{!with_formatter_of_file}), otherwise, uses the [Format.std_formatter]. *)
|
||||
|
||||
val get_out_channel :
|
||||
source_file:Pos.input_file ->
|
||||
source_file:Cli.input_file ->
|
||||
output_file:string option ->
|
||||
?ext:string ->
|
||||
unit ->
|
||||
@ -52,7 +52,7 @@ val get_out_channel :
|
||||
equal to [Some "-"] returns a wrapper around [stdout]. *)
|
||||
|
||||
val get_formatter_of_out_channel :
|
||||
source_file:Pos.input_file ->
|
||||
source_file:Cli.input_file ->
|
||||
output_file:string option ->
|
||||
?ext:string ->
|
||||
unit ->
|
||||
@ -79,3 +79,11 @@ val process_out : ?check_exit:(int -> unit) -> string -> string list -> string
|
||||
arguments, and returns the stdout of the process as a string. [check_exit]
|
||||
is called on the return code of the sub-process, the default is to fail on
|
||||
anything but 0. *)
|
||||
|
||||
val check_directory : string -> string option
|
||||
(** Checks if the given directory exists and returns it normalised (as per
|
||||
[Unix.realpath]). *)
|
||||
|
||||
val ( / ) : string -> string -> string
|
||||
(** [Filename.concat]: Sugar to allow writing
|
||||
[File.("some" / "relative" / "path")] *)
|
||||
|
||||
@ -1,3 +1,20 @@
|
||||
(* This file is part of the Catala compiler, a specification language for tax
|
||||
and social benefits computation rules. Copyright (C) 2023 Inria,
|
||||
contributors: Denis Merigoux <denis.merigoux@inria.fr>, Louis Gesbert
|
||||
<louis.gesbert@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. *)
|
||||
|
||||
(** Error formatting and helper functions *)
|
||||
|
||||
(**{1 Terminal formatting}*)
|
||||
@ -22,7 +39,7 @@ let () = ignore (unstyle_formatter Format.str_formatter)
|
||||
below std_ppf / err_ppf *)
|
||||
|
||||
let has_color oc =
|
||||
match !Cli.style_flag with
|
||||
match Cli.globals.color with
|
||||
| Cli.Never -> false
|
||||
| Always -> true
|
||||
| Auto -> Unix.(isatty (descr_of_out_channel oc))
|
||||
@ -61,8 +78,8 @@ type content_type = Error | Warning | Debug | Log | Result
|
||||
|
||||
let get_ppf = function
|
||||
| Result -> Lazy.force std_ppf
|
||||
| Debug when not !Cli.debug_flag -> Lazy.force ignore_ppf
|
||||
| Warning when !Cli.disable_warnings_flag -> Lazy.force ignore_ppf
|
||||
| Debug when not Cli.globals.debug -> Lazy.force ignore_ppf
|
||||
| Warning when Cli.globals.disable_warnings -> Lazy.force ignore_ppf
|
||||
| Error | Log | Debug | Warning -> Lazy.force err_ppf
|
||||
|
||||
(**{3 Markers}*)
|
||||
@ -75,7 +92,7 @@ let print_time_marker =
|
||||
time := new_time;
|
||||
let delta = (new_time -. old_time) *. 1000. in
|
||||
if delta > 50. then
|
||||
Format.fprintf ppf "@{<bold;black>[TIME] %.0fms@}@ " delta
|
||||
Format.fprintf ppf "@{<bold;black>[TIME] %.0fms@}@\n" delta
|
||||
|
||||
let pp_marker target ppf =
|
||||
let open Ocolor_types in
|
||||
@ -129,14 +146,14 @@ open Content
|
||||
|
||||
let emit_content (content : Content.t) (target : content_type) : unit =
|
||||
let { message; positions } = content in
|
||||
match !Cli.message_format_flag with
|
||||
match Cli.globals.message_format with
|
||||
| Cli.Human ->
|
||||
let ppf = get_ppf target in
|
||||
Format.fprintf ppf "@[<v>@[<hov 0>%t%t%t@]%a@]@." (pp_marker target)
|
||||
(fun ppf ->
|
||||
match target with
|
||||
| Log | Error | Warning -> Format.pp_print_char ppf ' '
|
||||
| Result | Debug -> Format.pp_print_space ppf ())
|
||||
| Log | Error | Warning | Debug -> Format.pp_print_char ppf ' '
|
||||
| Result -> Format.pp_print_space ppf ())
|
||||
message
|
||||
(fun ppf l ->
|
||||
Format.pp_print_list
|
||||
|
||||
@ -84,8 +84,6 @@ let get_end_column (pos : t) : int =
|
||||
|
||||
let get_file (pos : t) : string = (fst pos.code_pos).Lexing.pos_fname
|
||||
|
||||
type input_file = FileName of string | Contents of string
|
||||
|
||||
let to_string (pos : t) : string =
|
||||
let s, e = pos.code_pos in
|
||||
Printf.sprintf "in file %s, from %d:%d to %d:%d" s.Lexing.pos_fname
|
||||
@ -146,7 +144,10 @@ let format_loc_text ppf (pos : t) =
|
||||
let ic, input_line_opt =
|
||||
if filename = "stdin" then
|
||||
let line_index = ref 0 in
|
||||
let lines = String.split_on_char '\n' !Cli.contents in
|
||||
let lines =
|
||||
String.split_on_char '\n'
|
||||
(match Cli.globals.input_file with Contents s -> s | _ -> "")
|
||||
in
|
||||
let input_line_opt () : string option =
|
||||
match List.nth_opt lines !line_index with
|
||||
| Some l ->
|
||||
|
||||
@ -39,8 +39,6 @@ val join : t -> t -> t
|
||||
if they don't belong to the same file. The law position used is the one of
|
||||
the earliest position. *)
|
||||
|
||||
type input_file = FileName of string | Contents of string
|
||||
|
||||
(**{2 Formatters}*)
|
||||
|
||||
val to_string : t -> string
|
||||
|
||||
@ -10,27 +10,22 @@ let _ =
|
||||
(scope : Js.js_string Js.t)
|
||||
(language : Js.js_string Js.t)
|
||||
(trace : bool) =
|
||||
driver `Interpret
|
||||
(Contents (Js.to_string contents))
|
||||
{
|
||||
Cli.debug = false;
|
||||
color = Never;
|
||||
wrap_weaved_output = false;
|
||||
avoid_exceptions = false;
|
||||
plugins_dirs = [];
|
||||
language = Some (Js.to_string language);
|
||||
max_prec_digits = None;
|
||||
closure_conversion = false;
|
||||
message_format = Human;
|
||||
trace;
|
||||
disable_warnings = true;
|
||||
disable_counterexamples = false;
|
||||
optimize = false;
|
||||
check_invariants = false;
|
||||
ex_scope = Some (Js.to_string scope);
|
||||
ex_variable = None;
|
||||
output_file = None;
|
||||
print_only_law = false;
|
||||
link_modules = [];
|
||||
}
|
||||
let contents = Js.to_string contents in
|
||||
let scope = Js.to_string scope in
|
||||
let language = Js.to_string language in
|
||||
let language =
|
||||
try List.assoc (String.lowercase_ascii language) Cli.languages
|
||||
with Not_found ->
|
||||
Message.raise_error "Unrecognised input locale %S" language
|
||||
in
|
||||
let options =
|
||||
Cli.enforce_globals ~input_file:(Contents contents)
|
||||
~language:(Some language) ~debug:false ~color:Never ~trace ()
|
||||
in
|
||||
let prg, ctx, _type_order =
|
||||
Passes.dcalc options ~link_modules:[] ~optimize:false
|
||||
~check_invariants:false
|
||||
in
|
||||
Shared_ast.Interpreter.interpret_program_dcalc prg
|
||||
(Commands.get_scope_uid ctx scope)
|
||||
end)
|
||||
|
||||
@ -135,7 +135,7 @@ let tag_with_log_entry
|
||||
(markings : Uid.MarkedString.info list) : 'm Ast.expr boxed =
|
||||
let m = mark_tany (Mark.get e) (Expr.pos e) in
|
||||
|
||||
if !Cli.trace_flag then
|
||||
if Cli.globals.trace then
|
||||
Expr.eapp (Expr.eop (Log (l, markings)) [TAny, Expr.pos e] m) [e] m
|
||||
else e
|
||||
|
||||
|
||||
1385
compiler/driver.ml
1385
compiler/driver.ml
File diff suppressed because it is too large
Load Diff
@ -17,38 +17,101 @@
|
||||
|
||||
open Catala_utils
|
||||
|
||||
val driver :
|
||||
[< Cli.backend_option | `Plugin of Plugin.handler ] ->
|
||||
Pos.input_file ->
|
||||
Cli.global_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 *)
|
||||
|
||||
(** Compiler passes
|
||||
|
||||
Each pass takes only its cli options, then calls upon its dependent passes
|
||||
(forwarding their options as needed) *)
|
||||
module Passes : sig
|
||||
val surface : Cli.options -> Surface.Ast.program * Cli.backend_lang
|
||||
|
||||
val desugared :
|
||||
Cli.options ->
|
||||
link_modules:string list ->
|
||||
Desugared.Ast.program * Desugared.Name_resolution.context
|
||||
|
||||
val scopelang :
|
||||
Cli.options ->
|
||||
link_modules:string list ->
|
||||
Shared_ast.untyped Scopelang.Ast.program
|
||||
* Desugared.Name_resolution.context
|
||||
* Desugared.Dependency.ExceptionsDependencies.t Desugared.Ast.ScopeDef.Map.t
|
||||
|
||||
val dcalc :
|
||||
Cli.options ->
|
||||
link_modules:string list ->
|
||||
optimize:bool ->
|
||||
check_invariants:bool ->
|
||||
Shared_ast.typed Dcalc.Ast.program
|
||||
* Desugared.Name_resolution.context
|
||||
* Scopelang.Dependency.TVertex.t list
|
||||
|
||||
val lcalc :
|
||||
Cli.options ->
|
||||
link_modules:string list ->
|
||||
optimize:bool ->
|
||||
check_invariants:bool ->
|
||||
avoid_exceptions:bool ->
|
||||
closure_conversion:bool ->
|
||||
Shared_ast.untyped Lcalc.Ast.program
|
||||
* Desugared.Name_resolution.context
|
||||
* Scopelang.Dependency.TVertex.t list
|
||||
|
||||
val scalc :
|
||||
Cli.options ->
|
||||
link_modules:string list ->
|
||||
optimize:bool ->
|
||||
check_invariants:bool ->
|
||||
avoid_exceptions:bool ->
|
||||
closure_conversion:bool ->
|
||||
Scalc.Ast.program
|
||||
* Desugared.Name_resolution.context
|
||||
* Scopelang.Dependency.TVertex.t list
|
||||
end
|
||||
|
||||
module Commands : sig
|
||||
(** Helper functions used by top-level commands *)
|
||||
|
||||
val get_output :
|
||||
?ext:string ->
|
||||
Cli.options ->
|
||||
string option ->
|
||||
string option * ((out_channel -> 'a) -> 'a)
|
||||
(** bounded open of the expected output file *)
|
||||
|
||||
val get_output_format :
|
||||
?ext:string ->
|
||||
Cli.options ->
|
||||
string option ->
|
||||
string option * ((Format.formatter -> 'a) -> 'a)
|
||||
|
||||
val get_scope_uid :
|
||||
Desugared.Name_resolution.context -> string -> Shared_ast.ScopeName.t
|
||||
|
||||
val get_variable_uid :
|
||||
Desugared.Name_resolution.context ->
|
||||
Shared_ast.ScopeName.t ->
|
||||
string ->
|
||||
Desugared.Ast.ScopeDef.t
|
||||
|
||||
val commands : unit Cmdliner.Cmd.t list
|
||||
(** The list of built-in catala subcommands, as expected by
|
||||
[Cmdliner.Cmd.group] *)
|
||||
end
|
||||
|
||||
(** Various helpers *)
|
||||
|
||||
val modname_of_file : string -> string
|
||||
|
||||
(** API available to plugins for their own registration *)
|
||||
|
||||
module Plugin : sig
|
||||
include module type of Plugin.PluginAPI
|
||||
open Cmdliner
|
||||
|
||||
val register_generic : Cmd.info -> Cmd.Exit.code Term.t -> unit
|
||||
|
||||
val register_dcalc :
|
||||
Cmd.info ->
|
||||
extension:string ->
|
||||
Shared_ast.untyped Dcalc.Ast.program plugin_apply_fun_typ ->
|
||||
unit
|
||||
|
||||
val register_lcalc :
|
||||
Cmd.info ->
|
||||
extension:string ->
|
||||
Shared_ast.untyped Lcalc.Ast.program plugin_apply_fun_typ ->
|
||||
unit
|
||||
|
||||
val register_scalc :
|
||||
Cmd.info ->
|
||||
extension:string ->
|
||||
Scalc.Ast.program plugin_apply_fun_typ ->
|
||||
val register :
|
||||
string ->
|
||||
?man:Cmdliner.Manpage.block list ->
|
||||
?doc:string ->
|
||||
(Cli.options -> unit) Cmdliner.Term.t ->
|
||||
unit
|
||||
end
|
||||
|
||||
@ -64,8 +64,10 @@ and translate_expr (ctx : 'm ctx) (e : 'm D.expr) : 'm A.expr boxed =
|
||||
Expr.ecatch (translate_expr ctx arg) EmptyError
|
||||
(Expr.eraise NoValueProvided m)
|
||||
m
|
||||
| EDefault { excepts = [exn]; just; cons } when !Cli.optimize_flag ->
|
||||
(* FIXME: bad place to rely on a global flag *)
|
||||
| EDefault { excepts = [exn]; just; cons }
|
||||
(* Specific optimisation for this case *) ->
|
||||
(* FIXME: this case used to be disabled when optimisations are disabled, but
|
||||
the flag isn't forwarded to this function *)
|
||||
Expr.ecatch (translate_expr ctx exn) EmptyError
|
||||
(Expr.eifthenelse (translate_expr ctx just) (translate_expr ctx cons)
|
||||
(Expr.eraise EmptyError (Mark.get e))
|
||||
|
||||
@ -316,12 +316,12 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
|
||||
f = EApp { f = EOp { op = Log (BeginCall, info); _ }, _; args = [f] }, _;
|
||||
args = [arg];
|
||||
}
|
||||
when !Cli.trace_flag ->
|
||||
when Cli.globals.trace ->
|
||||
Format.fprintf fmt "(log_begin_call@ %a@ %a)@ %a" format_uid_list info
|
||||
format_with_parens f format_with_parens arg
|
||||
| EApp
|
||||
{ f = EOp { op = Log (VarDef var_def_info, info); _ }, _; args = [arg1] }
|
||||
when !Cli.trace_flag ->
|
||||
when Cli.globals.trace ->
|
||||
Format.fprintf fmt
|
||||
"(log_variable_definition@ %a@ {io_input=%s;@ io_output=%b}@ (%a)@ %a)"
|
||||
format_uid_list info
|
||||
@ -333,7 +333,7 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
|
||||
(var_def_info.log_typ, Pos.no_pos)
|
||||
format_with_parens arg1
|
||||
| EApp { f = EOp { op = Log (PosRecordIfTrueBool, _); _ }, m; args = [arg1] }
|
||||
when !Cli.trace_flag ->
|
||||
when Cli.globals.trace ->
|
||||
let pos = Expr.mark_pos m in
|
||||
Format.fprintf fmt
|
||||
"(log_decision_taken@ @[<hov 2>{filename = \"%s\";@ start_line=%d;@ \
|
||||
@ -342,7 +342,7 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
|
||||
(Pos.get_end_line pos) (Pos.get_end_column pos) format_string_list
|
||||
(Pos.get_law_info pos) format_with_parens arg1
|
||||
| EApp { f = EOp { op = Log (EndCall, info); _ }, _; args = [arg1] }
|
||||
when !Cli.trace_flag ->
|
||||
when Cli.globals.trace ->
|
||||
Format.fprintf fmt "(log_end_call@ %a@ %a)" format_uid_list info
|
||||
format_with_parens arg1
|
||||
| EApp { f = EOp { op = Log _; _ }, _; args = [arg1] } ->
|
||||
@ -465,7 +465,7 @@ let format_ctx
|
||||
Format.fprintf fmt "@[<hov 2>%a:@ %a@]" format_struct_field_name
|
||||
(None, struct_field) format_typ struct_field_type))
|
||||
(StructField.Map.bindings struct_fields);
|
||||
if !Cli.trace_flag then
|
||||
if Cli.globals.trace then
|
||||
format_struct_embedding fmt (struct_name, struct_fields)
|
||||
in
|
||||
let format_enum_decl fmt (enum_name, enum_cons) =
|
||||
@ -478,7 +478,7 @@ let format_ctx
|
||||
Format.fprintf fmt "@[<hov 2>| %a@ of@ %a@]" format_enum_cons_name
|
||||
enum_cons format_typ enum_cons_type))
|
||||
(EnumConstructor.Map.bindings enum_cons);
|
||||
if !Cli.trace_flag then format_enum_embedding fmt (enum_name, enum_cons)
|
||||
if Cli.globals.trace then format_enum_embedding fmt (enum_name, enum_cons)
|
||||
in
|
||||
let is_in_type_ordering s =
|
||||
List.exists
|
||||
|
||||
@ -15,44 +15,19 @@
|
||||
the License. *)
|
||||
|
||||
open Catala_utils
|
||||
open Cmdliner
|
||||
|
||||
type t = Cmdliner.Cmd.Exit.code Cmdliner.Cmd.t
|
||||
type t = unit Cmdliner.Cmd.t
|
||||
|
||||
let backend_plugins : (string, t) Hashtbl.t = Hashtbl.create 17
|
||||
|
||||
let register t =
|
||||
Hashtbl.replace backend_plugins
|
||||
(String.lowercase_ascii (Cmdliner.Cmd.name t))
|
||||
t
|
||||
let register info term =
|
||||
let name = String.lowercase_ascii (Cmd.name (Cmd.v info (Term.const ()))) in
|
||||
Hashtbl.replace backend_plugins name
|
||||
(Cmd.v info Term.(term $ Cli.Flags.Global.options))
|
||||
|
||||
let list () = Hashtbl.to_seq_values backend_plugins |> List.of_seq
|
||||
|
||||
module PluginAPI = struct
|
||||
open Cmdliner
|
||||
|
||||
let register_generic info term = register (Cmd.v info term)
|
||||
|
||||
(* For plugins relying on the standard [Driver] *)
|
||||
|
||||
type 'ast plugin_apply_fun_typ =
|
||||
source_file:Pos.input_file ->
|
||||
output_file:string option ->
|
||||
scope:Shared_ast.ScopeName.t option ->
|
||||
'ast ->
|
||||
Scopelang.Dependency.TVertex.t list ->
|
||||
unit
|
||||
end
|
||||
|
||||
type 'ast gen = {
|
||||
name : string;
|
||||
extension : string;
|
||||
apply : 'ast PluginAPI.plugin_apply_fun_typ;
|
||||
}
|
||||
|
||||
type handler =
|
||||
| Dcalc of Shared_ast.untyped Dcalc.Ast.program gen
|
||||
| Lcalc of Shared_ast.untyped Lcalc.Ast.program gen
|
||||
| Scalc of Scalc.Ast.program gen
|
||||
let names () = Hashtbl.to_seq_keys backend_plugins |> List.of_seq
|
||||
|
||||
let load_file f =
|
||||
try
|
||||
@ -62,6 +37,7 @@ let load_file f =
|
||||
Message.emit_warning "Could not load plugin %S: %s" f (Printexc.to_string e)
|
||||
|
||||
let rec load_dir d =
|
||||
Message.emit_debug "Loading plugins from %s" d;
|
||||
let dynlink_exts =
|
||||
if Dynlink.is_native then [".cmxs"] else [".cmo"; ".cma"]
|
||||
in
|
||||
|
||||
@ -14,53 +14,30 @@
|
||||
License for the specific language governing permissions and limitations under
|
||||
the License. *)
|
||||
|
||||
open Catala_utils
|
||||
|
||||
type t = Cmdliner.Cmd.Exit.code Cmdliner.Cmd.t
|
||||
type t = unit Cmdliner.Cmd.t
|
||||
(** Plugins just provide an additional top-level command *)
|
||||
|
||||
(** {2 plugin-facing API} *)
|
||||
|
||||
module PluginAPI : sig
|
||||
open Cmdliner
|
||||
|
||||
val register_generic : Cmd.info -> Cmd.Exit.code Term.t -> unit
|
||||
(** Entry point for the registration of a generic catala subcommand *)
|
||||
|
||||
(** The following are used by [Driver.Plugin] to provide a higher-level
|
||||
interface, registering plugins that rely on the [Driver.driver] function. *)
|
||||
|
||||
type 'ast plugin_apply_fun_typ =
|
||||
source_file:Pos.input_file ->
|
||||
output_file:string option ->
|
||||
scope:Shared_ast.ScopeName.t option ->
|
||||
'ast ->
|
||||
Scopelang.Dependency.TVertex.t list ->
|
||||
unit
|
||||
end
|
||||
|
||||
val register : t -> unit
|
||||
val register :
|
||||
Cmdliner.Cmd.info ->
|
||||
(Catala_utils.Cli.options -> unit) Cmdliner.Term.t ->
|
||||
unit
|
||||
(** Plugins are registerd as [Cmdliner] commands, which must take at least the
|
||||
default global options as arguments (this is required for e.g.
|
||||
[--plugins-dirs] to be handled correctly, and for setting debug flags), but
|
||||
can add more. *)
|
||||
|
||||
(** {2 catala-facing API} *)
|
||||
|
||||
val list : unit -> t list
|
||||
(** List registered plugins *)
|
||||
|
||||
val names : unit -> string list
|
||||
(** List the names of registered plugins *)
|
||||
|
||||
val load_file : string -> unit
|
||||
(** Load the given plugin (cmo/cma or cmxs file) *)
|
||||
|
||||
val load_dir : string -> unit
|
||||
(** Load all plugins found in the given directory *)
|
||||
|
||||
(** {3 Facilities for plugins using the standard driver} *)
|
||||
|
||||
type 'ast gen = {
|
||||
name : string;
|
||||
extension : string;
|
||||
apply : 'ast PluginAPI.plugin_apply_fun_typ;
|
||||
}
|
||||
|
||||
type handler =
|
||||
| Dcalc of Shared_ast.untyped Dcalc.Ast.program gen
|
||||
| Lcalc of Shared_ast.untyped Lcalc.Ast.program gen
|
||||
| Scalc of Scalc.Ast.program gen
|
||||
|
||||
@ -22,15 +22,6 @@ open Lcalc.Ast
|
||||
open Lcalc.To_ocaml
|
||||
module D = Dcalc.Ast
|
||||
|
||||
let name = "api_web"
|
||||
let extension = ".ml"
|
||||
|
||||
let info =
|
||||
Cmdliner.Cmd.info name
|
||||
~doc:
|
||||
"Catala plugin for generating web APIs. It generates OCaml code before \
|
||||
the associated [js_of_ocaml] wrapper."
|
||||
|
||||
(** Contains all format functions used to generating the [js_of_ocaml] wrapper
|
||||
of the corresponding Catala program. *)
|
||||
module To_jsoo = struct
|
||||
@ -432,44 +423,60 @@ module To_jsoo = struct
|
||||
prgm.code_items
|
||||
end
|
||||
|
||||
let apply
|
||||
~(source_file : Pos.input_file)
|
||||
~(output_file : string option)
|
||||
~scope
|
||||
(prgm : 'm Lcalc.Ast.program)
|
||||
(type_ordering : Scopelang.Dependency.TVertex.t list) =
|
||||
ignore scope;
|
||||
File.with_formatter_of_opt_file output_file (fun fmt ->
|
||||
Cli.trace_flag := true;
|
||||
Message.emit_debug "Writing OCaml code to %s..."
|
||||
(Option.value ~default:"stdout" output_file);
|
||||
To_ocaml.format_program fmt prgm type_ordering);
|
||||
|
||||
let output_file, filename_without_ext =
|
||||
match output_file with
|
||||
| Some "-" -> output_file, output_file
|
||||
| Some f ->
|
||||
output_file, Some (Filename.basename f |> Filename.remove_extension)
|
||||
| None -> Some "-", None
|
||||
let run
|
||||
link_modules
|
||||
output
|
||||
optimize
|
||||
check_invariants
|
||||
avoid_exceptions
|
||||
closure_conversion
|
||||
options =
|
||||
if not options.Cli.trace then
|
||||
Message.raise_error "This plugin requires the --trace flag.";
|
||||
let prg, _, type_ordering =
|
||||
Driver.Passes.lcalc options ~link_modules ~optimize ~check_invariants
|
||||
~avoid_exceptions ~closure_conversion
|
||||
in
|
||||
let modname =
|
||||
(* TODO: module directive support *)
|
||||
match options.Cli.input_file with
|
||||
| FileName n -> Some (Driver.modname_of_file n)
|
||||
| _ -> None
|
||||
in
|
||||
let () =
|
||||
(* First compile to ocaml (with --trace on) *)
|
||||
let output_file, with_output =
|
||||
Driver.Commands.get_output_format options ~ext:".ml" output
|
||||
in
|
||||
with_output
|
||||
@@ fun fmt ->
|
||||
Message.emit_debug "Compiling program into OCaml...";
|
||||
Message.emit_debug "Writing to %s..."
|
||||
(Option.value ~default:"stdout" output_file);
|
||||
Lcalc.To_ocaml.format_program fmt ?modname prg type_ordering
|
||||
in
|
||||
let jsoo_output_file, with_formatter =
|
||||
File.get_formatter_of_out_channel ~source_file
|
||||
~output_file:
|
||||
(Option.map
|
||||
(fun name ->
|
||||
if "-" = name then "-"
|
||||
else Filename.remove_extension name ^ "_api_web.ml")
|
||||
output_file)
|
||||
~ext:"_api_web.ml" ()
|
||||
in
|
||||
let module_name =
|
||||
Option.map
|
||||
(fun name -> Printf.sprintf "open %s" (String.capitalize_ascii name))
|
||||
filename_without_ext
|
||||
Driver.Commands.get_output_format options ~ext:"_api_web.ml" output
|
||||
in
|
||||
with_formatter (fun fmt ->
|
||||
Message.emit_debug "Writing JSOO API code to %s..."
|
||||
(Option.value ~default:"stdout" jsoo_output_file);
|
||||
To_jsoo.format_program fmt module_name prgm type_ordering)
|
||||
To_jsoo.format_program fmt
|
||||
(Option.map (( ^ ) "open ") modname)
|
||||
prg type_ordering)
|
||||
|
||||
let () = Driver.Plugin.register_lcalc info ~extension apply
|
||||
let term =
|
||||
let open Cmdliner.Term in
|
||||
const run
|
||||
$ Cli.Flags.link_modules
|
||||
$ Cli.Flags.output
|
||||
$ Cli.Flags.optimize
|
||||
$ Cli.Flags.check_invariants
|
||||
$ Cli.Flags.avoid_exceptions
|
||||
$ Cli.Flags.closure_conversion
|
||||
|
||||
let () =
|
||||
Driver.Plugin.register "api_web" term
|
||||
~doc:
|
||||
"Catala plugin for generating web APIs. It generates OCaml code before \
|
||||
the associated [js_of_ocaml] wrapper."
|
||||
|
||||
@ -14,15 +14,6 @@
|
||||
License for the specific language governing permissions and limitations under
|
||||
the License. *)
|
||||
|
||||
let name = "json_schema"
|
||||
let extension = "_schema.json"
|
||||
|
||||
let info =
|
||||
Cmdliner.Cmd.info name
|
||||
~doc:
|
||||
"Catala plugin for generating {{:https://json-schema.org} JSON schemas} \
|
||||
used to build forms for the Catala website."
|
||||
|
||||
open Catala_utils
|
||||
open Shared_ast
|
||||
open Lcalc.To_ocaml
|
||||
@ -215,24 +206,44 @@ module To_json = struct
|
||||
scope_body.scope_body_input_struct
|
||||
end
|
||||
|
||||
let apply
|
||||
~(source_file : Pos.input_file)
|
||||
~(output_file : string option)
|
||||
~(scope : Shared_ast.ScopeName.t option)
|
||||
(prgm : 'm Lcalc.Ast.program)
|
||||
(type_ordering : Scopelang.Dependency.TVertex.t list) =
|
||||
ignore source_file;
|
||||
ignore type_ordering;
|
||||
match scope with
|
||||
| Some s ->
|
||||
File.with_formatter_of_opt_file output_file (fun fmt ->
|
||||
Message.emit_debug
|
||||
"Writing JSON schema corresponding to the scope '%a' to the file \
|
||||
%s..."
|
||||
ScopeName.format_t s
|
||||
(Option.value ~default:"stdout" output_file);
|
||||
To_json.format_program fmt s prgm)
|
||||
| None ->
|
||||
Message.raise_error "A scope must be specified for the plugin: %s" name
|
||||
let run
|
||||
link_modules
|
||||
output
|
||||
optimize
|
||||
check_invariants
|
||||
avoid_exceptions
|
||||
closure_conversion
|
||||
ex_scope
|
||||
options =
|
||||
let prg, ctx, _ =
|
||||
Driver.Passes.lcalc options ~link_modules ~optimize ~check_invariants
|
||||
~avoid_exceptions ~closure_conversion
|
||||
in
|
||||
let output_file, with_output =
|
||||
Driver.Commands.get_output_format options ~ext:"_schema.json" output
|
||||
in
|
||||
with_output
|
||||
@@ fun fmt ->
|
||||
let scope_uid = Driver.Commands.get_scope_uid ctx ex_scope in
|
||||
Message.emit_debug
|
||||
"Writing JSON schema corresponding to the scope '%a' to the file %s..."
|
||||
ScopeName.format_t scope_uid
|
||||
(Option.value ~default:"stdout" output_file);
|
||||
To_json.format_program fmt scope_uid prg
|
||||
|
||||
let () = Driver.Plugin.register_lcalc info ~extension apply
|
||||
let term =
|
||||
let open Cmdliner.Term in
|
||||
const run
|
||||
$ Cli.Flags.link_modules
|
||||
$ Cli.Flags.output
|
||||
$ Cli.Flags.optimize
|
||||
$ Cli.Flags.check_invariants
|
||||
$ Cli.Flags.avoid_exceptions
|
||||
$ Cli.Flags.closure_conversion
|
||||
$ Cli.Flags.ex_scope
|
||||
|
||||
let () =
|
||||
Driver.Plugin.register "json_schema" term
|
||||
~doc:
|
||||
"Catala plugin for generating {{:https://json-schema.org} JSON schemas} \
|
||||
used to build forms for the Catala website."
|
||||
|
||||
@ -17,10 +17,6 @@
|
||||
open Catala_utils
|
||||
open Shared_ast
|
||||
|
||||
let name = "lazy"
|
||||
let extension = ".out" (* unused *)
|
||||
let info = Cmdliner.Cmd.info name ~doc:"Experimental lazy evaluation (plugin)"
|
||||
|
||||
(* -- Definition of the lazy interpreter -- *)
|
||||
|
||||
let log fmt = Format.ifprintf Format.err_formatter (fmt ^^ "@\n")
|
||||
@ -256,18 +252,24 @@ let interpret_program (prg : ('dcalc, 'm) gexpr program) (scope : ScopeName.t) :
|
||||
|
||||
(* -- Plugin registration -- *)
|
||||
|
||||
let apply ~source_file ~output_file ~scope prg _type_ordering =
|
||||
let scope =
|
||||
match scope with
|
||||
| None -> Message.raise_error "A scope must be specified"
|
||||
| Some s -> s
|
||||
let run link_modules optimize check_invariants ex_scope options =
|
||||
Interpreter.load_runtime_modules link_modules;
|
||||
let prg, ctx, _ =
|
||||
Driver.Passes.dcalc options ~link_modules ~optimize ~check_invariants
|
||||
in
|
||||
ignore source_file;
|
||||
(* File.with_formatter_of_opt_file output_file
|
||||
* @@ fun fmt -> *)
|
||||
ignore output_file;
|
||||
let fmt = Format.std_formatter in
|
||||
let scope = Driver.Commands.get_scope_uid ctx ex_scope in
|
||||
let result_expr, _env = interpret_program prg scope in
|
||||
let fmt = Format.std_formatter in
|
||||
Expr.format fmt result_expr
|
||||
|
||||
let () = Driver.Plugin.register_dcalc info ~extension apply
|
||||
let term =
|
||||
let open Cmdliner.Term in
|
||||
const run
|
||||
$ Cli.Flags.link_modules
|
||||
$ Cli.Flags.optimize
|
||||
$ Cli.Flags.check_invariants
|
||||
$ Cli.Flags.ex_scope
|
||||
|
||||
let () =
|
||||
Driver.Plugin.register "lazy" term
|
||||
~doc:"Experimental lazy evaluation (plugin)"
|
||||
|
||||
@ -22,19 +22,37 @@
|
||||
|
||||
open Catala_utils
|
||||
|
||||
let name = "python-plugin"
|
||||
let extension = ".py"
|
||||
let run
|
||||
link_modules
|
||||
output
|
||||
optimize
|
||||
check_invariants
|
||||
avoid_exceptions
|
||||
closure_conversion
|
||||
options =
|
||||
let open Driver.Commands in
|
||||
let prg, _, type_ordering =
|
||||
Driver.Passes.scalc options ~link_modules ~optimize ~check_invariants
|
||||
~avoid_exceptions ~closure_conversion
|
||||
in
|
||||
let output_file, with_output = get_output_format options ~ext:".py" output in
|
||||
Message.emit_debug "Compiling program into Python...";
|
||||
Message.emit_debug "Writing to %s..."
|
||||
(Option.value ~default:"stdout" output_file);
|
||||
with_output @@ fun fmt -> Scalc.To_python.format_program fmt prg type_ordering
|
||||
|
||||
let info =
|
||||
Cmdliner.Cmd.info name
|
||||
let term =
|
||||
let open Cmdliner.Term in
|
||||
const run
|
||||
$ Cli.Flags.link_modules
|
||||
$ Cli.Flags.output
|
||||
$ Cli.Flags.optimize
|
||||
$ Cli.Flags.check_invariants
|
||||
$ Cli.Flags.avoid_exceptions
|
||||
$ Cli.Flags.closure_conversion
|
||||
|
||||
let () =
|
||||
Driver.Plugin.register "python-plugin" term
|
||||
~doc:
|
||||
"This plugin is for demonstration purposes and should be equivalent to \
|
||||
using the built-in Python backend"
|
||||
|
||||
let apply ~source_file ~output_file ~scope prgm type_ordering =
|
||||
ignore source_file;
|
||||
ignore scope;
|
||||
File.with_formatter_of_opt_file output_file
|
||||
@@ fun fmt -> Scalc.To_python.format_program fmt prgm type_ordering
|
||||
|
||||
let () = Driver.Plugin.register_scalc info ~extension apply
|
||||
|
||||
@ -308,11 +308,11 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
|
||||
Format.fprintf fmt "(%a %a@ %a)" (format_expression ctx) arg1 format_op
|
||||
(op, Pos.no_pos) (format_expression ctx) arg2
|
||||
| EApp ((EApp ((EOp (Log (BeginCall, info)), _), [f]), _), [arg])
|
||||
when !Cli.trace_flag ->
|
||||
when Cli.globals.trace ->
|
||||
Format.fprintf fmt "log_begin_call(%a,@ %a,@ %a)" format_uid_list info
|
||||
(format_expression ctx) f (format_expression ctx) arg
|
||||
| EApp ((EOp (Log (VarDef var_def_info, info)), _), [arg1])
|
||||
when !Cli.trace_flag ->
|
||||
when Cli.globals.trace ->
|
||||
Format.fprintf fmt
|
||||
"log_variable_definition(%a,@ LogIO(io_input=%s,@ io_output=%b),@ %a)"
|
||||
format_uid_list info
|
||||
@ -322,14 +322,14 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
|
||||
| Runtime.Reentrant -> "Reentrant")
|
||||
var_def_info.log_io_output (format_expression ctx) arg1
|
||||
| EApp ((EOp (Log (PosRecordIfTrueBool, _)), pos), [arg1])
|
||||
when !Cli.trace_flag ->
|
||||
when Cli.globals.trace ->
|
||||
Format.fprintf fmt
|
||||
"log_decision_taken(SourcePosition(filename=\"%s\",@ start_line=%d,@ \
|
||||
start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)"
|
||||
(Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos)
|
||||
(Pos.get_end_line pos) (Pos.get_end_column pos) format_string_list
|
||||
(Pos.get_law_info pos) (format_expression ctx) arg1
|
||||
| EApp ((EOp (Log (EndCall, info)), _), [arg1]) when !Cli.trace_flag ->
|
||||
| EApp ((EOp (Log (EndCall, info)), _), [arg1]) when Cli.globals.trace ->
|
||||
Format.fprintf fmt "log_end_call(%a,@ %a)" format_uid_list info
|
||||
(format_expression ctx) arg1
|
||||
| EApp ((EOp (Log _), _), [arg1]) ->
|
||||
|
||||
@ -36,7 +36,7 @@ let tag_with_log_entry
|
||||
(e : untyped Ast.expr boxed)
|
||||
(l : log_entry)
|
||||
(markings : Uid.MarkedString.info list) : untyped Ast.expr boxed =
|
||||
if !Cli.trace_flag then
|
||||
if Cli.globals.trace then
|
||||
Expr.eapp
|
||||
(Expr.eop (Log (l, markings)) [TAny, Expr.pos e] (Mark.get e))
|
||||
[e] (Mark.get e)
|
||||
|
||||
@ -65,7 +65,7 @@ let indent_str = ref ""
|
||||
|
||||
(** {1 Evaluation} *)
|
||||
let print_log entry infos pos e =
|
||||
if !Cli.trace_flag then
|
||||
if Cli.globals.trace then
|
||||
match entry with
|
||||
| VarDef _ ->
|
||||
Message.emit_log "%s%a %a: @{<green>%s@}" !indent_str Print.log_entry
|
||||
@ -671,7 +671,7 @@ let rec evaluate_expr :
|
||||
} ->
|
||||
Message.raise_spanned_error (Expr.pos e')
|
||||
"Assertion failed: %a %a %a" (Print.expr ()) e1
|
||||
(Print.operator ~debug:!Cli.debug_flag)
|
||||
(Print.operator ~debug:Cli.globals.debug)
|
||||
op (Print.expr ()) e2
|
||||
| _ ->
|
||||
Message.emit_debug "%a" (Print.expr ()) e';
|
||||
@ -867,3 +867,13 @@ let interpret_program_dcalc p s : (Uid.MarkedString.info * ('a, 'm) gexpr) list
|
||||
Message.raise_spanned_error (Expr.pos e)
|
||||
"The interpreter can only interpret terms starting with functions having \
|
||||
thunked arguments"
|
||||
|
||||
let load_runtime_modules = function
|
||||
| [] -> ()
|
||||
| modules ->
|
||||
Message.emit_debug "Loading shared modules...";
|
||||
List.iter
|
||||
Dynlink.(
|
||||
fun m ->
|
||||
loadfile (adapt_filename (Filename.remove_extension m ^ ".cmo")))
|
||||
modules
|
||||
|
||||
@ -67,3 +67,7 @@ val interpret_program_lcalc :
|
||||
function whose argument are all thunked. The function is executed by
|
||||
providing for each argument a thunked empty default. Returns a list of all
|
||||
the computed values for the scope variables of the executed scope. *)
|
||||
|
||||
val load_runtime_modules : string list -> unit
|
||||
(** Dynlink the given runtime modules, in order to make them callable by the
|
||||
interpreter *)
|
||||
|
||||
@ -171,13 +171,9 @@ let lit (fmt : Format.formatter) (l : lit) : unit =
|
||||
| LUnit -> lit_style fmt "()"
|
||||
| LRat i ->
|
||||
lit_style fmt
|
||||
(Runtime.decimal_to_string ~max_prec_digits:!Cli.max_prec_digits i)
|
||||
| LMoney e -> (
|
||||
match !Cli.locale_lang with
|
||||
| En -> lit_style fmt (Format.asprintf "$%s" (Runtime.money_to_string e))
|
||||
| Fr -> lit_style fmt (Format.asprintf "%s €" (Runtime.money_to_string e))
|
||||
| Pl -> lit_style fmt (Format.asprintf "%s PLN" (Runtime.money_to_string e))
|
||||
)
|
||||
(Runtime.decimal_to_string ~max_prec_digits:Cli.globals.max_prec_digits i)
|
||||
| LMoney e ->
|
||||
lit_style fmt (Format.asprintf "¤%s" (Runtime.money_to_string e))
|
||||
| LDate d -> lit_style fmt (Runtime.date_to_string d)
|
||||
| LDuration d -> lit_style fmt (Runtime.duration_to_string d)
|
||||
|
||||
@ -712,7 +708,7 @@ let rec colors =
|
||||
let typ_debug = typ None ~colors
|
||||
let typ ctx = typ (Some ctx) ~colors
|
||||
|
||||
let expr ?(hide_function_body = false) ?(debug = !Cli.debug_flag) () ppf e =
|
||||
let expr ?(hide_function_body = false) ?(debug = Cli.globals.debug) () ppf e =
|
||||
expr_aux ~hide_function_body ~debug Bindlib.empty_ctxt colors ppf e
|
||||
|
||||
let scope_let_kind ?debug:(_debug = true) _ctx fmt k =
|
||||
|
||||
@ -152,10 +152,11 @@ let rec format_typ
|
||||
")" (format_typ ~colors) t2
|
||||
| TArray t1 -> (
|
||||
match Mark.remove (UnionFind.get (UnionFind.find t1)) with
|
||||
| TAny _ when not !Cli.debug_flag -> Format.pp_print_string fmt "collection"
|
||||
| TAny _ when not Cli.globals.debug ->
|
||||
Format.pp_print_string fmt "collection"
|
||||
| _ -> Format.fprintf fmt "@[collection@ %a@]" (format_typ ~colors) t1)
|
||||
| TAny v ->
|
||||
if !Cli.debug_flag then Format.fprintf fmt "<a%d>" (Any.hash v)
|
||||
if Cli.globals.debug then Format.fprintf fmt "<a%d>" (Any.hash v)
|
||||
else Format.pp_print_string fmt "<any>"
|
||||
| TClosureEnv -> Format.fprintf fmt "closure_env"
|
||||
|
||||
|
||||
@ -269,7 +269,7 @@ let localised_parser : Cli.backend_lang -> lexbuf -> Ast.source_file = function
|
||||
|
||||
(** Parses a single source file *)
|
||||
let rec parse_source_file
|
||||
(source_file : Pos.input_file)
|
||||
(source_file : Cli.input_file)
|
||||
(language : Cli.backend_lang) : Ast.program =
|
||||
Message.emit_debug "Parsing %s"
|
||||
(match source_file with FileName s | Contents s -> s);
|
||||
@ -307,7 +307,7 @@ and expand_includes
|
||||
match command with
|
||||
| Ast.LawInclude (Ast.CatalaFile sub_source) ->
|
||||
let source_dir = Filename.dirname source_file in
|
||||
let sub_source = Filename.concat source_dir (Mark.remove sub_source) in
|
||||
let sub_source = File.(source_dir / Mark.remove sub_source) in
|
||||
let includ_program = parse_source_file (FileName sub_source) language in
|
||||
{
|
||||
program_interfaces = [];
|
||||
@ -377,7 +377,7 @@ let add_interface source_file language path program =
|
||||
}
|
||||
|
||||
let parse_top_level_file
|
||||
(source_file : Pos.input_file)
|
||||
(source_file : Cli.input_file)
|
||||
(language : Cli.backend_lang) : Ast.program =
|
||||
let program = parse_source_file source_file language in
|
||||
let interface = get_interface program in
|
||||
|
||||
@ -20,7 +20,7 @@
|
||||
open Catala_utils
|
||||
|
||||
val add_interface :
|
||||
Pos.input_file ->
|
||||
Cli.input_file ->
|
||||
Cli.backend_lang ->
|
||||
Shared_ast.Qident.path ->
|
||||
Ast.program ->
|
||||
@ -28,4 +28,4 @@ val add_interface :
|
||||
(** Reads only declarations in metadata in the supplied input file, and add them
|
||||
to the given program *)
|
||||
|
||||
val parse_top_level_file : Pos.input_file -> Cli.backend_lang -> Ast.program
|
||||
val parse_top_level_file : Cli.input_file -> Cli.backend_lang -> Ast.program
|
||||
|
||||
@ -346,7 +346,7 @@ let rec generate_verification_conditions_scope_body_expr
|
||||
let e = match_and_ignore_outer_reentrant_default ctx e in
|
||||
let vc_confl = generate_vc_must_not_return_conflict ctx e in
|
||||
let vc_confl =
|
||||
if !Cli.optimize_flag then
|
||||
if Globals.optimize () then
|
||||
Expr.unbox
|
||||
(Shared_ast.Optimizations.optimize_expr ctx.decl vc_confl)
|
||||
else vc_confl
|
||||
@ -369,7 +369,7 @@ let rec generate_verification_conditions_scope_body_expr
|
||||
| ScopeVarDefinition ->
|
||||
let vc_empty = generate_vc_must_not_return_empty ctx e in
|
||||
let vc_empty =
|
||||
if !Cli.optimize_flag then
|
||||
if Globals.optimize () then
|
||||
Expr.unbox
|
||||
(Shared_ast.Optimizations.optimize_expr ctx.decl vc_empty)
|
||||
else vc_empty
|
||||
|
||||
28
compiler/verification/globals.ml
Normal file
28
compiler/verification/globals.ml
Normal file
@ -0,0 +1,28 @@
|
||||
(* This file is part of the Catala compiler, a specification language for tax
|
||||
and social benefits computation rules. Copyright (C) 2022 Inria, contributor:
|
||||
Aymeric Fromherz <aymeric.fromherz@inria.fr>, 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. *)
|
||||
|
||||
let optimize_ref = ref false
|
||||
let disable_counterexamples_ref = ref false
|
||||
|
||||
(** This sub-lib relies on global refs in many places. This should be cleaned
|
||||
up. *)
|
||||
let setup ~optimize ~disable_counterexamples =
|
||||
optimize_ref := optimize;
|
||||
disable_counterexamples_ref := disable_counterexamples
|
||||
|
||||
let optimize () = !optimize_ref
|
||||
let disable_counterexamples () = !disable_counterexamples_ref
|
||||
29
compiler/verification/globals.mli
Normal file
29
compiler/verification/globals.mli
Normal file
@ -0,0 +1,29 @@
|
||||
(* This file is part of the Catala compiler, a specification language for tax
|
||||
and social benefits computation rules. Copyright (C) 2022 Inria, contributor:
|
||||
Aymeric Fromherz <aymeric.fromherz@inria.fr>, 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. *)
|
||||
|
||||
(** This sub-lib relies on global refs in many places. This should be cleaned
|
||||
up. *)
|
||||
|
||||
val setup : optimize:bool -> disable_counterexamples:bool -> unit
|
||||
|
||||
val optimize : unit -> bool
|
||||
(** Not sure what that means in this context: does it turn on optimisations in
|
||||
the verif backend, or trigger special handling that is dependent on the
|
||||
input code having been optimised ?? *)
|
||||
|
||||
val disable_counterexamples : unit -> bool
|
||||
(** This should really be passed along through arguments *)
|
||||
@ -115,7 +115,7 @@ module MakeBackendIO (B : Backend) = struct
|
||||
Pos.format_loc_text (Mark.get vc.vc_variable)
|
||||
in
|
||||
let counterexample : string option =
|
||||
if !Cli.disable_counterexamples then
|
||||
if Globals.disable_counterexamples () then
|
||||
Some "Counterexample generation is disabled so none was generated."
|
||||
else
|
||||
match model with
|
||||
|
||||
@ -139,7 +139,7 @@ let rec print_z3model_expr (ctx : context) (ty : typ) (e : Expr.expr) : string =
|
||||
Catala sources *)
|
||||
| TUnit -> ""
|
||||
| TInt -> Expr.to_string e
|
||||
| TRat -> Arithmetic.Real.to_decimal_string e !Cli.max_prec_digits
|
||||
| TRat -> Arithmetic.Real.to_decimal_string e Cli.globals.max_prec_digits
|
||||
(* TODO: Print the right money symbol according to language *)
|
||||
| TMoney ->
|
||||
let z3_str = Expr.to_string e in
|
||||
@ -833,7 +833,7 @@ module Backend = struct
|
||||
|
||||
let make_context (decl_ctx : decl_ctx) : backend_context =
|
||||
let cfg =
|
||||
(if !Cli.disable_counterexamples then [] else ["model", "true"])
|
||||
(if Globals.disable_counterexamples () then [] else ["model", "true"])
|
||||
@ ["proof", "false"]
|
||||
in
|
||||
let z3_ctx = mk_context cfg in
|
||||
|
||||
@ -45,7 +45,7 @@ Last good token:
|
||||
11 │ context my_gaming scope GamingAuthorized
|
||||
│ ‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
|
||||
@ -89,7 +89,7 @@ Last good token:
|
||||
11 │ context my_gaming scope GamingAuthorized
|
||||
│ ‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
|
||||
@ -133,7 +133,7 @@ Last good token:
|
||||
11 │ context my_gaming scope GamingAuthorized
|
||||
│ ‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
|
||||
@ -179,5 +179,5 @@ Last good token:
|
||||
11 │ context my_gaming scope GamingAuthorized
|
||||
│ ‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -75,24 +75,24 @@ champ d'application Exemple2:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple1
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 96.48 €
|
||||
[RESULT] montant = ¤96.48
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 96.48 €
|
||||
[RESULT] montant = ESome ¤96.48
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple2
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 85.00 €
|
||||
[RESULT] montant = ¤85.00
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple2 --avoid_exceptions
|
||||
$ catala Interpret_lcalc -s Exemple2 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 85.00 €
|
||||
[RESULT] montant = ESome ¤85.00
|
||||
```
|
||||
|
||||
|
||||
@ -128,47 +128,47 @@ champ d'application Exemple4 :
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple1 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 345.73 €
|
||||
[RESULT] montant = ¤345.73
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple2 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 352.77 €
|
||||
[RESULT] montant = ¤352.77
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 345.73 €
|
||||
[RESULT] montant = ESome ¤345.73
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 352.77 €
|
||||
[RESULT] montant = ESome ¤352.77
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple3 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 339.70 €
|
||||
[RESULT] montant = ¤339.70
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple4 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 230.63 €
|
||||
[RESULT] montant = ¤230.63
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple3 --disable_warnings --avoid_exceptions
|
||||
$ catala Interpret_lcalc -s Exemple3 --disable_warnings --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 339.70 €
|
||||
[RESULT] montant = ESome ¤339.70
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple4 --disable_warnings --avoid_exceptions
|
||||
$ catala Interpret_lcalc -s Exemple4 --disable_warnings --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 230.63 €
|
||||
[RESULT] montant = ESome ¤230.63
|
||||
```
|
||||
|
||||
@ -34,10 +34,10 @@ champ d'application CasTest1:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s CasTest1 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 76.38 €
|
||||
[RESULT] montant = ¤76.38
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s CasTest1 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 76.38 €
|
||||
[RESULT] montant = ESome ¤76.38
|
||||
```
|
||||
|
||||
@ -150,44 +150,44 @@ champ d'application Exemple4:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple1 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 181.91 €
|
||||
[RESULT] montant = ¤181.91
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple2 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 67.34 €
|
||||
[RESULT] montant = ¤67.34
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple3 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 181.91 €
|
||||
[RESULT] montant = ¤181.91
|
||||
```
|
||||
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple4 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 118.59 €
|
||||
[RESULT] montant = ¤118.59
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 181.91 €
|
||||
[RESULT] montant = ESome ¤181.91
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 67.34 €
|
||||
[RESULT] montant = ESome ¤67.34
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple3 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 181.91 €
|
||||
[RESULT] montant = ESome ¤181.91
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple4 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 118.59 €
|
||||
[RESULT] montant = ESome ¤118.59
|
||||
```
|
||||
|
||||
@ -281,98 +281,98 @@ champ d'application Exemple9:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple1 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 0.00 €
|
||||
[RESULT] montant = ¤0.00
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple2 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 352.77 €
|
||||
[RESULT] montant = ¤352.77
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple3 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 321.61 €
|
||||
[RESULT] montant = ¤321.61
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple4 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 0.00 €
|
||||
[RESULT] montant = ¤0.00
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple5 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 311.56 €
|
||||
[RESULT] montant = ¤311.56
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple6 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 0.00 €
|
||||
[RESULT] montant = ¤0.00
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple7 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 153.77 €
|
||||
[RESULT] montant = ¤153.77
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple8 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 11.06 €
|
||||
[RESULT] montant = ¤11.06
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple9 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 210.06 €
|
||||
[RESULT] montant = ¤210.06
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 0.00 €
|
||||
[RESULT] montant = ESome ¤0.00
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 352.77 €
|
||||
[RESULT] montant = ESome ¤352.77
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple3 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 321.61 €
|
||||
[RESULT] montant = ESome ¤321.61
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple4 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 0.00 €
|
||||
[RESULT] montant = ESome ¤0.00
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple5 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 311.56 €
|
||||
[RESULT] montant = ESome ¤311.56
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple6 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 0.00 €
|
||||
[RESULT] montant = ESome ¤0.00
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple7 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 153.77 €
|
||||
[RESULT] montant = ESome ¤153.77
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple8 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 11.06 €
|
||||
[RESULT] montant = ESome ¤11.06
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple9 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 210.06 €
|
||||
[RESULT] montant = ESome ¤210.06
|
||||
```
|
||||
|
||||
@ -139,54 +139,54 @@ champ d'application CasTest5:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s CasTest1 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 12.06 €
|
||||
[RESULT] montant = ¤12.06
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s CasTest2 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 23.12 €
|
||||
[RESULT] montant = ¤23.12
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s CasTest3 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 154.78 €
|
||||
[RESULT] montant = ¤154.78
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s CasTest4 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 154.78 €
|
||||
[RESULT] montant = ¤154.78
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s CasTest5 --disable_warnings
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = 129.65 €
|
||||
[RESULT] montant = ¤129.65
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s CasTest1 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 12.06 €
|
||||
[RESULT] montant = ESome ¤12.06
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s CasTest2 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 23.12 €
|
||||
[RESULT] montant = ESome ¤23.12
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s CasTest3 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 154.78 €
|
||||
[RESULT] montant = ESome ¤154.78
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s CasTest4 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 154.78 €
|
||||
[RESULT] montant = ESome ¤154.78
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s CasTest5 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant = ESome 129.65 €
|
||||
[RESULT] montant = ESome ¤129.65
|
||||
```
|
||||
|
||||
@ -158,40 +158,40 @@ champ d'application Exemple2 :
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple1
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant_versé = 246.23 €
|
||||
[RESULT] montant_versé = ¤246.23
|
||||
[RESULT] éligibilité = true
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant_versé = ESome 246.23 €
|
||||
[RESULT] montant_versé = ESome ¤246.23
|
||||
[RESULT] éligibilité = ESome true
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions -O --closure_conversion
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant_versé = ESome 246.23 €
|
||||
[RESULT] montant_versé = ESome ¤246.23
|
||||
[RESULT] éligibilité = ESome true
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple2
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant_versé = 230.63 €
|
||||
[RESULT] montant_versé = ¤230.63
|
||||
[RESULT] éligibilité = true
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple2 --avoid_exceptions
|
||||
$ catala Interpret_lcalc -s Exemple2 --avoid_exceptions
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant_versé = 230.63 €
|
||||
[RESULT] éligibilité = true
|
||||
[RESULT] montant_versé = ESome ¤230.63
|
||||
[RESULT] éligibilité = ESome true
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Exemple2 --avoid_exceptions -O --closure_conversion
|
||||
$ catala Interpret_lcalc -s Exemple2 -O --avoid_exceptions --closure_conversion
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] montant_versé = 230.63 €
|
||||
[RESULT] éligibilité = true
|
||||
[RESULT] montant_versé = ESome ¤230.63
|
||||
[RESULT] éligibilité = ESome true
|
||||
```
|
||||
|
||||
@ -254,7 +254,7 @@ let driver_lwt
|
||||
(client_id : string)
|
||||
(client_secret : string) =
|
||||
try
|
||||
if debug then Cli.debug_flag := true;
|
||||
let _options = Cli.enforce_globals ~debug () in
|
||||
if not (expiration || diff) then
|
||||
Message.raise_error
|
||||
"You have to check at least something, see the list of options with \
|
||||
|
||||
@ -43,6 +43,9 @@ exception IndivisibleDurations
|
||||
exception ImpossibleDate
|
||||
exception NoValueProvided of source_position
|
||||
|
||||
(* TODO: register exception printers for the above
|
||||
(Printexc.register_printer) *)
|
||||
|
||||
let money_of_cents_string (cents : string) : money = Z.of_string cents
|
||||
let money_of_units_int (units : int) : money = Z.(of_int units * of_int 100)
|
||||
let money_of_cents_integer (cents : integer) : money = cents
|
||||
|
||||
@ -50,7 +50,7 @@ The null denominator:
|
||||
│ ‾‾
|
||||
└┬ `Division_by_zero` exception management
|
||||
└─ with decimals
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -72,7 +72,7 @@ The null denominator:
|
||||
│ ‾
|
||||
└┬ `Division_by_zero` exception management
|
||||
└─ with integers
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -94,5 +94,5 @@ The null denominator:
|
||||
│ ‾‾‾‾
|
||||
└┬ `Division_by_zero` exception management
|
||||
└─ with money
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -7,7 +7,7 @@ scope S1:
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala typecheck -s S1
|
||||
$ catala typecheck
|
||||
[ERROR] Please add parentheses to explicit which of these operators should be applied first
|
||||
|
||||
┌─⯈ tests/test_arithmetic/bad/logical_prio.catala_en:6.28-6.31:
|
||||
@ -21,5 +21,5 @@ $ catala typecheck -s S1
|
||||
6 │ definition o equals true and (false and true and true) or false
|
||||
│ ‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -33,5 +33,5 @@ Type money coming from expression:
|
||||
10 │ definition list_high_count equals number of (m >= $7) for m among list
|
||||
│ ‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -26,27 +26,27 @@ scope B:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = [ $0.00; $9.00; $5.20 ]
|
||||
[RESULT] x = [ ¤0.00; ¤9.00; ¤5.20 ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] max = $18.00
|
||||
[RESULT] min = $5.00
|
||||
[RESULT] y = $17.20
|
||||
[RESULT] max = ¤18.00
|
||||
[RESULT] min = ¤5.00
|
||||
[RESULT] y = ¤17.20
|
||||
[RESULT] z = 1
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = ESome [ ESome $0.00; ESome $9.00; ESome $5.20 ]
|
||||
[RESULT] x = ESome [ ESome ¤0.00; ESome ¤9.00; ESome ¤5.20 ]
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] max = ESome $18.00
|
||||
[RESULT] min = ESome $5.00
|
||||
[RESULT] y = ESome $17.20
|
||||
[RESULT] max = ESome ¤18.00
|
||||
[RESULT] min = ESome ¤5.00
|
||||
[RESULT] y = ESome ¤17.20
|
||||
[RESULT] z = ESome 1
|
||||
```
|
||||
|
||||
@ -34,16 +34,16 @@ $ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT]
|
||||
x =
|
||||
[ { S id = 0; income = $0.00; };
|
||||
{ S id = 1; income = $9.00; };
|
||||
{ S id = 2; income = $5.20; } ]
|
||||
[ { S id = 0; income = ¤0.00; };
|
||||
{ S id = 1; income = ¤9.00; };
|
||||
{ S id = 2; income = ¤5.20; } ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] argmax = { S id = 1; income = $9.00; }
|
||||
[RESULT] argmin = { S id = 0; income = $0.00; }
|
||||
[RESULT] argmax = { S id = 1; income = ¤9.00; }
|
||||
[RESULT] argmin = { S id = 0; income = ¤0.00; }
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
@ -51,13 +51,13 @@ $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
[RESULT]
|
||||
x =
|
||||
ESome
|
||||
[ ESome { S id = ESome 0; income = ESome $0.00; };
|
||||
ESome { S id = ESome 1; income = ESome $9.00; };
|
||||
ESome { S id = ESome 2; income = ESome $5.20; } ]
|
||||
[ ESome { S id = ESome 0; income = ESome ¤0.00; };
|
||||
ESome { S id = ESome 1; income = ESome ¤9.00; };
|
||||
ESome { S id = ESome 2; income = ESome ¤5.20; } ]
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] argmax = ESome { S id = ESome 1; income = ESome $9.00; }
|
||||
[RESULT] argmin = ESome { S id = ESome 0; income = ESome $0.00; }
|
||||
[RESULT] argmax = ESome { S id = ESome 1; income = ESome ¤9.00; }
|
||||
[RESULT] argmin = ESome { S id = ESome 0; income = ESome ¤0.00; }
|
||||
```
|
||||
|
||||
@ -19,13 +19,13 @@ scope B:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = [ $0.00; $9.00; $5.20 ]
|
||||
[RESULT] x = [ ¤0.00; ¤9.00; ¤5.20 ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = ESome [ ESome $0.00; ESome $9.00; ESome $5.20 ]
|
||||
[RESULT] x = ESome [ ESome ¤0.00; ESome ¤9.00; ESome ¤5.20 ]
|
||||
```
|
||||
|
||||
|
||||
@ -33,11 +33,11 @@ $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] y = [ $9.00; $5.20 ]
|
||||
[RESULT] y = [ ¤9.00; ¤5.20 ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] y = ESome [ ESome $9.00; ESome $5.20 ]
|
||||
[RESULT] y = ESome [ ESome ¤9.00; ESome ¤5.20 ]
|
||||
```
|
||||
|
||||
@ -20,23 +20,23 @@ scope B:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = [ $0.00; $9.00; $5.20 ]
|
||||
[RESULT] x = [ ¤0.00; ¤9.00; ¤5.20 ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] y = [ $9.00; $5.20 ]
|
||||
[RESULT] y = [ ¤9.00; ¤5.20 ]
|
||||
[RESULT] z = [ false; true; true ]
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = ESome [ ESome $0.00; ESome $9.00; ESome $5.20 ]
|
||||
[RESULT] x = ESome [ ESome ¤0.00; ESome ¤9.00; ESome ¤5.20 ]
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] y = ESome [ ESome $9.00; ESome $5.20 ]
|
||||
[RESULT] y = ESome [ ESome ¤9.00; ESome ¤5.20 ]
|
||||
[RESULT] z = ESome [ ESome false; ESome true; ESome true ]
|
||||
```
|
||||
|
||||
@ -34,16 +34,16 @@ $ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT]
|
||||
x =
|
||||
[ { S id = 0; income = $0.00; };
|
||||
{ S id = 1; income = $9.00; };
|
||||
{ S id = 2; income = $5.20; } ]
|
||||
[ { S id = 0; income = ¤0.00; };
|
||||
{ S id = 1; income = ¤9.00; };
|
||||
{ S id = 2; income = ¤5.20; } ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] argmax = { S id = 1; income = $9.00; }
|
||||
[RESULT] argmin = { S id = 0; income = $0.00; }
|
||||
[RESULT] argmax = { S id = 1; income = ¤9.00; }
|
||||
[RESULT] argmin = { S id = 0; income = ¤0.00; }
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
@ -51,13 +51,13 @@ $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
[RESULT]
|
||||
x =
|
||||
ESome
|
||||
[ ESome { S id = ESome 0; income = ESome $0.00; };
|
||||
ESome { S id = ESome 1; income = ESome $9.00; };
|
||||
ESome { S id = ESome 2; income = ESome $5.20; } ]
|
||||
[ ESome { S id = ESome 0; income = ESome ¤0.00; };
|
||||
ESome { S id = ESome 1; income = ESome ¤9.00; };
|
||||
ESome { S id = ESome 2; income = ESome ¤5.20; } ]
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] argmax = ESome { S id = ESome 1; income = ESome $9.00; }
|
||||
[RESULT] argmin = ESome { S id = ESome 0; income = ESome $0.00; }
|
||||
[RESULT] argmax = ESome { S id = ESome 1; income = ESome ¤9.00; }
|
||||
[RESULT] argmin = ESome { S id = ESome 0; income = ESome ¤0.00; }
|
||||
```
|
||||
|
||||
@ -13,13 +13,13 @@ scope B:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s B
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = [ $4.00; $8.00 ]
|
||||
[RESULT] x = [ ¤4.00; ¤8.00 ]
|
||||
[RESULT] z = [ false; true ]
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = ESome [ ESome $4.00; ESome $8.00 ]
|
||||
[RESULT] x = ESome [ ESome ¤4.00; ESome ¤8.00 ]
|
||||
[RESULT] z = ESome [ ESome false; ESome true ]
|
||||
```
|
||||
|
||||
@ -36,5 +36,5 @@ Type bool coming from expression:
|
||||
9 │ assertion x
|
||||
│ ‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -34,5 +34,5 @@ Type bool coming from expression:
|
||||
8 │ definition test_var equals 10 xor 20
|
||||
│ ‾‾‾
|
||||
└─ 'xor' should be a boolean operator
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -12,8 +12,6 @@ scope Test:
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Test
|
||||
catala: internal error, uncaught exception:
|
||||
Dates_calc.Dates.AmbiguousComputation
|
||||
|
||||
[ERROR] Unexpected error: Dates_calc.Dates.AmbiguousComputation
|
||||
#return code 125#
|
||||
```
|
||||
|
||||
@ -12,8 +12,6 @@ champ d'application Test:
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Test
|
||||
catala: internal error, uncaught exception:
|
||||
Dates_calc.Dates.AmbiguousComputation
|
||||
|
||||
[ERROR] Unexpected error: Dates_calc.Dates.AmbiguousComputation
|
||||
#return code 125#
|
||||
```
|
||||
|
||||
@ -38,5 +38,5 @@ $ catala Interpret -s Test
|
||||
12 │ date round increasing
|
||||
│ ‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -57,7 +57,7 @@ $ catala Interpret -s Ge
|
||||
│ ‾‾‾‾‾
|
||||
└┬ `UncomparableDurations` exception management
|
||||
└─ `>=` operator
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -77,7 +77,7 @@ $ catala Interpret -s Gt
|
||||
│ ‾‾‾‾‾
|
||||
└┬ `UncomparableDurations` exception management
|
||||
└─ `<=` operator
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -97,7 +97,7 @@ $ catala Interpret -s Le
|
||||
│ ‾‾‾‾‾
|
||||
└┬ `UncomparableDurations` exception management
|
||||
└─ `<=` operator
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -117,5 +117,5 @@ $ catala Interpret -s Lt
|
||||
│ ‾‾‾‾‾
|
||||
└┬ `UncomparableDurations` exception management
|
||||
└─ `<` operator
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -26,5 +26,5 @@ This consequence has a valid justification:
|
||||
9 │ definition x under condition true consequence equals 0
|
||||
│ ‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -25,5 +25,5 @@ $ catala Interpret -s A
|
||||
6 │ output y content boolean
|
||||
│ ‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -21,5 +21,5 @@ $ catala Interpret -s A
|
||||
5 │ output x content integer
|
||||
│ ‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -23,5 +23,5 @@ $ catala Interpret -s A
|
||||
14 │ definition e equals Case1
|
||||
│ ‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -24,5 +24,5 @@ $ catala Interpret -s A
|
||||
15 │ -- anything : 31
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└─ Wildcard cannot be used as single match case
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -33,5 +33,5 @@ $ catala Interpret -s A
|
||||
17 │ -- Case3 : false
|
||||
│ ‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -16,5 +16,5 @@ $ catala Typecheck
|
||||
4 │ declaration enumeration Foo:
|
||||
│ ‾‾‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -36,5 +36,5 @@ $ catala Interpret -s A
|
||||
16 │ -- Case2 of b : b
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -55,7 +55,7 @@ Next reachable case:
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└┬ Wildcard must be the last case
|
||||
└─ Wildcard can't be the first case
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -77,5 +77,5 @@ Next reachable case:
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└┬ Wildcard must be the last case
|
||||
└─ Wildcard can't be the first case
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -54,5 +54,5 @@ Type F coming from expression:
|
||||
28 │ definition y equals x with pattern Case3
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -44,5 +44,5 @@ Type F coming from expression:
|
||||
18 │ definition y equals x with pattern Case3
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -43,5 +43,5 @@ Type F coming from expression:
|
||||
17 │ definition y equals x with pattern Case3
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -24,5 +24,5 @@ $ catala Interpret -s A
|
||||
15 │ definition y equals x with pattern Case3
|
||||
│ ‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -30,5 +30,5 @@ $ catala Interpret -s A
|
||||
21 │ -- Case4 : true
|
||||
│ ‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -39,5 +39,5 @@ Candidate definition
|
||||
8 │ definition x equals 0
|
||||
│ ‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -22,5 +22,5 @@ $ catala Interpret -s A
|
||||
12 │ exception base_y
|
||||
│ ‾‾‾‾‾‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -51,5 +51,5 @@ $ catala Interpret -s A
|
||||
18 │ definition x equals 2
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -20,5 +20,5 @@ $ catala Interpret -s A
|
||||
9 │ definition x equals 1
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -45,5 +45,5 @@ Candidate definition
|
||||
14 │ definition y equals 2
|
||||
│ ‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -19,5 +19,5 @@ $ catala Interpret -s A
|
||||
9 │ exception base_y
|
||||
│ ‾‾‾‾‾‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -32,5 +32,5 @@ This consequence has a valid justification:
|
||||
15 │ definition x equals 2
|
||||
│ ‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -49,12 +49,12 @@ scope Benefit:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s Benefit
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] benefit = $2000.00
|
||||
[RESULT] benefit = ¤2000.00
|
||||
[RESULT] person = { Person age = 26; disabled = true; }
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s Benefit --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] benefit = ESome $2000.00
|
||||
[RESULT] benefit = ESome ¤2000.00
|
||||
[RESULT] person = ESome { Person age = ESome 26; disabled = ESome true; }
|
||||
```
|
||||
|
||||
@ -44,5 +44,5 @@ This consequence has a valid justification:
|
||||
15 │ definition f of x under condition not b consequence equals x * x
|
||||
│ ‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -29,5 +29,5 @@ Defined here:
|
||||
10 │ definition f1 of y under condition not cond
|
||||
│ ‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -28,5 +28,5 @@ Defined here:
|
||||
9 │ exception definition f1 of y under condition not cond
|
||||
│ ‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -28,5 +28,5 @@ Defined here:
|
||||
9 │ exception definition f1 of y under condition not cond
|
||||
│ ‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -17,5 +17,5 @@ $ catala Interpret -s RecursiveFunc
|
||||
8 │ definition f of x equals f of x + 1
|
||||
│ ‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -46,7 +46,8 @@ let scope S
|
||||
return { S y = y; }
|
||||
```
|
||||
|
||||
The next test of closure conversion does not go through for the moment.
|
||||
The next test of closure conversion should give the same results, it checks that
|
||||
`--avoid_exceptions` and `-O` are correctly implied by `--closure_conversion`
|
||||
The detection of closures that should not be converted because they are arguments
|
||||
to reduce or other special operators relies on pattern matching the special
|
||||
operator and its EAbs argument. However without exceptions on, because the
|
||||
@ -56,7 +57,40 @@ option. This let-binding is reduced by partial evaluation, which is why the test
|
||||
with optimizations on passes.
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Lcalc -s S --avoid_exceptions --closure_conversion
|
||||
[ERROR] Option --optimize must be enabled for --closure_conversion
|
||||
#return code 255#
|
||||
$ catala Lcalc -s S --closure_conversion
|
||||
let scope S
|
||||
(S_in: S_in {x_in: eoption collection eoption integer})
|
||||
: S {y: eoption integer}
|
||||
=
|
||||
let get x : eoption collection eoption integer = S_in.x_in in
|
||||
let set y : eoption integer =
|
||||
ESome
|
||||
match
|
||||
(handle_default_opt
|
||||
[ ]
|
||||
(λ (_: unit) → ESome true)
|
||||
(λ (_: unit) →
|
||||
match x with
|
||||
| ENone _1 → ENone _1
|
||||
| ESome y_2 →
|
||||
reduce
|
||||
(λ (f: eoption integer) (init: eoption integer) →
|
||||
match init with
|
||||
| ENone _1 → ENone _1
|
||||
| ESome y_3 →
|
||||
match f with
|
||||
| ENone _1 → ENone _1
|
||||
| ESome y_0 →
|
||||
let potential_max_1 : integer = y_0 in
|
||||
let potential_max_2 : integer = y_3 in
|
||||
if potential_max_1 < potential_max_2
|
||||
then ESome potential_max_1
|
||||
else ESome potential_max_2)
|
||||
ESome -1
|
||||
y_2))
|
||||
with
|
||||
| ENone _ → raise NoValueProvided
|
||||
| ESome y → y
|
||||
in
|
||||
return { S y = y; }
|
||||
```
|
||||
|
||||
@ -39,7 +39,7 @@ Incriminated subscope variable definition:
|
||||
15 │ definition a.f of x under condition b and x > 0 consequence equals x - 1
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -66,7 +66,7 @@ Incriminated subscope variable definition:
|
||||
15 │ definition a.f of x under condition b and x > 0 consequence equals x - 1
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
@ -93,5 +93,5 @@ Incriminated subscope variable definition:
|
||||
15 │ definition a.f of x under condition b and x > 0 consequence equals x - 1
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -31,5 +31,5 @@ Incriminated variable:
|
||||
6 │ input x content integer
|
||||
│ ‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -38,5 +38,5 @@ Incriminated subscope variable definition:
|
||||
14 │ definition a.a equals 0
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -24,5 +24,5 @@ Incriminated variable definition:
|
||||
8 │ definition a equals 0
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -44,5 +44,5 @@ Incriminated subscope declaration:
|
||||
8 │ a scope A
|
||||
│ ‾
|
||||
└─ Test
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -43,6 +43,6 @@ let scope A
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Typecheck -s A
|
||||
$ catala Typecheck
|
||||
[RESULT] Typechecking successful!
|
||||
```
|
||||
|
||||
@ -32,6 +32,6 @@ let scope B (B_in: B_in): B =
|
||||
```
|
||||
|
||||
```catala-test-inline
|
||||
$ catala Typecheck -s B
|
||||
$ catala Typecheck
|
||||
[RESULT] Typechecking successful!
|
||||
```
|
||||
|
||||
@ -35,5 +35,5 @@ Type money coming from expression:
|
||||
6 │ context y content money
|
||||
│ ‾‾‾‾‾
|
||||
└─ Article
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -14,12 +14,12 @@ scope A:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = $0.30
|
||||
[RESULT] y = $0.30
|
||||
[RESULT] x = ¤0.30
|
||||
[RESULT] y = ¤0.30
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = ESome $0.30
|
||||
[RESULT] y = ESome $0.30
|
||||
[RESULT] x = ESome ¤0.30
|
||||
[RESULT] y = ESome ¤0.30
|
||||
```
|
||||
|
||||
@ -15,14 +15,14 @@ scope A:
|
||||
```catala-test-inline
|
||||
$ catala Interpret -s A
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = $123.54
|
||||
[RESULT] y = $8548650.96
|
||||
[RESULT] z = $7.23
|
||||
[RESULT] x = ¤123.54
|
||||
[RESULT] y = ¤8548650.96
|
||||
[RESULT] z = ¤7.23
|
||||
```
|
||||
```catala-test-inline
|
||||
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
|
||||
[RESULT] Computation successful! Results:
|
||||
[RESULT] x = ESome $123.54
|
||||
[RESULT] y = ESome $8548650.96
|
||||
[RESULT] z = ESome $7.23
|
||||
[RESULT] x = ESome ¤123.54
|
||||
[RESULT] y = ESome ¤8548650.96
|
||||
[RESULT] z = ESome ¤7.23
|
||||
```
|
||||
|
||||
@ -20,5 +20,5 @@ $ catala typecheck
|
||||
11 │ equals (output of S1).a
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
└─ Scope calls are not allowed outside of scopes
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
@ -114,7 +114,7 @@ let S2_6 (S2_in_11: S2_in) =
|
||||
try:
|
||||
decl temp_a_16 : any;
|
||||
let temp_a_16 (__17 : unit) =
|
||||
return glob3_3 $44.00 + 100.;
|
||||
return glob3_3 ¤44.00 + 100.;
|
||||
decl temp_a_14 : any;
|
||||
let temp_a_14 (__15 : unit) =
|
||||
return true;
|
||||
@ -131,7 +131,7 @@ let S3_7 (S3_in_18: S3_in) =
|
||||
try:
|
||||
decl temp_a_23 : any;
|
||||
let temp_a_23 (__24 : unit) =
|
||||
return 50. + glob4_4 $44.00 55.;
|
||||
return 50. + glob4_4 ¤44.00 55.;
|
||||
decl temp_a_21 : any;
|
||||
let temp_a_21 (__22 : unit) =
|
||||
return true;
|
||||
|
||||
@ -30,5 +30,5 @@ Incriminated variable definition:
|
||||
9 │ definition x equals |2022-01-16|
|
||||
│ ‾‾‾‾‾‾‾‾‾‾‾‾
|
||||
|
||||
#return code 255#
|
||||
#return code 123#
|
||||
```
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user