diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index 6a30d52d..0daa9870 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -87,7 +87,7 @@ module Cli = struct catala_opts:string list -> build_dir:File.t option -> include_dirs:string list -> - color:Cli.when_enum -> + color:Global.when_enum -> debug:bool -> ninja_output:File.t option -> 'a) -> @@ -103,7 +103,7 @@ module Cli = struct let color = Arg.( value - & opt ~vopt:Cli.Always Cli.when_opt Auto + & opt ~vopt:Global.Always Cli.when_opt Auto & info ["color"] ~env:(Cmd.Env.info "CATALA_COLOR") ~doc: @@ -895,7 +895,7 @@ let ninja_init ~debug ~ninja_output : extra:def Seq.t -> test_flags:string list -> (File.t -> 'a) -> 'a = - let _options = Catala_utils.Cli.enforce_globals ~debug ~color () in + let _options = Catala_utils.Global.enforce_options ~debug ~color () in let chdir = match chdir with None -> Lazy.force Poll.project_root | some -> some in @@ -933,7 +933,7 @@ let ninja_cmdline ninja_flags nin_file targets = :: "-f" :: nin_file :: (if ninja_flags = "" then [] else [ninja_flags]) - @ (if Catala_utils.Cli.globals.debug then ["-v"] else []) + @ (if Catala_utils.Global.options.debug then ["-v"] else []) @ targets) open Cmdliner @@ -1074,7 +1074,7 @@ let main () = | Message.CompilerError content -> let bt = Printexc.get_raw_backtrace () in Message.Content.emit content Error; - if Catala_utils.Cli.globals.debug then + if Catala_utils.Global.options.debug then Printexc.print_raw_backtrace stderr bt; exit Cmd.Exit.some_error | Sys_error msg -> diff --git a/build_system/clerk_scan.ml b/build_system/clerk_scan.ml index 7afc4fb0..217b51f6 100644 --- a/build_system/clerk_scan.ml +++ b/build_system/clerk_scan.ml @@ -54,7 +54,8 @@ let test_command_args = fun str -> exec_opt re str |> Option.map (fun g -> String.trim (Re.Group.get g 1)) -let catala_file (file : File.t) (lang : Catala_utils.Cli.backend_lang) : item = +let catala_file (file : File.t) (lang : Catala_utils.Global.backend_lang) : item + = let module L = Surface.Lexer_common in let rec parse lines n acc = match Seq.uncons lines with diff --git a/build_system/clerk_scan.mli b/build_system/clerk_scan.mli index 4f541d80..8263295e 100644 --- a/build_system/clerk_scan.mli +++ b/build_system/clerk_scan.mli @@ -46,10 +46,10 @@ type item = { (** Contains all the data extracted from a single Catala file. Lists are in reverse file order. *) -val get_lang : File.t -> Cli.backend_lang option +val get_lang : File.t -> Global.backend_lang option (** Guesses Catala dialect from file-name and global options *) -val catala_file : File.t -> Catala_utils.Cli.backend_lang -> item +val catala_file : File.t -> Global.backend_lang -> item (** Scans a single Catala file into an item *) val tree : File.t -> (File.t * File.t list * item list) Seq.t diff --git a/compiler/catala_utils/cli.ml b/compiler/catala_utils/cli.ml index 70e1ce6c..604f5af1 100644 --- a/compiler/catala_utils/cli.ml +++ b/compiler/catala_utils/cli.ml @@ -15,16 +15,11 @@ License for the specific language governing permissions and limitations under the License. *) -(* Types used by flags & options *) +open Global -type file = string -type raw_file = file -type backend_lang = En | Fr | Pl -type when_enum = Auto | Always | Never -type message_format_enum = Human | GNU -type input_src = FileName of file | Contents of string * file | Stdin of file +(* Manipulation of types used by flags & options *) -(** Associates a {!type: Cli.backend_lang} with its string represtation. *) +(** Associates a {!type: Global.backend_lang} with its string represtation. *) let languages = ["en", En; "fr", Fr; "pl", Pl] let language_code = @@ -34,68 +29,17 @@ let language_code = let input_src_file = function FileName f | Contents (_, f) | Stdin f -> f let message_format_opt = ["human", Human; "gnu", GNU] -type options = { - mutable input_src : input_src; - mutable language : backend_lang option; - mutable debug : bool; - mutable color : when_enum; - mutable message_format : message_format_enum; - mutable trace : bool; - mutable plugins_dirs : file list; - mutable disable_warnings : bool; - mutable max_prec_digits : int; - mutable path_rewrite : raw_file -> file; -} - -(* Note: we force that the global options (ie options common to all commands) - and the options available through global refs are the same. While this is a - bit arbitrary, it makes some sense code-wise and provides some safeguard - against explosion of the number of global references. Reducing the number of - globals further would be nice though. *) -let globals = - { - input_src = Stdin "-stdin-"; - language = None; - debug = false; - color = Auto; - message_format = Human; - trace = false; - plugins_dirs = []; - disable_warnings = false; - max_prec_digits = 20; - path_rewrite = (fun _ -> assert false); - } - -let enforce_globals - ?input_src - ?language - ?debug - ?color - ?message_format - ?trace - ?plugins_dirs - ?disable_warnings - ?max_prec_digits - ?path_rewrite - () = - Option.iter (fun x -> globals.input_src <- x) input_src; - Option.iter (fun x -> globals.language <- x) language; - Option.iter (fun x -> globals.debug <- x) debug; - Option.iter (fun x -> globals.color <- x) color; - Option.iter (fun x -> globals.message_format <- x) message_format; - Option.iter (fun x -> globals.trace <- x) trace; - Option.iter (fun x -> globals.plugins_dirs <- x) plugins_dirs; - Option.iter (fun x -> globals.disable_warnings <- x) disable_warnings; - Option.iter (fun x -> globals.max_prec_digits <- x) max_prec_digits; - Option.iter (fun x -> globals.path_rewrite <- x) path_rewrite; - globals - open Cmdliner (* Arg converters for our custom types *) let when_opt = Arg.enum ["auto", Auto; "always", Always; "never", Never] +let raw_file = + Arg.conv ~docv:"FILE" + ( (fun f -> Result.map raw_file (Arg.conv_parser Arg.string f)), + (fun ppf f -> Format.pp_print_string ppf (f :> string)) ) + (* Some helpers for catala sources *) let extensions = [".catala_fr", Fr; ".catala_en", En; ".catala_pl", Pl] @@ -105,7 +49,7 @@ let file_lang filename = |> function | Some lang -> lang | None -> ( - match globals.language with + match Global.options.language with | Some lang -> lang | None -> Format.kasprintf failwith @@ -123,7 +67,7 @@ let exec_dir = Filename.dirname Sys.executable_name let reverse_path ?(from_dir = Sys.getcwd ()) ~to_dir f = - if Filename.is_relative from_dir then invalid_arg "File.with_reverse_path" + if Filename.is_relative from_dir then invalid_arg "Cli.reverse_path" else if not (Filename.is_relative f) then f else if not (Filename.is_relative to_dir) then Filename.concat from_dir f else @@ -160,11 +104,11 @@ module Flags = struct let converter = conv ~docv:"FILE" ( (fun s -> - if s = "-" then Ok (Stdin "-stdin-") - else Result.map (fun f -> FileName f) (conv_parser non_dir_file s)), + if s = "-" then Ok (Stdin (Global.raw_file "-stdin-")) + else Result.map (fun f -> FileName (Global.raw_file f)) (conv_parser non_dir_file s)), fun ppf -> function | Stdin _ -> Format.pp_print_string ppf "-" - | FileName f -> conv_printer non_dir_file ppf f + | FileName f -> conv_printer non_dir_file ppf (f :> file) | _ -> assert false ) in required @@ -291,13 +235,16 @@ module Flags = struct if debug then Printexc.record_backtrace true; let path_rewrite = match directory with - | None -> fun f -> f + | None -> fun (f: Global.raw_file) -> (f :> file) | Some to_dir -> ( - function "-" -> "-" | f -> reverse_path ~to_dir f) + fun (f: Global.raw_file) -> + match (f :> file) with + | "-" -> "-" + | f -> reverse_path ~to_dir f) in (* This sets some global refs for convenience, but most importantly returns the options record. *) - enforce_globals ~language ~debug ~color ~message_format ~trace + Global.enforce_options ~language ~debug ~color ~message_format ~trace ~plugins_dirs ~disable_warnings ~max_prec_digits ~path_rewrite () in Term.( @@ -316,25 +263,16 @@ module Flags = struct let make input_src name directory options : options = (* Set some global refs for convenience *) let input_src = - match name with - | None -> input_src - | Some name -> ( - match input_src with - | FileName f -> FileName f - | Contents (str, _) -> Contents (str, name) - | Stdin _ -> Stdin name) - in - let input_src = + let rename f = + match name with None -> f | Some n -> Global.raw_file n + in match input_src with | FileName f -> FileName (options.path_rewrite f) - | Contents (str, f) -> Contents (str, options.path_rewrite f) - | Stdin f -> Stdin (options.path_rewrite f) + | Contents (str, f) -> Contents (str, options.path_rewrite (rename f)) + | Stdin f -> Stdin (options.path_rewrite (rename f)) in - let plugins_dirs = List.map options.path_rewrite options.plugins_dirs in Option.iter Sys.chdir directory; - globals.input_src <- input_src; - globals.plugins_dirs <- plugins_dirs; - { options with input_src; plugins_dirs } + Global.enforce_options ~input_src () in Term.(const make $ input_src $ name_flag $ directory $ flags) end @@ -343,7 +281,7 @@ module Flags = struct let arg = Arg.( value - & opt_all (list ~sep:':' string) [] + & opt_all (list ~sep:':' raw_file) [] & info ["I"; "include"] ~docv:"DIR" ~env:(Cmd.Env.info "CATALA_INCLUDE") ~doc: @@ -394,7 +332,7 @@ module Flags = struct let output = value - & opt (some string) None + & opt (some raw_file) None & info ["output"; "o"] ~docv:"OUTPUT" ~env:(Cmd.Env.info "CATALA_OUT") ~doc: diff --git a/compiler/catala_utils/cli.mli b/compiler/catala_utils/cli.mli index 551a3a27..96d2cf96 100644 --- a/compiler/catala_utils/cli.mli +++ b/compiler/catala_utils/cli.mli @@ -15,33 +15,7 @@ License for the specific language governing permissions and limitations under the License. *) -type file = string -(** File names ; equal to [File.t] but let's avoid cyclic dependencies *) - -type raw_file -(** A file name that has not yet been resolved, [options.path_rewrite] must be - called on it *) - -type backend_lang = En | Fr | Pl - -(** The usual auto/always/never option argument *) -type when_enum = Auto | Always | Never - -val when_opt : when_enum Cmdliner.Arg.conv - -type message_format_enum = - | Human - | GNU (** Format of error and warning messages output by the compiler. *) - -(** Sources for program input *) -type input_src = - | FileName of file (** A file path to read from disk *) - | Contents of string * file - (** A raw string containing the code, and the corresponding (fake) - filename *) - | Stdin of file - (** Read from stdin; the specified filename will be used for file lookups, - error reportings, etc. *) +open Global val languages : (string * backend_lang) list @@ -49,10 +23,10 @@ val language_code : backend_lang -> string (** Returns the lowercase two-letter language code *) val file_lang : file -> backend_lang -(** Associates a file extension with its corresponding {!type: Cli.backend_lang} +(** Associates a file extension with its corresponding {!type: Global.backend_lang} string representation. *) -val input_src_file : input_src -> file +val input_src_file : file input_src -> file val reverse_path : ?from_dir:file -> to_dir:file -> file -> file (** If [to_dir] is a path to a given directory and [f] a path to a file as seen @@ -60,48 +34,10 @@ val reverse_path : ?from_dir:file -> to_dir:file -> file -> file leading to [f] from [to_dir]. The results attempts to be relative to [to_dir]. *) -(** {2 Configuration globals} *) - -type options = private { - mutable input_src : input_src; - 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; - mutable path_rewrite : raw_file -> file; -} -(** 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_src:input_src -> - ?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 -> - ?path_rewrite:(file -> file) -> - 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} *) +val when_opt: when_enum Cmdliner.Arg.conv + module Flags : sig open Cmdliner diff --git a/compiler/catala_utils/file.ml b/compiler/catala_utils/file.ml index 619aa5ab..f44dfcb1 100644 --- a/compiler/catala_utils/file.ml +++ b/compiler/catala_utils/file.ml @@ -16,6 +16,8 @@ type t = string +let format ppf t = Format.fprintf ppf "\"@{%s@}\"" t + (** Run finaliser [f] unconditionally after running [k ()], propagating any raised exception. *) let finally f k = @@ -30,7 +32,7 @@ let finally f k = let temp_file pfx sfx = let f = Filename.temp_file pfx sfx in - if not Cli.globals.debug then + if not Global.options.debug then at_exit (fun () -> try Sys.remove f with _ -> ()); f @@ -190,8 +192,6 @@ let equal a b = let compare a b = String.compare (String.lowercase_ascii a) (String.lowercase_ascii b) -let format ppf t = Format.fprintf ppf "\"@{%s@}\"" t - module Set = Set.Make (struct type nonrec t = t diff --git a/compiler/catala_utils/file.mli b/compiler/catala_utils/file.mli index dd1c28f1..d08b9103 100644 --- a/compiler/catala_utils/file.mli +++ b/compiler/catala_utils/file.mli @@ -44,7 +44,7 @@ val with_formatter_of_opt_file : t option -> (Format.formatter -> 'a) -> 'a {!with_formatter_of_file}), otherwise, uses the [Format.std_formatter]. *) val get_out_channel : - source_file:Cli.input_src -> + source_file:t Global.input_src -> output_file:t option -> ?ext:string -> unit -> @@ -54,7 +54,7 @@ val get_out_channel : equal to [Some "-"] returns a wrapper around [stdout]. *) val get_formatter_of_out_channel : - source_file:Cli.input_src -> + source_file:t Global.input_src -> output_file:t option -> ?ext:string -> unit -> diff --git a/compiler/catala_utils/global.ml b/compiler/catala_utils/global.ml new file mode 100644 index 00000000..b4cee277 --- /dev/null +++ b/compiler/catala_utils/global.ml @@ -0,0 +1,84 @@ +(* This file is part of the Catala compiler, a specification language for tax + and social benefits computation rules. Copyright (C) 2024 Inria, + contributors: Louis Gesbert + + 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. *) + +type file = string +type raw_file = file +type backend_lang = En | Fr | Pl +type when_enum = Auto | Always | Never +type message_format_enum = Human | GNU +type 'file input_src = + | FileName of 'file + | Contents of string * 'file + | Stdin of 'file +(* ['file] is expected to be [file] or [raw_file] *) + +type options = { + mutable input_src : file input_src; + mutable language : backend_lang option; + mutable debug : bool; + mutable color : when_enum; + mutable message_format : message_format_enum; + mutable trace : bool; + mutable plugins_dirs : file list; + mutable disable_warnings : bool; + mutable max_prec_digits : int; + mutable path_rewrite : raw_file -> file; +} + +(* Note: we force that the global options (ie options common to all commands) + and the options available through global refs are the same. While this is a + bit arbitrary, it makes some sense code-wise and provides some safeguard + against explosion of the number of global references. Reducing the number of + globals further would be nice though. *) +let options = + { + input_src = Stdin "-stdin-"; + language = None; + debug = false; + color = Auto; + message_format = Human; + trace = false; + plugins_dirs = []; + disable_warnings = false; + max_prec_digits = 20; + path_rewrite = (fun _ -> assert false); + } + +let enforce_options + ?input_src + ?language + ?debug + ?color + ?message_format + ?trace + ?plugins_dirs + ?disable_warnings + ?max_prec_digits + ?path_rewrite + () = + Option.iter (fun x -> options.input_src <- x) input_src; + Option.iter (fun x -> options.language <- x) language; + Option.iter (fun x -> options.debug <- x) debug; + Option.iter (fun x -> options.color <- x) color; + Option.iter (fun x -> options.message_format <- x) message_format; + Option.iter (fun x -> options.trace <- x) trace; + Option.iter (fun x -> options.plugins_dirs <- x) plugins_dirs; + Option.iter (fun x -> options.disable_warnings <- x) disable_warnings; + Option.iter (fun x -> options.max_prec_digits <- x) max_prec_digits; + Option.iter (fun x -> options.path_rewrite <- x) path_rewrite; + options + +let raw_file f = f diff --git a/compiler/catala_utils/global.mli b/compiler/catala_utils/global.mli new file mode 100644 index 00000000..e8349067 --- /dev/null +++ b/compiler/catala_utils/global.mli @@ -0,0 +1,85 @@ +(* This file is part of the Catala compiler, a specification language for tax + and social benefits computation rules. Copyright (C) 2024 Inria, + contributors: Louis Gesbert + + 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 module contains definitions of global flags and types used throughout. They should be defined from the command-line and never modified afterwards. *) + +type file = string +(** File names ; equal to [File.t] but let's avoid cyclic dependencies *) + +type raw_file = private file +(** A file name that has not yet been resolved, [options.path_rewrite] must be + called on it *) + +type backend_lang = En | Fr | Pl + +(** The usual auto/always/never option argument *) +type when_enum = Auto | Always | Never + +type message_format_enum = + | Human + | GNU (** Format of error and warning messages output by the compiler. *) + +(** Sources for program input *) +type 'file input_src = + | FileName of 'file (** A file path to read from disk *) + | Contents of string * 'file + (** A raw string containing the code, and the corresponding (fake) + filename *) + | Stdin of 'file + (** Read from stdin; the specified filename will be used for file lookups, + error reportings, etc. *) + +(** {2 Configuration globals} *) + +type options = private { + mutable input_src : file input_src; + mutable language : backend_lang option; + mutable debug : bool; + mutable color : when_enum; + mutable message_format : message_format_enum; + mutable trace : bool; + mutable plugins_dirs : file list; + mutable disable_warnings : bool; + mutable max_prec_digits : int; + mutable path_rewrite : raw_file -> file; +} +(** Global options, common to all subcommands (note: the fields are internally + mutable only for purposes of the [globals] toplevel value defined below) *) + +val options : 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_options : + ?input_src:file input_src -> + ?language:backend_lang option -> + ?debug:bool -> + ?color:when_enum -> + ?message_format:message_format_enum -> + ?trace:bool -> + ?plugins_dirs:file list -> + ?disable_warnings:bool -> + ?max_prec_digits:int -> + ?path_rewrite:(raw_file -> file) -> + unit -> + options +(** Sets up the global options (side-effect); for specific use-cases only, this + should never be called from the compiler outside of the [Cli] module. Other proper uses include setting up the compiler library + when using it directly through a specific front-end. *) + +val raw_file : string -> raw_file +(** Create a [raw_file], for use directly after parsing from the cmdline *) diff --git a/compiler/catala_utils/message.ml b/compiler/catala_utils/message.ml index e4e1ebda..c5a64fdf 100644 --- a/compiler/catala_utils/message.ml +++ b/compiler/catala_utils/message.ml @@ -39,8 +39,8 @@ let () = ignore (unstyle_formatter Format.str_formatter) below std_ppf / err_ppf *) let has_color oc = - match Cli.globals.color with - | Cli.Never -> false + match Global.options.color with + | Global.Never -> false | Always -> true | Auto -> Unix.(isatty (descr_of_out_channel oc)) @@ -78,8 +78,8 @@ type content_type = Error | Warning | Debug | Log | Result let get_ppf = function | Result -> Lazy.force std_ppf - | Debug when not Cli.globals.debug -> Lazy.force ignore_ppf - | Warning when Cli.globals.disable_warnings -> Lazy.force ignore_ppf + | Debug when not Global.options.debug -> Lazy.force ignore_ppf + | Warning when Global.options.disable_warnings -> Lazy.force ignore_ppf | Error | Log | Debug | Warning -> Lazy.force err_ppf (**{3 Markers}*) @@ -150,8 +150,8 @@ module Content = struct [MainMessage (fun ppf -> Format.pp_print_string ppf s)] let emit (content : t) (target : content_type) : unit = - match Cli.globals.message_format with - | Cli.Human -> + match Global.options.message_format with + | Global.Human -> let ppf = get_ppf target in Format.fprintf ppf "@[%t%t%a@]@." (pp_marker target) (fun (ppf : Format.formatter) -> @@ -174,7 +174,7 @@ module Content = struct Suggestions.format ppf suggestions_list) ppf message_elements) content - | Cli.GNU -> + | Global.GNU -> (* The top message doesn't come with a position, which is not something the GNU standard allows. So we look the position list and put the top message everywhere there is not a more precise message. If we can't diff --git a/compiler/catala_utils/pos.ml b/compiler/catala_utils/pos.ml index 4f5df1fe..c283f206 100644 --- a/compiler/catala_utils/pos.ml +++ b/compiler/catala_utils/pos.ml @@ -130,7 +130,7 @@ let format_loc_text ppf (pos : t) = let eline = get_end_line pos in let ic, input_line_opt = let from_contents = - match Cli.globals.input_src with + match Global.options.input_src with | Contents (str, _) when str = filename -> Some str | _ -> None in diff --git a/compiler/catala_web_interpreter.ml b/compiler/catala_web_interpreter.ml index 3816b248..6c2289e1 100644 --- a/compiler/catala_web_interpreter.ml +++ b/compiler/catala_web_interpreter.ml @@ -19,7 +19,7 @@ let () = Message.raise_error "Unrecognised input locale %S" language in let options = - Cli.enforce_globals + Global.enforce_options ~input_src:(Contents (contents, "-inline-")) ~language:(Some language) ~debug:false ~color:Never ~trace () in diff --git a/compiler/dcalc/from_scopelang.ml b/compiler/dcalc/from_scopelang.ml index 54e1392c..50119ca7 100644 --- a/compiler/dcalc/from_scopelang.ml +++ b/compiler/dcalc/from_scopelang.ml @@ -140,7 +140,7 @@ let tag_with_log_entry (markings : Uid.MarkedString.info list) : 'm Ast.expr boxed = let m = mark_tany (Mark.get e) (Expr.pos e) in - if Cli.globals.trace then + if Global.options.trace then Expr.eappop ~op:(Log (l, markings)) ~tys:[TAny, Expr.pos e] ~args:[e] m else e diff --git a/compiler/desugared/ast.ml b/compiler/desugared/ast.ml index 81202338..8005948a 100644 --- a/compiler/desugared/ast.ml +++ b/compiler/desugared/ast.ml @@ -238,7 +238,7 @@ type program = { program_ctx : decl_ctx; program_modules : modul ModuleName.Map.t; program_root : modul; - program_lang : Cli.backend_lang; + program_lang : Global.backend_lang; } let rec locations_used e : LocationSet.t = diff --git a/compiler/desugared/ast.mli b/compiler/desugared/ast.mli index ddfe13c5..48849052 100644 --- a/compiler/desugared/ast.mli +++ b/compiler/desugared/ast.mli @@ -126,7 +126,7 @@ type program = { program_modules : modul ModuleName.Map.t; (** Contains all submodules of the program, in a flattened structure *) program_root : modul; - program_lang : Cli.backend_lang; + program_lang : Global.backend_lang; } (** {1 Helpers} *) diff --git a/compiler/driver.ml b/compiler/driver.ml index 6e2d7c5e..97546298 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -18,7 +18,7 @@ open Catala_utils open Shared_ast -(** Associates a file extension with its corresponding {!type: Cli.backend_lang} +(** Associates a file extension with its corresponding {!type: Global.backend_lang} string representation. *) let extensions = [".catala_fr", "fr"; ".catala_en", "en"; ".catala_pl", "pl"] @@ -37,7 +37,7 @@ let load_module_interfaces if program.Surface.Ast.program_used_modules <> [] then Message.emit_debug "Loading module interfaces..."; let includes = - List.map options.Cli.path_rewrite includes @ more_includes + List.map options.Global.path_rewrite includes @ more_includes |> List.map File.Tree.build |> List.fold_left File.Tree.union File.Tree.empty in @@ -90,7 +90,7 @@ let load_module_interfaces in let intf = Surface.Parser_driver.load_interface ?default_module_name - (Cli.FileName f) + (Global.FileName f) in let modname = ModuleName.fresh intf.intf_modname in let seen = File.Map.add f None seen in @@ -137,7 +137,7 @@ module Passes = struct let surface options : Surface.Ast.program = debug_pass_name "surface"; let prg = - Surface.Parser_driver.parse_top_level_file options.Cli.input_src + Surface.Parser_driver.parse_top_level_file options.Global.input_src in Surface.Fill_positions.fill_pos_with_legislative_info prg @@ -169,8 +169,8 @@ module Passes = struct let dcalc : type ty. - Cli.options -> - includes:Cli.raw_file list -> + Global.options -> + includes:Global.raw_file list -> optimize:bool -> check_invariants:bool -> typed:ty mark -> @@ -402,18 +402,18 @@ module Commands = struct second_part ) let get_output ?ext options output_file = - let output_file = Option.map options.Cli.path_rewrite output_file in - File.get_out_channel ~source_file:options.Cli.input_src ~output_file ?ext () + let output_file = Option.map options.Global.path_rewrite output_file in + File.get_out_channel ~source_file:options.Global.input_src ~output_file ?ext () let get_output_format ?ext options output_file = - let output_file = Option.map options.Cli.path_rewrite output_file in - File.get_formatter_of_out_channel ~source_file:options.Cli.input_src + let output_file = Option.map options.Global.path_rewrite output_file in + File.get_formatter_of_out_channel ~source_file:options.Global.input_src ~output_file ?ext () let makefile options output = let prg = Passes.surface options in let backend_extensions_list = [".tex"] in - let source_file = Cli.input_src_file options.Cli.input_src in + let source_file = Cli.input_src_file options.Global.input_src in let output_file, with_output = get_output options ~ext:".d" output in Message.emit_debug "Writing list of dependencies to %s..." (Option.value ~default:"stdout" output_file); @@ -444,7 +444,7 @@ module Commands = struct in with_output @@ fun fmt -> - let language = Cli.file_lang (Cli.input_src_file options.Cli.input_src) in + let language = Cli.file_lang (Cli.input_src_file options.Global.input_src) in let weave_output = Literate.Html.ast_to_html language ~print_only_law in Message.emit_debug "Writing to %s" (Option.value ~default:"stdout" output_file); @@ -480,7 +480,7 @@ module Commands = struct in with_output @@ fun fmt -> - let language = Cli.file_lang (Cli.input_src_file options.Cli.input_src) in + let language = Cli.file_lang (Cli.input_src_file options.Global.input_src) in let weave_output = Literate.Latex.ast_to_latex language ~print_only_law in Message.emit_debug "Writing to %s" (Option.value ~default:"stdout" output_file); @@ -549,11 +549,11 @@ module Commands = struct match ex_scope_opt with | Some scope -> let scope_uid = get_scope_uid prg.program_ctx scope in - Scopelang.Print.scope ~debug:options.Cli.debug prg.program_ctx fmt + Scopelang.Print.scope ~debug:options.Global.debug prg.program_ctx fmt (scope_uid, ScopeName.Map.find scope_uid prg.program_scopes); Format.pp_print_newline fmt () | None -> - Scopelang.Print.program ~debug:options.Cli.debug fmt prg; + Scopelang.Print.program ~debug:options.Global.debug fmt prg; Format.pp_print_newline fmt () let scopelang_cmd = @@ -615,7 +615,7 @@ module Commands = struct match ex_scope_opt with | Some scope -> let scope_uid = get_scope_uid prg.decl_ctx scope in - Print.scope ~debug:options.Cli.debug prg.decl_ctx fmt + Print.scope ~debug:options.Global.debug prg.decl_ctx fmt ( scope_uid, BoundList.find ~f:(function @@ -629,7 +629,7 @@ module Commands = struct (* TODO: ??? *) let prg_dcalc_expr = Expr.unbox (Program.to_expr prg scope_uid) in Format.fprintf fmt "%a\n" - (Print.expr ~debug:options.Cli.debug ()) + (Print.expr ~debug:options.Global.debug ()) prg_dcalc_expr let dcalc_cmd = @@ -694,11 +694,11 @@ module Commands = struct in Message.emit_result "Computation successful!%s" (if List.length results > 0 then " Results:" else ""); - let language = Cli.file_lang (Cli.input_src_file options.Cli.input_src) in + let language = Cli.file_lang (Cli.input_src_file options.Global.input_src) in List.iter (fun ((var, _), result) -> Message.emit_result "@[%s@ =@ %a@]" var - (if options.Cli.debug then Print.expr ~debug:false () + (if options.Global.debug then Print.expr ~debug:false () else Print.UserFacing.value language) result) results @@ -733,11 +733,11 @@ module Commands = struct match ex_scope_opt with | Some scope -> let scope_uid = get_scope_uid prg.decl_ctx scope in - Print.scope ~debug:options.Cli.debug prg.decl_ctx fmt + Print.scope ~debug:options.Global.debug prg.decl_ctx fmt (scope_uid, Program.get_scope_body prg scope_uid); Format.pp_print_newline fmt () | None -> - Print.program ~debug:options.Cli.debug fmt prg; + Print.program ~debug:options.Global.debug fmt prg; Format.pp_print_newline fmt () let lcalc_cmd = @@ -880,7 +880,7 @@ module Commands = struct match ex_scope_opt with | Some scope -> let scope_uid = get_scope_uid prg.ctx.decl_ctx scope in - Scalc.Print.format_item ~debug:options.Cli.debug prg.ctx.decl_ctx fmt + Scalc.Print.format_item ~debug:options.Global.debug prg.ctx.decl_ctx fmt (List.find (function | Scalc.Ast.SScope { scope_body_name; _ } -> @@ -1001,7 +1001,7 @@ module Commands = struct $ Cli.Flags.check_invariants) let depends options includes prefix extension extra_files = - let file = Cli.input_src_file options.Cli.input_src in + let file = Cli.input_src_file options.Global.input_src in let more_includes = List.map Filename.dirname (file :: extra_files) in let prg = Surface.Ast. @@ -1151,7 +1151,7 @@ let main () = Cmdliner.Cmd.eval_peek_opts ~argv Cli.Flags.Global.flags ~version_opt:true with - | Some opts, _ -> opts.Cli.plugins_dirs + | Some opts, _ -> opts.Global.plugins_dirs | None, _ -> [] in Passes.debug_pass_name "init"; @@ -1181,7 +1181,7 @@ let main () = | exception Message.CompilerError content -> let bt = Printexc.get_raw_backtrace () in Message.Content.emit content Error; - if Cli.globals.debug then Printexc.print_raw_backtrace stderr bt; + if Global.options.debug then Printexc.print_raw_backtrace stderr bt; exit Cmd.Exit.some_error | exception Failure msg -> let bt = Printexc.get_raw_backtrace () in diff --git a/compiler/driver.mli b/compiler/driver.mli index f0021890..f6109ba6 100644 --- a/compiler/driver.mli +++ b/compiler/driver.mli @@ -25,29 +25,29 @@ val main : unit -> unit 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 + val surface : Global.options -> Surface.Ast.program val desugared : - Cli.options -> - includes:Cli.raw_file list -> + Global.options -> + includes:Global.raw_file list -> Desugared.Ast.program * Desugared.Name_resolution.context val scopelang : - Cli.options -> - includes:Cli.raw_file list -> + Global.options -> + includes:Global.raw_file list -> Shared_ast.untyped Scopelang.Ast.program val dcalc : - Cli.options -> - includes:Cli.raw_file list -> + Global.options -> + includes:Global.raw_file list -> optimize:bool -> check_invariants:bool -> typed:'m Shared_ast.mark -> 'm Dcalc.Ast.program * Scopelang.Dependency.TVertex.t list val lcalc : - Cli.options -> - includes:Cli.raw_file list -> + Global.options -> + includes:Global.raw_file list -> optimize:bool -> check_invariants:bool -> typed:'m Shared_ast.mark -> @@ -57,8 +57,8 @@ module Passes : sig Shared_ast.typed Lcalc.Ast.program * Scopelang.Dependency.TVertex.t list val scalc : - Cli.options -> - includes:Cli.raw_file list -> + Global.options -> + includes:Global.raw_file list -> optimize:bool -> check_invariants:bool -> avoid_exceptions:bool -> @@ -75,15 +75,15 @@ module Commands : sig val get_output : ?ext:string -> - Cli.options -> - Cli.raw_file option -> + Global.options -> + Global.raw_file option -> string option * ((out_channel -> 'a) -> 'a) (** bounded open of the expected output file *) val get_output_format : ?ext:string -> - Cli.options -> - Cli.raw_file option -> + Global.options -> + Global.raw_file option -> string option * ((Format.formatter -> 'a) -> 'a) val get_scope_uid : Shared_ast.decl_ctx -> string -> Shared_ast.ScopeName.t @@ -110,6 +110,6 @@ module Plugin : sig string -> ?man:Cmdliner.Manpage.block list -> ?doc:string -> - (Cli.options -> unit) Cmdliner.Term.t -> + (Global.options -> unit) Cmdliner.Term.t -> unit end diff --git a/compiler/lcalc/to_ocaml.ml b/compiler/lcalc/to_ocaml.ml index 2754f48d..a6dc8ca6 100644 --- a/compiler/lcalc/to_ocaml.ml +++ b/compiler/lcalc/to_ocaml.ml @@ -392,11 +392,11 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) : args = [arg]; _; } - when Cli.globals.trace -> + when Global.options.trace -> Format.fprintf fmt "(log_begin_call@ %a@ %a)@ %a" format_uid_list info format_with_parens f format_with_parens arg | EAppOp { op = Log (VarDef var_def_info, info); args = [arg1]; _ } - when Cli.globals.trace -> + when Global.options.trace -> Format.fprintf fmt "(log_variable_definition@ %a@ {io_input=%s;@ io_output=%b}@ (%a)@ %a)" format_uid_list info @@ -408,7 +408,7 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) : (var_def_info.log_typ, Pos.no_pos) format_with_parens arg1 | EAppOp { op = Log (PosRecordIfTrueBool, _); args = [arg1]; _ } - when Cli.globals.trace -> + when Global.options.trace -> let pos = Expr.pos e in Format.fprintf fmt "(log_decision_taken@ @[{filename = \"%s\";@ start_line=%d;@ \ @@ -416,7 +416,7 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) : (Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos) (Pos.get_end_line pos) (Pos.get_end_column pos) format_string_list (Pos.get_law_info pos) format_with_parens arg1 - | EAppOp { op = Log (EndCall, info); args = [arg1]; _ } when Cli.globals.trace + | EAppOp { op = Log (EndCall, info); args = [arg1]; _ } when Global.options.trace -> Format.fprintf fmt "(log_end_call@ %a@ %a)" format_uid_list info format_with_parens arg1 @@ -540,7 +540,7 @@ let format_ctx Format.fprintf fmt "@[%a:@ %a@]" format_struct_field_name (None, struct_field) format_typ struct_field_type)) (StructField.Map.bindings struct_fields); - if Cli.globals.trace then + if Global.options.trace then format_struct_embedding fmt (struct_name, struct_fields) in let format_enum_decl fmt (enum_name, enum_cons) = @@ -553,7 +553,7 @@ let format_ctx Format.fprintf fmt "@[| %a@ of@ %a@]" format_enum_cons_name enum_cons format_typ enum_cons_type)) (EnumConstructor.Map.bindings enum_cons); - if Cli.globals.trace then format_enum_embedding fmt (enum_name, enum_cons) + if Global.options.trace then format_enum_embedding fmt (enum_name, enum_cons) in let is_in_type_ordering s = List.exists diff --git a/compiler/literate/html.ml b/compiler/literate/html.ml index 82e3859c..8850e2dd 100644 --- a/compiler/literate/html.ml +++ b/compiler/literate/html.ml @@ -23,7 +23,7 @@ open Literate_common module A = Surface.Ast module P = Printf module R = Re.Pcre -module C = Cli +module C = Global (** {1 Helpers} *) @@ -47,7 +47,7 @@ let remove_cb_last_lines : string -> string = Prints an HTML complete page structure around the [wrapped] content. *) let wrap_html (source_files : string list) - (language : Cli.backend_lang) + (language : Global.backend_lang) (fmt : Format.formatter) (wrapped : Format.formatter -> unit) : unit = let css_as_string = diff --git a/compiler/literate/html.mli b/compiler/literate/html.mli index 53d071c9..34385829 100644 --- a/compiler/literate/html.mli +++ b/compiler/literate/html.mli @@ -23,7 +23,7 @@ open Catala_utils val wrap_html : string list -> - Cli.backend_lang -> + Global.backend_lang -> Format.formatter -> (Format.formatter -> unit) -> unit @@ -34,7 +34,7 @@ val wrap_html : (** {1 API} *) val ast_to_html : - Cli.backend_lang -> + Global.backend_lang -> print_only_law:bool -> Format.formatter -> Surface.Ast.program -> diff --git a/compiler/literate/latex.ml b/compiler/literate/latex.ml index b25dc972..e4add7c4 100644 --- a/compiler/literate/latex.ml +++ b/compiler/literate/latex.ml @@ -21,7 +21,7 @@ open Catala_utils open Literate_common module A = Surface.Ast -module C = Cli +module C = Global (** {1 Helpers} *) diff --git a/compiler/literate/latex.mli b/compiler/literate/latex.mli index 28ba0801..b536c5f3 100644 --- a/compiler/literate/latex.mli +++ b/compiler/literate/latex.mli @@ -23,7 +23,7 @@ open Catala_utils val wrap_latex : string list -> - Cli.backend_lang -> + Global.backend_lang -> Format.formatter -> (Format.formatter -> unit) -> unit @@ -34,7 +34,7 @@ val wrap_latex : (** {1 API} *) val ast_to_latex : - Cli.backend_lang -> + Global.backend_lang -> print_only_law:bool -> Format.formatter -> Surface.Ast.program -> diff --git a/compiler/literate/literate_common.ml b/compiler/literate/literate_common.ml index 72fd3a33..b5c1f41b 100644 --- a/compiler/literate/literate_common.ml +++ b/compiler/literate/literate_common.ml @@ -15,7 +15,7 @@ the License. *) open Catala_utils -open Cli +open Global let literal_title = function | En -> "Legislative text implementation" diff --git a/compiler/literate/literate_common.mli b/compiler/literate/literate_common.mli index ebf1bad7..660a9d55 100644 --- a/compiler/literate/literate_common.mli +++ b/compiler/literate/literate_common.mli @@ -16,30 +16,30 @@ open Catala_utils -val literal_title : Cli.backend_lang -> string +val literal_title : Global.backend_lang -> string (** Return the title traduction according the given - {!type:Catala_utils.Cli.backend_lang}. *) + {!type:Catala_utils.Global.backend_lang}. *) -val literal_generated_by : Cli.backend_lang -> string +val literal_generated_by : Global.backend_lang -> string (** Return the 'generated by' traduction according the given - {!type:Catala_utils.Cli.backend_lang}. *) + {!type:Catala_utils.Global.backend_lang}. *) -val literal_source_files : Cli.backend_lang -> string +val literal_source_files : Global.backend_lang -> string (** Return the 'source files weaved' traduction according the given - {!type:Catala_utils.Cli.backend_lang}. *) + {!type:Catala_utils.Global.backend_lang}. *) -val literal_disclaimer_and_link : Cli.backend_lang -> string +val literal_disclaimer_and_link : Global.backend_lang -> string (** Return the traduction of a paragraph giving a basic disclaimer about Catala and a link to the website according the given - {!type:Catala_utils.Cli.backend_lang}. *) + {!type:Catala_utils.Global.backend_lang}. *) -val literal_last_modification : Cli.backend_lang -> string +val literal_last_modification : Global.backend_lang -> string (** Return the 'last modification' traduction according the given - {!type:Catala_utils.Cli.backend_lang}. *) + {!type:Catala_utils.Global.backend_lang}. *) -val get_language_extension : Cli.backend_lang -> string +val get_language_extension : Global.backend_lang -> string (** Return the file extension corresponding to the given - {!type:Catala_utils.Cli.backend_lang}. *) + {!type:Catala_utils.Global.backend_lang}. *) val run_pandoc : string -> [ `Html | `Latex ] -> string (** Runs the [pandoc] on a string to pretty-print markdown features into the @@ -49,11 +49,11 @@ val check_exceeding_lines : ?max_len:int -> int -> string -> string -> unit (** [check_exceeding_lines ~max_len start_line filename content] prints a warning message for each lines of [content] exceeding [max_len] characters. *) -val call_pygmentize : ?lang:Cli.backend_lang -> string list -> string +val call_pygmentize : ?lang:Global.backend_lang -> string list -> string (** Calls the [pygmentize] command with the given arguments, and returns the results as a string. If [lang] is specified, the proper arguments for the Catala lexer are already passed. *) -val with_pygmentize_lexer : Cli.backend_lang -> (string list -> 'a) -> 'a +val with_pygmentize_lexer : Global.backend_lang -> (string list -> 'a) -> 'a (** Creates the required lexer file and returns the corresponding [pygmentize] command-line arguments *) diff --git a/compiler/literate/pygmentize.ml b/compiler/literate/pygmentize.ml index c7e002b5..5f46b50c 100644 --- a/compiler/literate/pygmentize.ml +++ b/compiler/literate/pygmentize.ml @@ -20,9 +20,9 @@ open Literate_common let lang_of_ext s = if String.starts_with ~prefix:"catala_" s then match s with - | "catala_en" -> Some Cli.En - | "catala_fr" -> Some Cli.Fr - | "catala_pl" -> Some Cli.Pl + | "catala_en" -> Some Global.En + | "catala_fr" -> Some Global.Fr + | "catala_pl" -> Some Global.Pl | _ -> failwith "Unknown Catala dialect" else None diff --git a/compiler/plugin.mli b/compiler/plugin.mli index f216623f..7278403b 100644 --- a/compiler/plugin.mli +++ b/compiler/plugin.mli @@ -21,7 +21,7 @@ type t = unit Cmdliner.Cmd.t val register : Cmdliner.Cmd.info -> - (Catala_utils.Cli.options -> unit) Cmdliner.Term.t -> + (Catala_utils.Global.options -> unit) Cmdliner.Term.t -> unit (** Plugins are registerd as [Cmdliner] commands, which must take at least the default global options as arguments (this is required for e.g. diff --git a/compiler/plugins/api_web.ml b/compiler/plugins/api_web.ml index 3607a516..ed0833b8 100644 --- a/compiler/plugins/api_web.ml +++ b/compiler/plugins/api_web.ml @@ -475,7 +475,7 @@ let run closure_conversion monomorphize_types _options = - let options = Cli.enforce_globals ~trace:true () in + let options = Global.enforce_options ~trace:true () in let prg, type_ordering = Driver.Passes.lcalc options ~includes ~optimize ~check_invariants ~avoid_exceptions ~closure_conversion ~typed:Expr.typed @@ -494,7 +494,7 @@ let run String.capitalize_ascii Filename.( basename - (remove_extension (Cli.input_src_file options.Cli.input_src))) + (remove_extension (Cli.input_src_file options.Global.input_src))) in To_jsoo.format_program fmt (Some modname) prg type_ordering) diff --git a/compiler/plugins/explain.ml b/compiler/plugins/explain.ml index 070b517e..48f5c589 100644 --- a/compiler/plugins/explain.ml +++ b/compiler/plugins/explain.ml @@ -23,7 +23,7 @@ type flags = { merge_level : int; format : [ `Dot | `Convert of string ]; show : string option; - output : Cli.raw_file option; + output : Global.raw_file option; base_src_url : string; } @@ -264,7 +264,7 @@ let rec lazy_eval : decl_ctx -> Env.t -> laziness_level -> expr -> expr * Env.t e in let e = - Interpreter.evaluate_operator eval op m Cli.En + Interpreter.evaluate_operator eval op m Global.En (* Default language to English but this should not raise any error messages so we don't care. *) args @@ -989,7 +989,7 @@ let rec graph_cleanup options g base_vars = let expr_to_dot_label0 : type a. - Cli.backend_lang -> + Global.backend_lang -> decl_ctx -> Env.t -> Format.formatter -> @@ -997,7 +997,7 @@ let expr_to_dot_label0 : unit = fun lang ctx env -> let xlang ~en ?(pl = en) ~fr () = - match lang with Cli.Fr -> fr | Cli.En -> en | Cli.Pl -> pl + match lang with Global.Fr -> fr | Global.En -> en | Global.Pl -> pl in let rec aux_value : type a t. Format.formatter -> (a, t) gexpr -> unit = fun ppf e -> Print.UserFacing.value ~fallback lang ppf e @@ -1369,7 +1369,7 @@ let run includes optimize ex_scope explain_options global_options = graph_cleanup explain_options g base_vars else g in - let lang = Cli.file_lang (Cli.input_src_file global_options.Cli.input_src) in + let lang = Cli.file_lang (Cli.input_src_file global_options.Global.input_src) in let dot_content = to_dot lang Format.str_formatter prg.decl_ctx env base_vars g ~base_src_url:explain_options.base_src_url; @@ -1386,7 +1386,7 @@ let run includes optimize ex_scope explain_options global_options = fun f -> f (Option.value ~default:"-" - (Option.map Cli.globals.path_rewrite output)) + (Option.map Global.options.path_rewrite output)) in with_dot_file @@ fun dotfile -> diff --git a/compiler/plugins/lazy_interp.ml b/compiler/plugins/lazy_interp.ml index ab002398..009c4ff7 100644 --- a/compiler/plugins/lazy_interp.ml +++ b/compiler/plugins/lazy_interp.ml @@ -112,7 +112,7 @@ let rec lazy_eval : renv := env; e in - ( Interpreter.evaluate_operator eval op m Cli.En + ( Interpreter.evaluate_operator eval op m Global.En (* Default language to English but this should not raise any error messages so we don't care. *) args, diff --git a/compiler/scalc/to_python.ml b/compiler/scalc/to_python.ml index 0a70fca5..5537a5f7 100644 --- a/compiler/scalc/to_python.ml +++ b/compiler/scalc/to_python.ml @@ -319,11 +319,11 @@ let rec format_expression ctx (fmt : Format.formatter) (e : expr) : unit = (op, Pos.no_pos) (format_expression ctx) arg2 | EApp { f = EAppOp { op = Log (BeginCall, info); args = [f] }, _; args = [arg] } - when Cli.globals.trace -> + when Global.options.trace -> Format.fprintf fmt "log_begin_call(%a,@ %a,@ %a)" format_uid_list info (format_expression ctx) f (format_expression ctx) arg | EAppOp { op = Log (VarDef var_def_info, info); args = [arg1] } - when Cli.globals.trace -> + when Global.options.trace -> Format.fprintf fmt "log_variable_definition(%a,@ LogIO(input_io=InputIO.%s,@ \ output_io=%s),@ %a)" @@ -335,7 +335,7 @@ let rec format_expression ctx (fmt : Format.formatter) (e : expr) : unit = (if var_def_info.log_io_output then "True" else "False") (format_expression ctx) arg1 | EAppOp { op = Log (PosRecordIfTrueBool, _); args = [arg1] } - when Cli.globals.trace -> + when Global.options.trace -> let pos = Mark.get e in Format.fprintf fmt "log_decision_taken(SourcePosition(filename=\"%s\",@ start_line=%d,@ \ @@ -343,7 +343,7 @@ let rec format_expression ctx (fmt : Format.formatter) (e : expr) : unit = (Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos) (Pos.get_end_line pos) (Pos.get_end_column pos) format_string_list (Pos.get_law_info pos) (format_expression ctx) arg1 - | EAppOp { op = Log (EndCall, info); args = [arg1] } when Cli.globals.trace -> + | EAppOp { op = Log (EndCall, info); args = [arg1] } when Global.options.trace -> Format.fprintf fmt "log_end_call(%a,@ %a)" format_uid_list info (format_expression ctx) arg1 | EAppOp { op = Log _; args = [arg1] } -> diff --git a/compiler/scopelang/ast.ml b/compiler/scopelang/ast.ml index 27841517..1c01de7a 100644 --- a/compiler/scopelang/ast.ml +++ b/compiler/scopelang/ast.ml @@ -62,7 +62,7 @@ type 'm program = { program_modules : nil scope_decl Mark.pos ScopeName.Map.t ModuleName.Map.t; program_scopes : 'm scope_decl Mark.pos ScopeName.Map.t; program_topdefs : ('m expr * typ) TopdefName.Map.t; - program_lang : Cli.backend_lang; + program_lang : Global.backend_lang; } let type_rule decl_ctx env = function diff --git a/compiler/scopelang/ast.mli b/compiler/scopelang/ast.mli index 8a707268..0908f9cd 100644 --- a/compiler/scopelang/ast.mli +++ b/compiler/scopelang/ast.mli @@ -58,7 +58,7 @@ type 'm program = { the scope signatures needed to respect the call convention *) program_scopes : 'm scope_decl Mark.pos ScopeName.Map.t; program_topdefs : ('m expr * typ) TopdefName.Map.t; - program_lang : Cli.backend_lang; + program_lang : Global.backend_lang; } val type_program : 'm program -> typed program diff --git a/compiler/scopelang/from_desugared.ml b/compiler/scopelang/from_desugared.ml index d454a1e9..8a76babc 100644 --- a/compiler/scopelang/from_desugared.ml +++ b/compiler/scopelang/from_desugared.ml @@ -37,7 +37,7 @@ let tag_with_log_entry (e : untyped Ast.expr boxed) (l : log_entry) (markings : Uid.MarkedString.info list) : untyped Ast.expr boxed = - if Cli.globals.trace then + if Global.options.trace then Expr.eappop ~op:(Log (l, markings)) ~tys:[TAny, Expr.pos e] diff --git a/compiler/shared_ast/definitions.ml b/compiler/shared_ast/definitions.ml index d61ca201..eb910cda 100644 --- a/compiler/shared_ast/definitions.ml +++ b/compiler/shared_ast/definitions.ml @@ -699,6 +699,6 @@ type decl_ctx = { type 'e program = { decl_ctx : decl_ctx; code_items : 'e code_item_list; - lang : Cli.backend_lang; + lang : Global.backend_lang; module_name : ModuleName.t option; } diff --git a/compiler/shared_ast/interpreter.ml b/compiler/shared_ast/interpreter.ml index e2d1ba77..61e66c1a 100644 --- a/compiler/shared_ast/interpreter.ml +++ b/compiler/shared_ast/interpreter.ml @@ -35,13 +35,13 @@ let indent_str = ref "" (** {1 Evaluation} *) let print_log lang entry infos pos e = - if Cli.globals.trace then + if Global.options.trace then match entry with | VarDef _ -> Message.emit_log "%s%a %a: @{%s@}" !indent_str Print.log_entry entry Print.uid_list infos (Message.unformat (fun ppf -> - (if Cli.globals.debug then Print.expr ~debug:true () + (if Global.options.debug then Print.expr ~debug:true () else Print.UserFacing.expr lang) ppf e)) | PosRecordIfTrueBool -> ( @@ -609,7 +609,7 @@ and val_to_runtime : let rec evaluate_expr : type d e. decl_ctx -> - Cli.backend_lang -> + Global.backend_lang -> ((d, e, yes) interpr_kind, 't) gexpr -> ((d, e, yes) interpr_kind, 't) gexpr = fun ctx lang e -> @@ -817,7 +817,7 @@ let rec evaluate_expr : and partially_evaluate_expr_for_assertion_failure_message : type d e. decl_ctx -> - Cli.backend_lang -> + Global.backend_lang -> ((d, e, yes) interpr_kind, 't) gexpr -> ((d, e, yes) interpr_kind, 't) gexpr = fun ctx lang e -> diff --git a/compiler/shared_ast/interpreter.mli b/compiler/shared_ast/interpreter.mli index d52aaa87..a3df8d99 100644 --- a/compiler/shared_ast/interpreter.mli +++ b/compiler/shared_ast/interpreter.mli @@ -26,7 +26,7 @@ val evaluate_operator : ((((_, _, _) interpr_kind as 'a), 'm) gexpr -> ('a, 'm) gexpr) -> 'a operator -> 'm mark -> - Cli.backend_lang -> + Global.backend_lang -> ('a, 'm) gexpr list -> ('a, 'm) gexpr (** Evaluates the result of applying the given operator to the given arguments, @@ -36,7 +36,7 @@ val evaluate_operator : val evaluate_expr : decl_ctx -> - Cli.backend_lang -> + Global.backend_lang -> (('a, 'b, _) interpr_kind, 'm) gexpr -> (('a, 'b, yes) interpr_kind, 'm) gexpr (** Evaluates an expression according to the semantics of the default calculus. *) diff --git a/compiler/shared_ast/optimizations.ml b/compiler/shared_ast/optimizations.ml index 99c29c81..c1a6ff59 100644 --- a/compiler/shared_ast/optimizations.ml +++ b/compiler/shared_ast/optimizations.ml @@ -184,7 +184,7 @@ let rec optimize_expr : feed the expression to the interpreter that will print the beautiful right error message *) let (_ : _ gexpr) = - Interpreter.evaluate_expr ctx.decl_ctx Cli.En + Interpreter.evaluate_expr ctx.decl_ctx Global.En (* Default language to English, no errors should be raised normally so we don't care *) e diff --git a/compiler/shared_ast/print.ml b/compiler/shared_ast/print.ml index 268221d8..1ef8dae5 100644 --- a/compiler/shared_ast/print.ml +++ b/compiler/shared_ast/print.ml @@ -180,7 +180,7 @@ let lit (fmt : Format.formatter) (l : lit) : unit = | LUnit -> lit_style fmt "()" | LRat i -> lit_style fmt - (Runtime.decimal_to_string ~max_prec_digits:Cli.globals.max_prec_digits i) + (Runtime.decimal_to_string ~max_prec_digits:Global.options.max_prec_digits i) | LMoney e -> lit_style fmt (Format.asprintf "¤%s" (Runtime.money_to_string e)) | LDate d -> lit_style fmt (Runtime.date_to_string d) @@ -771,7 +771,7 @@ end module ExprDebug = ExprGen (ExprDebugParam) -let expr ?(debug = Cli.globals.debug) () ppf e = +let expr ?(debug = Global.options.debug) () ppf e = if debug then ExprDebug.expr ppf e else ExprConcise.expr ppf e let scope_let_kind ?debug:(_debug = true) _ctx fmt k = @@ -958,15 +958,15 @@ module UserFacing = struct (* Refs: https://en.wikipedia.org/wiki/Wikipedia:Manual_of_Style/Dates_and_numbers#Grouping_of_digits https://fr.wikipedia.org/wiki/Wikip%C3%A9dia:Conventions_concernant_les_nombres#Pour_un_comptage_ou_une_mesure *) - let bigsep (lang : Cli.backend_lang) = + let bigsep (lang : Global.backend_lang) = match lang with En -> ",", 3 | Fr -> " ", 3 | Pl -> ",", 3 - let decsep (lang : Cli.backend_lang) = + let decsep (lang : Global.backend_lang) = match lang with En -> "." | Fr -> "," | Pl -> "." - let unit (_lang : Cli.backend_lang) ppf () = Format.pp_print_string ppf "()" + let unit (_lang : Global.backend_lang) ppf () = Format.pp_print_string ppf "()" - let bool (lang : Cli.backend_lang) ppf b = + let bool (lang : Global.backend_lang) ppf b = let s = match lang, b with | En, true -> "true" @@ -978,7 +978,7 @@ module UserFacing = struct in Format.pp_print_string ppf s - let integer (lang : Cli.backend_lang) ppf n = + let integer (lang : Global.backend_lang) ppf n = let sep, nsep = bigsep lang in let nsep = Z.pow (Z.of_int 10) nsep in if Z.sign n < 0 then Format.pp_print_char ppf '-'; @@ -991,7 +991,7 @@ module UserFacing = struct in aux (Z.abs n) - let money (lang : Cli.backend_lang) ppf n = + let money (lang : Global.backend_lang) ppf n = let num = Z.abs n in let units, cents = Z.div_rem num (Z.of_int 100) in if Z.sign n < 0 then Format.pp_print_char ppf '-'; @@ -1004,7 +1004,7 @@ module UserFacing = struct | Fr -> Format.pp_print_string ppf " €" | Pl -> Format.pp_print_string ppf " PLN" - let decimal (lang : Cli.backend_lang) ppf r = + let decimal (lang : Global.backend_lang) ppf r = let den = Q.den r in let num = Z.abs (Q.num r) in let int_part, rem = Z.div_rem num den in @@ -1021,7 +1021,7 @@ module UserFacing = struct | None -> if Z.equal n Z.zero then None, false else - let r = Cli.globals.max_prec_digits in + let r = Global.options.max_prec_digits in Some (r - 1), r <= 1 | Some r -> Some (r - 1), r <= 1 in @@ -1037,19 +1037,19 @@ module UserFacing = struct in aux 0 (if Z.equal int_part Z.zero then None - else Some (Cli.globals.max_prec_digits - ndigits int_part)) + else Some (Global.options.max_prec_digits - ndigits int_part)) rem (* It would be nice to print ratios as % but that's impossible to guess. Trying would lead to inconsistencies where some comparable numbers are in % and some others not, adding confusion. *) - let date (lang : Cli.backend_lang) ppf d = + let date (lang : Global.backend_lang) ppf d = let y, m, d = Dates_calc.Dates.date_to_ymd d in match lang with | En | Pl -> Format.fprintf ppf "%04d-%02d-%02d" y m d | Fr -> Format.fprintf ppf "%02d/%02d/%04d" d m y - let duration (lang : Cli.backend_lang) ppf dr = + let duration (lang : Global.backend_lang) ppf dr = let y, m, d = Dates_calc.Dates.period_to_ymds dr in let rec filter0 = function | (0, _) :: (_ :: _ as r) -> filter0 r @@ -1069,7 +1069,7 @@ module UserFacing = struct ppf; Format.pp_print_char ppf ']' - let lit_raw (lang : Cli.backend_lang) ppf lit : unit = + let lit_raw (lang : Global.backend_lang) ppf lit : unit = match lit with | LUnit -> unit lang ppf () | LBool b -> bool lang ppf b @@ -1079,20 +1079,20 @@ module UserFacing = struct | LDate d -> date lang ppf d | LDuration dr -> duration lang ppf dr - let lit_to_string (lang : Cli.backend_lang) lit = + let lit_to_string (lang : Global.backend_lang) lit = let buf = Buffer.create 32 in let ppf = Format.formatter_of_buffer buf in lit_raw lang ppf lit; Format.pp_print_flush ppf (); Buffer.contents buf - let lit (lang : Cli.backend_lang) ppf lit : unit = + let lit (lang : Global.backend_lang) ppf lit : unit = with_color (lit_raw lang) Ocolor_types.yellow ppf lit let rec value : type a. ?fallback:(Format.formatter -> (a, 't) gexpr -> unit) -> - Cli.backend_lang -> + Global.backend_lang -> Format.formatter -> (a, 't) gexpr -> unit = @@ -1132,7 +1132,7 @@ module UserFacing = struct fallback ppf e let expr : - type a. Cli.backend_lang -> Format.formatter -> (a, 't) gexpr -> unit = + type a. Global.backend_lang -> Format.formatter -> (a, 't) gexpr -> unit = fun lang -> let rec aux_value : type a t. Format.formatter -> (a, t) gexpr -> unit = fun ppf e -> value ~fallback lang ppf e diff --git a/compiler/shared_ast/print.mli b/compiler/shared_ast/print.mli index efdbe53d..d3560f2a 100644 --- a/compiler/shared_ast/print.mli +++ b/compiler/shared_ast/print.mli @@ -96,22 +96,22 @@ val program : ?debug:bool -> Format.formatter -> ('a, 'm) gexpr program -> unit (** User-facing, localised printer *) module UserFacing : sig - val unit : Cli.backend_lang -> Format.formatter -> Runtime.unit -> unit - val bool : Cli.backend_lang -> Format.formatter -> Runtime.bool -> unit - val integer : Cli.backend_lang -> Format.formatter -> Runtime.integer -> unit - val decimal : Cli.backend_lang -> Format.formatter -> Runtime.decimal -> unit - val money : Cli.backend_lang -> Format.formatter -> Runtime.money -> unit - val date : Cli.backend_lang -> Format.formatter -> Runtime.date -> unit + val unit : Global.backend_lang -> Format.formatter -> Runtime.unit -> unit + val bool : Global.backend_lang -> Format.formatter -> Runtime.bool -> unit + val integer : Global.backend_lang -> Format.formatter -> Runtime.integer -> unit + val decimal : Global.backend_lang -> Format.formatter -> Runtime.decimal -> unit + val money : Global.backend_lang -> Format.formatter -> Runtime.money -> unit + val date : Global.backend_lang -> Format.formatter -> Runtime.date -> unit val duration : - Cli.backend_lang -> Format.formatter -> Runtime.duration -> unit + Global.backend_lang -> Format.formatter -> Runtime.duration -> unit - val lit : Cli.backend_lang -> Format.formatter -> lit -> unit - val lit_to_string : Cli.backend_lang -> lit -> string + val lit : Global.backend_lang -> Format.formatter -> lit -> unit + val lit_to_string : Global.backend_lang -> lit -> string val value : ?fallback:(Format.formatter -> ('a, 't) gexpr -> unit) -> - Cli.backend_lang -> + Global.backend_lang -> Format.formatter -> ('a, 't) gexpr -> unit @@ -121,7 +121,7 @@ module UserFacing : sig is called upon non-value expressions (by default, [Invalid_argument] is raised) *) - val expr : Cli.backend_lang -> Format.formatter -> (_, _) gexpr -> unit + val expr : Global.backend_lang -> Format.formatter -> (_, _) gexpr -> unit (** This combines the user-facing value printer and the generic expression printer to handle all AST nodes *) end diff --git a/compiler/shared_ast/typing.ml b/compiler/shared_ast/typing.ml index b7582e6b..1b0f7d44 100644 --- a/compiler/shared_ast/typing.ml +++ b/compiler/shared_ast/typing.ml @@ -159,14 +159,14 @@ let rec format_typ ")" (format_typ ~colors) t2 | TArray t1 -> ( match Mark.remove (UnionFind.get (UnionFind.find t1)) with - | TAny _ when not Cli.globals.debug -> Format.pp_print_string fmt "list" + | TAny _ when not Global.options.debug -> Format.pp_print_string fmt "list" | _ -> Format.fprintf fmt "@[list of@ %a@]" (format_typ ~colors) t1) | TDefault t1 -> Format.pp_print_as fmt 1 "⟨"; format_typ ~colors fmt t1; Format.pp_print_as fmt 1 "⟩" | TAny v -> - if Cli.globals.debug then Format.fprintf fmt "" (Any.hash v) + if Global.options.debug then Format.fprintf fmt "" (Any.hash v) else Format.pp_print_string fmt "" | TClosureEnv -> Format.fprintf fmt "closure_env" @@ -234,7 +234,7 @@ let handle_type_error ctx (A.AnyExpr e) t1 t2 = ( (fun ppf -> Format.fprintf ppf "@[@[%a@ %a@]:" Format.pp_print_text "This expression has type" (format_typ ctx) t1; - if Cli.globals.debug then Format.fprintf ppf "@ %a@]" Expr.format e + if Global.options.debug then Format.fprintf ppf "@ %a@]" Expr.format e else Format.pp_close_box ppf ()), e_pos ); ( (fun ppf -> @@ -248,7 +248,7 @@ let handle_type_error ctx (A.AnyExpr e) t1 t2 = ( (fun ppf -> Format.fprintf ppf "@[@[%a:@]" Format.pp_print_text "While typechecking the following expression"; - if Cli.globals.debug then Format.fprintf ppf "@ %a@]" Expr.format e + if Global.options.debug then Format.fprintf ppf "@ %a@]" Expr.format e else Format.pp_close_box ppf ()), e_pos ); ( (fun ppf -> diff --git a/compiler/surface/ast.ml b/compiler/surface/ast.ml index f1cf771d..a06b4925 100644 --- a/compiler/surface/ast.ml +++ b/compiler/surface/ast.ml @@ -333,7 +333,7 @@ and program = { program_items : law_structure list; program_source_files : (string[@opaque]) list; program_used_modules : module_use list; - program_lang : Cli.backend_lang; [@opaque] + program_lang : Global.backend_lang; [@opaque] } and source_file = law_structure list diff --git a/compiler/surface/parser_driver.ml b/compiler/surface/parser_driver.ml index e1d53c6f..8c56d51e 100644 --- a/compiler/surface/parser_driver.ml +++ b/compiler/surface/parser_driver.ml @@ -198,14 +198,14 @@ module Parser_En = ParserAux (Lexer_en) module Parser_Fr = ParserAux (Lexer_fr) module Parser_Pl = ParserAux (Lexer_pl) -let localised_parser : Cli.backend_lang -> lexbuf -> Ast.source_file = function +let localised_parser : Global.backend_lang -> lexbuf -> Ast.source_file = function | En -> Parser_En.commands_or_includes | Fr -> Parser_Fr.commands_or_includes | Pl -> Parser_Pl.commands_or_includes (** Lightweight lexer for dependency *) -let lines (file : File.t) (language : Cli.backend_lang) = +let lines (file : File.t) (language : Global.backend_lang) = let lex_line = match language with | En -> Lexer_en.lex_line @@ -387,12 +387,12 @@ let get_interface program = let with_sedlex_source source_file f = match source_file with - | Cli.FileName file -> with_sedlex_file file f - | Cli.Contents (str, file) -> + | Global.FileName file -> with_sedlex_file file f + | Global.Contents (str, file) -> let lexbuf = Sedlexing.Utf8.from_string str in Sedlexing.set_filename lexbuf file; f lexbuf - | Cli.Stdin file -> + | Global.Stdin file -> let lexbuf = Sedlexing.Utf8.from_channel stdin in Sedlexing.set_filename lexbuf file; f lexbuf @@ -400,7 +400,7 @@ let with_sedlex_source source_file f = let check_modname program source_file = match program.Ast.program_module_name, source_file with | ( Some (mname, pos), - (Cli.FileName file | Cli.Contents (_, file) | Cli.Stdin file) ) + (Global.FileName file | Global.Contents (_, file) | Global.Stdin file) ) when not File.(equal mname Filename.(remove_extension (basename file))) -> Message.raise_spanned_error pos "@[Module declared as@ @{%s@},@ which@ does@ not@ match@ the@ \ @@ -437,7 +437,7 @@ let load_interface ?default_module_name source_file = Ast.intf_submodules = used_modules; } -let parse_top_level_file (source_file : Cli.input_src) : Ast.program = +let parse_top_level_file (source_file : File.t Global.input_src) : Ast.program = let program = with_sedlex_source source_file parse_source in check_modname program source_file; { diff --git a/compiler/surface/parser_driver.mli b/compiler/surface/parser_driver.mli index a295d3bb..bfaea93d 100644 --- a/compiler/surface/parser_driver.mli +++ b/compiler/surface/parser_driver.mli @@ -20,17 +20,17 @@ open Catala_utils val lines : - File.t -> Cli.backend_lang -> (string * Lexer_common.line_token) Seq.t + File.t -> Global.backend_lang -> (string * Lexer_common.line_token) Seq.t (** Raw file parser that doesn't interpret any includes and returns the flat law structure as is *) val load_interface : - ?default_module_name:string -> Cli.input_src -> Ast.interface + ?default_module_name:string -> File.t Global.input_src -> Ast.interface (** Reads only declarations in metadata in the supplied input file, and only keeps type information. The list of submodules is initialised with names only and empty contents. *) -val parse_top_level_file : Cli.input_src -> Ast.program +val parse_top_level_file : File.t Global.input_src -> Ast.program (** Parses a catala file (handling file includes) and returns a program. Interfaces of the used modules are returned empty, use [load_interface] to fill them. *) diff --git a/compiler/verification/z3backend.real.ml b/compiler/verification/z3backend.real.ml index f5c47fb3..bae794cd 100644 --- a/compiler/verification/z3backend.real.ml +++ b/compiler/verification/z3backend.real.ml @@ -139,7 +139,7 @@ let rec print_z3model_expr (ctx : context) (ty : typ) (e : Expr.expr) : string = Catala sources *) | TUnit -> "" | TInt -> Expr.to_string e - | TRat -> Arithmetic.Real.to_decimal_string e Cli.globals.max_prec_digits + | TRat -> Arithmetic.Real.to_decimal_string e Global.options.max_prec_digits (* TODO: Print the right money symbol according to language *) | TMoney -> let z3_str = Expr.to_string e in diff --git a/runtimes/rescript/package.json b/runtimes/rescript/package.json index ff6bd6d6..01868d3e 100644 --- a/runtimes/rescript/package.json +++ b/runtimes/rescript/package.json @@ -1,6 +1,6 @@ { "name": "@catala-lang/rescript-catala", - "version": "0.8.1-b.0", + "version": "0.9.0", "description": "ReScript wrapper for the Catala runtime", "scripts": { "clean": "rescript clean",