mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-19 00:15:39 +03:00
583e80993a
*Disclaimer*: This is intended for discussion My impression is that the with-exceptions backend is to be superseded by the without-exception backend, which is more general and more efficient. Therefore, seeing the added complexity of maintaining the two in parallel, I see no good reason to keep the with-exceptions version now that the equivalence of their semantics have been proved. It will also be nice to reduce divergences between the different backends ; and this should make further simplifications possible (e.g. some thunkings may no longer be needed) Of course I am ready to hear arguments in favor of keeping it, be it in the mid- or long-term. This patch removes the `--avoid-exceptions` flag, making it the only option, and the corresponding `with_exceptions` variant of the dcalc->lcalc translation. It doesn't do further simplifications.
1145 lines
37 KiB
OCaml
1145 lines
37 KiB
OCaml
(* This file is part of the Catala build system, a specification language for
|
|
tax and social benefits computation rules. Copyright (C) 2020 Inria,
|
|
contributors: Denis Merigoux <denis.merigoux@inria.fr>, Emile Rolley
|
|
<emile.rolley@tuta.io>, 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. *)
|
|
|
|
open Catala_utils
|
|
open Ninja_utils
|
|
module Nj = Ninja_utils
|
|
module Scan = Clerk_scan
|
|
|
|
(* Version is synchronised with the catala version *)
|
|
let version = Catala_utils.Cli.version
|
|
|
|
(** {1 Command line interface} *)
|
|
|
|
module Cli = struct
|
|
open Cmdliner
|
|
|
|
let catala_exe =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["e"; "exe"] ~docv:"EXE" ~doc:"Catala compiler executable.")
|
|
|
|
let catala_opts =
|
|
Arg.(
|
|
value
|
|
& opt_all string []
|
|
& info ["c"; "catala-opts"] ~docv:"FLAG"
|
|
~doc:"Option to pass to the Catala compiler. Can be repeated.")
|
|
|
|
let build_dir =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["build-dir"] ~docv:"DIR"
|
|
~doc:
|
|
"Directory where compilation artifacts should be written. Defaults \
|
|
to '_build'.")
|
|
|
|
let include_dirs =
|
|
let arg =
|
|
Arg.(
|
|
value
|
|
& opt_all (list ~sep:':' string) []
|
|
& info ["I"; "include"] ~docv:"DIR"
|
|
~env:(Cmd.Env.info "CATALA_INCLUDE")
|
|
~doc:
|
|
"Make modules from the given directory available from \
|
|
everywhere. Several dirs can be specified by repeating the flag \
|
|
or separating them with '$(b,:)'.")
|
|
in
|
|
Term.(const List.flatten $ arg)
|
|
|
|
let test_flags =
|
|
Arg.(
|
|
value
|
|
& opt (list string) []
|
|
& info ["test-flags"] ~docv:"FLAGS"
|
|
~env:(Cmd.Env.info "CATALA_TEST_FLAGS")
|
|
~doc:
|
|
"Flags to pass to the catala interpreter on $(b,catala test-scope) \
|
|
tests. Comma-separated list. A subset may also be applied to the \
|
|
compilation of modules, as needed.\n\
|
|
WARNING: flag shortcuts are not allowed here (i.e. don't use \
|
|
non-ambiguous prefixes such as $(b,--closure) for \
|
|
$(b,--closure-conversion))\n\
|
|
NOTE: if this is set, all inline tests that are $(i,not) \
|
|
$(b,catala test-scope) are skipped to avoid redundant testing.")
|
|
|
|
let runtest_report =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["report"] ~docv:"FILE"
|
|
~doc:
|
|
"If set, $(i,clerk runtest) will output a tests result summary in \
|
|
binary format to the given $(b,FILE)")
|
|
|
|
let runtest_out =
|
|
Arg.(
|
|
value
|
|
& pos 1 (some string) None
|
|
& info [] ~docv:"OUTFILE"
|
|
~doc:"Write the test outcome to file $(b,OUTFILE) instead of stdout.")
|
|
|
|
module Global : sig
|
|
val color : Catala_utils.Global.when_enum Term.t
|
|
val debug : bool Term.t
|
|
|
|
val term :
|
|
(config_file:File.t option ->
|
|
catala_exe:File.t option ->
|
|
catala_opts:string list ->
|
|
build_dir:File.t option ->
|
|
include_dirs:string list ->
|
|
color:Global.when_enum ->
|
|
debug:bool ->
|
|
ninja_output:File.t option ->
|
|
'a) ->
|
|
'a Term.t
|
|
end = struct
|
|
let config_file =
|
|
Arg.(
|
|
value
|
|
& opt (some file) None
|
|
& info ["config"] ~docv:"FILE"
|
|
~doc:
|
|
"Clerk configuration file to use, instead of looking up \
|
|
\"clerk.toml\" in parent directories.")
|
|
|
|
let color =
|
|
Arg.(
|
|
value
|
|
& opt ~vopt:Global.Always Cli.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.")
|
|
|
|
let debug =
|
|
Arg.(value & flag & info ["debug"; "d"] ~doc:"Prints debug information")
|
|
|
|
let ninja_output =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["o"; "output"] ~docv:"FILE"
|
|
~doc:
|
|
"$(i,FILE) is the file that will contain the build.ninja file \
|
|
output. If not specified, the build.ninja file is set to \
|
|
$(i,<builddir>/clerk.ninja) in debug mode, and a temporary file \
|
|
otherwise")
|
|
|
|
let term f =
|
|
Term.(
|
|
const
|
|
(fun
|
|
config_file
|
|
catala_exe
|
|
catala_opts
|
|
build_dir
|
|
include_dirs
|
|
color
|
|
debug
|
|
ninja_output
|
|
->
|
|
f ~config_file ~catala_exe ~catala_opts ~build_dir ~include_dirs
|
|
~color ~debug ~ninja_output)
|
|
$ config_file
|
|
$ catala_exe
|
|
$ catala_opts
|
|
$ build_dir
|
|
$ include_dirs
|
|
$ color
|
|
$ debug
|
|
$ ninja_output)
|
|
end
|
|
|
|
let files_or_folders =
|
|
Arg.(
|
|
value
|
|
& pos_all string []
|
|
& info [] ~docv:"FILE(S)" ~doc:"File(s) or folder(s) to process")
|
|
|
|
let files =
|
|
Arg.(
|
|
value
|
|
& pos_all file []
|
|
& info [] ~docv:"FILE(S)" ~doc:"File(s) to process")
|
|
|
|
let single_file =
|
|
Arg.(
|
|
required
|
|
& pos 0 (some file) None
|
|
& info [] ~docv:"FILE" ~doc:"File to process")
|
|
|
|
let reset_test_outputs =
|
|
Arg.(
|
|
value
|
|
& flag
|
|
& info ["r"; "reset"]
|
|
~doc:
|
|
"Used with the `test` command, resets the test output to whatever \
|
|
is output by the Catala compiler.")
|
|
|
|
let scope =
|
|
Arg.(
|
|
required
|
|
& opt (some string) None
|
|
& info ["s"; "scope"] ~docv:"SCOPE"
|
|
~doc:
|
|
"Used with the `run` command, selects which scope of a given \
|
|
Catala file to run.")
|
|
|
|
let targets =
|
|
Arg.(
|
|
value
|
|
& pos_all string []
|
|
& info [] ~docv:"TARGETS"
|
|
~doc:
|
|
"Flags or targets to forward to Ninja directly (use $(b,-- \
|
|
ninja_flags) to separate Ninja flags from Clerk flags)")
|
|
|
|
let report_verbosity =
|
|
Arg.(
|
|
value
|
|
& vflag `Failures
|
|
[
|
|
( `Summary,
|
|
info ["summary"] ~doc:"Only display a summary of the test results"
|
|
);
|
|
( `Short,
|
|
info ["short"] ~doc:"Don't display detailed test failures diff" );
|
|
( `Failures,
|
|
info ["failures"]
|
|
~doc:"Show details of files with failed tests only" );
|
|
( `Verbose,
|
|
info ["verbose"; "v"]
|
|
~doc:"Display the full list of tests that have been run" );
|
|
])
|
|
|
|
let report_xml =
|
|
Arg.(
|
|
value
|
|
& flag
|
|
& info ["xml"]
|
|
~env:(Cmd.Env.info "CATALA_XML_REPORT")
|
|
~doc:"Output the test report in JUnit-compatible XML format")
|
|
|
|
let diff_command =
|
|
Arg.(
|
|
value
|
|
& opt ~vopt:(Some None) (some (some string)) None
|
|
& info ["diff"]
|
|
~env:(Cmd.Env.info "CATALA_DIFF_COMMAND")
|
|
~doc:
|
|
"Use a standard $(i,diff) command instead of the default \
|
|
side-by-side view. If no argument is supplied, the command will \
|
|
be $(b,patdiff) if available or $(b,diff) otherwise. A supplied \
|
|
argument will be used as diff command with arguments pointing to \
|
|
the reference file and the output file")
|
|
|
|
let ninja_flags =
|
|
let env =
|
|
Cmd.Env.info
|
|
~doc:
|
|
"make-compatible flags handling. Currently recognizes the -i and -j \
|
|
options and forwards them through to Ninja."
|
|
"MAKEFLAGS"
|
|
in
|
|
let makeflags =
|
|
Arg.(
|
|
value
|
|
& opt (some string) None
|
|
& info ["makeflags"] ~env ~docv:"FLAG"
|
|
~doc:
|
|
"Provides the contents of a $(i, MAKEFLAGS) variable to pass on \
|
|
to Ninja. Currently recognizes the -i and -j options.")
|
|
in
|
|
let makeflags_to_ninja_flags (makeflags : string option) =
|
|
match makeflags with
|
|
| None -> ["-k0"]
|
|
| Some makeflags ->
|
|
let ignore_rex = Re.(compile @@ word (char 'i')) in
|
|
let has_ignore = Re.execp ignore_rex makeflags in
|
|
let jobs_rex = Re.(compile @@ seq [str "-j"; group (rep digit)]) in
|
|
let number_of_jobs =
|
|
try ["-j" ^ Re.Group.get (Re.exec jobs_rex makeflags) 1]
|
|
with _ -> []
|
|
in
|
|
(if has_ignore then ["-k0"] else []) @ number_of_jobs
|
|
in
|
|
Term.(const makeflags_to_ninja_flags $ makeflags)
|
|
|
|
let info =
|
|
let doc =
|
|
"Build system for Catala, a specification language for tax and social \
|
|
benefits computation rules."
|
|
in
|
|
let man =
|
|
[
|
|
`S Manpage.s_description;
|
|
`P
|
|
"$(b,clerk) is a build system for Catala, a specification language \
|
|
for tax and social benefits computation rules";
|
|
`S Manpage.s_authors;
|
|
`P "Denis Merigoux <denis.merigoux@inria.fr>";
|
|
`P "Emile Rolley <emile.rolley@tuta.io>";
|
|
`P "Louis Gesbert <louis.gesbert@inria.fr>";
|
|
`S Manpage.s_examples;
|
|
`P "Typical usage:";
|
|
`Pre "clerk test file.catala_en";
|
|
`S Manpage.s_bugs;
|
|
`P
|
|
"Please file bug reports at \
|
|
https://github.com/CatalaLang/catala/issues";
|
|
]
|
|
in
|
|
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
|
|
Cmd.info "clerk" ~version ~doc ~exits ~man
|
|
end
|
|
|
|
(** {1 System analysis} *)
|
|
|
|
(** Some functions that poll the surrounding systems (think [./configure]) *)
|
|
module Poll = struct
|
|
(** This module is sensitive to the CWD at first use. Therefore it's expected
|
|
that [chdir] has been run beforehand to the project root. *)
|
|
let root = lazy (Sys.getcwd ())
|
|
|
|
(** Scans for a parent directory being the root of the Catala source repo *)
|
|
let catala_project_root : File.t option Lazy.t =
|
|
root
|
|
|> Lazy.map
|
|
@@ fun root ->
|
|
if File.(exists (root / "catala.opam") && exists (root / "dune-project"))
|
|
then Some root
|
|
else None
|
|
|
|
let exec_dir : File.t = Catala_utils.Cli.exec_dir
|
|
let clerk_exe : File.t Lazy.t = lazy (Unix.realpath Sys.executable_name)
|
|
|
|
let catala_exe : File.t Lazy.t =
|
|
lazy
|
|
(let f = File.(exec_dir / "catala") in
|
|
if Sys.file_exists f then Unix.realpath f
|
|
else
|
|
match catala_project_root with
|
|
| (lazy (Some root)) ->
|
|
Unix.realpath
|
|
File.(root / "_build" / "default" / "compiler" / "catala.exe")
|
|
| _ -> File.check_exec "catala")
|
|
|
|
let build_dir : dir:File.t -> unit -> File.t =
|
|
fun ~dir () ->
|
|
let d = File.clean_path dir in
|
|
File.ensure_dir d;
|
|
d
|
|
(* Note: it could be safer here to use File.(Sys.getcwd () / "_build") by
|
|
default, but Ninja treats relative and absolute paths separately so that
|
|
you wouldn't then be able to build target _build/foo.ml but would have to
|
|
write the full path every time *)
|
|
|
|
(** Locates the main [lib] directory containing the OCaml libs *)
|
|
let ocaml_libdir : File.t Lazy.t =
|
|
lazy
|
|
(try String.trim (File.process_out "opam" ["var"; "lib"])
|
|
with Failure _ -> (
|
|
try String.trim (File.process_out "ocamlc" ["-where"])
|
|
with Failure _ -> (
|
|
match File.(check_directory (exec_dir /../ "lib")) with
|
|
| Some d -> d
|
|
| None ->
|
|
Message.error
|
|
"Could not locate the OCaml library directory, make sure OCaml \
|
|
or opam is installed")))
|
|
|
|
(** Locates the directory containing the OCaml runtime to link to *)
|
|
let ocaml_runtime_dir : File.t Lazy.t =
|
|
lazy
|
|
(let d =
|
|
match Lazy.force catala_project_root with
|
|
| Some root ->
|
|
(* Relative dir when running from catala source *)
|
|
File.(
|
|
root
|
|
/ "_build"
|
|
/ "install"
|
|
/ "default"
|
|
/ "lib"
|
|
/ "catala"
|
|
/ "runtime_ocaml")
|
|
| None -> (
|
|
match
|
|
File.check_directory
|
|
File.(exec_dir /../ "lib" / "catala" / "runtime_ocaml")
|
|
with
|
|
| Some d -> d
|
|
| None -> File.(Lazy.force ocaml_libdir / "catala" / "runtime_ocaml")
|
|
)
|
|
in
|
|
match File.check_directory d with
|
|
| Some dir ->
|
|
Message.debug "Catala runtime libraries found at @{<bold>%s@}." dir;
|
|
dir
|
|
| None ->
|
|
Message.error
|
|
"@[<hov>Could not locate the Catala runtime library at %s.@ Make \
|
|
sure that either catala is correctly installed,@ or you are \
|
|
running from the root of a compiled source tree.@]"
|
|
d)
|
|
|
|
let ocaml_include_and_lib_flags : (string list * string list) Lazy.t =
|
|
lazy
|
|
(let link_libs = ["zarith"; "dates_calc"] in
|
|
let includes_libs =
|
|
List.map
|
|
(fun lib ->
|
|
match File.(check_directory (Lazy.force ocaml_libdir / lib)) with
|
|
| None ->
|
|
Message.error
|
|
"Required OCaml library not found at %a.@ Try `opam install \
|
|
%s'"
|
|
File.format
|
|
File.(Lazy.force ocaml_libdir / lib)
|
|
lib
|
|
| Some d ->
|
|
( ["-I"; d],
|
|
String.map (function '-' -> '_' | c -> c) lib ^ ".cmxa" ))
|
|
link_libs
|
|
in
|
|
let includes, libs = List.split includes_libs in
|
|
( List.concat includes @ ["-I"; Lazy.force ocaml_runtime_dir],
|
|
libs @ [File.(Lazy.force ocaml_runtime_dir / "runtime_ocaml.cmxa")] ))
|
|
|
|
let ocaml_include_flags : string list Lazy.t =
|
|
lazy (fst (Lazy.force ocaml_include_and_lib_flags))
|
|
|
|
let ocaml_link_flags : string list Lazy.t =
|
|
lazy (snd (Lazy.force ocaml_include_and_lib_flags))
|
|
end
|
|
|
|
(**{1 Building rules}*)
|
|
|
|
(** Ninja variable names *)
|
|
module Var = struct
|
|
include Nj.Var
|
|
|
|
(** Global vars: always defined, at toplevel *)
|
|
|
|
let ninja_required_version = make "ninja_required_version"
|
|
let builddir = make "builddir"
|
|
let clerk_exe = make "CLERK_EXE"
|
|
let catala_exe = make "CATALA_EXE"
|
|
let catala_flags = make "CATALA_FLAGS"
|
|
let catala_flags_ocaml = make "CATALA_FLAGS_OCAML"
|
|
let catala_flags_python = make "CATALA_FLAGS_PYTHON"
|
|
let clerk_flags = make "CLERK_FLAGS"
|
|
let ocamlc_exe = make "OCAMLC_EXE"
|
|
let ocamlopt_exe = make "OCAMLOPT_EXE"
|
|
let ocaml_flags = make "OCAML_FLAGS"
|
|
let runtime_ocaml_libs = make "RUNTIME_OCAML_LIBS"
|
|
|
|
(** Rule vars, Used in specific rules *)
|
|
|
|
let input = make "in"
|
|
let output = make "out"
|
|
let pool = make "pool"
|
|
let src = make "src"
|
|
let orig_src = make "orig-src"
|
|
let scope = make "scope"
|
|
let test_id = make "test-id"
|
|
let ( ! ) = Var.v
|
|
end
|
|
|
|
let base_bindings catala_exe catala_flags build_dir include_dirs test_flags =
|
|
let includes =
|
|
List.fold_right
|
|
(fun dir flags ->
|
|
if Filename.is_relative dir then
|
|
"-I" :: File.(Var.(!builddir) / dir) :: flags
|
|
else "-I" :: dir :: flags)
|
|
include_dirs []
|
|
in
|
|
let catala_flags = ("--directory=" ^ Var.(!builddir)) :: catala_flags in
|
|
let catala_flags_ocaml =
|
|
List.filter
|
|
(function
|
|
| "-O" | "--optimize" | "--closure-conversion" -> true | _ -> false)
|
|
test_flags
|
|
in
|
|
let catala_flags_python =
|
|
List.filter
|
|
(function
|
|
| "-O" | "--optimize" | "--closure-conversion" -> true | _ -> false)
|
|
test_flags
|
|
in
|
|
let ocaml_flags = Lazy.force Poll.ocaml_include_flags in
|
|
[
|
|
Nj.binding Var.ninja_required_version ["1.7"];
|
|
(* use of implicit outputs *)
|
|
Nj.binding Var.builddir [build_dir];
|
|
Nj.binding Var.clerk_exe [Lazy.force Poll.clerk_exe];
|
|
Nj.binding Var.catala_exe
|
|
[
|
|
(match catala_exe with
|
|
| Some e -> File.check_exec e
|
|
| None -> Lazy.force Poll.catala_exe);
|
|
];
|
|
Nj.binding Var.catala_flags (catala_flags @ includes);
|
|
Nj.binding Var.catala_flags_ocaml catala_flags_ocaml;
|
|
Nj.binding Var.catala_flags_python catala_flags_python;
|
|
Nj.binding Var.clerk_flags
|
|
("-e"
|
|
:: Var.(!catala_exe)
|
|
:: ("--test-flags=" ^ String.concat "," test_flags)
|
|
:: includes
|
|
@ List.map (fun f -> "--catala-opts=" ^ f) catala_flags);
|
|
Nj.binding Var.ocamlc_exe ["ocamlc"];
|
|
Nj.binding Var.ocamlopt_exe ["ocamlopt"];
|
|
Nj.binding Var.ocaml_flags (ocaml_flags @ includes);
|
|
Nj.binding Var.runtime_ocaml_libs (Lazy.force Poll.ocaml_link_flags);
|
|
]
|
|
|
|
let[@ocamlformat "disable"] static_base_rules =
|
|
let open Var in
|
|
let shellout l = Format.sprintf "$$(%s)" (String.concat " " l) in
|
|
[
|
|
Nj.rule "copy"
|
|
~command:["cp"; "-f"; !input; !output]
|
|
~description:["<copy>"; !input];
|
|
|
|
Nj.rule "catala-ocaml"
|
|
~command:[!catala_exe; "ocaml"; !catala_flags; !catala_flags_ocaml;
|
|
!input; "-o"; !output]
|
|
~description:["<catala>"; "ocaml"; "⇒"; !output];
|
|
|
|
Nj.rule "ocaml-object"
|
|
~command:[!ocamlc_exe; "-i"; !ocaml_flags; !input; ">"; !input^"i"; "&&";
|
|
!ocamlc_exe; "-opaque"; !ocaml_flags; !input^"i"; "&&";
|
|
!ocamlc_exe; "-c"; !ocaml_flags; !input; "&&";
|
|
!ocamlopt_exe; "-c"; "-intf-suffix"; ".ml"; !ocaml_flags; !input]
|
|
~description:["<ocaml>"; "⇒"; !output];
|
|
|
|
Nj.rule "ocaml-module"
|
|
~command:
|
|
[!ocamlopt_exe; "-shared"; !ocaml_flags; !input; "-o"; !output]
|
|
~description:["<ocaml>"; "⇒"; !output];
|
|
|
|
Nj.rule "ocaml-exec"
|
|
~command: [
|
|
!ocamlopt_exe; !ocaml_flags; !runtime_ocaml_libs;
|
|
shellout [!catala_exe; "depends";
|
|
"--prefix="^ !builddir; "--extension=cmx";
|
|
!catala_flags; !orig_src];
|
|
"-o"; !output;
|
|
]
|
|
~description:["<ocaml>"; "⇒"; !output];
|
|
|
|
Nj.rule "python"
|
|
~command:[!catala_exe; "python"; !catala_flags; !catala_flags_python;
|
|
!input; "-o"; !output]
|
|
~description:["<catala>"; "python"; "⇒"; !output];
|
|
|
|
Nj.rule "tests"
|
|
~command:
|
|
[!clerk_exe; "runtest"; !clerk_flags; !input;
|
|
"--report"; !output;]
|
|
~description:["<catala>"; "tests"; "⇐"; !input];
|
|
|
|
Nj.rule "interpret"
|
|
~command:
|
|
[!catala_exe; "interpret"; !catala_flags; !input; "--scope=" ^ !scope]
|
|
~description:["<catala>"; "interpret"; !scope; "⇐"; !input]
|
|
~vars:[pool, ["console"]];
|
|
|
|
Nj.rule "dir-tests"
|
|
~command:["cat"; !input; ">"; !output; ";"]
|
|
~description:["<test>"; !test_id];
|
|
]
|
|
|
|
let gen_build_statements
|
|
(include_dirs : string list)
|
|
(same_dir_modules : (string * File.t) list)
|
|
(item : Scan.item) : Nj.ninja =
|
|
let open File in
|
|
let ( ! ) = Var.( ! ) in
|
|
let src = item.file_name in
|
|
let modules = List.rev item.used_modules in
|
|
let modfile ext modname =
|
|
match List.assoc_opt modname same_dir_modules with
|
|
| Some f -> (!Var.builddir / Filename.remove_extension f) ^ ext
|
|
| None -> modname ^ ext
|
|
in
|
|
let inc x = !Var.builddir / x in
|
|
let modd x = modfile "@module" x in
|
|
let def_src = Nj.binding Var.src [Filename.remove_extension src] in
|
|
let srcv = !Var.src ^ Filename.extension src in
|
|
let include_deps =
|
|
Nj.build "copy" ~inputs:[srcv]
|
|
~implicit_in:(List.map inc item.included_files @ List.map modd modules)
|
|
~outputs:[inc srcv]
|
|
in
|
|
let target_file ext = (!Var.builddir / !Var.src) ^ "." ^ ext in
|
|
let module_deps =
|
|
Option.map
|
|
(fun m ->
|
|
Nj.build "phony"
|
|
~inputs:[inc srcv; target_file "cmi"; target_file "cmxs"]
|
|
~outputs:[modd m])
|
|
item.module_def
|
|
in
|
|
let ml_file = target_file "ml" in
|
|
let py_file = target_file "py" in
|
|
let ocaml, python =
|
|
if item.extrnal then
|
|
( Nj.build "copy"
|
|
~implicit_in:[inc srcv]
|
|
~inputs:[src -.- "ml"]
|
|
~outputs:[ml_file],
|
|
Nj.build "copy"
|
|
~implicit_in:[inc srcv]
|
|
~inputs:[src -.- "py"]
|
|
~outputs:[py_file] )
|
|
else
|
|
( Nj.build "catala-ocaml"
|
|
~inputs:[inc srcv]
|
|
~implicit_in:[!Var.catala_exe] ~outputs:[ml_file],
|
|
Nj.build "python"
|
|
~inputs:[inc srcv]
|
|
~implicit_in:[!Var.catala_exe] ~outputs:[py_file] )
|
|
in
|
|
let ocamlopt =
|
|
let obj =
|
|
Nj.build "ocaml-object" ~inputs:[ml_file]
|
|
~implicit_in:(!Var.catala_exe :: List.map modd modules)
|
|
~outputs:(List.map target_file ["mli"; "cmi"; "cmo"; "cmx"; "o"])
|
|
~vars:
|
|
[
|
|
( Var.ocaml_flags,
|
|
!Var.ocaml_flags
|
|
:: "-I"
|
|
:: (!Var.builddir / src /../ "")
|
|
:: List.concat_map
|
|
(fun d ->
|
|
[
|
|
"-I";
|
|
(if Filename.is_relative d then !Var.builddir / d else d);
|
|
])
|
|
include_dirs );
|
|
]
|
|
in
|
|
let modexec =
|
|
match item.module_def with
|
|
| Some _ ->
|
|
Nj.build "ocaml-module"
|
|
~inputs:[target_file "cmx"]
|
|
~outputs:[target_file "cmxs"]
|
|
| None ->
|
|
Nj.build "ocaml-exec"
|
|
~inputs:[target_file "cmx"]
|
|
~outputs:[target_file "exe"]
|
|
~vars:[Var.orig_src, [inc srcv]]
|
|
in
|
|
[obj; modexec]
|
|
in
|
|
let expose_module =
|
|
match item.module_def with
|
|
| Some m when List.mem (dirname src) include_dirs ->
|
|
Some (Nj.build "phony" ~outputs:[m ^ "@module"] ~inputs:[modd m])
|
|
| _ -> None
|
|
in
|
|
let interp_deps =
|
|
!Var.catala_exe
|
|
:: List.map
|
|
(fun m ->
|
|
match List.assoc_opt m same_dir_modules with
|
|
| Some f -> (!Var.builddir / Filename.remove_extension f) ^ ".cmxs"
|
|
| None -> m ^ "@module")
|
|
modules
|
|
in
|
|
let interpret =
|
|
Nj.build "interpret"
|
|
~outputs:[srcv ^ "@interpret"]
|
|
~inputs:[inc srcv]
|
|
~implicit_in:interp_deps
|
|
in
|
|
let legacy_test_reference test =
|
|
(src /../ "output" / Filename.basename src) -.- test.Scan.id
|
|
in
|
|
let tests =
|
|
let out_tests_references =
|
|
List.map (fun test -> legacy_test_reference test) item.legacy_tests
|
|
in
|
|
let out_tests_prepare =
|
|
List.map
|
|
(fun f -> Nj.build "copy" ~inputs:[f] ~outputs:[inc f])
|
|
out_tests_references
|
|
in
|
|
let tests =
|
|
if (not item.has_inline_tests) && item.legacy_tests = [] then []
|
|
else
|
|
[
|
|
Nj.build "tests"
|
|
~inputs:[inc srcv]
|
|
~implicit_in:
|
|
((!Var.clerk_exe :: interp_deps)
|
|
@ List.map inc out_tests_references)
|
|
~outputs:[inc srcv ^ "@test"; inc srcv ^ "@out"]
|
|
~implicit_out:
|
|
(List.map (fun o -> inc o ^ "@out") out_tests_references);
|
|
]
|
|
in
|
|
out_tests_prepare @ tests
|
|
in
|
|
Seq.concat
|
|
@@ List.to_seq
|
|
[
|
|
Seq.return (Nj.comment "");
|
|
Seq.return def_src;
|
|
Seq.return include_deps;
|
|
Option.to_seq module_deps;
|
|
Option.to_seq expose_module;
|
|
Seq.return ocaml;
|
|
List.to_seq ocamlopt;
|
|
Seq.return python;
|
|
List.to_seq tests;
|
|
Seq.return interpret;
|
|
]
|
|
|
|
let gen_build_statements_dir
|
|
(include_dirs : string list)
|
|
(items : Scan.item list) : Nj.ninja =
|
|
let same_dir_modules =
|
|
List.filter_map
|
|
(fun item ->
|
|
Option.map (fun name -> name, item.Scan.file_name) item.Scan.module_def)
|
|
items
|
|
in
|
|
Seq.flat_map
|
|
(gen_build_statements include_dirs same_dir_modules)
|
|
(List.to_seq items)
|
|
|
|
let dir_test_rules dir subdirs items =
|
|
let open File in
|
|
let inputs =
|
|
List.rev_append
|
|
(List.rev_map (fun s -> (Var.(!builddir) / s) ^ "@test") subdirs)
|
|
(List.filter_map
|
|
(fun item ->
|
|
if item.Scan.legacy_tests = [] && not item.Scan.has_inline_tests then
|
|
None
|
|
else Some ((Var.(!builddir) / item.Scan.file_name) ^ "@test"))
|
|
items)
|
|
in
|
|
List.to_seq
|
|
[
|
|
Nj.Comment "";
|
|
Nj.build "dir-tests"
|
|
~outputs:[(Var.(!builddir) / dir) ^ "@test"]
|
|
~inputs
|
|
~vars:[Var.test_id, [dir]];
|
|
]
|
|
|
|
let build_statements include_dirs dir =
|
|
Scan.tree dir
|
|
|> Seq.flat_map
|
|
@@ fun (dir, subdirs, items) ->
|
|
Seq.append
|
|
(gen_build_statements_dir include_dirs items)
|
|
(dir_test_rules dir subdirs items)
|
|
|
|
let gen_ninja_file catala_exe catala_flags build_dir include_dirs test_flags dir
|
|
=
|
|
let ( @+ ) = Seq.append in
|
|
Seq.return
|
|
(Nj.Comment (Printf.sprintf "File generated by Clerk v.%s\n" version))
|
|
@+ Seq.return (Nj.Comment "- Global variables - #\n")
|
|
@+ List.to_seq
|
|
(base_bindings catala_exe catala_flags build_dir include_dirs test_flags)
|
|
@+ Seq.return (Nj.Comment "\n- Base rules - #\n")
|
|
@+ List.to_seq static_base_rules
|
|
@+ Seq.return (Nj.build "phony" ~outputs:["always"])
|
|
@+ Seq.return (Nj.Comment "\n- Project-specific build statements - #")
|
|
@+ build_statements include_dirs dir
|
|
@+ Seq.return (Nj.build "phony" ~outputs:["test"] ~inputs:[".@test"])
|
|
|
|
(** {1 Driver} *)
|
|
|
|
(* Last argument is a continuation taking as arguments [build_dir], the
|
|
[fix_path] function, and the ninja file name *)
|
|
let ninja_init
|
|
~config_file
|
|
~catala_exe
|
|
~catala_opts
|
|
~build_dir
|
|
~include_dirs
|
|
~color
|
|
~debug
|
|
~ninja_output :
|
|
extra:def Seq.t ->
|
|
test_flags:string list ->
|
|
(File.t -> (File.t -> File.t) -> File.t -> 'a) ->
|
|
'a =
|
|
let _options = Catala_utils.Global.enforce_options ~debug ~color () in
|
|
let default_config_file = "clerk.toml" in
|
|
let set_root_dir dir =
|
|
Message.debug "Entering directory %a" File.format dir;
|
|
Sys.chdir dir
|
|
in
|
|
(* fix_path adjusts paths specified from the command-line relative to the user
|
|
cwd to be instead relative to the project root *)
|
|
let fix_path, config =
|
|
let from_dir = Sys.getcwd () in
|
|
match config_file with
|
|
| None -> (
|
|
match
|
|
File.(find_in_parents (fun dir -> exists (dir / default_config_file)))
|
|
with
|
|
| Some (root, rel) ->
|
|
set_root_dir root;
|
|
( Catala_utils.File.reverse_path ~from_dir ~to_dir:rel,
|
|
Clerk_config.read default_config_file )
|
|
| None -> (
|
|
match
|
|
File.(
|
|
find_in_parents (function dir ->
|
|
exists (dir / "catala.opam") || exists (dir / ".git")))
|
|
with
|
|
| Some (root, rel) ->
|
|
set_root_dir root;
|
|
( Catala_utils.File.reverse_path ~from_dir ~to_dir:rel,
|
|
Clerk_config.default )
|
|
| None -> Fun.id, Clerk_config.default))
|
|
| Some f ->
|
|
let root = Filename.dirname f in
|
|
let config = Clerk_config.read f in
|
|
set_root_dir root;
|
|
( (fun d ->
|
|
let r = Catala_utils.File.reverse_path ~from_dir ~to_dir:root d in
|
|
Message.debug "%a => %a" File.format d File.format r;
|
|
r),
|
|
config )
|
|
in
|
|
let build_dir =
|
|
let dir =
|
|
match build_dir with None -> config.build_dir | Some dir -> dir
|
|
in
|
|
Poll.build_dir ~dir ()
|
|
in
|
|
let catala_opts = config.catala_opts @ catala_opts in
|
|
let include_dirs = config.include_dirs @ include_dirs in
|
|
let with_ninja_output k =
|
|
match ninja_output with
|
|
| Some f -> k f
|
|
| None when debug -> k File.(build_dir / "clerk.ninja")
|
|
| None -> File.with_temp_file "clerk_build_" ".ninja" k
|
|
in
|
|
fun ~extra ~test_flags k ->
|
|
Message.debug "building ninja rules...";
|
|
let build_dir =
|
|
match test_flags with
|
|
| [] -> build_dir
|
|
| flags -> File.((build_dir / "test") ^ String.concat "" flags)
|
|
in
|
|
with_ninja_output
|
|
@@ fun nin_file ->
|
|
File.with_formatter_of_file nin_file (fun nin_ppf ->
|
|
let ninja_contents =
|
|
Seq.concat
|
|
@@ List.to_seq
|
|
[
|
|
gen_ninja_file catala_exe catala_opts build_dir include_dirs
|
|
test_flags ".";
|
|
Seq.return (Nj.comment "\n - Command-specific targets - #");
|
|
extra;
|
|
]
|
|
in
|
|
Nj.format nin_ppf ninja_contents);
|
|
k build_dir fix_path nin_file
|
|
|
|
let cleaned_up_env () =
|
|
let passthrough_vars =
|
|
["CATALA_BIN="; "CATALA_INCLUDE="; "CATALA_TEST_FLAGS="]
|
|
in
|
|
Unix.environment ()
|
|
|> Array.to_seq
|
|
|> Seq.filter (fun s ->
|
|
(not (String.starts_with ~prefix:"CATALA_" s))
|
|
|| List.exists
|
|
(fun prefix -> String.starts_with ~prefix s)
|
|
passthrough_vars
|
|
||
|
|
(Message.warning "Ignoring environment variable %s" s;
|
|
false))
|
|
|> Array.of_seq
|
|
|
|
let ninja_cmdline ninja_flags nin_file targets =
|
|
("ninja" :: "-f" :: nin_file :: ninja_flags)
|
|
@ (if Catala_utils.Global.options.debug then ["-v"] else [])
|
|
@ targets
|
|
|
|
let run_ninja ~clean_up_env cmdline =
|
|
let cmd = List.hd cmdline in
|
|
let env = if clean_up_env then cleaned_up_env () else Unix.environment () in
|
|
let npid =
|
|
Unix.create_process_env cmd (Array.of_list cmdline) env Unix.stdin
|
|
Unix.stdout Unix.stderr
|
|
in
|
|
let return_code =
|
|
match Unix.waitpid [] npid with
|
|
| _, Unix.WEXITED n -> n
|
|
| _, (Unix.WSIGNALED n | Unix.WSTOPPED n) -> 128 - n
|
|
in
|
|
return_code
|
|
|
|
open Cmdliner
|
|
|
|
let build_cmd =
|
|
let run ninja_init (targets : string list) (ninja_flags : string list) =
|
|
ninja_init ~extra:Seq.empty ~test_flags:[]
|
|
@@ fun _build_dir fix_path nin_file ->
|
|
let targets =
|
|
List.map
|
|
(fun f ->
|
|
if String.exists (function '/' | '.' -> true | _ -> false) f then
|
|
fix_path f
|
|
else f)
|
|
targets
|
|
in
|
|
let ninja_cmd = ninja_cmdline ninja_flags nin_file targets in
|
|
Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
|
|
raise (Catala_utils.Cli.Exit_with (run_ninja ~clean_up_env:false ninja_cmd))
|
|
in
|
|
let doc =
|
|
"Low-level build command: can be used to forward build targets or options \
|
|
directly to Ninja"
|
|
in
|
|
Cmd.v (Cmd.info ~doc "build")
|
|
Term.(
|
|
const run $ Cli.Global.term ninja_init $ Cli.targets $ Cli.ninja_flags)
|
|
|
|
let set_report_verbosity = function
|
|
| `Summary -> Clerk_report.set_display_flags ~files:`None ~tests:`None ()
|
|
| `Short ->
|
|
Clerk_report.set_display_flags ~files:`Failed ~tests:`Failed ~diffs:false ()
|
|
| `Failures ->
|
|
if Global.options.debug then Clerk_report.set_display_flags ~files:`All ()
|
|
| `Verbose -> Clerk_report.set_display_flags ~files:`All ~tests:`All ()
|
|
|
|
let test_cmd =
|
|
let run
|
|
ninja_init
|
|
(files_or_folders : string list)
|
|
(reset_test_outputs : bool)
|
|
(test_flags : string list)
|
|
verbosity
|
|
xml
|
|
(diff_command : string option option)
|
|
(ninja_flags : string list) =
|
|
set_report_verbosity verbosity;
|
|
Clerk_report.set_display_flags ~diff_command ();
|
|
ninja_init ~extra:Seq.empty ~test_flags
|
|
@@ fun build_dir fix_path nin_file ->
|
|
let targets =
|
|
let fs = if files_or_folders = [] then ["."] else files_or_folders in
|
|
List.map File.(fun f -> (build_dir / fix_path f) ^ "@test") fs
|
|
in
|
|
let ninja_cmd = ninja_cmdline ninja_flags nin_file targets in
|
|
Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
|
|
match run_ninja ~clean_up_env:true ninja_cmd with
|
|
| 0 ->
|
|
Message.debug "gathering test results...";
|
|
let open Clerk_report in
|
|
let reports = List.flatten (List.map read_many targets) in
|
|
if reset_test_outputs then
|
|
let () =
|
|
if xml then
|
|
Message.error
|
|
"Options @{<bold>--xml@} and @{<bold>--reset@} are incompatible";
|
|
let ppf = Message.formatter_of_out_channel stdout () in
|
|
match List.filter (fun f -> f.successful < f.total) reports with
|
|
| [] ->
|
|
Format.fprintf ppf
|
|
"[@{<green>DONE@}] All tests passed, nothing to reset@."
|
|
| need_reset ->
|
|
List.iter
|
|
(fun f ->
|
|
let files =
|
|
List.fold_left
|
|
(fun files t ->
|
|
if t.success then files
|
|
else
|
|
File.Map.add (fst t.result).Lexing.pos_fname
|
|
(String.remove_prefix
|
|
~prefix:File.(build_dir / "")
|
|
(fst t.expected).Lexing.pos_fname)
|
|
files)
|
|
File.Map.empty f.tests
|
|
in
|
|
File.Map.iter
|
|
(fun result expected ->
|
|
Format.kasprintf Sys.command "cp -f %a %a@." File.format
|
|
result File.format expected
|
|
|> ignore)
|
|
files)
|
|
need_reset;
|
|
Format.fprintf ppf
|
|
"[@{<green>DONE@}] @{<yellow;bold>%d@} test files were \
|
|
@{<yellow>RESET@}@."
|
|
(List.length need_reset)
|
|
in
|
|
raise (Catala_utils.Cli.Exit_with 0)
|
|
else if (if xml then print_xml else summary) ~build_dir reports then
|
|
raise (Catala_utils.Cli.Exit_with 0)
|
|
else raise (Catala_utils.Cli.Exit_with 1)
|
|
| 1 -> raise (Catala_utils.Cli.Exit_with 10) (* Ninja build failed *)
|
|
| err -> raise (Catala_utils.Cli.Exit_with err)
|
|
(* Other Ninja error ? *)
|
|
in
|
|
let doc =
|
|
"Scan the given files or directories for catala tests, build their \
|
|
requirement and run them all. With $(b,--reset) the expected results are \
|
|
updated in-place ; otherwise, 0 is returned if the output matches the \
|
|
reference, or 1 is returned and a diff is printed to stdout"
|
|
in
|
|
Cmd.v (Cmd.info ~doc "test")
|
|
Term.(
|
|
const run
|
|
$ Cli.Global.term ninja_init
|
|
$ Cli.files_or_folders
|
|
$ Cli.reset_test_outputs
|
|
$ Cli.test_flags
|
|
$ Cli.report_verbosity
|
|
$ Cli.report_xml
|
|
$ Cli.diff_command
|
|
$ Cli.ninja_flags)
|
|
|
|
let run_cmd =
|
|
let run
|
|
ninja_init
|
|
(files_or_folders : string list)
|
|
(scope : string)
|
|
(ninja_flags : string list) =
|
|
let extra =
|
|
Seq.cons
|
|
(Nj.binding Var.scope [scope])
|
|
(Seq.return
|
|
(Nj.default
|
|
(List.map (fun file -> file ^ "@interpret") files_or_folders)))
|
|
in
|
|
ninja_init ~extra ~test_flags:[]
|
|
@@ fun _build_dir _fix_path nin_file ->
|
|
let ninja_cmd = ninja_cmdline ninja_flags nin_file [] in
|
|
Message.debug "executing '%s'..." (String.concat " " ninja_cmd);
|
|
raise (Catala_utils.Cli.Exit_with (run_ninja ~clean_up_env:false ninja_cmd))
|
|
in
|
|
let doc =
|
|
"Runs the Catala interpreter on the given files, after building their \
|
|
dependencies. The scope to be executed must be specified using the \
|
|
$(i,-s) option."
|
|
in
|
|
Cmd.v (Cmd.info ~doc "run")
|
|
Term.(
|
|
const run
|
|
$ Cli.Global.term ninja_init
|
|
$ Cli.files_or_folders
|
|
$ Cli.scope
|
|
$ Cli.ninja_flags)
|
|
|
|
let runtest_cmd =
|
|
let run catala_exe catala_opts include_dirs test_flags report out file =
|
|
let catala_opts =
|
|
List.fold_left
|
|
(fun opts dir -> "-I" :: dir :: opts)
|
|
catala_opts include_dirs
|
|
in
|
|
Clerk_runtest.run_tests
|
|
~catala_exe:(Option.value ~default:"catala" catala_exe)
|
|
~catala_opts ~test_flags ~report ~out file;
|
|
0
|
|
in
|
|
let doc =
|
|
"Mainly for internal purposes. Runs inline tests from a Catala file, and \
|
|
outputs their results to stdout"
|
|
in
|
|
Cmd.v (Cmd.info ~doc "runtest")
|
|
Term.(
|
|
const run
|
|
$ Cli.catala_exe
|
|
$ Cli.catala_opts
|
|
$ Cli.include_dirs
|
|
$ Cli.test_flags
|
|
$ Cli.runtest_report
|
|
$ Cli.runtest_out
|
|
$ Cli.single_file)
|
|
|
|
let report_cmd =
|
|
let run color debug verbosity xml diff_command build_dir files =
|
|
let _options = Catala_utils.Global.enforce_options ~debug ~color () in
|
|
let build_dir = Option.value ~default:"_build" build_dir in
|
|
set_report_verbosity verbosity;
|
|
Clerk_report.set_display_flags ~diff_command ();
|
|
let open Clerk_report in
|
|
let tests = List.flatten (List.map read_many files) in
|
|
let success = (if xml then print_xml else summary) ~build_dir tests in
|
|
exit (if success then 0 else 1)
|
|
in
|
|
let doc =
|
|
"Mainly for internal purposes. Reads a test report file and displays a \
|
|
summary of the results, returning 0 on success and 1 if any test failed."
|
|
in
|
|
Cmd.v (Cmd.info ~doc "report")
|
|
Term.(
|
|
const run
|
|
$ Cli.Global.color
|
|
$ Cli.Global.debug
|
|
$ Cli.report_verbosity
|
|
$ Cli.report_xml
|
|
$ Cli.diff_command
|
|
$ Cli.build_dir
|
|
$ Cli.files)
|
|
|
|
let main_cmd =
|
|
Cmd.group Cli.info [build_cmd; test_cmd; run_cmd; runtest_cmd; report_cmd]
|
|
|
|
let main () =
|
|
try exit (Cmdliner.Cmd.eval' ~catch:false main_cmd) with
|
|
| Catala_utils.Cli.Exit_with n -> exit n
|
|
| Message.CompilerError content ->
|
|
let bt = Printexc.get_raw_backtrace () in
|
|
Message.Content.emit content Error;
|
|
if Catala_utils.Global.options.debug then
|
|
Printexc.print_raw_backtrace stderr bt;
|
|
exit Cmd.Exit.some_error
|
|
| Sys_error msg ->
|
|
let bt = Printexc.get_raw_backtrace () in
|
|
Message.Content.emit
|
|
(Message.Content.of_string ("System error: " ^ msg))
|
|
Error;
|
|
if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
|
|
exit Cmd.Exit.internal_error
|
|
| e ->
|
|
let bt = Printexc.get_raw_backtrace () in
|
|
Message.Content.emit
|
|
(Message.Content.of_string ("Unexpected error: " ^ Printexc.to_string e))
|
|
Error;
|
|
if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
|
|
exit Cmd.Exit.internal_error
|