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 2023-06-28 15:57:52 +02:00
parent b38f3da60d
commit 0f9ee2c72e
128 changed files with 1836 additions and 1537 deletions

View File

@ -45,6 +45,7 @@ $(PY_VENV_DIR)/stamp: \
syntax_highlighting/fr/pygments/pyproject.toml \ syntax_highlighting/fr/pygments/pyproject.toml \
syntax_highlighting/pl/pygments/pyproject.toml syntax_highlighting/pl/pygments/pyproject.toml
test -d $(PY_VENV_DIR) || python3 -m venv $(PY_VENV_DIR) 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 \ $(PY_VENV_ACTIVATE) python3 -m pip install -U \
-e runtimes/python/catala \ -e runtimes/python/catala \
-e syntax_highlighting/en/pygments \ -e syntax_highlighting/en/pygments \
@ -102,7 +103,6 @@ runtimes:
#> plugins : Builds the compiler backend plugins #> plugins : Builds the compiler backend plugins
plugins: runtimes plugins: runtimes
dune build compiler/plugins/ dune build compiler/plugins/
@echo "define CATALA_PLUGINS=_build/default/compiler/plugins to test the plugins"
########################################## ##########################################
# Rules related to promoted files # Rules related to promoted files

View File

@ -57,10 +57,10 @@ let ninja_output =
Arg.( Arg.(
value value
& opt (some string) None & opt (some string) None
& info ["o"; "output"] ~docv:"OUTPUT" & info ["o"; "output"] ~docv:"FILE"
~doc: ~doc:
"$(i, OUTPUT) is the file that will contain the build.ninja file \ "$(i,FILE) is the file that will contain the build.ninja file \
output. If not specified, the build.ninja file will be outputed in \ output. If not specified, the build.ninja file will be output in \
the temporary directory of the system.") the temporary directory of the system.")
let scope = let scope =
@ -384,8 +384,6 @@ let add_reset_rules_aux
[ [
Var.catala_cmd; Var.catala_cmd;
Var.tested_file; Var.tested_file;
Lit "--unstyled";
Lit "--output=-";
Lit redirect; Lit redirect;
Var.expected_output; Var.expected_output;
Lit "2>&1"; Lit "2>&1";
@ -422,8 +420,6 @@ let add_test_rules_aux
:: [ :: [
Var.catala_cmd; Var.catala_cmd;
Var.tested_file; Var.tested_file;
Lit "--unstyled";
Lit "--output=-";
Lit "2>&1 | colordiff -u -b"; Lit "2>&1 | colordiff -u -b";
Var.expected_output; Var.expected_output;
Lit "-"; Lit "-";
@ -630,16 +626,15 @@ let run_inline_tests
let cmd_out_rd, cmd_out_wr = Unix.pipe () in let cmd_out_rd, cmd_out_wr = Unix.pipe () in
let ic = Unix.in_channel_of_descr cmd_out_rd in let ic = Unix.in_channel_of_descr cmd_out_rd in
let cmd = let cmd =
Array.of_list Array.of_list ((catala_exe :: catala_opts) @ test.params @ [file])
((catala_exe :: catala_opts)
@ test.params
@ [file; "--unstyled"; "--output=-"])
in in
let env = let env =
Unix.environment () Unix.environment ()
|> Array.to_seq |> Array.to_seq
|> Seq.filter (fun s -> |> Seq.filter (fun s ->
not (String.starts_with ~prefix:"OCAMLRUNPARAM=" s)) not (String.starts_with ~prefix:"OCAMLRUNPARAM=" s))
|> Seq.cons "CATALA_OUT=-"
|> Seq.cons "CATALA_COLOR=never"
|> Array.of_seq |> Array.of_seq
in in
let pid = let pid =
@ -885,7 +880,7 @@ let driver
(reset_test_outputs : bool) (reset_test_outputs : bool)
(ninja_output : string option) : int = (ninja_output : string option) : int =
try 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 ninja_flags = makeflags_to_ninja_flags makeflags in
let files_or_folders = List.sort_uniq String.compare files_or_folders let files_or_folders = List.sort_uniq String.compare files_or_folders
and catala_exe = Option.fold ~none:"catala" ~some:Fun.id catala_exe and catala_exe = Option.fold ~none:"catala" ~some:Fun.id catala_exe

View File

@ -15,23 +15,12 @@
License for the specific language governing permissions and limitations under License for the specific language governing permissions and limitations under
the License. *) the License. *)
type backend_lang = En | Fr | Pl (* Types used by flags & options *)
type backend_option = type backend_lang = En | Fr | Pl
[ `Latex type when_enum = Auto | Always | Never
| `Makefile type message_format_enum = Human | GNU
| `Html type input_file = FileName of string | Contents of string
| `Interpret
| `Interpret_Lcalc
| `Typecheck
| `OCaml
| `Python
| `Scalc
| `Lcalc
| `Dcalc
| `Scopelang
| `Exceptions
| `Proof ]
(** Associates a {!type: Cli.backend_lang} with its string represtation. *) (** Associates a {!type: Cli.backend_lang} with its string represtation. *)
let languages = ["en", En; "fr", Fr; "pl", Pl] 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 let rl = List.map (fun (a, b) -> b, a) languages in
fun l -> List.assoc l rl fun l -> List.assoc l rl
(** Source files to be compiled *) let message_format_opt = ["human", Human; "gnu", GNU]
let source_files : string list ref = ref []
let locale_lang : backend_lang ref = ref En type options = {
let contents : string ref = ref "" 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 *) (* Note: we force that the global options (ie options common to all commands)
let debug_flag = ref false 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 let enforce_globals
?input_file
(* Styles the terminal output *) ?language
let style_flag = ref Auto ?debug
?color
(* Max number of digits to show for decimal results *) ?message_format
let max_prec_digits = ref 20 ?trace
let trace_flag = ref false ?plugins_dirs
let disable_warnings_flag = ref false ?disable_warnings
let optimize_flag = ref false ?max_prec_digits
let disable_counterexamples = ref false () =
let avoid_exceptions_flag = ref false Option.iter (fun x -> globals.input_file <- x) input_file;
let check_invariants_flag = ref false Option.iter (fun x -> globals.language <- x) language;
Option.iter (fun x -> globals.debug <- x) debug;
type message_format_enum = Human | GNU Option.iter (fun x -> globals.color <- x) color;
Option.iter (fun x -> globals.message_format <- x) message_format;
let message_format_flag = ref Human 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 open Cmdliner
let file = (* Arg converters for our custom types *)
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.")
let when_opt = Arg.enum ["auto", Auto; "always", Always; "never", Never] let when_opt = Arg.enum ["auto", Auto; "always", Always; "never", Never]
let color = (** CLI flags and options *)
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.")
let message_format_opt = Arg.enum ["human", Human; "gnu", GNU] module Flags = struct
open Cmdliner
open Arg
let message_format = module Global = struct
Arg.( let info = info ~docs:Manpage.s_common_options
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.")
let unstyled = let input_file =
Arg.( 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 value
& flag & flag
& info ["unstyled"] & info ["check_invariants"] ~doc:"Check structural invariants on the AST."
~doc:
"Removes styling (colors, etc.) from terminal output. Equivalent to \
$(b,--color=never)")
let optimize = let wrap_weaved_output =
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.(
value value
& flag & flag
& info ["wrap"; "w"] & 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 = let print_only_law =
Arg.(
value value
& flag & flag
& info ["print_only_law"] & info ["print_only_law"]
~doc: ~doc:
"In literate programming output, skip all code and metadata sections \ "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 ex_scope =
let doc = "Set the given directory to be searched for backend plugins." in required
let env = Cmd.Env.info "CATALA_PLUGINS" ~doc in & opt (some string) None
let default = & info ["s"; "scope"] ~docv:"SCOPE" ~doc:"Scope to be focused on."
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 language = let ex_scope_opt =
Arg.(
value value
& opt (some string) None & opt (some string) None
& info ["l"; "language"] ~docv:"LANG" & info ["s"; "scope"] ~docv:"SCOPE" ~doc:"Scope to be focused on."
~doc:"Input language among: en, fr, pl.")
let max_prec_digits_opt = let ex_variable =
Arg.( required
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
& opt (some string) None & 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 = let output =
Arg.(
value
& opt (some string) None
& info ["v"; "variable"] ~docv:"VARIABLE" ~doc:"Variable to be focused on.")
let output =
Arg.(
value value
& opt (some string) None & opt (some string) None
& info ["output"; "o"] ~docv:"OUTPUT" & info ["output"; "o"] ~docv:"OUTPUT"
~env:(Cmd.Env.info "CATALA_OUT")
~doc: ~doc:
"$(i, OUTPUT) is the file that will contain the output of the \ "$(i, OUTPUT) is the file that will contain the output of the \
compiler. Defaults to $(i,FILE).$(i,EXT) where $(i,EXT) depends on \ 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 = let optimize =
Arg.( 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 value
& opt_all file [] & opt_all file []
& info ["use"; "u"] ~docv:"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 \ $(i,FILE) must be a catala file with a metadata section expressing \
what is exported ; for interpretation, a compiled OCaml shared \ what is exported ; for interpretation, a compiled OCaml shared \
module by the same basename (either .cmo or .cmxs) will be \ module by the same basename (either .cmo or .cmxs) will be \
expected.") expected."
type global_options = { let disable_counterexamples =
debug : bool; value
color : when_enum; & flag
message_format : message_format_enum; & info
wrap_weaved_output : bool; ["disable_counterexamples"]
avoid_exceptions : bool; ~doc:
plugins_dirs : string list; "Disables the search for counterexamples. Useful when you want a \
language : string option; deterministic output from the Catala compiler, since provers can \
max_prec_digits : int option; have some randomness in them."
trace : bool; end
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 version = "0.8.0" let version = "0.8.0"
let s_plugins = "INSTALLED PLUGINS"
let info = let info =
let doc = let doc =
@ -451,18 +329,30 @@ let info =
in in
let man = 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; `S Manpage.s_description;
`P `P
"Catala is a domain-specific language for deriving \ "Catala is a domain-specific language for deriving \
faithful-by-construction algorithms from legislative texts."; faithful-by-construction algorithms from legislative texts.";
`S Manpage.s_commands;
`S s_plugins;
`S Manpage.s_authors; `S Manpage.s_authors;
`P "The authors are listed by alphabetical order."; `P "The authors are listed by alphabetical order:";
`P "Nicolas Chataing <nicolas.chataing@ens.fr>"; `P "Nicolas Chataing <$(i,nicolas.chataing@ens.fr)>";
`P "Alain Delaët-Tixeuil <alain.delaet--tixeuil@inria.fr>"; `Noblank;
`P "Aymeric Fromherz <aymeric.fromherz@inria.fr>"; `P "Alain Delaët-Tixeuil <$(i,alain.delaet--tixeuil@inria.fr)>";
`P "Louis Gesbert <louis.gesbert@ocamlpro.com>"; `Noblank;
`P "Denis Merigoux <denis.merigoux@inria.fr>"; `P "Aymeric Fromherz <$(i,aymeric.fromherz@inria.fr)>";
`P "Emile Rolley <erolley@tutamail.com>"; `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; `S Manpage.s_examples;
`Pre "catala Interpret -s Foo file.catala_en"; `Pre "catala Interpret -s Foo file.catala_en";
`Pre "catala Ocaml -o target/file.ml 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 let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
Cmd.info "catala" ~version ~doc ~exits ~man Cmd.info "catala" ~version ~doc ~exits ~man
let catala_t ?(extra = []) handler = Cmd.group info (subcommands handler @ extra) exception Exit_with of int

View File

@ -17,25 +17,15 @@
type backend_lang = En | Fr | Pl 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 *) (** The usual auto/always/never option argument *)
type when_enum = Auto | Always | Never 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 languages : (string * backend_lang) list
val language_code : backend_lang -> string val language_code : backend_lang -> string
@ -43,85 +33,82 @@ val language_code : backend_lang -> string
(** {2 Configuration globals} *) (** {2 Configuration globals} *)
val source_files : string list ref type options = private {
(** Source files to be compiled *) mutable input_file : input_file;
mutable language : backend_lang option;
val locale_lang : backend_lang ref mutable debug : bool;
val contents : string ref mutable color : when_enum;
val debug_flag : bool ref mutable message_format : message_format_enum;
mutable trace : bool;
val style_flag : when_enum ref mutable plugins_dirs : string list;
(** Styles the terminal output *) mutable disable_warnings : bool;
mutable max_prec_digits : int;
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;
} }
(** 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} *) (** {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 version : string
val info : Cmdliner.Cmd.info 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) *)

View File

@ -28,7 +28,7 @@ let finally f k =
let temp_file pfx sfx = let temp_file pfx sfx =
let f = Filename.temp_file pfx sfx in 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 _ -> ()); at_exit (fun () -> try Sys.remove f with _ -> ());
f f
@ -58,7 +58,7 @@ let get_out_channel ~source_file ~output_file ?ext () =
| Some f, _ -> Some f, with_out_channel f | Some f, _ -> Some f, with_out_channel f
| None, Some ext -> | None, Some ext ->
let src = 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 in
let f = Filename.remove_extension src ^ ext in let f = Filename.remove_extension src ^ ext in
Some f, with_out_channel f Some f, with_out_channel f
@ -108,3 +108,11 @@ let process_out ?check_exit cmd args =
done; done;
assert false assert false
with End_of_file -> Buffer.contents buf 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

View File

@ -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]. *) {!with_formatter_of_file}), otherwise, uses the [Format.std_formatter]. *)
val get_out_channel : val get_out_channel :
source_file:Pos.input_file -> source_file:Cli.input_file ->
output_file:string option -> output_file:string option ->
?ext:string -> ?ext:string ->
unit -> unit ->
@ -52,7 +52,7 @@ val get_out_channel :
equal to [Some "-"] returns a wrapper around [stdout]. *) equal to [Some "-"] returns a wrapper around [stdout]. *)
val get_formatter_of_out_channel : val get_formatter_of_out_channel :
source_file:Pos.input_file -> source_file:Cli.input_file ->
output_file:string option -> output_file:string option ->
?ext:string -> ?ext:string ->
unit -> 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] 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 is called on the return code of the sub-process, the default is to fail on
anything but 0. *) 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")] *)

View File

@ -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 *) (** Error formatting and helper functions *)
(**{1 Terminal formatting}*) (**{1 Terminal formatting}*)
@ -22,7 +39,7 @@ let () = ignore (unstyle_formatter Format.str_formatter)
below std_ppf / err_ppf *) below std_ppf / err_ppf *)
let has_color oc = let has_color oc =
match !Cli.style_flag with match Cli.globals.color with
| Cli.Never -> false | Cli.Never -> false
| Always -> true | Always -> true
| Auto -> Unix.(isatty (descr_of_out_channel oc)) | Auto -> Unix.(isatty (descr_of_out_channel oc))
@ -61,8 +78,8 @@ type content_type = Error | Warning | Debug | Log | Result
let get_ppf = function let get_ppf = function
| Result -> Lazy.force std_ppf | Result -> Lazy.force std_ppf
| Debug when not !Cli.debug_flag -> Lazy.force ignore_ppf | Debug when not Cli.globals.debug -> Lazy.force ignore_ppf
| Warning when !Cli.disable_warnings_flag -> Lazy.force ignore_ppf | Warning when Cli.globals.disable_warnings -> Lazy.force ignore_ppf
| Error | Log | Debug | Warning -> Lazy.force err_ppf | Error | Log | Debug | Warning -> Lazy.force err_ppf
(**{3 Markers}*) (**{3 Markers}*)
@ -75,7 +92,7 @@ let print_time_marker =
time := new_time; time := new_time;
let delta = (new_time -. old_time) *. 1000. in let delta = (new_time -. old_time) *. 1000. in
if delta > 50. then 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 pp_marker target ppf =
let open Ocolor_types in let open Ocolor_types in
@ -129,14 +146,14 @@ open Content
let emit_content (content : Content.t) (target : content_type) : unit = let emit_content (content : Content.t) (target : content_type) : unit =
let { message; positions } = content in let { message; positions } = content in
match !Cli.message_format_flag with match Cli.globals.message_format with
| Cli.Human -> | Cli.Human ->
let ppf = get_ppf target in let ppf = get_ppf target in
Format.fprintf ppf "@[<v>@[<hov 0>%t%t%t@]%a@]@." (pp_marker target) Format.fprintf ppf "@[<v>@[<hov 0>%t%t%t@]%a@]@." (pp_marker target)
(fun ppf -> (fun ppf ->
match target with match target with
| Log | Error | Warning -> Format.pp_print_char ppf ' ' | Log | Error | Warning | Debug -> Format.pp_print_char ppf ' '
| Result | Debug -> Format.pp_print_space ppf ()) | Result -> Format.pp_print_space ppf ())
message message
(fun ppf l -> (fun ppf l ->
Format.pp_print_list Format.pp_print_list

View File

@ -84,8 +84,6 @@ let get_end_column (pos : t) : int =
let get_file (pos : t) : string = (fst pos.code_pos).Lexing.pos_fname 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 to_string (pos : t) : string =
let s, e = pos.code_pos in let s, e = pos.code_pos in
Printf.sprintf "in file %s, from %d:%d to %d:%d" s.Lexing.pos_fname 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 = let ic, input_line_opt =
if filename = "stdin" then if filename = "stdin" then
let line_index = ref 0 in 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 = let input_line_opt () : string option =
match List.nth_opt lines !line_index with match List.nth_opt lines !line_index with
| Some l -> | Some l ->

View File

@ -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 if they don't belong to the same file. The law position used is the one of
the earliest position. *) the earliest position. *)
type input_file = FileName of string | Contents of string
(**{2 Formatters}*) (**{2 Formatters}*)
val to_string : t -> string val to_string : t -> string

View File

@ -10,27 +10,22 @@ let _ =
(scope : Js.js_string Js.t) (scope : Js.js_string Js.t)
(language : Js.js_string Js.t) (language : Js.js_string Js.t)
(trace : bool) = (trace : bool) =
driver `Interpret let contents = Js.to_string contents in
(Contents (Js.to_string contents)) let scope = Js.to_string scope in
{ let language = Js.to_string language in
Cli.debug = false; let language =
color = Never; try List.assoc (String.lowercase_ascii language) Cli.languages
wrap_weaved_output = false; with Not_found ->
avoid_exceptions = false; Message.raise_error "Unrecognised input locale %S" language
plugins_dirs = []; in
language = Some (Js.to_string language); let options =
max_prec_digits = None; Cli.enforce_globals ~input_file:(Contents contents)
closure_conversion = false; ~language:(Some language) ~debug:false ~color:Never ~trace ()
message_format = Human; in
trace; let prg, ctx, _type_order =
disable_warnings = true; Passes.dcalc options ~link_modules:[] ~optimize:false
disable_counterexamples = false; ~check_invariants:false
optimize = false; in
check_invariants = false; Shared_ast.Interpreter.interpret_program_dcalc prg
ex_scope = Some (Js.to_string scope); (Commands.get_scope_uid ctx scope)
ex_variable = None;
output_file = None;
print_only_law = false;
link_modules = [];
}
end) end)

View File

@ -135,7 +135,7 @@ let tag_with_log_entry
(markings : Uid.MarkedString.info list) : 'm Ast.expr boxed = (markings : Uid.MarkedString.info list) : 'm Ast.expr boxed =
let m = mark_tany (Mark.get e) (Expr.pos e) in 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 Expr.eapp (Expr.eop (Log (l, markings)) [TAny, Expr.pos e] m) [e] m
else e else e

File diff suppressed because it is too large Load Diff

View File

@ -17,38 +17,101 @@
open Catala_utils 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 val main : unit -> unit
(** Main program entry point, including command-line parsing and return code *) (** 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 module Plugin : sig
include module type of Plugin.PluginAPI val register :
open Cmdliner string ->
?man:Cmdliner.Manpage.block list ->
val register_generic : Cmd.info -> Cmd.Exit.code Term.t -> unit ?doc:string ->
(Cli.options -> unit) Cmdliner.Term.t ->
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 ->
unit unit
end end

View File

@ -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.ecatch (translate_expr ctx arg) EmptyError
(Expr.eraise NoValueProvided m) (Expr.eraise NoValueProvided m)
m m
| EDefault { excepts = [exn]; just; cons } when !Cli.optimize_flag -> | EDefault { excepts = [exn]; just; cons }
(* FIXME: bad place to rely on a global flag *) (* 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.ecatch (translate_expr ctx exn) EmptyError
(Expr.eifthenelse (translate_expr ctx just) (translate_expr ctx cons) (Expr.eifthenelse (translate_expr ctx just) (translate_expr ctx cons)
(Expr.eraise EmptyError (Mark.get e)) (Expr.eraise EmptyError (Mark.get e))

View File

@ -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] }, _; f = EApp { f = EOp { op = Log (BeginCall, info); _ }, _; args = [f] }, _;
args = [arg]; args = [arg];
} }
when !Cli.trace_flag -> when Cli.globals.trace ->
Format.fprintf fmt "(log_begin_call@ %a@ %a)@ %a" format_uid_list info Format.fprintf fmt "(log_begin_call@ %a@ %a)@ %a" format_uid_list info
format_with_parens f format_with_parens arg format_with_parens f format_with_parens arg
| EApp | EApp
{ f = EOp { op = Log (VarDef var_def_info, info); _ }, _; args = [arg1] } { f = EOp { op = Log (VarDef var_def_info, info); _ }, _; args = [arg1] }
when !Cli.trace_flag -> when Cli.globals.trace ->
Format.fprintf fmt Format.fprintf fmt
"(log_variable_definition@ %a@ {io_input=%s;@ io_output=%b}@ (%a)@ %a)" "(log_variable_definition@ %a@ {io_input=%s;@ io_output=%b}@ (%a)@ %a)"
format_uid_list info 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) (var_def_info.log_typ, Pos.no_pos)
format_with_parens arg1 format_with_parens arg1
| EApp { f = EOp { op = Log (PosRecordIfTrueBool, _); _ }, m; args = [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 let pos = Expr.mark_pos m in
Format.fprintf fmt Format.fprintf fmt
"(log_decision_taken@ @[<hov 2>{filename = \"%s\";@ start_line=%d;@ \ "(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_end_line pos) (Pos.get_end_column pos) format_string_list
(Pos.get_law_info pos) format_with_parens arg1 (Pos.get_law_info pos) format_with_parens arg1
| EApp { f = EOp { op = Log (EndCall, info); _ }, _; args = [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.fprintf fmt "(log_end_call@ %a@ %a)" format_uid_list info
format_with_parens arg1 format_with_parens arg1
| EApp { f = EOp { op = Log _; _ }, _; args = [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 Format.fprintf fmt "@[<hov 2>%a:@ %a@]" format_struct_field_name
(None, struct_field) format_typ struct_field_type)) (None, struct_field) format_typ struct_field_type))
(StructField.Map.bindings struct_fields); (StructField.Map.bindings struct_fields);
if !Cli.trace_flag then if Cli.globals.trace then
format_struct_embedding fmt (struct_name, struct_fields) format_struct_embedding fmt (struct_name, struct_fields)
in in
let format_enum_decl fmt (enum_name, enum_cons) = 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 Format.fprintf fmt "@[<hov 2>| %a@ of@ %a@]" format_enum_cons_name
enum_cons format_typ enum_cons_type)) enum_cons format_typ enum_cons_type))
(EnumConstructor.Map.bindings enum_cons); (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 in
let is_in_type_ordering s = let is_in_type_ordering s =
List.exists List.exists

View File

@ -15,44 +15,19 @@
the License. *) the License. *)
open Catala_utils 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 backend_plugins : (string, t) Hashtbl.t = Hashtbl.create 17
let register t = let register info term =
Hashtbl.replace backend_plugins let name = String.lowercase_ascii (Cmd.name (Cmd.v info (Term.const ()))) in
(String.lowercase_ascii (Cmdliner.Cmd.name t)) Hashtbl.replace backend_plugins name
t (Cmd.v info Term.(term $ Cli.Flags.Global.options))
let list () = Hashtbl.to_seq_values backend_plugins |> List.of_seq let list () = Hashtbl.to_seq_values backend_plugins |> List.of_seq
let names () = Hashtbl.to_seq_keys 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 load_file f = let load_file f =
try try
@ -62,6 +37,7 @@ let load_file f =
Message.emit_warning "Could not load plugin %S: %s" f (Printexc.to_string e) Message.emit_warning "Could not load plugin %S: %s" f (Printexc.to_string e)
let rec load_dir d = let rec load_dir d =
Message.emit_debug "Loading plugins from %s" d;
let dynlink_exts = let dynlink_exts =
if Dynlink.is_native then [".cmxs"] else [".cmo"; ".cma"] if Dynlink.is_native then [".cmxs"] else [".cmo"; ".cma"]
in in

View File

@ -14,53 +14,30 @@
License for the specific language governing permissions and limitations under License for the specific language governing permissions and limitations under
the License. *) the License. *)
open Catala_utils type t = unit Cmdliner.Cmd.t
type t = Cmdliner.Cmd.Exit.code Cmdliner.Cmd.t
(** Plugins just provide an additional top-level command *) (** Plugins just provide an additional top-level command *)
(** {2 plugin-facing API} *) (** {2 plugin-facing API} *)
module PluginAPI : sig val register :
open Cmdliner Cmdliner.Cmd.info ->
(Catala_utils.Cli.options -> unit) Cmdliner.Term.t ->
val register_generic : Cmd.info -> Cmd.Exit.code Term.t -> unit unit
(** Entry point for the registration of a generic catala subcommand *) (** Plugins are registerd as [Cmdliner] commands, which must take at least the
default global options as arguments (this is required for e.g.
(** The following are used by [Driver.Plugin] to provide a higher-level [--plugins-dirs] to be handled correctly, and for setting debug flags), but
interface, registering plugins that rely on the [Driver.driver] function. *) can add more. *)
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
(** {2 catala-facing API} *) (** {2 catala-facing API} *)
val list : unit -> t list val list : unit -> t list
(** List registered plugins *) (** List registered plugins *)
val names : unit -> string list
(** List the names of registered plugins *)
val load_file : string -> unit val load_file : string -> unit
(** Load the given plugin (cmo/cma or cmxs file) *) (** Load the given plugin (cmo/cma or cmxs file) *)
val load_dir : string -> unit val load_dir : string -> unit
(** Load all plugins found in the given directory *) (** 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

View File

@ -22,15 +22,6 @@ open Lcalc.Ast
open Lcalc.To_ocaml open Lcalc.To_ocaml
module D = Dcalc.Ast 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 (** Contains all format functions used to generating the [js_of_ocaml] wrapper
of the corresponding Catala program. *) of the corresponding Catala program. *)
module To_jsoo = struct module To_jsoo = struct
@ -432,44 +423,60 @@ module To_jsoo = struct
prgm.code_items prgm.code_items
end end
let apply let run
~(source_file : Pos.input_file) link_modules
~(output_file : string option) output
~scope optimize
(prgm : 'm Lcalc.Ast.program) check_invariants
(type_ordering : Scopelang.Dependency.TVertex.t list) = avoid_exceptions
ignore scope; closure_conversion
File.with_formatter_of_opt_file output_file (fun fmt -> options =
Cli.trace_flag := true; if not options.Cli.trace then
Message.emit_debug "Writing OCaml code to %s..." Message.raise_error "This plugin requires the --trace flag.";
(Option.value ~default:"stdout" output_file); let prg, _, type_ordering =
To_ocaml.format_program fmt prgm type_ordering); Driver.Passes.lcalc options ~link_modules ~optimize ~check_invariants
~avoid_exceptions ~closure_conversion
let output_file, filename_without_ext = in
match output_file with let modname =
| Some "-" -> output_file, output_file (* TODO: module directive support *)
| Some f -> match options.Cli.input_file with
output_file, Some (Filename.basename f |> Filename.remove_extension) | FileName n -> Some (Driver.modname_of_file n)
| None -> Some "-", None | _ -> 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 in
let jsoo_output_file, with_formatter = let jsoo_output_file, with_formatter =
File.get_formatter_of_out_channel ~source_file Driver.Commands.get_output_format options ~ext:"_api_web.ml" output
~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
in in
with_formatter (fun fmt -> with_formatter (fun fmt ->
Message.emit_debug "Writing JSOO API code to %s..." Message.emit_debug "Writing JSOO API code to %s..."
(Option.value ~default:"stdout" jsoo_output_file); (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."

View File

@ -14,15 +14,6 @@
License for the specific language governing permissions and limitations under License for the specific language governing permissions and limitations under
the License. *) 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 Catala_utils
open Shared_ast open Shared_ast
open Lcalc.To_ocaml open Lcalc.To_ocaml
@ -215,24 +206,44 @@ module To_json = struct
scope_body.scope_body_input_struct scope_body.scope_body_input_struct
end end
let apply let run
~(source_file : Pos.input_file) link_modules
~(output_file : string option) output
~(scope : Shared_ast.ScopeName.t option) optimize
(prgm : 'm Lcalc.Ast.program) check_invariants
(type_ordering : Scopelang.Dependency.TVertex.t list) = avoid_exceptions
ignore source_file; closure_conversion
ignore type_ordering; ex_scope
match scope with options =
| Some s -> let prg, ctx, _ =
File.with_formatter_of_opt_file output_file (fun fmt -> Driver.Passes.lcalc options ~link_modules ~optimize ~check_invariants
Message.emit_debug ~avoid_exceptions ~closure_conversion
"Writing JSON schema corresponding to the scope '%a' to the file \ in
%s..." let output_file, with_output =
ScopeName.format_t s Driver.Commands.get_output_format options ~ext:"_schema.json" output
(Option.value ~default:"stdout" output_file); in
To_json.format_program fmt s prgm) with_output
| None -> @@ fun fmt ->
Message.raise_error "A scope must be specified for the plugin: %s" name 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."

View File

@ -17,10 +17,6 @@
open Catala_utils open Catala_utils
open Shared_ast 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 -- *) (* -- Definition of the lazy interpreter -- *)
let log fmt = Format.ifprintf Format.err_formatter (fmt ^^ "@\n") 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 -- *) (* -- Plugin registration -- *)
let apply ~source_file ~output_file ~scope prg _type_ordering = let run link_modules optimize check_invariants ex_scope options =
let scope = Interpreter.load_runtime_modules link_modules;
match scope with let prg, ctx, _ =
| None -> Message.raise_error "A scope must be specified" Driver.Passes.dcalc options ~link_modules ~optimize ~check_invariants
| Some s -> s
in in
ignore source_file; let scope = Driver.Commands.get_scope_uid ctx ex_scope in
(* File.with_formatter_of_opt_file output_file
* @@ fun fmt -> *)
ignore output_file;
let fmt = Format.std_formatter in
let result_expr, _env = interpret_program prg scope in let result_expr, _env = interpret_program prg scope in
let fmt = Format.std_formatter in
Expr.format fmt result_expr 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)"

View File

@ -22,19 +22,37 @@
open Catala_utils open Catala_utils
let name = "python-plugin" let run
let extension = ".py" 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 = let term =
Cmdliner.Cmd.info name 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: ~doc:
"This plugin is for demonstration purposes and should be equivalent to \ "This plugin is for demonstration purposes and should be equivalent to \
using the built-in Python backend" 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

View File

@ -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 Format.fprintf fmt "(%a %a@ %a)" (format_expression ctx) arg1 format_op
(op, Pos.no_pos) (format_expression ctx) arg2 (op, Pos.no_pos) (format_expression ctx) arg2
| EApp ((EApp ((EOp (Log (BeginCall, info)), _), [f]), _), [arg]) | 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.fprintf fmt "log_begin_call(%a,@ %a,@ %a)" format_uid_list info
(format_expression ctx) f (format_expression ctx) arg (format_expression ctx) f (format_expression ctx) arg
| EApp ((EOp (Log (VarDef var_def_info, info)), _), [arg1]) | EApp ((EOp (Log (VarDef var_def_info, info)), _), [arg1])
when !Cli.trace_flag -> when Cli.globals.trace ->
Format.fprintf fmt Format.fprintf fmt
"log_variable_definition(%a,@ LogIO(io_input=%s,@ io_output=%b),@ %a)" "log_variable_definition(%a,@ LogIO(io_input=%s,@ io_output=%b),@ %a)"
format_uid_list info format_uid_list info
@ -322,14 +322,14 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
| Runtime.Reentrant -> "Reentrant") | Runtime.Reentrant -> "Reentrant")
var_def_info.log_io_output (format_expression ctx) arg1 var_def_info.log_io_output (format_expression ctx) arg1
| EApp ((EOp (Log (PosRecordIfTrueBool, _)), pos), [arg1]) | EApp ((EOp (Log (PosRecordIfTrueBool, _)), pos), [arg1])
when !Cli.trace_flag -> when Cli.globals.trace ->
Format.fprintf fmt Format.fprintf fmt
"log_decision_taken(SourcePosition(filename=\"%s\",@ start_line=%d,@ \ "log_decision_taken(SourcePosition(filename=\"%s\",@ start_line=%d,@ \
start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)" 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_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_end_line pos) (Pos.get_end_column pos) format_string_list
(Pos.get_law_info pos) (format_expression ctx) arg1 (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.fprintf fmt "log_end_call(%a,@ %a)" format_uid_list info
(format_expression ctx) arg1 (format_expression ctx) arg1
| EApp ((EOp (Log _), _), [arg1]) -> | EApp ((EOp (Log _), _), [arg1]) ->

View File

@ -36,7 +36,7 @@ let tag_with_log_entry
(e : untyped Ast.expr boxed) (e : untyped Ast.expr boxed)
(l : log_entry) (l : log_entry)
(markings : Uid.MarkedString.info list) : untyped Ast.expr boxed = (markings : Uid.MarkedString.info list) : untyped Ast.expr boxed =
if !Cli.trace_flag then if Cli.globals.trace then
Expr.eapp Expr.eapp
(Expr.eop (Log (l, markings)) [TAny, Expr.pos e] (Mark.get e)) (Expr.eop (Log (l, markings)) [TAny, Expr.pos e] (Mark.get e))
[e] (Mark.get e) [e] (Mark.get e)

View File

@ -65,7 +65,7 @@ let indent_str = ref ""
(** {1 Evaluation} *) (** {1 Evaluation} *)
let print_log entry infos pos e = let print_log entry infos pos e =
if !Cli.trace_flag then if Cli.globals.trace then
match entry with match entry with
| VarDef _ -> | VarDef _ ->
Message.emit_log "%s%a %a: @{<green>%s@}" !indent_str Print.log_entry 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') Message.raise_spanned_error (Expr.pos e')
"Assertion failed: %a %a %a" (Print.expr ()) e1 "Assertion failed: %a %a %a" (Print.expr ()) e1
(Print.operator ~debug:!Cli.debug_flag) (Print.operator ~debug:Cli.globals.debug)
op (Print.expr ()) e2 op (Print.expr ()) e2
| _ -> | _ ->
Message.emit_debug "%a" (Print.expr ()) e'; 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) Message.raise_spanned_error (Expr.pos e)
"The interpreter can only interpret terms starting with functions having \ "The interpreter can only interpret terms starting with functions having \
thunked arguments" 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

View File

@ -67,3 +67,7 @@ val interpret_program_lcalc :
function whose argument are all thunked. The function is executed by function whose argument are all thunked. The function is executed by
providing for each argument a thunked empty default. Returns a list of all providing for each argument a thunked empty default. Returns a list of all
the computed values for the scope variables of the executed scope. *) 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 *)

