[m-rev.] for review: minimal model tabling analysis
Julien Fischer
juliensf at cs.mu.OZ.AU
Mon Mar 13 14:05:51 AEDT 2006
For review by Zoltan.
Estimated hours taken: 9
Branches: main
Add a first draft of an analysis that determines what procedures might call
code that uses minimal model tabling. We can use this information to avoid
adding redundant pneg context wrappers during code generation. This reduces
the overhead of minimal model tabling.
Add two new foreign_proc attributes: `may_call_mm_tabled' and
`will_not_call_mm_tabled' that can be used for annotating foreign_procs that
may call mercury with information about whether they may call minimal model
tabled procedures.
Fix a minor bug with trail usage analysis: we weren't handling unsafe casts
correctly during the second phase of the analysis.
TODO:
- documentation
- list of things in comments at the head of tabling_analysis.m.
- test with the intermodule-analysis framework
compiler/tabling_analysis.m:
New file. This module contains code for the new analysis.
It is similar to trail usage analysis.
compiler/transform_hlds.m:
Include the new module.
compiler/options.m:
Add a new option `--analyse-mm-tabling' that enables the new analysis
and optimization.
Delete a now redundant comment about the `--optimize-trail-usage'
option. That option is now controlled by the `--analyse-trail-usage'
option.
Fix some bad indentation.
compiler/mercury_compile.m:
Add the analysis.
Rearrange the stage numbers after stage 190 since we are running out
of room between 190-200.
compiler/hlds_module.m:
Add a slot in the HLDS to store information about which procedures
might call minimal model tabled procedures.
compiler/prog_data.m:
Add support for the new foreign_proc attributes: `may_call_mm_tabled'
and `will_not_call_mm_tabled'.
compiler/mmc_analysis.m:
Allow the new analysis to be use within the intermodule-analysis
framework.
compiler/prog_item.m:
compiler/add_pragma.m:
compiler/prog_io_pragma.m:
compiler/mercury_to_mercury.m:
compiler/trans_opt.m:
Add a new pragma, mm_tabling_info, for use in .opt and .trans_opt
files.
compiler/hlds_goal.m:
Add a new goal feature that indicates that a goal does not
call minimal model tabled procedures.
compiler/ite_gen.m:
Don't emit pneg context wrappers for goals that cannot call
minimal model tabled procedures.
compiler/trailing_analysis.m:
Unrelated change: fix the handling of unsafe casts during the
second pass of this analysis.
compiler/module_qual.m:
compiler/modules.m:
compiler/recompilation.version.m:
compiler/saved_vars.m:
Minor changes to conform to the above.
Julien.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.25
diff -u -r1.25 add_pragma.m
--- compiler/add_pragma.m 8 Mar 2006 02:25:30 -0000 1.25
+++ compiler/add_pragma.m 9 Mar 2006 05:34:56 -0000
@@ -252,6 +252,18 @@
TrailingStatus, Context, !ModuleInfo, !IO)
)
;
+ Pragma = mm_tabling_info(PredOrFunc, SymName, Arity, ModeNum,
+ MM_TablingStatus),
+ ( ImportStatus \= opt_imported ->
+ module_info_incr_errors(!ModuleInfo),
+ Pieces =
+ [words("Error: illegal use of pragma `mm_tabling_info',")],
+ write_error_pieces(Context, 0, Pieces, !IO)
+ ;
+ add_pragma_mm_tabling_info(PredOrFunc, SymName, Arity, ModeNum,
+ MM_TablingStatus, Context, !ModuleInfo, !IO)
+ )
+ ;
% Handle pragma type_spec decls later on (when we process clauses).
Pragma = type_spec(_, _, _, _, _, _, _, _)
;
@@ -584,6 +596,36 @@
%-----------------------------------------------------------------------------%
+:- pred add_pragma_mm_tabling_info(pred_or_func::in, sym_name::in, arity::in,
+ mode_num::in, mm_tabling_status::in, prog_context::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+add_pragma_mm_tabling_info(PredOrFunc, SymName, Arity, ModeNum,
+ TablingStatus, _Context, !ModuleInfo, !IO) :-
+ module_info_get_predicate_table(!.ModuleInfo, Preds),
+ (
+ predicate_table_search_pf_sym_arity(Preds, is_fully_qualified,
+ PredOrFunc, SymName, Arity, [PredId])
+ ->
+ some [!TablingInfo] (
+ module_info_get_mm_tabling_info(!.ModuleInfo, !:TablingInfo),
+ proc_id_to_int(ProcId, ModeNum),
+ svmap.set(proc(PredId, ProcId),
+ proc_mm_tabling_info(TablingStatus, no), !TablingInfo),
+ module_info_set_mm_tabling_info(!.TablingInfo, !ModuleInfo)
+ )
+ ;
+ % XXX We'll just ignore this for the time being -
+ % it causes errors with transitive-intermodule optimization.
+ %prog_out__write_context(Context, !IO),
+ %io__write_string("Internal compiler error: " ++
+ % "unknown predicate in `pragma trailing_info'.\n", !IO),
+ %module_info_incr_errors(!ModuleInfo)
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+
add_pragma_type_spec(Pragma, Context, !ModuleInfo, !QualInfo, !IO) :-
Pragma = type_spec(SymName, _, Arity, MaybePredOrFunc, _, _, _, _),
module_info_get_predicate_table(!.ModuleInfo, Preds),
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.152
diff -u -r1.152 hlds_goal.m
--- compiler/hlds_goal.m 9 Mar 2006 04:56:32 -0000 1.152
+++ compiler/hlds_goal.m 9 Mar 2006 06:41:55 -0000
@@ -1017,6 +1017,14 @@
% is safe for the compiler to omit trailing
% primitives when generating code for this goal.
+
+ ; cannot_call_mm_tabled
+ % This goal will never call a procedure that
+ % is evaluted using minimal model tabling. It
+ % is safe for the code generator to omit the
+ % pneg context wrappers when generating code for
+ % this goal.
+
; promise_same_deconstruct.
% This goal is a deconstruction unification
% occurring in a promise_same_conj conjunction,
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.131
diff -u -r1.131 hlds_module.m
--- compiler/hlds_module.m 9 Mar 2006 04:56:33 -0000 1.131
+++ compiler/hlds_module.m 9 Mar 2006 06:43:00 -0000
@@ -121,6 +121,18 @@
proc_maybe_trail_analysis_status :: maybe(analysis_status)
).
+ % Map from a proc to a indication of whether or not it (or one of
+ % its subgoals) calls a procedure that is tabled using minimal
+ % model tabling.
+ %
+:- type mm_tabling_info == map(pred_proc_id, proc_mm_tabling_info).
+
+:- type proc_mm_tabling_info
+ ---> proc_mm_tabling_info(
+ proc_mm_tabling_status :: mm_tabling_status,
+ proc_maybe_mm_tabling_analysis_status :: maybe(analysis_status)
+ ).
+
% List of procedures for which there are user-requested type
% specializations, and a list of predicates which should be
% processed by higher_order.m to ensure the production of those
@@ -371,6 +383,9 @@
:- pred module_info_get_trailing_info(module_info::in, trailing_info::out)
is det.
+:- pred module_info_get_mm_tabling_info(module_info::in, mm_tabling_info::out)
+ is det.
+
:- pred module_info_set_proc_requests(proc_requests::in,
module_info::in, module_info::out) is det.
@@ -383,6 +398,9 @@
:- pred module_info_set_trailing_info(trailing_info::in,
module_info::in, module_info::out) is det.
+:- pred module_info_set_mm_tabling_info(mm_tabling_info::in,
+ module_info::in, module_info::out) is det.
+
:- pred module_info_set_num_errors(int::in, module_info::in, module_info::out)
is det.
@@ -646,6 +664,10 @@
% NOTE: this includes opt_imported procedures.
trailing_info :: trailing_info,
+ % Information about whether procedure in the current module
+ % call
+ mm_tabling_info :: mm_tabling_info,
+
% How many lambda expressions there are at different contexts
% in the module. This is used to uniquely identify lambda
% expressions that appear on the same line of the same file.
@@ -703,6 +725,7 @@
map.init(UnusedArgInfo),
map.init(ExceptionInfo),
map.init(TrailingInfo),
+ map.init(MM_TablingInfo),
set.init(TypeSpecPreds),
set.init(TypeSpecForcePreds),
@@ -727,7 +750,7 @@
map.init(NoTagTypes),
ModuleSubInfo = module_sub_info(Name, Globals, no, [], [], [], [], no, 0,
[], [], StratPreds, UnusedArgInfo, ExceptionInfo, TrailingInfo,
- map.init, counter.init(1), ImportedModules,
+ MM_TablingInfo, map.init, counter.init(1), ImportedModules,
IndirectlyImportedModules, TypeSpecInfo, NoTagTypes, no, [],
init_analysis_info(mmc), [], []),
ModuleInfo = module_info(ModuleSubInfo, PredicateTable, Requests,
@@ -801,6 +824,7 @@
module_info_get_unused_arg_info(MI, MI ^ sub_info ^ unused_arg_info).
module_info_get_exception_info(MI, MI ^ sub_info ^ exception_info).
module_info_get_trailing_info(MI, MI ^ sub_info ^ trailing_info).
+module_info_get_mm_tabling_info(MI, MI ^ sub_info ^ mm_tabling_info).
module_info_get_lambdas_per_context(MI, MI ^ sub_info ^ lambdas_per_context).
module_info_get_model_non_pragma_counter(MI,
MI ^ sub_info ^ model_non_pragma_counter).
@@ -902,6 +926,8 @@
MI ^ sub_info ^ exception_info := NewVal).
module_info_set_trailing_info(NewVal, MI,
MI ^ sub_info ^ trailing_info := NewVal).
+module_info_set_mm_tabling_info(NewVal, MI,
+ MI ^ sub_info ^ mm_tabling_info := NewVal).
module_info_set_lambdas_per_context(NewVal, MI,
MI ^ sub_info ^ lambdas_per_context := NewVal).
module_info_set_model_non_pragma_counter(NewVal, MI,
Index: compiler/ite_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ite_gen.m,v
retrieving revision 1.86
diff -u -r1.86 ite_gen.m
--- compiler/ite_gen.m 28 Nov 2005 04:11:43 -0000 1.86
+++ compiler/ite_gen.m 10 Mar 2006 04:44:00 -0000
@@ -409,6 +409,8 @@
UseMinimalModelStackCopyPNeg),
(
UseMinimalModelStackCopyPNeg = yes,
+ not goal_info_has_feature(GoalInfo, cannot_call_mm_tabled)
+ ->
goal_info_get_context(GoalInfo, Context),
term__context_file(Context, File),
term__context_line(Context, Line),
@@ -449,7 +451,6 @@
no, no, no, no, yes, yes) - ""
])
;
- UseMinimalModelStackCopyPNeg = no,
PNegCondCode = empty,
PNegThenCode = empty,
PNegElseCode = empty
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.378
diff -u -r1.378 mercury_compile.m
--- compiler/mercury_compile.m 23 Feb 2006 09:36:56 -0000 1.378
+++ compiler/mercury_compile.m 9 Mar 2006 02:41:14 -0000
@@ -75,6 +75,7 @@
:- import_module transform_hlds.term_constr_main.
:- import_module transform_hlds.exception_analysis.
:- import_module transform_hlds.trailing_analysis.
+:- import_module transform_hlds.tabling_analysis.
:- import_module transform_hlds.higher_order.
:- import_module transform_hlds.accumulator.
:- import_module transform_hlds.tupling.
@@ -2042,6 +2043,8 @@
ClosureAnalysis),
globals__lookup_bool_option(Globals, analyse_trail_usage,
TrailingAnalysis),
+ globals__lookup_bool_option(Globals, analyse_mm_tabling,
+ MM_TablingAnalysis),
(
MakeOptInt = yes,
intermod__write_optfile(!HLDS, !IO),
@@ -2057,6 +2060,7 @@
; ExceptionAnalysis = yes
; TrailingAnalysis = yes
; SharingAnalysis = yes
+ ; MM_TablingAnalysis = yes
)
->
frontend_pass_by_phases(!HLDS, FoundModeError, !DumpInfo, !IO),
@@ -2097,17 +2101,23 @@
Termination2 = no
),
(
+ TrailingAnalysis = yes,
+ maybe_analyse_trail_usage(Verbose, Stats, !HLDS, !IO)
+ ;
+ TrailingAnalysis = no
+ ),
+ (
+ MM_TablingAnalysis = yes,
+ maybe_analyse_mm_tabling(Verbose, Stats, !HLDS, !IO)
+ ;
+ MM_TablingAnalysis = no
+ ),
+ (
SharingAnalysis = yes,
maybe_structure_sharing_analysis(Verbose, Stats,
!HLDS, !IO)
;
SharingAnalysis = no
- ),
- (
- TrailingAnalysis = yes,
- maybe_analyse_trail_usage(Verbose, Stats, !HLDS, !IO)
- ;
- TrailingAnalysis = no
)
;
io__set_exit_status(1, !IO)
@@ -2174,8 +2184,10 @@
maybe_dump_hlds(!.HLDS, 121, "termination_2", !DumpInfo, !IO),
maybe_analyse_trail_usage(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 167, "trail_usage", !DumpInfo, !IO),
+ maybe_analyse_mm_tabling(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 200, "mm_tabling_analysis", !DumpInfo, !IO),
maybe_structure_sharing_analysis(Verbose, Stats, !HLDS, !IO),
- maybe_dump_hlds(!.HLDS, 193, "structure_sharing", !DumpInfo, !IO),
+ maybe_dump_hlds(!.HLDS, 210, "structure_sharing", !DumpInfo, !IO),
trans_opt__write_optfile(!.HLDS, !IO).
:- pred output_analysis_file(module_name::in,
@@ -2384,10 +2396,13 @@
maybe_dump_hlds(!.HLDS, 175, "lco", !DumpInfo, !IO),
maybe_eliminate_dead_procs(Verbose, Stats, !HLDS, !IO),
- maybe_dump_hlds(!.HLDS, 192, "dead_procs", !DumpInfo, !IO),
+ maybe_dump_hlds(!.HLDS, 190, "dead_procs", !DumpInfo, !IO),
+
+ maybe_analyse_mm_tabling(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 200, "mm_tabling_analysis", !DumpInfo, !IO),
maybe_structure_sharing_analysis(Verbose, Stats, !HLDS, !IO),
- maybe_dump_hlds(!.HLDS, 193, "structure_sharing", !DumpInfo, !IO),
+ maybe_dump_hlds(!.HLDS, 210, "structure_sharing", !DumpInfo, !IO),
% If we are compiling in a deep profiling grade then now rerun simplify.
% The reason for doing this now is that we want to take advantage of any
@@ -2397,26 +2412,26 @@
%
simplify(no, pre_prof_transforms, Verbose, Stats,
process_all_nonimported_procs, !HLDS, !IO),
- maybe_dump_hlds(!.HLDS, 197, "pre_prof_transform_simplify", !DumpInfo,
+ maybe_dump_hlds(!.HLDS, 215, "pre_prof_transform_simplify", !DumpInfo,
!IO),
% The term size profiling transformation should be after all
% transformations that construct terms of non-zero size. (Deep profiling
% does not construct non-zero size terms.)
maybe_term_size_prof(Verbose, Stats, !HLDS, !IO),
- maybe_dump_hlds(!.HLDS, 200, "term_size_prof", !DumpInfo, !IO),
+ maybe_dump_hlds(!.HLDS, 220, "term_size_prof", !DumpInfo, !IO),
% Deep profiling transformation should be done late in the piece
% since it munges the code a fair amount and introduces strange
% disjunctions that might confuse other hlds->hlds transformations.
maybe_deep_profiling(Verbose, Stats, !HLDS, !IO),
- maybe_dump_hlds(!.HLDS, 205, "deep_profiling", !DumpInfo, !IO),
+ maybe_dump_hlds(!.HLDS, 225, "deep_profiling", !DumpInfo, !IO),
% Experimental complexity transformation should be done late in the
% piece for the same reason as deep profiling. At the moment, they are
% exclusive.
maybe_experimental_complexity(Verbose, Stats, !HLDS, !IO),
- maybe_dump_hlds(!.HLDS, 210, "complexity", !DumpInfo, !IO),
+ maybe_dump_hlds(!.HLDS, 230, "complexity", !DumpInfo, !IO),
maybe_dump_hlds(!.HLDS, 299, "middle_pass", !DumpInfo, !IO).
@@ -2824,10 +2839,28 @@
),
maybe_report_stats(Stats, !IO).
-:- pred mercury_compile.maybe_closure_analysis(bool::in, bool::in,
+:- pred maybe_analyse_mm_tabling(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+maybe_analyse_mm_tabling(Verbose, Stats, !HLDS, !IO) :-
+ globals.io_lookup_bool_option(analyse_mm_tabling, MM_TablingAnalysis,
+ !IO),
+ (
+ % XXX we should only enable this in .mm grades ... but no yet.
+ MM_TablingAnalysis = yes,
+ maybe_write_string(Verbose, "% Analysing minimal model tabling...\n",
+ !IO),
+ analyse_mm_tabling_in_module(!HLDS, !IO),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ;
+ MM_TablingAnalysis = no
+ ).
+
+:- pred maybe_closure_analysis(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
-mercury_compile.maybe_closure_analysis(Verbose, Stats, !HLDS, !IO) :-
+maybe_closure_analysis(Verbose, Stats, !HLDS, !IO) :-
globals.io_lookup_bool_option(analyse_closures, ClosureAnalysis,
!IO),
(
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.284
diff -u -r1.284 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 8 Mar 2006 02:25:32 -0000 1.284
+++ compiler/mercury_to_mercury.m 9 Mar 2006 02:47:32 -0000
@@ -161,6 +161,9 @@
:- pred mercury_output_pragma_trailing_info(pred_or_func::in, sym_name::in,
arity::in, mode_num::in, trailing_status::in, io::di, io::uo) is det.
+:- pred mercury_output_pragma_mm_tabling_info(pred_or_func::in, sym_name::in,
+ arity::in, mode_num::in, mm_tabling_status::in, io::di, io::uo) is det.
+
% Output the given foreign_decl declaration.
%
:- pred mercury_output_pragma_foreign_decl(foreign_language::in,
@@ -609,6 +612,11 @@
mercury_output_pragma_trailing_info(PredOrFunc, PredName, Arity,
ModeNum, TrailingStatus, !IO)
;
+ Pragma = mm_tabling_info(PredOrFunc, PredName, Arity, ModeNum,
+ MM_TablingStatus),
+ mercury_output_pragma_mm_tabling_info(PredOrFunc, PredName, Arity,
+ ModeNum, MM_TablingStatus, !IO)
+ ;
Pragma = fact_table(Pred, Arity, FileName),
mercury_format_pragma_fact_table(Pred, Arity, FileName, !IO)
;
@@ -3321,6 +3329,31 @@
%-----------------------------------------------------------------------------%
+mercury_output_pragma_mm_tabling_info(PredOrFunc, SymName, Arity, ModeNum,
+ MM_TablingStatus, !IO) :-
+ io.write_string(":- pragma mm_tabling_info(", !IO),
+ write_pred_or_func(PredOrFunc, !IO),
+ io.write_string(", ", !IO),
+ mercury_output_bracketed_sym_name(SymName, !IO),
+ io.write_string(", ", !IO),
+ io.write_int(Arity, !IO),
+ io.write_string(", ", !IO),
+ io.write_int(ModeNum, !IO),
+ io.write_string(", ", !IO),
+ (
+ MM_TablingStatus = mm_tabled_may_call,
+ io.write_string("mm_tabled_may_call", !IO)
+ ;
+ MM_TablingStatus = mm_tabled_will_not_call,
+ io.write_string("mm_tabled_will_not_call", !IO)
+ ;
+ MM_TablingStatus = mm_tabled_conditional,
+ io.write_string("mm_tabled_conditional", !IO)
+ ),
+ io.write_string(").\n", !IO).
+
+%-----------------------------------------------------------------------------%
+
mercury_output_pragma_decl(PredName, Arity, PredOrFunc, PragmaName, MaybeAfter,
!IO) :-
mercury_format_pragma_decl(PredName, Arity, PredOrFunc, PragmaName,
Index: compiler/mmc_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mmc_analysis.m,v
retrieving revision 1.13
diff -u -r1.13 mmc_analysis.m
--- compiler/mmc_analysis.m 17 Feb 2006 07:59:28 -0000 1.13
+++ compiler/mmc_analysis.m 9 Mar 2006 02:57:10 -0000
@@ -50,6 +50,7 @@
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
:- import_module transform_hlds.exception_analysis.
+:- import_module transform_hlds.tabling_analysis.
:- import_module transform_hlds.trailing_analysis.
:- import_module transform_hlds.unused_args.
@@ -64,6 +65,11 @@
:- instance compiler(mmc) where [
compiler_name(mmc) = "mmc",
+ analyses(mmc, "mm_tabling_analysis") =
+ 'new analysis_type'(
+ unit1 : unit(any_call),
+ unit1 : unit(mm_tabling_analysis_answer)),
+
analyses(mmc, "trail_usage") =
'new analysis_type'(
unit1 : unit(any_call),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.127
diff -u -r1.127 module_qual.m
--- compiler/module_qual.m 8 Mar 2006 02:25:33 -0000 1.127
+++ compiler/module_qual.m 9 Mar 2006 02:48:22 -0000
@@ -1083,6 +1083,7 @@
qualify_pragma(X at unused_args(_, _, _, _, _), X, !Info, !IO).
qualify_pragma(X at exceptions(_, _, _, _, _), X, !Info, !IO).
qualify_pragma(X at trailing_info(_, _, _, _, _), X, !Info, !IO).
+qualify_pragma(X at mm_tabling_info(_, _, _, _, _), X, !Info, !IO).
qualify_pragma(type_spec(A, B, C, D, MaybeModes0, Subst0, G, H),
type_spec(A, B, C, D, MaybeModes, Subst, G, H),
!Info, !IO) :-
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.379
diff -u -r1.379 modules.m
--- compiler/modules.m 8 Mar 2006 02:25:33 -0000 1.379
+++ compiler/modules.m 9 Mar 2006 02:50:56 -0000
@@ -2114,6 +2114,7 @@
pragma_allowed_in_interface(unused_args(_, _, _, _, _), no).
pragma_allowed_in_interface(exceptions(_, _, _, _, _), no).
pragma_allowed_in_interface(trailing_info(_, _, _, _, _), no).
+pragma_allowed_in_interface(mm_tabling_info(_, _, _, _, _), no).
pragma_allowed_in_interface(type_spec(_, _, _, _, _, _, _, _), yes).
pragma_allowed_in_interface(termination_info(_, _, _, _, _), yes).
pragma_allowed_in_interface(termination2_info(_,_, _, _, _, _), yes).
@@ -7621,6 +7622,7 @@
; Pragma = does_not_terminate(_, _), Reorderable = yes
; Pragma = exceptions(_, _, _, _, _), Reorderable = yes
; Pragma = trailing_info(_, _, _, _, _), Reorderable = yes
+ ; Pragma = mm_tabling_info(_, _, _, _, _), Reorderable = yes
; Pragma = export(_, _, _, _), Reorderable = yes
; Pragma = fact_table(_, _, _), Reorderable = no
; Pragma = foreign_code(_, _), Reorderable = no
@@ -7723,6 +7725,7 @@
; Pragma = termination_info(_, _, _, _, _), Reorderable = yes
; Pragma = structure_sharing(_, _, _, _, _, _), Reorderable = yes
; Pragma = trailing_info(_, _, _, _, _), Reorderable = yes
+ ; Pragma = mm_tabling_info(_, _, _, _, _), Reorderable = yes
; Pragma = type_spec(_, _, _, _, _, _, _, _), Reorderable = yes
; Pragma = unused_args(_, _, _, _, _), Reorderable = yes
).
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.503
diff -u -r1.503 options.m
--- compiler/options.m 3 Mar 2006 07:59:47 -0000 1.503
+++ compiler/options.m 10 Mar 2006 04:57:11 -0000
@@ -140,6 +140,7 @@
; debug_trail_usage
; debug_mode_constraints
; debug_intermodule_analysis
+ ; debug_mm_tabling_analysis
% Output options
; make_short_interface
@@ -540,6 +541,7 @@
; analyse_closures
; analyse_trail_usage
; optimize_trail_usage
+ ; analyse_mm_tabling
; untuple
; tuple
; tuple_trace_counts_file
@@ -880,7 +882,8 @@
debug_closure - bool(no),
debug_trail_usage - bool(no),
debug_mode_constraints - bool(no),
- debug_intermodule_analysis - bool(no)
+ debug_intermodule_analysis - bool(no),
+ debug_mm_tabling_analysis - bool(no)
]).
option_defaults_2(output_option, [
% Output Options (mutually exclusive)
@@ -1159,9 +1162,8 @@
analyse_exceptions - bool(no),
analyse_closures - bool(no),
analyse_trail_usage - bool(no),
- % XXX Change this to yes when trailing analysis is
- % complete.
- optimize_trail_usage - bool(no)
+ optimize_trail_usage - bool(no),
+ analyse_mm_tabling - bool(no)
]).
option_defaults_2(optimization_option, [
% Optimization options
@@ -1579,10 +1581,10 @@
long_option("debug-trail-usage", debug_trail_usage).
long_option("debug-mode-constraints", debug_mode_constraints).
long_option("debug-intermodule-analysis", debug_intermodule_analysis).
+long_option("debug-mm-tabling-analysis", debug_mm_tabling_analysis).
% output options (mutually exclusive)
-long_option("generate-source-file-mapping",
- generate_source_file_mapping).
+long_option("generate-source-file-mapping", generate_source_file_mapping).
long_option("generate-dependency-file", generate_dependency_file).
long_option("generate-dependencies", generate_dependencies).
long_option("generate-module-order", generate_module_order).
@@ -1596,9 +1598,9 @@
long_option("make-optimisation-interface", make_optimization_interface).
long_option("make-opt-int", make_optimization_interface).
long_option("make-transitive-optimization-interface",
- make_transitive_opt_interface).
+ make_transitive_opt_interface).
long_option("make-transitive-optimisation-interface",
- make_transitive_opt_interface).
+ make_transitive_opt_interface).
long_option("make-trans-opt", make_transitive_opt_interface).
long_option("make-analysis-registry", make_analysis_registry).
long_option("convert-to-mercury", convert_to_mercury).
@@ -1617,7 +1619,7 @@
long_option("smart-recompilation", smart_recompilation).
long_option("assume-gmake", assume_gmake).
long_option("generate-mmc-make-module-dependencies",
- generate_mmc_make_module_dependencies).
+ generate_mmc_make_module_dependencies).
long_option("generate-mmc-deps", generate_mmc_make_module_dependencies).
long_option("trace", trace).
long_option("trace-optimised", trace_optimized).
@@ -1960,7 +1962,7 @@
long_option("analyse-local-closures", analyse_closures).
long_option("analyse-trail-usage", analyse_trail_usage).
long_option("optimize-trail-usage", optimize_trail_usage).
-long_option("optimise-trail-usage", optimize_trail_usage).
+long_option("analyse-mm-tabling", analyse_mm_tabling).
long_option("untuple", untuple).
long_option("tuple", tuple).
long_option("tuple-trace-counts-file", tuple_trace_counts_file).
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.156
diff -u -r1.156 prog_data.m
--- compiler/prog_data.m 27 Feb 2006 08:05:20 -0000 1.156
+++ compiler/prog_data.m 10 Mar 2006 03:37:09 -0000
@@ -405,6 +405,16 @@
%-----------------------------------------------------------------------------%
%
+% Stuff for minimal model tabling analysis
+%
+
+:- type mm_tabling_status
+ ---> mm_tabled_may_call
+ ; mm_tabled_will_not_call
+ ; mm_tabled_conditional.
+
+%-----------------------------------------------------------------------------%
+%
% Stuff for the `type_spec' pragma
%
@@ -598,6 +608,8 @@
may_throw_exception.
:- func ordinary_despite_detism(pragma_foreign_proc_attributes) = bool.
:- func may_modify_trail(pragma_foreign_proc_attributes) = may_modify_trail.
+:- func may_call_mm_tabled(pragma_foreign_proc_attributes) =
+ may_call_mm_tabled.
:- func box_policy(pragma_foreign_proc_attributes) = box_policy.
:- func extra_attributes(pragma_foreign_proc_attributes)
= pragma_foreign_proc_extra_attributes.
@@ -642,6 +654,10 @@
pragma_foreign_proc_attributes::in,
pragma_foreign_proc_attributes::out) is det.
+:- pred set_may_call_mm_tabled(may_call_mm_tabled::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
:- pred set_box_policy(box_policy::in,
pragma_foreign_proc_attributes::in,
pragma_foreign_proc_attributes::out) is det.
@@ -679,6 +695,20 @@
---> may_modify_trail
; will_not_modify_trail.
+:- type may_call_mm_tabled
+ ---> may_call_mm_tabled
+ % The foreign code may make callbacks to minimal model tabled
+ % procedures.
+
+ ; will_not_call_mm_tabled
+ % The foreign code may make callbacks to Mercury, but they will
+ % not be to minimal model tabled code.
+
+ ; default_calls_mm_tabled.
+ % If either of the above are not specified:
+ % - for `will_not_call_mercury' set `will_not_call_mm_tabled'
+ % - for `may_call_mercury' set `may_call_mm_tabled'
+
:- type pragma_var
---> pragma_var(prog_var, string, mer_mode, box_policy).
% variable, name, mode
@@ -1372,6 +1402,7 @@
legacy_purity_behaviour :: bool,
ordinary_despite_detism :: bool,
may_modify_trail :: may_modify_trail,
+ may_call_mm_tabled :: may_call_mm_tabled,
box_policy :: box_policy,
extra_attributes ::
list(pragma_foreign_proc_extra_attribute)
@@ -1381,7 +1412,7 @@
attributes(Language, may_call_mercury, not_thread_safe,
not_tabled_for_io, purity_impure, depends_on_mercury_calls,
default_exception_behaviour, no, no, may_modify_trail,
- native_if_possible, []).
+ default_calls_mm_tabled, native_if_possible, []).
set_may_call_mercury(MayCallMercury, Attrs0, Attrs) :-
Attrs = Attrs0 ^ may_call_mercury := MayCallMercury.
@@ -1403,6 +1434,8 @@
Attrs = Attrs0 ^ ordinary_despite_detism := OrdinaryDespiteDetism.
set_may_modify_trail(MayModifyTrail, Attrs0, Attrs) :-
Attrs = Attrs0 ^ may_modify_trail := MayModifyTrail.
+set_may_call_mm_tabled(MayCallMM_Tabled, Attrs0, Attrs) :-
+ Attrs = Attrs0 ^ may_call_mm_tabled := MayCallMM_Tabled.
set_box_policy(BoxPolicyStr, Attrs0, Attrs) :-
Attrs = Attrs0 ^ box_policy := BoxPolicyStr.
@@ -1412,7 +1445,8 @@
% is at the start of the pragma.
Attrs = attributes(_Lang, MayCallMercury, ThreadSafe, TabledForIO,
Purity, Terminates, Exceptions, _LegacyBehaviour,
- OrdinaryDespiteDetism, MayModifyTrail, BoxPolicy, ExtraAttributes),
+ OrdinaryDespiteDetism, MayModifyTrail, MayCallMM_Tabled,
+ BoxPolicy, ExtraAttributes),
(
MayCallMercury = may_call_mercury,
MayCallMercuryStr = "may_call_mercury"
@@ -1485,6 +1519,16 @@
MayModifyTrailStrList = ["will_not_modify_trail"]
),
(
+ MayCallMM_Tabled = may_call_mm_tabled,
+ MayCallMM_TabledStrList = ["may_call_mm_tabled"]
+ ;
+ MayCallMM_Tabled = will_not_call_mm_tabled,
+ MayCallMM_TabledStrList =["will_not_call_mm_tabled"]
+ ;
+ MayCallMM_Tabled = default_calls_mm_tabled,
+ MayCallMM_TabledStrList = []
+ ),
+ (
BoxPolicy = native_if_possible,
BoxPolicyStr = []
;
@@ -1494,7 +1538,8 @@
StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr |
PurityStrList] ++ TerminatesStrList ++ ExceptionsStrList ++
OrdinaryDespiteDetismStrList ++ MayModifyTrailStrList ++
- BoxPolicyStr ++ list__map(extra_attribute_to_string, ExtraAttributes).
+ MayCallMM_TabledStrList ++ BoxPolicyStr ++
+ list__map(extra_attribute_to_string, ExtraAttributes).
add_extra_attribute(NewAttribute, Attributes0,
Attributes0 ^ extra_attributes :=
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.100
diff -u -r1.100 prog_io_pragma.m
--- compiler/prog_io_pragma.m 8 Mar 2006 02:25:34 -0000 1.100
+++ compiler/prog_io_pragma.m 9 Mar 2006 23:37:05 -0000
@@ -1204,6 +1204,47 @@
Result = error("error in `:- pragma trailing_info'", ErrorTerm)
).
+parse_pragma_type(ModuleName, "mm_tabling_info", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
+ (
+ PragmaTerms = [
+ PredOrFuncTerm,
+ PredNameTerm,
+ term.functor(term.integer(Arity), [], _),
+ term.functor(term.integer(ModeNum), [], _),
+ MM_TablingStatusTerm
+ ],
+ (
+ PredOrFuncTerm = term.functor(term.atom("predicate"), [], _),
+ PredOrFunc = predicate
+ ;
+ PredOrFuncTerm = term.functor(term.atom("function"), [], _),
+ PredOrFunc = function
+ ),
+ parse_implicitly_qualified_term(ModuleName, PredNameTerm,
+ ErrorTerm, "`:- pragma mm_tabling_info' declaration",
+ PredNameResult),
+ PredNameResult = ok(PredName, []),
+ (
+ MM_TablingStatusTerm = term.functor(
+ term.atom("mm_tabled_will_not_call"), [], _),
+ MM_TablingStatus = mm_tabled_will_not_call
+ ;
+ MM_TablingStatusTerm = term.functor(
+ term.atom("mm_tabled_may_call"), [], _),
+ MM_TablingStatus = mm_tabled_may_call
+ ;
+ MM_TablingStatusTerm = term.functor(
+ term.atom("mm_tabled_conditional"), [], _),
+ MM_TablingStatus = mm_tabled_conditional
+ )
+ ->
+ Result = ok(pragma(user, mm_tabling_info(PredOrFunc, PredName,
+ Arity, ModeNum, MM_TablingStatus)))
+ ;
+ Result = error("error in `:- pragma mm_tabling_info'", ErrorTerm)
+ ).
+
parse_pragma_type(ModuleName, "mode_check_clauses", PragmaTerms, ErrorTerm,
_VarSet, Result) :-
parse_simple_pragma(ModuleName, "mode_check_clauses",
@@ -1302,6 +1343,7 @@
; will_not_throw_exception
; ordinary_despite_detism
; may_modify_trail(may_modify_trail)
+ ; may_call_mm_tabled(may_call_mm_tabled)
; box_policy(box_policy).
:- pred parse_pragma_foreign_proc_attributes_term(foreign_language::in,
@@ -1341,6 +1383,8 @@
terminates(depends_on_mercury_calls) - terminates(does_not_terminate),
may_modify_trail(may_modify_trail) -
may_modify_trail(will_not_modify_trail),
+ may_call_mercury(will_not_call_mercury) -
+ may_call_mm_tabled(may_call_mm_tabled),
box_policy(native_if_possible) - box_policy(always_boxed)
],
(
@@ -1390,6 +1434,8 @@
set_ordinary_despite_detism(yes, !Attrs).
process_attribute(may_modify_trail(TrailMod), !Attrs) :-
set_may_modify_trail(TrailMod, !Attrs).
+process_attribute(may_call_mm_tabled(MayCallTabled), !Attrs) :-
+ set_may_call_mm_tabled(MayCallTabled, !Attrs).
process_attribute(box_policy(BoxPolicy), !Attrs) :-
set_box_policy(BoxPolicy, !Attrs).
@@ -1464,6 +1510,8 @@
Flag = ordinary_despite_detism
; parse_may_modify_trail(Term, TrailMod) ->
Flag = may_modify_trail(TrailMod)
+ ; parse_may_call_mm_tabled(Term, CallsTabled) ->
+ Flag = may_call_mm_tabled(CallsTabled)
; parse_box_policy(Term, BoxPolicy) ->
Flag = box_policy(BoxPolicy)
;
@@ -1496,6 +1544,13 @@
may_modify_trail).
parse_may_modify_trail(term.functor(term.atom("will_not_modify_trail"), [], _),
will_not_modify_trail).
+
+:- pred parse_may_call_mm_tabled(term::in, may_call_mm_tabled::out) is semidet.
+
+parse_may_call_mm_tabled(Term, may_call_mm_tabled) :-
+ Term = term.functor(term.atom("may_call_mm_tabled"), [], _).
+parse_may_call_mm_tabled(Term, will_not_call_mm_tabled) :-
+ Term = term.functor(term.atom("will_not_call_mm_tabled"), [], _).
:- pred parse_box_policy(term::in, box_policy::out) is semidet.
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.6
diff -u -r1.6 prog_item.m
--- compiler/prog_item.m 8 Mar 2006 02:25:34 -0000 1.6
+++ compiler/prog_item.m 9 Mar 2006 02:24:59 -0000
@@ -467,6 +467,16 @@
)
% PredName, Arity, Mode number, Trailing status.
% Should on appear in `.opt' or `.trans_opt' files.
+
+ ; mm_tabling_info(
+ mm_tabling_info_p_or_f :: pred_or_func,
+ mm_tabling_info_name :: sym_name,
+ mm_tabling_info_arity :: arity,
+ mm_tabling_info_mode :: mode_num,
+ mm_tabling_info_status :: mm_tabling_status
+ )
+ % PredName, Arity, Mode number, MM Tabling status.
+ % Should on appear in `.opt' or `.trans_opt' files.
%
% Diagnostics pragmas (pragmas related to compiler warnings/errors)
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.39
diff -u -r1.39 recompilation.version.m
--- compiler/recompilation.version.m 8 Mar 2006 02:25:34 -0000 1.39
+++ compiler/recompilation.version.m 9 Mar 2006 02:55:17 -0000
@@ -578,6 +578,8 @@
yes(yes(PredOrFunc) - Name / Arity)).
is_pred_pragma(trailing_info(PredOrFunc, Name, Arity, _, _),
yes(yes(PredOrFunc) - Name / Arity)).
+is_pred_pragma(mm_tabling_info(PredOrFunc, Name, Arity, _, _),
+ yes(yes(PredOrFunc) - Name / Arity)).
is_pred_pragma(fact_table(Name, Arity, _), yes(no - Name / Arity)).
is_pred_pragma(reserve_tag(_TypeName, _TypeArity), no).
is_pred_pragma(tabled(_, Name, Arity, MaybePredOrFunc, _),
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.58
diff -u -r1.58 saved_vars.m
--- compiler/saved_vars.m 24 Feb 2006 05:49:38 -0000 1.58
+++ compiler/saved_vars.m 9 Mar 2006 03:48:53 -0000
@@ -227,6 +227,7 @@
ok_to_duplicate(dont_warn_singleton) = yes.
ok_to_duplicate(mode_check_clauses_goal) = yes.
ok_to_duplicate(will_not_modify_trail) = yes.
+ok_to_duplicate(cannot_call_mm_tabled) = yes.
ok_to_duplicate(promise_same_deconstruct) = yes.
% Divide a list of goals into an initial subsequence of goals
Index: compiler/tabling_analysis.m
===================================================================
RCS file: compiler/tabling_analysis.m
diff -N compiler/tabling_analysis.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/tabling_analysis.m 13 Mar 2006 03:00:05 -0000
@@ -0,0 +1,1051 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+
+% File: tabling_analysis.m.
+% Author: juliensf.
+
+% This module contains an analysis that identifies those goals that cannot
+% call minimal model tabled procedures. We can optimize such goals by
+% omitting the pneg context wrappers during code generation (see ite_gen.m).
+% The analysis has two passes.
+
+% The first pass marks each procedure in the module as one of:
+%
+% * mm_tabled_will_not_call
+% * mm_tabled_may_call
+% * mm_tabled_conditional
+%
+% Procedures marked `mm_tabled_will_not_call' are guaranteed not to call
+% procedures that are minimal model tabled (or use minimal model tabling
+% themselves), while procedures marked `mm_tabled_may_call' may call procedures
+% that are minimal model tabled (or use it themselves).
+%
+% Procedures marked `mm_tabled_conditional' will not call minimal model tabled
+% procedure directly but may do so indirectly through either a higher-order
+% call or via a user-defined equality or comparison predicate.
+%
+% `mm_tabled_conditional' is a promise that we can determine whether the
+% procedure may call minimal model tabled predicates by only examining the the
+% values of any higher-order arguments and the types that any polymorphic
+% arguments become bound to.
+%
+% For procedures defined using the foreign language interface we rely upon
+% the foreign_proc attributes `will_not_call_mm_tabled' and
+% `may_call_mm_tabled'.
+
+% The second pass of the analysis marks individual goals with a feature
+% that indicates that they do not call minimal model tabled procedures.
+% This pass is only run when we are generating code.
+
+% TODO
+% - handle higher-order constructs
+%
+% - handle user-defined equality and comparison correctly
+% - the bits marked XXX user-defined uc need to be changed
+%
+% - XXX fix analysis of polymorphic procedures
+%
+% - don't be so conservative about calls to builtin.unify and
+% builtin.compare
+%
+
+%----------------------------------------------------------------------------%
+
+:- module transform_hlds.tabling_analysis.
+:- interface.
+
+:- import_module analysis.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+
+:- import_module io.
+
+%----------------------------------------------------------------------------%
+
+ % Analyse minimal model tabling in a module.
+ %
+:- pred analyse_mm_tabling_in_module(module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+ % Write out the mm_tabling_info pragma for this module.
+ %
+:- pred write_pragma_mm_tabling_info(module_info::in, mm_tabling_info::in,
+ pred_id::in, io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%
+% Types and instances for the intermodule analysis framework
+%
+
+:- type mm_tabling_analysis_answer.
+:- instance analysis(any_call, mm_tabling_analysis_answer).
+:- instance partial_order(mm_tabling_analysis_answer).
+:- instance answer_pattern(mm_tabling_analysis_answer).
+:- instance to_string(mm_tabling_analysis_answer).
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.mode_util.
+:- import_module check_hlds.type_util.
+:- import_module hlds.code_model.
+:- import_module hlds.hlds_error_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.make_hlds.
+:- import_module hlds.passes_aux.
+:- import_module hlds.special_pred.
+:- import_module libs.compiler_util.
+:- import_module libs.globals.
+:- import_module libs.options.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.modules.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_out.
+:- import_module parse_tree.prog_util.
+:- import_module parse_tree.prog_type.
+:- import_module transform_hlds.dependency_graph.
+:- import_module transform_hlds.mmc_analysis.
+
+:- import_module bool.
+:- import_module list.
+:- import_module map.
+:- import_module set.
+:- import_module std_util.
+:- import_module string.
+:- import_module term.
+
+%----------------------------------------------------------------------------%
+%
+% Perform minimal model tabling analysis on a module
+%
+
+analyse_mm_tabling_in_module(!ModuleInfo, !IO) :-
+ globals.io_lookup_bool_option(use_minimal_model_stack_copy,
+ UseMinimalModel, !IO),
+ (
+ % Only run the analysis in .mm grades.
+ UseMinimalModel = yes,
+ globals.io_lookup_bool_option(make_optimization_interface,
+ MakeOptInt, !IO),
+ globals.io_lookup_bool_option(make_transitive_opt_interface,
+ MakeTransOptInt, !IO),
+ % XXX why do we ignore building the analysis registry in
+ % trail_usage analysis? That looks wrong.
+ globals.io_lookup_bool_option(make_analysis_registry,
+ MakeAnalysisReg, !IO),
+ Pass1Only = MakeOptInt `bool.or` MakeTransOptInt
+ `bool.or` MakeAnalysisReg,
+ module_info_ensure_dependency_info(!ModuleInfo),
+ module_info_dependency_info(!.ModuleInfo, DepInfo),
+ hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
+ globals.io_lookup_bool_option(debug_mm_tabling_analysis, Debug, !IO),
+ list.foldl2(analyse_mm_tabling_in_scc(Debug, Pass1Only), SCCs,
+ !ModuleInfo, !IO),
+ (
+ MakeOptInt = yes,
+ make_opt_int(!.ModuleInfo, !IO)
+ ;
+ MakeOptInt = no
+ )
+ ;
+ UseMinimalModel = no
+ ).
+
+%----------------------------------------------------------------------------%
+%
+% Perform minimal model tabling analysis on a SCC
+%
+
+:- type scc == list(pred_proc_id).
+
+:- type proc_results == list(proc_result).
+
+:- type proc_result
+ ---> proc_result(
+ ppid :: pred_proc_id,
+ status :: mm_tabling_status,
+ maybe_analysis_status :: maybe(analysis_status)
+ ).
+
+:- pred analyse_mm_tabling_in_scc(bool::in, bool::in, scc::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+analyse_mm_tabling_in_scc(Debug, Pass1Only, SCC, !ModuleInfo, !IO) :-
+ %
+ % Begin by analysing each procedure in the SCC.
+ %
+ list.foldl3(check_proc_for_mm_tabling_calls(SCC), SCC, [], ProcResults,
+ !ModuleInfo, !IO),
+ combine_individual_proc_results(ProcResults, TablingStatus,
+ MaybeAnalysisStatus),
+ %
+ % Print out debugging information.
+ %
+ (
+ Debug = yes,
+ dump_mm_tabling_analysis_debug_info(!.ModuleInfo, SCC,
+ TablingStatus, !IO)
+ ;
+ Debug = no
+ ),
+ %
+ % Update the mm_tabling_info with information about this SCC.
+ %
+ module_info_get_mm_tabling_info(!.ModuleInfo, TablingInfo0),
+ Update = (pred(PPId::in, Info0::in, Info::out) is det :-
+ Info = Info0 ^ elem(PPId) :=
+ proc_mm_tabling_info(TablingStatus, MaybeAnalysisStatus)
+ ),
+ list.foldl(Update, SCC, TablingInfo0, TablingInfo),
+ module_info_set_mm_tabling_info(TablingInfo, !ModuleInfo),
+ %
+ % Record the analysis results for the intermodule analysis
+ %
+ globals.io_lookup_bool_option(make_analysis_registry,
+ MakeAnalysisRegistry, !IO),
+ (
+ MakeAnalysisRegistry = yes,
+ (
+ MaybeAnalysisStatus = yes(AnalysisStatus),
+ record_mm_tabling_analysis_results(TablingStatus, AnalysisStatus,
+ SCC, !ModuleInfo)
+ ;
+ MaybeAnalysisStatus = no,
+ unexpected(this_file, "process_scc: no analysis status")
+ )
+ ;
+ MakeAnalysisRegistry = no
+ ),
+ (
+ Pass1Only = no,
+ list.foldl2(annotate_proc, SCC, !ModuleInfo, !IO)
+ ;
+ Pass1Only = yes
+ ).
+
+ % Examine how the procedures interact with other procedures that
+ % are mutually-recursive to them.
+ %
+:- pred combine_individual_proc_results(proc_results::in,
+ mm_tabling_status::out, maybe(analysis_status)::out) is det.
+
+combine_individual_proc_results([], _, _) :-
+ unexpected(this_file, "Empty SCC during mm tabling analysis.").
+combine_individual_proc_results(ProcResults @ [_|_],
+ SCC_Result, MaybeAnalysisStatus) :-
+ (
+ % If none of the procedures calls tabled procedures or is conditional
+ % then the SCC cannot call tabled procedures.
+ all [ProcResult] list.member(ProcResult, ProcResults) =>
+ ProcResult ^ status = mm_tabled_will_not_call
+ ->
+ SCC_Result = mm_tabled_will_not_call
+ ;
+ % XXX Fix the variable names here - they don't make sense.
+ all [EResult] list.member(EResult, ProcResults) =>
+ EResult ^ status \= mm_tabled_may_call,
+ some [CResult] (
+ list.member(CResult, ProcResults),
+ CResult ^ status = mm_tabled_conditional
+ )
+ ->
+ SCC_Result = mm_tabled_conditional
+ ;
+ % Otherwise the SCC might call tabled procedures.
+ SCC_Result = mm_tabled_may_call
+ ),
+ combine_proc_result_maybe_analysis_statuses(ProcResults,
+ MaybeAnalysisStatus).
+
+:- pred combine_proc_result_maybe_analysis_statuses(proc_results::in,
+ maybe(analysis_status)::out) is det.
+
+combine_proc_result_maybe_analysis_statuses(ProcResults,
+ MaybeAnalysisStatus) :-
+ list.map(maybe_analysis_status, ProcResults, MaybeAnalysisStatuses),
+ list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
+ yes(optimal), MaybeAnalysisStatus).
+
+:- pred maybe_analysis_status(proc_result::in, maybe(analysis_status)::out)
+ is det.
+
+maybe_analysis_status(ProcResult, ProcResult ^ maybe_analysis_status).
+
+%----------------------------------------------------------------------------%
+%
+% Perform minimal model tabling analysis on a procedure
+%
+
+:- pred check_proc_for_mm_tabling_calls(scc::in,
+ pred_proc_id::in, proc_results::in, proc_results::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+check_proc_for_mm_tabling_calls(SCC, PPId, !Results, !ModuleInfo, !IO) :-
+ module_info_pred_proc_info(!.ModuleInfo, PPId, _, ProcInfo),
+ proc_info_eval_method(ProcInfo, EvalMethod),
+ ( EvalMethod = eval_minimal(_) ->
+ Result = mm_tabled_may_call,
+ MaybeAnalysisStatus = yes(optimal)
+ ;
+ proc_info_goal(ProcInfo, Body),
+ proc_info_vartypes(ProcInfo, VarTypes),
+ check_goal_for_mm_tabling_calls(SCC, VarTypes, Body,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO)
+ ),
+ list.cons(proc_result(PPId, Result, MaybeAnalysisStatus), !Results).
+
+%----------------------------------------------------------------------------%
+%
+% Perform minimal model tabling analysis of a goal
+%
+
+:- pred check_goal_for_mm_tabling_calls(scc::in, vartypes::in, hlds_goal::in,
+ mm_tabling_status::out, maybe(analysis_status)::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+check_goal_for_mm_tabling_calls(SCC, VarTypes, Goal - GoalInfo,
+ Result, MaybeStatus, !ModuleInfo, !IO) :-
+ check_goal_for_mm_tabling_calls_2(SCC, VarTypes, Goal, GoalInfo,
+ Result, MaybeStatus, !ModuleInfo, !IO).
+
+:- pred check_goal_for_mm_tabling_calls_2(scc::in,
+ vartypes::in, hlds_goal_expr::in, hlds_goal_info::in,
+ mm_tabling_status::out, maybe(analysis_status)::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+check_goal_for_mm_tabling_calls_2(_, _, Goal, _, mm_tabled_will_not_call,
+ yes(optimal), !ModuleInfo, !IO) :-
+ Goal = unify(_, _, _, Kind, _),
+ ( Kind = complicated_unify(_, _, _) ->
+ unexpected(this_file, "complicated unify during mm tabling analysis.")
+ ;
+ true
+ ).
+check_goal_for_mm_tabling_calls_2(SCC, VarTypes, Goal, _,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
+ Goal = call(CalleePredId, CalleeProcId, CallArgs, _, _, _),
+ CalleePPId = proc(CalleePredId, CalleeProcId),
+ module_info_pred_info(!.ModuleInfo, CalleePredId, CalleePredInfo),
+ (
+ % Handle (mutually-)recursive calls.
+ list.member(CalleePPId, SCC)
+ ->
+ % XXX user-defined uc - need to handle polymorphic recursion here.
+ Result = mm_tabled_will_not_call,
+ MaybeAnalysisStatus = yes(optimal)
+ ;
+ pred_info_is_builtin(CalleePredInfo)
+ ->
+ Result = mm_tabled_will_not_call,
+ MaybeAnalysisStatus = yes(optimal)
+ ;
+ % Handle builtin unify and compare.
+ %
+ % NOTE: the type specific unify and compare predicates are just
+ % treated as though they were normal predicates.
+ %
+ ModuleName = pred_info_module(CalleePredInfo),
+ any_mercury_builtin_module(ModuleName),
+ Name = pred_info_name(CalleePredInfo),
+ Arity = pred_info_orig_arity(CalleePredInfo),
+ ( SpecialPredId = spec_pred_compare
+ ; SpecialPredId = spec_pred_unify
+ ),
+ special_pred_name_arity(SpecialPredId, Name, _, Arity)
+ ->
+ % XXX user-defined uc
+ Result = mm_tabled_may_call,
+ MaybeAnalysisStatus = yes(optimal)
+ ;
+ % Handle normal calls.
+ globals.io_lookup_bool_option(intermodule_analysis, Intermod, !IO),
+ (
+ Intermod = yes,
+ pred_info_is_imported(CalleePredInfo)
+ ->
+ % Use the intermodule analysis framework if this is an imported
+ % procedure and `--intermodule-analysis' is enabled.
+ %
+ search_analysis_status(CalleePPId, Result0, AnalysisStatus, SCC,
+ !ModuleInfo, !IO),
+ ( Result0 = mm_tabled_conditional ->
+ % XXX user-defined uc
+ Result = mm_tabled_will_not_call
+ ;
+ Result = Result0
+ ),
+ MaybeAnalysisStatus = yes(AnalysisStatus)
+ ;
+ % Otherwise, the information (if we have any) will be in the
+ % mm_tabling_info table.
+ %
+ check_call_for_mm_tabling_calls(!.ModuleInfo, VarTypes,
+ CalleePPId, CallArgs, MaybeResult),
+ (
+ MaybeResult = yes(ProcTablingInfo),
+ ProcTablingInfo = proc_mm_tabling_info(Result,
+ MaybeAnalysisStatus)
+ ;
+ MaybeResult = no,
+ % If we do not have any information about the callee procedure
+ % then assume that it calls minimal model tabled procedures.
+ Result = mm_tabled_may_call,
+ (
+ Intermod = yes,
+ MaybeAnalysisStatus = yes(suboptimal)
+ ;
+ Intermod = no,
+ MaybeAnalysisStatus = no
+ )
+ )
+ )
+ ).
+check_goal_for_mm_tabling_calls_2(_, _VarTypes, Goal, _GoalInfo,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
+ Goal = generic_call(Details, _Args, _ArgModes, _),
+ (
+ % XXX use results of closure analysis here.
+ Details = higher_order(_Var, _, _, _),
+ Result = mm_tabled_may_call,
+ MaybeAnalysisStatus = yes(optimal)
+ ;
+ Details = class_method(_, _, _, _),
+ Result = mm_tabled_may_call,
+ MaybeAnalysisStatus = yes(optimal)
+ ;
+ Details = cast(_),
+ Result = mm_tabled_will_not_call,
+ MaybeAnalysisStatus = yes(optimal)
+ ).
+check_goal_for_mm_tabling_calls_2(SCC, VarTypes, not(Goal), _,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
+ check_goal_for_mm_tabling_calls(SCC, VarTypes, Goal, Result,
+ MaybeAnalysisStatus, !ModuleInfo, !IO).
+check_goal_for_mm_tabling_calls_2(SCC, VarTypes, Goal, _,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
+ Goal = scope(_, InnerGoal),
+ check_goal_for_mm_tabling_calls(SCC, VarTypes, InnerGoal, Result,
+ MaybeAnalysisStatus, !ModuleInfo, !IO).
+check_goal_for_mm_tabling_calls_2(_, _, Goal, _, Result, MaybeAnalysisStatus,
+ !ModuleInfo, !IO) :-
+ Goal = foreign_proc(Attributes, _, _, _, _, _),
+ Result = get_mm_tabling_status_from_attributes(Attributes),
+ MaybeAnalysisStatus = yes(optimal).
+check_goal_for_mm_tabling_calls_2(_, _, shorthand(_), _, _, _, !ModuleInfo,
+ !IO) :-
+ unexpected(this_file,
+ "shorthand goal encountered during mm tabling analysis.").
+check_goal_for_mm_tabling_calls_2(SCC, VarTypes, Goal, _,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
+ Goal = switch(_, _, Cases),
+ CaseGoals = list.map((func(case(_, CaseGoal)) = CaseGoal), Cases),
+ check_goals_for_mm_tabling_calls(SCC, VarTypes, CaseGoals,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO).
+check_goal_for_mm_tabling_calls_2(SCC, VarTypes, Goal, _,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
+ Goal = if_then_else(_, If, Then, Else),
+ check_goals_for_mm_tabling_calls(SCC, VarTypes, [If, Then, Else],
+ Result0, MaybeAnalysisStatus, !ModuleInfo, !IO),
+ (
+ Result0 = mm_tabled_will_not_call,
+ Result = mm_tabled_will_not_call
+ ;
+ ( Result0 = mm_tabled_conditional
+ ; Result0 = mm_tabled_may_call
+ ),
+ Result = mm_tabled_may_call
+ ).
+check_goal_for_mm_tabling_calls_2(SCC, VarTypes, Goal, _,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
+ ( Goal = conj(_, Goals)
+ ; Goal = disj(Goals)
+ ),
+ check_goals_for_mm_tabling_calls(SCC, VarTypes, Goals, Result,
+ MaybeAnalysisStatus, !ModuleInfo, !IO).
+
+:- pred check_goals_for_mm_tabling_calls(scc::in, vartypes::in,
+ hlds_goals::in, mm_tabling_status::out, maybe(analysis_status)::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+check_goals_for_mm_tabling_calls(SCC, VarTypes, Goals,
+ Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
+ list.map2_foldl2(check_goal_for_mm_tabling_calls(SCC, VarTypes), Goals,
+ Results, MaybeAnalysisStatuses, !ModuleInfo, !IO),
+ list.foldl(combine_mm_tabling_status, Results, mm_tabled_will_not_call,
+ Result),
+ list.foldl(combine_maybe_analysis_status, MaybeAnalysisStatuses,
+ yes(optimal), MaybeAnalysisStatus).
+
+%----------------------------------------------------------------------------%
+%
+% Utility procedure for processing goals
+%
+
+:- func get_mm_tabling_status_from_attributes(pragma_foreign_proc_attributes)
+ = mm_tabling_status.
+
+get_mm_tabling_status_from_attributes(Attributes) =
+ (
+ (
+ may_call_mm_tabled(Attributes) = will_not_call_mm_tabled
+ ;
+ may_call_mm_tabled(Attributes) = default_calls_mm_tabled,
+ may_call_mercury(Attributes) = will_not_call_mercury
+ )
+ ->
+ mm_tabled_will_not_call
+ ;
+ mm_tabled_may_call
+ ).
+
+%----------------------------------------------------------------------------%
+%
+% Additional code for handling calls
+%
+
+:- pred check_call_for_mm_tabling_calls(module_info::in, vartypes::in,
+ pred_proc_id::in, prog_vars::in, maybe(proc_mm_tabling_info)::out) is det.
+
+check_call_for_mm_tabling_calls(ModuleInfo, _VarTypes, PPId, _CallArgs,
+ MaybeResult) :-
+ module_info_get_mm_tabling_info(ModuleInfo, TablingInfo),
+ ( map.search(TablingInfo, PPId, CalleeTablingInfo) ->
+ MaybeResult = yes(CalleeTablingInfo)
+ % XXX user-defined uc (and higher-order args too)
+ ;
+ MaybeResult = no
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred combine_mm_tabling_status(mm_tabling_status::in,
+ mm_tabling_status::in, mm_tabling_status::out) is det.
+
+combine_mm_tabling_status(mm_tabled_will_not_call, Y, Y).
+combine_mm_tabling_status(mm_tabled_may_call, _,
+ mm_tabled_may_call).
+combine_mm_tabling_status(mm_tabled_conditional, mm_tabled_will_not_call,
+ mm_tabled_conditional).
+combine_mm_tabling_status(mm_tabled_conditional, mm_tabled_conditional,
+ mm_tabled_conditional).
+combine_mm_tabling_status(mm_tabled_conditional, mm_tabled_may_call,
+ mm_tabled_may_call).
+
+:- pred combine_maybe_analysis_status(maybe(analysis_status)::in,
+ maybe(analysis_status)::in, maybe(analysis_status)::out) is det.
+
+combine_maybe_analysis_status(MaybeStatusA, MaybeStatusB, MaybeStatus) :-
+ (
+ MaybeStatusA = yes(StatusA),
+ MaybeStatusB = yes(StatusB)
+ ->
+ MaybeStatus = yes(analysis.lub(StatusA, StatusB))
+ ;
+ MaybeStatus = no
+ ).
+
+%----------------------------------------------------------------------------%
+%
+% Code for attaching tabling analysis information to goals
+%
+
+ % Traverse the body of the procedure and attach the
+ % `cannot_call_mm_tabled' feature to the goal_infos of those goals that do
+ % not make calls to minimal model tabled procedures.
+ %
+:- pred annotate_proc(pred_proc_id::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+annotate_proc(PPId, !ModuleInfo, !IO) :-
+ some [!ProcInfo, !Body] (
+ module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, !:ProcInfo),
+ proc_info_goal(!.ProcInfo, !:Body),
+ proc_info_vartypes(!.ProcInfo, VarTypes),
+ annotate_goal(VarTypes, !Body, _Status, !ModuleInfo, !IO),
+ proc_info_set_goal(!.Body, !ProcInfo),
+ module_info_set_pred_proc_info(PPId, PredInfo, !.ProcInfo, !ModuleInfo)
+ ).
+
+:- pred annotate_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
+ mm_tabling_status::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+annotate_goal(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = GoalExpr0 - GoalInfo0,
+ annotate_goal_2(VarTypes, GoalExpr0, GoalExpr, Status,
+ !ModuleInfo, !IO),
+ ( Status = mm_tabled_will_not_call ->
+ goal_info_add_feature(cannot_call_mm_tabled, GoalInfo0, GoalInfo)
+ ;
+ GoalInfo = GoalInfo0
+ ),
+ !:Goal = GoalExpr - GoalInfo.
+
+:- pred annotate_goal_2(vartypes::in,
+ hlds_goal_expr::in, hlds_goal_expr::out, mm_tabling_status::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+annotate_goal_2(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = conj(ConjType, Conjuncts0),
+ annotate_goal_list(VarTypes, Conjuncts0, Conjuncts, Status, !ModuleInfo,
+ !IO),
+ !:Goal = conj(ConjType, Conjuncts).
+annotate_goal_2(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = call(CalleePredId, CalleeProcId, CallArgs, _, _, _),
+ CalleePPId = proc(CalleePredId, CalleeProcId),
+ module_info_pred_info(!.ModuleInfo, CalleePredId, CalleePredInfo),
+ (
+ pred_info_is_builtin(CalleePredInfo)
+ ->
+ Status = mm_tabled_will_not_call
+ ;
+ % Handle builtin unify and compare.
+ ModuleName = pred_info_module(CalleePredInfo),
+ any_mercury_builtin_module(ModuleName),
+ Name = pred_info_name(CalleePredInfo),
+ Arity = pred_info_orig_arity(CalleePredInfo),
+ ( SpecialPredId = spec_pred_compare
+ ; SpecialPredId = spec_pred_unify
+ ),
+ special_pred_name_arity(SpecialPredId, Name, _, Arity)
+ ->
+ % XXX user-defined uc
+ Status = mm_tabled_may_call
+ ;
+ globals.io_lookup_bool_option(intermodule_analysis, IntermodAnalysis,
+ !IO),
+ (
+ IntermodAnalysis = yes,
+ pred_info_is_imported(CalleePredInfo)
+ ->
+ % NOTE: we set the value of SCC to a dummy value here.
+ % This is okay because it only needs a meaningful value when
+ % building the analysis files; it won't be used when compiling to
+ % target code.
+ SCC = [],
+ search_analysis_status(CalleePPId, Result, AnalysisStatus, SCC,
+ !ModuleInfo, !IO),
+
+ ( AnalysisStatus = invalid ->
+ unexpected(this_file,
+ "invalid analysis result while annotating goals")
+ ;
+ % XXX user-defined uc
+ ( Result = mm_tabled_conditional ->
+ Status = mm_tabled_will_not_call
+ ;
+ Status = Result
+ )
+ )
+ ;
+ check_call_for_mm_tabling_calls(!.ModuleInfo, VarTypes,
+ CalleePPId, CallArgs, MaybeResult),
+ (
+ MaybeResult = yes(CalleeProcTablingInfo),
+ CalleeProcTablingInfo = proc_mm_tabling_info(Status, _)
+ ;
+ MaybeResult = no,
+ Status = mm_tabled_may_call
+ )
+ )
+ ).
+annotate_goal_2(_VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = generic_call(Details, _Args, _Modes, _Detism),
+ (
+ % XXX use results of closure analysis here.
+ Details = higher_order(_Var, _, _, _),
+ Status = mm_tabled_may_call
+ ;
+ Details = class_method(_, _, _, _),
+ Status = mm_tabled_may_call
+ ;
+ Details = cast(_),
+ Status = mm_tabled_will_not_call
+ ).
+annotate_goal_2(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = switch(Var, CanFail, Cases0),
+ annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo, !IO),
+ !:Goal = switch(Var, CanFail, Cases).
+annotate_goal_2(_VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = unify(_, _, _, Kind, _),
+ ( Kind = complicated_unify(_, _, _) ->
+ unexpected(this_file, "complicated unify during tabling analysis.")
+ ;
+ true
+ ),
+ Status = mm_tabled_will_not_call.
+annotate_goal_2(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = disj(Disjuncts0),
+ annotate_goal_list(VarTypes, Disjuncts0, Disjuncts, Status,
+ !ModuleInfo, !IO),
+ !:Goal = disj(Disjuncts).
+annotate_goal_2(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = not(NegGoal0),
+ annotate_goal(VarTypes, NegGoal0, NegGoal, Status, !ModuleInfo, !IO),
+ !:Goal = not(NegGoal).
+annotate_goal_2(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = scope(Reason, InnerGoal0),
+ annotate_goal(VarTypes, InnerGoal0, InnerGoal, Status, !ModuleInfo, !IO),
+ !:Goal = scope(Reason, InnerGoal).
+annotate_goal_2(VarTypes, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = if_then_else(Vars, If0, Then0, Else0),
+ annotate_goal(VarTypes, If0, If, IfStatus, !ModuleInfo, !IO),
+ annotate_goal(VarTypes, Then0, Then, ThenStatus, !ModuleInfo, !IO),
+ annotate_goal(VarTypes, Else0, Else, ElseStatus, !ModuleInfo, !IO),
+ (
+ IfStatus = mm_tabled_will_not_call,
+ ThenStatus = mm_tabled_will_not_call,
+ ElseStatus = mm_tabled_will_not_call
+ ->
+ Status = mm_tabled_will_not_call
+ ;
+ Status = mm_tabled_may_call
+ ),
+ !:Goal = if_then_else(Vars, If, Then, Else).
+annotate_goal_2(_, !Goal, Status, !ModuleInfo, !IO) :-
+ !.Goal = foreign_proc(Attributes, _, _, _, _, _),
+ Status = get_mm_tabling_status_from_attributes(Attributes).
+annotate_goal_2(_, shorthand(_), _, _, _, _, _, _) :-
+ unexpected(this_file, "shorthand goal").
+
+:- pred annotate_goal_list(vartypes::in, hlds_goals::in,
+ hlds_goals::out, mm_tabling_status::out, module_info::in,
+ module_info::out, io::di, io::uo) is det.
+
+annotate_goal_list(VarTypes, !Goals, Status, !ModuleInfo, !IO) :-
+ list.map2_foldl2(annotate_goal(VarTypes), !Goals, Statuses, !ModuleInfo,
+ !IO),
+ list.foldl(combine_mm_tabling_status, Statuses, mm_tabled_will_not_call,
+ Status).
+
+:- pred annotate_cases(vartypes::in, list(case)::in, list(case)::out,
+ mm_tabling_status::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+annotate_cases(VarTypes, !Cases, Status, !ModuleInfo, !IO) :-
+ list.map2_foldl2(annotate_case(VarTypes), !Cases, Statuses, !ModuleInfo,
+ !IO),
+ list.foldl(combine_mm_tabling_status, Statuses, mm_tabled_will_not_call,
+ Status).
+
+:- pred annotate_case(vartypes::in, case::in, case::out,
+ mm_tabling_status::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+annotate_case(VarTypes, !Case, Status, !ModuleInfo, !IO) :-
+ !.Case = case(ConsId, Goal0),
+ annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo, !IO),
+ !:Case = case(ConsId, Goal).
+
+%----------------------------------------------------------------------------%
+%
+% Stuff for intermodule optimization
+%
+
+:- pred make_opt_int(module_info::in, io::di, io::uo) is det.
+
+make_opt_int(ModuleInfo, !IO) :-
+ module_info_get_name(ModuleInfo, ModuleName),
+ module_name_to_file_name(ModuleName, ".opt.tmp", no, OptFileName, !IO),
+ globals.io_lookup_bool_option(verbose, Verbose, !IO),
+ maybe_write_string(Verbose, "% Appending mm_tabling_info pragmas to `",
+ !IO),
+ maybe_write_string(Verbose, OptFileName, !IO),
+ maybe_write_string(Verbose, "'...", !IO),
+ maybe_flush_output(Verbose, !IO),
+ io.open_append(OptFileName, OptFileRes, !IO),
+ (
+ OptFileRes = ok(OptFile),
+ io.set_output_stream(OptFile, OldStream, !IO),
+ module_info_get_mm_tabling_info(ModuleInfo, TablingInfo),
+ module_info_predids(ModuleInfo, PredIds),
+ list.foldl(write_pragma_mm_tabling_info(ModuleInfo, TablingInfo),
+ PredIds, !IO),
+ io.set_output_stream(OldStream, _, !IO),
+ io.close_output(OptFile, !IO),
+ maybe_write_string(Verbose, " done.\n", !IO)
+ ;
+ OptFileRes = error(IOError),
+ maybe_write_string(Verbose, " failed!\n", !IO),
+ io.error_message(IOError, IOErrorMessage),
+ io.write_strings(["Error opening file `",
+ OptFileName, "' for output: ", IOErrorMessage], !IO),
+ io.set_exit_status(1, !IO)
+ ).
+
+write_pragma_mm_tabling_info(ModuleInfo, TablingInfo, PredId, !IO) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ should_write_mm_tabling_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
+ (
+ ShouldWrite = yes,
+ ModuleName = pred_info_module(PredInfo),
+ Name = pred_info_name(PredInfo),
+ Arity = pred_info_orig_arity(PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ ProcIds = pred_info_procids(PredInfo),
+ list.foldl((pred(ProcId::in, !.IO::di, !:IO::uo) is det :-
+ proc_id_to_int(ProcId, ModeNum),
+ (
+ map.search(TablingInfo, proc(PredId, ProcId),
+ ProcTablingInfo),
+ ProcTablingInfo = proc_mm_tabling_info(Status, _)
+ ->
+ mercury_output_pragma_mm_tabling_info(PredOrFunc,
+ qualified(ModuleName, Name), Arity,
+ ModeNum, Status, !IO)
+ ;
+ true
+ )), ProcIds, !IO)
+ ;
+ ShouldWrite = no
+ ).
+
+:- pred should_write_mm_tabling_info(module_info::in, pred_id::in,
+ pred_info::in, bool::out) is det.
+
+should_write_mm_tabling_info(ModuleInfo, PredId, PredInfo, ShouldWrite) :-
+ pred_info_import_status(PredInfo, ImportStatus),
+ (
+ ( ImportStatus = exported
+ ; ImportStatus = opt_exported
+ ),
+ not is_unify_or_compare_pred(PredInfo),
+ module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
+ TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
+ not set.member(PredId, TypeSpecForcePreds),
+ %
+ % XXX Writing out pragmas for the automatically generated class
+ % instance methods causes the compiler to abort when it reads them
+ % back in.
+ %
+ pred_info_get_markers(PredInfo, Markers),
+ not check_marker(Markers, class_instance_method),
+ not check_marker(Markers, named_class_instance_method)
+ ->
+ ShouldWrite = yes
+ ;
+ ShouldWrite = no
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff for the intermodule analysis framework
+%
+
+:- type mm_tabling_analysis_answer
+ ---> mm_tabling_analysis_answer(mm_tabling_status).
+
+:- func analysis_name = string.
+analysis_name = "mm_tabling_analysis".
+
+:- instance analysis(any_call, mm_tabling_analysis_answer) where [
+ analysis_name(_, _) = analysis_name,
+ analysis_version_number(_, _) = 1,
+ preferred_fixpoint_type(_, _) = least_fixpoint,
+ bottom(_) = mm_tabling_analysis_answer(mm_tabled_will_not_call),
+ top(_) = mm_tabling_analysis_answer(mm_tabled_may_call)
+].
+
+:- instance answer_pattern(mm_tabling_analysis_answer) where [].
+:- instance partial_order(mm_tabling_analysis_answer) where [
+ (more_precise_than(
+ mm_tabling_analysis_answer(Status1),
+ mm_tabling_analysis_answer(Status2)) :-
+ mm_tabling_status_more_precise_than(Status1, Status2)),
+ equivalent(Status, Status)
+].
+
+:- pred mm_tabling_status_more_precise_than(mm_tabling_status::in,
+ mm_tabling_status::in) is semidet.
+
+mm_tabling_status_more_precise_than(mm_tabled_will_not_call,
+ mm_tabled_may_call).
+mm_tabling_status_more_precise_than(mm_tabled_will_not_call,
+ mm_tabled_conditional).
+mm_tabling_status_more_precise_than(mm_tabled_conditional,
+ mm_tabled_may_call).
+
+:- instance to_string(mm_tabling_analysis_answer) where [
+ func(to_string/1) is mm_tabling_analysis_answer_to_string,
+ func(from_string/1) is mm_tabling_analysis_answer_from_string
+].
+
+:- func mm_tabling_analysis_answer_to_string(mm_tabling_analysis_answer)
+ = string.
+
+mm_tabling_analysis_answer_to_string(mm_tabling_analysis_answer(Status))
+ = Str :-
+ mm_tabling_status_to_string(Status, Str).
+
+:- func mm_tabling_analysis_answer_from_string(string) =
+ mm_tabling_analysis_answer is semidet.
+
+mm_tabling_analysis_answer_from_string(Str)
+ = mm_tabling_analysis_answer(Status) :-
+ mm_tabling_status_to_string(Status, Str).
+
+:- pred mm_tabling_status_to_string(mm_tabling_status, string).
+:- mode mm_tabling_status_to_string(in, out) is det.
+:- mode mm_tabling_status_to_string(out, in) is semidet.
+
+mm_tabling_status_to_string(mm_tabled_may_call,
+ "mm_tabled_may_call").
+mm_tabling_status_to_string(mm_tabled_will_not_call,
+ "mm_tabled_will_not_call").
+mm_tabling_status_to_string(mm_tabled_conditional,
+ "mm_tabled_conditional").
+
+:- pred search_analysis_status(pred_proc_id::in,
+ mm_tabling_status::out, analysis_status::out, scc::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+search_analysis_status(PPId, Result, AnalysisStatus, CallerSCC,
+ !ModuleInfo, !IO) :-
+ module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
+ search_analysis_status_2(!.ModuleInfo, PPId, Result, AnalysisStatus,
+ CallerSCC, AnalysisInfo0, AnalysisInfo, !IO),
+ module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
+
+:- pred search_analysis_status_2(module_info::in, pred_proc_id::in,
+ mm_tabling_status::out, analysis_status::out, scc::in,
+ analysis_info::in, analysis_info::out, io::di, io::uo) is det.
+
+search_analysis_status_2(ModuleInfo, PPId, Result, AnalysisStatus, CallerSCC,
+ !AnalysisInfo, !IO) :-
+ mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
+ Call = any_call,
+ analysis.lookup_best_result(ModuleId, FuncId, Call,
+ MaybeBestStatus, !AnalysisInfo, !IO),
+ globals__io_lookup_bool_option(make_analysis_registry,
+ MakeAnalysisRegistry, !IO),
+ (
+ MaybeBestStatus = yes({BestCall, mm_tabling_analysis_answer(Result),
+ AnalysisStatus}),
+ (
+ MakeAnalysisRegistry = yes,
+ record_dependencies(ModuleId, FuncId, BestCall,
+ ModuleInfo, CallerSCC, !AnalysisInfo)
+ ;
+ MakeAnalysisRegistry = no
+ )
+ ;
+ MaybeBestStatus = no,
+ % If we do not have any information about the callee procedure
+ % then assume that it modifies the calls a minimal model tabled
+ % procedure.
+ top(Call) = Answer,
+ Answer = mm_tabling_analysis_answer(Result),
+ module_is_local(mmc, ModuleId, IsLocal, !IO),
+ (
+ IsLocal = yes,
+ AnalysisStatus = suboptimal,
+ (
+ MakeAnalysisRegistry = yes,
+ analysis.record_result(ModuleId, FuncId,
+ Call, Answer, AnalysisStatus, !AnalysisInfo),
+ analysis.record_request(analysis_name, ModuleId, FuncId, Call,
+ !AnalysisInfo),
+ record_dependencies(ModuleId, FuncId, Call,
+ ModuleInfo, CallerSCC, !AnalysisInfo)
+ ;
+ MakeAnalysisRegistry = no
+ )
+ ;
+ IsLocal = no,
+ % We can't do any better anyway.
+ AnalysisStatus = optimal
+ )
+ ).
+
+ % XXX if the procedures in CallerSCC definitely come from the
+ % same module then we don't need to record the dependency so many
+ % times, at least while we only have module-level granularity.
+ %
+:- pred record_dependencies(module_id::in, func_id::in, Call::in,
+ module_info::in, scc::in, analysis_info::in, analysis_info::out)
+ is det <= call_pattern(Call).
+
+record_dependencies(ModuleId, FuncId, Call,
+ ModuleInfo, CallerSCC, !AnalysisInfo) :-
+ list.foldl((pred(CallerPPId::in, Info0::in, Info::out) is det :-
+ mmc_analysis.module_id_func_id(ModuleInfo, CallerPPId,
+ CallerModuleId, _),
+ analysis.record_dependency(CallerModuleId,
+ analysis_name, ModuleId, FuncId, Call, Info0, Info)
+ ), CallerSCC, !AnalysisInfo).
+
+:- pred record_mm_tabling_analysis_results(mm_tabling_status::in,
+ analysis_status::in, scc::in, module_info::in, module_info::out) is det.
+
+record_mm_tabling_analysis_results(Status, ResultStatus, SCC, !ModuleInfo) :-
+ module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo0),
+ list.foldl(
+ record_mm_tabling_analysis_result(!.ModuleInfo, Status, ResultStatus),
+ SCC, AnalysisInfo0, AnalysisInfo),
+ module_info_set_analysis_info(AnalysisInfo, !ModuleInfo).
+
+:- pred record_mm_tabling_analysis_result(module_info::in,
+ mm_tabling_status::in, analysis_status::in, pred_proc_id::in,
+ analysis_info::in, analysis_info::out) is det.
+
+record_mm_tabling_analysis_result(ModuleInfo, Status, ResultStatus,
+ PPId @ proc(PredId, _ProcId), !AnalysisInfo) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ should_write_mm_tabling_info(ModuleInfo, PredId, PredInfo, ShouldWrite),
+ (
+ ShouldWrite = yes,
+ mmc_analysis.module_id_func_id(ModuleInfo, PPId, ModuleId, FuncId),
+ Answer = mm_tabling_analysis_answer(Status),
+ record_result(ModuleId, FuncId, any_call, Answer, ResultStatus,
+ !AnalysisInfo)
+ ;
+ ShouldWrite = no
+ ).
+
+%----------------------------------------------------------------------------%
+%
+% Code for printing out debugging traces
+%
+
+:- pred dump_mm_tabling_analysis_debug_info(module_info::in, scc::in,
+ mm_tabling_status::in, io::di, io::uo) is det.
+
+dump_mm_tabling_analysis_debug_info(ModuleInfo, SCC, Status, !IO) :-
+ io.write_string("SCC: ", !IO),
+ io.write(Status, !IO),
+ io.nl(!IO),
+ output_proc_names(ModuleInfo, SCC, !IO),
+ io.nl(!IO).
+
+:- pred output_proc_names(module_info::in, scc::in, io::di, io::uo) is det.
+
+output_proc_names(ModuleInfo, SCC, !IO) :-
+ list.foldl(output_proc_name(ModuleInfo), SCC, !IO).
+
+:- pred output_proc_name(module_info::in, pred_proc_id::in, io::di, io::uo)
+ is det.
+
+output_proc_name(Moduleinfo, PPId, !IO) :-
+ Pieces = describe_one_proc_name(Moduleinfo, should_module_qualify, PPId),
+ Str = error_pieces_to_string(Pieces),
+ io.format("\t%s\n", [s(Str)], !IO).
+
+%----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "tabling_analysis.m".
+
+%----------------------------------------------------------------------------%
+:- end_module tabling_analysis.
+%----------------------------------------------------------------------------%
Index: compiler/trailing_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trailing_analysis.m,v
retrieving revision 1.10
diff -u -r1.10 trailing_analysis.m
--- compiler/trailing_analysis.m 24 Feb 2006 05:49:41 -0000 1.10
+++ compiler/trailing_analysis.m 13 Mar 2006 02:29:21 -0000
@@ -14,7 +14,7 @@
%
% The compiler can use this information to omit redundant trailing operations
% in trailing grades. After running the analysis the trailing status of each
-% procedue is one of:
+% procedure is one of:
%
% (1) will_not_modify_trail
% (2) may_modify_trail
@@ -412,7 +412,7 @@
Goal = generic_call(Details, _Args, _ArgModes, _),
(
% XXX Use results of closure analysis to handle this.
- Details = higher_order(_Var, _, _, _),
+ Details = higher_order(_Var, _, _, _),
Result = may_modify_trail,
MaybeAnalysisStatus = yes(optimal)
;
@@ -885,8 +885,17 @@
).
annotate_goal_2(_VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
% XXX Use closure analysis results here.
- !.Goal = generic_call(_, _, _, _),
- Status = may_modify_trail.
+ !.Goal = generic_call(Details, _, _, _),
+ (
+ Details = higher_order(_, _, _, _),
+ Status = may_modify_trail
+ ;
+ Details = class_method(_, _, _, _),
+ Status = may_modify_trail
+ ;
+ Details = cast(_),
+ Status = will_not_modify_trail
+ ).
annotate_goal_2(VarTypes, _, !Goal, Status, !ModuleInfo, !IO) :-
!.Goal = switch(Var, CanFail, Cases0),
annotate_cases(VarTypes, Cases0, Cases, Status, !ModuleInfo, !IO),
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.36
diff -u -r1.36 trans_opt.m
--- compiler/trans_opt.m 22 Feb 2006 08:05:17 -0000 1.36
+++ compiler/trans_opt.m 10 Mar 2006 03:32:49 -0000
@@ -97,6 +97,7 @@
:- import_module transform_hlds.ctgc.structure_sharing.analysis.
:- import_module transform_hlds.exception_analysis.
:- import_module transform_hlds.intermod.
+:- import_module transform_hlds.tabling_analysis.
:- import_module transform_hlds.term_constr_main.
:- import_module transform_hlds.termination.
:- import_module transform_hlds.trailing_analysis.
@@ -159,6 +160,11 @@
write_pragma_trailing_info(Module, TrailingInfo),
PredIds, !IO),
+ module_info_get_mm_tabling_info(Module, TablingInfo),
+ list.foldl(
+ write_pragma_mm_tabling_info(Module, TablingInfo),
+ PredIds, !IO),
+
io__set_output_stream(OldStream, _, !IO),
io__close_output(Stream, !IO),
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.21
diff -u -r1.21 transform_hlds.m
--- compiler/transform_hlds.m 16 Dec 2005 12:17:55 -0000 1.21
+++ compiler/transform_hlds.m 9 Mar 2006 01:09:36 -0000
@@ -58,6 +58,7 @@
:- include_module post_term_analysis.
:- include_module exception_analysis.
:- include_module trailing_analysis.
+:- include_module tabling_analysis.
% Optimizations (HLDS -> HLDS)
:- include_module higher_order.
--------------------------------------------------------------------------
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