[m-rev.] for review: analysis framework (1/2)

Peter Wang wangp at students.cs.mu.OZ.AU
Mon Jan 16 14:13:21 AEDT 2006


Estimated hours taken: 30
Branches: main

Some work on the intermodule analysis framework.  The main changes are that
modules and analysis results have statuses associated with them, which are
saved into the `.analysis' files, and there is now code to handle intermodule
dependency graphs (that record which modules are dependent on a particular
analysis result).

Automatic recompilation of modules that use out of date or invalid analysis
results from other modules is not handled yet.

analysis/analysis.m:
analysis/analysis.file.m:
	Remove the `FuncInfo' type variable everywhere.  This was originally
	designed to be used by analyses to store "extra" information that
	would be passed from an analysis implementation through the analysis
	framework, back to methods defined by the analysis implementation
	itself.  One problem was that `FuncInfo' values were not designed to
	be saved and restored from disk.  Also, it made two `Call' or two
	`Answer' values hard to compare, as a `FuncInfo' value had to be
	present for a comparison call to be made, and it was not always
	obvious where that `FuncInfo' value would come from.  I have changed
	it so that that any information which might be be stored in a
	`FuncInfo' should be stored in the corresponding `Call' value itself.

	Change the format of analysis result files to include an overall
	status for the module and a status for each analysis result.  The
	statuses record whether the module or analysis result could be
	improved by further compilation, or if the module or analysis result
	is no longer valid.

	Add code to read and write intermodule dependency graphs (IMDGs).  The
	IMDG file for module M records all the modules which depend on an
	analysis result for a procedure defined in M.

	Bump analysis file format version numbers as they are incompatible
	with earlier versions.

compiler/mercury_compile.m:
	Update to match changes in the intermodule analysis framework.

compiler/mmc_analysis.m:
	Add the trail usage analysis to the list of analyses to be used with
	the intermodule analysis framework.
	Update the entry for unused argument elimination.

compiler/add_pragma.m:
compiler/hlds_module.m:
compiler/trailing_analysis.m:
	Make the trail usage analysis pass able to make use of the intermodule
	analysis framework.  Mainly, functions had to be converted to predicates
	taking I/O states.

	Associate each `trailing_status' in the `trailing_info' map with an
	`analysis_status', i.e. whether it is optimal or not.

compiler/unused_args.m:
	Update to match the removal of `FuncInfo' arguments and the
	addition of analysis statuses.

	Record the unused argument analysis result for a procedure even if
	all of the procedures arguments are used, so that callers of the
	procedure will know not to request more precise answers.

	Record the dependence of the current module on analysis results from
	other modules.

library/list.m:
	Add a `list.map2_foldl2' predicate.

compiler/Mmakefile:
	Add the `analysis' directory to the list of directories to be
	processed by mtags.


Index: analysis/analysis.file.m
===================================================================
RCS file: /home/mercury1/repository/mercury/analysis/analysis.file.m,v
retrieving revision 1.2
diff -u -r1.2 analysis.file.m
--- analysis/analysis.file.m	12 Dec 2005 02:54:30 -0000	1.2
+++ analysis/analysis.file.m	10 Jan 2006 04:02:34 -0000
@@ -8,16 +8,18 @@
 %
 % An analysis file contains analysis results for a single module.
 %-----------------------------------------------------------------------------%
+
 :- module analysis__file.
 
 :- interface.
 
-:- pred read_module_analysis_results(analysis_info::in,
-	module_id::in, module_analysis_map(analysis_result)::out,
+:- pred read_module_analysis_results(analysis_info::in, module_id::in,
+	analysis_status::out, module_analysis_map(analysis_result)::out,
 	io__state::di, io__state::uo) is det.
 
 :- pred write_module_analysis_results(analysis_info::in,
-	module_id::in, module_analysis_map(analysis_result)::in,
+	module_id::in, analysis_status::in,
+	module_analysis_map(analysis_result)::in,
 	io__state::di, io__state::uo) is det.
 
 :- pred read_module_analysis_requests(analysis_info::in,
@@ -28,27 +30,94 @@
 	module_id::in, module_analysis_map(analysis_request)::in,
 	io__state::di, io__state::uo) is det.
 
+:- pred read_module_imdg(analysis_info::in, module_id::in,
+	module_analysis_map(imdg_arc)::out, io::di, io::uo) is det.
+
+:- pred write_module_imdg(analysis_info::in, module_id::in,
+	module_analysis_map(imdg_arc)::in, io::di, io::uo) is det.
+
 :- pred empty_request_file(analysis_info::in, module_id::in,
 	io__state::di, io__state::uo) is det.
 
 %-----------------------------------------------------------------------------%
+
 :- implementation.
-% The format of an analysis file is:
+
+% The format of an analysis result file is:
 %
 % version_number.
-% analysis_name(analysis_version, func_id, call_pattern, answer_pattern).
-%-----------------------------------------------------------------------------%
+% module_status.
+% analysis_name(analysis_version, func_id, call_pattern, answer_pattern,
+%   result_status).
+
+% The format of an IMDG file is:
+%
+% version_number.
+% calling_module -> analysis_name(analysis_version, func_id, call_pattern).
+
+% The format of an analysis request file is:
+%
+% version_number.
+% analysis_name(analysis_version, func_id, call_pattern).
+
 :- import_module bool, exception, parser, term, term_io, varset.
 
 :- type invalid_analysis_file ---> invalid_analysis_file.
 
 :- func version_number = int.
-version_number = 1.
+version_number = 2.
+
+%-----------------------------------------------------------------------------%
+
+read_module_analysis_results(Info, ModuleId, ModuleStatus, ModuleResults,
+		!IO) :-
+	read_module_analysis_results_2(Info ^ compiler, ModuleId,
+		ModuleStatus, ModuleResults, !IO).
 
-read_module_analysis_results(Info, ModuleId, ModuleResults, !IO) :-
-	read_analysis_file(Info ^ compiler, ModuleId, ".analysis",
-		parse_result_entry(Info ^ compiler),
-		map__init, ModuleResults, !IO).
+:- pred read_module_analysis_results_2(Compiler::in, module_id::in,
+	analysis_status::out, module_analysis_map(analysis_result)::out, 
+	io::di, io::uo) is det <= compiler(Compiler).
+
+read_module_analysis_results_2(Compiler, ModuleId, ModuleStatus, ModuleResults,
+		!IO) :-
+	read_analysis_file(Compiler, ModuleId, ".analysis",
+		read_module_status, optimal, ModuleStatus,
+		parse_result_entry(Compiler),
+		map__init, ModuleResults0, !IO),
+	% If the module's overall status is `invalid' then at least one 
+	% of its results is invalid so ignore them all.
+	(
+		( ModuleStatus = optimal
+		; ModuleStatus = suboptimal
+		),
+		ModuleResults = ModuleResults0
+	;
+		ModuleStatus = invalid,
+		ModuleResults = map.init
+	).
+
+:- pred read_module_status(analysis_status::out, io::di, io::uo) is det.
+
+read_module_status(Status, !IO) :-
+	parser__read_term(TermResult `with_type` read_term, !IO),
+	( TermResult = term(_, term__functor(term__atom(String), [], _)) ->
+		( analysis_status_to_string(Status0, String) ->
+			Status = Status0
+		;
+			error("read_module_status: unknown status " ++ String),
+			throw(invalid_analysis_file)
+		)
+	;
+		throw(invalid_analysis_file)
+	).
+
+:- pred analysis_status_to_string(analysis_status, string).
+:- mode analysis_status_to_string(in, out) is det.
+:- mode analysis_status_to_string(out, in) is semidet.
+
+analysis_status_to_string(invalid, "invalid").
+analysis_status_to_string(suboptimal, "suboptimal").
+analysis_status_to_string(optimal, "optimal").
 
 :- pred parse_result_entry(Compiler::in)
 		`with_type` parse_entry(module_analysis_map(analysis_result))
@@ -58,29 +127,30 @@
     (	
 	Term = term__functor(term__atom(AnalysisName),
 			[VersionNumberTerm, FuncIdTerm,
-			CallPatternTerm, AnswerPatternTerm], _),
+			CallPatternTerm, AnswerPatternTerm, StatusTerm], _),
 	FuncIdTerm = term__functor(term__string(FuncId), [], _),
 	CallPatternTerm = term__functor(
 			term__string(CallPatternString), [], _),
 	AnswerPatternTerm = term__functor(
 			term__string(AnswerPatternString), [], _),