View File

@ -171,13 +171,9 @@ let lit (fmt : Format.formatter) (l : lit) : unit =
| LUnit -> lit_style fmt "()" | LUnit -> lit_style fmt "()"
| LRat i -> | LRat i ->
lit_style fmt lit_style fmt
(Runtime.decimal_to_string ~max_prec_digits:!Cli.max_prec_digits i) (Runtime.decimal_to_string ~max_prec_digits:Cli.globals.max_prec_digits i)
| LMoney e -> ( | LMoney e ->
match !Cli.locale_lang with lit_style fmt (Format.asprintf "¤%s" (Runtime.money_to_string e))
| 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))
)
| LDate d -> lit_style fmt (Runtime.date_to_string d) | LDate d -> lit_style fmt (Runtime.date_to_string d)
| LDuration d -> lit_style fmt (Runtime.duration_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_debug = typ None ~colors
let typ ctx = typ (Some ctx) ~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 expr_aux ~hide_function_body ~debug Bindlib.empty_ctxt colors ppf e
let scope_let_kind ?debug:(_debug = true) _ctx fmt k = let scope_let_kind ?debug:(_debug = true) _ctx fmt k =

View File

@ -152,10 +152,11 @@ let rec format_typ
")" (format_typ ~colors) t2 ")" (format_typ ~colors) t2
| TArray t1 -> ( | TArray t1 -> (
match Mark.remove (UnionFind.get (UnionFind.find t1)) with 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) | _ -> Format.fprintf fmt "@[collection@ %a@]" (format_typ ~colors) t1)
| TAny v -> | 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>" else Format.pp_print_string fmt "<any>"
| TClosureEnv -> Format.fprintf fmt "closure_env" | TClosureEnv -> Format.fprintf fmt "closure_env"

View File

@ -269,7 +269,7 @@ let localised_parser : Cli.backend_lang -> lexbuf -> Ast.source_file = function
(** Parses a single source file *) (** Parses a single source file *)
let rec parse_source_file let rec parse_source_file
(source_file : Pos.input_file) (source_file : Cli.input_file)
(language : Cli.backend_lang) : Ast.program = (language : Cli.backend_lang) : Ast.program =
Message.emit_debug "Parsing %s" Message.emit_debug "Parsing %s"
(match source_file with FileName s | Contents s -> s); (match source_file with FileName s | Contents s -> s);
@ -307,7 +307,7 @@ and expand_includes
match command with match command with
| Ast.LawInclude (Ast.CatalaFile sub_source) -> | Ast.LawInclude (Ast.CatalaFile sub_source) ->
let source_dir = Filename.dirname source_file in 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 let includ_program = parse_source_file (FileName sub_source) language in
{ {
program_interfaces = []; program_interfaces = [];
@ -377,7 +377,7 @@ let add_interface source_file language path program =
} }
let parse_top_level_file let parse_top_level_file
(source_file : Pos.input_file) (source_file : Cli.input_file)
(language : Cli.backend_lang) : Ast.program = (language : Cli.backend_lang) : Ast.program =
let program = parse_source_file source_file language in let program = parse_source_file source_file language in
let interface = get_interface program in let interface = get_interface program in

View File

@ -20,7 +20,7 @@
open Catala_utils open Catala_utils
val add_interface : val add_interface :
Pos.input_file -> Cli.input_file ->
Cli.backend_lang -> Cli.backend_lang ->
Shared_ast.Qident.path -> Shared_ast.Qident.path ->
Ast.program -> Ast.program ->
@ -28,4 +28,4 @@ val add_interface :
(** Reads only declarations in metadata in the supplied input file, and add them (** Reads only declarations in metadata in the supplied input file, and add them
to the given program *) 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

View File

@ -346,7 +346,7 @@ let rec generate_verification_conditions_scope_body_expr
let e = match_and_ignore_outer_reentrant_default ctx e in 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 = generate_vc_must_not_return_conflict ctx e in
let vc_confl = let vc_confl =
if !Cli.optimize_flag then if Globals.optimize () then
Expr.unbox Expr.unbox
(Shared_ast.Optimizations.optimize_expr ctx.decl vc_confl) (Shared_ast.Optimizations.optimize_expr ctx.decl vc_confl)
else vc_confl else vc_confl
@ -369,7 +369,7 @@ let rec generate_verification_conditions_scope_body_expr
| ScopeVarDefinition -> | ScopeVarDefinition ->
let vc_empty = generate_vc_must_not_return_empty ctx e in let vc_empty = generate_vc_must_not_return_empty ctx e in
let vc_empty = let vc_empty =
if !Cli.optimize_flag then if Globals.optimize () then
Expr.unbox Expr.unbox
(Shared_ast.Optimizations.optimize_expr ctx.decl vc_empty) (Shared_ast.Optimizations.optimize_expr ctx.decl vc_empty)
else vc_empty else vc_empty

View 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

View 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 *)

View File

@ -115,7 +115,7 @@ module MakeBackendIO (B : Backend) = struct
Pos.format_loc_text (Mark.get vc.vc_variable) Pos.format_loc_text (Mark.get vc.vc_variable)
in in
let counterexample : string option = let counterexample : string option =
if !Cli.disable_counterexamples then if Globals.disable_counterexamples () then
Some "Counterexample generation is disabled so none was generated." Some "Counterexample generation is disabled so none was generated."
else else
match model with match model with

View File

@ -139,7 +139,7 @@ let rec print_z3model_expr (ctx : context) (ty : typ) (e : Expr.expr) : string =
Catala sources *) Catala sources *)
| TUnit -> "" | TUnit -> ""
| TInt -> Expr.to_string e | 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 *) (* TODO: Print the right money symbol according to language *)
| TMoney -> | TMoney ->
let z3_str = Expr.to_string e in 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 make_context (decl_ctx : decl_ctx) : backend_context =
let cfg = let cfg =
(if !Cli.disable_counterexamples then [] else ["model", "true"]) (if Globals.disable_counterexamples () then [] else ["model", "true"])
@ ["proof", "false"] @ ["proof", "false"]
in in
let z3_ctx = mk_context cfg in let z3_ctx = mk_context cfg in

