2020-04-16 18:47:35 +03:00
|
|
|
(* This file is part of the Catala compiler, a specification language for tax and social benefits
|
2021-05-27 19:56:47 +03:00
|
|
|
computation rules. Copyright (C) 2020 Inria, contributors: Denis Merigoux
|
|
|
|
<denis.merigoux@inria.fr>, Emile Rolley <emile.rolley@tuta.io>
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
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
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
http://www.apache.org/licenses/LICENSE-2.0
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
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. *)
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2021-05-26 22:18:18 +03:00
|
|
|
type backend_lang = En | Fr | Pl
|
2021-01-09 23:03:32 +03:00
|
|
|
|
|
|
|
(** Source files to be compiled *)
|
2020-03-08 02:21:55 +03:00
|
|
|
let source_files : string list ref = ref []
|
|
|
|
|
2021-05-26 22:18:18 +03:00
|
|
|
let locale_lang : backend_lang ref = ref En
|
2021-01-09 23:03:32 +03:00
|
|
|
|
2020-12-26 19:37:41 +03:00
|
|
|
let contents : string ref = ref ""
|
|
|
|
|
2020-03-08 02:21:55 +03:00
|
|
|
(** Prints debug information *)
|
|
|
|
let debug_flag = ref false
|
|
|
|
|
2020-08-07 18:37:28 +03:00
|
|
|
(* Styles the terminal output *)
|
|
|
|
let style_flag = ref true
|
|
|
|
|
2020-12-09 18:45:23 +03:00
|
|
|
(* Max number of digits to show for decimal results *)
|
|
|
|
let max_prec_digits = ref 20
|
|
|
|
|
2020-12-11 12:51:46 +03:00
|
|
|
let trace_flag = ref false
|
|
|
|
|
2021-04-03 14:44:11 +03:00
|
|
|
let optimize_flag = ref false
|
|
|
|
|
2020-03-08 03:52:31 +03:00
|
|
|
open Cmdliner
|
|
|
|
|
2020-04-19 19:39:16 +03:00
|
|
|
let file =
|
|
|
|
Arg.(
|
|
|
|
required
|
|
|
|
& pos 1 (some file) None
|
|
|
|
& info [] ~docv:"FILE" ~doc:"Catala master file to be compiled")
|
2020-03-08 03:52:31 +03:00
|
|
|
|
|
|
|
let debug = Arg.(value & flag & info [ "debug"; "d" ] ~doc:"Prints debug information")
|
|
|
|
|
2020-08-07 18:37:28 +03:00
|
|
|
let unstyled = Arg.(value & flag & info [ "unstyled" ] ~doc:"Removes styling from terminal output")
|
|
|
|
|
2021-04-03 14:44:11 +03:00
|
|
|
let optimize = Arg.(value & flag & info [ "optimize"; "O" ] ~doc:"Run compiler optimizations")
|
|
|
|
|
2020-12-11 12:51:46 +03:00
|
|
|
let trace_opt =
|
2021-05-09 23:55:50 +03:00
|
|
|
Arg.(
|
|
|
|
value & flag & info [ "trace"; "t" ] ~doc:"Displays a trace of the interpreter's computation")
|
2020-12-11 12:51:46 +03:00
|
|
|
|
2020-04-29 10:55:49 +03:00
|
|
|
let wrap_weaved_output =
|
|
|
|
Arg.(
|
|
|
|
value & flag
|
|
|
|
& info [ "wrap"; "w" ] ~doc:"Wraps literate programming output with a minimal preamble")
|
2020-04-17 13:29:30 +03:00
|
|
|
|
2020-03-08 03:52:31 +03:00
|
|
|
let backend =
|
|
|
|
Arg.(
|
|
|
|
required
|
2020-04-19 19:39:16 +03:00
|
|
|
& pos 0 (some string) None
|
2021-01-28 02:28:28 +03:00
|
|
|
& info [] ~docv:"BACKEND"
|
2021-05-29 15:15:23 +03:00
|
|
|
~doc:"Backend selection among: LaTeX, Makefile, Html, Interpret, OCaml, Dcalc, Scopelang")
|
2020-03-08 03:52:31 +03:00
|
|
|
|
2021-06-21 19:00:06 +03:00
|
|
|
type backend_option = Latex | Makefile | Html | Run | OCaml | Python | Dcalc | Scopelang
|
2020-04-20 09:13:57 +03:00
|
|
|
|
2020-04-19 20:16:04 +03:00
|
|
|
let language =
|
|
|
|
Arg.(
|
2020-04-19 20:25:46 +03:00
|
|
|
value
|
|
|
|
& opt (some string) None
|
2021-05-27 20:02:35 +03:00
|
|
|
& info [ "l"; "language" ] ~docv:"LANG" ~doc:"Input language among: en, fr, pl")
|
2020-04-19 20:16:04 +03:00
|
|
|
|
2020-12-09 18:45:23 +03:00
|
|
|
let max_prec_digits_opt =
|
|
|
|
Arg.(
|
|
|
|
value
|
|
|
|
& opt (some int) None
|
|
|
|
& info [ "p"; "max_digits_printed" ] ~docv:"LANG"
|
|
|
|
~doc:"Maximum number of significant digits printed for decimal results (default 20)")
|
|
|
|
|
2020-08-06 16:44:51 +03:00
|
|
|
let ex_scope =
|
|
|
|
Arg.(
|
|
|
|
value & opt (some string) None & info [ "s"; "scope" ] ~docv:"SCOPE" ~doc:"Scope to be executed")
|
|
|
|
|
2020-03-08 03:52:31 +03:00
|
|
|
let output =
|
|
|
|
Arg.(
|
2020-04-19 19:39:16 +03:00
|
|
|
value
|
2020-03-08 03:52:31 +03:00
|
|
|
& opt (some string) None
|
|
|
|
& info [ "output"; "o" ] ~docv:"OUTPUT"
|
2021-05-29 15:15:23 +03:00
|
|
|
~doc:"$(i, OUTPUT) is the file that will contain the output of the compiler")
|
2020-03-08 03:52:31 +03:00
|
|
|
|
2020-04-17 16:53:23 +03:00
|
|
|
let catala_t f =
|
2020-08-06 16:44:51 +03:00
|
|
|
Term.(
|
2021-05-29 15:15:23 +03:00
|
|
|
const f $ file $ debug $ unstyled $ wrap_weaved_output $ backend $ language
|
2021-04-03 14:44:11 +03:00
|
|
|
$ max_prec_digits_opt $ trace_opt $ optimize $ ex_scope $ output)
|
2020-03-08 03:52:31 +03:00
|
|
|
|
2021-04-22 12:57:50 +03:00
|
|
|
let version = "0.4.0"
|
2020-12-26 19:37:41 +03:00
|
|
|
|
2020-03-08 03:52:31 +03:00
|
|
|
let info =
|
|
|
|
let doc =
|
2020-04-16 18:47:35 +03:00
|
|
|
"Compiler for Catala, a specification language for tax and social benefits computation rules."
|
2020-03-08 03:52:31 +03:00
|
|
|
in
|
|
|
|
let man =
|
|
|
|
[
|
|
|
|
`S Manpage.s_description;
|
|
|
|
`P
|
2020-04-19 20:04:11 +03:00
|
|
|
"Catala is a domain-specific language for deriving faithful-by-construction algorithms \
|
|
|
|
from legislative texts.";
|
2020-03-08 03:52:31 +03:00
|
|
|
`S Manpage.s_authors;
|
|
|
|
`P "Denis Merigoux <denis.merigoux@inria.fr>";
|
2020-12-11 12:51:46 +03:00
|
|
|
`P "Nicolas Chataing <nicolas.chataing@ens.fr>";
|
2020-03-08 03:52:31 +03:00
|
|
|
`S Manpage.s_examples;
|
|
|
|
`P "Typical usage:";
|
2020-04-19 19:39:16 +03:00
|
|
|
`Pre "catala LaTeX file.catala";
|
2020-03-08 03:52:31 +03:00
|
|
|
`S Manpage.s_bugs;
|
2020-12-11 12:51:46 +03:00
|
|
|
`P "Please file bug reports at https://github.com/CatalaLang/catala/issues";
|
2020-03-08 02:21:55 +03:00
|
|
|
]
|
|
|
|
in
|
2020-04-21 13:25:52 +03:00
|
|
|
let exits = Term.default_exits @ [ Term.exit_info ~doc:"on error." 1 ] in
|
2020-12-26 19:37:41 +03:00
|
|
|
Term.info "catala" ~version ~doc ~exits ~man
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
(**{1 Terminal formatting}*)
|
2020-03-08 02:21:55 +03:00
|
|
|
|
|
|
|
(**{2 Markers}*)
|
|
|
|
|
2021-02-28 13:15:18 +03:00
|
|
|
let time : float ref = ref (Unix.gettimeofday ())
|
|
|
|
|
|
|
|
let time_marker () =
|
|
|
|
let new_time = Unix.gettimeofday () in
|
|
|
|
let old_time = !time in
|
|
|
|
time := new_time;
|
|
|
|
let delta = (new_time -. old_time) *. 1000. in
|
|
|
|
if delta > 50. then
|
|
|
|
ANSITerminal.printf [ ANSITerminal.Bold; ANSITerminal.black ] "[TIME] %.0f ms\n" delta
|
|
|
|
|
2020-08-07 18:37:28 +03:00
|
|
|
let print_with_style (styles : ANSITerminal.style list) (str : ('a, unit, string) format) =
|
|
|
|
if !style_flag then ANSITerminal.sprintf styles str else Printf.sprintf str
|
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
(** Prints [\[DEBUG\]] in purple on the terminal standard output *)
|
2021-02-28 13:15:18 +03:00
|
|
|
let debug_marker () =
|
|
|
|
time_marker ();
|
|
|
|
print_with_style [ ANSITerminal.Bold; ANSITerminal.magenta ] "[DEBUG] "
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
(** Prints [\[ERROR\]] in red on the terminal error output *)
|
2020-08-07 18:37:28 +03:00
|
|
|
let error_marker () = print_with_style [ ANSITerminal.Bold; ANSITerminal.red ] "[ERROR] "
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
(** Prints [\[WARNING\]] in yellow on the terminal standard output *)
|
2020-08-07 18:37:28 +03:00
|
|
|
let warning_marker () = print_with_style [ ANSITerminal.Bold; ANSITerminal.yellow ] "[WARNING] "
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
(** Prints [\[RESULT\]] in green on the terminal standard output *)
|
2020-08-07 18:37:28 +03:00
|
|
|
let result_marker () = print_with_style [ ANSITerminal.Bold; ANSITerminal.green ] "[RESULT] "
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-12-11 12:51:46 +03:00
|
|
|
(** Prints [\[LOG\]] in red on the terminal error output *)
|
|
|
|
let log_marker () = print_with_style [ ANSITerminal.Bold; ANSITerminal.black ] "[LOG] "
|
|
|
|
|
2020-03-08 02:21:55 +03:00
|
|
|
(**{2 Printers}*)
|
|
|
|
|
|
|
|
(** All the printers below print their argument after the correct marker *)
|
|
|
|
|
2020-04-26 19:32:03 +03:00
|
|
|
let concat_with_line_depending_prefix_and_suffix (prefix : int -> string) (suffix : int -> string)
|
|
|
|
(ss : string list) =
|
|
|
|
match ss with
|
|
|
|
| hd :: rest ->
|
|
|
|
let out, _ =
|
|
|
|
List.fold_left
|
|
|
|
(fun (acc, i) s ->
|
|
|
|
((acc ^ prefix i ^ s ^ if i = List.length ss - 1 then "" else suffix i), i + 1))
|
|
|
|
((prefix 0 ^ hd ^ if 0 = List.length ss - 1 then "" else suffix 0), 1)
|
|
|
|
rest
|
|
|
|
in
|
|
|
|
out
|
|
|
|
| [] -> prefix 0
|
|
|
|
|
|
|
|
(** The int argument of the prefix corresponds to the line number, starting at 0 *)
|
|
|
|
let add_prefix_to_each_line (s : string) (prefix : int -> string) =
|
|
|
|
concat_with_line_depending_prefix_and_suffix
|
|
|
|
(fun i -> prefix i)
|
|
|
|
(fun _ -> "\n")
|
|
|
|
(String.split_on_char '\n' s)
|
2020-04-26 14:39:01 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
let debug_print (s : string) =
|
2020-03-08 02:21:55 +03:00
|
|
|
if !debug_flag then begin
|
2020-08-07 18:37:28 +03:00
|
|
|
Printf.printf "%s\n" (add_prefix_to_each_line s (fun _ -> debug_marker ()));
|
2020-03-08 02:21:55 +03:00
|
|
|
flush stdout;
|
|
|
|
flush stdout
|
|
|
|
end
|
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
let error_print (s : string) =
|
2020-08-07 18:37:28 +03:00
|
|
|
Printf.eprintf "%s\n" (add_prefix_to_each_line s (fun _ -> error_marker ()));
|
2020-09-13 19:48:28 +03:00
|
|
|
flush stderr;
|
|
|
|
flush stderr
|
2020-03-08 02:21:55 +03:00
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
let warning_print (s : string) =
|
2020-08-07 18:37:28 +03:00
|
|
|
Printf.printf "%s\n" (add_prefix_to_each_line s (fun _ -> warning_marker ()));
|
2020-03-08 02:21:55 +03:00
|
|
|
flush stdout;
|
|
|
|
flush stdout
|
|
|
|
|
2020-03-09 14:01:56 +03:00
|
|
|
let result_print (s : string) =
|
2020-08-07 18:37:28 +03:00
|
|
|
Printf.printf "%s\n" (add_prefix_to_each_line s (fun _ -> result_marker ()));
|
2020-03-08 02:21:55 +03:00
|
|
|
flush stdout;
|
|
|
|
flush stdout
|
2020-12-11 12:51:46 +03:00
|
|
|
|
|
|
|
let log_print (s : string) =
|
|
|
|
Printf.printf "%s\n" (add_prefix_to_each_line s (fun _ -> log_marker ()));
|
|
|
|
flush stdout;
|
|
|
|
flush stdout
|