-	analysis_type(_ `with_type` unit(FuncInfo), _ `with_type` unit(Call),
+	StatusTerm = term__functor(term__string(StatusString), [], _),
+	analysis_type(_ `with_type` unit(Call),
 			_ `with_type` unit(Answer)) =
 			analyses(Compiler, AnalysisName),
 
 	CallPattern = from_string(CallPatternString) `with_type` Call,
-	AnswerPattern = from_string(AnswerPatternString) `with_type` Answer
+	AnswerPattern = from_string(AnswerPatternString) `with_type` Answer,
+	analysis_status_to_string(Status, StatusString)
     ->
 	(
 		VersionNumber = analysis_version_number(
-				_ `with_type` FuncInfo, _ `with_type` Call,
+				_ `with_type` Call,
 				_ `with_type` Answer),
 		VersionNumberTerm = term__functor(
 				term__integer(VersionNumber), [], _)
 	->
-		Result = 'new analysis_result'(
-				unit1 `with_type` unit(FuncInfo),
-				CallPattern, AnswerPattern),
+		Result = 'new analysis_result'(CallPattern, AnswerPattern,
+			Status),
 		( AnalysisResults0 = map__search(Results0, AnalysisName) ->
 			AnalysisResults1 = AnalysisResults0
 		;
@@ -107,6 +177,7 @@
 
 read_module_analysis_requests(Info, ModuleId, ModuleRequests, !IO) :-
 	read_analysis_file(Info ^ compiler, ModuleId, ".request",
+		nop, unit, _NoHeader,
 		parse_request_entry(Info ^ compiler),
 		map__init, ModuleRequests, !IO).
 
@@ -121,21 +192,18 @@
 	FuncIdTerm = term__functor(term__string(FuncId), [], _),
 	CallPatternTerm = term__functor(
 		term__string(CallPatternString), [], _),
-	analysis_type(_ `with_type` unit(FuncInfo),
-		_ `with_type` unit(Call), _ `with_type` unit(Answer)) =
+	analysis_type(_ `with_type` unit(Call), _ `with_type` unit(Answer)) =
 		analyses(Compiler, AnalysisName),
 	CallPattern = from_string(CallPatternString) `with_type` Call
     ->
 	(
 		VersionNumber = analysis_version_number(
-				_ `with_type` FuncInfo, _ `with_type` Call,
+				_ `with_type` Call,
 				_ `with_type` Answer),
 		VersionNumberTerm = term__functor(
 				term__integer(VersionNumber), [], _)
 	->
-		Result = 'new analysis_request'(
-				unit1 `with_type` unit(FuncInfo),
-				CallPattern),
+		Result = 'new analysis_request'(CallPattern),
 		(
 			AnalysisRequests0 = map__search(Requests0,
 				AnalysisName)
@@ -163,49 +231,122 @@
 	throw(invalid_analysis_file)
     ).
 
+read_module_imdg(Info, ModuleId, ModuleEntries, !IO) :-
+    read_analysis_file(Info ^ compiler, ModuleId, ".imdg",
+	nop, unit, _NoHeader,
+	parse_imdg_arc(Info ^ compiler),
+	map.init, ModuleEntries, !IO).
+
+:- pred parse_imdg_arc(Compiler::in)
+	    `with_type` parse_entry(module_analysis_map(imdg_arc))
+	    `with_inst` parse_entry <= compiler(Compiler).
+
+parse_imdg_arc(Compiler, Term, Arcs0, Arcs) :-
+    (
+	Term = term.functor(atom("->"),
+	    [term.functor(string(DependentModule), [], _), ResultTerm], _),
+	ResultTerm = functor(atom(AnalysisName),
+	    [VersionNumberTerm, FuncIdTerm, CallPatternTerm], _),
+	FuncIdTerm = term.functor(term.string(FuncId), [], _),
+	CallPatternTerm = functor(string(CallPatternString), [], _),
+	analysis_type(_ : unit(Call), _ : unit(Answer))
+	    = analyses(Compiler, AnalysisName),
+	CallPattern = from_string(CallPatternString) : Call
+    ->
+	(
+	    VersionNumber = analysis_version_number(_ : Call, _ : Answer),
+	    VersionNumberTerm = term.functor(
+		term.integer(VersionNumber), [], _)
+	->
+	    Arc = 'new imdg_arc'(CallPattern, DependentModule),
+	    ( AnalysisArcs0 = map.search(Arcs0, AnalysisName) ->
+		AnalysisArcs1 = AnalysisArcs0
+	    ;
+		AnalysisArcs1 = map.init
+	    ),
+	    ( FuncArcs0 = map.search(AnalysisArcs1, FuncId) ->
+		FuncArcs = [Arc | FuncArcs0]
+	    ;
+		FuncArcs = [Arc]
+	    ),
+	    Arcs = map.set(Arcs0, AnalysisName, 
+		map.set(AnalysisArcs1, FuncId, FuncArcs))
+    	;
+	    % Ignore results with an out-of-date version number.
+	    % XXX: is that the right thing to do?
+	    %	   do we really need a version number for the IMDG?
+	    Arcs = Arcs0
+	)
+    ;
+	throw(invalid_analysis_file)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- type read_header(T) == pred(T, io, io).
+:- inst read_header == (pred(out, di, uo) is det).
+
 :- type parse_entry(T) == pred(term, T, T).
 :- inst parse_entry == (pred(in, in, out) is det).
 
 :- pred read_analysis_file(Compiler::in, module_id::in, string::in,
+		read_header(Header)::in(read_header), Header::in, Header::out,
 		parse_entry(T)::in(parse_entry), T::in, T::out,
 		io__state::di, io__state::uo) is det <= compiler(Compiler).
 
-read_analysis_file(Compiler, ModuleId, Suffix, ParseEntry,
-		ModuleResults0, ModuleResults, !IO) :-
+read_analysis_file(Compiler, ModuleId, Suffix,
+		ReadHeader, DefaultHeader, Header,
+		ParseEntry, ModuleResults0, ModuleResults, !IO) :-
 	module_id_to_file_name(Compiler, ModuleId,
 		Suffix, AnalysisFileName, !IO),
 	io__open_input(AnalysisFileName, OpenResult, !IO),
 	(
 		OpenResult = ok(Stream),
+		debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+			io.print("Reading analysis file ", !IO),
+			io.print(AnalysisFileName, !IO),
+			io.nl(!IO)
+		), !IO),
 		io__set_input_stream(Stream, OldStream, !IO),
+
 		promise_only_solution_io(
-		    (pred(R::out, di, uo) is cc_multi -->
-			try_io((pred(Results1::out, di, uo) is det -->
+		    (pred(HR::out, di, uo) is cc_multi -->
+			try_io((pred({Header1, Results1}::out, di, uo)
+				    is det -->
+			    check_analysis_file_version_number,
+			    ReadHeader(Header1),
 			    read_analysis_file_2(ParseEntry,
 			    		ModuleResults0, Results1)
-			), R)
+			), HR)
 		    ), Result, !IO),
 		(
-			Result = succeeded(ModuleResults)
+			Result = succeeded({Header, ModuleResults})
 		;
 			Result = failed,
+			Header = DefaultHeader,
 			ModuleResults = ModuleResults0
 		;
 			Result = exception(_),
 			% XXX Report error.
+			Header = DefaultHeader,
 			ModuleResults = ModuleResults0
 		),
 		io__set_input_stream(OldStream, _, !IO),
 		io__close_input(Stream, !IO)
 	;
 		OpenResult = error(_),
+		debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+			io.print("Error reading analysis file: ", !IO),
+			io.print(AnalysisFileName, !IO),
+			io.nl(!IO)
+		), !IO),
+		Header = DefaultHeader,
 		ModuleResults = ModuleResults0
 	).
 
-:- pred read_analysis_file_2(parse_entry(T)::in(parse_entry),
-	T::in, T::out, io__state::di, io__state::uo) is det.
+:- pred check_analysis_file_version_number(io::di, io::uo) is det.
 
-read_analysis_file_2(ParseEntry, Results0, Results, !IO) :-
+check_analysis_file_version_number(!IO) :-
 	parser__read_term(TermResult `with_type` read_term, !IO),
 	(
 		TermResult = term(_, term__functor(
@@ -214,18 +355,17 @@
 		true
 	;
 		throw(invalid_analysis_file)
-	),
-	read_analysis_file_3(ParseEntry, Results0, Results, !IO).
+	).
 
-:- pred read_analysis_file_3(parse_entry(T)::in(parse_entry),
+:- pred read_analysis_file_2(parse_entry(T)::in(parse_entry),
 	T::in, T::out, io__state::di, io__state::uo) is det.
 
-read_analysis_file_3(ParseEntry, Results0, Results, !IO) :-
+read_analysis_file_2(ParseEntry, Results0, Results, !IO) :-
 	parser__read_term(TermResult, !IO),
 	(
 		TermResult = term(_, Term) `with_type` read_term,
 		ParseEntry(Term, Results0, Results1),
-		read_analysis_file_3(ParseEntry, Results1, Results, !IO)
+		read_analysis_file_2(ParseEntry, Results1, Results, !IO)
 	;
 		TermResult = eof,
 		Results = Results0
@@ -234,15 +374,40 @@
 		throw(invalid_analysis_file)
 	).
 
-write_module_analysis_results(Info, ModuleId, ModuleResults, !IO) :-
+%-----------------------------------------------------------------------------%
+
+write_module_analysis_results(Info, ModuleId, ModuleStatus, ModuleResults,
+		!IO) :-
+	debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+		io.print("Writing module analysis results for ", !IO),
+		io.print(ModuleId, !IO),
+		io.nl(!IO)
+	), !IO),
+	WriteHeader = write_module_status(ModuleStatus),
 	write_analysis_file(Info ^ compiler, ModuleId, ".analysis",
-		write_result_entry, ModuleResults, !IO).
+		WriteHeader, write_result_entry, ModuleResults, !IO).
+
+:- pred write_module_status(analysis_status::in, io::di, io::uo) is det.
+
+write_module_status(Status, !IO) :-
+    term_io.write_term_nl(init:varset, Term, !IO),
+    Term = functor(atom(String), [], context_init),
+    analysis_status_to_string(Status, String).
 
 write_module_analysis_requests(Info, ModuleId, ModuleRequests, !IO) :-
 	module_id_to_file_name(Info ^ compiler, ModuleId, ".request",
 		AnalysisFileName, !IO),
+	debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+		io.print("Writing module analysis requests to ", !IO),
+		io.print(AnalysisFileName, !IO),
+		io.nl(!IO)
+	), !IO),
 	io__open_input(AnalysisFileName, InputResult, !IO),
 	( InputResult = ok(InputStream) ->
+		%
+		% Request file already exists.  Check it has the right version
+		% number, then append the new requests to the end.
+		%
 		io__set_input_stream(InputStream, OldInputStream, !IO),
 		parser__read_term(VersionResult `with_type` read_term, !IO),
 		io__set_input_stream(OldInputStream, _, !IO),
@@ -272,6 +437,7 @@
 	),
 	( Appended = no ->
 		write_analysis_file(Info ^ compiler, ModuleId, ".request",
+			nop,
 			write_request_entry(Info ^ compiler),
 			ModuleRequests, !IO)
 	;
@@ -281,17 +447,17 @@
 :- pred write_result_entry `with_type` write_entry(analysis_result)
 		`with_inst` write_entry.
 
-write_result_entry(AnalysisName, FuncId,
-		analysis_result(_ `with_type` unit(FuncInfo), Call, Answer),
-		!IO) :-
-	VersionNumber = analysis_version_number(_ `with_type` FuncInfo,
-				Call, Answer), 
+write_result_entry(AnalysisName, FuncId, Result, !IO) :-
+	Result = analysis_result(Call, Answer, Status),
+	VersionNumber = analysis_version_number(Call, Answer), 
+	analysis_status_to_string(Status, StatusString),
 	term_io__write_term_nl(varset__init `with_type` varset,
 		functor(atom(AnalysisName), [
 			functor(integer(VersionNumber), [], context_init),
 		    	functor(string(FuncId), [], context_init),
 			functor(string(to_string(Call)), [], context_init),
-			functor(string(to_string(Answer)), [], context_init)
+			functor(string(to_string(Answer)), [], context_init),
+			functor(string(StatusString), [], context_init)
 		], context_init), !IO).
 
 :- pred write_request_entry(Compiler::in)
@@ -299,15 +465,15 @@
 		`with_inst` write_entry <= compiler(Compiler).
 
 write_request_entry(Compiler, AnalysisName, FuncId,
-		analysis_request(_, Call), !IO) :-
+		analysis_request(Call), !IO) :-
 	(
-		analysis_type(_ `with_type` unit(FuncInfo),
+		analysis_type(
 			_ `with_type` unit(Call),
 			_ `with_type` unit(Answer)) =
 			analyses(Compiler, AnalysisName)
 	->
 		VersionNumber = analysis_version_number(
-			_ `with_type` FuncInfo, _ `with_type` Call,
+			_ `with_type` Call,
 			_ `with_type`  Answer)
 	;
 		error("write_request_entry: unknown analysis type")
@@ -320,14 +486,49 @@
 			functor(string(to_string(Call)), [], context_init)
 		], context_init), !IO).
 