View File

@ -45,7 +45,7 @@ Last good token:
11 │ context my_gaming scope GamingAuthorized 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 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 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 11 │ context my_gaming scope GamingAuthorized
│ ‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾
#return code 255# #return code 123#
``` ```

View File

@ -75,24 +75,24 @@ champ d'application Exemple2:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple1 $ catala Interpret -s Exemple1
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 96.48 [RESULT] montant = ¤96.48
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 96.48 [RESULT] montant = ESome ¤96.48
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple2 $ catala Interpret -s Exemple2
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 85.00 [RESULT] montant = ¤85.00
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple2 --avoid_exceptions $ catala Interpret_lcalc -s Exemple2 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 85.00 [RESULT] montant = ESome ¤85.00
``` ```

View File

@ -128,47 +128,47 @@ champ d'application Exemple4 :
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple1 --disable_warnings $ catala Interpret -s Exemple1 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 345.73 [RESULT] montant = ¤345.73
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple2 --disable_warnings $ catala Interpret -s Exemple2 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 352.77 [RESULT] montant = ¤352.77
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 345.73 [RESULT] montant = ESome ¤345.73
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 352.77 [RESULT] montant = ESome ¤352.77
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple3 --disable_warnings $ catala Interpret -s Exemple3 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 339.70 [RESULT] montant = ¤339.70
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple4 --disable_warnings $ catala Interpret -s Exemple4 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 230.63 [RESULT] montant = ¤230.63
``` ```
```catala-test-inline ```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] Computation successful! Results:
[RESULT] montant = 339.70 [RESULT] montant = ESome ¤339.70
``` ```
```catala-test-inline ```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] Computation successful! Results:
[RESULT] montant = 230.63 [RESULT] montant = ESome ¤230.63
``` ```

