diff options
Diffstat (limited to 'lib/tools')
35 files changed, 4548 insertions, 790 deletions
diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in index cfe91917f8..289322b6fa 100644 --- a/lib/tools/c_src/Makefile.in +++ b/lib/tools/c_src/Makefile.in @@ -29,7 +29,6 @@ CC=@CC@ LD=@LD@ AR=@AR@ RANLIB=@RANLIB@ -RM=@RM@ MKDIR=@MKDIR@ INSTALL=@INSTALL@ INSTALL_DIR=@INSTALL_DIR@ @@ -158,9 +157,9 @@ $(ERTS_LIB): docs: clean: - $(RM) -rf ../obj/* - $(RM) -rf ../bin/* - $(RM) -f ./*~ + $(RM) -r ../obj/* + $(RM) -r ../bin/* + $(RM) ./*~ .PHONY: all erts_lib docs clean diff --git a/lib/tools/doc/src/Makefile b/lib/tools/doc/src/Makefile index 001c31a443..5ff4fe3113 100644 --- a/lib/tools/doc/src/Makefile +++ b/lib/tools/doc/src/Makefile @@ -120,6 +120,7 @@ debug opt: clean clean_docs: rm -rf $(HTMLDIR)/* + rm -rf $(XMLDIR) rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f $(SPECDIR)/* diff --git a/lib/tools/doc/src/cover.xml b/lib/tools/doc/src/cover.xml index 15cd784253..e9f782977d 100644 --- a/lib/tools/doc/src/cover.xml +++ b/lib/tools/doc/src/cover.xml @@ -30,7 +30,7 @@ <date></date> <rev></rev> </header> - <module>cover</module> + <module since="">cover</module> <modulesummary>A Coverage Analysis Tool for Erlang</modulesummary> <description> <p>The module <c>cover</c> provides a set of functions for coverage @@ -115,7 +115,7 @@ </description> <funcs> <func> - <name>start() -> {ok,Pid} | {error,Reason}</name> + <name since="">start() -> {ok,Pid} | {error,Reason}</name> <fsummary>Start Cover.</fsummary> <type> <v>Pid = pid()</v> @@ -128,21 +128,33 @@ </desc> </func> <func> - <name>start(Nodes) -> {ok,StartedNodes} | {error,not_main_node}</name> + <name since="OTP 22.0">local_only() -> ok | {error,too_late}</name> + <fsummary>Only support running Cover on the local node.</fsummary> + <desc> + <p>Only support running Cover on the local node. This function + must be called before any modules have been compiled or any + nodes added. When running in this mode, modules will be Cover + compiled in a more efficient way, but the resulting code will + only work on the same node they were compiled on.</p> + </desc> + </func> + <func> + <name since="">start(Nodes) -> {ok,StartedNodes} | {error,not_main_node} | {error,local_only}</name> <fsummary>Start Cover on remote nodes.</fsummary> <type> <v>Nodes = StartedNodes = [atom()]</v> </type> <desc> <p>Starts a Cover server on the each of given nodes, and loads - all cover compiled modules.</p> + all cover compiled modules. This call will fail if + <c>cover:local_only/0</c> has been called.</p> </desc> </func> <func> - <name>compile(ModFiles) -> Result | [Result]</name> - <name>compile(ModFiles, Options) -> Result | [Result]</name> - <name>compile_module(ModFiles) -> Result | [Result]</name> - <name>compile_module(ModFiles, Options) -> Result | [Result]</name> + <name since="">compile(ModFiles) -> Result | [Result]</name> + <name since="">compile(ModFiles, Options) -> Result | [Result]</name> + <name since="">compile_module(ModFiles) -> Result | [Result]</name> + <name since="">compile_module(ModFiles, Options) -> Result | [Result]</name> <fsummary>Compile one or more modules for Cover analysis.</fsummary> <type> <v>ModFiles = ModFile | [ModFile]</v> @@ -176,9 +188,9 @@ </desc> </func> <func> - <name>compile_directory() -> [Result] | {error,Reason}</name> - <name>compile_directory(Dir) -> [Result] | {error,Reason}</name> - <name>compile_directory(Dir, Options) -> [Result] | {error,Reason}</name> + <name since="">compile_directory() -> [Result] | {error,Reason}</name> + <name since="">compile_directory(Dir) -> [Result] | {error,Reason}</name> + <name since="">compile_directory(Dir, Options) -> [Result] | {error,Reason}</name> <fsummary>Compile all modules in a directory for Cover analysis.</fsummary> <type> <v>Dir = string()</v> @@ -199,7 +211,7 @@ </desc> </func> <func> - <name>compile_beam(ModFiles) -> Result | [Result]</name> + <name since="">compile_beam(ModFiles) -> Result | [Result]</name> <fsummary>Compile one or more modules for Cover analysis, using existing beam(s).</fsummary> <type> <v>ModFiles = ModFile | [ModFile]</v> @@ -234,15 +246,15 @@ <c>{already_cover_compiled,no_beam_found,Module}</c> is returned.</p> <p><c>{error,BeamFile}</c> is returned if the compiled code - can not be loaded on the node.</p> + cannot be loaded on the node.</p> <p>If a list of <c>ModFiles</c> is given as input, a list of <c>Result</c> will be returned. The order of the returned list is undefined.</p> </desc> </func> <func> - <name>compile_beam_directory() -> [Result] | {error,Reason}</name> - <name>compile_beam_directory(Dir) -> [Result] | {error,Reason}</name> + <name since="">compile_beam_directory() -> [Result] | {error,Reason}</name> + <name since="">compile_beam_directory(Dir) -> [Result] | {error,Reason}</name> <fsummary>Compile all .beam files in a directory for Cover analysis.</fsummary> <type> <v>Dir = string()</v> @@ -260,14 +272,14 @@ </desc> </func> <func> - <name>analyse() -> {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse(Modules) -> OneResult | {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse(Analysis) -> {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse(Level) -> {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse(Modules, Analysis) -> OneResult | {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse(Modules, Level) -> OneResult | {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse(Analysis, Level) -> {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse(Modules, Analysis, Level) -> OneResult | {result,Ok,Fail} | {error,not_main_node}</name> + <name since="OTP 18.0">analyse() -> {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse(Modules) -> OneResult | {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse(Analysis) -> {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse(Level) -> {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse(Modules, Analysis) -> OneResult | {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse(Modules, Level) -> OneResult | {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse(Analysis, Level) -> {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse(Modules, Analysis, Level) -> OneResult | {result,Ok,Fail} | {error,not_main_node}</name> <fsummary>Analyse one or more Cover compiled modules.</fsummary> <type> <v>Modules = Module | [Module]</v> @@ -305,10 +317,10 @@ </desc> </func> <func> - <name>analyse_to_file() -> {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse_to_file(Modules) -> Answer | {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse_to_file(Options) -> {result,Ok,Fail} | {error,not_main_node}</name> - <name>analyse_to_file(Modules,Options) -> Answer | {result,Ok,Fail} | {error,not_main_node}</name> + <name since="OTP 18.0">analyse_to_file() -> {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse_to_file(Modules) -> Answer | {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse_to_file(Options) -> {result,Ok,Fail} | {error,not_main_node}</name> + <name since="">analyse_to_file(Modules,Options) -> Answer | {result,Ok,Fail} | {error,not_main_node}</name> <fsummary>Detailed coverage analysis of one or more Cover compiled modules.</fsummary> <type> <v>Modules = Module | [Module]</v> @@ -359,10 +371,10 @@ </desc> </func> <func> - <name>async_analyse_to_file(Module) -> </name> - <name>async_analyse_to_file(Module,Options) -> </name> - <name>async_analyse_to_file(Module, OutFile) -> </name> - <name>async_analyse_to_file(Module, OutFile, Options) -> pid()</name> + <name since="OTP R14B02">async_analyse_to_file(Module) -> </name> + <name since="OTP R14B02">async_analyse_to_file(Module,Options) -> </name> + <name since="OTP R14B02">async_analyse_to_file(Module, OutFile) -> </name> + <name since="OTP R14B02">async_analyse_to_file(Module, OutFile, Options) -> pid()</name> <fsummary>Asynchronous call to analyse_to_file.</fsummary> <type> <v>Module = atom()</v> @@ -384,7 +396,7 @@ </desc> </func> <func> - <name>modules() -> [Module] | {error,not_main_node}</name> + <name since="">modules() -> [Module] | {error,not_main_node}</name> <fsummary>Return all Cover compiled modules.</fsummary> <type> <v>Module = atom()</v> @@ -395,7 +407,7 @@ </desc> </func> <func> - <name>imported_modules() -> [Module] | {error,not_main_node}</name> + <name since="">imported_modules() -> [Module] | {error,not_main_node}</name> <fsummary>Return all modules for which there are imported data.</fsummary> <type> <v>Module = atom()</v> @@ -406,7 +418,7 @@ </desc> </func> <func> - <name>imported() -> [File] | {error,not_main_node}</name> + <name since="">imported() -> [File] | {error,not_main_node}</name> <fsummary>Return all imported files.</fsummary> <type> <v>File = string()</v> @@ -416,7 +428,7 @@ </desc> </func> <func> - <name>which_nodes() -> [Node] | {error,not_main_node}</name> + <name since="">which_nodes() -> [Node] | {error,not_main_node}</name> <fsummary>Return all nodes that are part of the coverage analysis.</fsummary> <type> <v>Node = atom()</v> @@ -428,7 +440,7 @@ </desc> </func> <func> - <name>is_compiled(Module) -> {file,File} | false | {error,not_main_node}</name> + <name since="">is_compiled(Module) -> {file,File} | false | {error,not_main_node}</name> <fsummary>Check if a module is Cover compiled.</fsummary> <type> <v>Module = atom()</v> @@ -442,8 +454,8 @@ </desc> </func> <func> - <name>reset(Module) -></name> - <name>reset() -> ok | {error,not_main_node}</name> + <name since="">reset(Module) -></name> + <name since="">reset() -> ok | {error,not_main_node}</name> <fsummary>Reset coverage data for Cover compiled modules.</fsummary> <type> <v>Module = atom()</v> @@ -458,8 +470,8 @@ </desc> </func> <func> - <name>export(ExportFile)</name> - <name>export(ExportFile,Module) -> ok | {error,Reason}</name> + <name since="">export(ExportFile)</name> + <name since="">export(ExportFile,Module) -> ok | {error,Reason}</name> <fsummary>Reset coverage data for Cover compiled modules.</fsummary> <type> <v>ExportFile = string()</v> @@ -470,7 +482,7 @@ <p>Exports the current coverage data for <c>Module</c> to the file <c>ExportFile</c>. It is recommended to name the <c>ExportFile</c> with the extension <c>.coverdata</c>, since - other filenames can not be read by the web based interface to + other filenames cannot be read by the web based interface to cover.</p> <p>If <c>Module</c> is not given, data for all Cover compiled or earlier imported modules is exported.</p> @@ -480,7 +492,7 @@ </desc> </func> <func> - <name>import(ExportFile) -> ok | {error,Reason}</name> + <name since="">import(ExportFile) -> ok | {error,Reason}</name> <fsummary>Reset coverage data for Cover compiled modules.</fsummary> <type> <v>ExportFile = string()</v> @@ -496,7 +508,7 @@ <p>Coverage data from several export files can be imported into one system. The coverage data is then added up when analysing.</p> - <p>Coverage data for a module can not be imported from the + <p>Coverage data for a module cannot be imported from the same file twice unless the module is first reset or compiled. The check is based on the filename, so you can easily fool the system by renaming your export file.</p> @@ -504,14 +516,14 @@ </desc> </func> <func> - <name>stop() -> ok | {error,not_main_node}</name> + <name since="">stop() -> ok | {error,not_main_node}</name> <fsummary>Stop Cover.</fsummary> <desc> <p>Stops the Cover server and unloads all Cover compiled code.</p> </desc> </func> <func> - <name>stop(Nodes) -> ok | {error,not_main_node}</name> + <name since="">stop(Nodes) -> ok | {error,not_main_node}</name> <fsummary>Stop Cover on remote nodes.</fsummary> <type> <v>Nodes = [atom()]</v> @@ -523,7 +535,7 @@ </desc> </func> <func> - <name>flush(Nodes) -> ok | {error,not_main_node}</name> + <name since="OTP R16B">flush(Nodes) -> ok | {error,not_main_node}</name> <fsummary>Collect cover data from remote nodes.</fsummary> <type> <v>Nodes = [atom()]</v> diff --git a/lib/tools/doc/src/cprof.xml b/lib/tools/doc/src/cprof.xml index df0acbe617..b6af8b6d28 100644 --- a/lib/tools/doc/src/cprof.xml +++ b/lib/tools/doc/src/cprof.xml @@ -34,7 +34,7 @@ <rev>PA1</rev> <file>cprof.sgml</file> </header> - <module>cprof</module> + <module since="">cprof</module> <modulesummary>A simple Call Count Profiling Tool using breakpoints for minimal runtime performance impact.</modulesummary> <description> <p>The <c>cprof</c> module is used to profile a program @@ -65,10 +65,10 @@ </description> <funcs> <func> - <name>analyse() -> {AllCallCount, ModAnalysisList}</name> - <name>analyse(Limit) -> {AllCallCount, ModAnalysisList}</name> - <name>analyse(Mod) -> ModAnalysis</name> - <name>analyse(Mod, Limit) -> ModAnalysis</name> + <name since="">analyse() -> {AllCallCount, ModAnalysisList}</name> + <name since="">analyse(Limit) -> {AllCallCount, ModAnalysisList}</name> + <name since="">analyse(Mod) -> ModAnalysis</name> + <name since="">analyse(Mod, Limit) -> ModAnalysis</name> <fsummary>Collect and analyse call counters.</fsummary> <type> <v>Limit = integer()</v> @@ -122,7 +122,7 @@ </desc> </func> <func> - <name>pause() -> integer()</name> + <name since="">pause() -> integer()</name> <fsummary>Pause running call count trace for all functions.</fsummary> <desc> <p>Pause call count tracing for all functions in all modules @@ -137,9 +137,9 @@ </desc> </func> <func> - <name>pause(FuncSpec) -> integer()</name> - <name>pause(Mod, Func) -> integer()</name> - <name>pause(Mod, Func, Arity) -> integer()</name> + <name since="">pause(FuncSpec) -> integer()</name> + <name since="">pause(Mod, Func) -> integer()</name> + <name since="">pause(Mod, Func, Arity) -> integer()</name> <fsummary>Pause running call count trace for matching functions.</fsummary> <type> <v>FuncSpec = Mod | {Mod,Func,Arity}, {FS}</v> @@ -167,10 +167,10 @@ </desc> </func> <func> - <name>restart() -> integer()</name> - <name>restart(FuncSpec) -> integer()</name> - <name>restart(Mod, Func) -> integer()</name> - <name>restart(Mod, Func, Arity) -> integer()</name> + <name since="">restart() -> integer()</name> + <name since="">restart(FuncSpec) -> integer()</name> + <name since="">restart(Mod, Func) -> integer()</name> + <name since="">restart(Mod, Func, Arity) -> integer()</name> <fsummary>Restart existing call counters for matching functions.</fsummary> <type> <v>FuncSpec = Mod | {Mod,Func,Arity}, {FS}</v> @@ -197,7 +197,7 @@ </desc> </func> <func> - <name>start() -> integer()</name> + <name since="">start() -> integer()</name> <fsummary>Start call count tracing for all functions.</fsummary> <desc> <p>Start call count tracing for all functions in all modules, @@ -212,9 +212,9 @@ </desc> </func> <func> - <name>start(FuncSpec) -> integer()</name> - <name>start(Mod, Func) -> integer()</name> - <name>start(Mod, Func, Arity) -> integer()</name> + <name since="">start(FuncSpec) -> integer()</name> + <name since="">start(Mod, Func) -> integer()</name> + <name since="">start(Mod, Func, Arity) -> integer()</name> <fsummary>Start call count tracing for matching functions.</fsummary> <type> <v>FuncSpec = Mod | {Mod,Func,Arity}, {FS}</v> @@ -240,7 +240,7 @@ </desc> </func> <func> - <name>stop() -> integer()</name> + <name since="">stop() -> integer()</name> <fsummary>Stop call count tracing for all functions.</fsummary> <desc> <p>Stop call count tracing for all functions in all modules, @@ -255,9 +255,9 @@ </desc> </func> <func> - <name>stop(FuncSpec) -> integer()</name> - <name>stop(Mod, Func) -> integer()</name> - <name>stop(Mod, Func, Arity) -> integer()</name> + <name since="">stop(FuncSpec) -> integer()</name> + <name since="">stop(Mod, Func) -> integer()</name> + <name since="">stop(Mod, Func, Arity) -> integer()</name> <fsummary>Stop call count tracing for matching functions.</fsummary> <type> <v>FuncSpec = Mod | {Mod,Func,Arity}, {FS}</v> diff --git a/lib/tools/doc/src/eprof.xml b/lib/tools/doc/src/eprof.xml index f098b7d39e..c9e4edd991 100644 --- a/lib/tools/doc/src/eprof.xml +++ b/lib/tools/doc/src/eprof.xml @@ -28,7 +28,7 @@ <date></date> <rev></rev> </header> - <module>eprof</module> + <module since="">eprof</module> <modulesummary>A Time Profiling Tool for Erlang</modulesummary> <description> <p>The module <c>eprof</c> provides a set of functions for time @@ -40,7 +40,7 @@ </description> <funcs> <func> - <name>start() -> {ok,Pid} | {error,Reason}</name> + <name since="">start() -> {ok,Pid} | {error,Reason}</name> <fsummary>Start Eprof.</fsummary> <type> <v>Pid = pid()</v> @@ -51,9 +51,9 @@ </desc> </func> <func> - <name>start_profiling(Rootset) -> profiling | {error, Reason}</name> - <name>start_profiling(Rootset,Pattern) -> profiling | {error, Reason}</name> - <name>start_profiling(Rootset,Pattern,Options) -> profiling | {error, Reason}</name> + <name since="">start_profiling(Rootset) -> profiling | {error, Reason}</name> + <name since="OTP R14B">start_profiling(Rootset,Pattern) -> profiling | {error, Reason}</name> + <name since="OTP R16B01">start_profiling(Rootset,Pattern,Options) -> profiling | {error, Reason}</name> <fsummary>Start profiling.</fsummary> <type> <v>Rootset = [atom() | pid()]</v> @@ -79,7 +79,7 @@ </desc> </func> <func> - <name>stop_profiling() -> profiling_stopped | profiling_already_stopped</name> + <name since="">stop_profiling() -> profiling_stopped | profiling_already_stopped</name> <fsummary>Stop profiling.</fsummary> <desc> <p>Stops profiling started with <c>start_profiling/1</c> or @@ -87,14 +87,14 @@ </desc> </func> <func> - <name>profile(Fun) -> profiling | {error, Reason}</name> - <name>profile(Fun, Options) -> profiling | {error, Reason}</name> - <name>profile(Rootset) -> profiling | {error, Reason}</name> - <name>profile(Rootset,Fun) -> {ok, Value} | {error,Reason}</name> - <name>profile(Rootset,Fun,Pattern) -> {ok, Value} | {error, Reason}</name> - <name>profile(Rootset,Module,Function,Args) -> {ok, Value} | {error, Reason}</name> - <name>profile(Rootset,Module,Function,Args,Pattern) -> {ok, Value} | {error, Reason}</name> - <name>profile(Rootset,Module,Function,Args,Pattern,Options) -> {ok, Value} | {error, Reason}</name> + <name since="">profile(Fun) -> profiling | {error, Reason}</name> + <name since="">profile(Fun, Options) -> profiling | {error, Reason}</name> + <name since="">profile(Rootset) -> profiling | {error, Reason}</name> + <name since="">profile(Rootset,Fun) -> {ok, Value} | {error,Reason}</name> + <name since="OTP R14B">profile(Rootset,Fun,Pattern) -> {ok, Value} | {error, Reason}</name> + <name since="">profile(Rootset,Module,Function,Args) -> {ok, Value} | {error, Reason}</name> + <name since="OTP R14B">profile(Rootset,Module,Function,Args,Pattern) -> {ok, Value} | {error, Reason}</name> + <name since="OTP R16B01">profile(Rootset,Module,Function,Args,Pattern,Options) -> {ok, Value} | {error, Reason}</name> <fsummary>Start profiling.</fsummary> <type> <v>Rootset = [atom() | pid()]</v> @@ -128,9 +128,9 @@ </desc> </func> <func> - <name>analyze() -> ok</name> - <name>analyze(Type) -> ok</name> - <name>analyze(Type,Options) -> ok</name> + <name since="OTP R14B">analyze() -> ok</name> + <name since="OTP R14B">analyze(Type) -> ok</name> + <name since="OTP R14B">analyze(Type,Options) -> ok</name> <fsummary>Display profiling results per process.</fsummary> <type> <v>Type = procs | total</v> @@ -152,7 +152,7 @@ </desc> </func> <func> - <name>log(File) -> ok</name> + <name since="">log(File) -> ok</name> <fsummary>Activate logging of <c>eprof</c>printouts.</fsummary> <type> <v>File = atom() | string()</v> @@ -164,7 +164,7 @@ </desc> </func> <func> - <name>stop() -> stopped</name> + <name since="">stop() -> stopped</name> <fsummary>Stop Eprof.</fsummary> <desc> <p>Stops the Eprof server.</p> diff --git a/lib/tools/doc/src/fprof.xml b/lib/tools/doc/src/fprof.xml index 1fd828d127..4bb8862016 100644 --- a/lib/tools/doc/src/fprof.xml +++ b/lib/tools/doc/src/fprof.xml @@ -32,7 +32,7 @@ <rev>PA1</rev> <file>fprof.sgml</file> </header> - <module>fprof</module> + <module since="">fprof</module> <modulesummary>A Time Profiling Tool using trace to file for minimal runtime performance impact.</modulesummary> <description> <p>This module is used to profile a program @@ -101,7 +101,7 @@ </description> <funcs> <func> - <name>start() -> {ok, Pid} | {error, {already_started, Pid}}</name> + <name since="">start() -> {ok, Pid} | {error, {already_started, Pid}}</name> <fsummary>Starts the <c>fprof</c> server.</fsummary> <type> <v>Pid = pid()</v> @@ -117,14 +117,14 @@ </desc> </func> <func> - <name>stop() -> ok</name> + <name since="">stop() -> ok</name> <fsummary>Same as <c>stop(normal)</c>.</fsummary> <desc> <p>Same as <c>stop(normal)</c>.</p> </desc> </func> <func> - <name>stop(Reason) -> ok</name> + <name since="">stop(Reason) -> ok</name> <fsummary>Stops the <c>fprof</c> server.</fsummary> <type> <v>Reason = term()</v> @@ -149,7 +149,7 @@ </desc> </func> <func> - <name>apply(Func, Args) -> term()</name> + <name since="">apply(Func, Args) -> term()</name> <fsummary>Same as <c>apply(Func, Args, [])</c>.</fsummary> <type> <v>Func = function() | {Module, Function}</v> @@ -162,7 +162,7 @@ </desc> </func> <func> - <name>apply(Module, Function, Args) -> term()</name> + <name since="">apply(Module, Function, Args) -> term()</name> <fsummary>Same as <c>apply({Module, Function}, Args, [])</c>.</fsummary> <type> <v>Args = [term()]</v> @@ -174,7 +174,7 @@ </desc> </func> <func> - <name>apply(Func, Args, OptionList) -> term()</name> + <name since="">apply(Func, Args, OptionList) -> term()</name> <fsummary>Calls <c>erlang:apply(Func, Args)</c>surrounded by<c>trace([start | OptionList])</c>and<c>trace(stop)</c>.</fsummary> <type> <v>Func = function() | {Module, Function}</v> @@ -210,7 +210,7 @@ </desc> </func> <func> - <name>apply(Module, Function, Args, OptionList) -> term()</name> + <name since="">apply(Module, Function, Args, OptionList) -> term()</name> <fsummary>Same as <c>apply({Module, Function}, Args, OptionList)</c>.</fsummary> <type> <v>Module = atom()</v> @@ -228,7 +228,7 @@ </desc> </func> <func> - <name>trace(start, Filename) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">trace(start, Filename) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>trace([start, {file, Filename}])</c>.</fsummary> <type> <v>Reason = term()</v> @@ -238,7 +238,7 @@ </desc> </func> <func> - <name>trace(verbose, Filename) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">trace(verbose, Filename) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>trace([start, verbose, {file, Filename}])</c>.</fsummary> <type> <v>Reason = term()</v> @@ -249,7 +249,7 @@ </desc> </func> <func> - <name>trace(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">trace(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>trace([{OptionName, OptionValue}])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -262,7 +262,7 @@ </desc> </func> <func> - <name>trace(verbose) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">trace(verbose) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>trace([start, verbose])</c>.</fsummary> <type> <v>Reason = term()</v> @@ -272,7 +272,7 @@ </desc> </func> <func> - <name>trace(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">trace(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>trace([OptionName])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -283,7 +283,7 @@ </desc> </func> <func> - <name>trace({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">trace({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>trace([{OptionName, OptionValue}])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -296,7 +296,7 @@ </desc> </func> <func> - <name>trace([Option]) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">trace([Option]) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Starts or stops tracing.</fsummary> <type> <v>Option = start | stop | {procs, PidSpec} | {procs, [PidSpec]} | verbose | {verbose, bool()} | file | {file, Filename} | {tracer, Tracer}</v> @@ -360,7 +360,7 @@ </desc> </func> <func> - <name>profile() -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">profile() -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>profile([])</c>.</fsummary> <type> <v>Reason = term()</v> @@ -370,7 +370,7 @@ </desc> </func> <func> - <name>profile(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">profile(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>profile([{OptionName, OptionValue}])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -383,7 +383,7 @@ </desc> </func> <func> - <name>profile(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">profile(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>profile([OptionName])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -394,7 +394,7 @@ </desc> </func> <func> - <name>profile({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">profile({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>profile([{OptionName, OptionValue}])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -407,7 +407,7 @@ </desc> </func> <func> - <name>profile([Option]) -> ok | {ok, Tracer} | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">profile([Option]) -> ok | {ok, Tracer} | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Compiles a trace into raw profile data held by the <c>fprof</c> server.</fsummary> <type> <v>Option = file | {file, Filename} | dump | {dump, Dump} | append | start | stop</v> @@ -465,7 +465,7 @@ </desc> </func> <func> - <name>analyse() -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">analyse() -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>analyse([])</c>.</fsummary> <type> <v>Reason = term()</v> @@ -475,7 +475,7 @@ </desc> </func> <func> - <name>analyse(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">analyse(OptionName, OptionValue) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>analyse([{OptionName, OptionValue}])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -488,7 +488,7 @@ </desc> </func> <func> - <name>analyse(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">analyse(OptionName) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>analyse([OptionName])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -499,7 +499,7 @@ </desc> </func> <func> - <name>analyse({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">analyse({OptionName, OptionValue}) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Same as <c>analyse([{OptionName, OptionValue}])</c>.</fsummary> <type> <v>OptionName = atom()</v> @@ -512,7 +512,7 @@ </desc> </func> <func> - <name>analyse([Option]) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> + <name since="">analyse([Option]) -> ok | {error, Reason} | {'EXIT', ServerPid, Reason}</name> <fsummary>Analyses raw profile data in the <c>fprof</c> server.</fsummary> <type> <v>Option = dest | {dest, Dest} | append | {cols, Cols} | callers | {callers, bool()} | no_callers | {sort, SortSpec} | totals | {totals, bool()} | details | {details, bool()} | no_details</v> diff --git a/lib/tools/doc/src/instrument.xml b/lib/tools/doc/src/instrument.xml index 9fd9332373..7e9cbaebb0 100644 --- a/lib/tools/doc/src/instrument.xml +++ b/lib/tools/doc/src/instrument.xml @@ -32,7 +32,7 @@ <rev>PA1</rev> <file>instrument.sgml</file> </header> - <module>instrument</module> + <module since="">instrument</module> <modulesummary>Analysis and Utility Functions for Instrumentation</modulesummary> <description> <p>The module <c>instrument</c> contains support for studying the resource @@ -92,7 +92,7 @@ <funcs> <func> - <name name="allocations" arity="0"/> + <name name="allocations" arity="0" since="OTP 21.0"/> <fsummary>Return a summary of all allocations in the system.</fsummary> <desc> <p>Shorthand for @@ -101,7 +101,7 @@ </func> <func> - <name name="allocations" arity="1"/> + <name name="allocations" arity="1" since="OTP 21.0"/> <fsummary>Return a summary of all allocations filtered by allocator type and scheduler id.</fsummary> <desc> @@ -111,15 +111,18 @@ default, but this can be configured an a per-allocator basis with the <seealso marker="erts:erts_alloc#M_atags"><c>+M<S>atags</c> </seealso> emulator option.</p> - <p>If tagged allocations are not enabled on any of the specified - allocator types, the call will fail with - <c>{error, not_enabled}</c>.</p> + <p>If the specified allocator types are not enabled, the call will fail + with <c>{error, not_enabled}</c>.</p> <p>The following options can be used:</p> <taglist> <tag><c>allocator_types</c></tag> <item> - <p>The allocator types that will be searched. Defaults to all - <c>alloc_util</c> allocators.</p> + <p>The allocator types that will be searched. Note that blocks can + move freely between allocator types, so restricting the search to + certain allocators may return unexpected types (e.g. process + heaps when searching binary_alloc), or hide blocks that were + migrated out.</p> + <p>Defaults to all <c>alloc_util</c> allocators.</p> </item> <tag><c>scheduler_ids</c></tag> <item> @@ -170,7 +173,7 @@ </func> <func> - <name name="carriers" arity="0"/> + <name name="carriers" arity="0" since="OTP 21.0"/> <fsummary>Return a list of all carriers in the system.</fsummary> <desc> <p>Shorthand for @@ -179,7 +182,7 @@ </func> <func> - <name name="carriers" arity="1"/> + <name name="carriers" arity="1" since="OTP 21.0"/> <fsummary>Return a list of all carriers filtered by allocator type and scheduler id.</fsummary> <desc> diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml index d2595cdb60..1d434decfc 100644 --- a/lib/tools/doc/src/lcnt.xml +++ b/lib/tools/doc/src/lcnt.xml @@ -34,7 +34,7 @@ <rev>PA1</rev> <file>lcnt.xml</file> </header> - <module>lcnt</module> + <module since="OTP R13B04">lcnt</module> <modulesummary>A runtime system Lock Profiling tool.</modulesummary> <description> <p>The <c>lcnt</c> module is used to profile the internal ethread locks in the @@ -71,7 +71,7 @@ <funcs> <func> - <name>start() -> {ok, Pid} | {error, {already_started, Pid}} </name> + <name since="OTP R13B04">start() -> {ok, Pid} | {error, {already_started, Pid}} </name> <fsummary>Starts the lock profiler server.</fsummary> <type> <v>Pid = pid()</v> @@ -84,7 +84,7 @@ </func> <func> - <name>stop() -> ok</name> + <name since="OTP R13B04">stop() -> ok</name> <fsummary>Stops the lock profiler server.</fsummary> <desc> <p>Stops the lock profiler server.</p> @@ -92,13 +92,13 @@ </func> <func> - <name>collect() -> ok</name> + <name since="OTP R13B04">collect() -> ok</name> <fsummary>Same as <c>collect(node())</c>.</fsummary> <desc><p>Same as <c>collect(node())</c>.</p></desc> </func> <func> - <name>collect(Node) -> ok</name> + <name since="OTP R13B04">collect(Node) -> ok</name> <fsummary>Collects lock statistics from the runtime system.</fsummary> <type> <v>Node = node()</v> @@ -113,13 +113,13 @@ </func> <func> - <name>clear() -> ok</name> + <name since="OTP R13B04">clear() -> ok</name> <fsummary>Same as <c>clear(node())</c>.</fsummary> <desc><p>Same as <c>clear(node())</c>.</p></desc> </func> <func> - <name>clear(Node) -> ok</name> + <name since="OTP R13B04">clear(Node) -> ok</name> <fsummary>Clears the internal lock statistics from runtime system.</fsummary> <type> <v>Node = node()</v> @@ -133,12 +133,12 @@ </desc> </func> <func> - <name>conflicts() -> ok</name> + <name since="OTP R13B04">conflicts() -> ok</name> <fsummary>Same as <c>conflicts([])</c>.</fsummary> <desc><p>Same as <c>conflicts([])</c>.</p></desc> </func> <func> - <name>conflicts([Option]) -> ok</name> + <name since="OTP R13B04">conflicts([Option]) -> ok</name> <fsummary>Prints a list of internal lock counters.</fsummary> <type> <v>Option = {sort, Sort} | {reverse, bool()} | {thresholds, [Thresholds]} | {print, [Print | {Print, integer()}]} | {max_locks, MaxLocks} | {combine, bool()}</v> @@ -154,14 +154,14 @@ </func> <func> - <name>locations() -> ok</name> + <name since="OTP R13B04">locations() -> ok</name> <fsummary>Same as <c>locations([])</c>.</fsummary> <desc> <p>Same as <c>locations([])</c>.</p> </desc> </func> <func> - <name>locations([Option]) -> ok</name> + <name since="OTP R13B04">locations([Option]) -> ok</name> <fsummary>Prints a list of internal lock counters by source code locations.</fsummary> <type> <v>Option = {sort, Sort} | {thresholds, [Thresholds]} | {print, [Print | {Print, integer()}]} | {max_locks, MaxLocks} | {combine, bool()}</v> @@ -177,12 +177,12 @@ </func> <func> - <name>inspect(Lock) -> ok</name> + <name since="OTP R13B04">inspect(Lock) -> ok</name> <fsummary>Same as <c>inspect(Lock, [])</c>.</fsummary> <desc><p>Same as <c>inspect(Lock, [])</c>.</p></desc> </func> <func> - <name>inspect(Lock, [Option]) -> ok</name> + <name since="OTP R13B04">inspect(Lock, [Option]) -> ok</name> <fsummary>Prints a list of internal lock counters for a specific lock.</fsummary> <type> <v>Lock = Name | {Name, Id | [Id]}</v> @@ -268,7 +268,7 @@ </func> <func> - <name>information() -> ok</name> + <name since="OTP R13B04">information() -> ok</name> <fsummary>Prints lcnt server state and generic information about collected lock statistics.</fsummary> <desc> <p>Prints lcnt server state and generic information about collected lock statistics.</p> @@ -276,7 +276,7 @@ </func> <func> - <name>swap_pid_keys() -> ok</name> + <name since="OTP R13B04">swap_pid_keys() -> ok</name> <fsummary>Swaps places on <c>Name</c> and <c>Id</c> space for ports and processes.</fsummary> <desc> <p>Swaps places on <c>Name</c> and <c>Id</c> space for ports and processes.</p> @@ -284,7 +284,7 @@ </func> <func> - <name>load(Filename) -> ok</name> + <name since="OTP R13B04">load(Filename) -> ok</name> <fsummary>Restores previously saved data to the server.</fsummary> <type> <v>Filename = filename()</v> @@ -295,7 +295,7 @@ </func> <func> - <name>save(Filename) -> ok</name> + <name since="OTP R13B04">save(Filename) -> ok</name> <fsummary>Saves the collected data to file.</fsummary> <type> <v>Filename = filename()</v> @@ -312,7 +312,7 @@ </section> <funcs> <func> - <name>apply(Fun) -> term()</name> + <name since="OTP R13B04">apply(Fun) -> term()</name> <fsummary>Same as <c>apply(Fun, [])</c>.</fsummary> <type> <v>Fun = fun()</v> @@ -322,7 +322,7 @@ </desc> </func> <func> - <name>apply(Fun, Args) -> term()</name> + <name since="OTP R13B04">apply(Fun, Args) -> term()</name> <fsummary>Same as <c>apply(Module, Function, Args)</c>.</fsummary> <type> <v>Fun = fun()</v> @@ -333,7 +333,7 @@ </desc> </func> <func> - <name>apply(Module, Function, Args) -> term()</name> + <name since="OTP R13B04">apply(Module, Function, Args) -> term()</name> <fsummary>Clears counters, applies function and collects the profiling results.</fsummary> <type> <v>Module = atom()</v> @@ -358,12 +358,12 @@ </func> <func> - <name>pid(Id, Serial) -> pid()</name> + <name since="OTP R13B04">pid(Id, Serial) -> pid()</name> <fsummary>Same as <c>pid(node(), Id, Serial)</c>.</fsummary> <desc><p>Same as <c>pid(node(), Id, Serial)</c>.</p></desc> </func> <func> - <name>pid(Node, Id, Serial) -> pid()</name> + <name since="OTP R13B04">pid(Node, Id, Serial) -> pid()</name> <fsummary>Creates a process id with creation 0.</fsummary> <type> <v>Node = node()</v> @@ -376,12 +376,12 @@ </func> <func> - <name>port(Id) -> port()</name> + <name since="OTP R13B04">port(Id) -> port()</name> <fsummary>Same as <c>port(node(), Id)</c>.</fsummary> <desc><p>Same as <c>port(node(), Id)</c>.</p></desc> </func> <func> - <name>port(Node, Id) -> port()</name> + <name since="OTP R13B04">port(Node, Id) -> port()</name> <fsummary>Creates a port id with creation 0.</fsummary> <type> <v>Node = node()</v> @@ -399,12 +399,12 @@ <funcs> <func> - <name>rt_collect() -> [lock_counter_data()]</name> + <name since="OTP R13B04">rt_collect() -> [lock_counter_data()]</name> <fsummary>Same as <c>rt_collect(node())</c>.</fsummary> <desc> <p>Same as <c>rt_collect(node())</c>.</p> </desc> </func> <func> - <name>rt_collect(Node) -> [lock_counter_data()]</name> + <name since="OTP R13B04">rt_collect(Node) -> [lock_counter_data()]</name> <fsummary>Returns a list of raw lock counter data.</fsummary> <type> <v>Node = node()</v> @@ -413,12 +413,12 @@ </func> <func> - <name>rt_clear() -> ok</name> + <name since="OTP R13B04">rt_clear() -> ok</name> <fsummary>Same as <c>rt_clear(node())</c>.</fsummary> <desc> <p>Same as <c>rt_clear(node())</c>.</p> </desc> </func> <func> - <name>rt_clear(Node) -> ok</name> + <name since="OTP R13B04">rt_clear(Node) -> ok</name> <fsummary>Clears the internal counters.</fsummary> <type> <v>Node = node()</v> @@ -427,13 +427,13 @@ </func> <func> - <name>rt_mask() -> [category_atom()]</name> + <name since="OTP 20.1">rt_mask() -> [category_atom()]</name> <fsummary>Same as <c>rt_mask(node())</c>.</fsummary> <desc><p>Same as <c>rt_mask(node())</c>.</p></desc> </func> <func> - <name>rt_mask(Node) -> [category_atom()]</name> + <name since="OTP 20.1">rt_mask(Node) -> [category_atom()]</name> <fsummary>Returns the current lock category mask.</fsummary> <type> <v>Node = node()</v> @@ -447,7 +447,7 @@ </func> <func> - <name>rt_mask(Categories) -> ok | {error, copy_save_enabled}</name> + <name since="OTP 20.1">rt_mask(Categories) -> ok | {error, copy_save_enabled}</name> <fsummary>Same as <c>rt_mask(node(), Categories)</c>.</fsummary> <type> <v>Categories = [atom()]</v> @@ -456,7 +456,7 @@ </func> <func> - <name>rt_mask(Node, Categories) -> ok | {error, copy_save_enabled}</name> + <name since="OTP 20.1">rt_mask(Node, Categories) -> ok | {error, copy_save_enabled}</name> <fsummary>Changes the lock category mask.</fsummary> <type> <v>Node = node()</v> @@ -489,12 +489,12 @@ </func> <func> - <name>rt_opt({Type, bool()}) -> bool()</name> + <name since="OTP R13B04">rt_opt({Type, bool()}) -> bool()</name> <fsummary>Same as <c>rt_opt(node(), {Type, Opt})</c>.</fsummary> <desc> <p>Same as <c>rt_opt(node(), {Type, Opt})</c>.</p> </desc> </func> <func> - <name>rt_opt(Node, {Type, bool()}) -> bool()</name> + <name since="OTP R13B04">rt_opt(Node, {Type, bool()}) -> bool()</name> <fsummary>Changes the lock counter behavior and returns the previous behaviour.</fsummary> <type> <v>Node = node()</v> diff --git a/lib/tools/doc/src/make.xml b/lib/tools/doc/src/make.xml index 123fcd4afc..322d77323f 100644 --- a/lib/tools/doc/src/make.xml +++ b/lib/tools/doc/src/make.xml @@ -30,7 +30,7 @@ <date></date> <rev></rev> </header> - <module>make</module> + <module since="">make</module> <modulesummary>A Make Utility for Erlang</modulesummary> <description> <p>The module <c>make</c> provides a set of functions similar to @@ -38,8 +38,8 @@ </description> <funcs> <func> - <name>all() -> up_to_date | error</name> - <name>all(Options) -> up_to_date | error</name> + <name since="">all() -> up_to_date | error</name> + <name since="">all(Options) -> up_to_date | error</name> <fsummary>Compile a set of modules.</fsummary> <type> <v>Options = [Option]</v> @@ -87,8 +87,8 @@ </desc> </func> <func> - <name>files(ModFiles) -> up_to_date | error</name> - <name>files(ModFiles, Options) -> up_to_date | error</name> + <name since="">files(ModFiles) -> up_to_date | error</name> + <name since="">files(ModFiles, Options) -> up_to_date | error</name> <fsummary>Compile a set of modules.</fsummary> <type> <v>ModFiles = [Module | File]</v> @@ -145,5 +145,10 @@ Modules. {'*',[debug_info]}. </code> <p></p> </section> + + <section> + <title>See Also</title> + <p><seealso marker="compiler:compile"><c>compile(3)</c></seealso></p> + </section> </erlref> diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 8b0a2ca283..fd41e2cbeb 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -31,6 +31,125 @@ </header> <p>This document describes the changes made to the Tools application.</p> +<section><title>Tools 3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Add <c>cprof</c> and <c>tags</c> modules to .app file so + that they are included in releases.</p> + <p> + Own Id: OTP-15534 Aux Id: PR-2078 </p> + </item> + <item> + <p> + Improved documentation parsing in emacs erldoc + functionality.</p> + <p> + Own Id: OTP-15699 Aux Id: PR-2184 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>The <c>cover</c> tool now uses the <c>counters</c> + module instead of <c>ets</c> for updating the counters + for how many times a line has been executed. By default, + Cover will work with distributed nodes, but a new + function <c>cover:local_only/0</c> allows running the + Cover in a restricted but faster local-only mode.</p> + <p>The increase in speed will vary depending on the type + of code being cover-compiled, but as an example, the + compiler test suite runs more than twice as fast with the + new Cover.</p> + <p> + Own Id: OTP-15575</p> + </item> + </list> + </section> + +</section> + +<section><title>Tools 3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Minor fixes for <c>make clean</c>.</p> + <p> + Own Id: OTP-15657</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + In the HTML file generated by + <c>cover:analyse_to_file/1,2</c>, a link is now added to + the line number. This makes it easier to share pointers + to specific lines.</p> + <p> + Own Id: OTP-15541</p> + </item> + <item> + <p> + Uncovered lines are now marked with a sad face, + <c>:-(</c>, in the HTML output from + <c>cover:analyse_to_file/1,2</c>. This is to make these + lines easier to find by search.</p> + <p> + Own Id: OTP-15542</p> + </item> + </list> + </section> + +</section> + +<section><title>Tools 3.0.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Remove emacs warnings and added more tests.</p> + <p> + Own Id: OTP-15476</p> + </item> + </list> + </section> + +</section> + +<section><title>Tools 3.0.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The HTML pages generated by cover:analyse_to_file/1 and + related functions is improved for readability.</p> + <p> + Own Id: OTP-15213 Aux Id: PR-1807 </p> + </item> + <item> + <p> + Add alignment functionality in emacs.</p> + <p> + Own Id: OTP-15239 Aux Id: PR-1728 </p> + </item> + </list> + </section> + +</section> + <section><title>Tools 3.0</title> <section><title>Improvements and New Features</title> @@ -52,6 +171,21 @@ </section> +<section><title>Tools 2.11.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Minor fixes for <c>make clean</c>.</p> + <p> + Own Id: OTP-15657</p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.11.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1829,4 +1963,3 @@ </section> </section> </chapter> - diff --git a/lib/tools/doc/src/tags.xml b/lib/tools/doc/src/tags.xml index ea0ae5cc4d..90a8b28177 100644 --- a/lib/tools/doc/src/tags.xml +++ b/lib/tools/doc/src/tags.xml @@ -32,7 +32,7 @@ <rev>A</rev> <file>tags.sgml</file> </header> - <module>tags</module> + <module since="">tags</module> <modulesummary>Generate Emacs TAGS file from Erlang source files</modulesummary> <description> <p>A <c>TAGS</c> file is used by Emacs to find function and variable @@ -42,14 +42,14 @@ </description> <funcs> <func> - <name>file(File [, Options])</name> + <name since="">file(File [, Options])</name> <fsummary>Create a <c>TAGS</c>file for the file <c>File</c>.</fsummary> <desc> <p>Create a <c>TAGS</c> file for the file <c>File</c>.</p> </desc> </func> <func> - <name>files(FileList [, Options])</name> + <name since="">files(FileList [, Options])</name> <fsummary>Create a TAGS file for the files in the list<c>FileList</c>.</fsummary> <desc> <p>Create a TAGS file for the files in the list @@ -57,7 +57,7 @@ </desc> </func> <func> - <name>dir(Dir [, Options])</name> + <name since="">dir(Dir [, Options])</name> <fsummary>Create a TAGS file for all files in directory<c>Dir</c>.</fsummary> <desc> <p>Create a TAGS file for all files in directory @@ -65,7 +65,7 @@ </desc> </func> <func> - <name>dirs(DirList [, Options])</name> + <name since="">dirs(DirList [, Options])</name> <fsummary>Create a TAGS file for all files in any directory in<c>DirList</c>.</fsummary> <desc> <p>Create a TAGS file for all files in any directory in @@ -73,7 +73,7 @@ </desc> </func> <func> - <name>subdir(Dir [, Options])</name> + <name since="">subdir(Dir [, Options])</name> <fsummary>Descend recursively down the directory <c>Dir</c>and create a <c>TAGS</c>file based on all files found.</fsummary> <desc> <p>Descend recursively down the directory <c>Dir</c> and @@ -81,7 +81,7 @@ </desc> </func> <func> - <name>subdirs(DirList [, Options])</name> + <name since="">subdirs(DirList [, Options])</name> <fsummary>Descend recursively down all the directories in<c>DirList</c>and create a <c>TAGS</c>file based on all files found.</fsummary> <desc> <p>Descend recursively down all the directories in @@ -90,7 +90,7 @@ </desc> </func> <func> - <name>root([Options])</name> + <name since="">root([Options])</name> <fsummary>Create a <c>TAGS</c>file covering all files in the Erlang distribution.</fsummary> <desc> <p>Create a <c>TAGS</c> file covering all files in diff --git a/lib/tools/doc/src/xref.xml b/lib/tools/doc/src/xref.xml index 6f833246ad..ab3641a52f 100644 --- a/lib/tools/doc/src/xref.xml +++ b/lib/tools/doc/src/xref.xml @@ -32,7 +32,7 @@ <rev>PA1</rev> <file>xref.sgml</file> </header> - <module>xref</module> + <module since="">xref</module> <modulesummary>A Cross Reference Tool for analyzing dependencies between functions, modules, applications and releases.</modulesummary> <description> <p>Xref is a cross reference tool that can be used for finding @@ -729,7 +729,7 @@ xref() = atom() | pid() </pre> </description> <funcs> <func> - <name>add_application(Xref, Directory [, Options]) -> {ok, application()} | Error</name> + <name since="">add_application(Xref, Directory [, Options]) -> {ok, application()} | Error</name> <fsummary>Add the modules of an application.</fsummary> <type> <v>Directory = directory()</v> @@ -761,7 +761,7 @@ xref() = atom() | pid() </pre> </desc> </func> <func> - <name>add_directory(Xref, Directory [, Options]) -> {ok, Modules} | Error</name> + <name since="">add_directory(Xref, Directory [, Options]) -> {ok, Modules} | Error</name> <fsummary>Add the modules in a directory.</fsummary> <type> <v>Directory = directory()</v> @@ -791,7 +791,7 @@ xref() = atom() | pid() </pre> </desc> </func> <func> - <name>add_module(Xref, File [, Options]) -> {ok, module()} | Error</name> + <name since="">add_module(Xref, File [, Options]) -> {ok, module()} | Error</name> <fsummary>Add a module.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -814,7 +814,7 @@ xref() = atom() | pid() </pre> </desc> </func> <func> - <name>add_release(Xref, Directory [, Options]) -> {ok, release()} | Error</name> + <name since="">add_release(Xref, Directory [, Options]) -> {ok, release()} | Error</name> <fsummary>Add the modules of a release.</fsummary> <type> <v>Directory = directory()</v> @@ -849,7 +849,7 @@ xref() = atom() | pid() </pre> </desc> </func> <func> - <name>analyze(Xref, Analysis [, Options]) -> {ok, Answer} | Error</name> + <name since="">analyze(Xref, Analysis [, Options]) -> {ok, Answer} | Error</name> <fsummary>Evaluate a predefined analysis.</fsummary> <type> <v>Analysis = undefined_function_calls | undefined_functions | locals_not_used | exports_not_used | deprecated_function_calls | {deprecated_function_calls, DeprFlag} | deprecated_functions | {deprecated_functions, DeprFlag} | {call, FuncSpec} | {use, FuncSpec} | {module_call, ModSpec} | {module_use, ModSpec} | {application_call, AppSpec} | {application_use, AppSpec} | {release_call, RelSpec} | {release_use, RelSpec}</v> @@ -939,7 +939,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>d(Directory) -> [DebugInfoResult] | [NoDebugInfoResult] | Error</name> + <name since="">d(Directory) -> [DebugInfoResult] | [NoDebugInfoResult] | Error</name> <fsummary>Check the modules in a directory using the code path.</fsummary> <type> <v>Directory = directory()</v> @@ -979,8 +979,8 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>forget(Xref) -> ok</name> - <name>forget(Xref, Variables) -> ok | Error</name> + <name since="">forget(Xref) -> ok</name> + <name since="">forget(Xref, Variables) -> ok | Error</name> <fsummary>Remove user variables and their values.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -994,7 +994,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>format_error(Error) -> Chars</name> + <name since="">format_error(Error) -> Chars</name> <fsummary>Return an English description of an Xref error reply.</fsummary> <type> <v>Error = {error, module(), term()}</v> @@ -1008,8 +1008,8 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>get_default(Xref) -> [{Option, Value}]</name> - <name>get_default(Xref, Option) -> {ok, Value} | Error</name> + <name since="">get_default(Xref) -> [{Option, Value}]</name> + <name since="">get_default(Xref, Option) -> {ok, Value} | Error</name> <fsummary>Return the default values of options.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -1023,7 +1023,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>get_library_path(Xref) -> {ok, LibraryPath}</name> + <name since="">get_library_path(Xref) -> {ok, LibraryPath}</name> <fsummary>Return the library path.</fsummary> <type> <v>LibraryPath = library_path()</v> @@ -1034,9 +1034,9 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>info(Xref) -> [Info]</name> - <name>info(Xref, Category) -> [{Item, [Info]}]</name> - <name>info(Xref, Category, Items) -> [{Item, [Info]}]</name> + <name since="">info(Xref) -> [Info]</name> + <name since="">info(Xref, Category) -> [{Item, [Info]}]</name> + <name since="">info(Xref, Category, Items) -> [{Item, [Info]}]</name> <fsummary>Return information about an Xref server.</fsummary> <type> <v>Application = [] | [application()]</v> @@ -1220,8 +1220,8 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>m(Module) -> [DebugInfoResult] | [NoDebugInfoResult] | Error</name> - <name>m(File) -> [DebugInfoResult] | [NoDebugInfoResult] | Error</name> + <name since="">m(Module) -> [DebugInfoResult] | [NoDebugInfoResult] | Error</name> + <name since="">m(File) -> [DebugInfoResult] | [NoDebugInfoResult] | Error</name> <fsummary>Check a module using the code path.</fsummary> <type> <v>DebugInfoResult = {deprecated, [funcall()]} | {undefined, [funcall()]} | {unused, [mfa()]}</v> @@ -1263,7 +1263,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>q(Xref, Query [, Options]) -> {ok, Answer} | Error</name> + <name since="">q(Xref, Query [, Options]) -> {ok, Answer} | Error</name> <fsummary>Evaluate a query.</fsummary> <type> <v>Answer = false | [constant()] | [Call] | [Component] | int() | [DefineAt] | [CallAt] | [AllLines]</v> @@ -1322,7 +1322,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>remove_application(Xref, Applications) -> ok | Error</name> + <name since="">remove_application(Xref, Applications) -> ok | Error</name> <fsummary>Remove applications and their modules.</fsummary> <type> <v>Applications = application() | [application()]</v> @@ -1335,7 +1335,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>remove_module(Xref, Modules) -> ok | Error</name> + <name since="">remove_module(Xref, Modules) -> ok | Error</name> <fsummary>Remove analyzed modules.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -1348,7 +1348,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>remove_release(Xref, Releases) -> ok | Error</name> + <name since="">remove_release(Xref, Releases) -> ok | Error</name> <fsummary>Remove releases and their applications and modules.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -1363,7 +1363,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>replace_application(Xref, Application, Directory [, Options]) -> {ok, application()} | Error</name> + <name since="">replace_application(Xref, Application, Directory [, Options]) -> {ok, application()} | Error</name> <fsummary>Replace an application's modules.</fsummary> <type> <v>Application = application()</v> @@ -1384,7 +1384,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>replace_module(Xref, Module, File [, Options]) -> {ok, module()} | Error</name> + <name since="">replace_module(Xref, Module, File [, Options]) -> {ok, module()} | Error</name> <fsummary>Replace an analyzed module.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -1409,8 +1409,8 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>set_default(Xref, Option, Value) -> {ok, OldValue} | Error</name> - <name>set_default(Xref, OptionValues) -> ok | Error</name> + <name since="">set_default(Xref, Option, Value) -> {ok, OldValue} | Error</name> + <name since="">set_default(Xref, OptionValues) -> ok | Error</name> <fsummary>Set the default values of options.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -1435,7 +1435,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>set_library_path(Xref, LibraryPath [, Options]) -> ok | Error</name> + <name since="">set_library_path(Xref, LibraryPath [, Options]) -> ok | Error</name> <fsummary>Set the library path and finds the library modules.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -1469,7 +1469,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>start(NameOrOptions) -> Return</name> + <name since="">start(NameOrOptions) -> Return</name> <fsummary>Create an Xref server.</fsummary> <type> <v>NameOrOptions = Name | Options</v> @@ -1487,7 +1487,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>start(Name, Options) -> Return</name> + <name since="">start(Name, Options) -> Return</name> <fsummary>Create an Xref server.</fsummary> <type> <v>Name = atom()</v> @@ -1504,7 +1504,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>stop(Xref)</name> + <name since="">stop(Xref)</name> <fsummary>Delete an Xref server.</fsummary> <type> <v>Xref = xref()</v> @@ -1514,7 +1514,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>update(Xref [, Options]) -> {ok, Modules} | Error</name> + <name since="">update(Xref [, Options]) -> {ok, Modules} | Error</name> <fsummary>Replace newly compiled analyzed modules.</fsummary> <type> <v>Error = {error, module(), Reason}</v> @@ -1534,7 +1534,7 @@ Evaluates a predefined analysis. </desc> </func> <func> - <name>variables(Xref [, Options]) -> {ok, [VariableInfo]}</name> + <name since="">variables(Xref [, Options]) -> {ok, [VariableInfo]}</name> <fsummary>Return the names of variables.</fsummary> <type> <v>Options = [Option] | Option</v> diff --git a/lib/tools/emacs/Makefile b/lib/tools/emacs/Makefile index ea4d6cb723..b7775d1c8c 100644 --- a/lib/tools/emacs/Makefile +++ b/lib/tools/emacs/Makefile @@ -46,6 +46,7 @@ EMACS_FILES= \ erlang-eunit \ erlang-edoc \ erlang-flymake \ + erlang-test \ erlang README_FILES= README diff --git a/lib/tools/emacs/erlang-edoc.el b/lib/tools/emacs/erlang-edoc.el index d0dcc81028..ea1e263faf 100644 --- a/lib/tools/emacs/erlang-edoc.el +++ b/lib/tools/emacs/erlang-edoc.el @@ -28,6 +28,7 @@ (defcustom erlang-edoc-indent-level 2 "Indentation level of xhtml in Erlang edoc." + :type '(integer) :safe 'integerp :group 'erlang) diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index 38c40927f4..53543d7b01 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -23,6 +23,7 @@ (eval-when-compile (require 'cl)) +(require 'erlang) (defvar erlang-eunit-src-candidate-dirs '("../src" ".") "*Name of directories which to search for source files matching @@ -331,8 +332,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." t) (apply test-fun test-args) (if under-cover - (save-excursion - (set-buffer (find-file-noselect src-filename)) + (with-current-buffer (find-file-noselect src-filename) (erlang-eunit-analyze-coverage))))))) (defun erlang-eunit-compile-and-run-module-tests-under-cover () @@ -348,8 +348,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (defun erlang-eunit-compile-file (file-path &optional under-cover) (if (file-readable-p file-path) - (save-excursion - (set-buffer (find-file-noselect file-path)) + (with-current-buffer (find-file-noselect file-path) ;; In order to run a code coverage analysis on a ;; module, we have two options: ;; @@ -376,8 +375,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (error msg)))) (defun erlang-eunit-last-compilation-successful-p () - (save-excursion - (set-buffer inferior-erlang-buffer) + (with-current-buffer inferior-erlang-buffer (goto-char compilation-parsing-end) (erlang-eunit-all-list-elems-fulfill-p (lambda (re) (let ((continue t) diff --git a/lib/tools/emacs/erlang-pkg.el b/lib/tools/emacs/erlang-pkg.el index 02d6bebbf4..7e95e4050e 100644 --- a/lib/tools/emacs/erlang-pkg.el +++ b/lib/tools/emacs/erlang-pkg.el @@ -1,3 +1,6 @@ (define-package "erlang" "2.7.0" "Erlang major mode" '((emacs "24.1"))) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 534f50ab33..3ebc6e8e1e 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -1985,7 +1985,7 @@ configured off." The first character of DD is space if the value is less than 10." (let ((date (current-time-string))) (format "%2d %s %s" - (string-to-int (substring date 8 10)) + (string-to-number (substring date 8 10)) (substring date 4 7) (substring date -4)))) diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el index efe3d515e9..fbdd298da3 100644 --- a/lib/tools/emacs/erlang-test.el +++ b/lib/tools/emacs/erlang-test.el @@ -29,7 +29,7 @@ ;; This library require GNU Emacs 25 or later. ;; -;; There are two ways to run emacs unit tests. +;; There are three ways to run the erlang emacs unit tests. ;; ;; 1. Within a running emacs process. Load this file. Then to run ;; all defined test cases: @@ -49,11 +49,22 @@ ;; ;; The -L option adds a directory to the load-path. It should be the ;; directory containing erlang.el and erlang-test.el. +;; +;; 3. Run the emacs_SUITE. The testcases tests_interpreted/1 and +;; tests_compiled/1 in this suite are using the second method. One +;; way to run this suite is with the ct_run tool, for example like the +;; following when standing at the OTP repo top directory: +;; +;; ct_run -suite lib/tools/test/emacs_SUITE +;; +;; Note that this creates a lot of html log files in the current +;; directory. ;;; Code: +(eval-when-compile + (require 'cl)) (require 'ert) -(require 'cl-lib) (require 'erlang) (defvar erlang-test-code @@ -63,7 +74,7 @@ ("SYMBOL" . "-define(SYMBOL, value).") ("MACRO" . "-define(MACRO(X), X + X).") ("struct" . "-record(struct, {until,maps,are,everywhere}).") - ("function". "function() -> #struct{}.")) + ("function" . "function() -> #struct{}.")) "Alist of erlang test code. Each entry have the format (TAGNAME . ERLANG_CODE). If TAGNAME is nil there is no definitions in the ERLANG_CODE. The @@ -116,8 +127,8 @@ concatenated to form an erlang file to test on.") (defun erlang-test-create-erlang-file (erlang-file) (with-temp-file erlang-file - (cl-loop for (_ . code) in erlang-test-code - do (insert code "\n")))) + (loop for (_ . code) in erlang-test-code + do (insert code "\n")))) (defun erlang-test-compile-tags (erlang-file tags-file) (should (zerop (call-process "etags" nil nil nil @@ -132,19 +143,20 @@ concatenated to form an erlang file to test on.") (sort (erlang-expected-completion-table) #'string-lessp)))) (defun erlang-expected-completion-table () - (append (cl-loop for (symbol . _) in erlang-test-code - when (stringp symbol) - append (list symbol (concat "erlang_test:" symbol))) + (append (loop for (symbol . _) in erlang-test-code + when (stringp symbol) + append (list symbol (concat "erlang_test:" symbol))) (list "erlang_test:" "erlang_test:module_info"))) (defun erlang-test-xref-find-definitions (erlang-file erlang-buffer) - (cl-loop for (tagname . code) in erlang-test-code - for line = 1 then (1+ line) - do (when tagname - (switch-to-buffer erlang-buffer) - (erlang-test-xref-jump tagname erlang-file line) - (erlang-test-xref-jump (concat "erlang_test:" tagname) - erlang-file line))) + (loop for (tagname . code) in erlang-test-code + for line = 1 then (1+ line) + do (when tagname + (switch-to-buffer erlang-buffer) + (erlang-test-xref-jump tagname erlang-file line) + (when (string-equal tagname "function") + (erlang-test-xref-jump (concat "erlang_test:" tagname) + erlang-file line)))) (erlang-test-xref-jump "erlang_test:" erlang-file 1)) (defun erlang-test-xref-jump (id expected-file expected-line) @@ -213,27 +225,27 @@ concatenated to form an erlang file to test on.") (ert-deftest erlang-test-parse-id () - (cl-loop for id-string in '("fun/10" - "qualified-function module:fun/10" - "record reko" - "macro _SYMBOL" - "macro MACRO/10" - "module modula" - "macro" - nil) - for id-list in '((nil nil "fun" 10) - (qualified-function "module" "fun" 10) - (record nil "reko" nil) - (macro nil "_SYMBOL" nil) - (macro nil "MACRO" 10) - (module nil "modula" nil) - (nil nil "macro" nil) - nil) - for id-list2 = (erlang-id-to-list id-string) - do (should (equal id-list id-list2)) - for id-string2 = (erlang-id-to-string id-list) - do (should (equal id-string id-string2)) - collect id-list2)) + (loop for id-string in '("fun/10" + "qualified-function module:fun/10" + "record reko" + "macro _SYMBOL" + "macro MACRO/10" + "module modula" + "macro" + nil) + for id-list in '((nil nil "fun" 10) + (qualified-function "module" "fun" 10) + (record nil "reko" nil) + (macro nil "_SYMBOL" nil) + (macro nil "MACRO" 10) + (module nil "modula" nil) + (nil nil "macro" nil) + nil) + for id-list2 = (erlang-id-to-list id-string) + do (should (equal id-list id-list2)) + for id-string2 = (erlang-id-to-string id-list) + do (should (equal id-string id-string2)) + collect id-list2)) (provide 'erlang-test) diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 3211132254..0b3a2319e2 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -4,7 +4,7 @@ ;; Author: Anders Lindgren ;; Keywords: erlang, languages, processes ;; Date: 2011-12-11 -;; Version: 2.8.1 +;; Version: 2.8.2 ;; Package-Requires: ((emacs "24.1")) ;; %CopyrightBegin% @@ -77,6 +77,9 @@ ;;; Code: (eval-when-compile (require 'cl)) +(require 'align) +(require 'comint) +(require 'tempo) ;; Variables: @@ -84,7 +87,7 @@ "The Erlang programming language." :group 'languages) -(defconst erlang-version "2.8.1" +(defconst erlang-version "2.8.2" "The version number of Erlang mode.") (defcustom erlang-root-dir nil @@ -333,6 +336,7 @@ when a new function header is generated. When nil, no blank line is inserted between the current line and the new header. When bound to a number it represents the number of blank lines which should be inserted." + :type '(restricted-sexp :match-alternatives (integerp 'nil)) :group 'erlang) (defvar erlang-electric-semicolon-criteria @@ -498,6 +502,13 @@ regardless of where in the line point is when the TAB command is used." :type 'boolean :safe 'booleanp) +(defcustom erlang-max-files-to-visit-for-refining-xrefs 32 + "Upper limit how many files to visit for checking arity. +When `nil' there is no limit." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) + (defvar erlang-man-inhibit (eq system-type 'windows-nt) "Inhibit the creation of the Erlang Manual Pages menu. @@ -901,8 +912,10 @@ resulting regexp is surrounded by \\_< and \\_>." "dist_get_stat" "dist_ctrl_get_data" "dist_ctrl_get_data_notification" + "dist_ctrl_get_opt" "dist_ctrl_input_handler" "dist_ctrl_put_data" + "dist_ctrl_set_opt" "dmonitor_node" "dt_append_vm_tag_data" "dt_get_tag" @@ -1405,6 +1418,19 @@ Other commands: (add-function :before-until (local 'eldoc-documentation-function) #'erldoc-eldoc-function)) (run-hooks 'erlang-mode-hook) + + ;; Align maps. + (add-to-list 'align-rules-list + '(erlang-maps + (regexp . "\\(\\s-*\\)\\(=>\\)\\s-*") + (modes . '(erlang-mode)) + (repeat . t))) + ;; Align records and :: specs + (add-to-list 'align-rules-list + '(erlang-record-specs + (regexp . "\\(\\s-*\\)\\(=\\).*\\(::\\)*\\s-*") + (modes . '(erlang-mode)) + (repeat . t))) (if (zerop (buffer-size)) (run-hooks 'erlang-new-file-hook))) @@ -1697,10 +1723,10 @@ Personal extensions could be added to `erlang-menu-personal-items'. This function should be called if any variable describing the menu configuration is changed." - (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map t)) + (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map)) -(defun erlang-menu-install (name items keymap &optional popup) +(defun erlang-menu-install (name items keymap) "Install a menu in Emacs based on an abstract description. NAME is the name of the menu. @@ -3670,32 +3696,40 @@ When an identifier is found return a list with 4 elements: module or nil. 2. Module - Module name string or nil. In case of a -qualified-function a search fails if no entries with correct -module are found. For other kinds the module is just a -preference. If no matching entries are found the search will be -retried without regard to module. +qualified-function the module is explicitly specified (like +module:fun()) and the search fails if no entries with correct +module are found. For other kinds the module is guessed: either +fetched from import statements or it is assumed to be the local +module. In these cases the module is just a preference. If no +matching entries are found the search will be retried without +regard to module. 3. Name - String name of function, module, record or macro. 4. Arity - Integer in case of functions and macros if the number of arguments could be found, otherwise nil." (save-excursion - (save-match-data - (if (eq (char-syntax (following-char)) ? ) - (skip-chars-backward " \t")) - (skip-chars-backward "[:word:]_:'") - (cond ((looking-at erlang-module-function-regexp) - (erlang-get-qualified-function-id-at-point)) - ((looking-at (concat erlang-atom-regexp ":")) - (erlang-get-module-id-at-point)) - ((looking-at erlang-name-regexp) - (erlang-get-some-other-id-at-point)))))) - -(defun erlang-get-qualified-function-id-at-point () + (let (case-fold-search) + (save-match-data + (if (eq (char-syntax (following-char)) ? ) + (skip-chars-backward " \t")) + (skip-chars-backward "[:word:]_:'") + (cond ((and (eq (preceding-char) ??) + (looking-at (concat "\\(MODULE\\):" erlang-atom-regexp))) + (erlang-get-qualified-function-id-at-point (erlang-get-module))) + ((looking-at erlang-module-function-regexp) + (erlang-get-qualified-function-id-at-point)) + ((looking-at (concat erlang-atom-regexp ":")) + (erlang-get-module-id-at-point)) + ((looking-at erlang-name-regexp) + (erlang-get-some-other-id-at-point))))))) + +(defun erlang-get-qualified-function-id-at-point (&optional module) (let ((kind 'qualified-function) - (module (erlang-remove-quotes - (buffer-substring-no-properties - (match-beginning 1) (match-end 1)))) + (module (or module + (erlang-remove-quotes + (buffer-substring-no-properties + (match-beginning 1) (match-end 1))))) (name (erlang-remove-quotes (buffer-substring-no-properties (match-beginning (1+ erlang-atom-regexp-matches)) @@ -3805,7 +3839,8 @@ of arguments could be found, otherwise nil." (let ((case-fold-search nil)) ; force string matching to be case sensitive (if (and (stringp str) (not (string-match (eval-when-compile - (concat "\\`" erlang-atom-regexp "\\'")) str))) + (concat "\\`" erlang-atom-regexp "\\'")) + str))) (progn (setq str (replace-regexp-in-string "'" "\\'" str t t )) (concat "'" str "'")) @@ -4193,22 +4228,18 @@ Return t if criteria fulfilled, nil otherwise." nil))))) -(defun erlang-in-literal (&optional lim) +(defun erlang-in-literal () "Test if point is in string, quoted atom or comment. Return one of the three atoms `atom', `string', and `comment'. Should the point be inside none of the above mentioned types of context, nil is returned." (save-excursion - (let* ((lim (or lim (save-excursion - (erlang-beginning-of-clause) - (point)))) - (state (funcall (symbol-function 'syntax-ppss)))) - (cond - ((eq (nth 3 state) ?') 'atom) - ((nth 3 state) 'string) - ((nth 4 state) 'comment) - (t nil))))) + (let ((state (funcall (symbol-function 'syntax-ppss)))) + (cond ((eq (nth 3 state) ?') 'atom) + ((nth 3 state) 'string) + ((nth 4 state) 'comment) + (t nil))))) (defun erlang-at-end-of-function-p () @@ -4863,15 +4894,36 @@ about Erlang modules." ;; The backend below is a wrapper around the built-in etags backend. ;; It adds awareness of the module:tag syntax in a similar way that is ;; done above for the old etags commands. +;; +;; In addition arity is also considered when jumping to definitions. +;; There is however currently no information about arity in the TAGS +;; file. Also two functions with the same name but different arity +;; _sometimes_ get one TAGS entry each and sometimes are joined in one +;; single entry. If they are directly consecutive they will be +;; joined. If there are other functions etc in between then they will +;; get one entry each. +;; +;; These limitations are present in both the etags program shipped +;; with GNU Emacs and the tags.erl program in this repository. +;; +;; Therefore erlang.el must complement the information in TAGS by +;; visiting files and checking arity. When searching for popular +;; function names (like init, handle_call etc) in a big TAGS file +;; (like one indexing this repository) this may be quite +;; time-consuming. There exists therefore an upper limit for the +;; number of files to visit (called +;; `erlang-max-files-to-visit-for-refining-xrefs'). +;; +;; As mentioned this xref implementation is based on the etags xref +;; implementation. But in the cases where arity is considered the +;; etags information structures (class xref-etags-location) will be +;; translated to our own structures which include arity (class +;; erlang-xref-location). This translation is started in the function +;; `erlang-refine-xrefs'. -(defvar erlang-current-arity nil - "The arity of the function currently being searched. - -There is no information about arity in the TAGS file. -Consecutive functions with same name but different arity will -only get one entry in the TAGS file. Matching TAGS entries are -therefore selected without regarding arity. The arity is -considered first when it is time to jump to the definition.") +;; I mention this as a head up that some of the functions below deal +;; with xref items with xref-etags-location and some deal with xref +;; items with erlang-xref-location. (defun erlang-etags--xref-backend () 'erlang-etags) @@ -4879,127 +4931,80 @@ considered first when it is time to jump to the definition.") (when (locate-library (symbol-name feature)) (require feature))) -(and (erlang-soft-require 'xref) - (erlang-soft-require 'cl-generic) - (erlang-soft-require 'eieio) - (erlang-soft-require 'etags) - ;; The purpose of using eval here is to avoid compilation - ;; warnings in emacsen without cl-defmethod etc. - (eval - '(progn - (cl-defmethod xref-backend-identifier-at-point - ((_backend (eql erlang-etags))) - (if (eq this-command 'xref-find-references) - (if (use-region-p) - (buffer-substring-no-properties (region-beginning) - (region-end)) - (thing-at-point 'symbol)) - (erlang-id-to-string (erlang-get-identifier-at-point)))) - - (cl-defmethod xref-backend-definitions - ((_backend (eql erlang-etags)) identifier) - (erlang-xref-find-definitions identifier)) - - (cl-defmethod xref-backend-apropos - ((_backend (eql erlang-etags)) identifier) - (erlang-xref-find-definitions identifier t)) - - (cl-defmethod xref-backend-identifier-completion-table - ((_backend (eql erlang-etags))) - (let ((erlang-replace-etags-tags-completion-table t)) - (tags-completion-table))) - - (defclass erlang-xref-location (xref-etags-location) ()) - - (defun erlang-convert-xrefs (xrefs) - (mapcar (lambda (xref) - (oset xref location (erlang-make-location - (oref xref location))) - xref) - xrefs)) - - (defun erlang-make-location (etags-location) - (with-slots (tag-info file) etags-location - (make-instance 'erlang-xref-location :tag-info tag-info - :file file))) - - (cl-defmethod xref-location-marker ((locus erlang-xref-location)) - (with-slots (tag-info file) locus - (with-current-buffer (find-file-noselect file) - (save-excursion - (or (erlang-goto-tag-location-by-arity tag-info) - (etags-goto-tag-location tag-info)) - ;; Reset erlang-current-arity. We want to jump to - ;; correct arity in the first attempt. That is now - ;; done. Possible remaining jumps will be from - ;; entries in the *xref* buffer and then we want to - ;; ignore the arity. (Alternatively we could remove - ;; all but one xref entry per file when we know the - ;; arity). - (setq erlang-current-arity nil) - (point-marker))))) - - (defun erlang-xref-context (xref) - (with-slots (tag-info) (xref-item-location xref) - (car tag-info)))))) - - -(defun erlang-goto-tag-location-by-arity (tag-info) - (when erlang-current-arity - (let* ((tag-text (car tag-info)) - (tag-pos (cdr (cdr tag-info))) - (tag-line (car (cdr tag-info))) - (regexp (erlang-tag-info-regexp tag-text)) - (startpos (or tag-pos - (when tag-line - (goto-char (point-min)) - (forward-line (1- tag-line)) - (point)) - (point-min)))) - (setq startpos (max (- startpos 2000) - (point-min))) - (goto-char startpos) - (let ((pos (or (erlang-search-by-arity regexp) - (unless (eq startpos (point-min)) - (goto-char (point-min)) - (erlang-search-by-arity regexp))))) - (when pos - (goto-char pos) - t))))) - -(defun erlang-tag-info-regexp (tag-text) - (concat "^" - (regexp-quote tag-text) - ;; Erlang function entries in TAGS includes the opening - ;; parenthesis for the argument list. Erlang macro entries - ;; do not. Add it here in order to end up in correct - ;; position for erlang-get-arity. - (if (string-prefix-p "-define" tag-text) - "\\s-*(" - ""))) - -(defun erlang-search-by-arity (regexp) - (let (pos) - (while (and (null pos) - (re-search-forward regexp nil t)) - (when (eq erlang-current-arity (save-excursion (erlang-get-arity))) - (setq pos (point-at-bol)))) - pos)) - - +(when (and (erlang-soft-require 'xref) + (erlang-soft-require 'cl-generic) + (erlang-soft-require 'eieio) + (erlang-soft-require 'etags)) + ;; The purpose of using eval here is to avoid compilation + ;; warnings in emacsen without cl-defmethod etc. + (eval + '(progn + (cl-defmethod xref-backend-identifier-at-point ((_backend + (eql erlang-etags))) + (if (eq this-command 'xref-find-references) + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end)) + (thing-at-point 'symbol)) + (erlang-id-to-string (erlang-get-identifier-at-point)))) + + (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags)) + identifier) + (erlang-xref-find-definitions identifier)) + + (cl-defmethod xref-backend-apropos ((_backend (eql erlang-etags)) + identifier) + (erlang-xref-find-definitions identifier t)) + + (cl-defmethod xref-backend-identifier-completion-table + ((_backend (eql erlang-etags))) + (let ((erlang-replace-etags-tags-completion-table t)) + (tags-completion-table))) + + (defclass erlang-xref-location (xref-file-location) + ((arity :type fixnum :initarg :arity + :reader erlang-xref-location-arity)) + :documentation "An erlang location is a file location plus arity.") + + ;; This method definition only calls the superclass which is + ;; the default behaviour if it was not defined. It is only + ;; needed for "upgrade" purposes. In version 2.8.1 of + ;; erlang.el this method was defined differently and in case + ;; user switch to a new erlang.el without restarting Emacs + ;; this method needs to be redefined. + (cl-defmethod xref-location-marker ((locus erlang-xref-location)) + (cl-call-next-method locus))))) + +;; If this function returns a single xref the user will jump to that +;; directly. If two or more xrefs are returned a *xref* window is +;; displayed and the user can choose where to jump. Hence we want to +;; return a single xref when we are pretty sure that is where the user +;; wants to go. Otherwise return all possible xrefs but sort them so +;; that xrefs in the local file is first and if arity is known sort +;; the xrefs with matching arity before others. + +;; Note that the arity sorting work may partly be undone later when +;; the hits are presented in the *xref* buffer since they then will be +;; grouped together by file. Ie when one file have one hit with +;; correct arity and others with wrong arity these hits will be +;; grouped together and may end up before hits with correct arity. (defun erlang-xref-find-definitions (identifier &optional is-regexp) (erlang-with-id (kind module name arity) identifier - (setq erlang-current-arity arity) (cond ((eq kind 'module) (erlang-xref-find-definitions-module name)) + ((eq kind 'qualified-function) + (erlang-xref-find-definitions-qualified-function module + name + arity + is-regexp)) (module - (erlang-xref-find-definitions-module-tag module + (erlang-xref-find-definitions-module-tag kind + module name - (eq kind - 'qualified-function) + arity is-regexp)) (t - (erlang-xref-find-definitions-tag kind name is-regexp))))) + (erlang-xref-find-definitions-tag kind name arity is-regexp))))) (defun erlang-xref-find-definitions-module (module) (and (fboundp 'xref-make) @@ -5024,62 +5029,252 @@ considered first when it is time to jump to the definition.") (setq files (cdr files)))))) (nreverse xrefs)))) -(defun erlang-visit-tags-table-buffer (cont cbuf) - (if (< emacs-major-version 26) - (visit-tags-table-buffer cont) - (visit-tags-table-buffer cont cbuf))) - -(defun erlang-xref-find-definitions-module-tag (module +(defun erlang-xref-find-definitions-qualified-function (module + tag + arity + is-regexp) + "Find definitions of TAG in MODULE preferably with arity ARITY. +If one single perfect match was found return only that (ignoring +other definitions matching TAG). If IS-REGEXP is non-nil then +TAG is a regexp." + (let* ((xrefs (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions tag is-regexp))) + (xrefs-split (erlang-split-xrefs-on-module xrefs module)) + (module-xrefs (car xrefs-split)) + (module-xrefs (erlang-refine-xrefs module-xrefs + 'qualified-function + tag + is-regexp))) + (or (erlang-single-arity-match module-xrefs arity) + (erlang-sort-by-arity module-xrefs arity)))) + + +;; We will end up here when erlang-get-some-other-id-at-point either +;; found module among the import statements or module is just the +;; current local file. +(defun erlang-xref-find-definitions-module-tag (kind + module tag - is-qualified + arity is-regexp) - "Find definitions of TAG and filter away definitions outside of -MODULE. If IS-QUALIFIED is nil and no definitions was found inside -the MODULE then return any definitions found outside. If -IS-REGEXP is non-nil then TAG is a regexp." - (and (fboundp 'etags--xref-find-definitions) - (fboundp 'erlang-convert-xrefs) - (let ((xrefs (erlang-convert-xrefs - (etags--xref-find-definitions tag is-regexp))) - xrefs-in-module) - (dolist (xref xrefs) - (when (string-equal module (erlang-xref-module xref)) - (push xref xrefs-in-module))) - (cond (is-qualified xrefs-in-module) - (xrefs-in-module xrefs-in-module) - (t xrefs))))) - -(defun erlang-xref-find-definitions-tag (kind tag is-regexp) - "Find all definitions of TAG and reorder them so that -definitions in the currently visited file comes first." - (and (fboundp 'etags--xref-find-definitions) - (fboundp 'erlang-convert-xrefs) - (let* ((current-file (and (buffer-file-name) - (file-truename (buffer-file-name)))) - (regexp (erlang-etags-regexp kind tag is-regexp)) - (xrefs (erlang-convert-xrefs - (etags--xref-find-definitions regexp t))) - local-xrefs non-local-xrefs) - (while xrefs - (let ((xref (car xrefs))) - (if (string-equal (erlang-xref-truename-file xref) - current-file) - (push xref local-xrefs) - (push xref non-local-xrefs)) - (setq xrefs (cdr xrefs)))) - (append (reverse local-xrefs) - (reverse non-local-xrefs))))) + "Find definitions of TAG preferably in MODULE and with arity ARITY. +Return definitions outside MODULE if none are found inside. If +IS-REGEXP is non-nil then TAG is a regexp. + +If one single perfect match was found return only that (ignoring +other definitions matching TAG)." + (let* ((xrefs (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions tag is-regexp))) + (xrefs-split (erlang-split-xrefs-on-module xrefs module)) + (module-xrefs (car xrefs-split)) + (module-xrefs (erlang-refine-xrefs module-xrefs + kind + tag + is-regexp))) + (or (erlang-single-arity-match module-xrefs arity) + (erlang-xref-find-definitions-tag kind tag arity is-regexp xrefs)))) + +(defun erlang-xref-find-definitions-tag (kind + tag + arity + is-regexp + &optional xrefs) + "Find definitions of TAG preferably in local file and with arity ARITY. +If one single perfect match was found return only that (ignoring +other definitions matching TAG). If no such local match was +found then look for a matching BIF in the same way. If IS-REGEXP +is non-nil then TAG is a regexp." + (let* ((regexp (erlang-etags-regexp kind tag is-regexp)) + (xrefs (or xrefs + (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions regexp t)))) + (xrefs-split (erlang-split-xrefs xrefs)) + (local-xrefs (car xrefs-split)) + (local-xrefs (erlang-refine-xrefs local-xrefs + kind + tag + is-regexp)) + (bif-xrefs (cadr xrefs-split)) + (other-xrefs (caddr xrefs-split))) + (or (erlang-single-arity-match local-xrefs arity) + ;; No local match, look for a matching BIF. + (progn + (setq bif-xrefs (erlang-refine-xrefs bif-xrefs + kind + tag + is-regexp)) + (erlang-single-arity-match bif-xrefs arity)) + (progn + (setq other-xrefs (erlang-refine-xrefs other-xrefs + kind + tag + is-regexp)) + (and (null local-xrefs) + (null bif-xrefs) + ;; No local of BIF matches at all. Is there a single + ;; arity match among the rest? + (erlang-single-arity-match other-xrefs arity))) + (append (erlang-sort-by-arity local-xrefs arity) + (erlang-sort-by-arity bif-xrefs arity) + (erlang-sort-by-arity other-xrefs arity))))) + + +(defun erlang-refine-xrefs (xrefs kind tag is-regexp) + (if (or (memq kind '(record module)) + ;; No support for apropos here. + is-regexp + (erlang-too-many-files-in-xrefs xrefs)) + xrefs + (when (and xrefs + (fboundp 'xref-item-location) + (fboundp 'xref-location-group) + (fboundp 'slot-value)) + (let (files) + (cl-loop for xref in xrefs + for loc = (xref-item-location xref) + for file = (xref-location-group loc) + do (pushnew file files :test 'string-equal)) + (or (cl-loop for file in files + append (erlang-xrefs-in-file file kind tag is-regexp)) + ;; Failed for some reason. Pretend like it is raining and + ;; return the unrefined xrefs. + xrefs))))) + +(defun erlang-too-many-files-in-xrefs (xrefs) + (and erlang-max-files-to-visit-for-refining-xrefs + (let ((files-to-visit (delete-dups + (mapcar #'erlang-xref-truename-file + xrefs)))) + (if (< (length files-to-visit) + erlang-max-files-to-visit-for-refining-xrefs) + nil + (message (concat "Too many hits to consider arity (see " + "`erlang-max-files-to-visit-for-refining-xrefs')")) + t)))) + +(defun erlang-xrefs-in-file (file kind tag is-regexp) + (when (fboundp 'make-instance) + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (let ((regexp (concat ; "^" + (erlang-etags-regexp kind tag is-regexp) + "\\s *(")) + last-arity) + (cl-loop while (re-search-forward regexp nil t) + for name = (match-string-no-properties 1) + for arity = (save-excursion + (erlang-get-arity)) + for loc = (make-instance 'erlang-xref-location + :file file + :line (line-number-at-pos) + :column 0 + :arity arity) + for sum = (erlang-xref-summary kind name arity) + when (and arity + (not (eq arity last-arity))) + collect (make-instance 'xref-item + :summary sum + :location loc) + do (setq last-arity arity))))))) + +(defun erlang-xref-summary (kind tag arity) + (format "%s%s%s" + (if (memq kind '(record macro module)) + (format "%s " kind) + "") + tag + (if arity (format "/%s" arity) ""))) + +(defun erlang-single-arity-match (xrefs wanted-arity) + "Attempt to find one perfect match. + +If we have all information needed to consider arity then return a +single perfect match or nothing. If there are more than one +match nothing is returned. + +If we don't have all information needed to consider arity just +return XREFS as is." + (if (erlang-should-consider-arity-p xrefs wanted-arity) + (let ((nr-matches 0) + match) + (while (and xrefs + (< nr-matches 2)) + (let* ((xref (car xrefs)) + (arity (erlang-xref-arity xref))) + (when (eq arity wanted-arity) + (setq match xref + nr-matches (1+ nr-matches))) + (setq xrefs (cdr xrefs)))) + (when (eq nr-matches 1) + (list match))) + (when (eq (length xrefs) 1) + xrefs))) + +(defun erlang-sort-by-arity (xrefs wanted-arity) + (if (erlang-should-consider-arity-p xrefs wanted-arity) + (let (matches non-matches) + (while xrefs + (let* ((xref (car xrefs)) + (arity (erlang-xref-arity xref))) + (push xref (if (eq arity wanted-arity) + matches + non-matches)) + (setq xrefs (cdr xrefs)))) + (append (reverse matches) (reverse non-matches) xrefs)) + xrefs)) + +(defun erlang-should-consider-arity-p (xrefs wanted-arity) + (and wanted-arity + xrefs + (fboundp 'erlang-xref-location-p) + (fboundp 'xref-item-location) + (erlang-xref-location-p (xref-item-location (car xrefs))))) (defun erlang-etags-regexp (kind tag is-regexp) - (let ((tag-regexp (if is-regexp - tag - (regexp-quote tag)))) - (cond ((eq kind 'record) - (concat "-record\\s-*(\\s-*" tag-regexp)) - ((eq kind 'macro) - (concat "-define\\s-*(\\s-*" tag-regexp)) - (t tag-regexp)))) - + (let ((tag-regexp (concat "\\(" + (if is-regexp + tag + (regexp-quote tag)) + "\\)"))) + (concat (if is-regexp "" "^") + (cond ((eq kind 'record) + (concat "-record\\s-*(\\s-*" tag-regexp)) + ((eq kind 'macro) + (concat "-define\\s-*(\\s-*" tag-regexp)) + (t + tag-regexp)) + (if is-regexp "" "\\_>")))) + +(defun erlang-xref-arity (xref) + (and (fboundp 'erlang-xref-location-arity) + (fboundp 'xref-item-location) + (erlang-xref-location-arity (xref-item-location xref)))) + +(defun erlang-split-xrefs-on-module (xrefs module) + (let (local-xrefs non-local-xrefs) + (dolist (xref xrefs) + (if (string-equal (erlang-xref-module xref) + module) + (push xref local-xrefs) + (push xref non-local-xrefs))) + (cons (reverse local-xrefs) + (reverse non-local-xrefs)))) + +(defun erlang-split-xrefs (xrefs) + (let ((current-file (and (buffer-file-name) + (file-truename (buffer-file-name)))) + local-xrefs bif-xrefs other-xrefs) + (dolist (xref xrefs) + (cond ((string-equal (erlang-xref-truename-file xref) current-file) + (push xref local-xrefs)) + ((string-equal (erlang-xref-module xref) "erlang") + (push xref bif-xrefs)) + (t + (push xref other-xrefs)))) + (list (reverse local-xrefs) + (reverse bif-xrefs) + (reverse other-xrefs)))) (defun erlang-xref-module (xref) (erlang-get-module-from-file-name (erlang-xref-file xref))) @@ -5094,7 +5289,13 @@ definitions in the currently visited file comes first." (fboundp 'xref-item-location) (xref-location-group (xref-item-location xref)))) - +(defun erlang-visit-tags-table-buffer (cont cbuf) + (if (< emacs-major-version 26) + (visit-tags-table-buffer cont) + ;; Remove this with-no-warnings when Emacs 26 is the required + ;; version minimum. + (with-no-warnings + (visit-tags-table-buffer cont cbuf)))) ;;; ;;; Prepare for other methods to run an Erlang slave process. @@ -5522,7 +5723,7 @@ Return the position after the newly inserted command." (+ insert-point insert-length))) -(defun inferior-erlang-strip-delete (&optional s) +(defun inferior-erlang-strip-delete (&optional _s) "Remove `^H' (delete) and the characters it was supposed to remove." (interactive) (if (and (boundp 'comint-last-input-end) @@ -5540,7 +5741,7 @@ Return the position after the newly inserted command." ;; Basically `comint-strip-ctrl-m', with a few extra checks. -(defun inferior-erlang-strip-ctrl-m (&optional string) +(defun inferior-erlang-strip-ctrl-m (&optional _string) "Strip trailing `^M' characters from the current output group." (interactive) (if (and (boundp 'comint-last-input-end) @@ -5577,8 +5778,8 @@ There exists two workarounds for this bug: (let* ((dir (inferior-erlang-compile-outdir)) (noext (substring (erlang-local-buffer-file-name) 0 -4)) (opts (append (list (cons 'outdir dir)) - (if current-prefix-arg - (list 'debug_info 'export_all)) + (when arg + (list 'debug_info 'export_all)) erlang-compile-extra-opts)) end) (with-current-buffer inferior-erlang-buffer @@ -5627,7 +5828,6 @@ unless the optional NO-DISPLAY is non-nil." (defun inferior-erlang-compute-compile-command (module-name opts) (let ((ccfn erlang-compile-command-function-alist) - (res (inferior-erlang-compute-erl-compile-command module-name opts)) ccfn-entry done result) diff --git a/lib/tools/emacs/erlang_appwiz.el b/lib/tools/emacs/erlang_appwiz.el index ecbce66f47..b71c180739 100644 --- a/lib/tools/emacs/erlang_appwiz.el +++ b/lib/tools/emacs/erlang_appwiz.el @@ -103,6 +103,10 @@ ;; ;; +(defvar appwiz-erlang-modulename "foo") +(defvar appwiz-erlang-ext "_work") + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Erlang application wizard @@ -245,13 +249,6 @@ creating the root directory and for naming application files." (insert "Application specification file for " name ".") (save-buffer))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; These are setq:ed -;; - -(defvar appwiz-erlang-modulename "foo") -(defvar appwiz-erlang-ext "_work") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -468,7 +465,7 @@ Call the function `erlang-menu-init' after modifying this variable.") The first character of DD is *not* space if the value is less than 10." (let ((date (current-time-string))) (format "%d %s %s" - (string-to-int (substring date 8 10)) + (string-to-number (substring date 8 10)) (substring date 4 7) (substring date -4)))) diff --git a/lib/tools/emacs/erldoc.el b/lib/tools/emacs/erldoc.el index 770ab299ee..bc16d7a14d 100644 --- a/lib/tools/emacs/erldoc.el +++ b/lib/tools/emacs/erldoc.el @@ -89,6 +89,13 @@ up the indexing." :type 'file :group 'erldoc) +(defcustom erldoc-no-signature-function #'ignore + "Notification function called if no function signature was found." + :type '(choice (function-item :tag "Ignore" ignore) + (function-item :tag "Warn" warn) + (function-item :tag "Error" error)) + :group 'erldoc) + (defun erldoc-strip-string (s) (let* ((re "[ \t\n\r\f\v\u00a0]+") (from (if (string-match (concat "\\`" re) s) (match-end 0) 0)) @@ -212,11 +219,21 @@ up the indexing." ;; Get the full function signature. (when (and (eq (car-safe d) 'a) (gethash (erldoc-dom-get-attribute d 'name) table)) - (push (append (gethash (erldoc-dom-get-attribute d 'name) table) - (list (funcall span-content - (or (erldoc-dom-get-element d 'span) - (cadr (memq d erldoc-dom-walk-siblings)))))) - entries)) + (let* ((name (erldoc-dom-get-attribute d 'name)) + (mfa-url (gethash name table)) + (mfa (car mfa-url)) + (sig (or (funcall span-content d) + (funcall span-content + (or (erldoc-dom-get-element d 'span) + (cadr + (memq d erldoc-dom-walk-siblings)))) + (progn + (funcall erldoc-no-signature-function + "erldoc-parse-man: no sig for %s" + mfa) + nil)))) + (push (append mfa-url (list sig)) + entries))) ;; Get data types (when (and (eq (car-safe d) 'a) (string-prefix-p "type-" @@ -280,7 +297,7 @@ up the indexing." (unless (file-exists-p of) (erldoc-parse-all erldoc-man-index of)) (unless (string= erldoc-output-file of) - (make-symbolic-link of erldoc-output-file)))) + (make-symbolic-link (expand-file-name of) erldoc-output-file)))) (setq erldoc-lookup-table (with-temp-buffer (insert-file-contents erldoc-output-file) @@ -356,9 +373,12 @@ up the indexing." (sigs)) (maphash (lambda (k v) (when (string-match re k) - (push (cons (string-to-number (match-string 1 k)) - (cdr (erldoc-tokenize-signature (cadr v)))) - sigs))) + (if (cadr v) + (push (cons (string-to-number (match-string 1 k)) + (cdr (erldoc-tokenize-signature (cadr v)))) + sigs) + (funcall erldoc-no-signature-function + "erldoc-format-signature: No sig for %s" k)))) (erldoc-lookup-table)) (when sigs ;; Mostly single return type but there are exceptions such as diff --git a/lib/tools/priv/styles.css b/lib/tools/priv/styles.css new file mode 100644 index 0000000000..84f00be9fd --- /dev/null +++ b/lib/tools/priv/styles.css @@ -0,0 +1,96 @@ +body { + font: 14px/1.6 "Helvetica Neue", Helvetica, Arial, sans-serif; + margin: 0; + padding: 0; + color: #000; + border-top: 2px solid #ddd; + background-color: #fff; + + min-height: 100%; + display: flex; + flex-direction: column; +} + +h1 { + width: 100%; + border-bottom: 1px solid #eee; + margin-bottom: 0; + font-weight: 100; + font-size: 1.1em; + letter-spacing: 1px; +} + +h1 code { + font-size: 0.96em; +} + +code { + font: 12px monospace; +} + +footer { + background: #eee; + width: 100%; + padding: 10px 0; + text-align: right; + border-top: 1px solid #ddd; + display: flex; + flex: 1; + order: 2; + justify-content: center; +} + +table { + width: 100%; + margin-top: 10px; + border-collapse: collapse; + border: 1px solid #cbcbcb; + color: #000; + -webkit-border-radius: 3px; + -moz-border-radius: 3px; +} +table thead { + display: none; +} +table td.line, +table td.line a, +table td.hits { + width: 20px; + background: #eaeaea; + text-align: center; + text-decoration: none; + font-size: 11px; + padding: 0 10px; + color: #949494; +} +table td.hits { + width: 10px; + text-align: right; + padding: 2px 5px; + color: rgba(0, 0, 0, 0.6); + background-color: #f0f0f0; +} +tr.miss td.line, +tr.miss td.line a, +tr.miss td.hits { + background-color: #ffdce0; + border-color: #fdaeb7; +} +tr.miss td { + background-color: #ffeef0; +} +tr.hit td.line, +tr.hit td.line a, +tr.hit td.hits { + background-color: #cdffd8; + border-color: #bef5cb; +} +tr.hit td { + background-color: #e6ffed; +} +td.source { + padding-left: 15px; + line-height: 15px; + white-space: pre; + font: 12px monospace; +} diff --git a/lib/tools/src/Makefile b/lib/tools/src/Makefile index 032bd612db..cc5bee9a8f 100644 --- a/lib/tools/src/Makefile +++ b/lib/tools/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2016. All Rights Reserved. +# Copyright Ericsson AB 1996-2018. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -72,6 +72,9 @@ APP_TARGET = $(EBIN)/$(APP_FILE) APPUP_SRC = $(APPUP_FILE).src APPUP_TARGET = $(EBIN)/$(APPUP_FILE) +PRIVDIR = ../priv +CSS = $(PRIVDIR)/styles.css + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -110,5 +113,7 @@ release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/ebin" $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) \ "$(RELSYSDIR)/ebin" + $(INSTALL_DIR) "$(RELSYSDIR)/priv" + $(INSTALL_DATA) $(CSS) "$(RELSYSDIR)/priv" release_docs_spec: diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index bf5faa165d..8fe866cb69 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2017. All Rights Reserved. +%% Copyright Ericsson AB 2001-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,6 +23,7 @@ %% This module implements the Erlang coverage tool. %% %% ARCHITECTURE +%% %% The coverage tool consists of one process on each node involved in %% coverage analysis. The process is registered as 'cover_server' %% (?SERVER). The cover_server on the 'main' node is in charge, and @@ -30,45 +31,62 @@ %% 'DOWN' message for another cover_server, it marks the node as %% 'lost'. If a nodeup is received for a lost node the main node %% ensures that the cover compiled modules are loaded again. If the -%% remote node was alive during the disconnected periode, cover data -%% for this periode will also be included in the analysis. +%% remote node was alive during the disconnected period, cover data +%% for this period will also be included in the analysis. %% %% The cover_server process on the main node is implemented by the %% functions init_main/1 and main_process_loop/1. The cover_server on %% the remote nodes are implemented by the functions init_remote/2 and %% remote_process_loop/1. %% +%% COUNTERS +%% +%% The 'counters' modules is used for counting how many time each line +%% executed. Each cover-compiled module will have its own array of +%% counters. +%% +%% The counter reference for module Module is stored in a persistent +%% term with the key {cover,Module}. +%% +%% When the cover:local_only/0 function has been called, the reference +%% for the counter array will be compiled into each cover-compiled +%% module directly (instead of retrieving it from a persistent term). +%% That will be faster, but the resulting code can be only be used on +%% the main node. +%% %% TABLES -%% Each nodes has two tables: cover_internal_data_table (?COVER_TABLE) and. -%% cover_internal_clause_table (?COVER_CLAUSE_TABLE). -%% ?COVER_TABLE contains the bump data i.e. the data about which lines -%% have been executed how many times. +%% +%% Each node has two tables: ?COVER_MAPPING_TABLE and ?COVER_CLAUSE_TABLE. +%% ?COVER_MAPPING_TABLE maps from a #bump{} record to an index in the +%% counter array for the module. It is used both during instrumentation +%% of cover-compiled modules and when collecting the counter values. +%% %% ?COVER_CLAUSE_TABLE contains information about which clauses in which modules %% cover is currently collecting statistics. -%% -%% The main node owns tables named -%% 'cover_collected_remote_data_table' (?COLLECTION_TABLE) and -%% 'cover_collected_remote_clause_table' (?COLLECTION_CLAUSE_TABLE). -%% These tables contain data which is collected from remote nodes (either when a -%% remote node is stopped with cover:stop/1 or when analysing). When -%% analysing, data is even moved from the COVER tables on the main -%% node to the COLLECTION tables. %% -%% The main node also has a table named 'cover_binary_code_table' -%% (?BINARY_TABLE). This table contains the binary code for each cover -%% compiled module. This is necessary so that the code can be loaded -%% on remote nodes that are started after the compilation. +%% The main node owns the tables ?COLLECTION_TABLE and +%% ?COLLECTION_CLAUSE_TABLE. The counter data is consolidated into those +%% tables from the counters on both the main node and from remote nodes. +%% This consolidation is done when a remote node is stopped with +%% cover:stop/1 or just before starting an analysis. +%% +%% The main node also has a table named ?BINARY_TABLE. This table +%% contains the abstract code code for each cover-compiled +%% module. This is necessary so that the code can be loaded on remote +%% nodes that are started after the compilation. %% %% PARALLELISM +%% %% To take advantage of SMP when doing the cover analysis both the data %% collection and analysis has been parallelized. One process is spawned for %% each node when collecting data, and on the remote node when collecting data %% one process is spawned per module. %% -%% When analyzing data it is possible to issue multiple analyse(_to_file)/X -%% calls at once. They are however all calls (for backwards compatibility -%% reasons) so the user of cover will have to spawn several processes to to the -%% calls ( or use async_analyse_to_file ). +%% When analyzing data it is possible to issue multiple +%% analyse(_to_file)/X calls at once. They are, however, all calls +%% (for backwards compatibility reasons), so the user of cover will +%% have to spawn several processes to to the calls (or use +%% async_analyse_to_file/X). %% %% External exports @@ -89,7 +107,8 @@ modules/0, imported/0, imported_modules/0, which_nodes/0, is_compiled/1, reset/1, reset/0, flush/1, - stop/0, stop/1]). + stop/0, stop/1, + local_only/0]). -export([remote_start/1,get_main_node/0]). %% Used internally to ensure we upgrade the code to the latest version. @@ -98,9 +117,16 @@ -record(main_state, {compiled=[], % [{Module,File}] imported=[], % [{Module,File,ImportFile}] stopper, % undefined | pid() + local_only=false, % true | false nodes=[], % [Node] lost_nodes=[]}). % [Node] +-record(remote_data, {module, + file, + code, + mapping, + clauses}). + -record(remote_state, {compiled=[], % [{Module,File}] main_node}). % atom() @@ -126,11 +152,12 @@ is_guard=false % boolean }). --define(COVER_TABLE, 'cover_internal_data_table'). +-define(COVER_MAPPING_TABLE, 'cover_internal_mapping_table'). -define(COVER_CLAUSE_TABLE, 'cover_internal_clause_table'). -define(BINARY_TABLE, 'cover_binary_code_table'). -define(COLLECTION_TABLE, 'cover_collected_remote_data_table'). -define(COLLECTION_CLAUSE_TABLE, 'cover_collected_remote_clause_table'). + -define(TAG, cover_compiled). -define(SERVER, cover_server). @@ -144,6 +171,8 @@ end). -define(SPAWN_DBG(Tag,Value),put(Tag,Value)). +-define(STYLESHEET, "styles.css"). +-define(TOOLS_APP, tools). -include_lib("stdlib/include/ms_transform.hrl"). @@ -184,6 +213,11 @@ start(Node) when is_atom(Node) -> start(Nodes) -> call({start_nodes,remove_myself(Nodes,[])}). +%% local_only() -> ok | {error,too_late} + +local_only() -> + call(local_only). + %% compile(ModFiles) -> %% compile(ModFiles, Options) -> %% compile_module(ModFiles) -> Result @@ -253,15 +287,8 @@ compile_directory(Dir, Options) when is_list(Dir), is_list(Options) -> compile_modules(Files,Options) -> Options2 = filter_options(Options), - %% compile_modules(Files,Options2,[]). call({compile, Files, Options2}). -%% compile_modules([File|Files], Options, Result) -> -%% R = call({compile, File, Options}), -%% compile_modules(Files,Options,[R|Result]); -%% compile_modules([],_Opts,Result) -> -%% lists:reverse(Result). - filter_options(Options) -> lists:filter(fun(Option) -> case Option of @@ -559,16 +586,6 @@ flush(Nodes) -> get_main_node() -> call(get_main_node). -%% bump(Module, Function, Arity, Clause, Line) -%% Module = Function = atom() -%% Arity = Clause = Line = integer() -%% This function is inserted into Cover compiled modules, once for each -%% executable line. -%bump(Module, Function, Arity, Clause, Line) -> -% Key = #bump{module=Module, function=Function, arity=Arity, clause=Clause, -% line=Line}, -% ets:update_counter(?COVER_TABLE, Key, 1). - call(Request) -> Ref = erlang:monitor(process,?SERVER), receive {'DOWN', Ref, _Type, _Object, noproc} -> @@ -629,10 +646,8 @@ remote_reply(MainNode,Reply) -> init_main(Starter) -> register(?SERVER,self()), - %% Having write concurrancy here gives a 40% performance boost - %% when collect/1 is called. - ?COVER_TABLE = ets:new(?COVER_TABLE, [set, public, named_table, - {write_concurrency, true}]), + ?COVER_MAPPING_TABLE = ets:new(?COVER_MAPPING_TABLE, + [ordered_set, public, named_table]), ?COVER_CLAUSE_TABLE = ets:new(?COVER_CLAUSE_TABLE, [set, public, named_table]), ?BINARY_TABLE = ets:new(?BINARY_TABLE, [set, public, named_table]), @@ -646,10 +661,26 @@ init_main(Starter) -> main_process_loop(State) -> receive + {From, local_only} -> + case State of + #main_state{compiled=[],nodes=[]} -> + reply(From, ok), + main_process_loop(State#main_state{local_only=true}); + #main_state{} -> + reply(From, {error,too_late}), + main_process_loop(State) + end; + {From, {start_nodes,Nodes}} -> - {StartedNodes,State1} = do_start_nodes(Nodes, State), - reply(From, {ok,StartedNodes}), - main_process_loop(State1); + case State#main_state.local_only of + false -> + {StartedNodes,State1} = do_start_nodes(Nodes, State), + reply(From, {ok,StartedNodes}), + main_process_loop(State1); + true -> + reply(From, {error,local_only}), + main_process_loop(State) + end; {From, {compile, Files, Options}} -> {R,S} = do_compile(Files, Options, State), @@ -740,11 +771,12 @@ main_process_loop(State) -> end, State#main_state.nodes), reload_originals(State#main_state.compiled), - ets:delete(?COVER_TABLE), + ets:delete(?COVER_MAPPING_TABLE), ets:delete(?COVER_CLAUSE_TABLE), ets:delete(?BINARY_TABLE), ets:delete(?COLLECTION_TABLE), ets:delete(?COLLECTION_CLAUSE_TABLE), + delete_all_counters(), unregister(?SERVER), reply(From, ok); @@ -876,10 +908,8 @@ main_process_loop(State) -> init_remote(Starter,MainNode) -> register(?SERVER,self()), - %% write_concurrency here makes otp_8270 break :( - ?COVER_TABLE = ets:new(?COVER_TABLE, [set, public, named_table - %,{write_concurrency, true} - ]), + ?COVER_MAPPING_TABLE = ets:new(?COVER_MAPPING_TABLE, + [ordered_set, public, named_table]), ?COVER_CLAUSE_TABLE = ets:new(?COVER_CLAUSE_TABLE, [set, public, named_table]), Starter ! {self(),started}, @@ -902,7 +932,7 @@ remote_process_loop(State) -> remote_process_loop(State#remote_state{compiled=Compiled}); {remote,reset,Module} -> - do_reset(Module), + reset_counters(Module), remote_reply(State#remote_state.main_node, ok), remote_process_loop(State); @@ -923,8 +953,9 @@ remote_process_loop(State) -> {remote,stop} -> reload_originals(State#remote_state.compiled), - ets:delete(?COVER_TABLE), + ets:delete(?COVER_MAPPING_TABLE), ets:delete(?COVER_CLAUSE_TABLE), + delete_all_counters(), unregister(?SERVER), ok; % not replying since 'DOWN' message will be received anyway @@ -959,28 +990,12 @@ remote_process_loop(State) -> end. do_collect(Modules, CollectorPid, From) -> - _ = pmap( - fun(Module) -> - Pattern = {#bump{module=Module, _='_'}, '$1'}, - MatchSpec = [{Pattern,[{'=/=','$1',0}],['$_']}], - Match = ets:select(?COVER_TABLE,MatchSpec,?CHUNK_SIZE), - send_chunks(Match, CollectorPid, []) - end,Modules), + _ = pmap(fun(Module) -> + send_counters(Module, CollectorPid) + end, Modules), CollectorPid ! done, remote_reply(From, ok). -send_chunks('$end_of_table', _CollectorPid, Mons) -> - get_downs(Mons); -send_chunks({Chunk,Continuation}, CollectorPid, Mons) -> - Mon = spawn_monitor( - fun() -> - lists:foreach(fun({Bump,_N}) -> - ets:insert(?COVER_TABLE, {Bump,0}) - end, - Chunk) end), - send_chunk(CollectorPid,Chunk), - send_chunks(ets:select(Continuation), CollectorPid, [Mon|Mons]). - send_chunk(CollectorPid,Chunk) -> CollectorPid ! {chunk,Chunk,self()}, receive continue -> ok end. @@ -1019,10 +1034,15 @@ do_reload_original(Module) -> ignore end. -load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) -> - %% Make sure the #bump{} records are available *before* the - %% module is loaded. - insert_initial_data(InitialTable), +load_compiled([Data|Compiled],Acc) -> + %% Make sure the #bump{} records and counters are available *before* + %% compiling and loading the code. + #remote_data{module=Module,file=File,code=Beam, + mapping=InitialMapping,clauses=InitialClauses} = Data, + ets:insert(?COVER_MAPPING_TABLE, InitialMapping), + ets:insert(?COVER_CLAUSE_TABLE, InitialClauses), + maybe_create_counters(Module, true), + Sticky = case code:is_sticky(Module) of true -> code:unstick_mod(Module), @@ -1030,7 +1050,7 @@ load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) -> false -> false end, - NewAcc = case code:load_binary(Module, ?TAG, Binary) of + NewAcc = case code:load_binary(Module, ?TAG, Beam) of {module,Module} -> add_compiled(Module, File, Acc); _ -> @@ -1045,16 +1065,6 @@ load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) -> load_compiled([],Acc) -> Acc. -insert_initial_data([Item|Items]) when is_atom(element(1,Item)) -> - ets:insert(?COVER_CLAUSE_TABLE, Item), - insert_initial_data(Items); -insert_initial_data([Item|Items]) -> - ets:insert(?COVER_TABLE, Item), - insert_initial_data(Items); -insert_initial_data([]) -> - ok. - - unload([Module|Modules]) -> do_clear(Module), do_reload_original(Module), @@ -1175,7 +1185,7 @@ get_downs_r([]) -> []; get_downs_r(Mons) -> receive - {'DOWN', Ref, _Type, Pid, R={_,_,_,_}} -> + {'DOWN', Ref, _Type, Pid, #remote_data{}=R} -> [R|get_downs_r(lists:delete({Pid,Ref},Mons))]; {'DOWN', Ref, _Type, Pid, Reason} = Down -> case lists:member({Pid,Ref},Mons) of @@ -1194,19 +1204,13 @@ get_downs_r(Mons) -> %% Binary is the beam code for the module and InitialTable is the initial %% data to insert in ?COVER_TABLE. get_data_for_remote_loading({Module,File}) -> - [{Module,Binary}] = ets:lookup(?BINARY_TABLE,Module), + [{Module,Code}] = ets:lookup(?BINARY_TABLE, Module), %%! The InitialTable list will be long if the module is big - what to do?? - InitialBumps = ets:select(?COVER_TABLE,ms(Module)), + Mapping = counters_mapping_table(Module), InitialClauses = ets:lookup(?COVER_CLAUSE_TABLE,Module), - {Module,File,Binary,InitialBumps ++ InitialClauses}. - -%% Create a match spec which returns the clause info {Module,InitInfo} and -%% all #bump keys for the given module with 0 number of calls. -ms(Module) -> - ets:fun2ms(fun({Key,_}) when Key#bump.module=:=Module -> - {Key,0} - end). + #remote_data{module=Module,file=File,code=Code, + mapping=Mapping,clauses=InitialClauses}. %% Unload modules on remote nodes remote_unload(Nodes,UnloadedModules) -> @@ -1462,7 +1466,7 @@ get_compiled_still_loaded(Nodes,Compiled0) -> do_compile_beams(ModsAndFiles, State) -> Result0 = pmap(fun({ok,Module,File}) -> - do_compile_beam(Module,File,State); + do_compile_beam(Module, File, State); (Error) -> Error end, @@ -1474,8 +1478,10 @@ do_compile_beams(ModsAndFiles, State) -> do_compile_beam(Module,BeamFile0,State) -> case get_beam_file(Module,BeamFile0,State#main_state.compiled) of {ok,BeamFile} -> + LocalOnly = State#main_state.local_only, UserOptions = get_compile_options(Module,BeamFile), - case do_compile_beam1(Module,BeamFile,UserOptions) of + case do_compile_beam1(Module,BeamFile, + UserOptions,LocalOnly) of {ok, Module} -> {ok,Module,BeamFile}; error -> @@ -1501,41 +1507,39 @@ fix_state_and_result([],State,Acc) -> do_compile(Files, Options, State) -> + LocalOnly = State#main_state.local_only, Result0 = pmap(fun(File) -> - do_compile(File, Options) + do_compile1(File, Options, LocalOnly) end, Files), Compiled = [{M,F} || {ok,M,F} <- Result0], remote_load_compiled(State#main_state.nodes,Compiled), fix_state_and_result(Result0,State,[]). -do_compile(File, Options) -> - case do_compile1(File, Options) of +do_compile1(File, Options, LocalOnly) -> + case do_compile2(File, Options, LocalOnly) of {ok, Module} -> {ok,Module,File}; error -> {error,File} end. -%% do_compile1(File, Options) -> {ok,Module} | error -do_compile1(File, UserOptions) -> +%% do_compile2(File, Options) -> {ok,Module} | error +do_compile2(File, UserOptions, LocalOnly) -> Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions, case compile:file(File, Options) of {ok, Module, Binary} -> - do_compile_beam1(Module,Binary,UserOptions); + do_compile_beam1(Module,Binary,UserOptions,LocalOnly); error -> error end. %% Beam is a binary or a .beam file name -do_compile_beam1(Module,Beam,UserOptions) -> +do_compile_beam1(Module,Beam,UserOptions,LocalOnly) -> %% Clear database do_clear(Module), - %% Extract the abstract format and insert calls to bump/6 at - %% every executable line and, as a side effect, initiate - %% the database - + %% Extract the abstract format. case get_abstract_code(Module, Beam) of no_abstract_code=E -> {error,E}; @@ -1545,7 +1549,8 @@ do_compile_beam1(Module,Beam,UserOptions) -> Forms0 = epp:interpret_file_attribute(Code), case find_main_filename(Forms0) of {ok,MainFile} -> - do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile); + do_compile_beam2(Module,Beam,UserOptions, + Forms0,MainFile,LocalOnly); Error -> Error end; @@ -1564,26 +1569,35 @@ get_abstract_code(Module, Beam) -> Error -> Error end. -do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile) -> - {Forms,Vars} = transform(Forms0, Module, MainFile), +do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile,LocalOnly) -> + init_counter_mapping(Module), + + %% Instrument the abstract code by inserting + %% calls to update the counters. + {Forms,Vars} = transform(Forms0, Module, MainFile, LocalOnly), + + %% Create counters. + maybe_create_counters(Module, not LocalOnly), %% We need to recover the source from the compilation %% info otherwise the newly compiled module will have %% source pointing to the current directory SourceInfo = get_source_info(Module, Beam), - %% Compile and load the result + %% Compile and load the result. %% It's necessary to check the result of loading since it may - %% fail, for example if Module resides in a sticky directory - {ok, Module, Binary} = compile:forms(Forms, SourceInfo ++ UserOptions), + %% fail, for example if Module resides in a sticky directory. + Options = SourceInfo ++ UserOptions, + {ok, Module, Binary} = compile:forms(Forms, Options), + case code:load_binary(Module, ?TAG, Binary) of {module, Module} -> - %% Store info about all function clauses in database + %% Store info about all function clauses in database. InitInfo = lists:reverse(Vars#vars.init_info), ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), - %% Store binary code so it can be loaded on remote nodes + %% Store binary code so it can be loaded on remote nodes. ets:insert(?BINARY_TABLE, {Module, Binary}), {ok, Module}; @@ -1615,11 +1629,12 @@ get_compile_info(Module, Beam) -> [] end. -transform(Code, Module, MainFile) -> +transform(Code, Module, MainFile, LocalOnly) -> Vars0 = #vars{module=Module}, - {ok,MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on), + {ok,MungedForms0,Vars} = transform_2(Code, [], Vars0, MainFile, on), + MungedForms = patch_code(Module, MungedForms0, LocalOnly), {MungedForms,Vars}. - + %% Helpfunction which returns the first found file-attribute, which can %% be interpreted as the name of the main erlang source file. find_main_filename([{attribute,_,file,{MainFile,_}}|_]) -> @@ -1786,19 +1801,7 @@ munge_body([Expr|Body], Vars, MungedBody, LastExprBumpLines) -> MungedExprs1 = [MungedExpr|MungedBody1], munge_body(Body, Vars3, MungedExprs1, NewBumps); false -> - ets:insert(?COVER_TABLE, {#bump{module = Vars#vars.module, - function = Vars#vars.function, - arity = Vars#vars.arity, - clause = Vars#vars.clause, - line = Line}, - 0}), Bump = bump_call(Vars, Line), -% Bump = {call, 0, {remote, 0, {atom,0,cover}, {atom,0,bump}}, -% [{atom, 0, Vars#vars.module}, -% {atom, 0, Vars#vars.function}, -% {integer, 0, Vars#vars.arity}, -% {integer, 0, Vars#vars.clause}, -% {integer, 0, Line}]}, Lines2 = [Line|Lines], {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}), NewBumps = new_bumps(Vars2, Vars), @@ -1853,8 +1856,10 @@ maybe_fix_last_expr(MungedExprs, Vars, LastExprBumpLines) -> last_expr_needs_fixing(Vars, LastExprBumpLines) -> case common_elems(Vars#vars.no_bump_lines, LastExprBumpLines) of - [Line] -> {yes, Line}; - _ -> no + [Line] -> + {yes, Line}; + _ -> + no end. fix_last_expr([MungedExpr|MungedExprs], Line, Vars) -> @@ -1919,9 +1924,7 @@ fix_cls([Cl | Cls], Line, Bump) -> bumps_line(E, L) -> try bumps_line1(E, L) catch true -> true end. -bumps_line1({call,_,{remote,_,{atom,_,ets},{atom,_,update_counter}}, - [{atom,_,?COVER_TABLE},{tuple,_,[_,_,_,_,_,{integer,_,Line}]},_]}, - Line) -> +bumps_line1({'BUMP',Line,_}, Line) -> throw(true); bumps_line1([E | Es], Line) -> bumps_line1(E, Line), @@ -1931,19 +1934,12 @@ bumps_line1(T, Line) when is_tuple(T) -> bumps_line1(_, _) -> false. -%%% End of fix of last expression. - +%% Insert a place holder for the call to counters:add/3 in the +%% abstract code. bump_call(Vars, Line) -> - A = erl_anno:new(0), - {call,A,{remote,A,{atom,A,ets},{atom,A,update_counter}}, - [{atom,A,?COVER_TABLE}, - {tuple,A,[{atom,A,?BUMP_REC_NAME}, - {atom,A,Vars#vars.module}, - {atom,A,Vars#vars.function}, - {integer,A,Vars#vars.arity}, - {integer,A,Vars#vars.clause}, - {integer,A,Line}]}, - {integer,A,1}]}. + {'BUMP',Line,counter_index(Vars, Line)}. + +%%% End of fix of last expression. munge_expr({match,Line,ExprL,ExprR}, Vars) -> {MungedExprL, Vars2} = munge_expr(ExprL, Vars), @@ -2103,6 +2099,159 @@ subtract(L1, L2) -> common_elems(L1, L2) -> [E || E <- L1, lists:member(E, L2)]. +%%%--Counters------------------------------------------------------------ + +init_counter_mapping(Mod) -> + true = ets:insert_new(?COVER_MAPPING_TABLE, {Mod,0}), + ok. + +counter_index(Vars, Line) -> + #vars{module=Mod,function=F,arity=A,clause=C} = Vars, + Key = #bump{module=Mod,function=F,arity=A, + clause=C,line=Line}, + case ets:lookup(?COVER_MAPPING_TABLE, Key) of + [] -> + Index = ets:update_counter(?COVER_MAPPING_TABLE, + Mod, {2,1}), + true = ets:insert(?COVER_MAPPING_TABLE, {Key,Index}), + Index; + [{Key,Index}] -> + Index + end. + +%% Create the counter array and store as a persistent term. +maybe_create_counters(Mod, true) -> + Cref = create_counters(Mod), + Key = {?MODULE,Mod}, + persistent_term:put(Key, Cref), + ok; +maybe_create_counters(_Mod, false) -> + ok. + +create_counters(Mod) -> + Size0 = ets:lookup_element(?COVER_MAPPING_TABLE, Mod, 2), + Size = max(1, Size0), %Size must not be 0. + Cref = counters:new(Size, [write_concurrency]), + ets:insert(?COVER_MAPPING_TABLE, {{counters,Mod},Cref}), + Cref. + +patch_code(Mod, Forms, false) -> + A = erl_anno:new(0), + AbstrKey = {tuple,A,[{atom,A,?MODULE},{atom,A,Mod}]}, + patch_code1(Forms, {distributed,AbstrKey}); +patch_code(Mod, Forms, true) -> + Cref = create_counters(Mod), + AbstrCref = cid_to_abstract(Cref), + patch_code1(Forms, {local_only,AbstrCref}). + +%% Go through the abstract code and replace 'BUMP' forms +%% with the actual code to increment the counters. +patch_code1({'BUMP',_Line,Index}, {distributed,AbstrKey}) -> + %% Replace with counters:add(persistent_term:get(Key), Index, 1). + %% This code will work on any node. + A = element(2, AbstrKey), + GetCref = {call,A,{remote,A,{atom,A,persistent_term},{atom,A,get}}, + [AbstrKey]}, + {call,A,{remote,A,{atom,A,counters},{atom,A,add}}, + [GetCref,{integer,A,Index},{integer,A,1}]}; +patch_code1({'BUMP',_Line,Index}, {local_only,AbstrCref}) -> + %% Replace with counters:add(Cref, Index, 1). This code + %% will only work on the local node. + A = element(2, AbstrCref), + {call,A,{remote,A,{atom,A,counters},{atom,A,add}}, + [AbstrCref,{integer,A,Index},{integer,A,1}]}; +patch_code1({clauses,Cs}, Key) -> + {clauses,[patch_code1(El, Key) || El <- Cs]}; +patch_code1([_|_]=List, Key) -> + [patch_code1(El, Key) || El <- List]; +patch_code1(Tuple, Key) when tuple_size(Tuple) >= 3 -> + Acc = [element(2, Tuple),element(1, Tuple)], + patch_code_tuple(3, tuple_size(Tuple), Tuple, Key, Acc); +patch_code1(Other, _Key) -> + Other. + +patch_code_tuple(I, Size, Tuple, Key, Acc) when I =< Size -> + El = patch_code1(element(I, Tuple), Key), + patch_code_tuple(I + 1, Size, Tuple, Key, [El|Acc]); +patch_code_tuple(_I, _Size, _Tuple, _Key, Acc) -> + list_to_tuple(lists:reverse(Acc)). + +%% Don't try this at home! Assumes knowledge of the internal +%% representation of a counter ref. +cid_to_abstract(Cref0) -> + A = erl_anno:new(0), + %% Disable dialyzer warning for breaking opacity. + Cref = binary_to_term(term_to_binary(Cref0)), + {write_concurrency,Ref} = Cref, + {tuple,A,[{atom,A,write_concurrency},{integer,A,Ref}]}. + +%% Called on the remote node. Collect and send counters to +%% the main node. Also zero the counters. +send_counters(Mod, CollectorPid) -> + Process = fun(Chunk) -> send_chunk(CollectorPid, Chunk) end, + move_counters(Mod, Process). + +%% Called on the main node. Collect the counters and consolidate +%% them into the collection table. Also zero the counters. +move_counters(Mod) -> + move_counters(Mod, fun insert_in_collection_table/1). + +move_counters(Mod, Process) -> + Pattern = {#bump{module=Mod,_='_'},'_'}, + Matches = ets:match_object(?COVER_MAPPING_TABLE, Pattern, ?CHUNK_SIZE), + Cref = get_counters_ref(Mod), + move_counters1(Matches, Cref, Process). + +move_counters1({Mappings,Continuation}, Cref, Process) -> + Move = fun({Key,Index}) -> + Count = counters:get(Cref, Index), + ok = counters:sub(Cref, Index, Count), + {Key,Count} + end, + Process(lists:map(Move, Mappings)), + move_counters1(ets:match_object(Continuation), Cref, Process); +move_counters1('$end_of_table', _Cref, _Process) -> + ok. + +counters_mapping_table(Mod) -> + Mapping = counters_mapping(Mod), + Cref = get_counters_ref(Mod), + #{size:=Size} = counters:info(Cref), + [{Mod,Size}|Mapping]. + +get_counters_ref(Mod) -> + ets:lookup_element(?COVER_MAPPING_TABLE, {counters,Mod}, 2). + +counters_mapping(Mod) -> + Pattern = {#bump{module=Mod,_='_'},'_'}, + ets:match_object(?COVER_MAPPING_TABLE, Pattern). + +clear_counters(Mod) -> + _ = persistent_term:erase({?MODULE,Mod}), + ets:delete(?COVER_MAPPING_TABLE, Mod), + Pattern = {#bump{module=Mod,_='_'},'_'}, + _ = ets:match_delete(?COVER_MAPPING_TABLE, Pattern), + ok. + +%% Reset counters (set counters to 0). +reset_counters(Mod) -> + Pattern = {#bump{module=Mod,_='_'},'$1'}, + MatchSpec = [{Pattern,[],['$1']}], + Matches = ets:select(?COVER_MAPPING_TABLE, + MatchSpec, ?CHUNK_SIZE), + Cref = get_counters_ref(Mod), + reset_counters1(Matches, Cref). + +reset_counters1({Indices,Continuation}, Cref) -> + _ = [counters:put(Cref, N, 0) || N <- Indices], + reset_counters1(ets:select(Continuation), Cref); +reset_counters1('$end_of_table', _Cref) -> + ok. + +delete_all_counters() -> + _ = [persistent_term:erase(Key) || {?MODULE,_}=Key <- persistent_term:get()], + ok. + %%%--Analysis------------------------------------------------------------ %% Collect data for all modules @@ -2138,20 +2287,7 @@ collect(Module,Clauses,Nodes) -> %% ?COLLECTION_TABLE. Resetting data in ?COVER_TABLE move_modules({Module,Clauses}) -> ets:insert(?COLLECTION_CLAUSE_TABLE,{Module,Clauses}), - Pattern = {#bump{module=Module, _='_'}, '_'}, - MatchSpec = [{Pattern,[],['$_']}], - Match = ets:select(?COVER_TABLE,MatchSpec,?CHUNK_SIZE), - do_move_module(Match). - -do_move_module({Bumps,Continuation}) -> - lists:foreach(fun({Key,Val}) -> - ets:insert(?COVER_TABLE, {Key,0}), - insert_in_collection_table(Key,Val) - end, - Bumps), - do_move_module(ets:select(Continuation)); -do_move_module('$end_of_table') -> - ok. + move_counters(Module). %% Given a .beam file, find the .erl file. Look first in same directory as %% the .beam file, then in ../src, then in compile info. @@ -2415,20 +2551,8 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) -> case file:open(OutFile, [write,raw,delayed_write]) of {ok, OutFd} -> Enc = encoding(ErlFile), - if HTML -> - Header = - ["<!DOCTYPE HTML PUBLIC " - "\"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<html>\n" - "<head>\n" - "<meta http-equiv=\"Content-Type\"" - " content=\"text/html; charset=", - html_encoding(Enc),"\"/>\n" - "<title>",OutFile,"</title>\n" - "</head>" - "<body style='background-color: white;" - " color: black'>\n" - "<pre>\n"], + if HTML -> + Header = create_header(OutFile, Enc), H1Bin = unicode:characters_to_binary(Header,Enc,Enc), ok = file:write(OutFd,H1Bin); true -> ok @@ -2445,14 +2569,19 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) -> string:pad(integer_to_list(Mi), 2, leading, $0), string:pad(integer_to_list(S), 2, leading, $0)]), - H2Bin = unicode:characters_to_binary( - ["File generated from ",ErlFile," by COVER ", - Timestamp,"\n\n" - "**************************************" - "**************************************" - "\n\n"], - Enc, Enc), - ok = file:write(OutFd, H2Bin), + OutFileInfo = + if HTML -> + create_footer(ErlFile, Timestamp); + true -> + ["File generated from ",ErlFile," by COVER ", + Timestamp, "\n\n", + "**************************************" + "**************************************" + "\n\n"] + end, + + H2Bin = unicode:characters_to_binary(OutFileInfo,Enc,Enc), + ok = file:write(OutFd, H2Bin), Pattern = {#bump{module=Module,line='$1',_='_'},'$2'}, MS = [{Pattern,[{is_integer,'$1'},{'>','$1',0}],[{{'$1','$2'}}]}], @@ -2462,7 +2591,7 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) -> print_lines(Module, CovLines, InFd, OutFd, 1, HTML), if HTML -> - ok = file:write(OutFd, "</pre>\n</body>\n</html>\n"); + ok = file:write(OutFd, close_html()); true -> ok end, @@ -2497,12 +2626,11 @@ print_lines(Module, CovLines, InFd, OutFd, L, HTML) -> case CovLines of [{L,N}|CovLines1] -> if N=:=0, HTML=:=true -> - LineNoNL = Line -- "\n", - Str = " 0", - %%Str = string:pad("0", 6, leading, $\s), - RedLine = ["<font color=red>",Str,fill1(), - LineNoNL,"</font>\n"], - ok = file:write(OutFd, RedLine); + MissedLine = table_row("miss", Line, L, N), + ok = file:write(OutFd, MissedLine); + HTML=:=true -> + HitLine = table_row("hit", Line, L, N), + ok = file:write(OutFd, HitLine); N < 1000000 -> Str = string:pad(integer_to_list(N), 6, leading, $\s), ok = file:write(OutFd, [Str,fill1(),Line]); @@ -2515,7 +2643,11 @@ print_lines(Module, CovLines, InFd, OutFd, L, HTML) -> end, print_lines(Module, CovLines1, InFd, OutFd, L+1, HTML); _ -> %Including comment lines - ok = file:write(OutFd, [tab(),Line]), + NonCoveredContent = + if HTML -> table_row(Line, L); + true -> [tab(),Line] + end, + ok = file:write(OutFd, NonCoveredContent), print_lines(Module, CovLines, InFd, OutFd, L+1, HTML) end end. @@ -2525,6 +2657,61 @@ fill1() -> "..| ". fill2() -> ".| ". fill3() -> "| ". +%% HTML sections +create_header(OutFile, Enc) -> + ["<!doctype html>\n" + "<html>\n" + "<head>\n" + "<meta charset=\"",html_encoding(Enc),"\">\n" + "<title>",OutFile,"</title>\n" + "<style>"] ++ + read_stylesheet() ++ + ["</style>\n", + "</head>\n" + "<body>\n" + "<h1><code>",OutFile,"</code></h1>\n"]. + +create_footer(ErlFile, Timestamp) -> + ["<footer><p>File generated from <code>",ErlFile, + "</code> by <a href=\"http://erlang.org/doc/man/cover.html\">cover</a> at ", + Timestamp,"</p></footer>\n<table>\n<tbody>\n"]. + +close_html() -> + ["</tbody>\n", + "<thead>\n", + "<tr>\n", + "<th>Line</th>\n", + "<th>Hits</th>\n", + "<th>Source</th>\n", + "</tr>\n", + "</thead>\n", + "</table>\n", + "</body>\n" + "</html>\n"]. + +table_row(CssClass, Line, L, N) -> + ["<tr class=\"",CssClass,"\">\n", table_data(Line, L, N)]. +table_row(Line, L) -> + ["<tr>\n", table_data(Line, L, "")]. + +table_data(Line, L, N) -> + LineNoNL = Line -- "\n", + ["<td class=\"line\" id=\"L",integer_to_list(L),"\">", + "<a href=\"#L",integer_to_list(L),"\">", + integer_to_list(L), + "</a></td>\n", + "<td class=\"hits\">",maybe_integer_to_list(N),"</td>\n", + "<td class=\"source\"><code>",LineNoNL,"</code></td>\n</tr>\n"]. + +maybe_integer_to_list(0) -> "<pre style=\"display: inline;\">:-(</pre>"; +maybe_integer_to_list(N) when is_integer(N) -> integer_to_list(N); +maybe_integer_to_list(_) -> "". + +read_stylesheet() -> + PrivDir = code:priv_dir(?TOOLS_APP), + {ok, Css} = file:read_file(filename:join(PrivDir, ?STYLESHEET)), + [Css]. + %%%--Export-------------------------------------------------------------- do_export(Module, OutFile, From, State) -> case file:open(OutFile,[write,binary,raw,delayed_write]) of @@ -2656,7 +2843,7 @@ get_term(Fd) -> %% Reset main node and all remote nodes do_reset_main_node(Module,Nodes) -> - do_reset(Module), + reset_counters(Module), do_reset_collection_table(Module), remote_reset(Module,Nodes). @@ -2664,27 +2851,9 @@ do_reset_collection_table(Module) -> ets:delete(?COLLECTION_CLAUSE_TABLE,Module), ets:match_delete(?COLLECTION_TABLE, {#bump{module=Module},'_'}). -%% do_reset(Module) -> ok -%% The reset is done on ?CHUNK_SIZE number of bumps to avoid building -%% long lists in the case of very large modules -do_reset(Module) -> - Pattern = {#bump{module=Module, _='_'}, '$1'}, - MatchSpec = [{Pattern,[{'=/=','$1',0}],['$_']}], - Match = ets:select(?COVER_TABLE,MatchSpec,?CHUNK_SIZE), - do_reset2(Match). - -do_reset2({Bumps,Continuation}) -> - lists:foreach(fun({Bump,_N}) -> - ets:insert(?COVER_TABLE, {Bump,0}) - end, - Bumps), - do_reset2(ets:select(Continuation)); -do_reset2('$end_of_table') -> - ok. - do_clear(Module) -> ets:match_delete(?COVER_CLAUSE_TABLE, {Module,'_'}), - ets:match_delete(?COVER_TABLE, {#bump{module=Module},'_'}), + clear_counters(Module), case lists:member(?COLLECTION_TABLE, ets:all()) of true -> %% We're on the main node diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl index 535ddbcd04..86e3d3a8b8 100644 --- a/lib/tools/src/eprof.erl +++ b/lib/tools/src/eprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,11 +26,11 @@ -export([start/0, stop/0, - dump/0, + dump/0, dump_data/0, start_profiling/1, start_profiling/2, start_profiling/3, profile/1, profile/2, profile/3, profile/4, profile/5, stop_profiling/0, - analyze/0, analyze/1, analyze/2, + analyze/0, analyze/1, analyze/2, analyze/4, log/1]). %% Internal exports @@ -117,6 +117,9 @@ profile(Rootset, M, F, A, Pattern, Options) -> dump() -> gen_server:call(?MODULE, dump, infinity). +dump_data() -> + gen_server:call(?MODULE, dump_data, infinity). + log(File) -> gen_server:call(?MODULE, {logfile, File}, infinity). @@ -151,22 +154,18 @@ init([]) -> %% analyze -handle_call({analyze, _, _}, _, #state{ bpd = #bpd{ p = {0,nil}, us = 0, n = 0} = Bpd } = S) when is_record(Bpd, bpd) -> +handle_call( + {analyze, _, _}, _, + #state{ bpd = #bpd{ p = {0,nil}, us = 0, n = 0 } } = S) -> {reply, nothing_to_analyze, S}; -handle_call({analyze, procs, Opts}, _, #state{ bpd = #bpd{ p = Ps, us = Tus} = Bpd, fd = Fd} = S) when is_record(Bpd, bpd) -> - lists:foreach(fun - ({Pid, Mfas}) -> - {Pn, Pus} = sum_bp_total_n_us(Mfas), - format(Fd, "~n****** Process ~w -- ~s % of profiled time *** ~n", [Pid, s("~.2f", [100.0*divide(Pus,Tus)])]), - print_bp_mfa(Mfas, {Pn,Pus}, Fd, Opts), - ok - end, gb_trees:to_list(Ps)), - {reply, ok, S}; +handle_call({analyze, procs, Opts}, _, #state{ bpd = Bpd, fd = Fd } = S) + when is_record(Bpd, bpd) -> + {reply, analyze(Fd, procs, Opts, Bpd), S}; -handle_call({analyze, total, Opts}, _, #state{ bpd = #bpd{ mfa = Mfas, n = Tn, us = Tus} = Bpd, fd = Fd} = S) when is_record(Bpd, bpd) -> - print_bp_mfa(Mfas, {Tn, Tus}, Fd, Opts), - {reply, ok, S}; +handle_call({analyze, total, Opts}, _, #state{ bpd = Bpd, fd = Fd } = S) + when is_record(Bpd, bpd) -> + {reply, analyze(Fd, total, Opts, Bpd), S}; handle_call({analyze, Type, _Opts}, _, S) -> {reply, {error, {undefined, Type}}, S}; @@ -260,6 +259,10 @@ handle_call({logfile, File}, _From, #state{ fd = OldFd } = S) -> handle_call(dump, _From, #state{ bpd = Bpd } = S) when is_record(Bpd, bpd) -> {reply, gb_trees:to_list(Bpd#bpd.p), S}; +handle_call(dump_data, _, #state{ bpd = #bpd{} = Bpd } = S) + when is_record(Bpd, bpd) -> + {reply, Bpd, S}; + handle_call(stop, _FromTag, S) -> {stop, normal, stopped, S}. @@ -438,6 +441,23 @@ collect_bpdfp(Mfa, Tree, Data) -> {PTno + Ni, PTuso + Time, Ti1} end, {0,0, Tree}, Data). + + +analyze(Fd, procs, Opts, #bpd{ p = Ps, us = Tus }) -> + lists:foreach( + fun + ({Pid, Mfas}) -> + {Pn, Pus} = sum_bp_total_n_us(Mfas), + format( + Fd, + "~n****** Process ~w -- ~s % of profiled time *** ~n", + [Pid, s("~.2f", [100.0*divide(Pus, Tus)])]), + print_bp_mfa(Mfas, {Pn,Pus}, Fd, Opts), + ok + end, gb_trees:to_list(Ps)); +analyze(Fd, total, Opts, #bpd{ mfa = Mfas, n = Tn, us = Tus } ) -> + print_bp_mfa(Mfas, {Tn, Tus}, Fd, Opts). + %% manipulators sort_mfa(Bpfs, mfa) when is_list(Bpfs) -> lists:sort(fun diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index f8c6aa22cb..f0e0fc4bec 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -21,11 +21,13 @@ [{description, "DEVTOOLS CXC 138 16"}, {vsn, "%VSN%"}, {modules, [cover, + cprof, eprof, fprof, instrument, lcnt, make, + tags, xref, xref_base, xref_compiler, diff --git a/lib/tools/test/Makefile b/lib/tools/test/Makefile index 2b7b17afb3..7a0a941ccc 100644 --- a/lib/tools/test/Makefile +++ b/lib/tools/test/Makefile @@ -32,6 +32,7 @@ MODULES = \ make_SUITE \ tools_SUITE \ xref_SUITE \ + prof_bench_SUITE \ ignore_cores ERL_FILES= $(MODULES:%=%.erl) @@ -41,7 +42,7 @@ INSTALL_PROGS= $(TARGET_FILES) EMAKEFILE=Emakefile -SPEC_FILES= tools.spec +SPEC_FILES= tools.spec tools_bench.spec COVER_FILE = tools.cover # ---------------------------------------------------- diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 161b0105b9..ee58fd7a10 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -24,7 +24,8 @@ -include_lib("common_test/include/ct.hrl"). suite() -> - [{ct_hooks,[ts_install_cth]}]. + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,5}}]. all() -> NoStartStop = [eif,otp_5305,otp_5418,otp_7095,otp_8273, @@ -35,7 +36,8 @@ all() -> distribution, reconnect, die_and_reconnect, dont_reconnect_after_stop, stop_node_after_disconnect, export_import, otp_5031, otp_6115, - otp_8270, otp_10979_hanging_node, otp_14817], + otp_8270, otp_10979_hanging_node, otp_14817, + local_only], case whereis(cover_server) of undefined -> [coverage,StartStop ++ NoStartStop]; @@ -1742,6 +1744,40 @@ otp_13289(Config) -> ok = file:delete(File), ok. +local_only(Config) -> + ok = file:set_cwd(proplists:get_value(data_dir, Config)), + + %% Trying restricting to local nodes too late. + cover:start(), + {ok,a} = cover:compile(a), + [a] = cover:modules(), + {error,too_late} = cover:local_only(), + cover:stop(), + + %% Now test local only mode. + cover:start(), + ok = cover:local_only(), + [] = cover:modules(), + {ok,a} = cover:compile(a), + [a] = cover:modules(), + done = a:start(5), + {ok, {a,{17,2}}} = cover:analyse(a, coverage, module), + {ok, [{{a,exit_kalle,0},{1,0}}, + {{a,loop,3},{5,1}}, + {{a,pong,1},{1,0}}, + {{a,start,1},{6,0}}, + {{a,stop,1},{0,1}}, + {{a,trycatch,1},{4,0}}]} = + cover:analyse(a, coverage, function), + + %% Make sure that it is not possible to run cover on + %% slave nodes. + {ok,Name} = test_server:start_node(?FUNCTION_NAME, slave, []), + {error,local_only} = cover:start([Name]), + test_server:stop_node(Name), + + ok. + %%--Auxiliary------------------------------------------------------------ analyse_expr(Expr, Config) -> diff --git a/lib/tools/test/emacs_SUITE.erl b/lib/tools/test/emacs_SUITE.erl index 5839f9ce5b..73270e6ed6 100644 --- a/lib/tools/test/emacs_SUITE.erl +++ b/lib/tools/test/emacs_SUITE.erl @@ -23,18 +23,28 @@ -export([all/0, init_per_testcase/2, end_per_testcase/2]). --export([bif_highlight/1, indent/1]). +-export([bif_highlight/1, + load_interpreted/1, compile_and_load/1, + indent/1, + tests_interpreted/1, tests_compiled/1 + ]). all() -> - [bif_highlight, indent]. + [bif_highlight, load_interpreted, compile_and_load, + indent, + tests_interpreted, tests_compiled + ]. -init_per_testcase(_Case, Config) -> +init_per_testcase(Case, Config) -> ErlangEl = filename:join([code:lib_dir(tools),"emacs","erlang.el"]), case file:read_file_info(ErlangEl) of - {ok, _} -> - [{el, ErlangEl}|Config]; - _ -> - {skip, "Could not find erlang.el"} + {ok, _} -> + case Case =:= bif_highlight orelse emacs_version_ok(24.1) of + false -> {skip, "Old or no emacs found"}; + _ -> [{el, ErlangEl}|Config] + end; + _ -> + {skip, "Could not find erlang.el"} end. end_per_testcase(_Case, _Config) -> @@ -46,54 +56,124 @@ bif_highlight(Config) -> %% All auto-imported bifs IntBifs = lists:usort( - [F || {F,A} <- erlang:module_info(exports), - erl_internal:bif(F,A)]), + [F || {F,A} <- erlang:module_info(exports), + erl_internal:bif(F,A)]), %% all bif which need erlang: prefix and are not operands ExtBifs = lists:usort( - [F || {F,A} <- erlang:module_info(exports), - not erl_internal:bif(F,A) andalso - not is_atom(catch erl_internal:op_type(F,A))]), + [F || {F,A} <- erlang:module_info(exports), + not erl_internal:bif(F,A) andalso + not is_atom(catch erl_internal:op_type(F,A))]), check_bif_highlight(Bin, <<"erlang-int-bifs">>, IntBifs), check_bif_highlight(Bin, <<"erlang-ext-bifs">>, ExtBifs). - + check_bif_highlight(Bin, Tag, Compare) -> - [_H,IntMatch,_T] = - re:split(Bin,<<"defvar ",Tag/binary, - "[^(]*\\(([^)]*)">>,[]), - EmacsIntBifs = [list_to_atom(S) || - S <- string:tokens(binary_to_list(IntMatch)," '\"\n")], - - ct:log("Emacs ~p",[EmacsIntBifs]), - ct:log("Int ~p",[Compare]), - - ct:log("Diff1 ~p",[Compare -- EmacsIntBifs]), - ct:log("Diff2 ~p",[EmacsIntBifs -- Compare]), - [] = Compare -- EmacsIntBifs, - [] = EmacsIntBifs -- Compare. - + [_H,Match,_T] = + re:split(Bin,<<"defvar ",Tag/binary, + "[^(]*\\(([^)]*)">>,[]), + EmacsBifs = [list_to_atom(S) || + S <- string:tokens(binary_to_list(Match)," '\"\n")], + + ct:log("Comparing ~s", [Tag]), + ct:log("Emacs ~p",[EmacsBifs]), + ct:log("Erlang ~p",[Compare]), + + ct:log("Only in Erlang ~p",[Compare -- EmacsBifs]), + ct:log("Only in Emacs ~p",[EmacsBifs -- Compare]), + [] = Compare -- EmacsBifs, + [] = EmacsBifs -- Compare. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -indent(Config) -> - case emacs_version_ok() of +load_interpreted(_Config) -> + _ = emacs(["-l erlang.el -f erlang-mode"]), + ok. + +compile_and_load(_Config) -> + Dir = emacs_dir(), + Files0 = filelib:wildcard("*.el", Dir), + Files = case emacs_version_ok(24.3) of + %% erldoc.el depends on cl-lib which was introduced in 24.3. + false -> Files0 -- ["erldoc.el"]; + _ -> Files0 + end, + Unforgiving = + case emacs_version_ok(24) of + Ver when Ver < 25 -> + ""; + Ver when Ver < 26 -> + %% Workaround byte-compile-error-on-warn which seem broken in + %% Emacs 25. + "\"(advice-add #'display-warning :after " + "(lambda (_ f _ _) (error \"%s\" f)))\""; + _ -> + "\"(setq byte-compile-error-on-warn t)\"" + end, + %% Add files here whenever they are cleaned of warnings. + NoWarn = ["erlang.el", "erlang-test.el", "erlang-edoc.el", "erlang-start.el", "erldoc.el"], + Compile = fun(File) -> + Pedantic = case lists:member(File, NoWarn) andalso Unforgiving /= "" of + true -> ["--eval ", Unforgiving, " "]; + false -> " " + end, + emacs([Pedantic, + " -f batch-byte-compile ", dquote(filename:join(Dir, File))]), + true + end, + lists:foreach(Compile, Files), + emacs(["-l erlang.elc -f erlang-mode"]), + ok. + +tests_interpreted(_Config) -> + case emacs_version_ok(25) of + false -> {skip, "Old or no emacs found"}; + _ -> + emacs(["-l erlang.el ", + "-l erlang-test.el -f ert-run-tests-batch-and-exit"]), + ok + end. + +tests_compiled(_Config) -> + case emacs_version_ok(25) of false -> {skip, "Old or no emacs found"}; - true -> - Def = filename:dirname(code:which(?MODULE)) ++ "/" ++ ?MODULE_STRING ++ "_data", - Dir = proplists:get_value(data_dir, Config, Def), - OrigFs = filelib:wildcard(Dir ++ "/*"), - io:format("Dir: ~s~nFs: ~p~n", [Dir, OrigFs]), - Fs = [{File, unindent(File)} || File <- OrigFs, - filename:extension(File) =:= ""], - Indent = fun emacs/1, - [Indent(File) || {_, File} <- Fs], - Res = [diff(Orig, File) || {Orig, File} <- Fs], - [file:delete(File) || {ok, File} <- Res], %% Cleanup - [] = [Fail || {fail, Fail} <- Res], + _ -> + emacs(["-l erlang.elc ", + "-l erlang-test.elc -f ert-run-tests-batch-and-exit"]), ok end. + +dquote(Str) -> + "\"" ++ Str ++ "\"". + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +indent(Config) -> + Def = filename:dirname(code:which(?MODULE)) + ++ "/" + ++ ?MODULE_STRING + ++ "_data", + Dir = proplists:get_value(data_dir, Config, Def), + OrigFs = filelib:wildcard(Dir ++ "/*"), + io:format("Dir: ~s~nFs: ~p~n", [Dir, OrigFs]), + Fs = [{File, unindent(File)} || File <- OrigFs, + filename:extension(File) =:= ""], + Indent = fun(File) -> + emacs([ + File, " ", + "--eval '(indent-region (point-min) (point-max) nil)' ", + "--eval '(save-buffer 0)'" + ]), + ok + end, + [Indent(File) || {_, File} <- Fs], + Res = [diff(Orig, File) || {Orig, File} <- Fs], + [file:delete(File) || {ok, File} <- Res], %% Cleanup + [] = [Fail || {fail, Fail} <- Res], + ok. + unindent(Input) -> Output = Input ++ ".erl", {ok, Bin} = file:read_file(Input), @@ -112,14 +192,15 @@ diff(Orig, File) -> {fail, File} end. -emacs_version_ok() -> - case os:cmd("emacs --version | head -1") of +emacs_version_ok(AcceptVer) -> + VersionLine = os:cmd("emacs --version | head -1"), + io:format("~s~n", [VersionLine]), + case VersionLine of "GNU Emacs " ++ Ver -> case string:to_float(Ver) of - {Vsn, _} when Vsn >= 24.1 -> - true; + {Vsn, _} when Vsn >= AcceptVer -> + Vsn; _ -> - io:format("Emacs version fail~n~s~n~n",[Ver]), false end; Res -> @@ -127,16 +208,19 @@ emacs_version_ok() -> false end. -emacs(File) -> - EmacsErlDir = filename:join([code:lib_dir(tools), "emacs"]), +emacs(EmacsCmds) when is_list(EmacsCmds) -> Cmd = ["emacs ", "--batch --quick ", - "--directory ", EmacsErlDir, " ", - "--eval \"(require 'erlang-start)\" ", - File, " ", - "--eval '(indent-region (point-min) (point-max) nil)' ", - "--eval '(save-buffer 0)'" - ], - _Res = os:cmd(Cmd), - % io:format("cmd ~s:~n=> ~s~n", [Cmd, _Res]), - ok. + "--directory ", dquote(emacs_dir()), " ", + "--eval \"(require 'erlang-start)\" " + | EmacsCmds], + Res0 = os:cmd(Cmd ++ " ; echo $?"), + Rows = string:lexemes(Res0, ["\r\n", $\n]), + Res = lists:last(Rows), + Output = string:join(lists:droplast(Rows), "\n"), + io:format("Cmd ~ts:~n => ~s ~ts~n", [Cmd, Res, Output]), + "0" = Res, + Output. + +emacs_dir() -> + filename:join([code:lib_dir(tools), "emacs"]). diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl index 8c521b2e1a..f474669836 100644 --- a/lib/tools/test/instrument_SUITE.erl +++ b/lib/tools/test/instrument_SUITE.erl @@ -77,6 +77,8 @@ allocations_ramv(Config) when is_list(Config) -> verify_allocations_disabled(_AllocType, Result) -> verify_allocations_disabled(Result). +verify_allocations_disabled({ok, {_HistStart, _UnscannedBytes, Allocs}}) -> + true = Allocs =:= #{}; verify_allocations_disabled({error, not_enabled}) -> ok. @@ -91,6 +93,13 @@ verify_allocations_enabled(_AllocType, Result) -> verify_allocations_enabled({ok, {_HistStart, _UnscannedBytes, Allocs}}) -> true = Allocs =/= #{}. +verify_allocations_output(#{}, {ok, {_, _, Allocs}}) when Allocs =:= #{} -> + %% This happens when the allocator is enabled but tagging is disabled. If + %% there's an error that causes Allocs to always be empty when enabled it + %% will be caught by verify_allocations_enabled. + ok; +verify_allocations_output(#{}, {error, not_enabled}) -> + ok; verify_allocations_output(#{ histogram_start := HistStart, histogram_width := HistWidth }, {ok, {HistStart, _UnscannedBytes, ByOrigin}}) -> @@ -124,8 +133,6 @@ verify_allocations_output(#{ histogram_start := HistStart, [BlockCount, GenTotalBlockCount]) end, - ok; -verify_allocations_output(#{}, {error, not_enabled}) -> ok. %% %% %% %% %% %% @@ -214,7 +221,8 @@ verify_carriers_output(#{ histogram_start := HistStart, ct:fail("Carrier count is ~p, expected at least ~p (SBC).", [CarrierCount, GenSBCCount]); CarrierCount >= GenSBCCount -> - ok + ct:pal("Found ~p carriers, required at least ~p (SBC)." , + [CarrierCount, GenSBCCount]) end, ok; @@ -252,13 +260,18 @@ test_format(Options0, Gather, Verify) -> test_abort(Gather) -> %% There's no way for us to tell whether this actually aborted or ran to %% completion, but it might catch a few segfaults. + %% This testcase is mostly useful when run in an debug emulator as it needs + %% the modified reduction count to trigger the odd trap scenarios Runner = self(), Ref = make_ref(), spawn_opt(fun() -> - [Gather({Type, SchedId, 1, 1, Ref}) || - Type <- erlang:system_info(alloc_util_allocators), - SchedId <- lists:seq(0, erlang:system_info(schedulers))], - Runner ! Ref + [begin + Ref2 = make_ref(), + [Gather({Type, SchedId, 1, 1, Ref2}) || + Type <- erlang:system_info(alloc_util_allocators), + SchedId <- lists:seq(0, erlang:system_info(schedulers))] + end || _ <- lists:seq(1,100)], + Runner ! Ref end, [{priority, max}]), receive Ref -> ok @@ -292,9 +305,19 @@ start_slave(Args) -> MicroSecs = erlang:monotonic_time(), Name = "instr" ++ integer_to_list(MicroSecs), Pa = filename:dirname(code:which(?MODULE)), - {ok, Node} = test_server:start_node(list_to_atom(Name), - slave, - [{args, "-pa " ++ Pa ++ " " ++ Args}]), + + %% We pass arguments through ZFLAGS as the nightly tests rotate + %% +Meamax/+Meamin which breaks the _enabled and _disabled tests unless + %% overridden. + ZFlags = os:getenv("ERL_ZFLAGS", ""), + {ok, Node} = try + os:putenv("ERL_ZFLAGS", ZFlags ++ [" " | Args]), + test_server:start_node(list_to_atom(Name), + slave, + [{args, "-pa " ++ Pa}]) + after + os:putenv("ERL_ZFLAGS", ZFlags) + end, Node. generate_test_blocks() -> @@ -309,8 +332,9 @@ generate_test_blocks() -> MBCs = [<<I, 0:64/unit:8>> || I <- lists:seq(1, ?GENERATED_MBC_BLOCK_COUNT)], Runner ! Ref, - receive after infinity -> ok end, - unreachable ! {SBCs, MBCs} + receive + gurka -> gaffel ! {SBCs, MBCs} + end end), receive Ref -> ok diff --git a/lib/tools/test/prof_bench_SUITE.erl b/lib/tools/test/prof_bench_SUITE.erl new file mode 100644 index 0000000000..50d0ba9cd9 --- /dev/null +++ b/lib/tools/test/prof_bench_SUITE.erl @@ -0,0 +1,126 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2017. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% +%% +-module(prof_bench_SUITE). + +-include_lib("common_test/include/ct_event.hrl"). + +%% Test server framework exports +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). + +-export([overhead/1]). + +%%%--------------------------------------------------------------------- +%%% Test suites +%%%--------------------------------------------------------------------- + + +suite() -> + [{timetrap,{minutes,10}}]. + +all() -> + [overhead]. + +init_per_suite(Config) -> + case {test_server:is_native(fprof_SUITE) or + (lists:any(fun(M) -> test_server:is_native(M) end, modules())) or + (whereis(cover_server) =/= undefined), + erlang:system_info(wordsize)} + of + {true, _} -> {skip, "Native or cover code"}; + {_, 4} -> {skip, "Can't run on 32-bit as files will be large"}; + {false, 8} -> Config + end. + +end_per_suite(Config) -> + LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), + file:delete(LogFile), + ok. + +%%%--------------------------------------------------------------------- + +%% ct:run_test([{suite, prof_bench_SUITE}]). +overhead(Config) -> + LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), + SofsCopy = filename:join(proplists:get_value(data_dir, Config), "sofs_copy.erl"), + TC = fun() -> compile:file(SofsCopy, [binary]) end, + _Warmup = timer:tc(TC), + + {NormTime,{ok, sofs_copy, _}} = timer:tc(TC), + {FProfTime,{ok,sofs_copy,_}} = fprof:apply(timer, tc, [TC], [{file, LogFile}]), + ct:pal("FProf: ~p Norm: ~p Ratio: ~p",[FProfTime, NormTime, NormTime / FProfTime * 100]), + {ok,{EProfTime,{ok,sofs_copy,_}}} = eprof:profile([], timer, tc, [TC]), + ct:pal("EProf: ~p Norm: ~p Ratio: ~p",[EProfTime, NormTime, NormTime / EProfTime * 100]), + {CProfTime,{ok,sofs_copy,_}} = cprof_apply(timer, tc, [TC]), + ct:pal("CProf: ~p Norm: ~p Ratio: ~p",[CProfTime, NormTime, NormTime / CProfTime * 100]), + {CoverTime,{ok,sofs_copy,_}} = cover_apply(timer, tc, [TC]), + ct:pal("Cover: ~p Norm: ~p Ratio: ~p",[CoverTime, NormTime, NormTime / CoverTime * 100]), + + ct_event:notify(#event{name = benchmark_data, + data = [{name, fprof_overhead}, + {value, NormTime / FProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, eprof_overhead}, + {value, NormTime / EProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, cprof_overhead}, + {value, NormTime / CProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, cover_overhead}, + {value, NormTime / CoverTime * 100}]}). + +%% overhead(Config) -> +%% LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), +%% SofsCopy = filename:join(proplists:get_value(data_dir, Config), "sofs_copy.erl"), +%% TC = fun() -> compile:file(SofsCopy, [binary]) end, +%% _Warmup = timer:tc(TC), + +%% [{ok,{EProfTime,{ok,sofs_copy,_}}} = eprof:profile([], timer, tc, [TC]) +%% || _ <- lists:seq(1,10)], +%% %% [fprof:apply(timer, tc, [TC], [{file, LogFile}]) || _ <- lists:seq(1,10)], +%% {FProfTime,{ok,sofs_copy,_}} = fprof:apply(timer, tc, [TC], [{file, LogFile}]), +%% {NormTime,{ok, sofs_copy, _}} = timer:tc(TC), + + %% ct:pal("FProf: ~p Norm: ~p Ratio: ~p",[FProfTime, NormTime, FProfTime / NormTime]). + +cprof_apply(M, F, A) -> + cprof:start(), + Res = apply(M, F, A), + cprof:stop(), + Res. + +cover_apply(M, F, A) -> + cover:start(), + catch cover:local_only(), + Modules = modules(), + [code:unstick_mod(Mod) || Mod <- Modules], + cover:compile_beam(Modules), + [code:stick_mod(Mod) || Mod <- Modules], + Res = apply(M, F, A), + cover:stop(), + Res. + +modules() -> + application:load(compiler), + {ok, CompilerModules} = application:get_key(compiler, modules), + %% Only cover compile a subset of the stdlib modules + StdlibModules = [erl_parse, erl_expand_records, erl_lint, gb_trees, gb_sets, sofs, + beam_lib, dict, epp, erl_anno, erl_bits, + orddict, ordsets, sets, string, unicode, unicode_util], + CompilerModules ++ StdlibModules. diff --git a/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl b/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl new file mode 100644 index 0000000000..2a9b19177e --- /dev/null +++ b/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl @@ -0,0 +1,2809 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2017. All Rights Reserved. +%% +%% 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. +%% +%% %CopyrightEnd% +%% +-module(sofs_copy). + +-export([from_term/1, from_term/2, from_external/2, empty_set/0, + is_type/1, set/1, set/2, from_sets/1, relation/1, relation/2, + a_function/1, a_function/2, family/1, family/2, + to_external/1, type/1, to_sets/1, no_elements/1, + specification/2, union/2, intersection/2, difference/2, + symdiff/2, symmetric_partition/2, product/1, product/2, + constant_function/2, is_equal/2, is_subset/2, is_sofs_set/1, + is_set/1, is_empty_set/1, is_disjoint/2]). + +-export([union/1, intersection/1, canonical_relation/1]). + +-export([relation_to_family/1, domain/1, range/1, field/1, + relative_product/1, relative_product/2, relative_product1/2, + converse/1, image/2, inverse_image/2, strict_relation/1, + weak_relation/1, extension/3, is_a_function/1]). + +-export([composite/2, inverse/1]). + +-export([restriction/2, restriction/3, drestriction/2, drestriction/3, + substitution/2, projection/2, partition/1, partition/2, + partition/3, multiple_relative_product/2, join/4]). + +-export([family_to_relation/1, family_specification/2, + union_of_family/1, intersection_of_family/1, + family_union/1, family_intersection/1, + family_domain/1, family_range/1, family_field/1, + family_union/2, family_intersection/2, family_difference/2, + partition_family/2, family_projection/2]). + +-export([family_to_digraph/1, family_to_digraph/2, + digraph_to_family/1, digraph_to_family/2]). + +%% Shorter names of some functions. +-export([fam2rel/1, rel2fam/1]). + +-import(lists, + [any/2, append/1, flatten/1, foreach/2, + keysort/2, last/1, map/2, mapfoldl/3, member/2, merge/2, + reverse/1, reverse/2, sort/1, umerge/1, umerge/2, usort/1]). + +-compile({inline, [{family_to_relation,1}, {relation_to_family,1}]}). + +-compile({inline, [{rel,2},{a_func,2},{fam,2},{term2set,2}]}). + +-compile({inline, [{external_fun,1},{element_type,1}]}). + +-compile({inline, + [{unify_types,2}, {match_types,2}, + {test_rel,3}, {symdiff,3}, + {subst,3}]}). + +-compile({inline, [{fam_binop,3}]}). + +%% Nope, no is_member, del_member or add_member. +%% +%% See also "Naive Set Theory" by Paul R. Halmos. +%% +%% By convention, erlang:error/1 is called from exported functions. + +-define(TAG, 'Set'). +-define(ORDTAG, 'OrdSet'). + +-record(?TAG, {data = [] :: list(), type = type :: term()}). +-record(?ORDTAG, {orddata = {} :: tuple() | atom(), + ordtype = type :: term()}). + +-define(LIST(S), (S)#?TAG.data). +-define(TYPE(S), (S)#?TAG.type). +-define(SET(L, T), #?TAG{data = L, type = T}). +-define(IS_SET(S), is_record(S, ?TAG)). +-define(IS_UNTYPED_SET(S), ?TYPE(S) =:= ?ANYTYPE). + +%% Ordered sets and atoms: +-define(ORDDATA(S), (S)#?ORDTAG.orddata). +-define(ORDTYPE(S), (S)#?ORDTAG.ordtype). +-define(ORDSET(L, T), #?ORDTAG{orddata = L, ordtype = T}). +-define(IS_ORDSET(S), is_record(S, ?ORDTAG)). +-define(ATOM_TYPE, atom). +-define(IS_ATOM_TYPE(T), is_atom(T)). % true for ?ANYTYPE... + +%% When IS_SET is true: +-define(ANYTYPE, '_'). +-define(BINREL(X, Y), {X, Y}). +-define(IS_RELATION(R), is_tuple(R)). +-define(REL_ARITY(R), tuple_size(R)). +-define(REL_TYPE(I, R), element(I, R)). +-define(SET_OF(X), [X]). +-define(IS_SET_OF(X), is_list(X)). +-define(FAMILY(X, Y), ?BINREL(X, ?SET_OF(Y))). + +-export_type([anyset/0, binary_relation/0, external_set/0, a_function/0, + family/0, relation/0, set_of_sets/0, set_fun/0, spec_fun/0, + type/0]). +-export_type([ordset/0, a_set/0]). + +-type(anyset() :: ordset() | a_set()). +-type(binary_relation() :: relation()). +-type(external_set() :: term()). +-type(a_function() :: relation()). +-type(family() :: a_function()). +-opaque(ordset() :: #?ORDTAG{}). +-type(relation() :: a_set()). +-opaque(a_set() :: #?TAG{}). +-type(set_of_sets() :: a_set()). +-type(set_fun() :: pos_integer() + | {external, fun((external_set()) -> external_set())} + | fun((anyset()) -> anyset())). +-type(spec_fun() :: {external, fun((external_set()) -> boolean())} + | fun((anyset()) -> boolean())). +-type(type() :: term()). + +-type(tuple_of(_T) :: tuple()). + +%% +%% Exported functions +%% + +%%% +%%% Create sets +%%% + +-spec(from_term(Term) -> AnySet when + AnySet :: anyset(), + Term :: term()). +from_term(T) -> + Type = case T of + _ when is_list(T) -> [?ANYTYPE]; + _ -> ?ANYTYPE + end, + try setify(T, Type) + catch _:_ -> erlang:error(badarg) + end. + +-spec(from_term(Term, Type) -> AnySet when + AnySet :: anyset(), + Term :: term(), + Type :: type()). +from_term(L, T) -> + case is_type(T) of + true -> + try setify(L, T) + catch _:_ -> erlang:error(badarg) + end; + false -> + erlang:error(badarg) + end. + +-spec(from_external(ExternalSet, Type) -> AnySet when + ExternalSet :: external_set(), + AnySet :: anyset(), + Type :: type()). +from_external(L, ?SET_OF(Type)) -> + ?SET(L, Type); +from_external(T, Type) -> + ?ORDSET(T, Type). + +-spec(empty_set() -> Set when + Set :: a_set()). +empty_set() -> + ?SET([], ?ANYTYPE). + +-spec(is_type(Term) -> Bool when + Bool :: boolean(), + Term :: term()). +is_type(Atom) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE -> + true; +is_type(?SET_OF(T)) -> + is_element_type(T); +is_type(T) when tuple_size(T) > 0 -> + is_types(tuple_size(T), T); +is_type(_T) -> + false. + +-spec(set(Terms) -> Set when + Set :: a_set(), + Terms :: [term()]). +set(L) -> + try usort(L) of + SL -> ?SET(SL, ?ATOM_TYPE) + catch _:_ -> erlang:error(badarg) + end. + +-spec(set(Terms, Type) -> Set when + Set :: a_set(), + Terms :: [term()], + Type :: type()). +set(L, ?SET_OF(Type)) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE -> + try usort(L) of + SL -> ?SET(SL, Type) + catch _:_ -> erlang:error(badarg) + end; +set(L, ?SET_OF(_) = T) -> + try setify(L, T) + catch _:_ -> erlang:error(badarg) + end; +set(_, _) -> + erlang:error(badarg). + +-spec(from_sets(ListOfSets) -> Set when + Set :: a_set(), + ListOfSets :: [anyset()]; + (TupleOfSets) -> Ordset when + Ordset :: ordset(), + TupleOfSets :: tuple_of(anyset())). +from_sets(Ss) when is_list(Ss) -> + case set_of_sets(Ss, [], ?ANYTYPE) of + {error, Error} -> + erlang:error(Error); + Set -> + Set + end; +from_sets(Tuple) when is_tuple(Tuple) -> + case ordset_of_sets(tuple_to_list(Tuple), [], []) of + error -> + erlang:error(badarg); + Set -> + Set + end; +from_sets(_) -> + erlang:error(badarg). + +-spec(relation(Tuples) -> Relation when + Relation :: relation(), + Tuples :: [tuple()]). +relation([]) -> + ?SET([], ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)); +relation(Ts = [T | _]) when is_tuple(T) -> + try rel(Ts, tuple_size(T)) + catch _:_ -> erlang:error(badarg) + end; +relation(_) -> + erlang:error(badarg). + +-spec(relation(Tuples, Type) -> Relation when + N :: integer(), + Type :: N | type(), + Relation :: relation(), + Tuples :: [tuple()]). +relation(Ts, TS) -> + try rel(Ts, TS) + catch _:_ -> erlang:error(badarg) + end. + +-spec(a_function(Tuples) -> Function when + Function :: a_function(), + Tuples :: [tuple()]). +a_function(Ts) -> + try func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(a_function(Tuples, Type) -> Function when + Function :: a_function(), + Tuples :: [tuple()], + Type :: type()). +a_function(Ts, T) -> + try a_func(Ts, T) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(family(Tuples) -> Family when + Family :: family(), + Tuples :: [tuple()]). +family(Ts) -> + try fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(family(Tuples, Type) -> Family when + Family :: family(), + Tuples :: [tuple()], + Type :: type()). +family(Ts, T) -> + try fam(Ts, T) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +%%% +%%% Functions on sets. +%%% + +-spec(to_external(AnySet) -> ExternalSet when + ExternalSet :: external_set(), + AnySet :: anyset()). +to_external(S) when ?IS_SET(S) -> + ?LIST(S); +to_external(S) when ?IS_ORDSET(S) -> + ?ORDDATA(S). + +-spec(type(AnySet) -> Type when + AnySet :: anyset(), + Type :: type()). +type(S) when ?IS_SET(S) -> + ?SET_OF(?TYPE(S)); +type(S) when ?IS_ORDSET(S) -> + ?ORDTYPE(S). + +-spec(to_sets(ASet) -> Sets when + ASet :: a_set() | ordset(), + Sets :: tuple_of(AnySet) | [AnySet], + AnySet :: anyset()). +to_sets(S) when ?IS_SET(S) -> + case ?TYPE(S) of + ?SET_OF(Type) -> list_of_sets(?LIST(S), Type, []); + Type -> list_of_ordsets(?LIST(S), Type, []) + end; +to_sets(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> + tuple_of_sets(tuple_to_list(?ORDDATA(S)), tuple_to_list(?ORDTYPE(S)), []); +to_sets(S) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(no_elements(ASet) -> NoElements when + ASet :: a_set() | ordset(), + NoElements :: non_neg_integer()). +no_elements(S) when ?IS_SET(S) -> + length(?LIST(S)); +no_elements(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> + tuple_size(?ORDDATA(S)); +no_elements(S) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(specification(Fun, Set1) -> Set2 when + Fun :: spec_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +specification(Fun, S) when ?IS_SET(S) -> + Type = ?TYPE(S), + R = case external_fun(Fun) of + false -> + spec(?LIST(S), Fun, element_type(Type), []); + XFun -> + specification(?LIST(S), XFun, []) + end, + case R of + SL when is_list(SL) -> + ?SET(SL, Type); + Bad -> + erlang:error(Bad) + end. + +-spec(union(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(umerge(?LIST(S1), ?LIST(S2)), Type) + end. + +-spec(intersection(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(intersection(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(difference(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(difference(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(symdiff(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(symdiff(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(symmetric_partition(Set1, Set2) -> {Set3, Set4, Set5} when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set(), + Set4 :: a_set(), + Set5 :: a_set()). +symmetric_partition(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> sympart(?LIST(S1), ?LIST(S2), [], [], [], Type) + end. + +-spec(product(Set1, Set2) -> BinRel when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +product(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + if + ?TYPE(S1) =:= ?ANYTYPE -> S1; + ?TYPE(S2) =:= ?ANYTYPE -> S2; + true -> + F = fun(E) -> {0, E} end, + T = ?BINREL(?TYPE(S1), ?TYPE(S2)), + ?SET(relprod(map(F, ?LIST(S1)), map(F, ?LIST(S2))), T) + end. + +-spec(product(TupleOfSets) -> Relation when + Relation :: relation(), + TupleOfSets :: tuple_of(a_set())). +product({S1, S2}) -> + product(S1, S2); +product(T) when is_tuple(T) -> + Ss = tuple_to_list(T), + try sets_to_list(Ss) of + [] -> + erlang:error(badarg); + L -> + Type = types(Ss, []), + case member([], L) of + true -> + empty_set(); + false -> + ?SET(reverse(prod(L, [], [])), Type) + end + catch _:_ -> erlang:error(badarg) + end. + +-spec(constant_function(Set, AnySet) -> Function when + AnySet :: anyset(), + Function :: a_function(), + Set :: a_set()). +constant_function(S, E) when ?IS_SET(S) -> + case {?TYPE(S), is_sofs_set(E)} of + {?ANYTYPE, true} -> S; + {Type, true} -> + NType = ?BINREL(Type, type(E)), + ?SET(constant_function(?LIST(S), to_external(E), []), NType); + _ -> erlang:error(badarg) + end; +constant_function(S, _) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(is_equal(AnySet1, AnySet2) -> Bool when + AnySet1 :: anyset(), + AnySet2 :: anyset(), + Bool :: boolean()). +is_equal(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> ?LIST(S1) == ?LIST(S2); + false -> erlang:error(type_mismatch) + end; +is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_ORDSET(S2) -> + case match_types(?ORDTYPE(S1), ?ORDTYPE(S2)) of + true -> ?ORDDATA(S1) == ?ORDDATA(S2); + false -> erlang:error(type_mismatch) + end; +is_equal(S1, S2) when ?IS_SET(S1), ?IS_ORDSET(S2) -> + erlang:error(type_mismatch); +is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) -> + erlang:error(type_mismatch). + +-spec(is_subset(Set1, Set2) -> Bool when + Bool :: boolean(), + Set1 :: a_set(), + Set2 :: a_set()). +is_subset(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> subset(?LIST(S1), ?LIST(S2)); + false -> erlang:error(type_mismatch) + end. + +-spec(is_sofs_set(Term) -> Bool when + Bool :: boolean(), + Term :: term()). +is_sofs_set(S) when ?IS_SET(S) -> + true; +is_sofs_set(S) when ?IS_ORDSET(S) -> + true; +is_sofs_set(_S) -> + false. + +-spec(is_set(AnySet) -> Bool when + AnySet :: anyset(), + Bool :: boolean()). +is_set(S) when ?IS_SET(S) -> + true; +is_set(S) when ?IS_ORDSET(S) -> + false. + +-spec(is_empty_set(AnySet) -> Bool when + AnySet :: anyset(), + Bool :: boolean()). +is_empty_set(S) when ?IS_SET(S) -> + ?LIST(S) =:= []; +is_empty_set(S) when ?IS_ORDSET(S) -> + false. + +-spec(is_disjoint(Set1, Set2) -> Bool when + Bool :: boolean(), + Set1 :: a_set(), + Set2 :: a_set()). +is_disjoint(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> + case ?LIST(S1) of + [] -> true; + [A | As] -> disjoint(?LIST(S2), A, As) + end; + false -> erlang:error(type_mismatch) + end. + +%%% +%%% Functions on set-of-sets. +%%% + +-spec(union(SetOfSets) -> Set when + Set :: a_set(), + SetOfSets :: set_of_sets()). +union(Sets) when ?IS_SET(Sets) -> + case ?TYPE(Sets) of + ?SET_OF(Type) -> ?SET(lunion(?LIST(Sets)), Type); + ?ANYTYPE -> Sets; + _ -> erlang:error(badarg) + end. + +-spec(intersection(SetOfSets) -> Set when + Set :: a_set(), + SetOfSets :: set_of_sets()). +intersection(Sets) when ?IS_SET(Sets) -> + case ?LIST(Sets) of + [] -> erlang:error(badarg); + [L | Ls] -> + case ?TYPE(Sets) of + ?SET_OF(Type) -> + ?SET(lintersection(Ls, L), Type); + _ -> erlang:error(badarg) + end + end. + +-spec(canonical_relation(SetOfSets) -> BinRel when + BinRel :: binary_relation(), + SetOfSets :: set_of_sets()). +canonical_relation(Sets) when ?IS_SET(Sets) -> + ST = ?TYPE(Sets), + case ST of + ?SET_OF(?ANYTYPE) -> empty_set(); + ?SET_OF(Type) -> + ?SET(can_rel(?LIST(Sets), []), ?BINREL(Type, ST)); + ?ANYTYPE -> Sets; + _ -> erlang:error(badarg) + end. + +%%% +%%% Functions on binary relations only. +%%% + +-spec(rel2fam(BinRel) -> Family when + Family :: family(), + BinRel :: binary_relation()). +rel2fam(R) -> + relation_to_family(R). + +-spec(relation_to_family(BinRel) -> Family when + Family :: family(), + BinRel :: binary_relation()). +%% Inlined. +relation_to_family(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + ?SET(rel2family(?LIST(R)), ?FAMILY(DT, RT)); + ?ANYTYPE -> R; + _Else -> erlang:error(badarg) + end. + +-spec(domain(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +domain(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, _) -> ?SET(dom(?LIST(R)), DT); + ?ANYTYPE -> R; + _Else -> erlang:error(badarg) + end. + +-spec(range(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +range(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(_, RT) -> ?SET(ran(?LIST(R), []), RT); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(field(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +%% In "Introduction to LOGIC", Suppes defines the field of a binary +%% relation to be the union of the domain and the range (or +%% counterdomain). +field(R) -> + union(domain(R), range(R)). + +-spec(relative_product(ListOfBinRels) -> BinRel2 when + ListOfBinRels :: [BinRel, ...], + BinRel :: binary_relation(), + BinRel2 :: binary_relation()). +%% The following clause is kept for backward compatibility. +%% The list is due to Dialyzer's specs. +relative_product(RT) when is_tuple(RT) -> + relative_product(tuple_to_list(RT)); +relative_product(RL) when is_list(RL) -> + case relprod_n(RL, foo, false, false) of + {error, Reason} -> + erlang:error(Reason); + Reply -> + Reply + end. + +-spec(relative_product(ListOfBinRels, BinRel1) -> BinRel2 when + ListOfBinRels :: [BinRel, ...], + BinRel :: binary_relation(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(); + (BinRel1, BinRel2) -> BinRel3 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + BinRel3 :: binary_relation()). +relative_product(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) -> + relative_product1(converse(R1), R2); +%% The following clause is kept for backward compatibility. +%% The list is due to Dialyzer's specs. +relative_product(RT, R) when is_tuple(RT), ?IS_SET(R) -> + relative_product(tuple_to_list(RT), R); +relative_product(RL, R) when is_list(RL), ?IS_SET(R) -> + EmptyR = case ?TYPE(R) of + ?BINREL(_, _) -> ?LIST(R) =:= []; + ?ANYTYPE -> true; + _ -> erlang:error(badarg) + end, + case relprod_n(RL, R, EmptyR, true) of + {error, Reason} -> + erlang:error(Reason); + Reply -> + Reply + end. + +-spec(relative_product1(BinRel1, BinRel2) -> BinRel3 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + BinRel3 :: binary_relation()). +relative_product1(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) -> + {DTR1, RTR1} = case ?TYPE(R1) of + ?BINREL(_, _) = R1T -> R1T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + {DTR2, RTR2} = case ?TYPE(R2) of + ?BINREL(_, _) = R2T -> R2T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + case match_types(DTR1, DTR2) of + true when DTR1 =:= ?ANYTYPE -> R1; + true when DTR2 =:= ?ANYTYPE -> R2; + true -> ?SET(relprod(?LIST(R1), ?LIST(R2)), ?BINREL(RTR1, RTR2)); + false -> erlang:error(type_mismatch) + end. + +-spec(converse(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +converse(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> ?SET(converse(?LIST(R), []), ?BINREL(RT, DT)); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(image(BinRel, Set1) -> Set2 when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +image(R, S) when ?IS_SET(R), ?IS_SET(S) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case match_types(DT, ?TYPE(S)) of + true -> + ?SET(usort(restrict(?LIST(S), ?LIST(R))), RT); + false -> + erlang:error(type_mismatch) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(inverse_image(BinRel, Set1) -> Set2 when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +inverse_image(R, S) when ?IS_SET(R), ?IS_SET(S) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case match_types(RT, ?TYPE(S)) of + true -> + NL = restrict(?LIST(S), converse(?LIST(R), [])), + ?SET(usort(NL), DT); + false -> + erlang:error(type_mismatch) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(strict_relation(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +strict_relation(R) when ?IS_SET(R) -> + case ?TYPE(R) of + Type = ?BINREL(_, _) -> + ?SET(strict(?LIST(R), []), Type); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(weak_relation(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +weak_relation(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case unify_types(DT, RT) of + [] -> + erlang:error(badarg); + Type -> + ?SET(weak(?LIST(R)), ?BINREL(Type, Type)) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(extension(BinRel1, Set, AnySet) -> BinRel2 when + AnySet :: anyset(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) -> + case {?TYPE(R), ?TYPE(S), is_sofs_set(E)} of + {T=?BINREL(DT, RT), ST, true} -> + case match_types(DT, ST) and match_types(RT, type(E)) of + false -> + erlang:error(type_mismatch); + true -> + RL = ?LIST(R), + case extc([], ?LIST(S), to_external(E), RL) of + [] -> + R; + L -> + ?SET(merge(RL, reverse(L)), T) + end + end; + {?ANYTYPE, ?ANYTYPE, true} -> + R; + {?ANYTYPE, ST, true} -> + case type(E) of + ?SET_OF(?ANYTYPE) -> + R; + ET -> + ?SET([], ?BINREL(ST, ET)) + end; + {_, _, true} -> + erlang:error(badarg) + end. + +-spec(is_a_function(BinRel) -> Bool when + Bool :: boolean(), + BinRel :: binary_relation()). +is_a_function(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(_, _) -> + case ?LIST(R) of + [] -> true; + [{V,_} | Es] -> is_a_func(Es, V) + end; + ?ANYTYPE -> true; + _ -> erlang:error(badarg) + end. + +-spec(restriction(BinRel1, Set) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +restriction(Relation, Set) -> + restriction(1, Relation, Set). + +-spec(drestriction(BinRel1, Set) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +drestriction(Relation, Set) -> + drestriction(1, Relation, Set). + +%%% +%%% Functions on functions only. +%%% + +-spec(composite(Function1, Function2) -> Function3 when + Function1 :: a_function(), + Function2 :: a_function(), + Function3 :: a_function()). +composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) -> + ?BINREL(DTF1, RTF1) = case ?TYPE(Fn1)of + ?BINREL(_, _) = F1T -> F1T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + ?BINREL(DTF2, RTF2) = case ?TYPE(Fn2) of + ?BINREL(_, _) = F2T -> F2T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + case match_types(RTF1, DTF2) of + true when DTF1 =:= ?ANYTYPE -> Fn1; + true when DTF2 =:= ?ANYTYPE -> Fn2; + true -> + case comp(?LIST(Fn1), ?LIST(Fn2)) of + SL when is_list(SL) -> + ?SET(sort(SL), ?BINREL(DTF1, RTF2)); + Bad -> + erlang:error(Bad) + end; + false -> erlang:error(type_mismatch) + end. + +-spec(inverse(Function1) -> Function2 when + Function1 :: a_function(), + Function2 :: a_function()). +inverse(Fn) when ?IS_SET(Fn) -> + case ?TYPE(Fn) of + ?BINREL(DT, RT) -> + case inverse1(?LIST(Fn)) of + SL when is_list(SL) -> + ?SET(SL, ?BINREL(RT, DT)); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> Fn; + _ -> erlang:error(badarg) + end. + +%%% +%%% Functions on relations (binary or other). +%%% + +-spec(restriction(SetFun, Set1, Set2) -> Set3 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +%% Equivalent to range(restriction(inverse(substitution(Fun, S1)), S2)). +restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + R; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, _SL} when RL =:= [] -> + R; + {true, []} -> + ?SET([], RT); + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + ?SET(reverse(restrict_n(I, RL, E, Es, [])), RT); + {true, [E | Es]} -> + ?SET(sort(restrict_n(I, keysort(I, RL), E, Es, [])), RT); + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + S2; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + NL = sort(restrict(?LIST(S2), converse(NSL, []))), + ?SET(NL, Type1); + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + S1; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + ?SET(sort(Sort, restrict(?LIST(S2), R1)), Type1); + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(drestriction(SetFun, Set1, Set2) -> Set3 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + R; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, []} -> + R; + {true, _SL} when RL =:= [] -> + R; + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + ?SET(diff_restrict_n(I, RL, E, Es, []), RT); + {true, [E | Es]} -> + ?SET(diff_restrict_n(I, keysort(I, RL), E, Es, []), RT); + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + S1; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + SL2 = ?LIST(S2), + NL = sort(diff_restrict(SL2, converse(NSL, []))), + ?SET(NL, Type1); + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + S1; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + SL2 = ?LIST(S2), + ?SET(sort(Sort, diff_restrict(SL2, R1)), Type1); + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(projection(SetFun, Set1) -> Set2 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +projection(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + _ when I =:= 1 -> + ?SET(projection1(?LIST(Set)), ?REL_TYPE(I, Type)); + _ -> + ?SET(projection_n(?LIST(Set), I, []), ?REL_TYPE(I, Type)) + end; +projection(Fun, Set) -> + range(substitution(Fun, Set)). + +-spec(substitution(SetFun, Set1) -> Set2 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +substitution(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + _Sort -> + NType = ?REL_TYPE(I, Type), + NSL = substitute_element(?LIST(Set), I, []), + ?SET(NSL, ?BINREL(Type, NType)) + end; +substitution(SetFun, Set) when ?IS_SET(Set) -> + Type = ?TYPE(Set), + L = ?LIST(Set), + case external_fun(SetFun) of + false when L =/= [] -> + case subst(L, SetFun, element_type(Type)) of + {SL, NewType} -> + ?SET(reverse(SL), ?BINREL(Type, NewType)); + Bad -> + erlang:error(Bad) + end; + false -> + empty_set(); + _ when Type =:= ?ANYTYPE -> + empty_set(); + _XFun when ?IS_SET_OF(Type) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type), + try check_fun(Type, XFun, FunT) of + _Sort -> + SL = substitute(L, XFun, []), + ?SET(SL, ?BINREL(Type, FunT)) + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(partition(SetOfSets) -> Partition when + SetOfSets :: set_of_sets(), + Partition :: a_set()). +partition(Sets) -> + F1 = relation_to_family(canonical_relation(Sets)), + F2 = relation_to_family(converse(F1)), + range(F2). + +-spec(partition(SetFun, Set) -> Partition when + SetFun :: set_fun(), + Partition :: a_set(), + Set :: a_set()). +partition(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + false -> % I =:= 1 + ?SET(partition_n(I, ?LIST(Set)), ?SET_OF(Type)); + true -> + ?SET(partition_n(I, keysort(I, ?LIST(Set))), ?SET_OF(Type)) + end; +partition(Fun, Set) -> + range(partition_family(Fun, Set)). + +-spec(partition(SetFun, Set1, Set2) -> {Set3, Set4} when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set(), + Set4 :: a_set()). +partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + {R, R}; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, _SL} when RL =:= [] -> + {R, R}; + {true, []} -> + {?SET([], RT), R}; + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + [L1 | L2] = partition3_n(I, RL, E, Es, [], []), + {?SET(L1, RT), ?SET(L2, RT)}; + {true, [E | Es]} -> + [L1 | L2] = partition3_n(I, keysort(I,RL), E, Es, [], []), + {?SET(L1, RT), ?SET(L2, RT)}; + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + {S2, S1}; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + R1 = converse(NSL, []), + [L1 | L2] = partition3(?LIST(S2), R1), + {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)}; + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + {S1, S1}; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + [L1 | L2] = partition3(?LIST(S2), R1), + {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)}; + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(multiple_relative_product(TupleOfBinRels, BinRel1) -> BinRel2 when + TupleOfBinRels :: tuple_of(BinRel), + BinRel :: binary_relation(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) -> + case test_rel(R, tuple_size(T), eq) of + true when ?TYPE(R) =:= ?ANYTYPE -> + empty_set(); + true -> + MProd = mul_relprod(tuple_to_list(T), 1, R), + relative_product(MProd); + false -> + erlang:error(badarg) + end. + +-spec(join(Relation1, I, Relation2, J) -> Relation3 when + Relation1 :: relation(), + Relation2 :: relation(), + Relation3 :: relation(), + I :: pos_integer(), + J :: pos_integer()). +join(R1, I1, R2, I2) + when ?IS_SET(R1), ?IS_SET(R2), is_integer(I1), is_integer(I2) -> + case test_rel(R1, I1, lte) and test_rel(R2, I2, lte) of + false -> erlang:error(badarg); + true when ?TYPE(R1) =:= ?ANYTYPE -> R1; + true when ?TYPE(R2) =:= ?ANYTYPE -> R2; + true -> + L1 = ?LIST(raise_element(R1, I1)), + L2 = ?LIST(raise_element(R2, I2)), + T = relprod1(L1, L2), + F = case (I1 =:= 1) and (I2 =:= 1) of + true -> + fun({X,Y}) -> join_element(X, Y) end; + false -> + fun({X,Y}) -> + list_to_tuple(join_element(X, Y, I2)) + end + end, + ?SET(replace(T, F, []), F({?TYPE(R1), ?TYPE(R2)})) + end. + +%% Inlined. +test_rel(R, I, C) -> + case ?TYPE(R) of + Rel when ?IS_RELATION(Rel), C =:= eq, I =:= ?REL_ARITY(Rel) -> true; + Rel when ?IS_RELATION(Rel), C =:= lte, I>=1, I =< ?REL_ARITY(Rel) -> + true; + ?ANYTYPE -> true; + _ -> false + end. + +%%% +%%% Family functions +%%% + +-spec(fam2rel(Family) -> BinRel when + Family :: family(), + BinRel :: binary_relation()). +fam2rel(F) -> + family_to_relation(F). + +-spec(family_to_relation(Family) -> BinRel when + Family :: family(), + BinRel :: binary_relation()). +%% Inlined. +family_to_relation(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, RT) -> + ?SET(family2rel(?LIST(F), []), ?BINREL(DT, RT)); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_specification(Fun, Family1) -> Family2 when + Fun :: spec_fun(), + Family1 :: family(), + Family2 :: family()). +family_specification(Fun, F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) = FType -> + R = case external_fun(Fun) of + false -> + fam_spec(?LIST(F), Fun, Type, []); + XFun -> + fam_specification(?LIST(F), XFun, []) + end, + case R of + SL when is_list(SL) -> + ?SET(SL, FType); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(union_of_family(Family) -> Set when + Family :: family(), + Set :: a_set()). +union_of_family(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) -> + ?SET(un_of_fam(?LIST(F), []), Type); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(intersection_of_family(Family) -> Set when + Family :: family(), + Set :: a_set()). +intersection_of_family(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) -> + case int_of_fam(?LIST(F)) of + FU when is_list(FU) -> + ?SET(FU, Type); + Bad -> + erlang:error(Bad) + end; + _ -> erlang:error(badarg) + end. + +-spec(family_union(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_union(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?SET_OF(Type)) -> + ?SET(fam_un(?LIST(F), []), ?FAMILY(DT, Type)); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_intersection(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_intersection(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?SET_OF(Type)) -> + case fam_int(?LIST(F), []) of + FU when is_list(FU) -> + ?SET(FU, ?FAMILY(DT, Type)); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_domain(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_domain(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(FDT, ?BINREL(DT, _)) -> + ?SET(fam_dom(?LIST(F), []), ?FAMILY(FDT, DT)); + ?ANYTYPE -> F; + ?FAMILY(_, ?ANYTYPE) -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_range(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_range(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?BINREL(_, RT)) -> + ?SET(fam_ran(?LIST(F), []), ?FAMILY(DT, RT)); + ?ANYTYPE -> F; + ?FAMILY(_, ?ANYTYPE) -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_field(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_field(F) -> + family_union(family_domain(F), family_range(F)). + +-spec(family_union(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_union(F1, F2) -> + fam_binop(F1, F2, fun fam_union/3). + +-spec(family_intersection(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_intersection(F1, F2) -> + fam_binop(F1, F2, fun fam_intersect/3). + +-spec(family_difference(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_difference(F1, F2) -> + fam_binop(F1, F2, fun fam_difference/3). + +%% Inlined. +fam_binop(F1, F2, FF) when ?IS_SET(F1), ?IS_SET(F2) -> + case unify_types(?TYPE(F1), ?TYPE(F2)) of + [] -> + erlang:error(type_mismatch); + ?ANYTYPE -> + F1; + Type = ?FAMILY(_, _) -> + ?SET(FF(?LIST(F1), ?LIST(F2), []), Type); + _ -> erlang:error(badarg) + end. + +-spec(partition_family(SetFun, Set) -> Family when + Family :: family(), + SetFun :: set_fun(), + Set :: a_set()). +partition_family(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + false -> % when I =:= 1 + ?SET(fam_partition_n(I, ?LIST(Set)), + ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type))); + true -> + ?SET(fam_partition_n(I, keysort(I, ?LIST(Set))), + ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type))) + end; +partition_family(SetFun, Set) when ?IS_SET(Set) -> + Type = ?TYPE(Set), + SL = ?LIST(Set), + case external_fun(SetFun) of + false when SL =/= [] -> + case subst(SL, SetFun, element_type(Type)) of + {NSL, NewType} -> + P = fam_partition(converse(NSL, []), true), + ?SET(reverse(P), ?BINREL(NewType, ?SET_OF(Type))); + Bad -> + erlang:error(Bad) + end; + false -> + empty_set(); + _ when Type =:= ?ANYTYPE -> + empty_set(); + _XFun when ?IS_SET_OF(Type) -> + erlang:error(badarg); + XFun -> + DType = XFun(Type), + try check_fun(Type, XFun, DType) of + Sort -> + Ts = inverse_substitution(?LIST(Set), XFun, Sort), + P = fam_partition(Ts, Sort), + ?SET(reverse(P), ?BINREL(DType, ?SET_OF(Type))) + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(family_projection(SetFun, Family1) -> Family2 when + SetFun :: set_fun(), + Family1 :: family(), + Family2 :: family()). +family_projection(SetFun, F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) when [] =:= ?LIST(F) -> + empty_set(); + ?FAMILY(DT, Type) -> + case external_fun(SetFun) of + false -> + case fam_proj(?LIST(F), SetFun, Type, ?ANYTYPE, []) of + {SL, NewType} -> + ?SET(SL, ?BINREL(DT, NewType)); + Bad -> + erlang:error(Bad) + end; + _ -> + erlang:error(badarg) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +%%% +%%% Digraph functions +%%% + +-spec(family_to_digraph(Family) -> Graph when + Graph :: digraph:graph(), + Family :: family()). +family_to_digraph(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) -> fam2digraph(F, digraph:new()); + ?ANYTYPE -> digraph:new(); + _Else -> erlang:error(badarg) + end. + +-spec(family_to_digraph(Family, GraphType) -> Graph when + Graph :: digraph:graph(), + Family :: family(), + GraphType :: [digraph:d_type()]). +family_to_digraph(F, Type) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) -> ok; + ?ANYTYPE -> ok; + _Else -> erlang:error(badarg) + end, + try digraph:new(Type) of + G -> case catch fam2digraph(F, G) of + {error, Reason} -> + true = digraph:delete(G), + erlang:error(Reason); + _ -> + G + end + catch + error:badarg -> erlang:error(badarg) + end. + +-spec(digraph_to_family(Graph) -> Family when + Graph :: digraph:graph(), + Family :: family()). +digraph_to_family(G) -> + try digraph_family(G) of + L -> ?SET(L, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) + catch _:_ -> erlang:error(badarg) + end. + +-spec(digraph_to_family(Graph, Type) -> Family when + Graph :: digraph:graph(), + Family :: family(), + Type :: type()). +digraph_to_family(G, T) -> + case {is_type(T), T} of + {true, ?SET_OF(?FAMILY(_,_) = Type)} -> + try digraph_family(G) of + L -> ?SET(L, Type) + catch _:_ -> erlang:error(badarg) + end; + _ -> + erlang:error(badarg) + end. + +%% +%% Local functions +%% + +%% Type = OrderedSetType +%% | SetType +%% | atom() except '_' +%% OrderedSetType = {Type, ..., Type} +%% SetType = [ElementType] % list of exactly one element +%% ElementType = '_' % any type (implies empty set) +%% | Type + +is_types(0, _T) -> + true; +is_types(I, T) -> + case is_type(?REL_TYPE(I, T)) of + true -> is_types(I-1, T); + false -> false + end. + +is_element_type(?ANYTYPE) -> + true; +is_element_type(T) -> + is_type(T). + +set_of_sets([S | Ss], L, T0) when ?IS_SET(S) -> + case unify_types([?TYPE(S)], T0) of + [] -> {error, type_mismatch}; + Type -> set_of_sets(Ss, [?LIST(S) | L], Type) + end; +set_of_sets([S | Ss], L, T0) when ?IS_ORDSET(S) -> + case unify_types(?ORDTYPE(S), T0) of + [] -> {error, type_mismatch}; + Type -> set_of_sets(Ss, [?ORDDATA(S) | L], Type) + end; +set_of_sets([], L, T) -> + ?SET(usort(L), T); +set_of_sets(_, _L, _T) -> + {error, badarg}. + +ordset_of_sets([S | Ss], L, T) when ?IS_SET(S) -> + ordset_of_sets(Ss, [?LIST(S) | L], [[?TYPE(S)] | T]); +ordset_of_sets([S | Ss], L, T) when ?IS_ORDSET(S) -> + ordset_of_sets(Ss, [?ORDDATA(S) | L], [?ORDTYPE(S) | T]); +ordset_of_sets([], L, T) -> + ?ORDSET(list_to_tuple(reverse(L)), list_to_tuple(reverse(T))); +ordset_of_sets(_, _L, _T) -> + error. + +%% Inlined. +rel(Ts, [Type]) -> + case is_type(Type) and atoms_only(Type, 1) of + true -> + rel(Ts, tuple_size(Type), Type); + false -> + rel_type(Ts, [], Type) + end; +rel(Ts, Sz) -> + rel(Ts, Sz, erlang:make_tuple(Sz, ?ATOM_TYPE)). + +atoms_only(Type, I) when ?IS_ATOM_TYPE(?REL_TYPE(I, Type)) -> + atoms_only(Type, I+1); +atoms_only(Type, I) when I > tuple_size(Type), ?IS_RELATION(Type) -> + true; +atoms_only(_Type, _I) -> + false. + +rel(Ts, Sz, Type) when Sz >= 1 -> + SL = usort(Ts), + rel(SL, SL, Sz, Type). + +rel([T | Ts], L, Sz, Type) when tuple_size(T) =:= Sz -> + rel(Ts, L, Sz, Type); +rel([], L, _Sz, Type) -> + ?SET(L, Type). + +rel_type([E | Ts], L, Type) -> + {NType, NE} = make_element(E, Type, Type), + rel_type(Ts, [NE | L], NType); +rel_type([], [], ?ANYTYPE) -> + empty_set(); +rel_type([], SL, Type) when ?IS_RELATION(Type) -> + ?SET(usort(SL), Type). + +%% Inlined. +a_func(Ts, T) -> + case {T, is_type(T)} of + {[?BINREL(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), + ?IS_ATOM_TYPE(RT) -> + func(Ts, Type); + {[Type], true} -> + func_type(Ts, [], Type, fun(?BINREL(_,_)) -> true end) + end. + +func(L0, Type) -> + L = usort(L0), + func(L, L, L, Type). + +func([{X,_} | Ts], X0, L, Type) when X /= X0 -> + func(Ts, X, L, Type); +func([{X,_} | _Ts], X0, _L, _Type) when X == X0 -> + bad_function; +func([], _X0, L, Type) -> + ?SET(L, Type). + +%% Inlined. +fam(Ts, T) -> + case {T, is_type(T)} of + {[?FAMILY(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), + ?IS_ATOM_TYPE(RT) -> + fam2(Ts, Type); + {[Type], true} -> + func_type(Ts, [], Type, fun(?FAMILY(_,_)) -> true end) + end. + +fam2([], Type) -> + ?SET([], Type); +fam2(Ts, Type) -> + fam2(sort(Ts), Ts, [], Type). + +fam2([{I,L} | T], I0, SL, Type) when I /= I0 -> + fam2(T, I, [{I,usort(L)} | SL], Type); +fam2([{I,L} | T], I0, SL, Type) when I == I0 -> + case {usort(L), SL} of + {NL, [{_I,NL1} | _]} when NL == NL1 -> + fam2(T, I0, SL, Type); + _ -> + bad_function + end; +fam2([], _I0, SL, Type) -> + ?SET(reverse(SL), Type). + +func_type([E | T], SL, Type, F) -> + {NType, NE} = make_element(E, Type, Type), + func_type(T, [NE | SL], NType, F); +func_type([], [], ?ANYTYPE, _F) -> + empty_set(); +func_type([], SL, Type, F) -> + true = F(Type), + NL = usort(SL), + check_function(NL, ?SET(NL, Type)). + +setify(L, ?SET_OF(Atom)) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE -> + ?SET(usort(L), Atom); +setify(L, ?SET_OF(Type0)) -> + try is_no_lists(Type0) of + N when is_integer(N) -> + rel(L, N, Type0); + Sizes -> + make_oset(L, Sizes, L, Type0) + catch + _:_ -> + {?SET_OF(Type), Set} = create(L, Type0, Type0, []), + ?SET(Set, Type) + end; +setify(E, Type0) -> + {Type, OrdSet} = make_element(E, Type0, Type0), + ?ORDSET(OrdSet, Type). + +is_no_lists(T) when is_tuple(T) -> + Sz = tuple_size(T), + is_no_lists(T, Sz, Sz, []). + +is_no_lists(_T, 0, Sz, []) -> + Sz; +is_no_lists(_T, 0, Sz, L) -> + {Sz, L}; +is_no_lists(T, I, Sz, L) when ?IS_ATOM_TYPE(?REL_TYPE(I, T)) -> + is_no_lists(T, I-1, Sz, L); +is_no_lists(T, I, Sz, L) -> + is_no_lists(T, I-1, Sz, [{I,is_no_lists(?REL_TYPE(I, T))} | L]). + +create([E | Es], T, T0, L) -> + {NT, S} = make_element(E, T, T0), + create(Es, NT, T0, [S | L]); +create([], T, _T0, L) -> + {?SET_OF(T), usort(L)}. + +make_element(C, ?ANYTYPE, _T0) -> + make_element(C); +make_element(C, Atom, ?ANYTYPE) when ?IS_ATOM_TYPE(Atom), + not is_list(C), not is_tuple(C) -> + {Atom, C}; +make_element(C, Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + {Atom, C}; +make_element(T, TT, ?ANYTYPE) when tuple_size(T) =:= tuple_size(TT) -> + make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], ?ANYTYPE); +make_element(T, TT, T0) when tuple_size(T) =:= tuple_size(TT) -> + make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], tuple_to_list(T0)); +make_element(L, [LT], ?ANYTYPE) when is_list(L) -> + create(L, LT, ?ANYTYPE, []); +make_element(L, [LT], [T0]) when is_list(L) -> + create(L, LT, T0, []). + +make_tuple([E | Es], [T | Ts], NT, L, T0) when T0 =:= ?ANYTYPE -> + {ET, ES} = make_element(E, T, T0), + make_tuple(Es, Ts, [ET | NT], [ES | L], T0); +make_tuple([E | Es], [T | Ts], NT, L, [T0 | T0s]) -> + {ET, ES} = make_element(E, T, T0), + make_tuple(Es, Ts, [ET | NT], [ES | L], T0s); +make_tuple([], [], NT, L, _T0s) when NT =/= [] -> + {list_to_tuple(reverse(NT)), list_to_tuple(reverse(L))}. + +%% Derive type. +make_element(C) when not is_list(C), not is_tuple(C) -> + {?ATOM_TYPE, C}; +make_element(T) when is_tuple(T) -> + make_tuple(tuple_to_list(T), [], []); +make_element(L) when is_list(L) -> + create(L, ?ANYTYPE, ?ANYTYPE, []). + +make_tuple([E | Es], T, L) -> + {ET, ES} = make_element(E), + make_tuple(Es, [ET | T], [ES | L]); +make_tuple([], T, L) when T =/= [] -> + {list_to_tuple(reverse(T)), list_to_tuple(reverse(L))}. + +make_oset([T | Ts], Szs, L, Type) -> + true = test_oset(Szs, T, T), + make_oset(Ts, Szs, L, Type); +make_oset([], _Szs, L, Type) -> + ?SET(usort(L), Type). + +%% Optimization. Avoid re-building (nested) tuples. +test_oset({Sz,Args}, T, T0) when tuple_size(T) =:= Sz -> + test_oset_args(Args, T, T0); +test_oset(Sz, T, _T0) when tuple_size(T) =:= Sz -> + true. + +test_oset_args([{Arg,Szs} | Ss], T, T0) -> + true = test_oset(Szs, ?REL_TYPE(Arg, T), T0), + test_oset_args(Ss, T, T0); +test_oset_args([], _T, _T0) -> + true. + +list_of_sets([S | Ss], Type, L) -> + list_of_sets(Ss, Type, [?SET(S, Type) | L]); +list_of_sets([], _Type, L) -> + reverse(L). + +list_of_ordsets([S | Ss], Type, L) -> + list_of_ordsets(Ss, Type, [?ORDSET(S, Type) | L]); +list_of_ordsets([], _Type, L) -> + reverse(L). + +tuple_of_sets([S | Ss], [?SET_OF(Type) | Types], L) -> + tuple_of_sets(Ss, Types, [?SET(S, Type) | L]); +tuple_of_sets([S | Ss], [Type | Types], L) -> + tuple_of_sets(Ss, Types, [?ORDSET(S, Type) | L]); +tuple_of_sets([], [], L) -> + list_to_tuple(reverse(L)). + +spec([E | Es], Fun, Type, L) -> + case Fun(term2set(E, Type)) of + true -> + spec(Es, Fun, Type, [E | L]); + false -> + spec(Es, Fun, Type, L); + _ -> + badarg + end; +spec([], _Fun, _Type, L) -> + reverse(L). + +specification([E | Es], Fun, L) -> + case Fun(E) of + true -> + specification(Es, Fun, [E | L]); + false -> + specification(Es, Fun, L); + _ -> + badarg + end; +specification([], _Fun, L) -> + reverse(L). + +%% Elements from the first list are kept. +intersection([H1 | T1], [H2 | T2], L) when H1 < H2 -> + intersection1(T1, T2, L, H2); +intersection([H1 | T1], [H2 | T2], L) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection([H1 | T1], [_H2 | T2], L) -> + intersection2(T1, T2, L, H1); +intersection(_, _, L) -> + reverse(L). + +intersection1([H1 | T1], T2, L, H2) when H1 < H2 -> + intersection1(T1, T2, L, H2); +intersection1([H1 | T1], T2, L, H2) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection1([H1 | T1], T2, L, _H2) -> + intersection2(T1, T2, L, H1); +intersection1(_, _, L, _) -> + reverse(L). + +intersection2(T1, [H2 | T2], L, H1) when H1 > H2 -> + intersection2(T1, T2, L, H1); +intersection2(T1, [H2 | T2], L, H1) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection2(T1, [H2 | T2], L, _H1) -> + intersection1(T1, T2, L, H2); +intersection2(_, _, L, _) -> + reverse(L). + +difference([H1 | T1], [H2 | T2], L) when H1 < H2 -> + diff(T1, T2, [H1 | L], H2); +difference([H1 | T1], [H2 | T2], L) when H1 == H2 -> + difference(T1, T2, L); +difference([H1 | T1], [_H2 | T2], L) -> + diff2(T1, T2, L, H1); +difference(L1, _, L) -> + reverse(L, L1). + +diff([H1 | T1], T2, L, H2) when H1 < H2 -> + diff(T1, T2, [H1 | L], H2); +diff([H1 | T1], T2, L, H2) when H1 == H2 -> + difference(T1, T2, L); +diff([H1 | T1], T2, L, _H2) -> + diff2(T1, T2, L, H1); +diff(_, _, L, _) -> + reverse(L). + +diff2(T1, [H2 | T2], L, H1) when H1 > H2 -> + diff2(T1, T2, L, H1); +diff2(T1, [H2 | T2], L, H1) when H1 == H2 -> + difference(T1, T2, L); +diff2(T1, [H2 | T2], L, H1) -> + diff(T1, T2, [H1 | L], H2); +diff2(T1, _, L, H1) -> + reverse(L, [H1 | T1]). + +symdiff([H1 | T1], T2, L) -> + symdiff2(T1, T2, L, H1); +symdiff(_, T2, L) -> + reverse(L, T2). + +symdiff1([H1 | T1], T2, L, H2) when H1 < H2 -> + symdiff1(T1, T2, [H1 | L], H2); +symdiff1([H1 | T1], T2, L, H2) when H1 == H2 -> + symdiff(T1, T2, L); +symdiff1([H1 | T1], T2, L, H2) -> + symdiff2(T1, T2, [H2 | L], H1); +symdiff1(_, T2, L, H2) -> + reverse(L, [H2 | T2]). + +symdiff2(T1, [H2 | T2], L, H1) when H1 > H2 -> + symdiff2(T1, T2, [H2 | L], H1); +symdiff2(T1, [H2 | T2], L, H1) when H1 == H2 -> + symdiff(T1, T2, L); +symdiff2(T1, [H2 | T2], L, H1) -> + symdiff1(T1, T2, [H1 | L], H2); +symdiff2(T1, _, L, H1) -> + reverse(L, [H1 | T1]). + +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 < H2 -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart(S1, [], L1, L12, L2, T) -> + {?SET(reverse(L1, S1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2), T)}; +sympart(_, S2, L1, L12, L2, T) -> + {?SET(reverse(L1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2, S2), T)}. + +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 < H2 -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart1(_, T2, L1, L12, L2, T, H2) -> + {?SET(reverse(L1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2, [H2 | T2]), T)}. + +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 > H2 -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart2(T1, _, L1, L12, L2, T, H1) -> + {?SET(reverse(L1, [H1 | T1]), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2), T)}. + +prod([[E | Es] | Xs], T, L) -> + prod(Es, Xs, T, prod(Xs, [E | T], L)); +prod([], T, L) -> + [list_to_tuple(reverse(T)) | L]. + +prod([E | Es], Xs, T, L) -> + prod(Es, Xs, T, prod(Xs, [E | T], L)); +prod([], _Xs, _E, L) -> + L. + +constant_function([E | Es], X, L) -> + constant_function(Es, X, [{E,X} | L]); +constant_function([], _X, L) -> + reverse(L). + +subset([H1 | T1], [H2 | T2]) when H1 > H2 -> + subset(T1, T2, H1); +subset([H1 | T1], [H2 | T2]) when H1 == H2 -> + subset(T1, T2); +subset(L1, _) -> + L1 =:= []. + +subset(T1, [H2 | T2], H1) when H1 > H2 -> + subset(T1, T2, H1); +subset(T1, [H2 | T2], H1) when H1 == H2 -> + subset(T1, T2); +subset(_, _, _) -> + false. + +disjoint([B | Bs], A, As) when A < B -> + disjoint(As, B, Bs); +disjoint([B | _Bs], A, _As) when A == B -> + false; +disjoint([_B | Bs], A, As) -> + disjoint(Bs, A, As); +disjoint(_Bs, _A, _As) -> + true. + +%% Append sets that come in order, then "merge". +lunion([[_] = S]) -> % optimization + S; +lunion([[] | Ls]) -> + lunion(Ls); +lunion([S | Ss]) -> + umerge(lunion(Ss, last(S), [S], [])); +lunion([]) -> + []. + +lunion([[E] = S | Ss], Last, SL, Ls) when E > Last -> % optimization + lunion(Ss, E, [S | SL], Ls); +lunion([S | Ss], Last, SL, Ls) when hd(S) > Last -> + lunion(Ss, last(S), [S | SL], Ls); +lunion([S | Ss], _Last, SL, Ls) -> + lunion(Ss, last(S), [S], [append(reverse(SL)) | Ls]); +lunion([], _Last, SL, Ls) -> + [append(reverse(SL)) | Ls]. + +%% The empty list is always the first list, if present. +lintersection(_, []) -> + []; +lintersection([S | Ss], S0) -> + lintersection(Ss, intersection(S, S0, [])); +lintersection([], S) -> + S. + +can_rel([S | Ss], L) -> + can_rel(Ss, L, S, S); +can_rel([], L) -> + sort(L). + +can_rel(Ss, L, [E | Es], S) -> + can_rel(Ss, [{E, S} | L], Es, S); +can_rel(Ss, L, _, _S) -> + can_rel(Ss, L). + +rel2family([{X,Y} | S]) -> + rel2fam(S, X, [Y], []); +rel2family([]) -> + []. + +rel2fam([{X,Y} | S], X0, YL, L) when X0 == X -> + rel2fam(S, X0, [Y | YL], L); +rel2fam([{X,Y} | S], X0, [A,B | YL], L) -> % optimization + rel2fam(S, X, [Y], [{X0,reverse(YL,[B,A])} | L]); +rel2fam([{X,Y} | S], X0, YL, L) -> + rel2fam(S, X, [Y], [{X0,YL} | L]); +rel2fam([], X, YL, L) -> + reverse([{X,reverse(YL)} | L]). + +dom([{X,_} | Es]) -> + dom([], X, Es); +dom([] = L) -> + L. + +dom(L, X, [{X1,_} | Es]) when X == X1 -> + dom(L, X, Es); +dom(L, X, [{Y,_} | Es]) -> + dom([X | L], Y, Es); +dom(L, X, []) -> + reverse(L, [X]). + +ran([{_,Y} | Es], L) -> + ran(Es, [Y | L]); +ran([], L) -> + usort(L). + +relprod(A, B) -> + usort(relprod1(A, B)). + +relprod1([{Ay,Ax} | A], B) -> + relprod1(B, Ay, Ax, A, []); +relprod1(_A, _B) -> + []. + +relprod1([{Bx,_By} | B], Ay, Ax, A, L) when Ay > Bx -> + relprod1(B, Ay, Ax, A, L); +relprod1([{Bx,By} | B], Ay, Ax, A, L) when Ay == Bx -> + relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay); +relprod1([{Bx,By} | B], _Ay, _Ax, A, L) -> + relprod2(B, Bx, By, A, L); +relprod1(_B, _Ay, _Ax, _A, L) -> + L. + +relprod2(B, Bx, By, [{Ay, _Ax} | A], L) when Ay < Bx -> + relprod2(B, Bx, By, A, L); +relprod2(B, Bx, By, [{Ay, Ax} | A], L) when Ay == Bx -> + relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay); +relprod2(B, _Bx, _By, [{Ay, Ax} | A], L) -> + relprod1(B, Ay, Ax, A, L); +relprod2(_, _, _, _, L) -> + L. + +relprod(B0, Bx0, By0, A0, L, Ax, [{Bx,By} | B], Ay) when Ay == Bx -> + relprod(B0, Bx0, By0, A0, [{Ax,By} | L], Ax, B, Ay); +relprod(B0, Bx0, By0, A0, L, _Ax, _B, _Ay) -> + relprod2(B0, Bx0, By0, A0, L). + +relprod_n([], _R, _EmptyG, _IsR) -> + {error, badarg}; +relprod_n(RL, R, EmptyR, IsR) -> + case domain_type(RL, ?ANYTYPE) of + Error = {error, _Reason} -> + Error; + DType -> + Empty = any(fun is_empty_set/1, RL) or EmptyR, + RType = range_type(RL, []), + Type = ?BINREL(DType, RType), + Prod = + case Empty of + true when DType =:= ?ANYTYPE; RType =:= ?ANYTYPE -> + empty_set(); + true -> + ?SET([], Type); + false -> + TL = ?LIST((relprod_n(RL))), + Sz = length(RL), + Fun = fun({X,A}) -> {X, flat(Sz, A, [])} end, + ?SET(map(Fun, TL), Type) + end, + case IsR of + true -> relative_product(Prod, R); + false -> Prod + end + end. + +relprod_n([R | Rs]) -> + relprod_n(Rs, R). + +relprod_n([], R) -> + R; +relprod_n([R | Rs], R0) -> + T = raise_element(R0, 1), + R1 = relative_product1(T, R), + NR = projection({external, fun({{X,A},AS}) -> {X,{A,AS}} end}, R1), + relprod_n(Rs, NR). + +flat(1, A, L) -> + list_to_tuple([A | L]); +flat(N, {T,A}, L) -> + flat(N-1, T, [A | L]). + +domain_type([T | Ts], T0) when ?IS_SET(T) -> + case ?TYPE(T) of + ?BINREL(DT, _RT) -> + case unify_types(DT, T0) of + [] -> {error, type_mismatch}; + T1 -> domain_type(Ts, T1) + end; + ?ANYTYPE -> + domain_type(Ts, T0); + _ -> {error, badarg} + end; +domain_type([], T0) -> + T0. + +range_type([T | Ts], L) -> + case ?TYPE(T) of + ?BINREL(_DT, RT) -> + range_type(Ts, [RT | L]); + ?ANYTYPE -> + ?ANYTYPE + end; +range_type([], L) -> + list_to_tuple(reverse(L)). + +converse([{A,B} | X], L) -> + converse(X, [{B,A} | L]); +converse([], L) -> + sort(L). + +strict([{E1,E2} | Es], L) when E1 == E2 -> + strict(Es, L); +strict([E | Es], L) -> + strict(Es, [E | L]); +strict([], L) -> + reverse(L). + +weak(Es) -> + %% Not very efficient... + weak(Es, ran(Es, []), []). + +weak(Es=[{X,_} | _], [Y | Ys], L) when X > Y -> + weak(Es, Ys, [{Y,Y} | L]); +weak(Es=[{X,_} | _], [Y | Ys], L) when X == Y -> + weak(Es, Ys, L); +weak([E={X,Y} | Es], Ys, L) when X > Y -> + weak1(Es, Ys, [E | L], X); +weak([E={X,Y} | Es], Ys, L) when X == Y -> + weak2(Es, Ys, [E | L], X); +weak([E={X,_Y} | Es], Ys, L) -> % when X < _Y + weak2(Es, Ys, [E, {X,X} | L], X); +weak([], [Y | Ys], L) -> + weak([], Ys, [{Y,Y} | L]); +weak([], [], L) -> + reverse(L). + +weak1([E={X,Y} | Es], Ys, L, X0) when X > Y, X == X0 -> + weak1(Es, Ys, [E | L], X); +weak1([E={X,Y} | Es], Ys, L, X0) when X == Y, X == X0 -> + weak2(Es, Ys, [E | L], X); +weak1([E={X,_Y} | Es], Ys, L, X0) when X == X0 -> % when X < Y + weak2(Es, Ys, [E, {X,X} | L], X); +weak1(Es, Ys, L, X) -> + weak(Es, Ys, [{X,X} | L]). + +weak2([E={X,_Y} | Es], Ys, L, X0) when X == X0 -> % when X < _Y + weak2(Es, Ys, [E | L], X); +weak2(Es, Ys, L, _X) -> + weak(Es, Ys, L). + +extc(L, [D | Ds], C, Ts) -> + extc(L, Ds, C, Ts, D); +extc(L, [], _C, _Ts) -> + L. + +extc(L, Ds, C, [{X,_Y} | Ts], D) when X < D -> + extc(L, Ds, C, Ts, D); +extc(L, Ds, C, [{X,_Y} | Ts], D) when X == D -> + extc(L, Ds, C, Ts); +extc(L, Ds, C, [{X,_Y} | Ts], D) -> + extc2([{D,C} | L], Ds, C, Ts, X); +extc(L, Ds, C, [], D) -> + extc_tail([{D,C} | L], Ds, C). + +extc2(L, [D | Ds], C, Ts, X) when X > D -> + extc2([{D,C} | L], Ds, C, Ts, X); +extc2(L, [D | Ds], C, Ts, X) when X == D -> + extc(L, Ds, C, Ts); +extc2(L, [D | Ds], C, Ts, _X) -> + extc(L, Ds, C, Ts, D); +extc2(L, [], _C, _Ts, _X) -> + L. + +extc_tail(L, [D | Ds], C) -> + extc_tail([{D,C} | L], Ds, C); +extc_tail(L, [], _C) -> + L. + +is_a_func([{E,_} | Es], E0) when E /= E0 -> + is_a_func(Es, E); +is_a_func(L, _E) -> + L =:= []. + +restrict_n(I, [T | Ts], Key, Keys, L) -> + case element(I, T) of + K when K < Key -> + restrict_n(I, Ts, Key, Keys, L); + K when K == Key -> + restrict_n(I, Ts, Key, Keys, [T | L]); + K -> + restrict_n(I, K, Ts, Keys, L, T) + end; +restrict_n(_I, _Ts, _Key, _Keys, L) -> + L. + +restrict_n(I, K, Ts, [Key | Keys], L, E) when K > Key -> + restrict_n(I, K, Ts, Keys, L, E); +restrict_n(I, K, Ts, [Key | Keys], L, E) when K == Key -> + restrict_n(I, Ts, Key, Keys, [E | L]); +restrict_n(I, _K, Ts, [Key | Keys], L, _E) -> + restrict_n(I, Ts, Key, Keys, L); +restrict_n(_I, _K, _Ts, _Keys, L, _E) -> + L. + +restrict([Key | Keys], Tuples) -> + restrict(Tuples, Key, Keys, []); +restrict(_Keys, _Tuples) -> + []. + +restrict([{K,_E} | Ts], Key, Keys, L) when K < Key -> + restrict(Ts, Key, Keys, L); +restrict([{K,E} | Ts], Key, Keys, L) when K == Key -> + restrict(Ts, Key, Keys, [E | L]); +restrict([{K,E} | Ts], _Key, Keys, L) -> + restrict(Ts, K, Keys, L, E); +restrict(_Ts, _Key, _Keys, L) -> + L. + +restrict(Ts, K, [Key | Keys], L, E) when K > Key -> + restrict(Ts, K, Keys, L, E); +restrict(Ts, K, [Key | Keys], L, E) when K == Key -> + restrict(Ts, Key, Keys, [E | L]); +restrict(Ts, _K, [Key | Keys], L, _E) -> + restrict(Ts, Key, Keys, L); +restrict(_Ts, _K, _Keys, L, _E) -> + L. + +diff_restrict_n(I, [T | Ts], Key, Keys, L) -> + case element(I, T) of + K when K < Key -> + diff_restrict_n(I, Ts, Key, Keys, [T | L]); + K when K == Key -> + diff_restrict_n(I, Ts, Key, Keys, L); + K -> + diff_restrict_n(I, K, Ts, Keys, L, T) + end; +diff_restrict_n(I, _Ts, _Key, _Keys, L) when I =:= 1 -> + reverse(L); +diff_restrict_n(_I, _Ts, _Key, _Keys, L) -> + sort(L). + +diff_restrict_n(I, K, Ts, [Key | Keys], L, T) when K > Key -> + diff_restrict_n(I, K, Ts, Keys, L, T); +diff_restrict_n(I, K, Ts, [Key | Keys], L, _T) when K == Key -> + diff_restrict_n(I, Ts, Key, Keys, L); +diff_restrict_n(I, _K, Ts, [Key | Keys], L, T) -> + diff_restrict_n(I, Ts, Key, Keys, [T | L]); +diff_restrict_n(I, _K, Ts, _Keys, L, T) when I =:= 1 -> + reverse(L, [T | Ts]); +diff_restrict_n(_I, _K, Ts, _Keys, L, T) -> + sort([T | Ts ++ L]). + +diff_restrict([Key | Keys], Tuples) -> + diff_restrict(Tuples, Key, Keys, []); +diff_restrict(_Keys, Tuples) -> + diff_restrict_tail(Tuples, []). + +diff_restrict([{K,E} | Ts], Key, Keys, L) when K < Key -> + diff_restrict(Ts, Key, Keys, [E | L]); +diff_restrict([{K,_E} | Ts], Key, Keys, L) when K == Key -> + diff_restrict(Ts, Key, Keys, L); +diff_restrict([{K,E} | Ts], _Key, Keys, L) -> + diff_restrict(Ts, K, Keys, L, E); +diff_restrict(_Ts, _Key, _Keys, L) -> + L. + +diff_restrict(Ts, K, [Key | Keys], L, E) when K > Key -> + diff_restrict(Ts, K, Keys, L, E); +diff_restrict(Ts, K, [Key | Keys], L, _E) when K == Key -> + diff_restrict(Ts, Key, Keys, L); +diff_restrict(Ts, _K, [Key | Keys], L, E) -> + diff_restrict(Ts, Key, Keys, [E | L]); +diff_restrict(Ts, _K, _Keys, L, E) -> + diff_restrict_tail(Ts, [E | L]). + +diff_restrict_tail([{_K,E} | Ts], L) -> + diff_restrict_tail(Ts, [E | L]); +diff_restrict_tail(_Ts, L) -> + L. + +comp([], B) -> + check_function(B, []); +comp(_A, []) -> + bad_function; +comp(A0, [{Bx,By} | B]) -> + A = converse(A0, []), + check_function(A0, comp1(A, B, [], Bx, By)). + +comp1([{Ay,Ax} | A], B, L, Bx, By) when Ay == Bx -> + comp1(A, B, [{Ax,By} | L], Bx, By); +comp1([{Ay,Ax} | A], B, L, Bx, _By) when Ay > Bx -> + comp2(A, B, L, Bx, Ay, Ax); +comp1([{Ay,_Ax} | _A], _B, _L, Bx, _By) when Ay < Bx -> + bad_function; +comp1([], B, L, Bx, _By) -> + check_function(Bx, B, L). + +comp2(A, [{Bx,_By} | B], L, Bx0, Ay, Ax) when Ay > Bx, Bx /= Bx0 -> + comp2(A, B, L, Bx, Ay, Ax); +comp2(A, [{Bx,By} | B], L, _Bx0, Ay, Ax) when Ay == Bx -> + comp1(A, B, [{Ax,By} | L], Bx, By); +comp2(_A, _B, _L, _Bx0, _Ay, _Ax) -> + bad_function. + +inverse1([{A,B} | X]) -> + inverse(X, A, [{B,A}]); +inverse1([]) -> + []. + +inverse([{A,B} | X], A0, L) when A0 /= A -> + inverse(X, A, [{B,A} | L]); +inverse([{A,_B} | _X], A0, _L) when A0 == A -> + bad_function; +inverse([], _A0, L) -> + SL = [{V,_} | Es] = sort(L), + case is_a_func(Es, V) of + true -> SL; + false -> bad_function + end. + +%% Inlined. +external_fun({external, Function}) when is_atom(Function) -> + false; +external_fun({external, Fun}) -> + Fun; +external_fun(_) -> + false. + +%% Inlined. +element_type(?SET_OF(Type)) -> Type; +element_type(Type) -> Type. + +subst(Ts, Fun, Type) -> + subst(Ts, Fun, Type, ?ANYTYPE, []). + +subst([T | Ts], Fun, Type, NType, L) -> + case setfun(T, Fun, Type, NType) of + {SD, ST} -> subst(Ts, Fun, Type, ST, [{T, SD} | L]); + Bad -> Bad + end; +subst([], _Fun, _Type, NType, L) -> + {L, NType}. + +projection1([E | Es]) -> + projection1([], element(1, E), Es); +projection1([] = L) -> + L. + +projection1(L, X, [E | Es]) -> + case element(1, E) of + X1 when X == X1 -> projection1(L, X, Es); + X1 -> projection1([X | L], X1, Es) + end; +projection1(L, X, []) -> + reverse(L, [X]). + +projection_n([E | Es], I, L) -> + projection_n(Es, I, [element(I, E) | L]); +projection_n([], _I, L) -> + usort(L). + +substitute_element([T | Ts], I, L) -> + substitute_element(Ts, I, [{T, element(I, T)} | L]); +substitute_element(_, _I, L) -> + reverse(L). + +substitute([T | Ts], Fun, L) -> + substitute(Ts, Fun, [{T, Fun(T)} | L]); +substitute(_, _Fun, L) -> + reverse(L). + +partition_n(I, [E | Ts]) -> + partition_n(I, Ts, element(I, E), [E], []); +partition_n(_I, []) -> + []. + +partition_n(I, [E | Ts], K, Es, P) -> + case {element(I, E), Es} of + {K1, _} when K == K1 -> + partition_n(I, Ts, K, [E | Es], P); + {K1, [_]} -> % optimization + partition_n(I, Ts, K1, [E], [Es | P]); + {K1, _} -> + partition_n(I, Ts, K1, [E], [reverse(Es) | P]) + end; +partition_n(I, [], _K, Es, P) when I > 1 -> + sort([reverse(Es) | P]); +partition_n(_I, [], _K, [_] = Es, P) -> % optimization + reverse(P, [Es]); +partition_n(_I, [], _K, Es, P) -> + reverse(P, [reverse(Es)]). + +partition3_n(I, [T | Ts], Key, Keys, L1, L2) -> + case element(I, T) of + K when K < Key -> + partition3_n(I, Ts, Key, Keys, L1, [T | L2]); + K when K == Key -> + partition3_n(I, Ts, Key, Keys, [T | L1], L2); + K -> + partition3_n(I, K, Ts, Keys, L1, L2, T) + end; +partition3_n(I, _Ts, _Key, _Keys, L1, L2) when I =:= 1 -> + [reverse(L1) | reverse(L2)]; +partition3_n(_I, _Ts, _Key, _Keys, L1, L2) -> + [sort(L1) | sort(L2)]. + +partition3_n(I, K, Ts, [Key | Keys], L1, L2, T) when K > Key -> + partition3_n(I, K, Ts, Keys, L1, L2, T); +partition3_n(I, K, Ts, [Key | Keys], L1, L2, T) when K == Key -> + partition3_n(I, Ts, Key, Keys, [T | L1], L2); +partition3_n(I, _K, Ts, [Key | Keys], L1, L2, T) -> + partition3_n(I, Ts, Key, Keys, L1, [T | L2]); +partition3_n(I, _K, Ts, _Keys, L1, L2, T) when I =:= 1 -> + [reverse(L1) | reverse(L2, [T | Ts])]; +partition3_n(_I, _K, Ts, _Keys, L1, L2, T) -> + [sort(L1) | sort([T | Ts ++ L2])]. + +partition3([Key | Keys], Tuples) -> + partition3(Tuples, Key, Keys, [], []); +partition3(_Keys, Tuples) -> + partition3_tail(Tuples, [], []). + +partition3([{K,E} | Ts], Key, Keys, L1, L2) when K < Key -> + partition3(Ts, Key, Keys, L1, [E | L2]); +partition3([{K,E} | Ts], Key, Keys, L1, L2) when K == Key -> + partition3(Ts, Key, Keys, [E | L1], L2); +partition3([{K,E} | Ts], _Key, Keys, L1, L2) -> + partition3(Ts, K, Keys, L1, L2, E); +partition3(_Ts, _Key, _Keys, L1, L2) -> + [L1 | L2]. + +partition3(Ts, K, [Key | Keys], L1, L2, E) when K > Key -> + partition3(Ts, K, Keys, L1, L2, E); +partition3(Ts, K, [Key | Keys], L1, L2, E) when K == Key -> + partition3(Ts, Key, Keys, [E | L1], L2); +partition3(Ts, _K, [Key | Keys], L1, L2, E) -> + partition3(Ts, Key, Keys, L1, [E | L2]); +partition3(Ts, _K, _Keys, L1, L2, E) -> + partition3_tail(Ts, L1, [E | L2]). + +partition3_tail([{_K,E} | Ts], L1, L2) -> + partition3_tail(Ts, L1, [E | L2]); +partition3_tail(_Ts, L1, L2) -> + [L1 | L2]. + +replace([E | Es], F, L) -> + replace(Es, F, [F(E) | L]); +replace(_, _F, L) -> + sort(L). + +mul_relprod([T | Ts], I, R) when ?IS_SET(T) -> + P = raise_element(R, I), + F = relative_product1(P, T), + [F | mul_relprod(Ts, I+1, R)]; +mul_relprod([], _I, _R) -> + []. + +raise_element(R, I) -> + L = sort(I =/= 1, rearr(?LIST(R), I, [])), + Type = ?TYPE(R), + ?SET(L, ?BINREL(?REL_TYPE(I, Type), Type)). + +rearr([E | Es], I, L) -> + rearr(Es, I, [{element(I, E), E} | L]); +rearr([], _I, L) -> + L. + +join_element(E1, E2) -> + [_ | L2] = tuple_to_list(E2), + list_to_tuple(tuple_to_list(E1) ++ L2). + +join_element(E1, E2, I2) -> + tuple_to_list(E1) ++ join_element2(tuple_to_list(E2), 1, I2). + +join_element2([B | Bs], C, I2) when C =/= I2 -> + [B | join_element2(Bs, C+1, I2)]; +join_element2([_ | Bs], _C, _I2) -> + Bs. + +family2rel([{X,S} | F], L) -> + fam2rel(F, L, X, S); +family2rel([], L) -> + reverse(L). + +fam2rel(F, L, X, [Y | Ys]) -> + fam2rel(F, [{X,Y} | L], X, Ys); +fam2rel(F, L, _X, _) -> + family2rel(F, L). + +fam_spec([{_,S}=E | F], Fun, Type, L) -> + case Fun(?SET(S, Type)) of + true -> + fam_spec(F, Fun, Type, [E | L]); + false -> + fam_spec(F, Fun, Type, L); + _ -> + badarg + end; +fam_spec([], _Fun, _Type, L) -> + reverse(L). + +fam_specification([{_,S}=E | F], Fun, L) -> + case Fun(S) of + true -> + fam_specification(F, Fun, [E | L]); + false -> + fam_specification(F, Fun, L); + _ -> + badarg + end; +fam_specification([], _Fun, L) -> + reverse(L). + +un_of_fam([{_X,S} | F], L) -> + un_of_fam(F, [S | L]); +un_of_fam([], L) -> + lunion(sort(L)). + +int_of_fam([{_,S} | F]) -> + int_of_fam(F, [S]); +int_of_fam([]) -> + badarg. + +int_of_fam([{_,S} | F], L) -> + int_of_fam(F, [S | L]); +int_of_fam([], [L | Ls]) -> + lintersection(Ls, L). + +fam_un([{X,S} | F], L) -> + fam_un(F, [{X, lunion(S)} | L]); +fam_un([], L) -> + reverse(L). + +fam_int([{X, [S | Ss]} | F], L) -> + fam_int(F, [{X, lintersection(Ss, S)} | L]); +fam_int([{_X,[]} | _F], _L) -> + badarg; +fam_int([], L) -> + reverse(L). + +fam_dom([{X,S} | F], L) -> + fam_dom(F, [{X, dom(S)} | L]); +fam_dom([], L) -> + reverse(L). + +fam_ran([{X,S} | F], L) -> + fam_ran(F, [{X, ran(S, [])} | L]); +fam_ran([], L) -> + reverse(L). + +fam_union(F1 = [{A,_AS} | _AL], [B1={B,_BS} | BL], L) when A > B -> + fam_union(F1, BL, [B1 | L]); +fam_union([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_union(AL, BL, [{A, umerge(AS, BS)} | L]); +fam_union([A1 | AL], F2, L) -> + fam_union(AL, F2, [A1 | L]); +fam_union(_, F2, L) -> + reverse(L, F2). + +fam_intersect(F1 = [{A,_AS} | _AL], [{B,_BS} | BL], L) when A > B -> + fam_intersect(F1, BL, L); +fam_intersect([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_intersect(AL, BL, [{A, intersection(AS, BS, [])} | L]); +fam_intersect([_A1 | AL], F2, L) -> + fam_intersect(AL, F2, L); +fam_intersect(_, _, L) -> + reverse(L). + +fam_difference(F1 = [{A,_AS} | _AL], [{B,_BS} | BL], L) when A > B -> + fam_difference(F1, BL, L); +fam_difference([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_difference(AL, BL, [{A, difference(AS, BS, [])} | L]); +fam_difference([A1 | AL], F2, L) -> + fam_difference(AL, F2, [A1 | L]); +fam_difference(F1, _, L) -> + reverse(L, F1). + +check_function([{X,_} | XL], R) -> + check_function(X, XL, R); +check_function([], R) -> + R. + +check_function(X0, [{X,_} | XL], R) when X0 /= X -> + check_function(X, XL, R); +check_function(X0, [{X,_} | _XL], _R) when X0 == X -> + bad_function; +check_function(_X0, [], R) -> + R. + +fam_partition_n(I, [E | Ts]) -> + fam_partition_n(I, Ts, element(I, E), [E], []); +fam_partition_n(_I, []) -> + []. + +fam_partition_n(I, [E | Ts], K, Es, P) -> + case {element(I, E), Es} of + {K1, _} when K == K1 -> + fam_partition_n(I, Ts, K, [E | Es], P); + {K1, [_]} -> % optimization + fam_partition_n(I, Ts, K1, [E], [{K,Es} | P]); + {K1, _} -> + fam_partition_n(I, Ts, K1, [E], [{K,reverse(Es)} | P]) + end; +fam_partition_n(_I, [], K, [_] = Es, P) -> % optimization + reverse(P, [{K,Es}]); +fam_partition_n(_I, [], K, Es, P) -> + reverse(P, [{K,reverse(Es)}]). + +fam_partition([{K,Vs} | Ts], Sort) -> + fam_partition(Ts, K, [Vs], [], Sort); +fam_partition([], _Sort) -> + []. + +fam_partition([{K1,V} | Ts], K, Vs, P, S) when K1 == K -> + fam_partition(Ts, K, [V | Vs], P, S); +fam_partition([{K1,V} | Ts], K, [_] = Vs, P, S) -> % optimization + fam_partition(Ts, K1, [V], [{K, Vs} | P], S); +fam_partition([{K1,V} | Ts], K, Vs, P, S) -> + fam_partition(Ts, K1, [V], [{K, sort(S, Vs)} | P], S); +fam_partition([], K, [_] = Vs, P, _S) -> % optimization + [{K, Vs} | P]; +fam_partition([], K, Vs, P, S) -> + [{K, sort(S, Vs)} | P]. + +fam_proj([{X,S} | F], Fun, Type, NType, L) -> + case setfun(S, Fun, Type, NType) of + {SD, ST} -> fam_proj(F, Fun, Type, ST, [{X, SD} | L]); + Bad -> Bad + end; +fam_proj([], _Fun, _Type, NType, L) -> + {reverse(L), NType}. + +setfun(T, Fun, Type, NType) -> + case Fun(term2set(T, Type)) of + NS when ?IS_SET(NS) -> + case unify_types(NType, ?SET_OF(?TYPE(NS))) of + [] -> type_mismatch; + NT -> {?LIST(NS), NT} + end; + NS when ?IS_ORDSET(NS) -> + case unify_types(NType, NT = ?ORDTYPE(NS)) of + [] -> type_mismatch; + NT -> {?ORDDATA(NS), NT} + end; + _ -> + badarg + end. + +%% Inlined. +term2set(L, Type) when is_list(L) -> + ?SET(L, Type); +term2set(T, Type) -> + ?ORDSET(T, Type). + +fam2digraph(F, G) -> + Fun = fun({From, ToL}) -> + digraph:add_vertex(G, From), + Fun2 = fun(To) -> + digraph:add_vertex(G, To), + case digraph:add_edge(G, From, To) of + {error, {bad_edge, _}} -> + throw({error, cyclic}); + _ -> + true + end + end, + foreach(Fun2, ToL) + end, + foreach(Fun, to_external(F)), + G. + +digraph_family(G) -> + Vs = sort(digraph:vertices(G)), + digraph_fam(Vs, Vs, G, []). + +digraph_fam([V | Vs], V0, G, L) when V /= V0 -> + Ns = sort(digraph:out_neighbours(G, V)), + digraph_fam(Vs, V, G, [{V,Ns} | L]); +digraph_fam([], _V0, _G, L) -> + reverse(L). + +%% -> boolean() +check_fun(T, F, FunT) -> + true = is_type(FunT), + {NT, _MaxI} = number_tuples(T, 1), + L = flatten(tuple2list(F(NT))), + has_hole(L, 1). + +number_tuples(T, N) when is_tuple(T) -> + {L, NN} = mapfoldl(fun number_tuples/2, N, tuple_to_list(T)), + {list_to_tuple(L), NN}; +number_tuples(_, N) -> + {N, N+1}. + +tuple2list(T) when is_tuple(T) -> + map(fun tuple2list/1, tuple_to_list(T)); +tuple2list(C) -> + [C]. + +has_hole([I | Is], I0) when I =< I0 -> has_hole(Is, erlang:max(I+1, I0)); +has_hole(Is, _I) -> Is =/= []. + +%% Optimization. Same as check_fun/3, but for integers. +check_for_sort(T, _I) when T =:= ?ANYTYPE -> + empty; +check_for_sort(T, I) when ?IS_RELATION(T), I =< ?REL_ARITY(T), I >= 1 -> + I > 1; +check_for_sort(_T, _I) -> + error. + +inverse_substitution(L, Fun, Sort) -> + %% One easily sees that the inverse of the tuples created by + %% applying Fun need to be sorted iff the tuples created by Fun + %% need to be sorted. + sort(Sort, fun_rearr(L, Fun, [])). + +fun_rearr([E | Es], Fun, L) -> + fun_rearr(Es, Fun, [{Fun(E), E} | L]); +fun_rearr([], _Fun, L) -> + L. + +sets_to_list(Ss) -> + map(fun(S) when ?IS_SET(S) -> ?LIST(S) end, Ss). + +types([], L) -> + list_to_tuple(reverse(L)); +types([S | _Ss], _L) when ?TYPE(S) =:= ?ANYTYPE -> + ?ANYTYPE; +types([S | Ss], L) -> + types(Ss, [?TYPE(S) | L]). + +%% Inlined. +unify_types(T, T) -> T; +unify_types(Type1, Type2) -> + catch unify_types1(Type1, Type2). + +unify_types1(Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + Atom; +unify_types1(?ANYTYPE, Type) -> + Type; +unify_types1(Type, ?ANYTYPE) -> + Type; +unify_types1(?SET_OF(Type1), ?SET_OF(Type2)) -> + [unify_types1(Type1, Type2)]; +unify_types1(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> + unify_typesl(tuple_size(T1), T1, T2, []); +unify_types1(_T1, _T2) -> + throw([]). + +unify_typesl(0, _T1, _T2, L) -> + list_to_tuple(L); +unify_typesl(N, T1, T2, L) -> + T = unify_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)), + unify_typesl(N-1, T1, T2, [T | L]). + +%% inlined. +match_types(T, T) -> true; +match_types(Type1, Type2) -> match_types1(Type1, Type2). + +match_types1(Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + true; +match_types1(?ANYTYPE, _) -> + true; +match_types1(_, ?ANYTYPE) -> + true; +match_types1(?SET_OF(Type1), ?SET_OF(Type2)) -> + match_types1(Type1, Type2); +match_types1(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> + match_typesl(tuple_size(T1), T1, T2); +match_types1(_T1, _T2) -> + false. + +match_typesl(0, _T1, _T2) -> + true; +match_typesl(N, T1, T2) -> + case match_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)) of + true -> match_typesl(N-1, T1, T2); + false -> false + end. + +sort(true, L) -> + sort(L); +sort(false, L) -> + reverse(L). diff --git a/lib/tools/test/tools_bench.spec b/lib/tools/test/tools_bench.spec new file mode 100644 index 0000000000..ef08fd68a8 --- /dev/null +++ b/lib/tools/test/tools_bench.spec @@ -0,0 +1 @@ +{suites,"../tools_test",[prof_bench_SUITE]}. diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index 018f632948..da4f56c09b 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2017. All Rights Reserved. +%% Copyright Ericsson AB 2000-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2233,18 +2233,18 @@ variables(Conf) when is_list(Conf) -> {{error, _, _}, _} = xref_base:variables(S108, [{verbose,false}]), {ok, S109} = xref_base:set_library_path(S108, [], [{verbose,false}]), - Tabs = length(ets:all()), + NoOfTables = erlang:system_info(ets_count), {ok, S110} = eval("Eplus := closure E, TT := Eplus", 'closure()', S109), {{ok, [{user, ['Eplus','TT']}]}, S111} = xref_base:variables(S110), {ok, S112} = xref_base:forget(S111, ['TT','Eplus']), - true = Tabs =:= length(ets:all()), + true = NoOfTables =:= erlang:system_info(ets_count), {ok, NS0} = eval("Eplus := closure E", 'closure()', S112), {{ok, [{user, ['Eplus']}]}, NS} = xref_base:variables(NS0), ok = xref_base:delete(NS), - true = Tabs =:= length(ets:all()), + true = NoOfTables =:= erlang:system_info(ets_count), ok = file:delete(Beam), ok. diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index bb3f4c66c0..191a458c62 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 3.0 +TOOLS_VSN = 3.2 |