CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-09-19 00:15:39 +03:00
Code Issues Projects Releases Wiki Activity

Clerk: better handling of transitive dependencies

Browse Source 
We need a concrete intermediate target for e.g. transitive uses of `> Include`
for Ninja to correctly handle them.

Of course we could also unroll all transitive dependencies, but meh.

Note also that now tests now just generate the outputs but facilities for
diffing and resetting are temporarily absent.
This commit is contained in:
Louis Gesbert 2023-09-24 11:25:34 +02:00
parent dbe0990163
commit cc7066e9a8
9 changed files with 100 additions and 188 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

254
build_system/clerk_driver.ml
View File

@ -40,6 +40,13 @@ module Cli = struct
& info ["c"; "catala-opts"] ~docv:"FLAG"
~doc:"Option to pass to the Catala compiler. Can be repeated.")
let build_dir =
Arg.(
value
& opt string "_build"
& info ["build-dir"] ~docv:"DIR"
~doc:"Directory where compilation artifacts should be written")
module Global : sig
val term :
(chdir:File.t option ->
@ -460,7 +467,6 @@ module Var = struct
let ninja_required_version = make "ninja_required_version"
let builddir = make "builddir"
let default = make "default"
let clerk_exe = make "CLERK_EXE"
let catala_exe = make "CATALA_EXE"
let catala_flags = make "CATALA_FLAGS"
@ -469,19 +475,12 @@ module Var = struct
let ocamlopt_flags = make "OCAMLOPT_FLAGS"
let runtime_ocaml_libs = make "RUNTIME_OCAML_LIBS"
let diff = make "DIFF"
let module_dir module_name = make ("module_dir_" ^ module_name)
(** Source file of a given Catala module *)
let module_src module_name = make ("module_src_" ^ module_name)
(** Rule vars, Used in specific rules *)
let input = make "in"
let output = make "out"
let pool = make "pool"
let modules_src = make "modules_src"
let modules_use = make "modules_use"
let include_flags = make "include_flags"
let scope = make "scope"
let test_id = make "test-id"
let test_out = make "test-out"
@ -501,8 +500,7 @@ let base_bindings catala_exe catala_flags =
| Some e -> e
| None -> Lazy.force Poll.catala_exe);
];
Nj.binding Var.catala_flags
("--build-dir" :: Var.(!builddir) :: catala_flags);
Nj.binding Var.catala_flags catala_flags;
Nj.binding Var.clerk_flags
("-e"
:: Var.(!catala_exe)
@ -516,13 +514,16 @@ let base_bindings catala_exe catala_flags =
let static_base_rules =
let open Var in
[
Nj.rule "stamp"
~command:[ "touch"; !output ]
~description:["<stamp>"; !input ];
Nj.rule "ocaml"
~command:
[
!catala_exe;
"ocaml";
!catala_flags;
!modules_src;
!input;
"-o";
!output;
@ -533,7 +534,6 @@ let static_base_rules =
[
!ocamlopt_exe;
"-shared";
!include_flags;
!ocamlopt_flags;
!input;
"-o";
@ -558,23 +558,6 @@ let static_base_rules =
!test_command;
!catala_flags;
!input;
!modules_use;
"2>&1";
"|";
!diff;
!test_out;
"/dev/stdin";
]
~description:
["<catala>"; "test"; !test_id; "⇐"; !input; "(" ^ !test_command ^ ")"];
Nj.rule "out-reset"
~command:
[
!catala_exe;
!test_command;
!catala_flags;
!input;
!modules_use;
">";
!output;
"2>&1";
@ -582,176 +565,120 @@ let static_base_rules =
"true";
]
~description:
["<catala>"; "reset"; !test_id; "⇐"; !input; "(" ^ !test_command ^ ")"];
["<catala>"; "test"; !test_id; "⇐"; !input; "(" ^ !test_command ^ ")"];
Nj.rule "inline-tests"
~command:
[
!clerk_exe;
"runtest";
!clerk_flags;
"--catala-opts=--build-dir=" ^ !builddir;
"--build-dir=" ^ !builddir;
!input;
!modules_use;
">"; !output;
"2>&1";
"|";
!diff;
!input;
"/dev/stdin";
]
~description:["<catala>"; "inline-tests"; "⇐"; !input];
Nj.rule "inline-reset"
~command:
[
!clerk_exe;
"runtest";
!clerk_flags;
"--catala-opts=--build-dir=" ^ !builddir;
!input;
!modules_use;
"--reset";
]
~description:["<catala>"; "inline-reset"; "⇐"; !input];
Nj.rule "interpret"
~command:
[
!catala_exe;
"interpret";
!catala_flags;
"--build-dir=" ^ !builddir;
!input;
!modules_use;
"--scope=" ^ !scope;
]
~description:["<catala>"; "interpret"; !scope; "⇐"; !input]
~vars:[pool, ["console"]];
]
let gen_module_def (item : catala_build_item) : Nj.ninja =
match item.module_def with
| None -> Seq.empty
| Some modname ->
List.to_seq
[
Nj.binding (Var.module_dir modname) [Filename.dirname item.file_name];
Nj.binding (Var.module_src modname) [Filename.basename item.file_name];
]
let gen_build_statements (item : catala_build_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 header = Nj.comment ("\nDefinitions from " ^ src) in
let inc x = File.(!Var.builddir / x ^ "@inc") in
let modd x = File.(!Var.builddir / src /../ x ^ "@mod") in
let include_deps =
Nj.build "stamp"
~inputs:(src ::
List.map inc item.included_files @
List.map modd modules)
~outputs:[inc src]
in
let module_deps =
Option.map (fun m ->
Nj.build "phony"
~inputs:[inc src]
~outputs:[modd m]
) item.module_def
in
let ml_file =
match item.module_def with
| Some m ->
!Var.builddir / src /../ m ^ ".ml"
| None ->
!Var.builddir / src -.- "ml"
in
let ocaml =
Nj.build "ocaml" ~inputs:[src]
~implicit_in:
((if modules = [] then [] else [!Var.modules_src]) @ item.included_files)
~outputs:[(!Var.builddir / src) -.- "ml"]
~vars:
(if modules = [] then []
else
[
( Var.modules_src,
List.map
(fun m -> !(Var.module_dir m) / !(Var.module_src m))
modules );
])
~implicit_in:[inc src]
~outputs:[ml_file]
in
let ocamlopt =
let target ext =
match item.module_def with
| Some m -> (!Var.builddir / src /../ m) ^ "." ^ ext
| None -> (!Var.builddir / src) -.- ext
in
let implicit_out =
[target "cmi"; target "cmx" (* target "cmt"; target "o" *)]
in
let vars =
[Var.include_flags, ["-I"; !Var.builddir / Filename.dirname src]]
in
let implicit_out_exts = ["cmi"; "cmx"; (* "cmt"; "o" *)] in
match item.module_def with
| Some _ ->
| Some m ->
let target ext = !Var.builddir / src /../ m ^ "." ^ ext in
Nj.build "ocaml-module"
~inputs:[(!Var.builddir / src) -.- "ml"]
~implicit_in:(List.map (fun m -> (src /../ m) ^ ".cmi") modules)
~inputs:[ml_file]
~implicit_in:(List.map (fun m -> !Var.builddir / src /../ m ^ ".cmi") modules)
~outputs:[target "cmxs"]
~implicit_out ~vars
~implicit_out:(List.map target implicit_out_exts)
~vars:[Var.ocamlopt_flags,
[ !Var.ocamlopt_flags; "-I" ; File.(!Var.builddir / src /../ "") ]]
| None ->
let target ext = !Var.builddir / src -.- ext in
let inputs =
List.map (fun m -> (!Var.builddir / src /../ m) ^ ".cmx") modules
@ [(!Var.builddir / src) -.- "ml"]
List.map (fun m -> !Var.builddir / src /../ m ^ ".cmx") modules
@ [ml_file]
in
Nj.build "ocaml-exec" ~inputs ~outputs:[target "exe"] ~implicit_out ~vars
Nj.build "ocaml-exec" ~inputs ~outputs:[target "exe"]
~implicit_out:(List.map target implicit_out_exts)
in
let interpret_deps =
Nj.build "phony"
~outputs:["interpret-deps@" ^ src]
~inputs:
(item.included_files
@ List.map (fun m -> !(Var.module_dir m) / !(Var.module_src m)) modules
@ List.map
(fun m -> (!Var.builddir / !(Var.module_dir m) / m) ^ ".cmxs")
modules)
let interp_deps =
inc src :: List.map (fun m -> !Var.builddir /src /../ m ^ ".cmxs") modules
in
let interpret =
Nj.build "interpret"
~outputs:["interpret@" ^ src]
~inputs:[src]
~implicit_in:["interpret-deps@" ^ src]
~vars:
(if item.used_modules = [] then []
else
[
( Var.modules_use,
List.map
(fun m ->
"--use=" ^ (!(Var.module_dir m) / !(Var.module_src m)))
item.used_modules );
])
~implicit_in:interp_deps
in
let tests =
let inputs = [src] in
let implicit_in = ["interpret-deps@" ^ src] in
let vars =
if item.used_modules = [] then []
else
[
( Var.modules_use,
List.map
(fun m ->
"--catala-opts=--use="
^ (!(Var.module_dir m) / !(Var.module_src m)))
item.used_modules );
]
in
let legacy_tests =
List.fold_left
(fun acc test ->
let vars =
vars
@ [
Var.test_id, [test.id];
Var.test_command, test.cmd;
( Var.test_out,
[(src /../ "output" / Filename.basename src) -.- test.id] );
]
in
Nj.build "out-test" ~inputs ~implicit_in
~outputs:["outtest@" ^ src ^ "@" ^ test.id]
~vars
:: Nj.build "out-reset" ~inputs ~implicit_in ~outputs:[!Var.test_out]
~implicit_out:["outtest-reset@" ^ src ^ "@" ^ test.id]
~vars
:: acc)
let vars = [
Var.test_id, [test.id];
Var.test_command, test.cmd;
( Var.test_out,
[] );
]
in
Nj.build "out-test" ~inputs:[src] ~implicit_in:interp_deps
~outputs:[!Var.builddir / src /../ "output" / Filename.basename src -.- test.id]
~vars
:: acc)
[] item.legacy_tests
in
let inline_tests =
if not item.has_inline_tests then []
else
[
Nj.build "inline-tests" ~inputs ~implicit_in ~vars
~outputs:["inline@" ^ src];
Nj.build "inline-reset" ~inputs ~implicit_in ~vars
~outputs:["inline-reset@" ^ src];
Nj.build "inline-tests" ~inputs:[src] ~implicit_in:interp_deps
~outputs:[!Var.builddir / src];
]
in
let tests =
@ -761,19 +688,11 @@ let gen_build_statements (item : catala_build_item) : Nj.ninja =
Nj.build "phony"
~outputs:["test@" ^ src]
~inputs:
((if item.has_inline_tests then ["inline@" ^ item.file_name]
else [])
@ List.map
(fun test -> "outtest@" ^ item.file_name ^ "@" ^ test.id)
item.legacy_tests);
Nj.build "phony"
~outputs:["test-reset@" ^ src]
~inputs:
((if item.has_inline_tests then ["inline-reset@" ^ item.file_name]
((if item.has_inline_tests then [!Var.builddir / item.file_name]
else [])
@ List.map
(fun test ->
"outtest-reset@" ^ item.file_name ^ "@" ^ test.id)
!Var.builddir / src /../ "output" / Filename.basename src -.- test.id)
item.legacy_tests);
]
in
@ -783,9 +702,10 @@ let gen_build_statements (item : catala_build_item) : Nj.ninja =
@@ List.to_seq
[
Seq.return header;
Seq.return include_deps;
Option.to_seq module_deps;
Seq.return ocaml;
Seq.return ocamlopt;
Seq.return interpret_deps;
List.to_seq tests;
Seq.return interpret;
]
@ -846,7 +766,6 @@ let build_statements dir =
Seq.concat
@@ List.to_seq
[
Seq.flat_map gen_module_def items;
Seq.flat_map gen_build_statements items;
Seq.return (Nj.comment "\n- Global targets - #\n");
test_targets_by_dir items;
@ -863,27 +782,6 @@ let gen_ninja_file catala_exe catala_flags dir =
@+ Seq.return (Nj.Comment "- Project-specific build statements - #")
@+ build_statements dir
(**{1 Running}*)
let run_file
(file : string)
(catala_exe : string)
(catala_opts : string)
(scope : string) : int =
let command =
String.concat " "
(List.filter
(fun s -> s <> "")
[catala_exe; "Interpret"; file; catala_opts; "-s " ^ scope])
in
Message.emit_debug "Running: %s" command;
Sys.command command
(** {1 Return code values} *)
let return_ok = 0
let return_err = 1
(** {1 Driver} *)
let ninja_init ~chdir ~catala_exe ~catala_opts ~color ~debug ~ninja_output :
@ -1002,9 +900,10 @@ let run_cmd =
$ Cli.ninja_flags)
let runtest_cmd =
let run catala_exe catala_opts reset file =
let run catala_exe build_dir catala_opts reset file =
Clerk_runtest.run_inline_tests file ~reset
(Option.value ~default:"catala" catala_exe)
build_dir
catala_opts;
0
in
@ -1016,6 +915,7 @@ let runtest_cmd =
Term.(
const run
$ Cli.catala_exe
$ Cli.build_dir
$ Cli.catala_opts
$ Cli.reset_test_outputs
$ Cli.single_file)

2
build_system/clerk_runtest.ml
View File

@ -180,6 +180,7 @@ let run_inline_tests
~(reset : bool)
(file : string)
(catala_exe : string)
(build_dir : File.t)
(catala_opts : string list) =
let _, file = checkfile [] file in
match scan_for_inline_tests file with
@ -220,6 +221,7 @@ let run_inline_tests
|> Seq.cons "CATALA_OUT=-"
|> Seq.cons "CATALA_COLOR=never"
|> Seq.cons "CATALA_PLUGINS="
|> Seq.cons ("CATALA_BUILD_DIR="^build_dir)
|> Array.of_seq
in
let pid =

2
build_system/clerk_runtest.mli
View File

@ -24,7 +24,7 @@ val has_inline_tests : string -> bool
(** Checks if the given named file contains inline tests (either directly or
through includes) *)
val run_inline_tests : reset:bool -> string -> string -> string list -> unit
val run_inline_tests : reset:bool -> string -> string -> string -> string list -> unit
(** [run_inline_tests ~reset file catala_exe catala_opts] runs the tests in
Catala [file] using the given path to the Catala executable and the provided
options. Output is printed to [stdout] if [reset] is false, otherwise [file]

4
compiler/catala_utils/file.ml
View File

@ -130,7 +130,7 @@ let ( -.- ) file ext = Filename.chop_extension file ^ "." ^ ext
let path_to_list path =
String.split_on_char Filename.dir_sep.[0] path
|> List.filter (fun d -> d <> "")
|> List.filter (function "" | "." -> false | _ -> true)
let equal a b =
String.equal (String.lowercase_ascii a) (String.lowercase_ascii b)
@ -214,4 +214,6 @@ module Tree = struct
| Some (_, D _) | None -> None
with Not_found -> None
let union t1 t2 = lazy (Map.union (fun _ x _ -> Some x) (Lazy.force t1) (Lazy.force t2))
end

3
compiler/catala_utils/file.mli
View File

@ -141,4 +141,7 @@ module Tree: sig
val lookup: t -> path -> path option
(** Checks if there is a matching plain file (case-insensitively) ; and returns its path with the correct case if so *)
val union: t -> t -> t
(** Merges two trees. In case of conflict, lhs entry wins *)
end

2
compiler/catala_web_interpreter.ml
View File

@ -23,7 +23,7 @@ let () =
~language:(Some language) ~debug:false ~color:Never ~trace ()
in
let prg, ctx, _type_order =
Passes.dcalc options ~includes:File.Tree.empty ~optimize:false
Passes.dcalc options ~includes:Catala_utils.File.Tree.empty ~optimize:false
~check_invariants:false
in
Shared_ast.Interpreter.interpret_program_dcalc prg

11
compiler/driver.ml
View File

@ -50,8 +50,11 @@ let load_module_interfaces includes program =
let find_module req_chain m =
let fname_base = ModuleName.to_string m in
let required_from_file = Pos.get_file (ModuleName.pos m) in
let includes =
File.Tree.union includes
(File.Tree.build (File.dirname required_from_file))
in
match
Option.to_list (File.check_file File.(required_from_file /../ fname_base)) @
List.filter_map
(fun (ext, _) ->
File.Tree.lookup includes (fname_base ^ ext))
@ -360,9 +363,9 @@ module Commands = struct
let include_flags =
let mk dirs =
lazy (dirs
|> List.map (fun d -> Lazy.force (File.Tree.build d))
|> List.fold_left (File.Map.union (fun _ x _ -> Some x)) File.Map.empty)
dirs
|> List.map (fun d -> File.Tree.build d)
|> List.fold_left File.Tree.union File.Tree.empty
in
Term.(const mk $ Cli.Flags.include_dirs)

5
compiler/plugins/explain.ml
View File

@ -1385,12 +1385,12 @@ let options =
$ Cli.Flags.output
$ base_src_url)
let run includes optimize ex_scope explain_options global_options =
let run includes build_dirs optimize ex_scope explain_options global_options =
let prg, ctx, _ =
Driver.Passes.dcalc global_options ~includes ~optimize
~check_invariants:false
in
Interpreter.load_runtime_modules ~includes prg;
Interpreter.load_runtime_modules ~build_dirs prg;
let scope = Driver.Commands.get_scope_uid ctx ex_scope in
(* let result_expr, env = interpret_program prg scope in *)
let g, base_vars, env = program_to_graph explain_options prg scope in
@ -1437,6 +1437,7 @@ let term =
let open Cmdliner.Term in
const run
$ Driver.Commands.include_flags
$ Cli.Flags.build_dirs
$ Cli.Flags.optimize
$ Cli.Flags.ex_scope
$ options

5
compiler/plugins/lazy_interp.ml
View File

@ -257,11 +257,11 @@ let interpret_program (prg : ('dcalc, 'm) gexpr program) (scope : ScopeName.t) :
(* -- Plugin registration -- *)
let run includes optimize check_invariants ex_scope options =
let run includes build_dirs optimize check_invariants ex_scope options =
let prg, ctx, _ =
Driver.Passes.dcalc options ~includes ~optimize ~check_invariants
in
Interpreter.load_runtime_modules ~includes prg;
Interpreter.load_runtime_modules ~build_dirs prg;
let scope = Driver.Commands.get_scope_uid ctx ex_scope in
let result_expr, _env = interpret_program prg scope in
let fmt = Format.std_formatter in
@ -271,6 +271,7 @@ let term =
let open Cmdliner.Term in
const run
$ Driver.Commands.include_flags
$ Cli.Flags.build_dirs
$ Cli.Flags.optimize
$ Cli.Flags.check_invariants
$ Cli.Flags.ex_scope