View File

@ -34,10 +34,10 @@ champ d'application CasTest1:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s CasTest1 --disable_warnings $ catala Interpret -s CasTest1 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 76.38 [RESULT] montant = ¤76.38
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s CasTest1 --avoid_exceptions $ catala Interpret_Lcalc -s CasTest1 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 76.38 [RESULT] montant = ESome ¤76.38
``` ```

View File

@ -150,44 +150,44 @@ champ d'application Exemple4:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple1 --disable_warnings $ catala Interpret -s Exemple1 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 181.91 [RESULT] montant = ¤181.91
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple2 --disable_warnings $ catala Interpret -s Exemple2 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 67.34 [RESULT] montant = ¤67.34
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple3 --disable_warnings $ catala Interpret -s Exemple3 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 181.91 [RESULT] montant = ¤181.91
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple4 --disable_warnings $ catala Interpret -s Exemple4 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 118.59 [RESULT] montant = ¤118.59
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 181.91 [RESULT] montant = ESome ¤181.91
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 67.34 [RESULT] montant = ESome ¤67.34
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple3 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple3 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 181.91 [RESULT] montant = ESome ¤181.91
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple4 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple4 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 118.59 [RESULT] montant = ESome ¤118.59
``` ```

View File

@ -281,98 +281,98 @@ champ d'application Exemple9:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple1 --disable_warnings $ catala Interpret -s Exemple1 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 0.00 [RESULT] montant = ¤0.00
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple2 --disable_warnings $ catala Interpret -s Exemple2 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 352.77 [RESULT] montant = ¤352.77
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple3 --disable_warnings $ catala Interpret -s Exemple3 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 321.61 [RESULT] montant = ¤321.61
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple4 --disable_warnings $ catala Interpret -s Exemple4 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 0.00 [RESULT] montant = ¤0.00
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple5 --disable_warnings $ catala Interpret -s Exemple5 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 311.56 [RESULT] montant = ¤311.56
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple6 --disable_warnings $ catala Interpret -s Exemple6 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 0.00 [RESULT] montant = ¤0.00
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple7 --disable_warnings $ catala Interpret -s Exemple7 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 153.77 [RESULT] montant = ¤153.77
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple8 --disable_warnings $ catala Interpret -s Exemple8 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 11.06 [RESULT] montant = ¤11.06
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple9 --disable_warnings $ catala Interpret -s Exemple9 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 210.06 [RESULT] montant = ¤210.06
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 0.00 [RESULT] montant = ESome ¤0.00
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple2 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 352.77 [RESULT] montant = ESome ¤352.77
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple3 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple3 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 321.61 [RESULT] montant = ESome ¤321.61
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple4 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple4 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 0.00 [RESULT] montant = ESome ¤0.00
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple5 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple5 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 311.56 [RESULT] montant = ESome ¤311.56
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple6 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple6 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 0.00 [RESULT] montant = ESome ¤0.00
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple7 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple7 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 153.77 [RESULT] montant = ESome ¤153.77
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple8 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple8 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 11.06 [RESULT] montant = ESome ¤11.06
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple9 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple9 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 210.06 [RESULT] montant = ESome ¤210.06
``` ```