+write_module_imdg(Info, ModuleId, ModuleEntries, !IO) :-
+    write_analysis_file(Info ^ compiler, ModuleId, ".imdg",
+	nop, write_imdg_arc(Info ^ compiler), ModuleEntries, !IO).
+
+:- pred write_imdg_arc(Compiler::in)
+	    `with_type` write_entry(imdg_arc)
+	    `with_inst` write_entry <= compiler(Compiler).
+
+write_imdg_arc(Compiler, AnalysisName, FuncId,
+	imdg_arc(Call, DependentModule), !IO) :-
+    (
+	analysis_type(_ : unit(Call), _ : unit(Answer))
+	    = analyses(Compiler, AnalysisName)
+    ->
+	VersionNumber = analysis_version_number(_ : Call, _ : Answer)
+    ;
+	error("write_imdg_arc: unknown analysis type")
+    ),
+    term_io.write_term_nl(varset.init : varset,
+	functor(atom("->"), [
+	    functor(string(DependentModule), [], context_init),
+	    ResultTerm
+	], context_init), !IO),
+    ResultTerm = functor(atom(AnalysisName), [
+	functor(integer(VersionNumber), [], context_init),
+	functor(string(FuncId), [], context_init),
+	functor(string(to_string(Call)), [], context_init)
+    ], context_init).
+
+%-----------------------------------------------------------------------------%
+
+:- type write_header == pred(io, io).
+:- inst write_header == (pred(di, uo) is det).
+
 :- type write_entry(T) == pred(analysis_name, func_id, T, io__state, io__state).
 :- inst write_entry == (pred(in, in, in, di, uo) is det).
 
 :- pred write_analysis_file(Compiler::in, module_id::in, string::in,
+	write_header::in(write_header),
 	write_entry(T)::in(write_entry), module_analysis_map(T)::in,
 	io__state::di, io__state::uo) is det <= compiler(Compiler).
 
-write_analysis_file(Compiler, ModuleId, Suffix,
+write_analysis_file(Compiler, ModuleId, Suffix, WriteHeader,
 		WriteEntry, ModuleResults, !IO) :-
 	module_id_to_file_name(Compiler, ModuleId,
 		Suffix, AnalysisFileName, !IO),
@@ -337,6 +538,7 @@
 		io__set_output_stream(Stream, OldOutput, !IO),
 		io__write_int(version_number, !IO),
 		io__write_string(".\n", !IO),
+		WriteHeader(!IO),
 		write_analysis_entries(WriteEntry, ModuleResults, !IO),
 		io__set_output_stream(OldOutput, _, !IO),
 		io__close_output(Stream, !IO)
@@ -367,5 +569,17 @@
 empty_request_file(Info, ModuleId, !IO) :-
 	module_id_to_file_name(Info ^ compiler, ModuleId, ".request", 
 		RequestFileName, !IO),
+	debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+		io.print("Removing request file ", !IO),
+		io.print(RequestFileName, !IO),
+		io.nl(!IO)
+	), !IO),
 	io__remove_file(RequestFileName, _, !IO).
 
+:- pred nop(io::di, io::uo) is det.
+
+nop(!IO).
+
+:- pred nop(unit::out, io::di, io::uo) is det.
+
+nop(unit, !IO).
Index: analysis/analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/analysis/analysis.m,v
retrieving revision 1.2
diff -u -r1.2 analysis.m
--- analysis/analysis.m	5 Apr 2004 05:06:38 -0000	1.2
+++ analysis/analysis.m	10 Jan 2006 04:33:53 -0000
@@ -1,10 +1,12 @@
 %-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sw=8 noet
+%-----------------------------------------------------------------------------%
 % Copyright (C) 2003-2004 University of Melbourne.
 % This file may only be copied under the terms of the GNU Library General
 % Public License - see the file COPYING.LIB in the Mercury distribution.
 %-----------------------------------------------------------------------------%
 % File: analysis.m
-% Main author: stayl
+% Main authors: stayl, wangp
 %
 % An inter-module analysis framework, as described in
 %
@@ -18,7 +20,12 @@
 
 :- interface.
 
-:- import_module assoc_list, io, list, std_util.
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module io.
+:- import_module list.
+:- import_module set.
+:- import_module std_util.
 
 	% The intention is that eventually any compiler can
 	% use this library via .NET by defining an instance
@@ -39,30 +46,39 @@
 :- type analysis_name == string.
 
 :- type analysis_type
