From 3b3201ae38070cdcd32e50d8ff8eea0722c7433c Mon Sep 17 00:00:00 2001 From: Fred Hebert Date: Thu, 30 Jan 2020 23:12:55 -0500 Subject: [PATCH] Split up the compiler DAG This is another tricky commit towards replacing the current module analysis with EPP. The compiler DAG is now being shared across multiple applications being compiled, rather than a per-application basis, which promises to allow better ordering, parallelism, and more thorough invalidation of runtime dependencies when they are modified. This however required changes: - The compiler DAG is no longer private to `rebar_compiler`, and has been extracted to the `rebar_compiler_dag` module - The compiler DAG is now started by the `rebar_prv_compile` module, which oversees the calls to `rebar_compiler` for each OTP application - The compiler DAG has been refactored to use a "dirty flag" to know if it was modified, rather than just tracking modifications in a functional manner, since the scope change (going multi-app) makes it impossible to cleanly use the functional approach without much larger changes - The DAG used to be cached within each OTP application. This is no longer possible since it is shared. Instead the DAG is stored in the state's deps_dir, which allows to cleanly split caches between regular apps for the user's project and plugins - The DAG supported a "label" mode that was used to store distinct DAGs for extra_src_dir runs and regular modules; this label is now used (and extended to `rebar_prv_compile` internals) to distinguish between "compile runs", such as "project_apps", or just "apps" (deps). The label is optional (i.e. not used by plugins which have no such need) - The extra_src_dirs for each app is now compiled using the main app's DAG, but the run takes place later in the compilation process. This may need changing to detect and prevent dependencies from src_dirs into extra_src_dirs, but this should not technically be a problem for runtime anyway. - Reworked the support for extra_src_dirs that are at the root of an umbrella project (and therefore do not belong to any single app) to use the new structure, also as part of the project_apps DAG. All tests keep passing, and this puts us in a better place to use EPP with cross-app support in the near-future. --- src/rebar_compiler.erl | 257 ++++++++----------------------------- src/rebar_compiler_dag.erl | 221 +++++++++++++++++++++++++++++++ src/rebar_prv_compile.erl | 104 ++++++++++----- 3 files changed, 344 insertions(+), 238 deletions(-) create mode 100644 src/rebar_compiler_dag.erl diff --git a/src/rebar_compiler.erl b/src/rebar_compiler.erl index 655facc9a..dd21b8bab 100644 --- a/src/rebar_compiler.erl +++ b/src/rebar_compiler.erl @@ -30,18 +30,35 @@ ok | {ok, [string()]} | {ok, [string()], [string()]}. -callback clean([file:filename()], rebar_app_info:t()) -> _. --define(DAG_VSN, 2). --define(DAG_ROOT, "source"). --define(DAG_EXT, ".dag"). --type dag_v() :: {digraph:vertex(), term()} | 'false'. --type dag_e() :: {digraph:vertex(), digraph:vertex()}. --type dag() :: {list(dag_v()), list(dag_e()), list(string())}. --record(dag, {vsn = ?DAG_VSN :: pos_integer(), - info = {[], [], []} :: dag()}). -define(RE_PREFIX, "^(?!\\._)"). -compile_all(Compilers, AppInfo) -> +-spec compile_all([{module(), digraph:graph()}, ...], rebar_app_info:t()) -> ok + ; ([module(), ...], rebar_app_info:t()) -> ok. +compile_all(DAGs, AppInfo) when is_tuple(hd(DAGs)) -> % > 3.13.0 + prepare_compiler_env(AppInfo), + lists:foreach(fun({Compiler, G}) -> + run(G, Compiler, AppInfo), + %% TODO: disable default recursivity in extra_src_dirs compiling to + %% prevent compiling sample modules in _SUITE_data/ directories + %% in CT. + ExtraApps = annotate_extras(AppInfo), + [run(G, Compiler, ExtraAppInfo) || ExtraAppInfo <- ExtraApps], + ok + end, + DAGs); +compile_all(Compilers, AppInfo) -> % =< 3.13.0 interface; plugins use this! + %% Support the old-style API by re-declaring a local DAG for the + %% compile steps needed. + lists:foreach(fun(Compiler) -> + OutDir = rebar_app_info:out_dir(AppInfo), + G = rebar_compiler_dag:init(OutDir, Compiler, undefined, []), + compile_all([{Compiler, G}], AppInfo), + rebar_compiler_dag:maybe_store(G, OutDir, Compiler, undefined, []), + rebar_compiler_dag:terminate(G) + end, Compilers). + +prepare_compiler_env(AppInfo) -> EbinDir = rebar_utils:to_list(rebar_app_info:ebin_dir(AppInfo)), %% Make sure that outdir is on the path ok = rebar_file_utils:ensure_dir(EbinDir), @@ -51,15 +68,9 @@ compile_all(Compilers, AppInfo) -> %% called here for clarity as it's required by both opts_changed/2 %% and erl_compiler_opts_set/0 in needed_files _ = code:ensure_loaded(compile), - - lists:foreach(fun(CompilerMod) -> - run(CompilerMod, AppInfo, undefined), - run_on_extra_src_dirs(CompilerMod, AppInfo, - fun(Mod, App) -> run(Mod, App, "extra") end) - end, Compilers), ok. -run(CompilerMod, AppInfo, Label) -> +run(G, CompilerMod, AppInfo) -> #{src_dirs := SrcDirs, include_dirs := InclDirs, src_ext := SrcExt, @@ -72,12 +83,14 @@ run(CompilerMod, AppInfo, Label) -> AbsInclDirs = [filename:join(BaseDir, InclDir) || InclDir <- InclDirs], FoundFiles = find_source_files(BaseDir, SrcExt, SrcDirs, BaseOpts), - OutDir = rebar_app_info:out_dir(AppInfo), AbsSrcDirs = [filename:join(BaseDir, SrcDir) || SrcDir <- SrcDirs], - G = init_dag(CompilerMod, AbsInclDirs, AbsSrcDirs, FoundFiles, OutDir, EbinDir, Label), - {{FirstFiles, FirstFileOpts}, {RestFiles, Opts}} = CompilerMod:needed_files(G, FoundFiles, - Mappings, AppInfo), - true = digraph:delete(G), + + InDirs = lists:usort(AbsInclDirs ++ AbsSrcDirs), + + rebar_compiler_dag:prune(G, AbsSrcDirs, EbinDir, FoundFiles), + rebar_compiler_dag:update(G, CompilerMod, InDirs, FoundFiles), + {{FirstFiles, FirstFileOpts}, + {RestFiles, Opts}} = CompilerMod:needed_files(G, FoundFiles, Mappings, AppInfo), compile_each(FirstFiles, FirstFileOpts, BaseOpts, Mappings, CompilerMod), case RestFiles of @@ -167,20 +180,19 @@ compile_queue(Targets, Pids, Opts, Config, Outs, CompilerMod) -> clean(Compilers, AppInfo) -> lists:foreach(fun(CompilerMod) -> clean_(CompilerMod, AppInfo, undefined), - run_on_extra_src_dirs(CompilerMod, AppInfo, - fun(Mod, App) -> clean_(Mod, App, "extra") end) + Extras = annotate_extras(AppInfo), + [clean_(CompilerMod, ExtraApp, "extra") || ExtraApp <- Extras] end, Compilers). -clean_(CompilerMod, AppInfo, Label) -> +clean_(CompilerMod, AppInfo, _Label) -> #{src_dirs := SrcDirs, src_ext := SrcExt} = CompilerMod:context(AppInfo), BaseDir = rebar_app_info:dir(AppInfo), Opts = rebar_app_info:opts(AppInfo), - EbinDir = rebar_app_info:ebin_dir(AppInfo), FoundFiles = find_source_files(BaseDir, SrcExt, SrcDirs, Opts), CompilerMod:clean(FoundFiles, AppInfo), - rebar_file_utils:rm_rf(dag_file(CompilerMod, EbinDir, Label)). + ok. -spec needs_compile(filename:all(), extension(), [{extension(), file:dirname()}]) -> boolean(). needs_compile(Source, OutExt, Mappings) -> @@ -190,30 +202,23 @@ needs_compile(Source, OutExt, Mappings) -> Target = filename:join(OutDir, BaseName++OutExt), filelib:last_modified(Source) > filelib:last_modified(Target). -run_on_extra_src_dirs(CompilerMod, AppInfo, Fun) -> +annotate_extras(AppInfo) -> ExtraDirs = rebar_dir:extra_src_dirs(rebar_app_info:opts(AppInfo), []), - run_on_extra_src_dirs(ExtraDirs, CompilerMod, AppInfo, Fun). - -run_on_extra_src_dirs([], _CompilerMod, _AppInfo, _Fun) -> - ok; -run_on_extra_src_dirs([Dir | Rest], CompilerMod, AppInfo, Fun) -> - case filelib:is_dir(filename:join(rebar_app_info:dir(AppInfo), Dir)) of - true -> - OldSrcDirs = rebar_app_info:get(AppInfo, src_dirs, ["src"]), - AppDir = rebar_app_info:dir(AppInfo), - EbinDir = filename:join(rebar_app_info:out_dir(AppInfo), Dir), - AppInfo1 = rebar_app_info:ebin_dir(AppInfo, EbinDir), - AppInfo2 = rebar_app_info:set(AppInfo1, src_dirs, [Dir]), - AppInfo3 = rebar_app_info:set(AppInfo2, extra_src_dirs, OldSrcDirs), - AppInfo4 = add_to_includes( % give access to .hrl in app's src/ - AppInfo3, - [filename:join([AppDir, D]) || D <- OldSrcDirs] - ), - Fun(CompilerMod, AppInfo4); - _ -> - ok + OldSrcDirs = rebar_app_info:get(AppInfo, src_dirs, ["src"]), + AppDir = rebar_app_info:dir(AppInfo), + lists:map(fun(Dir) -> + EbinDir = filename:join(rebar_app_info:out_dir(AppInfo), Dir), + AppInfo1 = rebar_app_info:ebin_dir(AppInfo, EbinDir), + AppInfo2 = rebar_app_info:set(AppInfo1, src_dirs, [Dir]), + AppInfo3 = rebar_app_info:set(AppInfo2, extra_src_dirs, OldSrcDirs), + add_to_includes( % give access to .hrl in app's src/ + AppInfo3, + [filename:join([AppDir, D]) || D <- OldSrcDirs] + ) end, - run_on_extra_src_dirs(Rest, CompilerMod, AppInfo, Fun). + [ExtraDir || ExtraDir <- ExtraDirs, + filelib:is_dir(filename:join(AppDir, ExtraDir))] + ). %% These functions are here for the ultimate goal of getting rid of %% rebar_base_compiler. This can't be done because of existing plugins. @@ -233,7 +238,7 @@ format_error_source(Path, Opts) -> report(Messages) -> rebar_base_compiler:report(Messages). -%% private functions +%%% private functions find_source_files(BaseDir, SrcExt, SrcDirs, Opts) -> SourceExtRe = "^(?!\\._).*\\" ++ SrcExt ++ [$$], @@ -242,160 +247,6 @@ find_source_files(BaseDir, SrcExt, SrcDirs, Opts) -> rebar_utils:find_files_in_dirs([filename:join(BaseDir, SrcDir)], SourceExtRe, Recursive) end, SrcDirs). -%% @private generate the name for the DAG based on the compiler module and -%% a custom label, both of which are used to prevent various compiler runs -%% from clobbering each other. The label `undefined' is kept for a default -%% run of the compiler, to keep in line with previous versions of the file. -dag_file(CompilerMod, Dir, undefined) -> - filename:join([rebar_dir:local_cache_dir(Dir), CompilerMod, - ?DAG_ROOT ++ ?DAG_EXT]); -dag_file(CompilerMod, Dir, Label) -> - filename:join([rebar_dir:local_cache_dir(Dir), CompilerMod, - ?DAG_ROOT ++ "_" ++ Label ++ ?DAG_EXT]). - -%% private graph functions - -%% Get dependency graph of given Erls files and their dependencies (header files, -%% parse transforms, behaviours etc.) located in their directories or given -%% InclDirs. Note that last modification times stored in vertices already respect -%% dependencies induced by given graph G. -init_dag(Compiler, InclDirs, SrcDirs, Erls, Dir, EbinDir, Label) -> - G = digraph:new([acyclic]), - try restore_dag(Compiler, G, InclDirs, Dir, Label) - catch - _:_ -> - ?WARN("Failed to restore ~ts file. Discarding it.~n", [dag_file(Compiler, Dir, Label)]), - file:delete(dag_file(Compiler, Dir, Label)) - end, - Dirs = lists:usort(InclDirs ++ SrcDirs), - %% A source file may have been renamed or deleted. Remove it from the graph - %% and remove any beam file for that source if it exists. - Modified = maybe_rm_beams_and_edges(G, EbinDir, Erls), - Modified1 = lists:foldl(update_dag_fun(G, Compiler, Dirs), Modified, Erls), - if Modified1 -> store_dag(Compiler, G, InclDirs, Dir, Label); - not Modified1 -> ok - end, - G. - -maybe_rm_beams_and_edges(G, Dir, Files) -> - Vertices = digraph:vertices(G), - case lists:filter(fun(File) -> - case filename:extension(File) =:= ".erl" of - true -> - maybe_rm_beam_and_edge(G, Dir, File); - false -> - false - end - end, lists:sort(Vertices) -- lists:sort(Files)) of - [] -> - false; - _ -> - true - end. - -maybe_rm_beam_and_edge(G, OutDir, Source) -> - %% This is NOT a double check it is the only check that the source file is actually gone - case filelib:is_regular(Source) of - true -> - %% Actually exists, don't delete - false; - false -> - Target = target_base(OutDir, Source) ++ ".beam", - ?DEBUG("Source ~ts is gone, deleting previous beam file if it exists ~ts", [Source, Target]), - file:delete(Target), - digraph:del_vertex(G, Source), - true - end. - - -target_base(OutDir, Source) -> - filename:join(OutDir, filename:basename(Source, ".erl")). - -restore_dag(Compiler, G, InclDirs, Dir, Label) -> - case file:read_file(dag_file(Compiler, Dir, Label)) of - {ok, Data} -> - % Since externally passed InclDirs can influence dependency graph (see - % modify_dag), we have to check here that they didn't change. - #dag{vsn=?DAG_VSN, info={Vs, Es, InclDirs}} = - binary_to_term(Data), - lists:foreach( - fun({V, LastUpdated}) -> - digraph:add_vertex(G, V, LastUpdated) - end, Vs), - lists:foreach( - fun({_, V1, V2, _}) -> - digraph:add_edge(G, V1, V2) - end, Es); - {error, _} -> - ok - end. - -store_dag(Compiler, G, InclDirs, Dir, Label) -> - Vs = lists:map(fun(V) -> digraph:vertex(G, V) end, digraph:vertices(G)), - Es = lists:map(fun(E) -> digraph:edge(G, E) end, digraph:edges(G)), - File = dag_file(Compiler, Dir, Label), - ok = filelib:ensure_dir(File), - Data = term_to_binary(#dag{info={Vs, Es, InclDirs}}, [{compressed, 2}]), - file:write_file(File, Data). - -update_dag(G, Compiler, Dirs, Source) -> - case digraph:vertex(G, Source) of - {_, LastUpdated} -> - case filelib:last_modified(Source) of - 0 -> - %% The file doesn't exist anymore, - %% erase it from the graph. - %% All the edges will be erased automatically. - digraph:del_vertex(G, Source), - modified; - LastModified when LastUpdated < LastModified -> - modify_dag(G, Compiler, Source, LastModified, filename:dirname(Source), Dirs); - _ -> - Modified = lists:foldl( - update_dag_fun(G, Compiler, Dirs), - false, digraph:out_neighbours(G, Source)), - MaxModified = update_max_modified_deps(G, Source), - case Modified orelse MaxModified > LastUpdated of - true -> modified; - false -> unmodified - end - end; - false -> - modify_dag(G, Compiler, Source, filelib:last_modified(Source), filename:dirname(Source), Dirs) - end. - -modify_dag(G, Compiler, Source, LastModified, SourceDir, Dirs) -> - AbsIncls = Compiler:dependencies(Source, SourceDir, Dirs), - digraph:add_vertex(G, Source, LastModified), - digraph:del_edges(G, digraph:out_edges(G, Source)), - lists:foreach( - fun(Incl) -> - update_dag(G, Compiler, Dirs, Incl), - digraph:add_edge(G, Source, Incl) - end, AbsIncls), - modified. - -update_dag_fun(G, Compiler, Dirs) -> - fun(Erl, Modified) -> - case update_dag(G, Compiler, Dirs, Erl) of - modified -> true; - unmodified -> Modified - end - end. - -update_max_modified_deps(G, Source) -> - MaxModified = - lists:foldl(fun(File, Acc) -> - case digraph:vertex(G, File) of - {_, MaxModified} when MaxModified > Acc -> - MaxModified; - _ -> - Acc - end - end, 0, [Source | digraph:out_neighbours(G, Source)]), - digraph:add_vertex(G, Source, MaxModified), - MaxModified. - add_to_includes(AppInfo, Dirs) -> Opts = rebar_app_info:opts(AppInfo), List = rebar_opts:get(Opts, erl_opts, []), diff --git a/src/rebar_compiler_dag.erl b/src/rebar_compiler_dag.erl new file mode 100644 index 000000000..1fa46c52c --- /dev/null +++ b/src/rebar_compiler_dag.erl @@ -0,0 +1,221 @@ +%%% Module handling the directed graph required for the analysis +%%% of all top-level applications by the various compiler plugins. +-module(rebar_compiler_dag). +-export([init/4, prune/4, update/4, maybe_store/5, terminate/1]). + +-include("rebar.hrl"). + +-define(DAG_VSN, 3). +-define(DAG_ROOT, "source"). +-define(DAG_EXT, ".dag"). + +-type dag_v() :: {digraph:vertex(), term()} | 'false'. +-type dag_e() :: {digraph:vertex(), digraph:vertex()}. +-type critical_meta() :: term(). % if this changes, the DAG is invalid +-type dag_rec() :: {list(dag_v()), list(dag_e()), critical_meta()}. +-type dag() :: digraph:graph(). +-record(dag, {vsn = ?DAG_VSN :: pos_integer(), + info = {[], [], []} :: dag_rec()}). + +%% You should initialize one DAG per compiler module. +%% `CritMeta' is any contextual information that, if it is found to change, +%% must invalidate the DAG loaded from disk. +-spec init(file:filename_all(), atom(), string() | undefined, critical_meta()) -> dag(). +init(Dir, Compiler, Label, CritMeta) -> + G = digraph:new([acyclic]), + File = dag_file(Dir, Compiler, Label), + try + restore_dag(G, File, CritMeta) + catch + _:_ -> + %% Don't mark as dirty yet to avoid creating compiler DAG files for + %% compilers that are actually never used. + ?WARN("Failed to restore ~ts file. Discarding it.~n", [File]), + file:delete(File) + end, + G. + +-spec prune(dag(), file:filename_all(), file:filename_all(), [file:filename_all()]) -> ok. +prune(G, SrcDirs, EbinDir, Erls) -> + %% A source file may have been renamed or deleted. Remove it from the graph + %% and remove any beam file for that source if it exists. + Vertices = digraph:vertices(G), + SrcParts = [filename:split(SrcDir) || SrcDir <- SrcDirs], + [maybe_rm_beam_and_edge(G, EbinDir, File) + || File <- lists:sort(Vertices) -- lists:sort(Erls), + filename:extension(File) =:= ".erl", + lists:any(fun(Src) -> lists:prefix(Src, filename:split(File)) end, + SrcParts)], + ok. + +%% @doc this function scans all the source files found and looks into +%% all the `InDirs' for deps (other erl or .hrl files) that are related +%% to them (by calling `CompileMod:dependencies()' on them). +%% +%% The trick here is that change detection, done with last_modified stamps, +%% takes place at the same time as the graph propagation (finding deps) +%% themselves. As such, this is a confusing mutually recursive depth-first +%% search function that relies on side-effects and precise order-of-traversal +%% to propagate file changes. +%% +%% To be replaced by a more declarative EPP-based flow. +-spec update(dag(), module(), [file:filename_all()], [file:filename_all()]) -> ok. +update(_, _, _, []) -> + ok; +update(G, Compiler, InDirs, [Source|Erls]) -> + case digraph:vertex(G, Source) of + {_, LastUpdated} -> + case filelib:last_modified(Source) of + 0 -> + %% The file doesn't exist anymore, + %% erase it from the graph. + %% All the edges will be erased automatically. + digraph:del_vertex(G, Source), + mark_dirty(G), + update(G, Compiler, InDirs, Erls); + LastModified when LastUpdated < LastModified -> + add_to_dag(G, Compiler, InDirs, Source, LastModified, filename:dirname(Source)), + update(G, Compiler, InDirs, Erls); + _ -> + AltErls = digraph:out_neighbours(G, Source), + %% Deps must be explored before the module itself + update(G, Compiler, InDirs, AltErls), + Modified = is_dirty(G), + MaxModified = update_max_modified_deps(G, Source), + case Modified orelse MaxModified > LastUpdated of + true -> mark_dirty(G); + false -> ok + end, + update(G, Compiler, InDirs, Erls) + end; + false -> + add_to_dag(G, Compiler, InDirs, Source, filelib:last_modified(Source), filename:dirname(Source)), + update(G, Compiler, InDirs, Erls) + end. + +maybe_store(G, Dir, Compiler, Label, CritMeta) -> + case is_dirty(G) of + true -> + clear_dirty(G), + File = dag_file(Dir, Compiler, Label), + store_dag(G, File, CritMeta); + false -> + ok + end. + +terminate(G) -> + true = digraph:delete(G). + +%%%%%%%%%%%%%%% +%%% PRIVATE %%% +%%%%%%%%%%%%%%% +%% @private generate the name for the DAG based on the compiler module and +%% a custom label, both of which are used to prevent various compiler runs +%% from clobbering each other. The label `undefined' is kept for a default +%% run of the compiler, to keep in line with previous versions of the file. +dag_file(Dir, CompilerMod, undefined) -> + filename:join([rebar_dir:local_cache_dir(Dir), CompilerMod, + ?DAG_ROOT ++ ?DAG_EXT]); +dag_file(Dir, CompilerMod, Label) -> + filename:join([rebar_dir:local_cache_dir(Dir), CompilerMod, + ?DAG_ROOT ++ "_" ++ Label ++ ?DAG_EXT]). + +restore_dag(G, File, CritMeta) -> + case file:read_file(File) of + {ok, Data} -> + %% The CritMeta value is checked and if it doesn't match, we fail + %% the whole restore operation. + #dag{vsn=?DAG_VSN, info={Vs, Es, CritMeta}} = binary_to_term(Data), + [digraph:add_vertex(G, V, LastUpdated) || {V, LastUpdated} <- Vs], + [digraph:add_edge(G, V1, V2) || {_, V1, V2, _} <- Es], + ok; + {error, _Err} -> + ok + end. + +store_dag(G, File, CritMeta) -> + ok = filelib:ensure_dir(File), + Vs = lists:map(fun(V) -> digraph:vertex(G, V) end, digraph:vertices(G)), + Es = lists:map(fun(E) -> digraph:edge(G, E) end, digraph:edges(G)), + Data = term_to_binary(#dag{info={Vs, Es, CritMeta}}, [{compressed, 2}]), + file:write_file(File, Data). + +%% Drop a file from the digraph if it doesn't exist, and if so, +%% delete its related build artifact +maybe_rm_beam_and_edge(G, OutDir, Source) -> + %% This is NOT a double check it is the only check that the source file is actually gone + case filelib:is_regular(Source) of + true -> + %% Actually exists, don't delete + false; + false -> + Target = target_base(OutDir, Source) ++ ".beam", + ?DEBUG("Source ~ts is gone, deleting previous beam file if it exists ~ts", [Source, Target]), + file:delete(Target), + digraph:del_vertex(G, Source), + mark_dirty(G), + true + end. + +%% @private Return what should be the base name of an erl file, relocated to the +%% target directory. For example: +%% target_base("ebin/", "src/my_module.erl") -> "ebin/my_module" +target_base(OutDir, Source) -> + filename:join(OutDir, filename:basename(Source, ".erl")). + +%% @private a file has been found to change or wasn't part of the DAG before, +%% and must be added, along with all its dependencies. +add_to_dag(G, Compiler, InDirs, Source, LastModified, SourceDir) -> + AbsIncls = Compiler:dependencies(Source, SourceDir, InDirs), + digraph:add_vertex(G, Source, LastModified), + digraph:del_edges(G, digraph:out_edges(G, Source)), + %% Deps must be explored before the module itself + [begin + update(G, Compiler, InDirs, [Incl]), + digraph:add_edge(G, Source, Incl) + end || Incl <- AbsIncls], + mark_dirty(G), + AbsIncls. + +%% @private change status propagation: if the dependencies of a file have +%% been updated, mark the last_modified time for that file to be equivalent +%% to its most-recently-changed dependency; that way, nested header file +%% change stamps are propagated to the final module. +%% This is required because at some point the module is compared to its +%% associated .beam file's last-generation stamp to know if it requires +%% rebuilding. +%% The responsibility for this is however diffuse across various modules. +update_max_modified_deps(G, Source) -> + MaxModified = lists:foldl( + fun(File, Acc) -> + case digraph:vertex(G, File) of + {_, MaxModified} when MaxModified > Acc -> MaxModified; + _ -> Acc + end + end, + 0, + [Source | digraph:out_neighbours(G, Source)] + ), + digraph:add_vertex(G, Source, MaxModified), + MaxModified. + +%% Mark the digraph as having been modified, which is required to +%% save its updated form on disk after the compiling run. +%% This uses a magic vertex to carry the dirty state. This is less +%% than ideal because listing vertices may expect filenames and +%% instead there's going to be one trick atom through it. +mark_dirty(G) -> + digraph:add_vertex(G, '$r3_dirty_bit', true), + ok. + +%% Check whether the digraph has been modified and is considered dirty. +is_dirty(G) -> + case digraph:vertex(G, '$r3_dirty_bit') of + {_, Bool} -> Bool; + false -> false + end. + +%% Remove the dirty status. Because the saving of a digraph on disk saves all +%% vertices, clear the flag before serializing it. +clear_dirty(G) -> + digraph:del_vertex(G, '$r3_dirty_bit'). diff --git a/src/rebar_prv_compile.erl b/src/rebar_prv_compile.erl index fb142fd8a..03d0b878e 100644 --- a/src/rebar_prv_compile.erl +++ b/src/rebar_prv_compile.erl @@ -68,8 +68,8 @@ handle_project_apps(Providers, State) -> ProjectApps2 = copy_and_build_project_apps(State, Providers, ProjectApps1), State2 = rebar_state:project_apps(State, ProjectApps2), - %% projects with structures like /apps/foo,/apps/bar,/test - build_extra_dirs(State, ProjectApps2), + %% build extra_src_dirs in the root of multi-app projects + build_root_extras(State, ProjectApps2), State3 = update_code_paths(State2, ProjectApps2), @@ -98,11 +98,11 @@ format_error(Reason) -> copy_and_build_apps(State, Providers, Apps) -> Apps0 = [prepare_app(State, Providers, App) || App <- Apps], - compile(State, Providers, Apps0). + compile(State, Providers, Apps0, apps). copy_and_build_project_apps(State, Providers, Apps) -> Apps0 = [prepare_project_app(State, Providers, App) || App <- Apps], - compile(State, Providers, Apps0). + compile(State, Providers, Apps0, project_apps). -spec compile(rebar_state:t(), [rebar_app_info:t()]) -> [rebar_app_info:t()] ; (rebar_state:t(), rebar_app_info:t()) -> rebar_app_info:t(). @@ -114,12 +114,18 @@ compile(State, AppInfo) -> ; (rebar_state:t(), [providers:t()], rebar_app_info:t()) -> rebar_app_info:t(). compile(State, Providers, AppInfo) when not is_list(AppInfo) -> - [Res] = compile(State, Providers, [AppInfo]), + [Res] = compile(State, Providers, [AppInfo], undefined), Res; compile(State, Providers, Apps) -> + compile(State, Providers, Apps, undefined). + +-spec compile(rebar_state:t(), [providers:t()], + [rebar_app_info:t()], atom() | undefined) -> [rebar_app_info:t()]. +compile(State, Providers, Apps, Tag) -> + ?DEBUG("Compile (~p)", [if Tag =:= undefined -> untagged; true -> Tag end]), Apps1 = [prepare_compile(State, Providers, App) || App <- Apps], Apps2 = [prepare_compilers(State, Providers, App) || App <- Apps1], - Apps3 = [run_compilers(State, Providers, App) || App <- Apps2], + Apps3 = run_compilers(State, Providers, Apps2, Tag), Apps4 = [finalize_compilers(State, Providers, App) || App <- Apps3], Apps5 = [prepare_app_file(State, Providers, App) || App <- Apps4], Apps6 = compile_app_files(State, Providers, Apps5), @@ -147,10 +153,32 @@ prepare_compilers(State, Providers, AppInfo) -> AppDir = rebar_app_info:dir(AppInfo), rebar_hooks:run_all_hooks(AppDir, pre, ?ERLC_HOOK, Providers, AppInfo, State). -run_compilers(State, _Providers, AppInfo) -> - ?INFO("Compiling ~ts", [rebar_app_info:name(AppInfo)]), - build_app(AppInfo, State), - AppInfo. +run_compilers(State, _Providers, Apps, Tag) -> + %% Prepare a compiler digraph to be shared by all compiled applications + %% in a given run, providing the ability to combine their dependency + %% ordering and resources. + %% The Tag allows to create a Label when someone cares about a specific + %% run for compilation; + DAGLabel = case Tag of + undefined -> undefined; + _ -> atom_to_list(Tag) + end, + %% The Dir for the DAG is set to deps_dir so builds taking place + %% in different contexts (i.e. plugins) don't risk clobbering regular deps. + Dir = rebar_dir:deps_dir(State), + CritMeta = [], % used to be incldirs per app + DAGs = [{Mod, rebar_compiler_dag:init(Dir, Mod, DAGLabel, CritMeta)} + || Mod <- rebar_state:compilers(State)], + rebar_paths:set_paths([deps], State), + %% Compile all the apps + [build_app(DAGs, AppInfo, State) || AppInfo <- Apps], + %% Potentially store shared compiler DAGs so next runs can easily + %% share the base information for easy re-scans. + lists:foreach(fun({Mod, G}) -> + rebar_compiler_dag:maybe_store(G, Dir, Mod, DAGLabel, CritMeta), + rebar_compiler_dag:terminate(G) + end, DAGs), + Apps. finalize_compilers(State, Providers, AppInfo) -> AppDir = rebar_app_info:dir(AppInfo), @@ -184,55 +212,61 @@ finalize_app_file(State, Providers, AppInfo) -> finalize_compile(State, Providers, AppInfo) -> AppDir = rebar_app_info:dir(AppInfo), AppInfo2 = rebar_hooks:run_all_hooks(AppDir, post, ?PROVIDER, Providers, AppInfo, State), - %% Problem if we use a newer AppInfo version? Used to be ran on result of app compile - %% directly, but we need the check here to ensure all hooks have run, while the new - %% "concurrent" pipeline does not let us go back. has_all_artifacts(AppInfo), AppInfo2. -build_extra_dirs(State, Apps) -> +build_root_extras(State, Apps) -> + %% The root extra src dirs belong to no specific applications; + %% because the compiler works on OTP apps, we instead build + %% a fake AppInfo record that only contains the root extra_src + %% directories, has access to all the top-level apps' public + %% include files, and builds to a specific extra outdir. + %% TODO: figure out digraph strategy to properly ensure no + %% cross-contamination but proper change detection. BaseDir = rebar_state:dir(State), F = fun(App) -> rebar_app_info:dir(App) == BaseDir end, - %% check that this app hasn't already been dealt with case lists:any(F, Apps) of + true -> + []; false -> ProjOpts = rebar_state:opts(State), Extras = rebar_dir:extra_src_dirs(ProjOpts, []), - [build_extra_dir(State, Dir) || Dir <- Extras]; - true -> ok + {ok, VirtApp} = rebar_app_info:new("extra", "0.0.0", BaseDir, []), + VirtApps = extra_virtual_apps(State, VirtApp, Extras), + %% re-use the project-apps digraph? + run_compilers(State, [], VirtApps, project_apps) end. -build_extra_dir(_State, []) -> ok; -build_extra_dir(State, Dir) -> - case ec_file:is_dir(filename:join([rebar_state:dir(State), Dir])) of +extra_virtual_apps(_, _, []) -> + []; +extra_virtual_apps(State, VApp0, [Dir|Dirs]) -> + SrcDir = filename:join([rebar_state:dir(State), Dir]), + case ec_file:is_dir(SrcDir) of + false -> + extra_virtual_apps(State, VApp0, Dirs); true -> BaseDir = filename:join([rebar_dir:base_dir(State), "extras"]), OutDir = filename:join([BaseDir, Dir]), - rebar_file_utils:ensure_dir(OutDir), copy(rebar_state:dir(State), BaseDir, Dir), - - Compilers = rebar_state:compilers(State), - FakeApp = rebar_app_info:new(), - FakeApp1 = rebar_app_info:out_dir(FakeApp, BaseDir), - FakeApp2 = rebar_app_info:ebin_dir(FakeApp1, OutDir), + VApp1 = rebar_app_info:out_dir(VApp0, BaseDir), + VApp2 = rebar_app_info:ebin_dir(VApp1, OutDir), Opts = rebar_state:opts(State), - FakeApp3 = rebar_app_info:opts(FakeApp2, Opts), - FakeApp4 = rebar_app_info:set(FakeApp3, src_dirs, [OutDir]), - rebar_compiler:compile_all(Compilers, FakeApp4); - false -> - ok + VApp3 = rebar_app_info:opts(VApp2, Opts), + [rebar_app_info:set(VApp3, src_dirs, [OutDir]) + | extra_virtual_apps(State, VApp0, Dirs)] end. %% =================================================================== %% Internal functions %% =================================================================== -build_app(AppInfo, State) -> +build_app(DAGs, AppInfo, State) -> + ?INFO("Compiling ~ts", [rebar_app_info:name(AppInfo)]), case rebar_app_info:project_type(AppInfo) of Type when Type =:= rebar3 ; Type =:= undefined -> - Compilers = rebar_state:compilers(State), - rebar_paths:set_paths([deps], State), - rebar_compiler:compile_all(Compilers, AppInfo); + %% assume the deps paths are already set by the caller (run_compilers/3) + %% and shared for multiple apps to save work. + rebar_compiler:compile_all(DAGs, AppInfo); Type -> ProjectBuilders = rebar_state:project_builders(State), case lists:keyfind(Type, 1, ProjectBuilders) of