View File

@ -139,54 +139,54 @@ champ d'application CasTest5:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s CasTest1 --disable_warnings $ catala Interpret -s CasTest1 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 12.06 [RESULT] montant = ¤12.06
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s CasTest2 --disable_warnings $ catala Interpret -s CasTest2 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 23.12 [RESULT] montant = ¤23.12
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s CasTest3 --disable_warnings $ catala Interpret -s CasTest3 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 154.78 [RESULT] montant = ¤154.78
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s CasTest4 --disable_warnings $ catala Interpret -s CasTest4 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 154.78 [RESULT] montant = ¤154.78
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s CasTest5 --disable_warnings $ catala Interpret -s CasTest5 --disable_warnings
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = 129.65 [RESULT] montant = ¤129.65
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s CasTest1 --avoid_exceptions $ catala Interpret_Lcalc -s CasTest1 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 12.06 [RESULT] montant = ESome ¤12.06
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s CasTest2 --avoid_exceptions $ catala Interpret_Lcalc -s CasTest2 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 23.12 [RESULT] montant = ESome ¤23.12
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s CasTest3 --avoid_exceptions $ catala Interpret_Lcalc -s CasTest3 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 154.78 [RESULT] montant = ESome ¤154.78
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s CasTest4 --avoid_exceptions $ catala Interpret_Lcalc -s CasTest4 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 154.78 [RESULT] montant = ESome ¤154.78
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s CasTest5 --avoid_exceptions $ catala Interpret_Lcalc -s CasTest5 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant = ESome 129.65 [RESULT] montant = ESome ¤129.65
``` ```