-	---> some [FuncInfo, Call, Answer]
-		analysis_type(unit(FuncInfo), unit(Call), unit(Answer))
-		=> analysis(FuncInfo, Call, Answer).
-
-	% An analysis is defined by a type describing call patterns,
-	% a type defining answer patterns and a type giving information
-	% about the function being analysed (e.g. arity) which should
-	% be provided by the caller.
-:- typeclass analysis(FuncInfo, Call, Answer) <=
-		(call_pattern(FuncInfo, Call),
-		answer_pattern(FuncInfo, Answer))
+	--->	some [Call, Answer]
+		analysis_type(unit(Call), unit(Answer))
+		=> analysis(Call, Answer).
+
+	% An analysis is defined by a type describing call patterns and
+	% a type defining answer patterns.  If the analysis needs to store
+	% more information about the function being analysed (e.g. arity)
+	% it should be stored as part of the type for call patterns.
+	%
+:- typeclass analysis(Call, Answer) <=
+		(call_pattern(Call),
+		answer_pattern(Answer))
 	where
 [
-	func analysis_name(FuncInfo::unused, Call::unused, Answer::unused) =
+	func analysis_name(Call::unused, Answer::unused) =
 		(analysis_name::out) is det,
 
 	% The version number should be changed when the Call or Answer
 	% types are changed so that results which use the old types
 	% can be discarded.
-	func analysis_version_number(FuncInfo::unused, Call::unused,
+	func analysis_version_number(Call::unused,
 		Answer::unused) = (int::out) is det,
 
-	func preferred_fixpoint_type(FuncInfo::unused, Call::unused,
-		Answer::unused) = (fixpoint_type::out) is det
+	func preferred_fixpoint_type(Call::unused,
+		Answer::unused) = (fixpoint_type::out) is det,
+
+	% `top' and `bottom' should not really depend on the call pattern.
+	% However some analyses may choose to store extra information about
+	% the function in their `Call' types that might be needed for the
+	% answer pattern.
+	%
+ 	func bottom(Call) = Answer,
+ 	func top(Call) = Answer
 ].
 
 :- type fixpoint_type
@@ -75,18 +91,15 @@
 			% Can stop at any time.
 		greatest_fixpoint.
 
-:- typeclass call_pattern(FuncInfo, Call)
-		<= (partial_order(FuncInfo, Call), to_string(Call)) where [].
+:- typeclass call_pattern(Call)
+		<= (partial_order(Call), to_string(Call)) where [].
 
-:- typeclass answer_pattern(FuncInfo, Answer)
-		<= (partial_order(FuncInfo, Answer), to_string(Answer)) where [
-	func bottom(FuncInfo) = Answer,
-	func top(FuncInfo) = Answer
-].
+:- typeclass answer_pattern(Answer)
+		<= (partial_order(Answer), to_string(Answer)) where [].
 
-:- typeclass partial_order(FuncInfo, Call) where [
-	pred more_precise_than(FuncInfo::in, Call::in, Call::in) is semidet,
-	pred equivalent(FuncInfo::in, Call::in, Call::in) is semidet
+:- typeclass partial_order(T) where [
+	pred more_precise_than(T::in, T::in) is semidet,
+	pred equivalent(T::in, T::in) is semidet
 ].
 
 :- typeclass to_string(S) where [
@@ -94,11 +107,25 @@
 	func from_string(string) = S is semidet
 ].
 
+	% A call pattern that can be used by analyses that do not need
+	% finer granularity.
+	%
 :- type any_call ---> any_call.
-:- instance call_pattern(unit, any_call).
-:- instance partial_order(unit, any_call).
+:- instance call_pattern(any_call).
+:- instance partial_order(any_call).
 :- instance to_string(any_call).
 
+	% The status of a module or a specific analysis result.
+	%
+:- type analysis_status
+	--->	invalid
+	;	suboptimal
+	;	optimal.
+
+	% Least upper bound of two analysis_status values.
+	%
+:- func lub(analysis_status, analysis_status) = analysis_status.
+
 	% This will need to encode language specific details like
 	% whether it is a predicate or a function, and the arity
 	% and mode number.
@@ -110,220 +137,822 @@
 :- func init_analysis_info(Compiler) = analysis_info <= compiler(Compiler).
 
 	% Look up all results for a given function.
-:- pred lookup_results(module_id::in, func_id::in, FuncInfo::in,
-	assoc_list(Call, Answer)::out, analysis_info::in, analysis_info::out,
-	io__state::di, io__state::uo) is det
-	<= analysis(FuncInfo, Call, Answer).
+	%
+	% N.B. Newly recorded results will NOT be found.  This
+	% is intended for looking up results from _other_ modules.
+	%
+:- pred lookup_results(module_id::in, func_id::in,
+	list({Call, Answer, analysis_status})::out, 
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det
+	<= analysis(Call, Answer).
+
+	% Look up all results for a given function and call pattern CP such
+	% that the results have call patterns CP' that are equivalent
+	% to CP or less specific than CP.
+	%
+	% N.B. Newly recorded results will NOT be found.  This
+	% is intended for looking up results from _other_ modules.
+	%
+:- pred lookup_matching_results(module_id::in, func_id::in, Call::in,
+	list({Call, Answer, analysis_status})::out, 
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det
+	<= analysis(Call, Answer).
 
 	% Look up the best result matching a given call.
-:- pred lookup_best_result(module_id::in, func_id::in, FuncInfo::in,
-	Call::in, maybe(pair(Call, Answer))::out, analysis_info::in,
-	analysis_info::out, io__state::di, io__state::uo) is det
-	<= analysis(FuncInfo, Call, Answer).
+	%
+	% N.B. Newly recorded results will NOT be found.  This
+	% is intended for looking up results from _other_ modules.
+	%
+:- pred lookup_best_result(module_id::in, func_id::in, Call::in,
+	maybe({Call, Answer, analysis_status})::out,
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det
+	<= analysis(Call, Answer).
 
 	% Record an analysis result for a (usually local) function.
-:- pred record_result(module_id::in, func_id::in, FuncInfo::in, Call::in,
-	Answer::in, analysis_info::in, analysis_info::out) is det
-	<= analysis(FuncInfo, Call, Answer).
+	% XXX at the moment the result is assumed to be for a function local to
+	% the currently-compiled module and things will probably break if it
+	% isn't.
+	%
+:- pred record_result(module_id::in, func_id::in, Call::in,
+	Answer::in, analysis_status::in,
+	analysis_info::in, analysis_info::out) is det
+	<= analysis(Call, Answer).
+
+	% Record the dependency of a module on the analysis result of another
+	% module.
+	%
+:- pred record_dependency(module_id::in, analysis_name::in, module_id::in,
+	func_id::in, Call::in, analysis_info::in, analysis_info::out) is det
+	<= call_pattern(Call).
 
 	% Lookup all the requests for a given (usually local) function.
 :- pred lookup_requests(analysis_name::in, module_id::in, func_id::in,
-	FuncInfo::in, list(Call)::out, analysis_info::in, analysis_info::out,
-	io__state::di, io__state::uo) is det <= call_pattern(FuncInfo, Call).
+	list(Call)::out, analysis_info::in, analysis_info::out,
+	io::di, io::uo) is det <= call_pattern(Call).
 
 	% Record a request for a local function.
 :- pred record_request(analysis_name::in, module_id::in, func_id::in,
-	FuncInfo::in, Call::in, analysis_info::in, analysis_info::out) is det
-	<= call_pattern(FuncInfo, Call).
+	Call::in, analysis_info::in, analysis_info::out) is det
+	<= call_pattern(Call).
 
 	% Should be called after all analysis is completed to write the
 	% requests and results for the current compilation to the
 	% analysis files.
-:- pred write_analysis_files(module_id::in, analysis_info::in,
-	io__state::di, io__state::uo) is det.
+	%
+:- pred write_analysis_files(module_id::in, set(module_id)::in, 
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 
 :- implementation.
 
 :- include_module analysis__file.
 :- import_module analysis__file.
 
-:- import_module map, require, set.
+:- import_module bool.
+:- import_module map.
+:- import_module require.
+:- import_module set.
+:- import_module string.
 
 :- type analysis_info
 	---> some [Compiler] analysis_info(
 		compiler :: Compiler,
+
+			% Holds outstanding requests for more specialised
+			% variants of procedures.  Requests are added to this
+			% map as analyses proceed and written out to disk
+			% at the end of the compilation of this module.
+			%
 		analysis_requests :: analysis_map(analysis_request),
-		analysis_results :: analysis_map(analysis_result)
+
+			% The overall status of each module.
+			%
+		module_statuses	:: map(module_id, analysis_status),
+
+			% The "old" map stores analysis results read in from
+			% disk.  New results generated while analysing the
+			% current module are added to the "new" map.  After
+			% all the analyses the two maps are compared to
+			% see which analysis results have changed.  Other
+			% modules may need to be marked or invalidated as a
+			% result.  Then "new" results are moved into the "old"
+			% map, from where they can be written to disk.
+			%
+		old_analysis_results :: analysis_map(analysis_result),
+		new_analysis_results :: analysis_map(analysis_result),
+
+			% The Inter-module Dependency Graph records dependences
+			% of an entire module's analysis results on another
+			% module's answer patterns. e.g. assume module M1
+			% contains function F1 that has an analysis result that
+			% used the answer F2:CP2->AP2 from module M2.  If AP2
+			% changes then all of M1 will either be marked
+			% `suboptimal' or `invalid'.  Finer-grained dependency
+			% tracking would allow only F1 to be recompiled,
+			% instead of all of M1, but we don't do that.
+			%
+			% IMDGs are loaded from disk into the old map.
+			% During analysis any dependences of the current module
+			% on other modules is added into the new map.
+			% At the end of analysis all the arcs which terminate
+			% at the current module are cleared from the old map
+			% and replaced by those in the new map.
+			%
+			% XXX: check if we really need two maps
+			%
+		old_imdg :: analysis_map(imdg_arc),
+		new_imdg :: analysis_map(imdg_arc)
 	) => compiler(Compiler).
 
+	% An analysis result is a call pattern paired with an answer.
+	% The result has a status associated with it.
+	%
 :- type analysis_result
-	--->	some [FuncInfo, Call, Answer] analysis_result(unit(FuncInfo),
-			Call, Answer) => analysis(FuncInfo, Call, Answer).
+	--->	some [Call, Answer]
+		analysis_result(Call, Answer, analysis_status)
+		=> analysis(Call, Answer).
 
 :- type analysis_request
-	---> some [FuncInfo, Call] analysis_request(unit(FuncInfo), Call)
-			=> call_pattern(FuncInfo, Call).
+	--->	some [Call]
+		analysis_request(Call)
+		=> call_pattern(Call).
+
+:- type imdg_arc
+	--->	some [Call]
+		imdg_arc(
+			Call,	    % Call pattern of the analysis result
+				    % being depended on.
+			module_id   % The module that _depends on_ this
+				    % function's result.
+		) => call_pattern(Call).
+
+:- type analysis_map(T)		== map(module_id, module_analysis_map(T)).
+:- type module_analysis_map(T)	== map(analysis_name, func_analysis_map(T)).
+:- type func_analysis_map(T)	== map(func_id, list(T)).
 
-:- type analysis_hash == int.
+%-----------------------------------------------------------------------------%
+%
+% The "any" call pattern
+%
 
-:- type analysis_map(T) == map(module_id, module_analysis_map(T)).
-:- type module_analysis_map(T) == map(analysis_name, func_analysis_map(T)).
-:- type func_analysis_map(T) == map(func_id, list(T)).
-
-:- instance call_pattern(unit, any_call) where [].
-:- instance partial_order(unit, any_call) where [
-	more_precise_than(_, _, _) :- semidet_fail,
-	equivalent(_, _, _) :- semidet_succeed
+:- instance call_pattern(any_call) where [].
+:- instance partial_order(any_call) where [
+	more_precise_than(_, _) :- semidet_fail,
+	equivalent(_, _) :- semidet_succeed
 ].
 :- instance to_string(any_call) where [
 	to_string(any_call) = "",
 	from_string("") = any_call
 ].
 
+%-----------------------------------------------------------------------------%
+
 init_analysis_info(Compiler) =
-	'new analysis_info'(Compiler, map__init, map__init).
+    'new analysis_info'(Compiler, map__init, map__init, map__init, map__init,
+	map__init, map__init).
 
-lookup_results(ModuleId, FuncId, _FuncInfo, ResultList, !Info, !IO) :-
-	%io__write_string("looking up results for ", !IO),
-	%io__write_string(FuncId, !IO),
-	%io__nl(!IO),
-	( map__search(!.Info ^ analysis_results, ModuleId, ModuleResults0) ->
-		ModuleResults = ModuleResults0
-	;
-		read_module_analysis_results(!.Info, ModuleId,
-			ModuleResults, !IO),
-		!:Info = !.Info ^ analysis_results
-				^ elem(ModuleId) := ModuleResults
-	),
-	AnalysisName = analysis_name(_ `with_type` FuncInfo,
-				_ `with_type` Call, _ `with_type` Answer),
-	(
-		Results = ModuleResults ^ elem(AnalysisName) ^ elem(FuncId)
-	->
-		ResultList = list__map(
-		    (func(Result) = ResultCall - ResultAnswer :-
-			Result = analysis_result(_,
-					ResultCall0, ResultAnswer0),
-			det_univ_to_type(univ(ResultCall0), ResultCall),
-		    	det_univ_to_type(univ(ResultAnswer0), ResultAnswer)
-		    ), Results)
-	;
-		ResultList = []
-	).
+%-----------------------------------------------------------------------------%
 
-lookup_best_result(ModuleId, FuncId, FuncInfo, Call, MaybeBestResult,
-		!Info, !IO) :-
-	%io__write_string("looking up best result for ", !IO),
-	%io__write_string(FuncId, !IO),
-	%io__nl(!IO),
-	lookup_results(ModuleId, FuncId, FuncInfo, ResultList, !Info, !IO),
-	MatchingResults = list__filter(
-		(pred((ResultCall - _)::in) is semidet :-
-			( more_precise_than(FuncInfo, Call, ResultCall)
-			; equivalent(FuncInfo, Call, ResultCall)
-			)
-		), ResultList),
-	(
-		MatchingResults = [],
-		MaybeBestResult = no
-	;
-		MatchingResults = [FirstResult | MatchingResults1],
-		MaybeBestResult = yes(list__foldl(
-		    (func(ThisResult, BestResult) =
-			(
-				more_precise_than(FuncInfo,
-					snd(ThisResult), snd(BestResult))
-			->
-				ThisResult
-			;
-				BestResult
-			)
-		    ), MatchingResults1, FirstResult))
-	).
-
-record_result(ModuleId, FuncId, FuncInfo, CallPattern, AnswerPattern, !Info) :-
-	( ModuleResults0 = map__search(!.Info ^ analysis_results, ModuleId) ->
-		ModuleResults1 = ModuleResults0
-	;
-		ModuleResults1 = map__init
-	),
-	AnalysisName = analysis_name(FuncInfo, CallPattern, AnswerPattern),
-	( AnalysisResults0 = map__search(ModuleResults1, AnalysisName) ->
-		AnalysisResults1 = AnalysisResults0
-	;
-		AnalysisResults1 = map__init
-	),
-	( FuncResults0 = map__search(AnalysisResults1, FuncId) ->
-		FuncResults1 = FuncResults0
-	;
-		FuncResults1 = []
-	),
-	!:Info = !.Info ^ analysis_results :=
-		map__set(!.Info ^ analysis_results, ModuleId,
-		map__set(ModuleResults1, AnalysisName,
-		map__set(AnalysisResults1, FuncId,
-		['new analysis_result'(unit1 `with_type` unit(FuncInfo),
-			CallPattern, AnswerPattern) | FuncResults1]))).
-
-lookup_requests(AnalysisName, ModuleId, FuncId, _FuncInfo,
-		CallPatterns, !Info, !IO) :-
-	( map__search(!.Info ^ analysis_requests, ModuleId, ModuleRequests0) ->
-		ModuleRequests = ModuleRequests0
-	;
-		read_module_analysis_requests(!.Info,
-			ModuleId, ModuleRequests, !IO),
-		!:Info = !.Info ^ analysis_requests
-				^ elem(ModuleId) := ModuleRequests
-	),
-	( CallPatterns0 = ModuleRequests ^ elem(AnalysisName) ^ elem(FuncId) ->
-		CallPatterns = list__filter_map(
-		    (func(Call0) = Call is semidet :-
-			univ(Call) = univ(Call0)
-		    ), CallPatterns0)
-	;
-		CallPatterns = []
-	).
+lookup_results(ModuleId, FuncId, ResultList, !Info, !IO) :-
+    debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+	io.write_string("Looking up analysis results for ", !IO),
+	io.write_string(ModuleId, !IO),
+	io.write_string(".", !IO),
+	io.write_string(FuncId, !IO),
+	io.nl(!IO)
+    ), !IO),
+    ensure_old_module_analysis_results_loaded(ModuleId, !Info, !IO),
+    lookup_results_2(!.Info ^ old_analysis_results,
+	ModuleId, FuncId, ResultList),
+    debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+	io.write_string("Found these results: ", !IO),
+	io.print(ResultList, !IO),
+	io.nl(!IO)
+    ), !IO).
+
+:- pred lookup_results_2(analysis_map(analysis_result)::in, module_id::in,
+	func_id::in, list({Call, Answer, analysis_status})::out) is det
+	<= analysis(Call, Answer).
+
+lookup_results_2(Map, ModuleId, FuncId, ResultList) :-
+    AnalysisName = analysis_name(_ : Call, _ : Answer),
+    (if
+	ModuleResults = Map ^ elem(ModuleId),
+	Results = ModuleResults ^ elem(AnalysisName) ^ elem(FuncId)
+    then
+	% XXX we might have to discard results which are
+	% `invalid' or `fixpoint_invalid' if they are written at all
+	ResultList = list.map(
+	    (func(Result) = {Call, Answer, Status} :-
+		Result = analysis_result(Call0, Answer0, Status),
+		det_univ_to_type(univ(Call0), Call),
+		det_univ_to_type(univ(Answer0), Answer)
+	    ), Results)
+    else
+	ResultList = []
+    ).
+
+lookup_matching_results(ModuleId, FuncId, Call, ResultList, !Info, !IO) :-
+    lookup_results(ModuleId, FuncId, AllResultsList, !Info, !IO),
+    ResultList = list.filter(
+	(pred(({ResultCall, _, _})::in) is semidet :-
+	    ( more_precise_than(Call, ResultCall)
+	    ; equivalent(Call, ResultCall)
+	    )
+	), AllResultsList).
+
+lookup_best_result(ModuleId, FuncId, Call, MaybeBestResult, !Info, !IO) :-
+    debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+	io.write_string("Looking up best analysis result for ", !IO),
+	io.write_string(ModuleId, !IO),
+	io.write_string(".", !IO),
+	io.write_string(FuncId, !IO),
+	io.nl(!IO)
+    ), !IO),
+    lookup_matching_results(ModuleId, FuncId, Call, MatchingResults,
+	!Info, !IO),
+    (
+	MatchingResults = [],
+	MaybeBestResult = no
+    ;
+	MatchingResults = [_ | _],
+	MaybeBestResult = yes(BestResult),
+	most_precise_answer(MatchingResults, BestResult)
+    ).
+
+:- pred most_precise_answer(
+	list({Call, Answer, analysis_status})::in(non_empty_list),
+	{Call, Answer, analysis_status}::out) is det
+	<= analysis(Call, Answer).
+
+most_precise_answer([Result | Results], BestResult) :-
+    list.foldl(more_precise_answer, Results, Result, BestResult).
+
+:- pred more_precise_answer({Call, Answer, analysis_status}::in,
+	{Call, Answer, analysis_status}::in, 
+	{Call, Answer, analysis_status}::out) is det
+	<= analysis(Call, Answer).
+
+more_precise_answer(Result, Best0, Best) :-
+    Result = {_, ResultAnswer, _},
+    Best0  = {_, BestAnswer0, _},
+    (if more_precise_than(ResultAnswer, BestAnswer0) then
+	Best = Result
+    else
+	Best = Best0
+    ).
+
+:- pred lookup_exactly_matching_result(module_id::in, func_id::in, Call::in,
+	maybe({Call, Answer, analysis_status})::out, 
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det
+	<= analysis(Call, Answer).
+
+lookup_exactly_matching_result(ModuleId, FuncId, Call, MaybeResult,
+        !Info, !IO) :-
+    lookup_results(ModuleId, FuncId, AllResultsList, !Info, !IO),
+    ResultList = list.filter(
+        (pred(({ResultCall, _, _})::in) is semidet :-
+                equivalent(Call, ResultCall)
+        ), AllResultsList),
+    (
+        ResultList = [],
+        MaybeResult = no
+    ;
+        ResultList = [Result],
+        MaybeResult = yes(Result)
+    ;
+        ResultList = [_, _ | _],
+        error("lookup_exactly_matching_result: zero or one " ++
+                "exactly matching results expected")
+    ).
+
+%-----------------------------------------------------------------------------%
+
+record_result(ModuleId, FuncId, CallPattern, AnswerPattern, Status, !Info) :-
+    Map0 = !.Info ^ new_analysis_results,
+    record_result_in_analysis_map(ModuleId, FuncId,
+	CallPattern, AnswerPattern, Status, Map0, Map),
+    !:Info = !.Info ^ new_analysis_results := Map.
+
+:- pred record_result_in_analysis_map(module_id::in, func_id::in,
+	Call::in, Answer::in, analysis_status::in,
+	analysis_map(analysis_result)::in, 
+	analysis_map(analysis_result)::out) is det
+	<= analysis(Call, Answer).
+
+record_result_in_analysis_map(ModuleId, FuncId,
+        CallPattern, AnswerPattern, Status, !Map) :-
+    ( ModuleResults0 = map.search(!.Map, ModuleId) ->
+	ModuleResults1 = ModuleResults0
+    ;
+	ModuleResults1 = map.init
+    ),
+    AnalysisName = analysis_name(CallPattern, AnswerPattern),
+    ( AnalysisResults0 = map.search(ModuleResults1, AnalysisName) ->
+	AnalysisResults1 = AnalysisResults0
+    ;
+	AnalysisResults1 = map.init
+    ),
+    ( FuncResults0 = map.search(AnalysisResults1, FuncId) ->
+	FuncResults1 = FuncResults0
+    ;
+	FuncResults1 = []
+    ),
+    !:Map = map.set(!.Map, ModuleId,
+	map.set(ModuleResults1, AnalysisName,
+	map.set(AnalysisResults1, FuncId,
+	FuncResults))),
+    FuncResults = [Result | FuncResults1],
+    Result = 'new analysis_result'(CallPattern, AnswerPattern, Status).
+
+%-----------------------------------------------------------------------------%
+
+lookup_requests(AnalysisName, ModuleId, FuncId, CallPatterns, !Info, !IO) :-
+    ( map__search(!.Info ^ analysis_requests, ModuleId, ModuleRequests0) ->
+        ModuleRequests = ModuleRequests0
+    ;
+        read_module_analysis_requests(!.Info, ModuleId, ModuleRequests, !IO),
+        !:Info = !.Info ^ analysis_requests ^ elem(ModuleId) := ModuleRequests
+    ),
+    ( CallPatterns0 = ModuleRequests ^ elem(AnalysisName) ^ elem(FuncId) ->
+        CallPatterns = list__filter_map(
+            (func(Call0) = Call is semidet :- univ(Call) = univ(Call0)),
+            CallPatterns0)
+    ;
+        CallPatterns = []
+    ).
+
+record_request(AnalysisName, ModuleId, FuncId, CallPattern, !Info) :-
+    ( ModuleResults0 = map.search(!.Info ^ analysis_requests, ModuleId) ->
+        ModuleResults1 = ModuleResults0
+    ;
+        ModuleResults1 = map.init
+    ),
+    ( AnalysisResults0 = map.search(ModuleResults1, AnalysisName) ->
+        AnalysisResults1 = AnalysisResults0
+    ;
+        AnalysisResults1 = map.init
+    ),
+    ( FuncResults0 = map.search(AnalysisResults1, FuncId) ->
+        FuncResults1 = FuncResults0
+    ;
+        FuncResults1 = []
+    ),
+    !:Info = !.Info ^ analysis_requests :=
+        map.set(!.Info ^ analysis_requests, ModuleId,
+        map.set(ModuleResults1, AnalysisName,
+        map.set(AnalysisResults1, FuncId,
+        ['new analysis_request'(CallPattern) | FuncResults1]))).
 
-record_request(AnalysisName, ModuleId, FuncId, _FuncInfo,
-		CallPattern, !Info) :-
-	( ModuleResults0 = map__search(!.Info ^ analysis_requests, ModuleId) ->
-		ModuleResults1 = ModuleResults0
+%-----------------------------------------------------------------------------%
+
+record_dependency(CallerModuleId, AnalysisName, CalleeModuleId, FuncId, Call,
+	!Info) :-
+    (if CallerModuleId = CalleeModuleId then
+	% XXX this assertion breaks compiling the standard library with
+	% --analyse-trail-usage at the moment
+	%
+	% error("record_dependency: " ++ CalleeModuleId ++ " and " ++
+	%    CallerModuleId ++ " must be different")
+	true
+    else
+	( Analyses0 = map.search(!.Info ^ new_imdg, CallerModuleId) ->
+	    Analyses1 = Analyses0
 	;
-		ModuleResults1 = map__init
+	    Analyses1 = map.init
 	),
-	( AnalysisResults0 = map__search(ModuleResults1, AnalysisName) ->
-		AnalysisResults1 = AnalysisResults0
+	( Funcs0 = map.search(Analyses1, AnalysisName) ->
+	    Funcs1 = Funcs0
 	;
-		AnalysisResults1 = map__init
+	    Funcs1 = map.init
 	),
-	( FuncResults0 = map__search(AnalysisResults1, FuncId) ->
-		FuncResults1 = FuncResults0
+	( FuncArcs0 = map.search(Funcs1, FuncId) ->
+	    FuncArcs1 = FuncArcs0
 	;
-		FuncResults1 = []
+	    FuncArcs1 = []
 	),
-	!:Info = !.Info ^ analysis_requests :=
-		map__set(!.Info ^ analysis_requests, ModuleId,
-		map__set(ModuleResults1, AnalysisName,
-		map__set(AnalysisResults1, FuncId,
-		['new analysis_request'(unit1 `with_type` unit(FuncInfo),
-			CallPattern) | FuncResults1]))).
+	!:Info = !.Info ^ new_imdg :=
+	    map.set(!.Info ^ new_imdg, CalleeModuleId,
+	    map.set(Analyses1, AnalysisName,
+	    map.set(Funcs1, FuncId, FuncArcs))),
+	FuncArcs = [Dep | FuncArcs1],
+	Dep = 'new imdg_arc'(Call, CallerModuleId)
+    ).
 
-write_analysis_files(ModuleId, Info, !IO) :-
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 
+    % The algorithm is from Nick's thesis, pp. 108-9.
+    % Or my corruption thereof.
+    % 
+    % For each new analysis result (P^M:DP --> Ans_new):
+    %   Read in the registry of M if necessary
+    %   If there is an existing analysis result (P^M:DP --> Ans_old):
+    %	if Ans_new \= Ans_old:
+    %	    Replace the entry in the registry with P^M:DP --> Ans_new
+    %	    if Ans_new `more_precise_than` Ans_old
+    %		Status = suboptimal
+    %	    else
+    %		Status = invalid
+    %	    For each entry (Q^N:DQ --> P^M:DP) in the IMDG:
+    %		% Mark Q^N:DQ --> _ (_) with Status
+    %		Actually, we don't do that.  We only mark the
+    %		module N's _overall_ status with the 
+    %		least upper bound of its old status and Status.
+    %   Else (P:DP --> Ans_old) did not exist:
+    %	Insert result (P:DP --> Ans_new) into the registry.
+    %
+    % Finally, clear out the "new" analysis results map.  When we write
+    % out the analysis files we will do it from the "old" results map.
+    %
+:- pred update_analysis_registry(analysis_info::in, analysis_info::out,
+	io::di, io::uo) is det.
+:- pred update_analysis_registry_2(module_id::in,
+	module_analysis_map(analysis_result)::in,
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+:- pred update_analysis_registry_3(module_id::in, analysis_name::in, 
+	func_analysis_map(analysis_result)::in,
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+:- pred update_analysis_registry_4(module_id::in, analysis_name::in,
+	func_id::in, list(analysis_result)::in, 
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+:- pred update_analysis_registry_5(module_id::in, analysis_name::in,
+	func_id::in, analysis_result::in, 
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+
+update_analysis_registry(!Info, !IO) :-
+    map.foldl2(update_analysis_registry_2, !.Info ^ new_analysis_results,
+	!Info, !IO),
+    !:Info = !.Info ^ new_analysis_results := map.init.
+
+update_analysis_registry_2(ModuleId, ModuleMap, !Info, !IO) :-
+    ensure_old_module_analysis_results_loaded(ModuleId, !Info, !IO),
+    ensure_old_imdg_loaded(ModuleId, !Info, !IO),
+    map.foldl2(update_analysis_registry_3(ModuleId), ModuleMap, !Info, !IO).
+
+update_analysis_registry_3(ModuleId, AnalysisName, FuncMap, !Info, !IO) :-
+    map.foldl2(update_analysis_registry_4(ModuleId, AnalysisName),
+	FuncMap, !Info, !IO).
+
+update_analysis_registry_4(ModuleId, AnalysisName, FuncId, NewResults,
+	!Info, !IO) :-
+    list.foldl2(update_analysis_registry_5(ModuleId, AnalysisName, FuncId),
+	NewResults, !Info, !IO).
+
+update_analysis_registry_5(ModuleId, _AnalysisName, FuncId, NewResult,
+	!Info, !IO) :-
+    NewResult = analysis_result(Call, NewAnswer, NewStatus),
+    lookup_exactly_matching_result(ModuleId, FuncId, Call, MaybeResult,
+	!Info, !IO),
+    (
+	% There was a previous answer for this call pattern.
 	%
-	% Write the results for the current module.
+	MaybeResult = yes({_OldCall, OldAnswer, OldStatus}),
+	(if equivalent(NewAnswer, OldAnswer) then
+	    debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+		io.print("No change in the result ", !IO),
+		io.print(ModuleId, !IO),
+		io.print(".", !IO),
+		io.print(FuncId, !IO),
+		io.print(":", !IO),
+		io.print(Call, !IO),
+		io.print(" --> ", !IO),
+		io.print(NewAnswer, !IO),
+		io.nl(!IO)
+	    ), !IO),
+
+	    (if NewStatus \= OldStatus then
+		OldMap0 = !.Info ^ old_analysis_results,
+		replace_result_in_analysis_map(ModuleId, FuncId,
+		    Call, NewAnswer, NewStatus, OldMap0, OldMap),
+		!:Info = !.Info ^ old_analysis_results := OldMap
+	    else
+		true
+	    )
+	else
+	    % Answer has changed.
+	    % Replace the old answer in the registry with the new answer.
+	    %
+	    OldMap0 = !.Info ^ old_analysis_results,
+	    replace_result_in_analysis_map(ModuleId, FuncId,
+                Call, NewAnswer, NewStatus, OldMap0, OldMap),
+	    !:Info = !.Info ^ old_analysis_results := OldMap,
+
+	    % If the answer is more precise than before then dependent
+	    % modules should be marked suboptimal.  Otherwise the answer
+	    % is less precise than it was before, so dependent modules
+	    % should be invalidated.
+	    %
+	    (if NewAnswer `more_precise_than` OldAnswer then
+		Status = suboptimal
+	    else
+		Status = invalid
+	    ),
+	    debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+		io.print("Mark dependent modules as ", !IO),
+		io.print(Status, !IO),
+		io.nl(!IO),
+		io.print("The modules to mark are: ", !IO),
+		io.print(DepModules, !IO),
+		io.nl(!IO)
+	    ), !IO),
+	    DepModules = imdg_dependent_modules(
+		!.Info ^ old_imdg ^ det_elem(ModuleId)),
+	    set.fold2(taint_module_overall_status(Status), DepModules,
+		!Info, !IO)
+	)
+    ;
+	% There was no previous answer for this call pattern.
+	% Just add this result to the registry.
 	%
-	( ModuleResults0 = map__search(Info ^ analysis_results, ModuleId) ->
-		ModuleResults = ModuleResults0
-	;
-		ModuleResults = map__init
-	),
-	write_module_analysis_results(Info, ModuleId, ModuleResults, !IO),
+	MaybeResult = no,
+	OldMap0 = !.Info ^ old_analysis_results,
+	record_result_in_analysis_map(ModuleId, FuncId,
+	    Call, NewAnswer, NewStatus, OldMap0, OldMap),
+	!:Info = !.Info ^ old_analysis_results := OldMap
+    ).
+
+    % replace_result_in_analysis_map(ModuleId, FuncId,
+    %	Call, Answer, Status, !Map)
+    % 
+    % Replace an analysis result for the given function/call pattern
+    % with a new result.  A previous result _must_ already exist
+    % in the map with exactly the same call pattern.
+    %
+:- pred replace_result_in_analysis_map(module_id::in, func_id::in,
+	Call::in, Answer::in, analysis_status::in,
+	analysis_map(analysis_result)::in, 
+	analysis_map(analysis_result)::out) is det
+	<= analysis(Call, Answer).
+
+replace_result_in_analysis_map(ModuleId, FuncId,
+	CallPattern, AnswerPattern, Status, Map0, Map) :-
+    AnalysisName = analysis_name(CallPattern, AnswerPattern),
+    ModuleResults0 = map.lookup(Map0, ModuleId),
+    AnalysisResults0 = map.lookup(ModuleResults0, AnalysisName),
+    FuncResults0 = map.lookup(AnalysisResults0, FuncId),
+    replace_result_in_list(CallPattern, AnswerPattern, Status,
+	FuncResults0, FuncResults),
+    Map = map.det_update(Map0, ModuleId,
+	map.det_update(ModuleResults0, AnalysisName,
+	map.det_update(AnalysisResults0, FuncId, FuncResults))).
+
+:- pred replace_result_in_list(Call::in, Answer::in, analysis_status::in, 
+	list(analysis_result)::in, list(analysis_result)::out)
+	is det <= analysis(Call, Answer).
+
+replace_result_in_list(_Call, _Answer, _Status, [], _) :-
+    error("replace_result_in_list/5: found no result to replace").
+replace_result_in_list(Call, Answer, Status, [H0 | T0], [H | T]) :-
+    H0 = analysis_result(HCall0, _, _),
+    det_univ_to_type(univ(HCall0), HCall),
+    (if equivalent(Call, HCall) then
+	H = 'new analysis_result'(Call, Answer, Status),
+	T = T0
+    else
+	H = H0,
+	replace_result_in_list(Call, Answer, Status, T0, T)
+    ).
+
+    % Return the set of M
+    % where (M:CP --> _:_) `in` IMDG
+    %
+:- func imdg_dependent_modules(module_analysis_map(imdg_arc)) = set(module_id).
+:- func imdg_dependent_modules_2(analysis_name, func_analysis_map(imdg_arc),
+        set(module_id)) = set(module_id).
+:- func imdg_dependent_modules_3(func_id, list(imdg_arc),
+        set(module_id)) = set(module_id).
+
+imdg_dependent_modules(ModuleMap)
+    = map.foldl(imdg_dependent_modules_2, ModuleMap, set.init).
+imdg_dependent_modules_2(_AnalysisName, FuncMap, Modules0)
+    = map.foldl(imdg_dependent_modules_3, FuncMap, Modules0).
+imdg_dependent_modules_3(_FuncId, IMDGEntries, Modules0)
+    = set.union(Modules0, set.from_list(list.map(arc_module_id, IMDGEntries))).
+
+:- func arc_module_id(imdg_arc) = module_id.
+
+arc_module_id(imdg_arc(_, ModuleId)) = ModuleId.
+
+:- pred taint_module_overall_status(analysis_status::in,
+	module_id::in, analysis_info::in, analysis_info::out,
+	io::di, io::uo) is det.
+
+taint_module_overall_status(Status, ModuleId, !Info, !IO) :-
+    (if Status = optimal then
+	true
+    else
+	ensure_old_module_analysis_results_loaded(ModuleId, !Info, !IO),
+	debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+	    io.print("Tainting the overall module status of ", !IO),
+	    io.print(ModuleId, !IO),
+	    io.print(" with ", !IO),
+	    io.print(ModuleStatus, !IO),
+	    io.nl(!IO)
+	), !IO),
+	ModuleStatus0 = !.Info ^ module_statuses ^ det_elem(ModuleId),
+	ModuleStatus = lub(ModuleStatus0, Status),
+	!:Info = !.Info ^ module_statuses ^ elem(ModuleId) := ModuleStatus
+    ).
 
-	%
-	% Write the requests for the imported modules.
-	%
-	map__foldl(write_module_analysis_requests(Info),
-		Info ^ analysis_requests, !IO),
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+    % For each module N imported by M:
+    %	Delete all entries leading to module M from N's IMDG:
+    %	For each P^M:DP in S (call patterns to analyse):
+    %	    add P^M:DP --> Q^N:DQ to N's IMDG
+    %
+:- pred update_intermodule_dependencies(module_id::in, set(module_id)::in,
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+
+update_intermodule_dependencies(ModuleId, ImportedModules, !Info, !IO) :-
+    set.fold2(update_intermodule_dependencies_2(ModuleId),
+	ImportedModules, !Info, !IO).
+
+:- pred update_intermodule_dependencies_2(module_id::in, module_id::in,
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+
+update_intermodule_dependencies_2(ModuleId, ImportedModuleId, !Info, !IO) :-
+    debug_msg((pred(!.IO::di, !:IO::uo) is det :-
+	io.print("Clearing entries involving ", !IO),
+	io.print(ModuleId, !IO),
+	io.print(" from ", !IO),
+	io.print(ImportedModuleId, !IO),
+	io.print("'s IMDG.\n", !IO)
+    ), !IO),
+    ensure_old_imdg_loaded(ImportedModuleId, !Info, !IO),
+    IMDG0 = !.Info ^ old_imdg ^ det_elem(ImportedModuleId),
+    clear_imdg_entries_pointing_at(ModuleId, IMDG0, IMDG1),
+
+    (if NewArcs = !.Info ^ new_imdg ^ elem(ImportedModuleId) then
+	map.union(combine_func_imdg, IMDG1, NewArcs, IMDG)
+    else
+	IMDG = IMDG1
+    ),
+    !:Info = !.Info ^ old_imdg ^ elem(ImportedModuleId) := IMDG,
+    !:Info = !.Info  ^ new_imdg :=
+        map.delete(!.Info ^ new_imdg, ImportedModuleId).
+
+:- pred clear_imdg_entries_pointing_at(module_id::in,
+	module_analysis_map(imdg_arc)::in,
+	module_analysis_map(imdg_arc)::out) is det.
+:- pred clear_imdg_entries_pointing_at_2(module_id::in, analysis_name::in, 
+	func_analysis_map(imdg_arc)::in,
+	func_analysis_map(imdg_arc)::out) is det.
+:- pred clear_imdg_entries_pointing_at_3(module_id::in, func_id::in,
+	list(imdg_arc)::in, list(imdg_arc)::out) is det.
+
+clear_imdg_entries_pointing_at(ModuleId, Map0, Map) :-
+    map.map_values(clear_imdg_entries_pointing_at_2(ModuleId), Map0, Map).
+clear_imdg_entries_pointing_at_2(ModuleId, _, FuncMap0, FuncMap) :-
+    map.map_values(clear_imdg_entries_pointing_at_3(ModuleId),
+	FuncMap0, FuncMap).
+clear_imdg_entries_pointing_at_3(ModuleId, _, Arcs0, Arcs) :-
+    list.filter((pred(imdg_arc(_, ModId)::in) is semidet :- ModuleId \= ModId),
+	Arcs0, Arcs).
+
+:- pred combine_func_imdg(func_analysis_map(imdg_arc)::in,
+	func_analysis_map(imdg_arc)::in, func_analysis_map(imdg_arc)::out)
+	is det.
+
+combine_func_imdg(FuncImdgA, FuncImdgB, FuncImdg) :-
+    map.union(combine_imdg_lists, FuncImdgA, FuncImdgB, FuncImdg).
+
+:- pred combine_imdg_lists(list(imdg_arc)::in, list(imdg_arc)::in,
+	list(imdg_arc)::out) is det.
+
+combine_imdg_lists(ArcsA, ArcsB, ArcsA ++ ArcsB).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ensure_old_module_analysis_results_loaded(module_id::in,
+	analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+
+ensure_old_module_analysis_results_loaded(ModuleId, !Info, !IO) :-
+    (if map.search(!.Info ^ old_analysis_results, ModuleId, _Results) then
+	% sanity check
+	map.lookup(!.Info ^ module_statuses, ModuleId, _StatusMustExist)
+    else
+	read_module_analysis_results(!.Info, ModuleId,
+	    ModuleStatus, ModuleResults, !IO),
+	!:Info = (!.Info
+		^ module_statuses ^ elem(ModuleId) := ModuleStatus)
+		^ old_analysis_results ^ elem(ModuleId) := ModuleResults
+    ).
+
+:- pred ensure_old_imdg_loaded(module_id::in, analysis_info::in,
+	analysis_info::out, io::di, io::uo) is det.
+
+ensure_old_imdg_loaded(ModuleId, !Info, !IO) :-
+    Map0 = !.Info ^ old_imdg,
+    (if map.search(Map0, ModuleId, _) then
+	% already loaded
+	true
+    else
+	read_module_imdg(!.Info, ModuleId, IMDG, !IO),
+	map.det_insert(Map0, ModuleId, IMDG, Map),
+	!:Info = !.Info ^ old_imdg := Map
+    ).
+
+%-----------------------------------------------------------------------------%
+
+    % In this procedure we have just finished compiling module ModuleId
+    % and will write out data currently cached in the analysis_info
+    % structure out to disk.
+    % 
+write_analysis_files(ModuleId, ImportedModuleIds, !Info, !IO) :-
+    % The current module was just compiled so we set its status to the
+    % lub of all the new analysis results generated.
+    (if NewResults = !.Info ^ new_analysis_results ^ elem(ModuleId) then
+	ModuleStatus = lub_result_statuses(NewResults)
+    else
+	ModuleStatus = optimal
+    ),
+
+    update_analysis_registry(!Info, !IO),
+
+    !:Info = !.Info ^ module_statuses ^ elem(ModuleId) := ModuleStatus,
+
+    update_intermodule_dependencies(ModuleId, ImportedModuleIds,
+	!Info, !IO),
+    (if map.is_empty(!.Info ^ new_analysis_results) then
+	true
+    else
+	io.print("Warning: new_analysis_results is not empty\n", !IO),
+	io.print(!.Info ^ new_analysis_results, !IO),
+	io.nl(!IO)
+    ),
+
+    % Write the results for all the modules we know of.  For the
+    % module being compiled, its analysis results may have changed.
+    % For other modules, their overall statuses may have changed.
+    map.foldl(write_analysis_files_2(!.Info),
+	!.Info ^ old_analysis_results, !IO),
+
+    % Write the requests for the imported modules.
+    map.foldl(write_module_analysis_requests(!.Info),
+	!.Info ^ analysis_requests, !IO),
+
+    % Remove the requests for the current module since we (should have)
+    % fulfilled them in this pass.
+    empty_request_file(!.Info, ModuleId, !IO),
+
+    % Write the intermodule dependency graphs.
+    map.foldl(write_module_imdg(!.Info), !.Info ^ old_imdg, !IO).
+
+:- pred write_analysis_files_2(analysis_info::in, module_id::in,
+	module_analysis_map(analysis_result)::in, io::di, io::uo) is det.
+
+write_analysis_files_2(Info, ModuleId, ModuleResults, !IO) :-
+    ModuleStatus = Info ^ module_statuses ^ det_elem(ModuleId),
+    write_module_analysis_results(Info, ModuleId,
+	ModuleStatus, ModuleResults, !IO).
+
+%-----------------------------------------------------------------------------%
+
+lub(StatusA, StatusB) = Status :-
+    compare(Cmp, StatusA, StatusB),
+    (
+	Cmp = (=),
+	Status = StatusA
+    ;
+	Cmp = (<),
+	Status = StatusA
+    ;
+	Cmp = (>),
+	Status = StatusB
+    ).
+
+:- func lub_result_statuses(module_analysis_map(analysis_result))
+	= analysis_status.
+:- func lub_result_statuses_2(analysis_name,
+	func_analysis_map(analysis_result), analysis_status) = analysis_status.
+:- func lub_result_statuses_3(func_id, list(analysis_result), analysis_status)
+	= analysis_status.
+:- func lub_result_statuses_4(analysis_result, analysis_status)
+	= analysis_status.
+
+lub_result_statuses(ModuleMap) =
+    map.foldl(lub_result_statuses_2, ModuleMap, optimal).
+lub_result_statuses_2(_AnalysisName, FuncMap, Acc) =
+    map.foldl(lub_result_statuses_3, FuncMap, Acc).
+lub_result_statuses_3(_FuncId, Results, Acc) =
+    list.foldl(lub_result_statuses_4, Results, Acc).
+lub_result_statuses_4(analysis_result(_, _, Status), Acc) =
+    lub(Status, Acc).
+
+%-----------------------------------------------------------------------------%
 
-	empty_request_file(Info, ModuleId, !IO).
+% XXX make this enableable with a command-line option.  A problem is that we
+% don't want to make the analysis directory dependent on anything in the
+% compiler directory.
+
+:- pred debug_msg(pred(io, io)::in(pred(di, uo) is det), io::di, io::uo)
+    is det.
+
+debug_msg(_P, !IO) :-
+    % P(!IO),
+    true.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list