View File

@ -158,40 +158,40 @@ champ d'application Exemple2 :
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple1 $ catala Interpret -s Exemple1
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant_versé = 246.23 [RESULT] montant_versé = ¤246.23
[RESULT] éligibilité = true [RESULT] éligibilité = true
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions $ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant_versé = ESome 246.23 [RESULT] montant_versé = ESome ¤246.23
[RESULT] éligibilité = ESome true [RESULT] éligibilité = ESome true
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions -O --closure_conversion $ catala Interpret_Lcalc -s Exemple1 --avoid_exceptions -O --closure_conversion
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant_versé = ESome 246.23 [RESULT] montant_versé = ESome ¤246.23
[RESULT] éligibilité = ESome true [RESULT] éligibilité = ESome true
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple2 $ catala Interpret -s Exemple2
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant_versé = 230.63 [RESULT] montant_versé = ¤230.63
[RESULT] éligibilité = true [RESULT] éligibilité = true
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Exemple2 --avoid_exceptions $ catala Interpret_lcalc -s Exemple2 --avoid_exceptions
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] montant_versé = 230.63 [RESULT] montant_versé = ESome ¤230.63
[RESULT] éligibilité = true [RESULT] éligibilité = ESome true
``` ```
```catala-test-inline ```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] Computation successful! Results:
[RESULT] montant_versé = 230.63 [RESULT] montant_versé = ESome ¤230.63
[RESULT] éligibilité = true [RESULT] éligibilité = ESome true
``` ```

View File

@ -254,7 +254,7 @@ let driver_lwt
(client_id : string) (client_id : string)
(client_secret : string) = (client_secret : string) =
try try
if debug then Cli.debug_flag := true; let _options = Cli.enforce_globals ~debug () in
if not (expiration || diff) then if not (expiration || diff) then
Message.raise_error Message.raise_error
"You have to check at least something, see the list of options with \ "You have to check at least something, see the list of options with \

View File

@ -43,6 +43,9 @@ exception IndivisibleDurations
exception ImpossibleDate exception ImpossibleDate
exception NoValueProvided of source_position 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_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_units_int (units : int) : money = Z.(of_int units * of_int 100)
let money_of_cents_integer (cents : integer) : money = cents let money_of_cents_integer (cents : integer) : money = cents

View File

@ -50,7 +50,7 @@ The null denominator:
│ ‾‾ │ ‾‾
└┬ `Division_by_zero` exception management └┬ `Division_by_zero` exception management
└─ with decimals └─ with decimals
#return code 255# #return code 123#
``` ```
```catala-test-inline ```catala-test-inline
@ -72,7 +72,7 @@ The null denominator:
│ ‾ │ ‾
└┬ `Division_by_zero` exception management └┬ `Division_by_zero` exception management
└─ with integers └─ with integers
#return code 255# #return code 123#
``` ```
```catala-test-inline ```catala-test-inline
@ -94,5 +94,5 @@ The null denominator:
│ ‾‾‾‾ │ ‾‾‾‾
└┬ `Division_by_zero` exception management └┬ `Division_by_zero` exception management
└─ with money └─ with money
#return code 255# #return code 123#
``` ```

View File

@ -7,7 +7,7 @@ scope S1:
``` ```
```catala-test-inline ```catala-test-inline
$ catala typecheck -s S1 $ catala typecheck
[ERROR] Please add parentheses to explicit which of these operators should be applied first [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: ┌─⯈ 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 6 │ definition o equals true and (false and true and true) or false
│ ‾‾ │ ‾‾
#return code 255# #return code 123#
``` ```

View File

@ -33,5 +33,5 @@ Type money coming from expression:
10 │ definition list_high_count equals number of (m >= $7) for m among list 10 │ definition list_high_count equals number of (m >= $7) for m among list
│ ‾‾ │ ‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -26,27 +26,27 @@ scope B:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s A $ catala Interpret -s A
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] x = [ $0.00; $9.00; $5.20 ] [RESULT] x = [ ¤0.00; ¤9.00; ¤5.20 ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s B $ catala Interpret -s B
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] max = $18.00 [RESULT] max = ¤18.00
[RESULT] min = $5.00 [RESULT] min = ¤5.00
[RESULT] y = $17.20 [RESULT] y = ¤17.20
[RESULT] z = 1 [RESULT] z = 1
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [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-test-inline
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize $ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] max = ESome $18.00 [RESULT] max = ESome ¤18.00
[RESULT] min = ESome $5.00 [RESULT] min = ESome ¤5.00
[RESULT] y = ESome $17.20 [RESULT] y = ESome ¤17.20
[RESULT] z = ESome 1 [RESULT] z = ESome 1
``` ```

View File

@ -34,16 +34,16 @@ $ catala Interpret -s A
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] [RESULT]
x = x =
[ { S id = 0; income = $0.00; }; [ { S id = 0; income = ¤0.00; };
{ S id = 1; income = $9.00; }; { S id = 1; income = ¤9.00; };
{ S id = 2; income = $5.20; } ] { S id = 2; income = ¤5.20; } ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s B $ catala Interpret -s B
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] argmax = { S id = 1; income = $9.00; } [RESULT] argmax = { S id = 1; income = ¤9.00; }
[RESULT] argmin = { S id = 0; income = $0.00; } [RESULT] argmin = { S id = 0; income = ¤0.00; }
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
@ -51,13 +51,13 @@ $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
[RESULT] [RESULT]
x = x =
ESome ESome
[ ESome { S id = ESome 0; income = ESome $0.00; }; [ ESome { S id = ESome 0; income = ESome ¤0.00; };
ESome { S id = ESome 1; income = ESome $9.00; }; ESome { S id = ESome 1; income = ESome ¤9.00; };
ESome { S id = ESome 2; income = ESome $5.20; } ] ESome { S id = ESome 2; income = ESome ¤5.20; } ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize $ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] argmax = ESome { S id = ESome 1; income = ESome $9.00; } [RESULT] argmax = ESome { S id = ESome 1; income = ESome ¤9.00; }
[RESULT] argmin = ESome { S id = ESome 0; income = ESome $0.00; } [RESULT] argmin = ESome { S id = ESome 0; income = ESome ¤0.00; }
``` ```

View File

@ -19,13 +19,13 @@ scope B:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s A $ catala Interpret -s A
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] x = [ $0.00; $9.00; $5.20 ] [RESULT] x = [ ¤0.00; ¤9.00; ¤5.20 ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [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-test-inline
$ catala Interpret -s B $ catala Interpret -s B
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] y = [ $9.00; $5.20 ] [RESULT] y = [ ¤9.00; ¤5.20 ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize $ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] y = ESome [ ESome $9.00; ESome $5.20 ] [RESULT] y = ESome [ ESome ¤9.00; ESome ¤5.20 ]
``` ```

View File

@ -20,23 +20,23 @@ scope B:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s A $ catala Interpret -s A
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] x = [ $0.00; $9.00; $5.20 ] [RESULT] x = [ ¤0.00; ¤9.00; ¤5.20 ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s B $ catala Interpret -s B
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] y = [ $9.00; $5.20 ] [RESULT] y = [ ¤9.00; ¤5.20 ]
[RESULT] z = [ false; true; true ] [RESULT] z = [ false; true; true ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [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-test-inline
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize $ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [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 ] [RESULT] z = ESome [ ESome false; ESome true; ESome true ]
``` ```

View File

@ -34,16 +34,16 @@ $ catala Interpret -s A
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] [RESULT]
x = x =
[ { S id = 0; income = $0.00; }; [ { S id = 0; income = ¤0.00; };
{ S id = 1; income = $9.00; }; { S id = 1; income = ¤9.00; };
{ S id = 2; income = $5.20; } ] { S id = 2; income = ¤5.20; } ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret -s B $ catala Interpret -s B
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] argmax = { S id = 1; income = $9.00; } [RESULT] argmax = { S id = 1; income = ¤9.00; }
[RESULT] argmin = { S id = 0; income = $0.00; } [RESULT] argmin = { S id = 0; income = ¤0.00; }
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
@ -51,13 +51,13 @@ $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
[RESULT] [RESULT]
x = x =
ESome ESome
[ ESome { S id = ESome 0; income = ESome $0.00; }; [ ESome { S id = ESome 0; income = ESome ¤0.00; };
ESome { S id = ESome 1; income = ESome $9.00; }; ESome { S id = ESome 1; income = ESome ¤9.00; };
ESome { S id = ESome 2; income = ESome $5.20; } ] ESome { S id = ESome 2; income = ESome ¤5.20; } ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize $ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] argmax = ESome { S id = ESome 1; income = ESome $9.00; } [RESULT] argmax = ESome { S id = ESome 1; income = ESome ¤9.00; }
[RESULT] argmin = ESome { S id = ESome 0; income = ESome $0.00; } [RESULT] argmin = ESome { S id = ESome 0; income = ESome ¤0.00; }
``` ```

View File

@ -13,13 +13,13 @@ scope B:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s B $ catala Interpret -s B
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] x = [ $4.00; $8.00 ] [RESULT] x = [ ¤4.00; ¤8.00 ]
[RESULT] z = [ false; true ] [RESULT] z = [ false; true ]
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s B --avoid_exceptions --optimize $ catala Interpret_Lcalc -s B --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [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 ] [RESULT] z = ESome [ ESome false; ESome true ]
``` ```

View File

@ -36,5 +36,5 @@ Type bool coming from expression:
9 │ assertion x 9 │ assertion x
│ ‾ │ ‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -34,5 +34,5 @@ Type bool coming from expression:
8 │ definition test_var equals 10 xor 20 8 │ definition test_var equals 10 xor 20
│ ‾‾‾ │ ‾‾‾
└─ 'xor' should be a boolean operator └─ 'xor' should be a boolean operator
#return code 255# #return code 123#
``` ```

View File

@ -12,8 +12,6 @@ scope Test:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Test $ catala Interpret -s Test
catala: internal error, uncaught exception: [ERROR] Unexpected error: Dates_calc.Dates.AmbiguousComputation
Dates_calc.Dates.AmbiguousComputation
#return code 125# #return code 125#
``` ```

View File

@ -12,8 +12,6 @@ champ d'application Test:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Test $ catala Interpret -s Test
catala: internal error, uncaught exception: [ERROR] Unexpected error: Dates_calc.Dates.AmbiguousComputation
Dates_calc.Dates.AmbiguousComputation
#return code 125# #return code 125#
``` ```

View File

@ -38,5 +38,5 @@ $ catala Interpret -s Test
12 │ date round increasing 12 │ date round increasing
│ ‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾
#return code 255# #return code 123#
``` ```

View File

@ -57,7 +57,7 @@ $ catala Interpret -s Ge
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└┬ `UncomparableDurations` exception management └┬ `UncomparableDurations` exception management
└─ `>=` operator └─ `>=` operator
#return code 255# #return code 123#
``` ```
```catala-test-inline ```catala-test-inline
@ -77,7 +77,7 @@ $ catala Interpret -s Gt
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└┬ `UncomparableDurations` exception management └┬ `UncomparableDurations` exception management
└─ `<=` operator └─ `<=` operator
#return code 255# #return code 123#
``` ```
```catala-test-inline ```catala-test-inline
@ -97,7 +97,7 @@ $ catala Interpret -s Le
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└┬ `UncomparableDurations` exception management └┬ `UncomparableDurations` exception management
└─ `<=` operator └─ `<=` operator
#return code 255# #return code 123#
``` ```
```catala-test-inline ```catala-test-inline
@ -117,5 +117,5 @@ $ catala Interpret -s Lt
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└┬ `UncomparableDurations` exception management └┬ `UncomparableDurations` exception management
└─ `<` operator └─ `<` operator
#return code 255# #return code 123#
``` ```

View File

@ -26,5 +26,5 @@ This consequence has a valid justification:
9 │ definition x under condition true consequence equals 0 9 │ definition x under condition true consequence equals 0
│ ‾ │ ‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -25,5 +25,5 @@ $ catala Interpret -s A
6 │ output y content boolean 6 │ output y content boolean
│ ‾ │ ‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -21,5 +21,5 @@ $ catala Interpret -s A
5 │ output x content integer 5 │ output x content integer
│ ‾ │ ‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -23,5 +23,5 @@ $ catala Interpret -s A
14 │ definition e equals Case1 14 │ definition e equals Case1
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -24,5 +24,5 @@ $ catala Interpret -s A
15 │ -- anything : 31 15 │ -- anything : 31
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Wildcard cannot be used as single match case └─ Wildcard cannot be used as single match case
#return code 255# #return code 123#
``` ```

View File

@ -33,5 +33,5 @@ $ catala Interpret -s A
17 │ -- Case3 : false 17 │ -- Case3 : false
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -16,5 +16,5 @@ $ catala Typecheck
4 │ declaration enumeration Foo: 4 │ declaration enumeration Foo:
│ ‾‾‾ │ ‾‾‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -36,5 +36,5 @@ $ catala Interpret -s A
16 │ -- Case2 of b : b 16 │ -- Case2 of b : b
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -55,7 +55,7 @@ Next reachable case:
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾
└┬ Wildcard must be the last case └┬ Wildcard must be the last case
└─ Wildcard can't be the first case └─ Wildcard can't be the first case
#return code 255# #return code 123#
``` ```
```catala-test-inline ```catala-test-inline
@ -77,5 +77,5 @@ Next reachable case:
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾
└┬ Wildcard must be the last case └┬ Wildcard must be the last case
└─ Wildcard can't be the first case └─ Wildcard can't be the first case
#return code 255# #return code 123#
``` ```

View File

@ -54,5 +54,5 @@ Type F coming from expression:
28 │ definition y equals x with pattern Case3 28 │ definition y equals x with pattern Case3
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -44,5 +44,5 @@ Type F coming from expression:
18 │ definition y equals x with pattern Case3 18 │ definition y equals x with pattern Case3
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -43,5 +43,5 @@ Type F coming from expression:
17 │ definition y equals x with pattern Case3 17 │ definition y equals x with pattern Case3
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -24,5 +24,5 @@ $ catala Interpret -s A
15 │ definition y equals x with pattern Case3 15 │ definition y equals x with pattern Case3
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -30,5 +30,5 @@ $ catala Interpret -s A
21 │ -- Case4 : true 21 │ -- Case4 : true
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -39,5 +39,5 @@ Candidate definition
8 │ definition x equals 0 8 │ definition x equals 0
│ ‾ │ ‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -22,5 +22,5 @@ $ catala Interpret -s A
12 │ exception base_y 12 │ exception base_y
│ ‾‾‾‾‾‾ │ ‾‾‾‾‾‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -51,5 +51,5 @@ $ catala Interpret -s A
18 │ definition x equals 2 18 │ definition x equals 2
│ ‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾
#return code 255# #return code 123#
``` ```

View File

@ -20,5 +20,5 @@ $ catala Interpret -s A
9 │ definition x equals 1 9 │ definition x equals 1
│ ‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -45,5 +45,5 @@ Candidate definition
14 │ definition y equals 2 14 │ definition y equals 2
│ ‾ │ ‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -19,5 +19,5 @@ $ catala Interpret -s A
9 │ exception base_y 9 │ exception base_y
│ ‾‾‾‾‾‾ │ ‾‾‾‾‾‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -32,5 +32,5 @@ This consequence has a valid justification:
15 │ definition x equals 2 15 │ definition x equals 2
│ ‾ │ ‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -49,12 +49,12 @@ scope Benefit:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s Benefit $ catala Interpret -s Benefit
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] benefit = $2000.00 [RESULT] benefit = ¤2000.00
[RESULT] person = { Person age = 26; disabled = true; } [RESULT] person = { Person age = 26; disabled = true; }
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s Benefit --avoid_exceptions --optimize $ catala Interpret_Lcalc -s Benefit --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] benefit = ESome $2000.00 [RESULT] benefit = ESome ¤2000.00
[RESULT] person = ESome { Person age = ESome 26; disabled = ESome true; } [RESULT] person = ESome { Person age = ESome 26; disabled = ESome true; }
``` ```

View File

@ -44,5 +44,5 @@ This consequence has a valid justification:
15 │ definition f of x under condition not b consequence equals x * x 15 │ definition f of x under condition not b consequence equals x * x
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -29,5 +29,5 @@ Defined here:
10 │ definition f1 of y under condition not cond 10 │ definition f1 of y under condition not cond
│ ‾ │ ‾
#return code 255# #return code 123#
``` ```

View File

@ -28,5 +28,5 @@ Defined here:
9 │ exception definition f1 of y under condition not cond 9 │ exception definition f1 of y under condition not cond
│ ‾ │ ‾
#return code 255# #return code 123#
``` ```

View File

@ -28,5 +28,5 @@ Defined here:
9 │ exception definition f1 of y under condition not cond 9 │ exception definition f1 of y under condition not cond
│ ‾ │ ‾
#return code 255# #return code 123#
``` ```

View File

@ -17,5 +17,5 @@ $ catala Interpret -s RecursiveFunc
8 │ definition f of x equals f of x + 1 8 │ definition f of x equals f of x + 1
│ ‾ │ ‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -46,7 +46,8 @@ let scope S
return { S y = y; } 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 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 to reduce or other special operators relies on pattern matching the special
operator and its EAbs argument. However without exceptions on, because the 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. with optimizations on passes.
```catala-test-inline ```catala-test-inline
$ catala Lcalc -s S --avoid_exceptions --closure_conversion $ catala Lcalc -s S --closure_conversion
[ERROR] Option --optimize must be enabled for --closure_conversion let scope S
#return code 255# (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; }
``` ```

View File

@ -39,7 +39,7 @@ Incriminated subscope variable definition:
15 │ definition a.f of x under condition b and x > 0 consequence equals x - 1 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 ```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 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 ```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 15 │ definition a.f of x under condition b and x > 0 consequence equals x - 1
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾
#return code 255# #return code 123#
``` ```

View File

@ -31,5 +31,5 @@ Incriminated variable:
6 │ input x content integer 6 │ input x content integer
│ ‾ │ ‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -38,5 +38,5 @@ Incriminated subscope variable definition:
14 │ definition a.a equals 0 14 │ definition a.a equals 0
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾
#return code 255# #return code 123#
``` ```

View File

@ -24,5 +24,5 @@ Incriminated variable definition:
8 │ definition a equals 0 8 │ definition a equals 0
│ ‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾
#return code 255# #return code 123#
``` ```

View File

@ -44,5 +44,5 @@ Incriminated subscope declaration:
8 │ a scope A 8 │ a scope A
│ ‾ │ ‾
└─ Test └─ Test
#return code 255# #return code 123#
``` ```

View File

@ -43,6 +43,6 @@ let scope A
``` ```
```catala-test-inline ```catala-test-inline
$ catala Typecheck -s A $ catala Typecheck
[RESULT] Typechecking successful! [RESULT] Typechecking successful!
``` ```

View File

@ -32,6 +32,6 @@ let scope B (B_in: B_in): B =
``` ```
```catala-test-inline ```catala-test-inline
$ catala Typecheck -s B $ catala Typecheck
[RESULT] Typechecking successful! [RESULT] Typechecking successful!
``` ```

View File

@ -35,5 +35,5 @@ Type money coming from expression:
6 │ context y content money 6 │ context y content money
│ ‾‾‾‾‾ │ ‾‾‾‾‾
└─ Article └─ Article
#return code 255# #return code 123#
``` ```

View File

@ -14,12 +14,12 @@ scope A:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s A $ catala Interpret -s A
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] x = $0.30 [RESULT] x = ¤0.30
[RESULT] y = $0.30 [RESULT] y = ¤0.30
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] x = ESome $0.30 [RESULT] x = ESome ¤0.30
[RESULT] y = ESome $0.30 [RESULT] y = ESome ¤0.30
``` ```

View File

@ -15,14 +15,14 @@ scope A:
```catala-test-inline ```catala-test-inline
$ catala Interpret -s A $ catala Interpret -s A
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] x = $123.54 [RESULT] x = ¤123.54
[RESULT] y = $8548650.96 [RESULT] y = ¤8548650.96
[RESULT] z = $7.23 [RESULT] z = ¤7.23
``` ```
```catala-test-inline ```catala-test-inline
$ catala Interpret_Lcalc -s A --avoid_exceptions --optimize $ catala Interpret_Lcalc -s A --avoid_exceptions --optimize
[RESULT] Computation successful! Results: [RESULT] Computation successful! Results:
[RESULT] x = ESome $123.54 [RESULT] x = ESome ¤123.54
[RESULT] y = ESome $8548650.96 [RESULT] y = ESome ¤8548650.96
[RESULT] z = ESome $7.23 [RESULT] z = ESome ¤7.23
``` ```

View File

@ -20,5 +20,5 @@ $ catala typecheck
11 │ equals (output of S1).a 11 │ equals (output of S1).a
│ ‾‾‾‾‾‾‾‾‾‾‾‾ │ ‾‾‾‾‾‾‾‾‾‾‾‾
└─ Scope calls are not allowed outside of scopes └─ Scope calls are not allowed outside of scopes
#return code 255# #return code 123#
``` ```

View File

@ -114,7 +114,7 @@ let S2_6 (S2_in_11: S2_in) =
try: try:
decl temp_a_16 : any; decl temp_a_16 : any;
let temp_a_16 (__17 : unit) = let temp_a_16 (__17 : unit) =
return glob3_3 $44.00 + 100.; return glob3_3 ¤44.00 + 100.;
decl temp_a_14 : any; decl temp_a_14 : any;
let temp_a_14 (__15 : unit) = let temp_a_14 (__15 : unit) =
return true; return true;
@ -131,7 +131,7 @@ let S3_7 (S3_in_18: S3_in) =
try: try:
decl temp_a_23 : any; decl temp_a_23 : any;
let temp_a_23 (__24 : unit) = 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; decl temp_a_21 : any;
let temp_a_21 (__22 : unit) = let temp_a_21 (__22 : unit) =
return true; return true;

View File

@ -30,5 +30,5 @@ Incriminated variable definition:
9 │ definition x equals |2022-01-16| 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