[m-rev.] For review: adding a new package for RBMM
Quan Phan
Quan.Phan at cs.kuleuven.be
Tue May 22 15:04:47 AEST 2007
Estimated hours taken: 85
Branches: main
Add a package for region-based memory management. Currently it contains
a region analysis which divides the heap used by a program into regions and
reasons about their lifetime, based on those data it then detects the points
where instructions for creating and destroying regions can be added.
Currently it supports single-module program and only gathers the necessary
information, runtime support for regions and support for multi-module
programs
will be implemented in subsequent development.
Quan.
compiler/rbmm.m:
Top-level of the region-based memory management (RBMM) sub-package.
This is part of the transform_hlds package.
compiler/rbmm.execution_path.m
Collecting execution paths in procedures.
compiler/rbmm.interproc_region_lifetime.m
Reasoning about region lifetime acroos procedure boundary.
compiler/rbmm.live_region_analysis.m
Deriving live regions before and after program points in
execution paths.
compiler/rbmm.live_variable_analysis.m
Computing live variables before and after program points in
execution paths.
compiler/rbmm.points_to_analysis.m
Implementing the region points-to analysis.
compiler/rbmm.points_to_graph.m
Region points-to graph which represents the heap in terms of regions.
compiler/rbmm.points_to_info.m
Defining the information that is collected during region points-to
analysis.
compiler/rbmm.region_instruction.m
Introducing region instructions along execution paths.
compiler/rbmm.region_liveness_info.m
Defining the analysis information for live variable and live region
analysis.
compiler/smm_common.m:
Utilities that may be used in static memory management: CTGC and
RBMM.
XXX There is currently some code duplication between the
CTGC and RBMM systems. This will be removed in a susbsequent
change.
All the above are new files.
compiler/transform_hlds.m:
Add sub-modules rbmm and smm_common.
compiler/fixpoint_table.m:
A general fixpoint computation.
XXX A file with similar functionality is duplicated in CTGC code.
fixpoint_table.m is only used in rbmm.points_to_info.m.
compiler/mercury_compile.m
Import package rbmm and call to the region analysis.
compiler/options.m
Add option --region-analysis.
cvs diff: Diffing .
Index: fixpoint_table.m
===================================================================
RCS file: fixpoint_table.m
diff -N fixpoint_table.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ fixpoint_table.m 22 May 2007 03:39:48 -0000
@@ -0,0 +1,217 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000-2007 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: fixpoint_table.m
+% Main author: nancy.
+%
+% This modules defines a generic table to be used for fixpoint
computations.
+% For each key (usually pred_proc_id), it will map a given abstract
+% substitution. Here the notion of abstract substitution is abstracted
+% away as a typeclass which required only two operations: equal and init.
+%
+%-----------------------------------------------------------------------------%
+
+:- module fixpoint_table.
+:- interface.
+
+:- import_module list.
+
+:- type fixpoint_table(K, E).
+
+ % Initialise the table.
+ % The first parameter is a list of keys which will be allowed in
+ % the table.
+ % fp_init(Initializer, Keys, Table).
+ %
+:- pred fp_init(pred(K, E), list(K), fixpoint_table(K, E)).
+:- mode fp_init(pred(in, out) is det, in, out) is det.
+
+ % Inform the table that a new run has begun.
+ %
+:- pred fp_new_run(fixpoint_table(K, E)::in, fixpoint_table(K, E)::out)
+ is det.
+
+ % Which run of the fix point are we up to?
+ %
+:- func fp_which_run(fixpoint_table(K, E)) = int.
+
+ % Check whether a fixpoint has been reached.
+ %
+:- pred fp_stable(fixpoint_table(K, E)::in) is semidet.
+
+ % Check whether the entries are recursive.
+ %
+:- pred fp_is_recursive(fixpoint_table(K,E)::in) is semidet.
+
+ % Add a new element (E) associated with key (K) to the table.
+ % - if an element is already recorded with that key,
+ % * and if both elements are equal, then a fixpoint is obtained
+ % as far as this key is concerned
+ % * if the elements are different, fixpoint is not reached yet,
+ % and the new information is simply kept
+ % - if the element was not yet present in the table, add it
+ % to the table (which does not change the stability of the
+ % table)
+ % fp_add( EqualityTest, Key, Element, TableIn, TableOut).
+ %
+:- pred fp_add(pred(E, E), K, E, fixpoint_table(K, E),
fixpoint_table(K, E)).
+:- mode fp_add(pred(in, in) is semidet, in, in, in, out) is det.
+
+ % Retrieve an element (E) associated with key (K) from the table.
+ % This operation will change the state of the table if the
+ % element _is_ present in the table. This means we're facing
+ % a recursive calltree. If the key is not an element of the
+ % allowed keys, then the procedure will fail.
+ %
+:- pred fp_get(K::in, E::out, fixpoint_table(K, E)::in,
+ fixpoint_table(K, E)::out) is semidet.
+
+ % Retrieve an element (E) associated with key (K) from the table.
+ % The operation reports an error when the element is not present.
+ %
+:- pred fp_get_final(K::in, E::out, fixpoint_table(K,E)::in) is det.
+
+ % Same as fp_get_final, but the predicate fails instead
+ % of aborting when the element is not present.
+ %
+:- pred fp_get_final_semidet(K::in, E::out, fixpoint_table(K,E)::in)
+ is semidet.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module libs.
+:- import_module libs.compiler_util.
+
+:- import_module bool.
+:- import_module int.
+:- import_module map.
+:- import_module string.
+
+:- type fixpoint_table(K, E)
+ ---> ft(
+ keys :: list(K), % list of allowed keys
+ run :: int, % number of runs
+ recursive :: bool, % is recursive or not
+ mapping :: map(K, fp_entry(E))
+ ).
+
+:- type fp_entry(E)
+ ---> entry(
+ bool, % stability: yes = stable, no = unstable
+ E
+ ).
+
+:- func fp_entry_init(E) = fp_entry(E).
+
+fp_entry_init(Elem) = entry(no, Elem).
+
+:- func fp_entry_stability(fp_entry(E)) = bool.
+
+fp_entry_stability(entry(S, _)) = S.
+
+:- func fp_entry_elem(fp_entry(E)) = E.
+
+fp_entry_elem(entry(_, Elem)) = Elem.
+
+:- func fp_entry_init(bool, E) = fp_entry(E).
+
+fp_entry_init(Bool, Elem) = entry(Bool, Elem).
+
+fp_init(Init, Ks, ft(Ks, Run, IsRecursive, Map)) :-
+ Run = 0,
+ IsRecursive = no,
+ map.init(Map0),
+ list.foldl(
+ (pred(K::in, M0::in, M::out) is det :-
+ Init(K, E),
+ map.det_insert(M0, K, fp_entry_init(E), M)
+ ), Ks, Map0, Map).
+
+fp_new_run(T0, T0 ^ run := T0 ^ run + 1).
+
+fp_which_run(T0) = T0 ^ run.
+
+fp_is_recursive(T) :- T ^ recursive = yes.
+
+fp_stable(T) :-
+ (
+ T ^ recursive = yes
+ ->
+ map.foldl(
+ pred(_K::in, Entry::in, S0::in, S::out) is det :-
+ (
+ ( S0 = no ->
+ S = no
+ ;
+ S = fp_entry_stability(Entry)
+ )
+ ), T ^ mapping, yes, yes)
+ ;
+ true
+ ).
+
+fp_add(Equal, Index, Elem, Tin, Tout) :-
+ Map = Tin ^ mapping,
+ (
+ map.search(Map, Index, Entry),
+ TabledElem = fp_entry_elem(Entry)
+ ->
+ ( Equal(TabledElem, Elem) ->
+ S = yes
+ ;
+ S = no
+ ),
+ % whether or not the tabled element is equal to
+ % the new element, the final tabled element will
+ % always be set to the new one. This is handy
+ % for performing the following trick: equality
+ % can be checked on some partial piece of the
+ % elements (for deciding stability), but some other
+ % part might have changed, a change that should
+ % become visible in the table too.
+ % (in fact this is necessary for the reuse-fixpoint
+ % table where not only the reuses are kept (the
+ % abstract substitution), but also the goal that
+ % might have changed.
+ FinalTabledElem = fp_entry_init(S, Elem),
+ map.det_update(Map, Index, FinalTabledElem, MapOut)
+ ;
+ % should not occur!
+ map.det_insert(Map, Index, fp_entry_init(Elem), MapOut)
+ ),
+ Tout = (Tin ^ mapping := MapOut).
+
+fp_get(Index, Elem, Tin, Tout) :-
+ List = Tin ^ keys,
+ list.member(Index, List), % can fail
+ Mapin = Tin ^ mapping,
+ (
+ map.search(Mapin, Index, Entry),
+ TabledElem = fp_entry_elem(Entry)
+ ->
+ Elem = TabledElem,
+ Mapout = Mapin
+ ;
+ unexpected(this_file, "fp_get: key not in map")
+ ),
+ Tout = (Tin ^ mapping := Mapout) ^ recursive := yes.
+
+fp_get_final(Index, Elem, T) :-
+ ( fp_get_final_semidet(Index, TabledElem, T) ->
+ Elem = TabledElem
+ ;
+ unexpected(this_file, "fp_get_final: final element not found")
+ ).
+
+fp_get_final_semidet(Index, Elem, T):-
+ map.search(T^mapping, Index, Entry),
+ Elem = fp_entry_elem(Entry).
+
+:- func this_file = string.
+this_file = "fixpoint_table.m".
Index: mercury_compile.m
===================================================================
RCS file:
/home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.434
diff -u -u -r1.434 mercury_compile.m
--- mercury_compile.m 15 May 2007 02:38:21 -0000 1.434
+++ mercury_compile.m 22 May 2007 01:47:07 -0000
@@ -101,6 +101,8 @@
:- import_module transform_hlds.size_prof.
:- import_module ll_backend.deep_profiling.
+:- import_module transform_hlds.rbmm.
+
% the LLDS back-end
:- import_module ll_backend.continuation_info.
:- import_module ll_backend.dupproc.
@@ -125,9 +127,7 @@
%
:- import_module ll_backend.llds_to_x86_64.
:- import_module ll_backend.llds_to_x86_64_out.
-:- import_module ll_backend.x86_64_instrs.
-:- import_module ll_backend.x86_64_out.
-:- import_module ll_backend.x86_64_regs.
+%:- import_module ll_backend.x86_64_instrs.
% the MLDS back-end
:- import_module ml_backend.add_trail_ops. % HLDS -> HLDS
@@ -2664,6 +2664,10 @@
maybe_experimental_complexity(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 230, "complexity", !DumpInfo, !IO),
+ % XXX This may be moved to later.
+ maybe_region_analysis(!HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 240, "region_analysis", !DumpInfo, !IO),
+
maybe_dump_hlds(!.HLDS, 299, "middle_pass", !DumpInfo, !IO).
%-----------------------------------------------------------------------------%
@@ -4232,6 +4236,19 @@
maybe_report_stats(Stats, !IO)
).
+:- pred maybe_region_analysis(module_info::in, module_info::out, io::di,
+ io::uo) is det.
+
+maybe_region_analysis(!HLDS, !IO) :-
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, region_analysis, Analysis),
+ (
+ Analysis = yes,
+ do_region_analysis(!HLDS)
+ ;
+ Analysis = no
+ ).
+
:- pred maybe_deep_profiling(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
Index: options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.558
diff -u -u -r1.558 options.m
--- options.m 14 May 2007 08:20:10 -0000 1.558
+++ options.m 16 May 2007 00:11:26 -0000
@@ -293,6 +293,7 @@
; record_term_sizes_as_words
; record_term_sizes_as_cells
; experimental_complexity
+ ; region_analysis
% (c) Miscellaneous
; gc
@@ -1070,6 +1071,7 @@
record_term_sizes_as_words - bool(no),
record_term_sizes_as_cells - bool(no),
experimental_complexity - string(""),
+ region_analysis - bool(no),
% (c) Miscellaneous optional features
gc - string("boehm"),
parallel - bool(no),
@@ -1836,6 +1838,7 @@
long_option("record-term-sizes-as-words", record_term_sizes_as_words).
long_option("record-term-sizes-as-cells", record_term_sizes_as_cells).
long_option("experimental-complexity", experimental_complexity).
+long_option("region-analysis", region_analysis).
% (c) miscellaneous optional features
long_option("gc", gc).
long_option("garbage-collection", gc).
@@ -3655,7 +3658,9 @@
"\tEnable experimental complexity analysis for the predicates",
"\tlisted in the given file.",
"\tThis option is supported for the C back-end, with",
- "\t--no-highlevel-code."
+ "\t--no-highlevel-code.",
+ "--region-analysis",
+ "\tEnable the analysis for region based memory management"
]),
io.write_string(" Miscellaneous optional features\n"),
Index: rbmm.execution_path.m
===================================================================
RCS file: rbmm.execution_path.m
diff -N rbmm.execution_path.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.execution_path.m 22 May 2007 02:03:50 -0000
@@ -0,0 +1,298 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 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 rbmm.execution_path.m.
+% Main author: Quan Phan.
+%
+% This module collects all execution paths (ExecPath) of procedures.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.rbmm.execution_path.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module transform_hlds.rbmm.region_liveness_info.
+
+ % Collects execution paths for each procedure.
+ %
+:- pred execution_path_analysis(module_info::in,
execution_path_table::out)
+ is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.
+:- import_module check_hlds.goal_path.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+:- import_module transform_hlds.smm_common.
+
+:- import_module pair.
+:- import_module string.
+:- import_module svmap.
+:- import_module list.
+:- import_module map.
+
+
+%-----------------------------------------------------------------------------%
+%
+% Execution path analysis
+%
+
+execution_path_analysis(ModuleInfo, ExecPathTable) :-
+ module_info_predids(PredIds, ModuleInfo, _),
+ map.init(ExecPathTable0),
+ list.foldl(execution_path_analysis_pred(ModuleInfo), PredIds,
+ ExecPathTable0, ExecPathTable).
+
+:- pred execution_path_analysis_pred(module_info::in, pred_id::in,
+ execution_path_table::in, execution_path_table::out)
+ is det.
+
+execution_path_analysis_pred(ModuleInfo, PredId, !ExecPathTable) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_non_imported_procids(PredInfo),
+ list.foldl(execution_path_analysis_proc(ModuleInfo, PredId), ProcIds,
+ !ExecPathTable).
+
+:- pred execution_path_analysis_proc(module_info::in, pred_id::in,
+ proc_id::in, execution_path_table::in, execution_path_table::out)
is det.
+
+execution_path_analysis_proc(ModuleInfo, PredId, ProcId, !ExecPathTable) :-
+ PPId = proc(PredId, ProcId),
+ ( if
+ some_are_special_preds([PPId], ModuleInfo)
+ then
+ true
+ else
+ module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+ compute_execution_paths(ProcInfo, ModuleInfo, ExecPaths),
+ svmap.set(PPId, ExecPaths, !ExecPathTable)
+ ).
+
+ % Compute all execution paths in the procedure.
+ %
+:- pred compute_execution_paths(proc_info::in, module_info::in,
+ list(execution_path)::out) is det.
+
+compute_execution_paths(ProcInfo0, ModuleInfo, ExecPaths) :-
+ % Fill the goals with program point information
+ fill_goal_path_slots(ModuleInfo, ProcInfo0, ProcInfo),
+ proc_info_get_goal(ProcInfo, Goal),
+ ExecPaths0 = [[]],
+ execution_paths_covered_goal(ProcInfo, Goal, ExecPaths0, ExecPaths).
+
+ % Extend the given execution paths to cover this goal.
+ %
+:- pred execution_paths_covered_goal(proc_info::in, hlds_goal::in,
+ list(execution_path)::in, list(execution_path)::out) is det.
+
+execution_paths_covered_goal(ProcInfo, Goal, !ExecPaths) :-
+ Goal = hlds_goal(Expr, Info),
+ (
+ goal_is_atomic(Expr)
+ ->
+ (
+ ( Expr = unify(_, _, _, _, _)
+ ; Expr = plain_call(_, _, _, _, _, _)
+ ; Expr = conj(_ConjType, [])
+ ; Expr = disj([])
+ )
+ ->
+ % Retrieve the program point of this goal.
+ program_point_init(Info, ProgPoint),
+ append_to_each_execution_path(!.ExecPaths,
+ [[pair(ProgPoint, Goal)]], !:ExecPaths)
+ ;
+ % XXX: other kinds of atomic calls (generic_call,
+ % foreign_proc), TEMPORARILY ignored their corresponding pps.
+ % XXX: handle event_call and unsafe_cast generic_calls
+ append_to_each_execution_path(!.ExecPaths, [[]], !:ExecPaths)
+ )
+ ;
+ execution_paths_covered_compound_goal(ProcInfo, Goal,
+ !ExecPaths)
+ ).
+
+ % Extend current execution paths to cover this compound goal.
+ %
+:- pred execution_paths_covered_compound_goal(proc_info::in,
hlds_goal::in,
+ list(execution_path)::in, list(execution_path)::out) is det.
+
+execution_paths_covered_compound_goal(ProcInfo, CompoundGoal,
!ExecPaths) :-
+ CompoundGoal = hlds_goal(Expr, _),
+ (
+ Expr = conj(_ConjType, [Goal | Goals]),
+ execution_paths_covered_conj(ProcInfo, [Goal | Goals], !ExecPaths)
+ ;
+ Expr = switch(_, _, Cases),
+ execution_paths_covered_cases(ProcInfo, CompoundGoal, Cases,
+ !ExecPaths)
+ ;
+ Expr = disj([Goal | Goals]),
+ execution_paths_covered_disj(ProcInfo, [Goal | Goals],
+ !ExecPaths)
+ ;
+ Expr = negation(Goal),
+ execution_paths_covered_goal(ProcInfo, Goal, !ExecPaths)
+ ;
+ Expr = scope(_, Goal),
+ execution_paths_covered_goal(ProcInfo, Goal, !ExecPaths)
+ ;
+ Expr = if_then_else(_V, Cond, Then, Else),
+ execution_paths_covered_goal(ProcInfo, Cond,
+ !.ExecPaths, ExecPathsCond),
+ execution_paths_covered_goal(ProcInfo, Then,
+ ExecPathsCond, ExecPathsCondThen),
+ execution_paths_covered_goal(ProcInfo, Else,
+ !.ExecPaths, ExecPathsElse),
+ !:ExecPaths = ExecPathsCondThen ++ ExecPathsElse
+ ;
+ ( Expr = unify(_, _, _, _, _)
+ ; Expr = plain_call(_, _, _, _, _, _)
+ ; Expr = conj(_, [])
+ ; Expr = disj([])
+ ; Expr = call_foreign_proc(_, _, _, _, _, _, _)
+ ; Expr = generic_call(_, _, _, _)
+ ; Expr = shorthand(_)
+ ),
+ unexpected(this_file,
+ "collect_execution_path_in_compound_goal: encountered
atomic or"
+ ++ " unsupported goal")
+ ).
+
+ % Extend execution paths to cover the goals in this conjunction.
+ %
+:- pred execution_paths_covered_conj(proc_info::in, list(hlds_goal)::in,
+ list(execution_path)::in, list(execution_path)::out) is det.
+
+execution_paths_covered_conj(_, [], !ExecPaths).
+execution_paths_covered_conj(ProcInfo, [Conj | Conjs], !ExecPaths) :-
+ execution_paths_covered_goal(ProcInfo, Conj, !ExecPaths),
+ execution_paths_covered_conj(ProcInfo, Conjs, !ExecPaths).
+
+ % Extend execution paths to cover a disjunction.
+ % To do this we extend the execution paths from the beginning of the
+ % disjunction for each disjunct to obtain a set of execution paths
+ % for each disjuct. At the end of the disjunction we combine these.
+ %
+:- pred execution_paths_covered_disj(proc_info::in, list(hlds_goal)::in,
+ list(execution_path)::in, list(execution_path)::out) is det.
+
+execution_paths_covered_disj(_, [], _, []).
+execution_paths_covered_disj(ProcInfo, [Disj | Disjs], !ExecPaths) :-
+ execution_paths_covered_goal(ProcInfo, Disj, !.ExecPaths,
+ ExecPathsDisj),
+ execution_paths_covered_disj(ProcInfo, Disjs, !.ExecPaths,
+ ExecPathsDisjs),
+ !:ExecPaths = ExecPathsDisj ++ ExecPathsDisjs.
+
+ % Extend execution paths to cover a switch.
+ % Switches are handled like disjunctions except that unifications
+ % involving the switch var sometimes need special handling.
+ % Unifications between the switch vars and a constant or a functor
+ % of arity zero are not explicitly present in the goal. This causes
+ % the execution paths to have fewer program points than they should.
+ % If this happens we need to add a program point for the removed
+ % unification. The goal corresponding to this introduced program
+ % point is the switch goal itself. This is so thtat we can get
+ % information about the switch var in the live variable analysis.
+ %
+:- pred execution_paths_covered_cases(proc_info::in, hlds_goal::in,
+ list(case)::in, list(execution_path)::in, list(execution_path)::out)
+ is det.
+
+execution_paths_covered_cases(_, _, [], _, []).
+execution_paths_covered_cases(ProcInfo, Switch, [Case | Cases],
+ !ExecPaths) :-
+ Case = case(ConsId, CaseGoal),
+ Switch = hlds_goal(_SwitchExpr, Info),
+ program_point_init(Info, ProgPoint),
+
+ % Handle the unification on the switch var if it has been removed.
+ % We add a dummy program point for this unification.
+ (
+ ConsId = cons(_SymName, Arity),
+ ( if Arity = 0
+ then
+ append_to_each_execution_path(!.ExecPaths,
+ [[pair(ProgPoint, Switch)]], ExecPathsBeforeCase)
+ else
+ ExecPathsBeforeCase = !.ExecPaths
+ )
+ ;
+ ( ConsId = int_const(_Int)
+ ; ConsId = string_const(_String)
+ ; ConsId = float_const(_Float)
+ ),
+ % need to add a dummy pp
+ append_to_each_execution_path(!.ExecPaths,
+ [[pair(ProgPoint, Switch)]], ExecPathsBeforeCase)
+ ;
+ ( ConsId = pred_const(_, _)
+ ; ConsId = type_ctor_info_const(_, _, _)
+ ; ConsId = base_typeclass_info_const(_, _, _, _)
+ ; ConsId = type_info_cell_constructor(_)
+ ; ConsId = typeclass_info_cell_constructor
+ ; ConsId = tabling_info_const(_)
+ ; ConsId = deep_profiling_proc_layout(_)
+ ; ConsId = table_io_decl(_)
+ ),
+ unexpected(this_file, "execution_paths_covered_cases: new cons_id "
+ ++ "encountered")
+ ),
+ execution_paths_covered_goal(ProcInfo, CaseGoal,
+ ExecPathsBeforeCase, ExecPathsCase),
+ execution_paths_covered_cases(ProcInfo, Switch, Cases,
+ !.ExecPaths, ExecPathsCases),
+ !:ExecPaths = ExecPathsCase ++ ExecPathsCases.
+
+ % extend each execution path in the first list with each in the
+ % second list, all the extended execution paths are put in the
third list
+ %
+:- pred append_to_each_execution_path(list(execution_path)::in,
+ list(execution_path)::in, list(execution_path)::out) is det.
+
+append_to_each_execution_path([], _, []).
+append_to_each_execution_path([ExecPath | ExecPaths], Extensions,
+ ExtendedExecPaths) :-
+ extend_exectution_path(ExecPath, Extensions, ExtendedExecPaths0),
+ append_to_each_execution_path(ExecPaths, Extensions,
+ ExtendedExecPaths1),
+ ExtendedExecPaths = ExtendedExecPaths0 ++ ExtendedExecPaths1.
+
+ % extend_exectution_path(ExecPath, Extensions, ExtendedExecPaths):
+ %
+ % ExtendedExecPaths is the list created by appending each extension
+ % in Extensions to ExecPath.
+ %
+:- pred extend_exectution_path(execution_path::in,
list(execution_path)::in,
+ list(execution_path)::out) is det.
+
+extend_exectution_path(_, [], []).
+extend_exectution_path(ExecPath, [Extension | Extensions],
+ ExtendedExecPaths) :-
+ ExtendedExecPath = ExecPath ++ Extension,
+ extend_exectution_path(ExecPath, Extensions, ExtendedExecPaths0),
+ ExtendedExecPaths = [ExtendedExecPath | ExtendedExecPaths0].
+
+%----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "rbmm.execution_path.m".
+
+%----------------------------------------------------------------------------%
Index: rbmm.interproc_region_lifetime.m
===================================================================
RCS file: rbmm.interproc_region_lifetime.m
diff -N rbmm.interproc_region_lifetime.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.interproc_region_lifetime.m 22 May 2007 01:56:11 -0000
@@ -0,0 +1,644 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 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 rbmm.interproc_region_lifetime.m.
+% Main author: Quan Phan.
+%
+% This module detects lifetime of regions across procedure boundary. It
+% updates the initial bornR and deadR, then computing constantR for each
+% procedure. It also provides a predicate to eliminate primitive regions
+% (i.e., ones that do not actually exist if primitive values are not boxed)
+% from analysis information.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.rbmm.interproc_region_lifetime.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module transform_hlds.rbmm.points_to_info.
+:- import_module transform_hlds.rbmm.region_liveness_info.
+
+%-----------------------------------------------------------------------------%
+
+ % This predicate reasons about lifetime of regions across procedure
+ % boundary. It will update the initial deadR and bornR sets and compute
+ % constantR set.
+ %
+:- pred compute_interproc_region_lifetime(module_info::in,
+ rpta_info_table::in, execution_path_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::in,
+ proc_region_set_table::out, proc_region_set_table::in,
+ proc_region_set_table::out, proc_region_set_table::in,
+ proc_region_set_table::out) is det.
+
+ % This predicate removes regions of primitive types from the input
data
+ % structures.
+ % The reason for this is the assumption that primitive values are not
+ % boxed (i.e., not store in regions).
+ %
+:- pred ignore_primitive_regions(module_info::in, rpta_info_table::in,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.
+:- import_module check_hlds.goal_path.
+:- import_module check_hlds.type_util.
+:- import_module hlds.arg_info.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module parse_tree.
+:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.prog_data.
+:- import_module transform_hlds.dependency_graph.
+:- import_module transform_hlds.rbmm.points_to_graph.
+:- import_module transform_hlds.smm_common.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module list.
+:- import_module map.
+:- import_module maybe.
+:- import_module pair.
+:- import_module set.
+:- import_module solutions.
+:- import_module string.
+:- import_module svmap.
+:- import_module svset.
+:- import_module term.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+%
+% Computing across procedure region lifetime.
+%
+
+compute_interproc_region_lifetime(ModuleInfo, RptaInfoTable, ExecPathTable,
+ LRBeforeTable, LRAfterTable, InputRTable, OutputRTable,
+ ConstantRTable, !BornRTable, !DeadRTable) :-
+
+ apply_live_region_born_removal_rules(ModuleInfo, RptaInfoTable,
+ ExecPathTable, LRBeforeTable, LRAfterTable, !BornRTable),
+ apply_live_region_dead_removal_rules(ModuleInfo, RptaInfoTable,
+ ExecPathTable, LRBeforeTable, LRAfterTable, !DeadRTable),
+ map.foldl(compute_constantR(InputRTable, OutputRTable, !.BornRTable),
+ !.DeadRTable, map.init, ConstantRTable).
+
+:- pred compute_constantR(proc_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::in,
+ pred_proc_id::in, region_set::in, proc_region_set_table::in,
+ proc_region_set_table::out) is det.
+
+compute_constantR(InputRTable, OutputRTable, BornRTable, PPId, DeadR,
+ !ConstantRTable) :-
+ map.lookup(InputRTable, PPId, InputR),
+ map.lookup(OutputRTable, PPId, OutputR),
+ map.lookup(BornRTable, PPId, BornR),
+ set.union(InputR, OutputR, InputOutputR0),
+ set.difference(InputOutputR0, BornR, InputOutputR),
+ set.difference(InputOutputR, DeadR, ConstantR),
+ svmap.set(PPId, ConstantR, !ConstantRTable).
+
+ % Apply the live region analysis rules to update bornR and deadR
+ % sets of each procedure.
+ %
+:- pred apply_live_region_dead_removal_rules(module_info::in,
+ rpta_info_table::in, execution_path_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::out) is det.
+
+apply_live_region_dead_removal_rules(ModuleInfo, RptaInfoTable,
ExecPathTable,
+ LRBeforeTable, LRAfterTable, !DeadRTable) :-
+ apply_live_region_rule(dead_removal_rules, ModuleInfo, RptaInfoTable,
+ ExecPathTable, LRBeforeTable, LRAfterTable, !DeadRTable).
+
+:- pred apply_live_region_born_removal_rules(module_info::in,
+ rpta_info_table::in, execution_path_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::out) is det.
+
+apply_live_region_born_removal_rules(ModuleInfo, RptaInfoTable,
ExecPathTable,
+ LRBeforeTable, LRAfterTable, !BornRTable) :-
+ apply_live_region_rule(born_removal_rules, ModuleInfo, RptaInfoTable,
+ ExecPathTable, LRBeforeTable, LRAfterTable, !BornRTable).
+
+:- type rule_pred == (
+ pred(pred_proc_id, region_set, region_set, proc_region_set_table,
+ map(rptg_node, rptg_node), region_set)
+ ).
+:- inst rule_pred == ( pred(in, in, in, in, in, out) is det ).
+
+:- pred apply_live_region_rule(rule_pred::in(rule_pred), module_info::in,
+ rpta_info_table::in, execution_path_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::out) is det.
+
+apply_live_region_rule(Rule, ModuleInfo, RptaInfoTable, ExecPathTable,
+ LRBeforeTable, LRAfterTable, !ProcRegionSetTable) :-
+ module_info_ensure_dependency_info(ModuleInfo, ModuleInfo1),
+ module_info_get_maybe_dependency_info(ModuleInfo1, MaybeDepInfo),
+ (
+ MaybeDepInfo = yes(DepInfo)
+ ->
+ hlds.hlds_module.hlds_dependency_info_get_dependency_ordering(
+ DepInfo, DepOrdering),
+ run_with_dependencies(Rule, DepOrdering, ModuleInfo1,
+ RptaInfoTable, ExecPathTable, LRBeforeTable, LRAfterTable,
+ !ProcRegionSetTable)
+ ;
+ unexpected(this_file,
+ "apply_live_region_rule: no dependency info")
+ ).
+
+:- pred run_with_dependencies(rule_pred::in(rule_pred),
+ dependency_ordering::in, module_info::in, rpta_info_table::in,
+ execution_path_table::in, proc_pp_region_set_table::in,
+ proc_pp_region_set_table::in, proc_region_set_table::in,
+ proc_region_set_table::out) is det.
+
+run_with_dependencies(Rule, Deps, ModuleInfo, RptaInfoTable, ExecPathTable,
+ LRBeforeTable, LRAfterTable, !ProcRegionSetTable) :-
+ % We want to proceed the SCC graph top-down so reverse the list
+ % (the process is foldr2, but it is not yet in list module)
+ list.reverse(Deps, Deps1),
+ list.foldl(run_with_dependency(Rule, ModuleInfo, RptaInfoTable,
+ ExecPathTable, LRBeforeTable, LRAfterTable), Deps1,
+ !ProcRegionSetTable).
+
+:- pred run_with_dependency(rule_pred::in(rule_pred),
+ module_info::in, rpta_info_table::in, execution_path_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ list(pred_proc_id)::in, proc_region_set_table::in,
+ proc_region_set_table::out) is det.
+
+run_with_dependency(Rule, ModuleInfo, RptaInfoTable, ExecPathTable,
+ LRBeforeTable, LRAfterTable, SCC, !ProcRegionSetTable) :-
+ (
+ % Ignores special predicates.
+ some_are_special_preds(SCC, ModuleInfo)
+ ->
+ true
+ ;
+ % Perform a fixpoint computation for each strongly connected
+ % component.
+ run_with_dependency_until_fixpoint(Rule, SCC, ModuleInfo,
+ RptaInfoTable, ExecPathTable, LRBeforeTable, LRAfterTable,
+ !ProcRegionSetTable)
+ ).
+
+:- pred run_with_dependency_until_fixpoint(rule_pred::in(rule_pred),
+ list(pred_proc_id)::in, module_info::in, rpta_info_table::in,
+ execution_path_table::in, proc_pp_region_set_table::in,
+ proc_pp_region_set_table::in, proc_region_set_table::in,
+ proc_region_set_table::out) is det.
+
+run_with_dependency_until_fixpoint(Rule, SCC, ModuleInfo, RptaInfoTable,
+ ExecPathTable, LRBeforeTable, LRAfterTable, !ProcRegionSetTable) :-
+ % This call calculates the region set for each procedure in SCC
+ list.foldl(apply_rule_pred_proc(Rule, ModuleInfo, RptaInfoTable,
+ ExecPathTable, LRBeforeTable, LRAfterTable),
+ SCC, !.ProcRegionSetTable, ProcRegionSetTable1),
+ (
+ proc_region_set_table_equal(ProcRegionSetTable1,
+ !.ProcRegionSetTable)
+ ->
+ % If all region_set's in the FPTable are intact update the main
+ % ProcRegionSetTable.
+ !:ProcRegionSetTable = ProcRegionSetTable1
+ ;
+ % Some is not fixed, start all over again
+ run_with_dependency_until_fixpoint(Rule, SCC, ModuleInfo,
+ RptaInfoTable, ExecPathTable, LRBeforeTable, LRAfterTable,
+ ProcRegionSetTable1, !:ProcRegionSetTable)
+ ).
+
+:- pred apply_rule_pred_proc(rule_pred::in(rule_pred),
+ module_info::in, rpta_info_table::in, execution_path_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ pred_proc_id::in, proc_region_set_table::in,
proc_region_set_table::out)
+ is det.
+
+apply_rule_pred_proc(Rule, ModuleInfo, RptaInfoTable, ExecPathTable,
+ LRBeforeTable, LRAfterTable, PPId, !ProcRegionSetTable) :-
+ % We need to follow each execution path and apply the two rules when
+ % possible
+ map.lookup(RptaInfoTable, PPId, RptaInfo),
+ map.lookup(ExecPathTable, PPId, EPs),
+ map.lookup(LRBeforeTable, PPId, ProcLRBefore),
+ map.lookup(LRAfterTable, PPId, ProcLRAfter),
+
+ % Here we analysing a caller but will update the region sets of its
+ % callees.
+ apply_live_region_rules_eps(Rule, EPs, ExecPathTable, ModuleInfo,
+ PPId, RptaInfo, RptaInfoTable, ProcLRBefore, ProcLRAfter,
+ !ProcRegionSetTable).
+
+:- pred apply_live_region_rules_eps(rule_pred::in(rule_pred),
+ list(execution_path)::in, execution_path_table::in, module_info::in,
+ pred_proc_id::in, rpta_info::in, rpta_info_table::in,
+ pp_region_set_table::in, pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::out) is det.
+
+apply_live_region_rules_eps(_Rule, [], _, _, _, _, _, _, _,
+ !ProcRegionSetTable).
+apply_live_region_rules_eps(Rule, [ExecPath|ExecPaths], ExecPathTable,
+ ModuleInfo, PPId, RptaInfo, RptaInfoTable, ProcLRBefore,
+ ProcLRAfter, !ProcRegionSetTable) :-
+ apply_live_region_rules_ep(Rule, ExecPath, ExecPathTable, ModuleInfo,
+ PPId, RptaInfo, RptaInfoTable, ProcLRBefore, ProcLRAfter,
+ !ProcRegionSetTable),
+ apply_live_region_rules_eps(Rule, ExecPaths, ExecPathTable, ModuleInfo,
+ PPId, RptaInfo, RptaInfoTable, ProcLRBefore, ProcLRAfter,
+ !ProcRegionSetTable).
+
+ % Follow each execution path of a procedure and update deadR and bornR
+ % sets
+ %
+:- pred apply_live_region_rules_ep(rule_pred::in(rule_pred),
+ execution_path::in, execution_path_table::in, module_info::in,
+ pred_proc_id::in, rpta_info::in, rpta_info_table::in,
+ pp_region_set_table::in, pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::out) is det.
+
+apply_live_region_rules_ep(_Rule, [], _, _, _, _, _, _, _,
+ !ProcRegionSetTable).
+apply_live_region_rules_ep(Rule, [ProgPoint - Goal | ProgPoint_Goals],
+ ExecPathTable, ModuleInfo, PPId, RptaInfo, RptaInfoTable,
+ ProcLRBefore, ProcLRAfter, !ProcRegionSetTable) :-
+ Goal = hlds_goal(Expr, _Info),
+ % The updating will only happen at call sites, i.e., when the goal
+ % at the program point is a procedure call.
+ ( if
+ Expr = plain_call(PredId_q, ProcId_q, _, _, _, _)
+ then
+ PPId_q = proc(PredId_q, ProcId_q),
+ ( if
+ some_are_special_preds([PPId_q], ModuleInfo)
+ then
+ true
+ else
+ RptaInfo = rpta_info(_, AlphaMapping),
+ map.lookup(AlphaMapping, ProgPoint, AlphaAtProgPoint),
+
+ map.lookup(ProcLRBefore, ProgPoint, LRBefore),
+ map.lookup(ProcLRAfter, ProgPoint, LRAfter),
+
+ % apply a rule
+ call(Rule, PPId_q, LRBefore, LRAfter,
+ !.ProcRegionSetTable, AlphaAtProgPoint, RegionSet),
+
+ map.lookup(!.ProcRegionSetTable, PPId_q,
+ RegionSet0),
+ ( if
+ set.equal(RegionSet, RegionSet0)
+ then
+ % i.e., no region is removed, so everything is the same
+ % as before
+ true
+ else
+ % some regions are removed, record the new set for q
and ...
+ svmap.set(PPId_q, RegionSet,
+ !ProcRegionSetTable),
+
+ % ... those removals need to be propagated to the ones
+ % called by q
+ set.difference(RegionSet0, RegionSet,
+ ToBeRemoved),
+ list.foldl(
+ remove_this_region_from_callees_of_proc(
+ PPId_q, ExecPathTable, ModuleInfo, RptaInfoTable),
+ set.to_sorted_list(ToBeRemoved),
+ !ProcRegionSetTable)
+ )
+ )
+ else
+ % ignore other sorts of goal
+ true
+ ),
+ apply_live_region_rules_ep(Rule, ProgPoint_Goals, ExecPathTable,
+ ModuleInfo, PPId, RptaInfo, RptaInfoTable, ProcLRBefore,
ProcLRAfter,
+ !ProcRegionSetTable).
+
+%-----------------------------------------------------------------------------%
+%
+% Live region analysis rules.
+%
+% Those rules ensure that:
+% 1. when it is not safe for a procedure to remove a region, that
region must
+% not be in the procedure's deadR seti,
+% 2. when a region exists before the procedure is called, that region
must not
+% be in the procedure's bornR set.
+%
+
+ % Rules for eliminating regions from deadR set.
+ %
+:- pred dead_removal_rules(pred_proc_id::in, region_set::in,
region_set::in,
+ proc_region_set_table::in, map(rptg_node, rptg_node)::in,
+ region_set::out) is det.
+
+dead_removal_rules(Q_Id, LRBefore, LRAfter, DeadRTable, AlphaAtPP,
DeadR_q) :-
+ % The current deadR of q.
+ map.lookup(DeadRTable, Q_Id, DeadR_q0),
+
+ % Apply dead removal rule L1 for r that is live before and after the
+ % call to q.
+ set.intersect(LRBefore, LRAfter, Rule1_Candidate),
+ set.fold(dead_removal_rule_1(AlphaAtPP), Rule1_Candidate, DeadR_q0,
+ DeadR_q1),
+
+ % Remove deadR rule L2.
+ targets_with_more_than_one_source(AlphaAtPP, Targets),
+ set.fold(dead_removal_rule_2(AlphaAtPP), Targets, DeadR_q1, DeadR_q).
+
+:- pred dead_removal_rule_1(map(rptg_node, rptg_node)::in, rptg_node::in,
+ region_set::in, region_set::out) is det.
+
+dead_removal_rule_1(AlphaAtCallSite, Region, !DeadR_q) :-
+ % Find r' such that alpha(r') = Region.
+ solutions(map.inverse_search(AlphaAtCallSite, Region), SourceList),
+ set.list_to_set(SourceList, RPrimes),
+
+ % Remove any r' that is in deadR(q).
+ set.difference(!.DeadR_q, RPrimes, !:DeadR_q).
+
+:- pred dead_removal_rule_2(map(rptg_node, rptg_node)::in, rptg_node::in,
+ set(rptg_node)::in, set(rptg_node)::out) is det.
+
+dead_removal_rule_2(AlphaAtCallSite, Region, !DeadR_q) :-
+ solutions(map.inverse_search(AlphaAtCallSite, Region), SourceList),
+ set.list_to_set(SourceList, RPrimes),
+ set.difference(!.DeadR_q, RPrimes, !:DeadR_q).
+
+ % rules for eliminating regions from bornR set.
+ %
+:- pred born_removal_rules(pred_proc_id::in, region_set::in,
region_set::in,
+ proc_region_set_table::in, map(rptg_node, rptg_node)::in,
+ region_set::out) is det.
+
+born_removal_rules(Q_Id, LRBefore, _, BornRTable, AlphaAtCallSite,
BornR_q) :-
+ % The current bornR of q.
+ map.lookup(BornRTable, Q_Id, BornR_q0),
+
+ % Apply born removal rule L3 for r that is live before and after the
+ % call to q.
+ set.fold(born_removal_rule_1(AlphaAtCallSite), LRBefore,
+ BornR_q0, BornR_q1),
+
+ % remove bornR rule L4,
+ targets_with_more_than_one_source(AlphaAtCallSite, Targets),
+ set.fold(born_removal_rule_2(AlphaAtCallSite), Targets,
+ BornR_q1, BornR_q).
+
+:- pred born_removal_rule_1(map(rptg_node, rptg_node)::in, rptg_node::in,
+ set(rptg_node)::in, set(rptg_node)::out) is det.
+
+born_removal_rule_1(AlphaAtCallSite, Region, !BornR_q) :-
+ solutions(map.inverse_search(AlphaAtCallSite, Region), SourceList),
+ set.list_to_set(SourceList, RPrimes),
+ set.difference(!.BornR_q, RPrimes, !:BornR_q).
+
+ % alpha(r') = r, alpha(r'') = r, r', r'' in bornR(q) imply remove r',
+ % r'' from bornR(q).
+ %
+:- pred born_removal_rule_2(map(rptg_node, rptg_node)::in, rptg_node::in,
+ set(rptg_node)::in, set(rptg_node)::out) is det.
+
+born_removal_rule_2(AlphaAtCallSite, Region, !BornR_q) :-
+ solutions(map.inverse_search(AlphaAtCallSite, Region), SourceList),
+ set.list_to_set(SourceList, RPrimes),
+ set.difference(!.BornR_q, RPrimes, !:BornR_q).
+
+ % Find targets of alpha mapping that are mapped to by more than one
+ % source.
+ %
+:- pred targets_with_more_than_one_source(map(rptg_node, rptg_node)::in,
+ region_set::out) is det.
+
+targets_with_more_than_one_source(AlphaAtCallSite, Targets) :-
+ map.foldl2(process_one_mapping, AlphaAtCallSite, set.init,
+ _Processed, set.init, Targets).
+
+:- pred process_one_mapping(rptg_node::in, rptg_node::in, region_set::in,
+ region_set::out, region_set::in, region_set::out) is det.
+
+process_one_mapping(_Source, Target, !Candidates, !Targets) :-
+ ( if
+ set.contains(!.Candidates, Target)
+ then
+ svset.insert(Target, !Targets)
+ else
+ svset.insert(Target, !Candidates)
+ ).
+
+ % This predicate propagates the removal of a region from a deadR or
+ % bornR sets of a procedure to the ones it calls, i.e., also remove
+ % the region from the corresponding sets of them.
+ %
+:- pred remove_this_region_from_callees_of_proc(pred_proc_id::in,
+ execution_path_table::in, module_info::in, rpta_info_table::in,
+ rptg_node::in, proc_region_set_table::in, proc_region_set_table::out)
+ is det.
+
+remove_this_region_from_callees_of_proc(PPId, ExecPathTable, ModuleInfo,
+ RptaInfoTable, Region, !ProcRegionSetTable) :-
+ % to have the goal at each pp
+ map.lookup(ExecPathTable, PPId, ExecPaths),
+
+ % Follow execution paths of this procedure and remove the region from
+ % this procedure's callees.
+ remove_this_from_eps(ExecPaths, PPId, Region, ExecPathTable,
+ ModuleInfo, RptaInfoTable, !ProcRegionSetTable).
+
+ % Follow each execution path of a procedure and update deadR and
+ % bornR sets
+ %
+:- pred remove_this_from_eps(list(execution_path)::in, pred_proc_id::in,
+ rptg_node::in, execution_path_table::in, module_info::in,
+ rpta_info_table::in, proc_region_set_table::in,
+ proc_region_set_table::out) is det.
+remove_this_from_eps([], _, _, _, _, _, !ProcRegionSetTable).
+remove_this_from_eps([ExecPath | ExecPaths], PPId, Region, ExecPathTable,
+ ModuleInfo, RptaInfoTable, !ProcRegionSetTable) :-
+ remove_this_from_ep(ExecPath, PPId, Region, ExecPathTable, ModuleInfo,
+ RptaInfoTable, !ProcRegionSetTable),
+ remove_this_from_eps(ExecPaths, PPId, Region, ExecPathTable, ModuleInfo,
+ RptaInfoTable, !ProcRegionSetTable).
+
+:- pred remove_this_from_ep(execution_path::in, pred_proc_id::in,
+ rptg_node::in, execution_path_table::in, module_info::in,
+ rpta_info_table::in, proc_region_set_table::in,
+ proc_region_set_table::out) is det.
+remove_this_from_ep([], _, _, _, _, _, !ProcRegionSetTable).
+remove_this_from_ep([ProgPoint - Goal|ProgPoint_Goals], PPId,
+ ToBeRemovedRegion, ExecPathTable, ModuleInfo, RptaInfoTable,
+ !ProcRegionSetTable) :-
+ Goal = hlds_goal(Expr, _Info),
+ ( if
+ Expr = plain_call(PredId_q, ProcId_q, _, _, _, _)
+ then
+ PPId_q = proc(PredId_q, ProcId_q),
+ ( if
+ some_are_special_preds([PPId_q], ModuleInfo)
+ then
+ true
+ else
+ % Find the alpha mapping: alpha(_, R) = ToBeRemovedRegion
+ map.lookup(RptaInfoTable, PPId, RptaInfo_p),
+ RptaInfo_p = rpta_info(_Graph_p, AlphaMapping),
+ map.lookup(AlphaMapping, ProgPoint, AlphaAtCallSite),
+
+ map.foldl(find_alpha_source(ToBeRemovedRegion),
+ AlphaAtCallSite, set.init, Rs),
+
+ % Remove the sources from the RegionSet (either deadR or
+ % bornR) of this callee.
+ map.lookup(!.ProcRegionSetTable, PPId_q, RegionSet0),
+ set.difference(RegionSet0, Rs, RegionSet1),
+
+ % update the table and continue
+ ( if
+ set.equal(RegionSet0, RegionSet1)
+ then
+ % no need to update
+ true
+ else
+ % Some is removed from deadR or bornR of this callee,
+ % so we update the entry of this called and analyse it.
+ svmap.set(PPId_q, RegionSet1,
+ !ProcRegionSetTable),
+ set.difference(RegionSet0, RegionSet1,
+ RemovedFromQ),
+
+ % Call this one mutually recursively.
+ list.foldl(
+ remove_this_region_from_callees_of_proc(PPId_q,
+ ExecPathTable, ModuleInfo, RptaInfoTable),
+ set.to_sorted_list(RemovedFromQ), !ProcRegionSetTable)
+ )
+ )
+ else
+ % ignore other sorts of goals
+ %
+ true
+ ),
+ remove_this_from_ep(ProgPoint_Goals, PPId, ToBeRemovedRegion,
+ ExecPathTable, ModuleInfo, RptaInfoTable, !ProcRegionSetTable).
+
+:- pred find_alpha_source(rptg_node::in, rptg_node::in, rptg_node::in,
+ set(rptg_node)::in, set(rptg_node)::out) is det.
+find_alpha_source(ToBeRemovedRegion, Source, Target, !Rs) :-
+ ( if
+ ToBeRemovedRegion = Target
+ then
+ set.insert(!.Rs, Source, !:Rs)
+ else
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Eliminating primitive regions from live region analysis's information.
+%
+
+ignore_primitive_regions(ModuleInfo, RptaInfoTable, !BornRTable,
+ !DeadRTable, !ConstantRTable, !LocalRTable, !LRBeforeTable,
+ !LRAfterTable, !VoidVarRegionTable) :-
+ map.foldl(eliminate_primitive_regions(ModuleInfo, RptaInfoTable),
+ !.BornRTable, !BornRTable),
+ map.foldl(eliminate_primitive_regions(ModuleInfo, RptaInfoTable),
+ !.DeadRTable, !DeadRTable),
+ map.foldl(eliminate_primitive_regions(ModuleInfo, RptaInfoTable),
+ !.ConstantRTable, !ConstantRTable),
+ map.foldl(eliminate_primitive_regions(ModuleInfo, RptaInfoTable),
+ !.LocalRTable, !LocalRTable),
+
+ map.foldl(eliminate_primitive_regions_2(ModuleInfo, RptaInfoTable),
+ !.LRBeforeTable, !LRBeforeTable),
+ map.foldl(eliminate_primitive_regions_2(ModuleInfo, RptaInfoTable),
+ !.LRAfterTable, !LRAfterTable),
+ map.foldl(eliminate_primitive_regions_2(ModuleInfo, RptaInfoTable),
+ !.VoidVarRegionTable, !VoidVarRegionTable).
+
+ % Eliminate regions of primitive types from the proc_region_set_table.
+ %
+:- pred eliminate_primitive_regions(module_info::in, rpta_info_table::in,
+ pred_proc_id::in, region_set::in, proc_region_set_table::in,
+ proc_region_set_table::out) is det.
+
+eliminate_primitive_regions(ModuleInfo, RptaInfoTable, PPId, RegionSet0,
+ !RegionSetTable) :-
+ map.lookup(RptaInfoTable, PPId, RptaInfo),
+ RptaInfo = rpta_info(Graph, _Alpha),
+ set.fold(retain_non_primitive_regions(ModuleInfo, Graph), RegionSet0,
+ set.init, RegionSet),
+ svmap.det_update(PPId, RegionSet, !RegionSetTable).
+
+:- pred retain_non_primitive_regions(module_info::in, rpt_graph::in,
+ rptg_node::in, region_set::in, region_set::out) is det.
+
+retain_non_primitive_regions(ModuleInfo, Graph, Region, !RegionSet) :-
+ rptg_node_contents(Graph, Region, Content),
+ rptg_node_content_get_node_type(Content, NodeType),
+ (
+ type_is_atomic(ModuleInfo, NodeType)
+ ->
+ true
+ ;
+ is_dummy_argument_type(ModuleInfo, NodeType)
+ ->
+ true
+ ;
+ svset.insert(Region, !RegionSet)
+ ).
+
+ % Eliminate regions of primitive types from the
+ % proc_pp_region_set_table.
+ %
+:- pred eliminate_primitive_regions_2(module_info::in,
rpta_info_table::in,
+ pred_proc_id::in, pp_region_set_table::in,
proc_pp_region_set_table::in,
+ proc_pp_region_set_table::out) is det.
+
+eliminate_primitive_regions_2(ModuleInfo, RptaInfoTable, PPId, LRProc0,
+ !LRTable) :-
+ map.lookup(RptaInfoTable, PPId, RptaInfo),
+ RptaInfo = rpta_info(Graph, _Alpha),
+ map.foldl(retain_non_primitive_regions_at_pp(ModuleInfo, Graph),
+ LRProc0, map.init, LRProc),
+ svmap.det_update(PPId, LRProc, !LRTable).
+
+:- pred retain_non_primitive_regions_at_pp(module_info::in, rpt_graph::in,
+ program_point::in, region_set::in, pp_region_set_table::in,
+ pp_region_set_table::out) is det.
+
+retain_non_primitive_regions_at_pp(ModuleInfo, Graph, ProgPoint,
+ RegionSet0, !LRProc) :-
+ set.fold(retain_non_primitive_regions(ModuleInfo, Graph), RegionSet0,
+ set.init, RegionSet),
+ svmap.set(ProgPoint, RegionSet, !LRProc).
+
+%----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "rbmm.interproc_region_lifetime.m".
+
+%----------------------------------------------------------------------------%
Index: rbmm.live_region_analysis.m
===================================================================
RCS file: rbmm.live_region_analysis.m
diff -N rbmm.live_region_analysis.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.live_region_analysis.m 21 May 2007 13:12:31 -0000
@@ -0,0 +1,260 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 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 rbmm.live_region_analysis.m.
+% Main author: Quan Phan.
+%
+% This module implements the live region analysis, which uses ExecPaths
with
+% live variables to collect live regions at each program point.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.rbmm.live_region_analysis.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module transform_hlds.rbmm.points_to_info.
+:- import_module transform_hlds.rbmm.region_liveness_info.
+
+%-----------------------------------------------------------------------------%
+
+ % Collects live region sets.
+ %
+:- pred live_region_analysis(module_info::in, rpta_info_table::in,
+ proc_pp_varset_table::in, proc_pp_varset_table::in,
+ proc_pp_varset_table::in, proc_pp_region_set_table::out,
+ proc_pp_region_set_table::out, proc_pp_region_set_table::out,
+ proc_region_set_table::out, proc_region_set_table::out,
+ proc_region_set_table::out, proc_region_set_table::out,
+ proc_region_set_table::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.
+:- import_module check_hlds.goal_path.
+:- import_module check_hlds.type_util.
+:- import_module hlds.arg_info.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module parse_tree.
+:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.prog_data.
+:- import_module transform_hlds.rbmm.points_to_graph.
+:- import_module transform_hlds.smm_common.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module list.
+:- import_module map.
+:- import_module pair.
+:- import_module set.
+:- import_module string.
+:- import_module svmap.
+:- import_module svset.
+:- import_module term.
+:- import_module varset.
+
+%----------------------------------------------------------------------------%
+%
+% Live region analysis
+%
+
+% Compute for each procedure live region sets before and after all program
+% points. As in live variable analysis we calculated the set of void
+% variables after a program point, this analysis also computes the set of
+% regions of those variables.
+%
+% Apart from that, it is convenient to also compute the inputR, outputR,
+% localR, and the initial bornR and deadR for each procedure in this
+% analysis.
+%
+
+live_region_analysis(ModuleInfo, RptaInfoTable, LVBeforeTable,
LVAfterTable,
+ VoidVarTable, LRBeforeTable, LRAfterTable, VoidVarRegionTable,
+ InputRTable, OutputRTable, BornRTable, DeadRTable, LocalRTable) :-
+ module_info_predids(PredIds, ModuleInfo, _),
+ map.init(LRBeforeTable0),
+ map.init(LRAfterTable0),
+ map.init(VoidVarRegionTable0),
+ map.init(InputRTable0),
+ map.init(OutputRTable0),
+ map.init(BornRTable0),
+ map.init(DeadRTable0),
+ map.init(LocalRTable0),
+ foldl8(live_region_analysis_pred(ModuleInfo, RptaInfoTable,
+ LVBeforeTable, LVAfterTable, VoidVarTable),
+ PredIds,
+ LRBeforeTable0, LRBeforeTable,
+ LRAfterTable0, LRAfterTable,
+ VoidVarRegionTable0, VoidVarRegionTable,
+ InputRTable0, InputRTable,
+ OutputRTable0, OutputRTable,
+ BornRTable0, BornRTable,
+ DeadRTable0, DeadRTable,
+ LocalRTable0, LocalRTable).
+
+:- pred live_region_analysis_pred(module_info::in, rpta_info_table::in,
+ proc_pp_varset_table::in, proc_pp_varset_table::in,
+ proc_pp_varset_table::in, pred_id::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out) is det.
+live_region_analysis_pred(ModuleInfo, RptaInfoTable, LVBeforeTable,
+ LVAfterTable, VoidVarTable, PredId, !LRBeforeTable, !LRAfterTable,
+ !VoidVarRegionTable, !InputRTable, !OutputRTable, !BornRTable,
+ !DeadRTable, !LocalRTable) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_non_imported_procids(PredInfo) = ProcIds,
+
+ foldl8(live_region_analysis_proc(ModuleInfo, RptaInfoTable,
+ LVBeforeTable, LVAfterTable, VoidVarTable, PredId), ProcIds,
+ !LRBeforeTable, !LRAfterTable, !VoidVarRegionTable,
+ !InputRTable, !OutputRTable, !BornRTable, !DeadRTable,
+ !LocalRTable).
+
+:- pred live_region_analysis_proc(module_info::in, rpta_info_table::in,
+ proc_pp_varset_table::in, proc_pp_varset_table::in,
+ proc_pp_varset_table::in, pred_id::in, proc_id::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out,
+ proc_region_set_table::in, proc_region_set_table::out) is det.
+
+live_region_analysis_proc(ModuleInfo, RptaInfoTable, LVBeforeTable,
+ LVAfterTable, VoidVarTable, PredId, ProcId, !LRBeforeTable,
+ !LRAfterTable, !VoidVarRegionTable, !InputRTable, !OutputRTable,
+ !BornRTable, !DeadRTable, !LocalRTable) :-
+ PPId = proc(PredId, ProcId),
+ ( if
+ some_are_special_preds([PPId], ModuleInfo)
+ then
+ % XXX: This action seems to be overkilled, it never goes in this
+ % branch.
+ % XXX: For the time being just ignore special predicates
+ % such as __Unify__ and others or non-defined-in-module ones.
+ % The latter ones should have been analysed when their
+ % modules analysed and their tables will be integrated.
+ % But it is not the case at the moment.
+ %
+ true
+ else
+ (
+ % This check is just a cautious check
+ RptaInfo = rpta_info_table_search_rpta_info(PPId,
+ RptaInfoTable)
+ ->
+ % Compute region sets.
+ RptaInfo = rpta_info(Graph, _ALpha),
+ module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+ find_input_output_args(ModuleInfo, ProcInfo, Inputs,
+ Outputs),
+ lv_to_lr(set.from_list(Inputs), Graph, ModuleInfo,
+ ProcInfo, InputR),
+ lv_to_lr(set.from_list(Outputs), Graph, ModuleInfo,
+ ProcInfo, OutputR),
+ svmap.set(PPId, InputR, !InputRTable),
+ svmap.set(PPId, OutputR, !OutputRTable),
+ % initial bornR
+ set.difference(OutputR, InputR, BornR),
+ svmap.set(PPId, BornR, !BornRTable),
+ % initial deadR
+ set.difference(InputR, OutputR, DeadR),
+ svmap.set(PPId, DeadR, !DeadRTable),
+ % localR
+ rptg_get_nodes(Graph, Nodes),
+ set.difference(
+ set.difference(set.from_list(Nodes), InputR),
+ OutputR, LocalR),
+ svmap.set(PPId, LocalR, !LocalRTable),
+
+ % Compute live region set at each program point
+ map.lookup(LVBeforeTable, PPId, ProcLVBefore),
+ map.foldl(
+ proc_lv_to_proc_lr(Graph, ModuleInfo, ProcInfo),
+ ProcLVBefore, map.init, ProcLRBefore),
+ svmap.set(PPId, ProcLRBefore, !LRBeforeTable),
+
+ map.lookup(LVAfterTable, PPId, ProcLVAfter),
+ map.foldl(
+ proc_lv_to_proc_lr(Graph, ModuleInfo, ProcInfo),
+ ProcLVAfter, map.init, ProcLRAfter),
+ svmap.set(PPId, ProcLRAfter, !LRAfterTable),
+
+ map.lookup(VoidVarTable, PPId, ProcVoidVar),
+ map.foldl(
+ proc_lv_to_proc_lr(Graph, ModuleInfo, ProcInfo),
+ ProcVoidVar, map.init, ProcVoidVarRegion),
+ svmap.set(PPId, ProcVoidVarRegion, !VoidVarRegionTable)
+ ;
+ unexpected(this_file,
+ "live_region_analysis_proc: rpta_info must exist")
+ )
+ ).
+
+:- pred proc_lv_to_proc_lr(rpt_graph::in, module_info::in, proc_info::in,
+ program_point::in, variable_set::in, pp_region_set_table::in,
+ pp_region_set_table::out) is det.
+
+proc_lv_to_proc_lr(Graph, ModuleInfo, ProcInfo, ProgPoint, LVs,
!ProcLRMap) :-
+ lv_to_lr(LVs, Graph, ModuleInfo, ProcInfo, LRs),
+ svmap.set(ProgPoint, LRs, !ProcLRMap).
+
+:- pred foldl8(pred(L, A, A, B, B, C, C, D, D, E, E, F, F, G, G, H, H),
+ list(L),
+ A, A, B, B, C, C, D, D, E, E, F, F, G, G, H, H).
+:- mode foldl8(pred(in, in, out, in, out, in, out, in, out, in, out,
in, out,
+ in, out, in, out) is det,
+ in, in, out, in, out, in, out, in, out, in, out, in, out, in, out, in,
+ out) is det.
+
+foldl8(_, [], !A, !B, !C, !D, !E, !F, !G, !H).
+foldl8(P, [H|T], !A, !B, !C, !D, !E, !F, !G, !H) :-
+ call(P, H, !A, !B, !C, !D, !E, !F, !G, !H),
+ foldl8(P, T, !A, !B, !C, !D, !E, !F, !G, !H).
+
+ % From a set of live variables, derive the set of live regions.
+ % A live region is defined to be reachable from a live variable
+ % in the corresponding region points-to graph.
+ %
+:- pred lv_to_lr(variable_set::in, rpt_graph::in, module_info::in,
+ proc_info::in, region_set::out) is det.
+
+lv_to_lr(LVSet, Graph, ModuleInfo, ProcInfo, LRSet) :-
+ (
+ set.empty(LVSet)
+ ->
+ set.init(LRSet)
+ ;
+ % collect reachable regions at this pp
+ set.init(LRSet0),
+ set.fold(reach_from_a_variable(Graph, ModuleInfo, ProcInfo),
+ LVSet, LRSet0, LRSet)
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "rbmm.live_region_analysis.m".
+
+%----------------------------------------------------------------------------%
Index: rbmm.live_variable_analysis.m
===================================================================
RCS file: rbmm.live_variable_analysis.m
diff -N rbmm.live_variable_analysis.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.live_variable_analysis.m 22 May 2007 02:11:27 -0000
@@ -0,0 +1,429 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 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 rbmm.live_variable_analysis.m.
+% Main author: Quan Phan.
+%
+% This module implements the live variable analysis.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.rbmm.live_variable_analysis.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module transform_hlds.rbmm.region_liveness_info.
+
+ % Collects live variable sets.
+ %
+:- pred live_variable_analysis(module_info::in, execution_path_table::in,
+ proc_pp_varset_table::out, proc_pp_varset_table::out,
+ proc_pp_varset_table::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.
+:- import_module check_hlds.goal_path.
+:- import_module check_hlds.type_util.
+:- import_module hlds.arg_info.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module parse_tree.
+:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.prog_data.
+:- import_module transform_hlds.smm_common.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module list.
+:- import_module map.
+:- import_module pair.
+:- import_module set.
+:- import_module string.
+:- import_module svmap.
+:- import_module svset.
+:- import_module term.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+%
+% Live variable analysis
+%
+
+% For each procedure, compute the sets of live variables before and after
+% each program point.
+% Currently, it also calculates set of void variables (i.e., ones whose
names
+% start with "_") after each program point. Those variables are considered
+% dead at that point.
+%
+
+live_variable_analysis(ModuleInfo, ExecPathTable, LVBeforeTable,
+ LVAfterTable, VoidVarTable) :-
+ module_info_predids(PredIds, ModuleInfo, _ModuleInfo),
+ map.init(LVBeforeTable0),
+ map.init(LVAfterTable0),
+ map.init(VoidVarTable0),
+ list.foldl3(live_variable_analysis_pred(ModuleInfo, ExecPathTable),
+ PredIds, LVBeforeTable0, LVBeforeTable, LVAfterTable0,
LVAfterTable,
+ VoidVarTable0, VoidVarTable).
+
+:- pred live_variable_analysis_pred(module_info::in,
execution_path_table::in,
+ pred_id::in, proc_pp_varset_table::in, proc_pp_varset_table::out,
+ proc_pp_varset_table::in, proc_pp_varset_table::out,
+ proc_pp_varset_table::in, proc_pp_varset_table::out) is det.
+
+live_variable_analysis_pred(ModuleInfo, ExecPathTable, PredId,
+ !LVBeforeTable, !LVAfterTable, !VoidVarTable) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_non_imported_procids(PredInfo) = ProcIds,
+ list.foldl3(
+ live_variable_analysis_proc(ModuleInfo, ExecPathTable, PredId),
+ ProcIds, !LVBeforeTable, !LVAfterTable, !VoidVarTable).
+
+:- pred live_variable_analysis_proc(module_info::in,
execution_path_table::in,
+ pred_id::in, proc_id::in, proc_pp_varset_table::in,
+ proc_pp_varset_table::out, proc_pp_varset_table::in,
+ proc_pp_varset_table::out, proc_pp_varset_table::in,
+ proc_pp_varset_table::out) is det.
+
+live_variable_analysis_proc(ModuleInfo, ExecPathTable, PredId, ProcId,
+ !LVBeforeTable, !LVAfterTable, !VoidVarTable) :-
+ PPId = proc(PredId, ProcId),
+ ( if
+ some_are_special_preds([PPId], ModuleInfo)
+ then
+ true
+ else
+ module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+ find_input_output_args(ModuleInfo, ProcInfo, Inputs, Outputs),
+ map.lookup(ExecPathTable, PPId, ExecPaths),
+ live_variable_analysis_exec_paths(ExecPaths, Inputs, Outputs,
+ ModuleInfo, ProcInfo, map.init, ProcLVBefore,
+ map.init, ProcLVAfter,
+ map.init, ProcVoidVar),
+
+ svmap.set(PPId, ProcLVBefore, !LVBeforeTable),
+ svmap.set(PPId, ProcLVAfter, !LVAfterTable),
+ svmap.set(PPId, ProcVoidVar, !VoidVarTable)
+ ).
+
+:- pred live_variable_analysis_exec_paths(list(execution_path)::in,
+ list(prog_var)::in, list(prog_var)::in, module_info::in,
proc_info::in,
+ pp_varset_table::in, pp_varset_table::out, pp_varset_table::in,
+ pp_varset_table::out, pp_varset_table::in, pp_varset_table::out) is
det.
+
+ % Live variable analysis is backward, so we reverse the execution path
+ % before starting. We have specific treatment for execution paths with
+ % only one program point, which means the last program point is
also the
+ % first one.
+ %
+live_variable_analysis_exec_paths([], _, _, _, _, !ProcLVBefore,
+ !ProcLVAfter, !ProcVoidVar).
+live_variable_analysis_exec_paths([ExecPath0 | ExecPaths], Inputs,
Outputs,
+ ModuleInfo, ProcInfo, !ProcLVBefore, !ProcLVAfter, !ProcVoidVar) :-
+ list.reverse(ExecPath0, ExecPath),
+ ( if
+ list.length(ExecPath) = 1
+ then
+ live_variable_analysis_singleton_exec_path(ExecPath, Inputs,
Outputs,
+ ModuleInfo, ProcInfo, !ProcLVBefore, !ProcLVAfter,
!ProcVoidVar)
+ else
+ % Start with the last program point.
+ live_variable_analysis_exec_path(ExecPath, Inputs, Outputs,
+ ModuleInfo, ProcInfo, yes, set.init, !ProcLVBefore,
!ProcLVAfter,
+ !ProcVoidVar)
+ ),
+ live_variable_analysis_exec_paths(ExecPaths, Inputs, Outputs,
+ ModuleInfo, ProcInfo, !ProcLVBefore, !ProcLVAfter, !ProcVoidVar).
+
+:- pred live_variable_analysis_exec_path(execution_path::in,
+ list(prog_var)::in, list(prog_var)::in, module_info::in,
proc_info::in,
+ bool::in, set(prog_var)::in, pp_varset_table::in,
pp_varset_table::out,
+ pp_varset_table::in, pp_varset_table::out, pp_varset_table::in,
+ pp_varset_table::out) is det.
+
+live_variable_analysis_exec_path([], _, _, _, _,_, _, !ProcLVBefore,
+ !ProcLVAfter, !ProcVoidVar).
+ % Process the last program point in an execution path. The live variable
+ % set of the last program point is always the set of output variables
+ % of the procedure.
+ %
+live_variable_analysis_exec_path([(LastProgPoint - Goal) |
ProgPointGoals],
+ Inputs, Outputs, ModuleInfo, ProcInfo, yes, _LVBeforeNext,
+ !ProcLVBefore, !ProcLVAfter, !ProcVoidVar) :-
+ ( if
+ map.search(!.ProcLVAfter, LastProgPoint, LVAfterLast0)
+ then
+ LVAfterLast = LVAfterLast0
+ else
+ LVAfterLast = set.list_to_set(Outputs),
+ svmap.set(LastProgPoint, LVAfterLast, !ProcLVAfter)
+ ),
+
+ % Compute live variable before this last program point.
+ compute_useds_produceds(ModuleInfo, Goal, UsedSet, ProducedSet),
+ set.union(set.difference(LVAfterLast, ProducedSet), UsedSet,
+ LVBeforeLastInThisExecPath),
+ record_live_vars_at_prog_point(LastProgPoint,
+ LVBeforeLastInThisExecPath, !ProcLVBefore),
+
+ % Collect void variables after this program point.
+ collect_void_vars(LastProgPoint, ProducedSet, ProcInfo, !ProcVoidVar),
+
+ live_variable_analysis_exec_path(ProgPointGoals, Inputs, Outputs,
+ ModuleInfo, ProcInfo, no, LVBeforeLastInThisExecPath,
!ProcLVBefore,
+ !ProcLVAfter, !ProcVoidVar).
+
+ % Process a middle program point.
+ %
+live_variable_analysis_exec_path(
+ [(ProgPoint - Goal), ProgPointGoal | ProgPointGoals], Inputs,
+ Outputs, ModuleInfo, ProcInfo, no, LVBeforeNext, !ProcLVBefore,
+ !ProcLVAfter, !ProcVoidVar) :-
+ % The live variable set after this program point is the union of the
+ % live variable sets after it in all execution paths to which it
belongs.
+ record_live_vars_at_prog_point(ProgPoint, LVBeforeNext, !ProcLVAfter),
+
+ % Compute LV before this program point.
+ compute_useds_produceds(ModuleInfo, Goal, UsedSet, ProducedSet),
+ set.union(set.difference(LVBeforeNext, ProducedSet), UsedSet,
+ LVBeforeInThisExecPath),
+ record_live_vars_at_prog_point(ProgPoint, LVBeforeInThisExecPath,
+ !ProcLVBefore),
+
+ % Collect void variables after this program point.
+ collect_void_vars(ProgPoint, ProducedSet, ProcInfo, !ProcVoidVar),
+
+ live_variable_analysis_exec_path([ProgPointGoal | ProgPointGoals],
+ Inputs, Outputs, ModuleInfo, ProcInfo, no, LVBeforeInThisExecPath,
+ !ProcLVBefore, !ProcLVAfter, !ProcVoidVar).
+
+ % The live variable set before the first program point is ALWAYS
+ % Inputs.
+ %
+live_variable_analysis_exec_path([FirstProgPoint - Goal], Inputs,
_Outputs,
+ ModuleInfo, ProcInfo, no, LVBeforeNext, !ProcLVBefore,
+ !ProcLVAfter, !ProcVoidVar) :-
+ ( if
+ map.search(!.ProcLVBefore, FirstProgPoint, _LVBeforeFirst)
+ then
+ true
+ else
+ LVBeforeFirst = set.list_to_set(Inputs),
+ svmap.set(FirstProgPoint, LVBeforeFirst, !ProcLVBefore)
+ ),
+
+ % Live variable set after the first program point.
+ record_live_vars_at_prog_point(FirstProgPoint, LVBeforeNext,
+ !ProcLVAfter),
+
+ % Collect void vars after this program point.
+ compute_useds_produceds(ModuleInfo, Goal, _UsedSet, ProducedSet),
+ collect_void_vars(FirstProgPoint, ProducedSet, ProcInfo, !ProcVoidVar).
+
+ % This predicate analyses execution paths with only one program point.
+ % So it must be called in a context that matches that condition.
+ %
+:- pred live_variable_analysis_singleton_exec_path(execution_path::in,
+ list(prog_var)::in, list(prog_var)::in, module_info::in, proc_info::in,
+ pp_varset_table::in, pp_varset_table::out, pp_varset_table::in,
+ pp_varset_table::out, pp_varset_table::in, pp_varset_table::out) is
det.
+
+live_variable_analysis_singleton_exec_path([ProgPoint - Goal | _], Inputs,
+ Outputs, ModuleInfo, ProcInfo, !ProcLVBefore, !ProcLVAfter,
+ !ProcVoidVar) :-
+ LVBefore = set.list_to_set(Inputs),
+ svmap.set(ProgPoint, LVBefore, !ProcLVBefore),
+ LVAfter = set.list_to_set(Outputs),
+ svmap.set(ProgPoint, LVAfter, !ProcLVAfter),
+
+ % Collect void vars after this program point.
+ compute_useds_produceds(ModuleInfo, Goal, _UsedSet, ProducedSet),
+ collect_void_vars(ProgPoint, ProducedSet, ProcInfo, !ProcVoidVar).
+
+live_variable_analysis_singleton_exec_path([], _, _, _, _,
+ !ProcLVBefore, !ProcLVAfter, !ProcVoidVar) :-
+ unexpected(this_file,
+ "live_variable_analysis_singleton_exec_path: impossible").
+
+ % A variable is live at a program point if it is live in one of
+ % the execution paths that covers the program point.
+ % Therefore we need to union the existing live variable set at a
program
+ % point with the newly found.
+ %
+:- pred record_live_vars_at_prog_point(program_point::in,
variable_set::in,
+ pp_varset_table::in, pp_varset_table::out) is det.
+
+record_live_vars_at_prog_point(ProgPoint, LV, !ProcLV) :-
+ ( if
+ map.search(!.ProcLV, ProgPoint, ExistingLV)
+ then
+ svmap.set(ProgPoint, set.union(ExistingLV, LV), !ProcLV)
+ else
+ svmap.set(ProgPoint, LV, !ProcLV)
+ ).
+
+ % Compute used and produced variables in an atomic goal, which
+ % has been recorded alongside a program point in an execution_path.
+ % A variable is used in an atomic goal if it is input to the goal.
+ % It is produced in the atomic goal if it is output of the goal.
+ %
+:- pred compute_useds_produceds(module_info::in, hlds_goal::in,
+ variable_set::out, variable_set::out) is det.
+
+compute_useds_produceds(ModuleInfo, Goal, UsedSet, ProducedSet) :-
+ ( if
+ % a removed switch
+ Goal = hlds_goal(switch(Var, _, _), _SwitchInfo)
+ then
+ Useds = [Var],
+ Produceds = []
+ else
+ Goal = hlds_goal(Expr, _Info),
+ (
+ Expr = plain_call(CalleePredId, CalleeProcId, Args,
+ _BuiltIn, _Context, _Name)
+ ->
+ get_inputs_outputs_proc_call(Args,
+ proc(CalleePredId, CalleeProcId), ModuleInfo,
+ Useds, Produceds)
+ ;
+ Expr = unify(_, _, _, Unification, _)
+ ->
+ get_inputs_outputs_unification(Unification, Useds,
+ Produceds)
+ ;
+ (Expr = conj(_, []) ; Expr = disj([]))
+ ->
+ Useds = [],
+ Produceds = []
+ ;
+ unexpected(this_file, "compute_useds_produceds: the expression "
+ ++ "must be either call, unify, true, or fail")
+ )
+ ),
+ set.list_to_set(Useds, UsedSet),
+ set.list_to_set(Produceds, ProducedSet).
+
+ % Divide the variables appearing in a unification into lists of input
+ % variables and output variables.
+ %
+:- pred get_inputs_outputs_unification(unification::in,
+ list(prog_var)::out, list(prog_var)::out) is det.
+
+get_inputs_outputs_unification(construct(LVar, _, Args, _, _, _, _),
+ Args, [LVar]).
+get_inputs_outputs_unification(deconstruct(LVar, _, Args, _, _, _),
+ [LVar], Args).
+get_inputs_outputs_unification(assign(LVar, RVar), [RVar], [LVar]).
+get_inputs_outputs_unification(simple_test(LVar, RVar), [LVar, RVar], []).
+get_inputs_outputs_unification(complicated_unify(_, _, _), [], []).
+
+ % Divide the arguments in a procedure call into lists of input
+ % variables and output variables.
+ %
+:- pred get_inputs_outputs_proc_call(list(prog_var)::in, pred_proc_id::in,
+ module_info::in, list(prog_var)::out, list(prog_var)::out) is det.
+
+get_inputs_outputs_proc_call(ActualArgs, CalleeId, ModuleInfo,
+ ActualInputs, ActualOutputs) :-
+ module_info_pred_proc_info(ModuleInfo, CalleeId, _PredInfo, CalleeInfo),
+ find_input_output_args(ModuleInfo, CalleeInfo, Inputs, Outputs),
+
+ proc_info_get_headvars(CalleeInfo, FormalArgs),
+ get_inputs_outputs_proc_call_2(FormalArgs, ActualArgs,
+ Inputs, Outputs, [], ActualInputs, [], ActualOutputs).
+
+:- pred get_inputs_outputs_proc_call_2(list(prog_var)::in,
+ list(prog_var)::in, list(prog_var)::in, list(prog_var)::in,
+ list(prog_var)::in, list(prog_var)::out, list(prog_var)::in,
+ list(prog_var)::out) is det.
+
+get_inputs_outputs_proc_call_2([], [], _, _, !ActualInputs,
!ActualOutputs).
+get_inputs_outputs_proc_call_2([], [_ | _], _, _, !ActualInputs,
+ !ActualOutputs) :-
+ unexpected(this_file,
+ "get_inputs_outputs_proc_call_2: more actual arguments than "
+ ++ "formal ones").
+get_inputs_outputs_proc_call_2([_ | _], [], _, _, !ActualInputs,
+ !ActualOutputs) :-
+ unexpected(this_file,
+ "get_inputs_outputs_proc_call_2: more formal arguments that "
+ ++ "actual ones").
+get_inputs_outputs_proc_call_2([FormalArg | FormalArgs],
+ [ActualArg | ActualArgs], Inputs, Outputs, !ActualInputs,
+ !ActualOutputs) :-
+ (
+ list.member(FormalArg, Inputs)
+ ->
+ % This formal argument is an input, so the correspondig argument
+ % is an actual input argument.
+ ActualInputs1 = [ActualArg | !.ActualInputs],
+ ActualOutputs1 = !.ActualOutputs
+ ;
+ list.member(FormalArg, Outputs)
+ ->
+ % This formal argument is an output, so the corresponding argument
+ % is an actual output argument.
+ ActualOutputs1 = [ActualArg | !.ActualOutputs],
+ ActualInputs1 = !.ActualInputs
+ ;
+ % this formal param is neither an output nor an input, so ignore
+ % the corresponding arg.
+ ActualInputs1 = !.ActualInputs,
+ ActualOutputs1 = !.ActualOutputs
+ ),
+ get_inputs_outputs_proc_call_2(FormalArgs, ActualArgs, Inputs, Outputs,
+ ActualInputs1, !:ActualInputs, ActualOutputs1, !:ActualOutputs).
+
+ % Collect variables whose names start with _, i.e., void variables.
+ % I am considering those variables dead right after created in the live
+ % variable and region analyses.
+ %
+:- pred collect_void_vars(program_point::in, variable_set::in,
proc_info::in,
+ pp_varset_table::in, pp_varset_table::out) is det.
+collect_void_vars(ProgPoint, ProducedSet, ProcInfo, !ProcVoidVar) :-
+ ( if
+ map.search(!.ProcVoidVar, ProgPoint, _DeadVars)
+ then
+ true
+ else
+ proc_info_get_varset(ProcInfo, Varset),
+ set.fold(void_var(Varset), ProducedSet, set.init, VoidVars),
+ svmap.set(ProgPoint, VoidVars, !ProcVoidVar)
+ ).
+
+ % To be used with the fold above: if Var is a void variable,
+ % add it to VoidVars set.
+ %
+:- pred void_var(prog_varset::in, prog_var::in, variable_set::in,
+ variable_set::out) is det.
+void_var(Varset, Var, !VoidVars) :-
+ mercury_var_to_string(Varset, no, Var) = VarName,
+ string.substring(VarName, 0, 1, FirstChar),
+ ( if
+ FirstChar = "_"
+ then
+ set.insert(!.VoidVars, Var, !:VoidVars)
+ else
+ true
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "rbmm.live_variable_analysis.m".
+
+%----------------------------------------------------------------------------%
Index: rbmm.m
===================================================================
RCS file: rbmm.m
diff -N rbmm.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.m 22 May 2007 03:51:06 -0000
@@ -0,0 +1,64 @@
+%-----------------------------------------------------------------------------%
+% Vim: ft=Mercury ts=4 sw=4
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 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: rbmm.m.
+% Main author: quan.
+%
+% This is the main file for the region-based memory management package.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.rbmm.
+:- interface.
+
+:- include_module execution_path.
+:- include_module interproc_region_lifetime.
+:- include_module live_region_analysis.
+:- include_module live_variable_analysis.
+:- include_module points_to_analysis.
+:- include_module points_to_graph.
+:- include_module points_to_info.
+:- include_module region_instruction.
+:- include_module region_liveness_info.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- pred do_region_analysis(module_info::in, module_info::out) is det.
+
+:- implementation.
+
+:- import_module transform_hlds.rbmm.execution_path.
+:- import_module transform_hlds.rbmm.interproc_region_lifetime.
+:- import_module transform_hlds.rbmm.live_region_analysis.
+:- import_module transform_hlds.rbmm.live_variable_analysis.
+:- import_module transform_hlds.rbmm.points_to_analysis.
+:- import_module transform_hlds.rbmm.region_instruction.
+
+do_region_analysis(!ModuleInfo) :-
+ region_points_to_analysis(RptaInfoTable, !ModuleInfo),
+ execution_path_analysis(!.ModuleInfo, ExecPathTable),
+ live_variable_analysis(!.ModuleInfo, ExecPathTable, LVBeforeTable,
+ LVAfterTable, VoidVarTable),
+ live_region_analysis(!.ModuleInfo, RptaInfoTable,
+ LVBeforeTable, LVAfterTable, VoidVarTable,
+ LRBeforeTable0, LRAfterTable0, VoidVarRegionTable0,
+ InputRTable, OutputRTable, BornRTable0, DeadRTable0, LocalRTable0),
+ compute_interproc_region_lifetime(!.ModuleInfo, RptaInfoTable,
+ ExecPathTable, LRBeforeTable0, LRAfterTable0, InputRTable,
+ OutputRTable, ConstantRTable0, BornRTable0, BornRTable1,
+ DeadRTable0, DeadRTable1),
+ ignore_primitive_regions(!.ModuleInfo, RptaInfoTable,
+ BornRTable1, BornRTable, DeadRTable1, DeadRTable,
+ ConstantRTable0, _ConstantRTable, LocalRTable0, LocalRTable,
+ LRBeforeTable0, LRBeforeTable, LRAfterTable0, LRAfterTable,
+ VoidVarRegionTable0, VoidVarRegionTable),
+ transform(!.ModuleInfo, RptaInfoTable, ExecPathTable,
+ LRBeforeTable, LRAfterTable, VoidVarRegionTable, BornRTable,
+ DeadRTable, LocalRTable, _AnnotationTable).
+
+:- end_module transform_hlds.rbmm.
Index: rbmm.points_to_analysis.m
===================================================================
RCS file: rbmm.points_to_analysis.m
diff -N rbmm.points_to_analysis.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.points_to_analysis.m 22 May 2007 02:20:12 -0000
@@ -0,0 +1,1164 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 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 rbmm.points_to_analysis.m.
+% Main author: Quan Phan.
+%
+% This module implements the region points-to analysis (rpta), which
collects
+% for each procedure a region points-to graph representing the
splitting of
+% the heap used by the procedure into regions, i.e., which variables are
+% stored in which regions. Because the region model is polymorphic,
i.e., we
+% can pass different actual regions for region arguments, the analysis
also
+% gathers the alpha mapping, which maps formal region parameters to actual
+% ones at each call site in a procedure. So there are 2 sorts of
information:
+% region points-to graph (rptg) and alpha mapping.
+%
+% The analysis is composed of 2 phases:
+% 1. intraprocedural analysis: only analyses unifications and compute only
+% rptgs.
+% 2. interprocedural analysis: only analyses (plain) procedure calls,
+% compute both rptgs and alpha mappings.
+%
+%
+% Currently the analysis ONLY collects the information, do NOT record
it into
+% the HLDS.
+%
+
+:- module transform_hlds.rbmm.points_to_analysis.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module transform_hlds.rbmm.points_to_info.
+
+:- pred region_points_to_analysis(rpta_info_table::out, module_info::in,
+ module_info::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.
+:- import_module check_hlds.goal_path.
+:- import_module fixpoint_table.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+:- import_module transform_hlds.dependency_graph.
+:- import_module transform_hlds.rbmm.points_to_graph.
+:- import_module transform_hlds.smm_common.
+
+:- import_module bool.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module set.
+:- import_module string.
+:- import_module term.
+:- import_module svmap.
+:- import_module maybe.
+
+region_points_to_analysis(InfoTable, !ModuleInfo) :-
+ rpta_info_table_init = InfoTable0,
+ intra_proc_rpta(!.ModuleInfo, InfoTable0, InfoTable1),
+ inter_proc_rpta(!.ModuleInfo, InfoTable1, InfoTable).
+
+%----------------------------------------------------------------------------%
+%
+% Intraprocedural region points-to analysis.
+%
+
+:- pred intra_proc_rpta(module_info::in, rpta_info_table::in,
+ rpta_info_table::out) is det.
+
+intra_proc_rpta(ModuleInfo, !InfoTable) :-
+ module_info_predids(PredIds, ModuleInfo, _),
+ list.foldl(intra_proc_rpta_pred(ModuleInfo), PredIds, !InfoTable).
+
+:- pred intra_proc_rpta_pred(module_info::in, pred_id::in,
+ rpta_info_table::in, rpta_info_table::out) is det.
+
+intra_proc_rpta_pred(ModuleInfo, PredId, !InfoTable) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_non_imported_procids(PredInfo) = ProcIds,
+ list.foldl(intra_proc_rpta_proc(ModuleInfo, PredId), ProcIds,
+ !InfoTable).
+
+:- pred intra_proc_rpta_proc(module_info::in, pred_id::in, proc_id::in,
+ rpta_info_table::in, rpta_info_table::out) is det.
+
+intra_proc_rpta_proc(ModuleInfo, PredId, ProcId, !InfoTable) :-
+ PPId = proc(PredId, ProcId),
+ intra_analyse_pred_proc(ModuleInfo, PPId, !InfoTable).
+
+:- pred intra_analyse_pred_proc(module_info::in, pred_proc_id::in,
+ rpta_info_table::in, rpta_info_table::out) is det.
+
+intra_analyse_pred_proc(ModuleInfo, PPId, !InfoTable) :-
+ ( if
+ some_are_special_preds([PPId], ModuleInfo)
+ then
+ true
+ else
+ module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+ rpta_info_init(ProcInfo, RptaInfo0),
+ proc_info_get_goal(ProcInfo, Goal),
+ intra_analyse_goal(Goal, RptaInfo0, RptaInfo),
+ rpta_info_table_set_rpta_info(PPId, RptaInfo, !InfoTable)
+ ).
+
+:- pred intra_analyse_goal(hlds_goal::in,
+ rpta_info::in, rpta_info::out) is det.
+
+intra_analyse_goal(Goal, !RptaInfo) :-
+ Goal = hlds_goal(GoalExpr, _),
+ intra_analyse_goal_expr(GoalExpr, !RptaInfo).
+
+:- pred intra_analyse_goal_expr(hlds_goal_expr::in,
+ rpta_info::in, rpta_info::out) is det.
+
+intra_analyse_goal_expr(conj(_ConjType, Goals), !RptaInfo) :-
+ list.foldl(intra_analyse_goal, Goals, !RptaInfo).
+
+ % Procedure calls are ignored in the intraprocedural analysis.
+ %
+intra_analyse_goal_expr(plain_call(_, _, _, _, _, _), !RptaInfo).
+
+intra_analyse_goal_expr(generic_call(_,_,_,_), !RptaInfo) :-
+ unexpected(this_file,
+ "intra_analyse_goal_expr: generic_call not handled").
+
+intra_analyse_goal_expr(switch(_, _, Cases), !RptaInfo) :-
+ list.foldl(intra_analyse_case, Cases, !RptaInfo).
+
+:- pred intra_analyse_case(case::in, rpta_info::in, rpta_info::out) is det.
+
+intra_analyse_case(Case, !RptaInfo) :-
+ Case = case(_, Goal),
+ intra_analyse_goal(Goal, !RptaInfo).
+
+ % Most of the processing in intraprocedural analysis happens to
+ % unifications.
+ %
+intra_analyse_goal_expr(unify(_, _, _, Unification, _), !RptaInfo) :-
+ process_unification(Unification, !RptaInfo).
+
+intra_analyse_goal_expr(disj(Goals), !RptaInfo) :-
+ list.foldl(intra_analyse_goal, Goals, !RptaInfo).
+
+intra_analyse_goal_expr(negation(Goal), !RptaInfo) :-
+ intra_analyse_goal(Goal, !RptaInfo).
+
+ % scope
+ % XXX: only analyse the goal. May need to take into account the
Reason.
+ %
+intra_analyse_goal_expr(scope(_Reason, Goal), !RptaInfo) :-
+% (
+% ( Reason = exist_quant(_)
+% ; Reason = promise_solutions(_, _) % XXX ???
+% ; Reason = promise_purity(_, _)
+% ; Reason = commit(_) % XXX ???
+% ; Reason = barrier(_)
+% ; Reason = trace_goal(_, _, _, _, _)
+% ; Reason = from_ground_term(_)
+% ),
+ intra_analyse_goal(Goal, !RptaInfo).
+% ;
+% Msg = "intra_analyse_goal_expr: Scope's reason of
from_ground_term "
+% ++ "not handled",
+% unexpected(this_file, Msg)
+% ).
+
+intra_analyse_goal_expr(if_then_else(_Vars, If, Then, Else), !RptaInfo) :-
+ intra_analyse_goal(If, !RptaInfo),
+ intra_analyse_goal(Then, !RptaInfo),
+ intra_analyse_goal(Else, !RptaInfo).
+
+intra_analyse_goal_expr(GoalExpr, !RptaInfo) :-
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
+ unexpected(this_file, "intra_analyse_goal_expr: call_foreign_proc"
+ ++ " not handled").
+
+intra_analyse_goal_expr(shorthand(_), !RptaInfo) :-
+ unexpected(this_file, "intra_analyse_goal_expr: shorthand not
handled").
+
+:- pred process_unification(unification::in, rpta_info::in,
+ rpta_info::out) is det.
+
+ % For construction and deconstruction, add edges from LVar to
+ % each of RVars.
+process_unification(construct(LVar, ConsId, RVars, _, _, _, _),
!RptaInfo) :-
+ list.foldl2(process_cons_and_decons(LVar, ConsId), RVars,
+ 1, _, !RptaInfo).
+
+process_unification(deconstruct(LVar, ConsId, RVars, _, _, _),
!RptaInfo) :-
+ list.foldl2(process_cons_and_decons(LVar, ConsId), RVars,
+ 1, _, !RptaInfo).
+
+:- pred process_cons_and_decons(prog_var::in, cons_id::in, prog_var::in,
+ int::in, int::out, rpta_info::in, rpta_info::out) is det.
+process_cons_and_decons(LVar, ConsId, RVar, !Component, !RptaInfo) :-
+ !.RptaInfo = rpta_info(Graph0, AlphaMapping),
+ get_node_by_variable(Graph0, LVar, Node1),
+ get_node_by_variable(Graph0, RVar, Node2),
+ Sel = [termsel(ConsId, !.Component)],
+ ArcContent = rptg_arc_content(Sel),
+
+ % Only add the edge if it is not in the graph
+ % It is more suitable to the edge_operator's semantics if we check
+ % this inside the edge_operator. But we also want to know if the edge
+ % is actually added or not so it is convenient to check the edge's
+ % existence outside edge_operator. Otherwise we can extend
edge_operator
+ % with one more argument to indicate that.
+ ( if
+ edge_in_graph(Node1, ArcContent, Node2, Graph0)
+ then
+ true
+ else
+ edge_operator(Node1, Node2, ArcContent, Graph0, Graph1),
+ RptaInfo1 = rpta_info(Graph1, AlphaMapping),
+
+ % After an edge is added, rules P2 and P3 are applied to ensure
+ % the invariants of the graph.
+ apply_rule_2(Node1, Node2, ConsId, !.Component, RptaInfo1,
RptaInfo2),
+ RptaInfo2 = rpta_info(Graph2, _),
+ get_node_by_variable(Graph2, RVar, RVarNode),
+ apply_rule_3(RVarNode, RptaInfo2, !:RptaInfo)
+ ),
+ !:Component = !.Component + 1.
+
+ % Unification is an assigment: merge the corresponding nodes of ToVar
+ % and FromVar.
+ %
+process_unification(assign(ToVar, FromVar), !RptaInfo) :-
+ !.RptaInfo = rpta_info(Graph0, AlphaMapping),
+ get_node_by_variable(Graph0, ToVar, ToNode),
+ get_node_by_variable(Graph0, FromVar, FromNode),
+ ( if
+ ToNode = FromNode
+ then
+ true
+ else
+ unify_operator(ToNode, FromNode, Graph0, Graph1),
+ RptaInfo1 = rpta_info(Graph1, AlphaMapping),
+ % After the merge of two nodes, apply rule P1 to ensure rptg's
+ % invariants.
+ apply_rule_1(ToNode, RptaInfo1, !:RptaInfo)
+ ).
+
+ % Do nothing with the simple test.
+ %
+process_unification(simple_test(_, _), !RptaInfo).
+
+ % XXX: do not consider this for the time being.
+ %
+process_unification(complicated_unify(_, _, _), !RptaInfo).
+
+%-----------------------------------------------------------------------------%
+%
+% The part for interprocedural analysis.
+%
+
+ % The interprocedural analysis requires fixpoint computation,
+ % so we will compute a fixpoint for each strongly connected component.
+ %
+:- pred inter_proc_rpta(module_info::in, rpta_info_table::in,
+ rpta_info_table::out) is det.
+
+inter_proc_rpta(ModuleInfo0, !InfoTable) :-
+ module_info_ensure_dependency_info(ModuleInfo0, ModuleInfo),
+ module_info_get_maybe_dependency_info(ModuleInfo, MaybeDepInfo),
+ (
+ MaybeDepInfo = yes(DepInfo)
+ ->
+ hlds_dependency_info_get_dependency_ordering(DepInfo, DepOrdering),
+ run_with_dependencies(DepOrdering, ModuleInfo, !InfoTable)
+ ;
+ unexpected(this_file, "inter_proc_rpta: no dependency information")
+ ).
+
+:- pred run_with_dependencies(dependency_ordering::in, module_info::in,
+ rpta_info_table::in, rpta_info_table::out) is det.
+
+run_with_dependencies(Deps, ModuleInfo, !InfoTable) :-
+ list.foldl(run_with_dependency(ModuleInfo), Deps, !InfoTable).
+
+:- pred run_with_dependency(module_info::in, list(pred_proc_id)::in,
+ rpta_info_table::in, rpta_info_table::out) is det.
+
+run_with_dependency(ModuleInfo, SCC, !InfoTable) :-
+ (
+ % Analysis ignores special predicates.
+ some_are_special_preds(SCC, ModuleInfo)
+ ->
+ true
+ ;
+ % For each list of strongly connected components,
+ % perform a fixpoint computation.
+ rpta_info_fixpoint_table_init(SCC, !.InfoTable, FPtable0),
+ run_with_dependency_until_fixpoint(SCC, FPtable0, ModuleInfo,
+ !InfoTable)
+ ).
+
+:- pred run_with_dependency_until_fixpoint(list(pred_proc_id)::in,
+ rpta_info_fixpoint_table::in, module_info::in, rpta_info_table::in,
+ rpta_info_table::out) is det.
+
+run_with_dependency_until_fixpoint(SCC, FPtable0, ModuleInfo,
!InfoTable) :-
+ list.foldl(inter_analyse_pred_proc(ModuleInfo, !.InfoTable), SCC,
+ FPtable0, FPtable1),
+ (
+ rpta_info_fixpoint_table_all_stable(FPtable1)
+ ->
+ % If all rpta_info's in the FPTable are intact
+ % update the main InfoTable.
+ list.foldl(update_rpta_info_in_rpta_info_table(FPtable1), SCC,
+ !InfoTable)
+ ;
+ % Some is not fixed, start all over again.
+ rpta_info_fixpoint_table_new_run(FPtable1, FPtable2),
+ run_with_dependency_until_fixpoint(SCC, FPtable2, ModuleInfo,
+ !InfoTable)
+ ).
+
+:- pred inter_analyse_pred_proc(module_info::in, rpta_info_table::in,
+ pred_proc_id::in, rpta_info_fixpoint_table::in,
+ rpta_info_fixpoint_table::out) is det.
+
+inter_analyse_pred_proc(ModuleInfo, InfoTable, PPId, !FPTable) :-
+ % Look up the caller's rpta_info,
+ % it should be there already after the intraprocedural analysis.
+ % We start the interprocedural analysis of a procedure with this
+ % rpta_info.
+ lookup_rpta_info(PPId, InfoTable, !FPTable, CallerRptaInfo0, _),
+
+ % Start the analysis of the procedure's body.
+ %
+ % We will need the information about program point for storing alpha
+ % mapping.
+ module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+ fill_goal_path_slots(ModuleInfo, ProcInfo, ProcInfo1),
+
+ % Goal now will contain information of program points.
+ proc_info_get_goal(ProcInfo1, Goal),
+
+ inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPTable,
+ CallerRptaInfo0, CallerRptaInfo),
+
+ % Put into the fixpoint table.
+ rpta_info_fixpoint_table_new_rpta_info(PPId, CallerRptaInfo, !FPTable).
+
+ % Analyse a given goal, with module_info and fixpoint table
+ % to lookup extra information, starting from an initial abstract
+ % substitution, and creating a new one. During this process,
+ % the fixpoint table might change (when recursive predicates are
+ % encountered).
+ %
+:- pred inter_analyse_goal(module_info::in,
+ rpta_info_table::in, hlds_goal::in, rpta_info_fixpoint_table::in,
+ rpta_info_fixpoint_table::out, rpta_info::in, rpta_info::out) is det.
+
+inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPtable, !RptaInfo) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ inter_analyse_goal_expr(GoalExpr, GoalInfo, ModuleInfo, InfoTable,
+ !FPtable, !RptaInfo).
+
+:- pred inter_analyse_goal_expr(hlds_goal_expr::in, hlds_goal_info::in,
+ module_info::in, rpta_info_table::in, rpta_info_fixpoint_table::in,
+ rpta_info_fixpoint_table::out, rpta_info::in, rpta_info::out) is det.
+
+inter_analyse_goal_expr(conj(_ConjType, Goals), _, ModuleInfo,
+ InfoTable, !FPTable, !RptaInfo) :-
+ list.foldl2(inter_analyse_goal(ModuleInfo, InfoTable), Goals,
+ !FPTable, !RptaInfo).
+
+ % There are two rpta_info's:
+ % one is of the currently-analysed procedure (caller) which we are
going
+ % to update, the other is of the called procedure (callee).
+ %
+ % The input RptaInfo0 is caller's, if the procedure calls itself then
+ % this is also that of the callee but we will retrieve it again
from the
+ % InfoTable.
+ %
+inter_analyse_goal_expr(plain_call(PredId, ProcId, ActualParams, _,_,
_PName),
+ GoalInfo, ModuleInfo, InfoTable, FPTable0, FPTable,
+ !CallerRptaInfo) :-
+ CalleePPId = proc(PredId, ProcId),
+
+ % Get callee's rpta_info.
+ % As what I assume now, after the intraprocedural analysis we have all
+ % the rpta_info's of all the procedures in the InfoTable, therefore
+ % this lookup cannot fail. But it sometimes fails because the callee
+ % can be imported procedures, built-ins and so forth which are not
+ % analysed by the intraprocedural analysis. In such cases, I assume
that
+ % the rpta_info of the caller is not updated, because no information is
+ % available from the callee.
+ % When IsInit = no, the CalleeRptaInfo is dummy.
+ lookup_rpta_info(CalleePPId, InfoTable, FPTable0, FPTable,
+ CalleeRptaInfo, IsInit),
+ (
+ IsInit = bool.yes
+ ;
+ IsInit = bool.no,
+ program_point_init(GoalInfo, CallSite),
+ CalleeRptaInfo = rpta_info(CalleeGraph, _),
+
+ % Collect alpha mapping at this call site.
+ module_info_proc_info(ModuleInfo, CalleePPId, CalleeProcInfo),
+ proc_info_get_headvars(CalleeProcInfo, FormalParams),
+ !.CallerRptaInfo = rpta_info(CallerGraph0, CallerAlphaMappings0),
+ alpha_mapping_at_call_site(FormalParams, ActualParams,
CalleeGraph,
+ CallerGraph0, CallerGraph,
+ map.init, CallerAlphaMappingAtCallSite),
+ svmap.set(CallSite, CallerAlphaMappingAtCallSite,
+ CallerAlphaMappings0, CallerAlphaMappings),
+ CallerRptaInfo1 = rpta_info(CallerGraph, CallerAlphaMappings),
+
+ % Follow the edges from the nodes rooted at the formal parameters
+ % (in the callee's graph) and apply the interprocedural rules to
+ % complete the alpha mapping and update the caller's graph with
+ % the information from the callee's graph.
+ map.keys(CallerAlphaMappingAtCallSite, FormalNodes),
+ apply_rules(FormalNodes, CallSite, [], CalleeRptaInfo,
+ CallerRptaInfo1, !:CallerRptaInfo)
+ ).
+
+inter_analyse_goal_expr(generic_call(_, _, _, _), _, _, _, !FPTable,
+ !RptaInfo) :-
+ unexpected(this_file,
+ "inter_analyse_goal_expr: generic_call not handled").
+
+inter_analyse_goal_expr(switch(_, _, Cases), _, ModuleInfo, InfoTable,
+ !FPTable, !RptaInfo) :-
+ list.foldl2(inter_analyse_case(ModuleInfo, InfoTable), Cases,
+ !FPTable, !RptaInfo).
+
+:- pred inter_analyse_case(module_info::in,
+ rpta_info_table::in, case::in, rpta_info_fixpoint_table::in,
+ rpta_info_fixpoint_table::out, rpta_info::in, rpta_info::out) is det.
+inter_analyse_case(ModuleInfo, InfoTable, Case, !FPtable, !RptaInfo) :-
+ Case = case(_, Goal),
+ inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPtable, !RptaInfo).
+
+ % Unifications are ignored in interprocedural analysis
+ %
+inter_analyse_goal_expr(unify(_, _, _, _, _), _, _, _, !FPTable,
!RptaInfo).
+
+inter_analyse_goal_expr(disj(Goals), _, ModuleInfo, InfoTable,
+ !FPTable, !RptaInfo) :-
+ list.foldl2(inter_analyse_goal(ModuleInfo, InfoTable), Goals,
+ !FPTable, !RptaInfo).
+
+inter_analyse_goal_expr(negation(Goal), _, ModuleInfo, InfoTable,
+ !FPTable, !RptaInfo) :-
+ inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPTable, !RptaInfo).
+
+ % XXX: may need to take into account the Reason.
+ % for now just analyse the goal.
+ %
+inter_analyse_goal_expr(scope(_Reason, Goal), _, ModuleInfo, InfoTable,
+ !FPTable, !RptaInfo) :-
+% (
+% ( Reason = exist_quant(_)
+% ; Reason = promise_solutions(_, _) % XXX ???
+% ; Reason = promise_purity(_, _)
+% ; Reason = commit(_) % XXX ???
+% ; Reason = barrier(_)
+% ; Reason = trace_goal(_, _, _, _, _)
+% ; Reason = from_ground_term(_)
+% ),
+ inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPTable,
!RptaInfo).
+% ;
+% Msg = "inter_analyse_goal_expr: Scope's reason of
from_ground_term "
+% ++ "not handled",
+% unexpected(this_file, Msg)
+% ).
+
+inter_analyse_goal_expr(if_then_else(_Vars, If, Then, Else), _, ModuleInfo,
+ InfoTable, !FPTable, !RptaInfo) :-
+ inter_analyse_goal(ModuleInfo, InfoTable, If, !FPTable, !RptaInfo),
+ inter_analyse_goal(ModuleInfo, InfoTable, Then, !FPTable, !RptaInfo),
+ inter_analyse_goal(ModuleInfo, InfoTable, Else, !FPTable, !RptaInfo).
+
+inter_analyse_goal_expr(GoalExpr, _, _, _, !FPTable, !RptaInfo) :-
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
+ unexpected(this_file,
+ "inter_analyse_goal_expr: foreign code not handled").
+
+inter_analyse_goal_expr(shorthand(_), _, _, _, !FPTable, !RptaInfo) :-
+ unexpected(this_file,
+ "inter_analyse_goal_expr: shorthand goal not handled").
+
+ % As said above, the rpta_info of a procedure when it is looked
+ % up in interprocedural analysis is either in the InfoTable or in the
+ % fixpoint table. If the procedure happens to be imported ones,
built-ins,
+ % and so on, we returns no and initialize the lookup value to a dummy
+ % value.
+ %
+:- pred lookup_rpta_info(pred_proc_id::in, rpta_info_table::in,
+ rpta_info_fixpoint_table::in, rpta_info_fixpoint_table::out,
+ rpta_info::out, bool::out) is det.
+
+lookup_rpta_info(PPId, InfoTable, !FPtable, RptaInfo, Init) :-
+ ( if
+ % First look up in the current fixpoint table,
+ rpta_info_fixpoint_table_get_rpta_info(PPId, RptaInfo0,
+ !.FPtable, FPtable1)
+ then
+ RptaInfo = RptaInfo0,
+ !:FPtable = FPtable1,
+ Init = bool.no
+ else
+ % ... second look up among already recorded rpta_info.
+ ( if
+ RptaInfo0 = rpta_info_table_search_rpta_info(PPId, InfoTable)
+ then
+ RptaInfo = RptaInfo0,
+ Init = bool.no
+ else
+ % Initialize a dummy.
+ RptaInfo = rpta_info(rpt_graph_init, map.init),
+ Init = bool.yes
+ )
+ ).
+
+:- pred update_rpta_info_in_rpta_info_table(rpta_info_fixpoint_table::in,
+ pred_proc_id::in, rpta_info_table::in, rpta_info_table::out) is det.
+
+update_rpta_info_in_rpta_info_table(FPTable, PPId, !InfoTable) :-
+ rpta_info_fixpoint_table_get_final_rpta_info(PPId, RptaInfo, FPTable),
+ rpta_info_table_set_rpta_info(PPId, RptaInfo, !InfoTable).
+
+ % Rule 1:
+ % After two nodes are unified, it can happen that the unified node has
+ % two edges with the same label pointing to 2 different nodes. This
rule
+ % ensures that it happens the 2 nodes will also be unified.
+ %
+ % After a node is unified, the node itself was probably removed from
+ % the graph so we need to trace "it" by the variables assigned to it.
+ % That is why the first argument is the set of variables associated
+ % with the unified node.
+ %
+ % The algorithm is as follows.
+ % 1. If the node has no or one out-arc we have to do nothing and the
+ % predicate quits.
+ % 2. The node has > 1 out-arc, take one of them, find in the rest
+ % another arc that has a same label, unify the end nodes of the two
arcs.
+ % Because of this unification of the end nodes, more unifications are
+ % probably triggered.
+ % 3. Start all over again with the same node and the *updated* graph.
+ %
+:- pred rule_1(set(prog_var)::in, rpt_graph::in, rpt_graph::out) is det.
+
+rule_1(VarSet, !Graph) :-
+ get_node_by_varset(!.Graph, VarSet, UnifiedNode),
+ rptg_get_edgemap(!.Graph, EdgeMap),
+ map.lookup(EdgeMap, UnifiedNode, OutEdgesOfUnifiedNode),
+ map.keys(OutEdgesOfUnifiedNode, OutArcsUnifiedNode),
+ (
+ OutArcsUnifiedNode = [A | As],
+ merge_nodes_reached_by_same_labelled_arcs(A, As, As, !Graph,
+ Happened),
+ (
+ Happened = bool.no
+ ;
+ % Some nodes have been merged, so size of !:Graph is strictly
+ % smaller than that of !.Graph and at some point this
predicate
+ % will end up in the then-branch.
+ Happened = bool.yes,
+ rule_1(VarSet, !Graph)
+ )
+ ;
+ OutArcsUnifiedNode = []
+ ).
+
+ % This predicate unifies the end nodes of the input arc and of an arc
+ % in the list which has the same label as the input arc. When one such
+ % an arc found, the predicate will not look further in the list.
+ % The unification of nodes, if happends, will be propagated by calling
+ % rule_1 predicate mutually recursively.
+ %
+:- pred merge_nodes_reached_by_same_labelled_arcs(rptg_arc::in,
+ list(rptg_arc)::in, list(rptg_arc)::in, rpt_graph::in, rpt_graph::out,
+ bool::out) is det.
+
+ % The loop in this predicate is similar to
+ % for i = ... to N - 1
+ % for j = i+1 to N ...
+ % ...
+ % this clause is reached at the end of the inner loop. No unification
+ % has happened so far therefore the list of arcs (Rest = [A | As])
+ % are still safe to use.
+ %
+
+ % reach this clause means that no unification of nodes happened and
+ % all the out-arcs have been processed (Rest = []).
+ %
+merge_nodes_reached_by_same_labelled_arcs(_, [], [], !Graph, bool.no).
+
+ % Some out-arcs still need to be processed
+ %
+merge_nodes_reached_by_same_labelled_arcs(_, [], [A | As], !Graph,
+ Happened) :-
+ merge_nodes_reached_by_same_labelled_arcs(A, As, As, !Graph, Happened).
+
+merge_nodes_reached_by_same_labelled_arcs(Arc, [A | As], Rest, !Graph,
+ Happened) :-
+ % For a node, we do not allow two arcs with the same label to another
+ % node. So End and E below must be definitely different nodes and we
+ % only need to compare labels.
+ rptg_arc_contents(!.Graph, Arc, _Start, End, ArcContent),
+ rptg_arc_contents(!.Graph, A, _S, E, AC),
+ ( if
+ ArcContent = AC
+ then
+ % Unify the two end nodes.
+ unify_operator(End, E, !.Graph, Graph1),
+
+ % Apply rule 1 after the above unification.
+ rptg_node_contents(Graph1, End, Content),
+ rule_1(Content^varset, Graph1, !:Graph),
+ Happened = bool.yes
+ else
+ % Still not found an arc with the same label, continue the
+ % inner loop.
+ merge_nodes_reached_by_same_labelled_arcs(Arc, As, Rest, !Graph,
+ Happened)
+ ).
+
+ % This predicate wraps rule_1 to work with rpta_info type.
+ %
+:- pred apply_rule_1(rptg_node::in, rpta_info::in, rpta_info::out) is det.
+
+apply_rule_1(Node, !RptaInfo) :-
+ !.RptaInfo = rpta_info(Graph0, AlphaMapping),
+ rptg_node_contents(Graph0, Node, Content),
+ rule_1(Content^varset, Graph0, Graph1),
+ !:RptaInfo = rpta_info(Graph1, AlphaMapping).
+
+ % Rule 2:
+ % After an edge <N, Label, M) is added to a graph, it may happen
+ % that there exists another edge from N with the same label but
+ % pointing to a node different from M. This rule ensures that if that
+ % the case the node will be unified with M.
+ %
+ % This predicate is called whenever a new edge has been added to the
+ % graph. So when it is called there is at most one existing edge with
+ % the same label to a different node. Because of that the predicate
+ % need not be recursive.
+ %
+:- pred rule_2(set(prog_var)::in, set(prog_var)::in, cons_id::in, int::in,
+ rpt_graph::in, rpt_graph::out) is det.
+
+rule_2(SVarSet, EVarSet, ConsId, Component, !Graph) :-
+ get_node_by_varset(!.Graph, SVarSet, N),
+ get_node_by_varset(!.Graph, EVarSet, M),
+ Sel = [termsel(ConsId, Component)],
+ rptg_get_edgemap(!.Graph, EdgeMap),
+ map.lookup(EdgeMap, N, OutEdgesN),
+ map.keys(OutEdgesN, OutArcsN),
+ merge_nodes_reached_by_same_labelled_arc(Sel, M, OutArcsN, !Graph).
+
+ % If an A(rc) in OutArcsN has the same label Sel then merge M
+ % with the node (MPrime) that the A(rc) points to.
+ %
+:- pred merge_nodes_reached_by_same_labelled_arc(selector::in,
+ rptg_node::in, list(rptg_arc)::in, rpt_graph::in, rpt_graph::out)
is det.
+
+merge_nodes_reached_by_same_labelled_arc(_, _, [], !Graph).
+merge_nodes_reached_by_same_labelled_arc(Sel, M, [A | As], !Graph) :-
+ rptg_arc_contents(!.Graph, A, _, MPrime, ArcContent),
+ ( if
+ ArcContent = rptg_arc_content(Selector),
+ Selector = Sel,
+ MPrime \= M
+ then
+ unify_operator(M, MPrime, !.Graph, Graph1),
+ rptg_node_contents(Graph1, M, Content),
+ rule_1(Content^varset, Graph1, !:Graph)
+ else
+ % still not found an arc with the same label, continue the loop
+ merge_nodes_reached_by_same_labelled_arc(Sel, M, As, !Graph)
+ ).
+
+ % This predicate wraps rule_2 to work with rpta_info type.
+ %
+:- pred apply_rule_2(rptg_node::in, rptg_node::in, cons_id::in, int::in,
+ rpta_info::in, rpta_info::out) is det.
+
+apply_rule_2(Start, End, ConsId, Component, !RptaInfo) :-
+ !.RptaInfo = rpta_info(Graph0, AlphaMapping),
+ rptg_node_contents(Graph0, Start, SContent),
+ rptg_node_contents(Graph0, End, EContent),
+ rule_2(SContent^varset, EContent^varset, ConsId, Component,
+ Graph0, Graph),
+ !:RptaInfo = rpta_info(Graph, AlphaMapping).
+
+ % Rule 3:
+ % This rule is applied after an edge is added TO the Node to enforce
+ % the invariant that a subterm of the same type as the compounding
+ % term is stored in the same region as the compounding term. In
+ % the context of region points-to graph it means that there exists
+ % a path between 2 nodes of the same type. In that case, this rule
+ % will unify the 2 nodes.
+ %
+ % This algorithm may not be an efficient one because it checks all
+ % the nodes in the graph one by one to see if a node can reach the
+ % node or not.
+ %
+ % We enforce the invariant (in the sense that whenever the invariant
+ % is made invalid this rule will correct it) therefore whenever we
+ % find a satisfied node and unify it with Node we can stop. This is
+ % indicated by Happened.
+ %
+:- pred rule_3(rptg_node::in, rpt_graph::in, rpt_graph::out) is det.
+
+rule_3(Node, !Graph) :-
+ rptg_get_nodemap(!.Graph, NodeMap),
+ map.keys(NodeMap, Nodes),
+ (
+ Nodes = [_N | _NS],
+ % The graph has some node(s), so check each node to see if it
+ % satisfies the condition of rule 3 or not, if yes unify it
+ % with NY (NY is the node that Node may be merged into.)
+ get_node_by_node(!.Graph, Node, NY),
+ rule_3_2(Nodes, NY, !Graph, Happened),
+
+ % This predicate will quit when Happened = no, i.e. no more
+ % nodes need to be unified.
+ (
+ Happened = bool.yes,
+ % A node in Nodes has been unified with NY, so we start all
+ % over again. Note that the node that has been unified has
+ % been removed, so it will not be in the Graph1 in the below
+ % call. So this predicate can terminate at some point (due
+ % to the fact that the "size" of !.Graph is smaller than that
+ % of !:Graph).
+ rule_3(Node, !Graph)
+ ;
+ % no node in Nodes has been unified with NY, which means that
+ % no more nodes need to be unified, so just quit.
+ Happened = bool.no
+ )
+ ;
+ Nodes = [],
+ % no node in the graph, impossible
+ unexpected(this_file, "rule_3: impossible having no node in graph")
+ ).
+
+ % Check each node in the list to see if it satisfies the condition of
+ % rule 3 or not, i.e., link to another node with the same type.
+ % 1. If the predicate finds out such a node, it unifies it with NY
+ % (also apply rule 1 here) and quit with Happend = 1.
+ % 2. if no such a node found, it processes the rest of the list. The
+ % process continues like that until either 1. happens (the case above)
+ % or the list becomes empty and the predicate quits with Happened = 0.
+ %
+:- pred rule_3_2(list(rptg_node)::in, rptg_node::in, rpt_graph::in,
+ rpt_graph::out, bool::out) is det.
+
+rule_3_2([], _, !Graph, bool.no).
+rule_3_2([NZ | NZs], NY, !Graph, Happened) :-
+ ( if
+ rule_3_condition(NZ, NY, !.Graph, NZ1)
+ then
+ unify_operator(NZ, NZ1, !.Graph, Graph1),
+
+ % apply rule 1
+ rptg_node_contents(Graph1, NZ, Content),
+ rule_1(Content^varset, Graph1, !:Graph),
+ Happened = bool.yes
+ else
+ % try with the rest, namely NS
+ rule_3_2(NZs, NY, !Graph, Happened)
+ ).
+
+:- pred rule_3_condition(rptg_node::in, rptg_node::in, rpt_graph::in,
+ rptg_node::out) is semidet.
+
+rule_3_condition(NZ, NY, Graph, NZ1) :-
+ rptg_path(Graph, NZ, NY, _),
+ rptg_lookup_node_type(Graph, NZ) = NZType,
+ % A node reachable from NY, with the same type as NZ, the node can
+ % be exactly NY
+ reachable_and_having_type(Graph, NY, NZType, NZ1),
+ NZ \= NZ1.
+
+ % This predicate is just to wrap the call to rule_3 so that the
+ % changed graph is put into rpta_info structure.
+ %
+:- pred apply_rule_3(rptg_node::in, rpta_info::in, rpta_info::out) is det.
+
+apply_rule_3(Node, !RptaInfo) :-
+ !.RptaInfo = rpta_info(Graph0, AlphaMapping),
+ rule_3(Node, Graph0, Graph),
+ !:RptaInfo = rpta_info(Graph, AlphaMapping).
+
+
+%-----------------------------------------------------------------------------%
+%
+% Collecting alpha mapping and application of rule P4.
+%
+
+ % Build up the alpha mapping (node -> node) and apply rule P4
+ % to ensure that it is actually a function.
+ %
+:- pred alpha_mapping_at_call_site(list(prog_var)::in, list(prog_var)::in,
+ rpt_graph::in, rpt_graph::in, rpt_graph::out,
+ map(rptg_node, rptg_node)::in, map(rptg_node, rptg_node)::out) is det.
+
+alpha_mapping_at_call_site([], [], _, !CallerGraph, !AlphaMap).
+alpha_mapping_at_call_site([], [_ | _], _, !CallerGraph, !AlphaMap) :-
+ unexpected(this_file,
+ "alpha_mapping_at_call_site: actuals and formals not match").
+alpha_mapping_at_call_site([_ | _], [], _, !CallerGraph, !AlphaMap) :-
+ unexpected(this_file,
+ "alpha_mapping_at_call_site: actuals and formals not match").
+ % Xi's are formal arguments, Yi's are actual arguments at the call site
+ %
+alpha_mapping_at_call_site([Xi | Xs], [Yi | Ys], CalleeGraph,
+ !CallerGraph, !AlphaMap) :-
+ get_node_by_variable(CalleeGraph, Xi, N_Xi),
+ get_node_by_variable(!.CallerGraph, Yi, N_Yi),
+ ( if
+ map.search(!.AlphaMap, N_Xi, N_Y)
+ then
+ % alpha(N_Xi) = N_Y, alpha(N_Xi) = N_Yi, N_Y != N_Yi
+ %
+ ( if
+ N_Y \= N_Yi
+ then
+ % Apply rule P4
+ unify_operator(N_Y, N_Yi, !.CallerGraph, CallerGraph1),
+
+ % Apply rule P1 after some nodes are unified
+ rptg_node_contents(CallerGraph1, N_Y, Content),
+ rule_1(Content^varset, CallerGraph1, CallerGraph2)
+ else
+ CallerGraph2 = !.CallerGraph
+ )
+ else
+ svmap.set(N_Xi, N_Yi, !AlphaMap),
+ CallerGraph2 = !.CallerGraph
+ ),
+ alpha_mapping_at_call_site(Xs, Ys, CalleeGraph,
+ CallerGraph2, !:CallerGraph, !AlphaMap).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% Rules P5-P8 complete the alpha mapping at a call site and integrate the
+% parts rooted at the formal parameters in the callee's graph into the
+% caller's graph.
+%
+% The application of those rules happens at a call site, so related to a
+% caller and a callee.
+%
+% We will start from the rooted nodes, follow each outcoming edge in the
+% callee's graph exactly once and apply the rules.
+%
+
+:- pred apply_rules(list(rptg_node)::in, program_point::in,
+ list(rptg_node)::in, rpta_info::in, rpta_info::in,
+ rpta_info::out) is det.
+
+apply_rules([], _, _, _, !CallerRptaInfo).
+apply_rules([CalleeNode | CalleeNodes0], CallSite, Processed,
CalleeRptaInfo,
+ !CallerRptaInfo) :-
+ % The caller node corresponding to the callee node at this call site.
+ !.CallerRptaInfo = rpta_info(_, CallerAlphaMapping0),
+ map.lookup(CallerAlphaMapping0, CallSite, AlphaAtCallSite),
+ map.lookup(AlphaAtCallSite, CalleeNode, CallerNode),
+
+ % Follow CalleeNode and apply rules when traversing its edges.
+ apply_rules_node(CallSite, CalleeNode, CalleeRptaInfo, CallerNode,
+ !CallerRptaInfo),
+
+ % Continue with the nodes reached from Callee Node.
+ CalleeRptaInfo = rpta_info(CalleeGraph, _),
+ rptg_successors(CalleeGraph, CalleeNode, SuccessorsCalleeNode),
+ set.to_sorted_list(SuccessorsCalleeNode, SsList),
+ list.delete_elems(SsList, Processed, ToBeProcessed),
+ CalleeNodes = ToBeProcessed ++ CalleeNodes0,
+ apply_rules(CalleeNodes, CallSite, [CalleeNode | Processed],
+ CalleeRptaInfo, !CallerRptaInfo).
+
+:- pred apply_rules_node(program_point::in, rptg_node::in, rpta_info::in,
+ rptg_node::in, rpta_info::in, rpta_info::out) is det.
+
+apply_rules_node(CallSite, CalleeNode, CalleeRptaInfo, CallerNode,
+ !CallerRptaInfo) :-
+ CalleeRptaInfo = rpta_info(CalleeGraph, _),
+
+ % Apply rules P5-P8 for each out-edge of CalleeNode.
+ rptg_get_edgemap(CalleeGraph, EdgeMap),
+ map.lookup(EdgeMap, CalleeNode, CalleeNodeOutEdges),
+ map.keys(CalleeNodeOutEdges, CalleeNodeOutArcs),
+ apply_rules_arcs(CalleeNodeOutArcs, CallerNode, CallSite,
+ CalleeRptaInfo, !CallerRptaInfo).
+
+:- pred apply_rules_arcs(list(rptg_arc)::in, rptg_node::in,
+ program_point::in, rpta_info::in, rpta_info::in, rpta_info::out) is
det.
+
+apply_rules_arcs([], _, _, _, !RptaInfoR).
+apply_rules_arcs([Arc | Arcs], CallerNode, CallSite, CalleeRptaInfo,
+ !CallerRptaInfo) :-
+ rule_5(Arc, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo),
+ rule_6(Arc, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo),
+ rule_7(Arc, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo),
+ rule_8(Arc, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo),
+ apply_rules_arcs(Arcs, CallerNode, CallSite, CalleeRptaInfo,
+ !CallerRptaInfo).
+
+:- pred rule_5(rptg_arc::in, program_point::in, rpta_info::in,
+ rptg_node::in, rpta_info::in, rpta_info::out) is det.
+
+rule_5(Arc, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo) :-
+ % Find an out-arc in the caller's graph that has a same label
+ % the label of the out-arc in callee's graph
+ CalleeRptaInfo = rpta_info(CalleeGraph, _),
+ rptg_arc_contents(CalleeGraph, Arc, _CalleeNode, CalleeM, Label),
+ !.CallerRptaInfo = rpta_info(CallerGraph0, CallerAlphaMapping0),
+ get_node_by_node(CallerGraph0, CallerNode, RealCallerNode),
+ ( if
+ find_arc_from_node_with_same_label(RealCallerNode, Label,
+ CallerGraph0, CallerMPrime),
+ map.search(CallerAlphaMapping0, CallSite, AlphaAtCallSite),
+ map.search(AlphaAtCallSite, CalleeM, CallerM),
+ get_node_by_node(CallerGraph0, CallerM, RealCallerM),
+ CallerMPrime \= RealCallerM
+ then
+ % When the premises of rule P5 are satisfied, nodes are unified and
+ % rule P1 applied to ensure invariants.
+ unify_operator(RealCallerM, CallerMPrime,
+ CallerGraph0, CallerGraph1),
+ CallerRptaInfo1 = rpta_info(CallerGraph1, CallerAlphaMapping0),
+ apply_rule_1(RealCallerM, CallerRptaInfo1, !:CallerRptaInfo)
+ else
+ true
+ ).
+
+:- pred rule_6(rptg_arc::in, program_point::in, rpta_info::in,
+ rptg_node::in, rpta_info::in, rpta_info::out) is det.
+rule_6(Arc, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo) :-
+ % Find an out-arc in the caller's graph that has a same label
+ % the label of the out-arc in callee's graph.
+ CalleeRptaInfo = rpta_info(CalleeGraph, _),
+ rptg_arc_contents(CalleeGraph, Arc, _CalleeNode, CalleeM, Label),
+ !.CallerRptaInfo = rpta_info(CallerGraph, CallerAlphaMapping0),
+ get_node_by_node(CallerGraph, CallerNode, RealCallerNode),
+ ( if
+ find_arc_from_node_with_same_label(RealCallerNode, Label,
+ CallerGraph, CallerM)
+ then
+ % (CallerNode, sel, CallerM) in the graph.
+ map.lookup(CallerAlphaMapping0, CallSite, AlphaAtCallSite0),
+ ( if
+ map.search(AlphaAtCallSite0, CalleeM, _)
+ then
+ % alpha(CalleeM) = CallerM so ignore.
+ true
+ else
+ % Apply rule P6 when its premises are satisfied
+ % record alpha(CalleeM) = CallerM.
+ svmap.set(CalleeM, CallerM, AlphaAtCallSite0,
AlphaAtCallSite1),
+ svmap.set(CallSite, AlphaAtCallSite1, CallerAlphaMapping0,
+ CallerAlphaMapping),
+ !:CallerRptaInfo = rpta_info(CallerGraph, CallerAlphaMapping)
+ )
+ else
+ true
+ ).
+
+:- pred rule_7(rptg_arc::in, program_point::in, rpta_info::in,
+ rptg_node::in, rpta_info::in, rpta_info::out) is det.
+rule_7(Arc, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo) :-
+ % Find an out-arc in the caller's graph that has a same label
+ % the label of the out-arc in callee's graph.
+ CalleeRptaInfo = rpta_info(CalleeGraph, _),
+ rptg_arc_contents(CalleeGraph, Arc, _CalleeNode, CalleeM, Label),
+ !.CallerRptaInfo = rpta_info(CallerGraph0, CallerAlphaMapping),
+ get_node_by_node(CallerGraph0, CallerNode, RealCallerNode),
+ ( if
+ find_arc_from_node_with_same_label(RealCallerNode, Label,
+ CallerGraph0, _)
+ then
+ true
+ else
+ % No edge from CallerNode with the label exists.
+ ( if
+ map.lookup(CallerAlphaMapping, CallSite, AlphaAtCallSite),
+ map.search(AlphaAtCallSite, CalleeM, CallerM)
+ then
+ % Reach here means all the premises of rule P7 are satisfied,
+ % add (CallerNode, sel, CallerM).
+ get_node_by_node(CallerGraph0, CallerM, RealCallerM),
+ edge_operator(RealCallerNode, RealCallerM, Label,
+ CallerGraph0, CallerGraph1),
+
+ % Need to apply rule 3.
+ rule_3(RealCallerM, CallerGraph1, CallerGraph2),
+ !:CallerRptaInfo = rpta_info(CallerGraph2, CallerAlphaMapping)
+ else
+ true
+ )
+ ).
+
+:- pred rule_8(rptg_arc::in, program_point::in, rpta_info::in,
+ rptg_node::in, rpta_info::in, rpta_info::out) is det.
+rule_8(Arc, CallSite, CalleeRptaInfo, CallerNode, !CallerRptaInfo) :-
+ % Find an out-arc in the caller's graph that has a same label
+ % the label of the out-arc in callee's graph
+ CalleeRptaInfo = rpta_info(CalleeGraph, _),
+ rptg_arc_contents(CalleeGraph, Arc, _CalleeNode, CalleeM, Label),
+ !.CallerRptaInfo = rpta_info(CallerGraph0, CallerAlphaMapping0),
+ get_node_by_node(CallerGraph0, CallerNode, RealCallerNode),
+ ( if
+ find_arc_from_node_with_same_label(RealCallerNode, Label,
+ CallerGraph0, _)
+ then
+ true
+ else
+ % No edge from CallerNode with the label exists.
+ ( if
+ map.lookup(CallerAlphaMapping0, CallSite, AlphaAtCallSite0),
+ map.search(AlphaAtCallSite0, CalleeM, _)
+ then
+ true
+ else
+ % rule 8: add node CallerM, alpha(CalleeM) = CallerM,
+ % edge(CallerNode, sel, CallerM)
+ %
+ rptg_get_node_supply(CallerGraph0, NS0),
+ string.append("R", string.int_to_string(NS0 + 1), RegName),
+ CallerMContent = rptg_node_content(set.init, RegName,
set.init,
+ rptg_lookup_node_type(CalleeGraph, CalleeM)),
+ rptg_set_node(CallerMContent, CallerM,
+ CallerGraph0, CallerGraph1),
+ edge_operator(RealCallerNode, CallerM, Label,
+ CallerGraph1, CallerGraph2),
+
+ map.lookup(CallerAlphaMapping0, CallSite, AlphaAtCallSite0),
+ svmap.set(CalleeM, CallerM, AlphaAtCallSite0, AlphaAtCallSite),
+ svmap.set(CallSite, AlphaAtCallSite,
+ CallerAlphaMapping0, CallerAlphaMapping),
+
+ rule_3(CallerM, CallerGraph2, CallerGraph),
+ !:CallerRptaInfo = rpta_info(CallerGraph, CallerAlphaMapping)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Fixpoint table used in region points-to analysis.
+%
+
+:- type rpta_info_fixpoint_table ==
+ fixpoint_table(pred_proc_id, rpta_info).
+
+ % Initialise the fixpoint table for the given set of pred_proc_id's.
+ %
+:- pred rpta_info_fixpoint_table_init(list(pred_proc_id)::in,
+ rpta_info_table::in, rpta_info_fixpoint_table::out) is det.
+
+rpta_info_fixpoint_table_init(Keys, InfoTable, Table):-
+ fp_init(wrapped_init(InfoTable), Keys, Table).
+
+ % Add the results of a new analysis pass to the already existing
+ % fixpoint table.
+ %
+:- pred rpta_info_fixpoint_table_new_run(rpta_info_fixpoint_table::in,
+ rpta_info_fixpoint_table::out) is det.
+
+rpta_info_fixpoint_table_new_run(Tin, Tout) :-
+ fp_new_run(Tin,Tout).
+
+ % The fixpoint table keeps track of the number of analysis passes. This
+ % predicate returns this number.
+ %
+:- pred rpta_info_fixpoint_table_which_run(rpta_info_fixpoint_table::in,
+ int::out) is det.
+
+rpta_info_fixpoint_table_which_run(Tin, Run) :-
+ Run = fp_which_run(Tin).
+
+ % A fixpoint is reached if all entries in the table are stable,
+ % i.e. haven't been modified by the last analysis pass.
+ %
+:- pred rpta_info_fixpoint_table_all_stable(rpta_info_fixpoint_table::in)
+ is semidet.
+
+rpta_info_fixpoint_table_all_stable(Table) :-
+ fp_stable(Table).
+
+ % Enter the newly computed region points-to information for a given
+ % procedure.
+ % If the description is different from the one that was already stored
+ % for that procedure, the stability of the fixpoint table is set to
+ % "unstable".
+ % Aborts if the procedure is not already in the fixpoint table.
+ %
+:- pred rpta_info_fixpoint_table_new_rpta_info(pred_proc_id::in,
+ rpta_info::in, rpta_info_fixpoint_table::in,
+ rpta_info_fixpoint_table::out) is det.
+
+rpta_info_fixpoint_table_new_rpta_info(PredProcId, RptaInfo, Tin, Tout) :-
+ fp_add(
+ pred(TabledElem::in, Elem::in) is semidet :-
+ (
+ rpta_info_equal(Elem, TabledElem)
+ ),
+ PredProcId, RptaInfo, Tin, Tout).
+
+ % Retrieve the rpta_info of a given pred_proc_id. If this information
+ % is not available, this means that the set of pred_proc_id's to which
+ % the fixpoint table relates are mutually recursive, hence the table
+ % is characterised as recursive.
+ % Fails if the procedure is not in the table.
+ %
+:- pred rpta_info_fixpoint_table_get_rpta_info(pred_proc_id::in,
+ rpta_info::out, rpta_info_fixpoint_table::in,
+ rpta_info_fixpoint_table::out) is semidet.
+
+rpta_info_fixpoint_table_get_rpta_info(PredProcId, RptaInfo, Tin, Tout) :-
+ fp_get(PredProcId, RptaInfo, Tin, Tout).
+
+ % Retreive rpta_info, without changing the table. To be used after
+ % fixpoint has been reached. Aborts if the procedure is not in the
table.
+ %
+:- pred rpta_info_fixpoint_table_get_final_rpta_info(pred_proc_id::in,
+ rpta_info::out, rpta_info_fixpoint_table::in) is det.
+
+rpta_info_fixpoint_table_get_final_rpta_info(PredProcId, RptaInfo, T):-
+ fp_get_final(PredProcId, RptaInfo, T).
+
+:- pred wrapped_init(rpta_info_table::in, pred_proc_id::in, rpta_info::out)
+ is det.
+
+wrapped_init(InfoTable, PredProcId, E) :-
+ ( if
+ rpta_info_table_search_rpta_info(PredProcId, InfoTable) = Entry
+ then
+ E = Entry
+ else
+ % The information we are looking for should be there after the
+ % intraprocedural analysis.
+ unexpected(this_file, "wrapper_init: rpta_info should exist.")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "rbmm.points_to_analysis.m".
+
+%-----------------------------------------------------------------------------%
Index: rbmm.points_to_graph.m
===================================================================
RCS file: rbmm.points_to_graph.m
diff -N rbmm.points_to_graph.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.points_to_graph.m 22 May 2007 02:22:03 -0000
@@ -0,0 +1,980 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 The 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: rbmm.points_to_graph.m.
+% Main author: Quan Phan.
+%
+% This module defines the region points-to graph data structure and the
+% operations on it.
+
+:- module transform_hlds.rbmm.points_to_graph.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module set.
+:- import_module string.
+
+ % A region points-to graph rpt_graph(Node, Arc) represents a directed
+ % graph with information type Node associated with each node, and
+ % information of type Arc associated with each arc.
+ %
+:- type rpt_graph
+ ---> rpt_graph(
+ rptg_node_supply, % the counter for node
+ rptg_arc_supply, % the counter for arc
+ map(rptg_node, rptg_node_content),
+ map(rptg_arc, rptg_arc_info),
+ map(rptg_node, map(rptg_arc, rptg_node))
+ ).
+
+:- type rptg_node_supply == int.
+:- type rptg_arc_supply == int.
+
+:- type rptg_node
+ ---> rptg_node(int).
+
+:- type rptg_node_content
+ ---> rptg_node_content(
+ % set of procedure variables assigned to this node
+ varset :: set(prog_var),
+ % the region variable that names this node
+ reg_var_name :: string,
+ merged_from :: set(rptg_node),
+ node_type :: mer_type
+ ).
+
+:- pred rptg_node_content_get_varset(rptg_node_content::in,
+ set(prog_var)::out) is det.
+:- pred rptg_node_content_get_region_name(rptg_node_content::in,
+ string::out) is det.
+:- pred rptg_node_content_get_merged_from(rptg_node_content::in,
+ set(rptg_node)::out) is det.
+:- pred rptg_node_content_get_node_type(rptg_node_content::in,
+ mer_type::out) is det.
+
+:- pred rptg_node_content_set_varset(set(prog_var)::in,
+ rptg_node_content::in, rptg_node_content::out) is det.
+:- pred rptg_node_content_set_region_name(string::in,
rptg_node_content::in,
+ rptg_node_content::out) is det.
+:- pred rptg_node_content_set_merged_from(set(rptg_node)::in,
+ rptg_node_content::in, rptg_node_content::out) is det.
+:- pred rptg_node_content_set_node_type(mer_type::in,
rptg_node_content::in,
+ rptg_node_content::out) is det.
+
+:- type rptg_arc
+ ---> rptg_arc(int).
+
+:- type rptg_arc_content
+ ---> rptg_arc_content(
+ label :: selector % the label of an edge
+ ).
+
+:- pred rptg_arc_content_get_label(rptg_arc_content::in, selector::out)
is det.
+:- pred rptg_arc_content_set_label(selector::in, rptg_arc_content::in,
+ rptg_arc_content::out) is det.
+
+:- type rptg_arc_info
+ ---> rptg_arc_info(
+ rptg_node, % the from node
+ rptg_node, % the to node
+ rptg_arc_content % the label
+ ).
+
+ % rpt_graph_init(Graph) binds Graph to an empty graph
+ % containing no nodes and no arcs. (The graph contains
+ % a counter of the number of nodes allocated in it, so
+ % it is possible for a graph to contain no nodes or arcs
+ % and still fail to unify with the binding of Graph from
+ % rpt_graph_init.)
+ %
+:- pred rpt_graph_init(rpt_graph::out) is det.
+
+:- func rpt_graph_init = rpt_graph.
+
+ % rptg_set_node(NodeInfo, Node, OldGraph, NewGraph) takes
+ % OldGraph and NodeInfo which is the information to be stored
+ % in a new node, and returns a key "Node" which refers to that
+ % node, and the new graph NewGraph containing all of the nodes
+ % and arcs in OldGraph as well as the new node.
+ % It is possible to have two nodes in the graph with the
+ % same information stored in them.
+ %
+ % This operation is O(lgN) for a graph containing N nodes.
+ %
+:- pred rptg_set_node(rptg_node_content::in, rptg_node::out,
+ rpt_graph::in, rpt_graph::out) is det.
+
+ % rptg_node_contents(Graph, Node, NodeContent) takes Graph and
+ % Node and returns the information NodeContent stored in Node.
+ %
+ % This operation is O(lgN) for a graph containing N nodes.
+ %
+:- pred rptg_node_contents(rpt_graph::in,
+ rptg_node::in, rptg_node_content::out) is det.
+:- func rptg_node_contents(rpt_graph, rptg_node) = rptg_node_content.
+
+ % rptg_successors(Graph, Node, Nodes) takes a graph Graph and
+ % a node Node and returns the set of nodes Nodes that are reachable
+ % (directly - not transitively) from Node.
+ %
+ % This operation is O(NlgN) for a graph containing N nodes.
+ %
+:- pred rptg_successors(rpt_graph::in, rptg_node::in, set(rptg_node)::out)
+ is det.
+:- func rptg_successors(rpt_graph, rptg_node) = set(rptg_node).
+
+ % rptg_get_nodes(Graph, Nodes) binds Nodes to the set of nodes in
Graph.
+ %
+:- pred rptg_get_nodes(rpt_graph::in, list(rptg_node)::out) is det.
+:- func rptg_get_nodes(rpt_graph) = list(rptg_node).
+
+ % rptg_set_edge(Start, End, ArcInfo, Arc, OldGraph, NewGraph)
+ % takes a graph OldGraph and adds an arc from Start to End with
+ % the information ArcInfo stored in it, and returns a key for
+ % that arc Arc, and the new graph NewGraph.
+ % If an identical arc already exists then this operation has
+ % no effect.
+ %
+ % This operation is O(lgN+lgM) for a graph with N nodes and M arcs.
+ %
+:- pred rptg_set_edge(rptg_node::in, rptg_node::in, rptg_arc_content::in,
+ rptg_arc::out, rpt_graph::in, rpt_graph::out) is det.
+
+ % rptg_arc_contents(Graph, Arc, Start, End, ArcInfo) takes a
+ % graph Graph and an arc Arc and returns the start and end nodes
+ % and the content stored in that arc.
+ %
+:- pred rptg_arc_contents(rpt_graph::in, rptg_arc::in, rptg_node::out,
+ rptg_node::out, rptg_arc_content::out) is det.
+
+ % rptg_path(Graph, Start, End, Path) is true iff there is a path
+ % from the node Start to the node End in Graph that goes through
+ % the sequence of arcs Arcs.
+ % The algorithm will return paths containing at most one cycle.
+ %
+:- pred rptg_path(rpt_graph, rptg_node, rptg_node, list(rptg_arc)).
+:- mode rptg_path(in, in, in, out) is nondet.
+:- mode rptg_path(in, in, out, out) is nondet.
+
+:- pred reachable_and_having_type(rpt_graph::in, rptg_node::in,
mer_type::in,
+ rptg_node::out) is semidet.
+
+:- pred rptg_get_node_supply(rpt_graph::in, rptg_node_supply::out) is det.
+:- pred rptg_get_arc_supply(rpt_graph::in, rptg_arc_supply::out) is det.
+:- pred rptg_get_nodemap(rpt_graph::in,
+ map(rptg_node, rptg_node_content)::out) is det.
+:- pred rptg_get_arcmap(rpt_graph::in, map(rptg_arc, rptg_arc_info)::out)
+ is det.
+:- pred rptg_get_edgemap(rpt_graph::in,
+ map(rptg_node, map(rptg_arc, rptg_node))::out) is det.
+
+:- pred rptg_set_node_supply(rptg_node_supply::in,
+ rpt_graph::in, rpt_graph::out)is det.
+:- pred rptg_set_arc_supply(rptg_arc_supply::in,
+ rpt_graph::in, rpt_graph::out) is det.
+:- pred rptg_set_nodemap(map(rptg_node, rptg_node_content)::in,
+ rpt_graph::in, rpt_graph::out) is det.
+:- pred rptg_set_arcmap(map(rptg_arc, rptg_arc_info)::in,
+ rpt_graph::in, rpt_graph::out) is det.
+:- pred rptg_set_edgemap(map(rptg_node, map(rptg_arc, rptg_node))::in,
+ rpt_graph::in, rpt_graph::out) is det.
+
+ % get a node given the region name (region variable) assigned to it.
+ % There is one and only one node with a given region name.
+ % Therefore the predicate returns the node as soon as it finds.
+ %
+:- pred get_node_by_region_name(rpt_graph::in, string::in,
+ rptg_node::out) is det.
+
+ % Get a node given a set of Mercury variables assigned to it.
+ % There is one and only one node corresponding to a set of variables.
+ % Therefore the predicate returns the node as soon as it finds.
+ %
+:- pred get_node_by_varset(rpt_graph::in, set(prog_var)::in,
+ rptg_node::out) is det.
+
+ % Get a node given a Mercury variable assigned to it.
+ % There is one and only one node of a variable.
+ % Therefore the predicate returns the node as soon as it finds.
+ %
+:- pred get_node_by_variable(rpt_graph::in, prog_var::in,
+ rptg_node::out) is det.
+
+ % Get a node given a node that has been merged into the first one.
+ %
+:- pred get_node_by_node(rpt_graph::in, rptg_node::in, rptg_node::out)
is det.
+
+ % compare two graphs
+ %
+:- pred rptg_equal(rpt_graph::in, rpt_graph::in) is semidet.
+
+ % This predicate returns a set of nodes (regions) reachable from a
+ % variable X
+ %
+:- pred reach_from_a_variable(rpt_graph::in, module_info::in,
proc_info::in,
+ prog_var::in, set(rptg_node)::in, set(rptg_node)::out) is det.
+
+:- func rptg_lookup_region_name(rpt_graph, rptg_node) = string.
+:- func rptg_lookup_node_type(rpt_graph, rptg_node) = mer_type.
+
+ % Implement the unify operator
+ %
+:- pred unify_operator(rptg_node::in, rptg_node::in,
+ rpt_graph::in, rpt_graph::out) is det.
+
+ % Implement the edge operator
+ %
+:- pred edge_operator(rptg_node::in, rptg_node::in, rptg_arc_content::in,
+ rpt_graph::in, rpt_graph::out) is det.
+
+ % This predicate finds, in the graph, an edge which has the given
label.
+ % If found, it returns the node which the edge points to.
+ % Fails if no such an edge exists.
+ %
+ % Note: this predicate is used when we do not know the end node. If we
+ % know the start node, the label and the end node, we may want to use
+ % edge_in_graph instead.
+ %
+:- pred find_arc_from_node_with_same_label(rptg_node::in,
+ rptg_arc_content::in, rpt_graph::in, rptg_node::out) is semidet.
+
+ % Check if an edge (Start, Label, End) is in the Graph or not
+ %
+:- pred edge_in_graph(rptg_node::in, rptg_arc_content::in, rptg_node::in,
+ rpt_graph::in) is semidet.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module transform_hlds.smm_common.
+
+:- import_module assoc_list.
+:- import_module pair.
+:- import_module solutions.
+:- import_module svmap.
+:- import_module svset.
+:- import_module term.
+
+rpt_graph_init(Graph) :-
+ Graph = rpt_graph(0, 0, Nodes, Arcs, Edges),
+ map.init(Nodes),
+ map.init(Arcs),
+ map.init(Edges).
+
+rpt_graph_init = G :-
+ rpt_graph_init(G).
+
+ % After adding a node with Content into the graph, we need to
update the
+ % Content so that the merged_from set of the node contains itself.
+ % Doing it this way is not completely satisfied because we are adding a
+ % node with the given content but we change the content after all.
+ % But without adding the node first, the node is nonexistant and we
+ % cannot make add it to the merged_from set.
+ %
+rptg_set_node(Content0, rptg_node(N), G0, G) :-
+ rptg_get_node_supply(G0, NS0),
+ NS = NS0 + 1,
+ N = NS,
+ rptg_set_node_supply(NS, G0, G1),
+
+ % make the merged_from set contain this node
+ set.init(MergedFrom0),
+ svset.insert(rptg_node(NS), MergedFrom0, MergedFrom1),
+ rptg_node_content_set_merged_from(MergedFrom1, Content0, Content),
+
+ rptg_get_nodemap(G1, NodeMap0),
+ svmap.set(rptg_node(N), Content, NodeMap0, NodeMap),
+ rptg_set_nodemap(NodeMap, G1, G2),
+
+ % set edge
+ rptg_get_edgemap(G2, EdgeMap0),
+ svmap.set(rptg_node(N), map.init, EdgeMap0, EdgeMap),
+ rptg_set_edgemap(EdgeMap, G2, G).
+
+rptg_node_contents(G, N, Content) :-
+ rptg_get_nodemap(G, NodeMap),
+ map.lookup(NodeMap, N, Content).
+
+rptg_node_contents(G, N) = NC :-
+ rptg_node_contents(G, N, NC).
+
+rptg_get_nodes(G, Ns) :-
+ rptg_get_nodemap(G, NodeMap),
+ map.keys(NodeMap, Ns).
+
+rptg_get_nodes(G) = Ns :-
+ rptg_get_nodes(G,Ns).
+
+rptg_successors(G, N, Ss) :-
+ rptg_get_edgemap(G, EdgeMap),
+ map.lookup(EdgeMap, N, OutEdges),
+ map.values(OutEdges, SsList),
+ set.list_to_set(SsList, Ss).
+
+rptg_successors(G, N) = S :-
+ rptg_successors(G, N, S).
+
+rptg_set_edge(Start, End, Info, Arc, G0, G) :-
+ rptg_get_arc_supply(G0, AS0),
+ AS = AS0 + 1,
+ Arc = rptg_arc(AS),
+ rptg_set_arc_supply(AS, G0, G1),
+
+ rptg_get_arcmap(G1, ArcMap0),
+ map.set(ArcMap0, Arc, rptg_arc_info(Start, End, Info), ArcMap),
+ rptg_set_arcmap(ArcMap, G1, G2),
+
+ % register into edge set of the Start node
+ rptg_get_edgemap(G2, EdgeMap0),
+ map.lookup(EdgeMap0, Start, OutEdges0),
+ map.set(OutEdges0, Arc, End, OutEdges),
+ map.set(EdgeMap0, Start, OutEdges, EdgeMap),
+ rptg_set_edgemap(EdgeMap, G2, G).
+
+rptg_arc_contents(G, Arc, S, E, Content) :-
+ rptg_get_arcmap(G, ArcMap),
+ map.lookup(ArcMap, Arc, I),
+ I = rptg_arc_info(S, E, Content).
+
+rptg_path(G, S, E, Path) :-
+ rptg_path_2(G, S, E, [], Path).
+
+:- pred rptg_path_2(rpt_graph, rptg_node, rptg_node, list(rptg_node),
+ list(rptg_arc)).
+:- mode rptg_path_2(in, in, in, in, out) is nondet.
+:- mode rptg_path_2(in, in, out, in, out) is nondet.
+
+rptg_path_2(G, S, E, Nodes0, Path) :-
+ rptg_get_edgemap(G, EdgeMap),
+ map.lookup(EdgeMap, S, OutEdgesOfS),
+ (
+ map.member(OutEdgesOfS, A, E),
+ \+ list.member(E, Nodes0),
+ Path = [A]
+ ;
+ map.member(OutEdgesOfS, A, N),
+ \+ list.member(N, Nodes0),
+ rptg_path_2(G, N, E, [N | Nodes0], Path0),
+ Path = [A | Path0]
+ ).
+
+ % Find a node that is reachable from Start and has type EType.
+ % If not found, fails.
+ %
+reachable_and_having_type(Graph, Start, EType, E) :-
+ rptg_lookup_node_type(Graph, Start) = Type,
+ ( if
+ Type = EType
+ then
+ E = Start
+ else
+ reachable_and_having_type_2(Graph, [Start], [Start], EType, E)
+ ).
+
+ % This implementation uses breath-first search. It ensures that
each node
+ % becomes "Start" node at most once, therefore it will terminate.
+ %
+:- pred reachable_and_having_type_2(rpt_graph::in, list(rptg_node)::in,
+ list(rptg_node)::in, mer_type::in, rptg_node::out) is semidet.
+
+reachable_and_having_type_2(Graph, [StartNode | StartNodes0],
VisitedNodes0,
+ EType, E) :-
+ rptg_get_edgemap(Graph, EdgeMap),
+ map.lookup(EdgeMap, StartNode, OutArcs),
+ map.values(OutArcs, Ends),
+ ( if
+ find_node_with_same_type(Ends, Graph, EType, E1)
+ then
+ % Find such a node, return it.
+ E = E1
+ else
+ % Still not find, do breath-first search, with nodes that we have
+ % never started from.
+ StartNodes1 = StartNodes0 ++ Ends,
+ list.remove_dups([StartNode | VisitedNodes0], VisitedNodes),
+ list.delete_elems(StartNodes1, VisitedNodes, StartNodes),
+
+ reachable_and_having_type_2(Graph, StartNodes, VisitedNodes,
+ EType, E)
+ ).
+
+ % Find a node with the given type in the list of nodes.
+ % If not found, fails.
+ %
+:- pred find_node_with_same_type(list(rptg_node)::in, rpt_graph::in,
+ mer_type::in, rptg_node::out) is semidet.
+
+find_node_with_same_type([N | Ns], Graph, Type, End) :-
+ rptg_lookup_node_type(Graph, N) = NType,
+ ( if
+ NType = Type
+ then
+ End = N
+ else
+ find_node_with_same_type(Ns, Graph, Type, End)
+ ).
+
+rptg_get_node_supply(G, NS) :-
+ G = rpt_graph(NS, _AS, _N, _A, _E).
+rptg_get_arc_supply(G, AS) :-
+ G = rpt_graph(_NS, AS, _N, _A, _E).
+rptg_get_nodemap(G, N) :-
+ G = rpt_graph(_NS, _AS, N, _A, _E).
+rptg_get_arcmap(G, A) :-
+ G = rpt_graph(_NS, _AS, _N, A, _E).
+rptg_get_edgemap(G, E) :-
+ G = rpt_graph(_NS, _AS, _N, _A, E).
+rptg_set_node_supply(NS, !G) :-
+ !.G = rpt_graph(_, AS, N, A, E),
+ !:G = rpt_graph(NS, AS, N, A, E).
+
+rptg_set_arc_supply(AS, !G) :-
+ !.G = rpt_graph(NS, _, N, A, E),
+ !:G = rpt_graph(NS, AS, N, A, E).
+rptg_set_nodemap(N, !G) :-
+ !.G = rpt_graph(NS, AS, _, A, E),
+ !:G = rpt_graph(NS, AS, N, A, E).
+rptg_set_arcmap(A, !G) :-
+ !.G = rpt_graph(NS, AS, N, _, E),
+ !:G = rpt_graph(NS, AS, N, A, E).
+rptg_set_edgemap(E, !G) :-
+ !.G= rpt_graph(NS, AS, N, A, _),
+ !:G = rpt_graph(NS, AS, N, A, E).
+
+rptg_node_content_get_varset(NC, NC^varset).
+rptg_node_content_get_region_name(NC, NC^reg_var_name).
+rptg_node_content_get_merged_from(NC, NC^merged_from).
+rptg_node_content_get_node_type(NC, NC^node_type).
+
+rptg_node_content_set_varset(VarSet, !NC) :-
+ !.NC^varset := VarSet = !:NC.
+rptg_node_content_set_region_name(Name, !NC) :-
+ !.NC^reg_var_name := Name = !:NC.
+rptg_node_content_set_merged_from(Nodes, !NC) :-
+ !.NC^merged_from := Nodes = !:NC.
+rptg_node_content_set_node_type(NodeType, !NC) :-
+ !.NC^node_type := NodeType = !:NC.
+
+rptg_arc_content_get_label(AC, AC^label).
+rptg_arc_content_set_label(Label, !AC) :-
+ !.AC^label := Label = !:AC.
+
+ % find a node in the graph using its region name
+ %
+get_node_by_region_name(Graph, RegName, Node) :-
+ % from all nodes in the graph find a node corresponding to the
+ % region name
+ rptg_get_nodes(Graph, AllNodes),
+ ( if
+ get_node_by_region_name_from_list(Graph, AllNodes, RegName, Node0)
+ then
+ Node = Node0
+ else
+ unexpected(this_file,
+ "get_node_by_region_name: No such a node exists")
+ ).
+
+:- pred get_node_by_region_name_from_list(rpt_graph::in,
list(rptg_node)::in,
+ string::in, rptg_node::out) is semidet.
+
+get_node_by_region_name_from_list(Graph, List, RegName, Node) :-
+ List = [ANode | Rest],
+ rptg_node_contents(Graph, ANode, NodeInfo),
+ ( if
+ NodeInfo^reg_var_name = RegName
+ then
+ Node = ANode
+ else
+ get_node_by_region_name_from_list(Graph, Rest, RegName, Node)
+ ).
+
+ % find a node in the graph using a set of variables.
+ % Because a variable is assigned to only one node.
+ %
+get_node_by_varset(Graph, Varset, Node) :-
+ rptg_get_nodes(Graph, AllNodes),
+ ( if
+ get_node_by_varset_from_list(Graph, AllNodes, Varset, Node0)
+ then
+ Node = Node0
+ else
+ unexpected(this_file, "get_node_by_varset: No such a node exists")
+ ).
+
+:- pred get_node_by_varset_from_list(rpt_graph::in, list(rptg_node)::in,
+ set(prog_var)::in, rptg_node::out) is semidet.
+
+get_node_by_varset_from_list(Graph, List, Varset, Node) :-
+ List = [ANode | Rest],
+ rptg_node_contents(Graph, ANode, NodeInfo),
+ ( if
+ set.subset(Varset, NodeInfo^varset)
+ then
+ Node = ANode
+ else
+ get_node_by_varset_from_list(Graph, Rest, Varset, Node)
+ ).
+
+ % find a node in the graph using a variable assigned to it.
+ % simply call get_node_by_varset.
+ %
+get_node_by_variable(Graph, Var, Node) :-
+ % make a set(prog_var) containing the variable
+ set.init(Varset0),
+ set.insert(Varset0, Var, Varset),
+ % find the node
+ get_node_by_varset(Graph, Varset, Node).
+
+get_node_by_node(Graph, Node, MergedNode) :-
+ % first the node in the NodeMap
+ rptg_get_nodemap(Graph, NodeMap),
+ ( if
+ map.search(NodeMap, Node, _NodeContent)
+ then
+ MergedNode = Node
+ else
+ % not directly in the NodeMap, checked if it has been merged
+ rptg_get_nodes(Graph, AllNodes),
+ ( if
+ get_node_by_node_from_list(Graph, AllNodes, Node, MergedNode0)
+ then
+ MergedNode = MergedNode0
+ else
+ unexpected(this_file, "get_node_by_node: No such a node
exists")
+ )
+ ).
+
+:- pred get_node_by_node_from_list(rpt_graph::in, list(rptg_node)::in,
+ rptg_node::in, rptg_node::out) is semidet.
+get_node_by_node_from_list(Graph, [N | Ns], Node, MergedNode) :-
+ rptg_node_contents(Graph, N, NContent),
+ ( if
+ set.member(Node, NContent^merged_from)
+ then
+ MergedNode = N
+ else
+ get_node_by_node_from_list(Graph, Ns, Node, MergedNode)
+ ).
+
+rptg_lookup_region_name(Graph, Node) = RegionName :-
+ rptg_node_contents(Graph, Node, Content),
+ Content^reg_var_name = RegionName.
+
+rptg_lookup_node_type(Graph, Node) = NodeType :-
+ rptg_node_contents(Graph, Node, Content),
+ Content^node_type = NodeType.
+
+%-----------------------------------------------------------------------------%
+%
+% The two graph-manipulating operators, i.e., unify and edge.
+%
+
+unify_operator(Node1, Node2, !Graph) :-
+ % The varset need to be unioned.
+ rptg_get_nodemap(!.Graph, NodeMap0),
+ rptg_node_contents(!.Graph, Node1, NodeContent1),
+ rptg_node_contents(!.Graph, Node2, NodeContent2),
+
+ rptg_node_content_set_varset(
+ set.union(NodeContent1^varset, NodeContent2^varset),
+ NodeContent1, NewContent0),
+ rptg_node_content_set_merged_from(
+ set.union(NodeContent1^merged_from, NodeContent2^merged_from),
+ NewContent0, NewContent1),
+ map.det_update(NodeMap0, Node1, NewContent1, NodeMap1),
+
+ rptg_set_nodemap(NodeMap1, !Graph),
+
+ % Copy all out-edges of node 2 to node 1.
+ transfer_out_edges(Node1, Node2, !Graph),
+
+ % Copy all in-edges of node 2 to node 1.
+ transfer_in_edges(Node1, Node2, !Graph),
+
+ % Remove node 2.
+ delete_node(Node2, !Graph).
+
+ % This predicate receives a graph and returns a new graph in which
+ % for all the out-edges of node2 in the first graph are copied to
+ % node1, as out-edges of node1.
+ %
+:- pred transfer_out_edges(rptg_node::in, rptg_node::in, rpt_graph::in,
+ rpt_graph::out) is det.
+
+transfer_out_edges(Node1, Node2, !Graph) :-
+ % Out-edges from node 2.
+ rptg_get_edgemap(!.Graph, EdgeMap),
+ map.lookup(EdgeMap, Node2, OutEdges2Map),
+ map.keys(OutEdges2Map, OutArcs),
+ % Transfer them to node 1
+ transfer_out_edges_2(OutArcs, Node1, !Graph).
+
+ % This predicate receives a list of out-edges of node2 and returns a
+ % graph with all the edges in the list copied to Node1, but it
+ % maintains the invariant that "there is only one arc with a
+ % specific label from a specific node to another specific node".
+ % The algorithm is as follows.
+ % for each arc (Node2, Content, Node) in OutArcs2 list:
+ % if (Node1, Content, Node) exists
+ % ignore the arc
+ % else
+ % copy the arc to Node1.
+ %
+:- pred transfer_out_edges_2(list(rptg_arc)::in, rptg_node::in,
+ rpt_graph::in, rpt_graph::out) is det.
+
+transfer_out_edges_2([], _, !Graph).
+transfer_out_edges_2([Arc | Arcs], Node1, !Graph) :-
+ rptg_arc_contents(!.Graph, Arc, _Node2, Node, ArcContent),
+ ( if
+ edge_in_graph(Node1, ArcContent, Node, !.Graph)
+ then
+ true
+ else
+ % not existed, copy the Arc as an out-edge of Node1
+ rptg_set_edge(Node1, Node, ArcContent, _Arc, !Graph)
+ ),
+ transfer_out_edges_2(Arcs, Node1, !Graph).
+
+ % This predicate receives a graph and returns a new graph in which
+ % all the in-edges of node2 in the first graph are copied as in-edges
+ % of node1.
+ %
+:- pred transfer_in_edges(rptg_node::in, rptg_node::in, rpt_graph::in,
+ rpt_graph::out) is det.
+
+transfer_in_edges(Node1, Node2, !Graph) :-
+ % in-edges of node 2
+ rptg_get_in_arcs(!.Graph, Node2, InArcs),
+ % copy them to node 1
+ transfer_in_edges_2(InArcs, Node1, !Graph).
+
+ % Finding incoming arcs to a node is not direct as finding outcoming
+ % ones, we have to scan all the arcs in the graph and explicitly
+ % check their ending node.
+ %
+:- pred rptg_get_in_arcs(rpt_graph::in, rptg_node::in,
list(rptg_arc)::out)
+ is det.
+
+rptg_get_in_arcs(Graph, Node, Arcs) :-
+ rptg_get_arcmap(Graph, ArcMap),
+ map.foldl(arc_points_to_node(Node), ArcMap, [], Arcs).
+
+:- pred arc_points_to_node(rptg_node::in, rptg_arc::in, rptg_arc_info::in,
+ list(rptg_arc)::in, list(rptg_arc)::out) is det.
+
+arc_points_to_node(End, Arc, ArcInfo, !L) :-
+ ArcInfo = rptg_arc_info(_S, E, _C),
+ ( if
+ E = End
+ then
+ !:L = [Arc | !.L]
+ else
+ true
+ ).
+
+ % This predicate is very similar to transfer_out_edges_2, except that
+ % the arcs now point to Node1, instead of going out from it.
+ %
+:- pred transfer_in_edges_2(list(rptg_arc)::in, rptg_node::in,
rpt_graph::in,
+ rpt_graph::out) is det.
+
+transfer_in_edges_2([], _, !Graph).
+transfer_in_edges_2([Arc | Arcs], Node1, !Graph) :-
+ rptg_arc_contents(!.Graph, Arc, Node, _Node2, ArcContent),
+ ( if
+ edge_in_graph(Node, ArcContent, Node1, !.Graph)
+ then
+ true
+ else
+ % No, copy the Arc as an in-edge of Node1
+ rptg_set_edge(Node, Node1, ArcContent, _Arc, !Graph)
+ ),
+ transfer_in_edges_2(Arcs, Node1, !Graph).
+
+ % Delete a node from the graph.
+ % We also need to delete all the edges and arcs from the Node,
+ % and delete all edges and arcs to the Node.
+ %
+:- pred delete_node(rptg_node::in, rpt_graph::in, rpt_graph::out) is det.
+
+delete_node(Node, Graph0, Graph) :-
+ Graph0 = rpt_graph(NS, AS, NodeMap0, ArcMap0, EdgeMap0),
+ map.delete(NodeMap0, Node, NodeMap),
+ delete_all_outedges_and_arcs(Node, ArcMap0, ArcMap1, EdgeMap0,
EdgeMap1),
+ delete_all_inedges_and_arcs(Node, ArcMap1, ArcMap, EdgeMap1, EdgeMap),
+ Graph = rpt_graph(NS, AS, NodeMap, ArcMap, EdgeMap).
+
+ % This predicate deletes all the edges which start from the input
+ % node Node.
+ % Note: it works as a helper for delete_node so it does not proceed
+ % on a graph but on the edge map and the arc map.
+ %
+:- pred delete_all_outedges_and_arcs(rptg_node::in,
+ map(rptg_arc, rptg_arc_info)::in,
+ map(rptg_arc, rptg_arc_info)::out,
+ map(rptg_node, map(rptg_arc, rptg_node))::in,
+ map(rptg_node, map(rptg_arc, rptg_node))::out) is det.
+
+delete_all_outedges_and_arcs(Node, !ArcMap, !EdgeMap) :-
+ % Delete the corresponding arcs from arc map.
+ map.lookup(!.EdgeMap, Node, EdgesFromNodeMap),
+ map.keys(EdgesFromNodeMap, OutArcs),
+ svmap.delete_list(OutArcs, !ArcMap),
+ % Delete all outcoming edges of the Node from edge map.
+ svmap.delete(Node, !EdgeMap).
+
+ % This predicate deletes all the incoming edges of the input node
(Node).
+ % We only store outcoming edges therefore to remove incoming ones
of Node
+ % we need to check all the outcoming edges and remove those point
to Node.
+ %
+:- pred delete_all_inedges_and_arcs(rptg_node::in,
+ map(rptg_arc, rptg_arc_info)::in,
+ map(rptg_arc, rptg_arc_info)::out,
+ map(rptg_node, map(rptg_arc, rptg_node))::in,
+ map(rptg_node, map(rptg_arc, rptg_node))::out) is det.
+
+delete_all_inedges_and_arcs(Node, !ArcMap, !EdgeMap) :-
+ map.keys(!.EdgeMap, StartNodes),
+
+ % For each node: find the outcoming edges from it
+ % and delete ones pointing to Node.
+ delete_all_inedges_and_arcs_2(StartNodes, Node, !ArcMap, !EdgeMap).
+
+ % This predicate receives a node (Node) and a list of (start) nodes.
+ % It deletes all the start nodes' outcoming edges and corresponding
arcs
+ % which point to the Node.
+ %
+:- pred delete_all_inedges_and_arcs_2(list(rptg_node)::in, rptg_node::in,
+ map(rptg_arc, rptg_arc_info)::in, map(rptg_arc, rptg_arc_info)::out,
+ map(rptg_node, map(rptg_arc, rptg_node))::in,
+ map(rptg_node, map(rptg_arc, rptg_node))::out) is det.
+
+delete_all_inedges_and_arcs_2([], _, !ArcMap, !EdgeMap).
+delete_all_inedges_and_arcs_2([N | Ns], Node, !ArcMap, !EdgeMap) :-
+ % Find the mapping with end node = Node, there will be only one,
+ % but we do as below because inverse_search is non-det.
+ map.lookup(!.EdgeMap, N, EdgesFromN0),
+ solutions(map.inverse_search(EdgesFromN0, Node), ArcsFromNPointToNode),
+
+ svmap.delete_list(ArcsFromNPointToNode, !ArcMap),
+ svmap.delete_list(ArcsFromNPointToNode, EdgesFromN0, EdgesFromN),
+ svmap.set(N, EdgesFromN, !EdgeMap),
+ delete_all_inedges_and_arcs_2(Ns, Node, !ArcMap, !EdgeMap).
+
+edge_operator(Start, End, Info, !G) :-
+ rptg_set_edge(Start, End, Info, _Arc, !G).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% For finding and checking edges in graph.
+%
+find_arc_from_node_with_same_label(N, ArcContent, G, M) :-
+ rptg_get_edgemap(G, EdgeMap),
+ map.lookup(EdgeMap, N, OutEdges),
+ map.keys(OutEdges, OutArcs),
+ find_arc_with_same_label(ArcContent, OutArcs, G, M).
+
+:- pred find_arc_with_same_label(rptg_arc_content::in,
+ list(rptg_arc)::in, rpt_graph::in, rptg_node::out) is semidet.
+
+find_arc_with_same_label(ArcContent, [Arc | Arcs], G, M) :-
+ rptg_arc_contents(G, Arc, _N, M0, ArcContent0),
+ ( if
+ ArcContent0 = ArcContent
+ then
+ M = M0
+ else
+ find_arc_with_same_label(ArcContent, Arcs, G, M)
+ ).
+
+edge_in_graph(Start, Label, End, Graph) :-
+ rptg_get_edgemap(Graph, EdgeMap),
+ map.lookup(EdgeMap, Start, OutEdges),
+ solutions(map.inverse_search(OutEdges, End), ArcList),
+ find_arc_with_same_label(Label, ArcList, Graph, _).
+
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% Equality of region points-to graphs.
+%
+
+rptg_equal(Graph1, Graph2) :-
+ Graph1 = rpt_graph(NS1, AS1, Nodes1, Arcs1, Edges1),
+ Graph2 = rpt_graph(NS2, AS2, Nodes2, Arcs2, Edges2),
+ NS1 = NS2,
+ AS1 = AS2,
+ simple_map_equal(Nodes1, Nodes2),
+ simple_map_equal(Arcs1, Arcs2),
+ complex_map_equal(Edges1, Edges2).
+
+% The comparisons below may not be necessary, unification can help if it is
+% sure that the elements are added to the maps in the same order.
+%
+ % The values of the maps are required to be comparable using
+ % unification, i.e., values of type V1 can be compared using
+ % unification.
+ %
+:- pred simple_map_equal(map(K1, V1)::in, map(K1, V1)::in) is semidet.
+
+simple_map_equal(Map1, Map2) :-
+ % Check if they have the same number of entries?
+ map.count(Map1, C1),
+ map.count(Map2, C2),
+ C1 = C2,
+
+ % If yes, check if all the entries are equal.
+ map.keys(Map1, Ks1),
+ simple_map_equal_2(Ks1, Map1, Map2).
+
+ % With the condition that the two maps have the same number of entries,
+ % verify that all keys in map 1 are also in map 2 and
+ % their corresponding values are equal.
+ %
+:- pred simple_map_equal_2(list(K1)::in,
+ map(K1, V1)::in, map(K1, V1)::in) is semidet.
+
+simple_map_equal_2([], _, _).
+simple_map_equal_2([K | Ks], Map1, Map2) :-
+ % K is also in map 2?
+ map.search(Map2, K, V2),
+
+ % Yes, so check whether the values are equal.
+ map.lookup(Map1, K, V1),
+ V1 = V2,
+ simple_map_equal_2(Ks, Map1, Map2).
+
+ % The maps need to be of map-in-map structure, namely
+ % map(k1, map(k2, v)) and values of type V can be compared by unifying
+ % (i.e., in our notion here map(k2, v) is a "simple" map).
+ %
+:- pred complex_map_equal(map(K1, map(K2, V))::in, map(K1, map(K2,
V))::in)
+ is semidet.
+
+complex_map_equal(Map1, Map2) :-
+ map.count(Map1, C1),
+ map.count(Map2, C2),
+ C1 = C2,
+ map.keys(Map1, Ks1),
+ complex_map_equal_2(Ks1, Map1, Map2).
+
+:- pred complex_map_equal_2(list(K1)::in, map(K1, map(K2, V))::in,
+ map(K1, map(K2, V))::in) is semidet.
+
+complex_map_equal_2([], _, _).
+complex_map_equal_2([K | Ks], Map1, Map2) :-
+ map.search(Map2, K, V2),
+
+ % V2 is "simple" map, so compare it with V1.
+ map.lookup(Map1, K, V1),
+ simple_map_equal(V1, V2),
+ complex_map_equal_2(Ks, Map1, Map2).
+
+ % This predicate finds all regions that are reachable from X.
+ % The regions must be reached by edges with labels (type selectors)
+ % which are valid with the type of X.
+ %
+reach_from_a_variable(Graph, HLDS, ProcInfo, X, !Reach_X) :-
+ get_node_by_variable(Graph, X, N_X),
+ Node_Selector = pair(N_X, []),
+
+ proc_info_get_vartypes(ProcInfo, VarTypes),
+ map.lookup(VarTypes, X, TypeX),
+
+ % Find regions reached from X.
+ reach_from_a_variable_2([Node_Selector], Graph, HLDS,
+ TypeX, [], !Reach_X).
+
+ % This predicate receives a (remembered) list of nodes that are
+ % reached from X, along with the valid selectors to those nodes
+ % from the node of X.
+ % Algorithm:
+ % 1. each node is recorded into the reach_from_x set,
+ % 2. if an target of a node's out-arc can be reached by a valid
+ % selector, we "remember" the target as reachable from X but not
+ % record it yet,
+ % 3. do until the remembered list is empty.
+ %
+:- pred reach_from_a_variable_2(assoc_list(rptg_node, selector)::in,
+ rpt_graph::in, module_info::in, mer_type::in, list(rptg_node)::in,
+ set(rptg_node)::in, set(rptg_node)::out) is det.
+
+reach_from_a_variable_2([], _, _, _, _, !Reach_X).
+reach_from_a_variable_2([Node_Selector | Node_Selectors0],
+ Graph, HLDS, TypeX, Processed0, !Reach_X) :-
+ Node_Selector = Node - Selector,
+
+ % Add the "remembered" Node to reach_from_x set
+ svset.insert(Node, !Reach_X),
+
+ % Add the Node to processed list so that we do not have to deal with
+ % it more than once. (Node is not yet in Processed0 because if it
+ % is in there it will not be in the to-be-processed list.
+ Processed = [Node | Processed0],
+
+ % Take out-arcs of the Node and update the remembered list
+ rptg_get_edgemap(Graph, EdgeMap),
+ map.lookup(EdgeMap, Node, OutEdges),
+ map.keys(OutEdges, OutArcs),
+ list.foldl(
+ update_remembered_list(Selector, HLDS, TypeX, Graph, Processed),
+ OutArcs, Node_Selectors0, Node_Selectors),
+
+ reach_from_a_variable_2(Node_Selectors, Graph, HLDS, TypeX,
+ Processed, !Reach_X).
+
+ % A target is remembered as reachable from X if its arc's selector
+ % is valid. The remembered list is appended, so it is a breadth-first
+ % process.
+ %
+:- pred update_remembered_list(selector::in, module_info::in,
+ mer_type::in, rpt_graph::in, list(rptg_node)::in, rptg_arc::in,
+ assoc_list(rptg_node, selector)::in,
+ assoc_list(rptg_node, selector)::out) is det.
+update_remembered_list(Selector0, HLDS, TypeX, Graph, Processed, OutArc,
+ !List) :-
+ rptg_arc_contents(Graph, OutArc, _Start, End, ArcContent),
+ ArcSelector = ArcContent^label,
+ Selector = Selector0 ++ ArcSelector,
+ ( if
+ check_type_of_node(HLDS, TypeX, Selector)
+ then
+ % The arc's selector is a valid one.
+ ( if
+ list.member(End, Processed)
+ then
+ % Already processed, ignore.
+ true
+ else
+ % A non-processed node and can be reached from X by a
+ % valid selector, so it is remembered.
+ %
+ !:List = !.List ++ [pair(End, Selector)]
+ )
+ else
+ % Selector is not valid, ignore.
+ true
+ ).
+
+:- func this_file = string.
+this_file = "rbmm.points_to_graph.m".
Index: rbmm.points_to_info.m
===================================================================
RCS file: rbmm.points_to_info.m
diff -N rbmm.points_to_info.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.points_to_info.m 21 May 2007 11:33:07 -0000
@@ -0,0 +1,168 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 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 rbmm.points_to_info.m.
+% Main author: Quan Phan.
+%
+% This module defines the "rpta_info" and "rpta_info_table" types.
+% rpta_info_table maps a procedure to its corresponding rpt information
+% (i.e., the rpt graph and the alpha mappings (at the call sites in it)).
+
+:- module transform_hlds.rbmm.points_to_info.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_pred.
+:- import_module transform_hlds.rbmm.points_to_graph.
+:- import_module transform_hlds.smm_common.
+
+:- import_module map.
+
+:- type rpta_info_table == map(pred_proc_id, rpta_info).
+
+:- func rpta_info_table_init = rpta_info_table.
+
+:- func rpta_info_table_search_rpta_info(pred_proc_id, rpta_info_table)
+ = rpta_info is semidet.
+:- pred rpta_info_table_set_rpta_info(pred_proc_id::in, rpta_info::in,
+ rpta_info_table::in, rpta_info_table::out) is det.
+
+ % type rpta_info and operations
+ %
+:- type rpta_info
+ ---> rpta_info(rpt_graph, rpt_alpha_mapping).
+
+ % The rpta_info will be for a specific procedure, at the beginning
+ % the alpha mapping is empty and the rpt graph contains all the nodes
+ % corresponding to all the variables appear in the procedure.
+ %
+:- pred rpta_info_init(proc_info::in, rpta_info::out) is det.
+:- func rpta_info_init(proc_info) = rpta_info.
+
+:- pred rpta_info_equal(rpta_info::in, rpta_info::in) is semidet.
+
+%-----------------------------------------------------------------------------%
+
+:- type rpt_alpha_mapping ==
+ map(
+ program_point,
+ map(rptg_node, rptg_node)
+ ).
+
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.
+:- import_module check_hlds.type_util.
+:- import_module hlds.hlds_module.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+
+:- import_module assoc_list.
+:- import_module int.
+:- import_module list.
+:- import_module set.
+:- import_module std_util.
+:- import_module string.
+:- import_module varset.
+
+rpta_info_table_init = map.init.
+rpta_info_table_search_rpta_info(PredProcId, Table) = RptaInfo :-
+ Table^elem(PredProcId) = RptaInfo.
+rpta_info_table_set_rpta_info(PredProcId, RptaInfo, Table0, Table) :-
+ Table = Table0^elem(PredProcId) := RptaInfo.
+
+ % The rpta_info will be for a specific procedure, so at the beginning
+ % the alpha mapping is empty and the rpt graph contains all the nodes
+ % corresponding to all the variables appear in the procedure.
+ %
+rpta_info_init(ProcInfo, RptaInfo) :-
+ proc_info_get_vartypes(ProcInfo, VarTypes),
+ map.keys(VarTypes, Vars),
+ list.foldl2(add_node_from_var(VarTypes), Vars, 1, _Reg,
+ rpt_graph_init, Graph),
+ map.init(AlphaMapping),
+ RptaInfo = rpta_info(Graph, AlphaMapping).
+rpta_info_init(ProcInfo) = RptaInfo :-
+ rpta_info_init(ProcInfo, RptaInfo).
+
+:- pred add_node_from_var(map(prog_var, mer_type)::in, prog_var::in,
int::in,
+ int::out, rpt_graph::in, rpt_graph::out) is det.
+
+add_node_from_var(VarTypes, Var, Reg0, Reg, !Graph) :-
+ map.lookup(VarTypes, Var, NodeType),
+ set.init(Varset0),
+ set.insert(Varset0, Var, Varset),
+ Reg = Reg0 + 1,
+ string.append("R", string.int_to_string(Reg0), RegName),
+ NodeInfo = rptg_node_content(Varset, RegName, set.init, NodeType),
+ rptg_set_node(NodeInfo, _Node, !Graph).
+
+rpta_info_equal(RptaInfo1, RptaInfo2):-
+ RptaInfo1 = rpta_info(Graph1, Alpha1),
+ RptaInfo2 = rpta_info(Graph2, Alpha2),
+ rptg_equal(Graph1, Graph2),
+ rpt_alpha_mapping_equal(Alpha1, Alpha2).
+
+%-----------------------------------------------------------------------------%
+%
+% Alpha mapping at call sites.
+%
+
+:- pred rpt_alpha_mapping_equal(rpt_alpha_mapping::in,
+ rpt_alpha_mapping::in) is semidet.
+
+rpt_alpha_mapping_equal(AlphaMapping1, AlphaMapping2) :-
+ map.count(AlphaMapping1, C1),
+ map.count(AlphaMapping2, C2),
+ C1 = C2,
+
+ map.keys(AlphaMapping1, CallSites1),
+ rpt_alpha_mapping_equal_2(CallSites1, AlphaMapping1, AlphaMapping2).
+
+:- pred rpt_alpha_mapping_equal_2(list(program_point)::in,
+ rpt_alpha_mapping::in, rpt_alpha_mapping::in) is semidet.
+
+rpt_alpha_mapping_equal_2([], _, _).
+rpt_alpha_mapping_equal_2([CallSite1 | CallSite1s],
+ AlphaMapping1, AlphaMapping2) :-
+ map.search(AlphaMapping2, CallSite1, AlphaMappingAtCallSite2),
+
+ map.lookup(AlphaMapping1, CallSite1, AlphaMappingAtCallSite1),
+ rpt_alpha_mapping_at_call_site_equal(
+ AlphaMappingAtCallSite1,AlphaMappingAtCallSite2),
+ rpt_alpha_mapping_equal_2(CallSite1s, AlphaMapping1, AlphaMapping2).
+
+:- pred rpt_alpha_mapping_at_call_site_equal(map(rptg_node, rptg_node)::in,
+ map(rptg_node, rptg_node)::in) is semidet.
+
+rpt_alpha_mapping_at_call_site_equal(AMAtCallSite1, AMAtCallSite2) :-
+ map.count(AMAtCallSite1, C1),
+ map.count(AMAtCallSite2, C2),
+ C1 = C2,
+
+ map.keys(AMAtCallSite1, Nodes1),
+ rpt_alpha_mapping_at_call_site_equal_2(Nodes1, AMAtCallSite1,
+ AMAtCallSite2).
+
+:- pred rpt_alpha_mapping_at_call_site_equal_2(list(rptg_node)::in,
+ map(rptg_node, rptg_node)::in, map(rptg_node, rptg_node)::in) is
semidet.
+
+rpt_alpha_mapping_at_call_site_equal_2([], _, _).
+rpt_alpha_mapping_at_call_site_equal_2([N | Ns], AMAtCallSite1,
+ AMAtCallSite2) :-
+ map.search(AMAtCallSite2, N, NPrime2),
+
+ map.lookup(AMAtCallSite1, N, NPrime1),
+ NPrime1 = NPrime2,
+ rpt_alpha_mapping_at_call_site_equal_2(Ns, AMAtCallSite1,
AMAtCallSite2).
+
+
Index: rbmm.region_instruction.m
===================================================================
RCS file: rbmm.region_instruction.m
diff -N rbmm.region_instruction.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.region_instruction.m 21 May 2007 11:37:33 -0000
@@ -0,0 +1,495 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006-2002,2004 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 rbmm.region_instruction.m.
+% Main author: Quan Phan
+%
+% This module implements the process of introducing region instructions to
+% each program point in a procedure based on its region points-to graph
and
+% live region information.
+%
+
+:- module transform_hlds.rbmm.region_instruction.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+:- import_module transform_hlds.rbmm.points_to_info.
+:- import_module transform_hlds.rbmm.region_liveness_info.
+:- import_module transform_hlds.smm_common.
+
+:- import_module list.
+:- import_module map.
+:- import_module string.
+
+:- type annotation_table == map(pred_proc_id, annotation_proc).
+
+:- type annotation_proc == map(program_point, before_after).
+:- type before_after ---> before_after(list(string), list(string)).
+
+ % Currently the region instructions are strings, which are attached to
+ % either before or after a program point.
+ %
+:- pred transform(module_info::in, rpta_info_table::in,
+ execution_path_table::in, proc_pp_region_set_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::in,
+ proc_region_set_table::in, annotation_table::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.
+:- import_module check_hlds.goal_path.
+:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_llds.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module transform_hlds.rbmm.points_to_graph.
+
+:- import_module bool.
+:- import_module pair.
+:- import_module set.
+:- import_module svmap.
+:- import_module svset.
+:- import_module term.
+:- import_module varset.
+
+transform(ModuleInfo, RptaInfoTable, ExecPathTable, LRBeforeTable,
+ LRAfterTable, VoidVarRegionTable, BornRTable, DeadRTable,
+ LocalRTable, AnnotationTable) :-
+ module_info_predids(PredIds, ModuleInfo, _),
+ map.init(AnnotationTable0),
+ list.foldl(transform_pred(ModuleInfo, RptaInfoTable, ExecPathTable,
+ LRBeforeTable, LRAfterTable, VoidVarRegionTable, BornRTable,
+ DeadRTable, LocalRTable), PredIds,
+ AnnotationTable0, AnnotationTable).
+
+:- pred transform_pred(module_info::in, rpta_info_table::in,
+ execution_path_table::in, proc_pp_region_set_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::in,
+ proc_region_set_table::in, pred_id::in,
+ annotation_table::in, annotation_table::out) is det.
+
+transform_pred(ModuleInfo, RptaInfoTable, ExecPathTable, LRBeforeTable,
+ LRAfterTable, VoidVarRegionTable, BornRTable, DeadRTable,
+ LocalRTable, PredId, !AnnotationTable) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_non_imported_procids(PredInfo) = ProcIds,
+ list.foldl(transform_proc(ModuleInfo, PredId, RptaInfoTable,
+ ExecPathTable, LRBeforeTable, LRAfterTable, VoidVarRegionTable,
+ BornRTable, DeadRTable, LocalRTable), ProcIds, !AnnotationTable).
+
+:- pred transform_proc(module_info::in, pred_id::in, rpta_info_table::in,
+ execution_path_table::in, proc_pp_region_set_table::in,
+ proc_pp_region_set_table::in, proc_pp_region_set_table::in,
+ proc_region_set_table::in, proc_region_set_table::in,
+ proc_region_set_table::in, proc_id::in,
+ annotation_table::in, annotation_table::out) is det.
+
+transform_proc(ModuleInfo, PredId, RptaInfoTable, ExecPathTable,
+ LRBeforeTable, LRAfterTable, VoidVarRegionTable, BornRTable,
+ DeadRTable, LocalRTable, ProcId, !AnnotationTable) :-
+ PPId = proc(PredId, ProcId),
+ ( if
+ some_are_special_preds([PPId], ModuleInfo)
+ then
+ true
+ else
+ module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+ map.lookup(RptaInfoTable, PPId, RptaInfo),
+ map.lookup(BornRTable, PPId, BornR),
+ map.lookup(DeadRTable, PPId, DeadR),
+ map.lookup(LocalRTable, PPId, LocalR),
+ map.lookup(LRBeforeTable, PPId, ProcLRBefore),
+ map.lookup(LRAfterTable, PPId, ProcLRAfter),
+ map.lookup(VoidVarRegionTable, PPId, ProcVoidVarRegion),
+ map.lookup(ExecPathTable, PPId, ExecPaths),
+ transform_exec_paths(ExecPaths, RptaInfo, BornR, DeadR, LocalR,
+ ProcLRBefore, ProcLRAfter, ProcVoidVarRegion,
+ BornRTable, DeadRTable, ModuleInfo, ProcInfo,
+ map.init, AnnotationProc),
+ svmap.set(PPId, AnnotationProc, !AnnotationTable)
+ ).
+
+ % Follow each execution path of a procedure and introduce
+ % region instructions at each program point.
+ %
+:- pred transform_exec_paths(list(execution_path)::in, rpta_info::in,
+ set(rptg_node)::in, set(rptg_node)::in, set(rptg_node)::in,
+ pp_region_set_table::in, pp_region_set_table::in,
+ pp_region_set_table::in, proc_region_set_table::in,
+ proc_region_set_table::in, module_info::in, proc_info::in,
+ annotation_proc::in, annotation_proc::out) is det.
+
+transform_exec_paths([], _, _, _, _, _, _, _, _, _, _, _, !AnnotationProc).
+transform_exec_paths([ExecPath|ExecPaths], RptaInfo, BornR, DeadR,
+ LocalR, ProcLRBefore, ProcLRAfter, ProcVoidVarRegion,
+ BornRTable, DeadRTable, ModuleInfo, ProcInfo, !AnnotationProc) :-
+ transform_exec_path(ExecPath, RptaInfo, BornR, DeadR, LocalR,
+ ProcLRBefore, ProcLRAfter, ProcVoidVarRegion,
+ BornRTable, DeadRTable, ModuleInfo, ProcInfo, !AnnotationProc),
+ transform_exec_paths(ExecPaths, RptaInfo, BornR, DeadR, LocalR,
+ ProcLRBefore, ProcLRAfter, ProcVoidVarRegion,
+ BornRTable, DeadRTable, ModuleInfo, ProcInfo, !AnnotationProc).
+
+:- pred transform_exec_path(execution_path::in, rpta_info::in,
+ set(rptg_node)::in, set(rptg_node)::in, set(rptg_node)::in,
+ pp_region_set_table::in, pp_region_set_table::in,
+ pp_region_set_table::in, proc_region_set_table::in,
+ proc_region_set_table::in, module_info::in, proc_info::in,
+ annotation_proc::in, annotation_proc::out) is det.
+transform_exec_path([], _, _, _, _, _, _, _, _, _, _, _, !AnnotationProc).
+transform_exec_path([ProgPoint - Goal | ProgPoint_Goals], RptaInfo,
+ BornR, DeadR, LocalR, ProcLRBefore, ProcLRAfter, ProcVoidVarRegion,
+ BornRTable, DeadRTable, ModuleInfo, ProcInfo, !AnnotationProc) :-
+ map.lookup(ProcLRBefore, ProgPoint, LRBefore),
+ map.lookup(ProcLRAfter, ProgPoint, LRAfter),
+ map.lookup(ProcVoidVarRegion, ProgPoint, VoidVarRegions),
+
+ % Because void variables at this program point are considered dead
+ % right after they get bound, the regions that are reached from them
+ % are also candidates to be removed. They will be destroyed after this
+ % program point if they are not live after the program point and they
+ % are either in DeadR or LocalR or BornR.
+ set.difference(VoidVarRegions, LRAfter, DeadVoidVarRegions0),
+ set.union(LocalR, BornR, Local_Born),
+ set.union(Local_Born, DeadR, Local_Born_Dead),
+ set.intersect(Local_Born_Dead, DeadVoidVarRegions0, DeadVoidVarRegions),
+ RptaInfo = rpta_info(Graph_p, _),
+ set.fold(record_instruction_after_prog_point(ProgPoint, Graph_p,
+ "Tn", "remove"), DeadVoidVarRegions, !AnnotationProc),
+
+ set.difference(LRBefore, LRAfter, ToBeRemoved),
+ set.intersect(ToBeRemoved, Local_Born_Dead, ToBeRemovedAndAllowed),
+ ( if
+ Goal = hlds_goal(switch(_, _, _), _)
+ then
+ % This is a switch, i.e. unification, only rule 4 applied.
+ transformation_rule_4_2(ProgPoint, ToBeRemovedAndAllowed,
+ RptaInfo, !AnnotationProc)
+ else
+ Goal = hlds_goal(Expr, _),
+ set.difference(LRAfter, LRBefore, ToBeCreated),
+ set.intersect(ToBeCreated, Local_Born, ToBeCreatedAndAllowed),
+ transformation_rule_1(Expr, ProgPoint, ToBeCreatedAndAllowed,
+ RptaInfo, BornRTable, !AnnotationProc),
+ transformation_rule_2(Expr, ProgPoint, ToBeCreatedAndAllowed,
+ RptaInfo, ModuleInfo, ProcInfo, !AnnotationProc),
+ transformation_rule_3(Expr, ProgPoint, ToBeRemovedAndAllowed,
+ RptaInfo, DeadRTable, !AnnotationProc),
+ transformation_rule_4(Expr, ProgPoint, ToBeRemovedAndAllowed,
+ RptaInfo, !AnnotationProc)
+ ),
+
+ (
+ ProgPoint_Goals = [NextProgPoint - _ | _],
+ % Transformation rule T5:
+ % When a region is live after a program point but not live
before the
+ % next program point in the same execution path, it will be removed
+ % before the next program point if the current procedure is allowed
+ % to remove it.
+ map.lookup(ProcLRBefore, NextProgPoint, LRBeforeNext),
+ set.difference(LRAfter, LRBeforeNext, ToBeRemovedBeforeNext),
+ set.intersect(Local_Born_Dead, ToBeRemovedBeforeNext,
+ ToBeRemovedBeforeNextAndAllowed),
+ set.fold(record_instruction_before_prog_point(NextProgPoint,
Graph_p,
+ "T5", "remove"),
+ ToBeRemovedBeforeNextAndAllowed, !AnnotationProc),
+
+ transform_exec_path(ProgPoint_Goals, RptaInfo, BornR, DeadR,
LocalR,
+ ProcLRBefore, ProcLRAfter, ProcVoidVarRegion,
+ BornRTable, DeadRTable, ModuleInfo, ProcInfo, !AnnotationProc)
+ ;
+ % This is the last program point, we finish.
+ ProgPoint_Goals = [],
+ true
+ ).
+
+ % Rule 1: if an output region of q is not live, not created by q,
+ % and p is allowed to create it, it is created before the call to q.
+ %
+ % There are two cases: either q is defined in this module or q is
+ % imported.
+ % The former is dealt with as per the rule.
+ % The latter: for now, with the assumption that all source code is in
+ % only one module, imported preds will only be ones from
+ % Mercury's library. We do not intent to deal with the library's code
+ % now therefore we have to assume here that the caller will always
+ % *CREATE* the OUTPUT REGION for those procedures.
+ %
+:- pred transformation_rule_1(hlds_goal_expr::in, program_point::in,
+ region_set::in, rpta_info::in, proc_region_set_table::in,
+ annotation_proc::in, annotation_proc::out) is det.
+
+transformation_rule_1(Expr, ProgPoint, ToBeCreatedAndAllowed, RptaInfo,
+ BornRTable, !AnnotationProc) :-
+ (
+ Expr = plain_call(PredId_q, ProcId_q, _, _, _, _)
+ ->
+ PPId_q = proc(PredId_q, ProcId_q),
+ RptaInfo = rpta_info(Graph, AlphaMapping),
+ ( if
+ % Currently we do not collect BornR for non-defined-in-module
+ % procedure, so if we cannot find one here then q is an
+ % imported.
+ map.search(BornRTable, PPId_q, _)
+ then
+ map.lookup(AlphaMapping, ProgPoint, AlphaAtProgPoint),
+ map.lookup(BornRTable, PPId_q, BornR_q),
+ map.foldl(process_mapping_rule_1(ProgPoint,
ToBeCreatedAndAllowed,
+ BornR_q, Graph), AlphaAtProgPoint, !AnnotationProc)
+ else
+ % q is from an imported module, therefore we consider
+ % BornR of q empty, so just create whatever regions becoming
+ % live provided that they are in BornR or LocalR, i.e., p is
+ % allowed to create them.
+ set.fold(record_instruction_before_prog_point(ProgPoint, Graph,
+ "T1", "create"), ToBeCreatedAndAllowed, !AnnotationProc)
+ )
+ ;
+ (Expr = conj(_, [])
+ ;Expr = disj([])
+ ;Expr = unify(_, _, _, _, _))
+ ->
+ true
+ ;
+ unexpected(this_file,
+ "transformation_rule_1: found non-atomic goal")
+ ).
+
+:- pred process_mapping_rule_1(program_point::in, region_set::in,
+ region_set::in, rpt_graph::in, rptg_node::in, rptg_node::in,
+ annotation_proc::in, annotation_proc::out) is det.
+
+process_mapping_rule_1(ProgPoint, ToBeCreatedAndAllowed, BornR_q, Graph_p,
+ SourceRegion, TargetRegion, !AnnotationProc) :-
+ ( if
+ (
+ set.contains(ToBeCreatedAndAllowed, TargetRegion),
+ not set.contains(BornR_q, SourceRegion)
+ )
+ then
+ record_instruction_before_prog_point(ProgPoint, Graph_p, "T1",
+ "create", TargetRegion, !AnnotationProc)
+ else
+ true
+ ).
+
+ % Transformation rule 2: if a region reachable from the left variable
+ % of a construction is not live before the construction but it is live
+ % after and is a local region or in a BornR set, then the region is
+ % created before the unification.
+ %
+:- pred transformation_rule_2(hlds_goal_expr::in, program_point::in,
+ region_set::in, rpta_info::in, module_info::in, proc_info::in,
+ annotation_proc::in, annotation_proc::out) is det.
+
+transformation_rule_2(Expr, ProgPoint, ToBeCreatedAndAllowed, RptaInfo,
+ ModuleInfo, ProcInfo, !AnnotationProc) :-
+ (
+ Expr = unify(X, _, _, construct(_, _, _, _, _, _, _), _)
+ ->
+ RptaInfo = rpta_info(Graph, _AlphaMapping),
+ % need to be regions reachable from X
+ reach_from_a_variable(Graph, ModuleInfo, ProcInfo, X,
+ set.init, Reach_X),
+
+ set.intersect(Reach_X, ToBeCreatedAndAllowed,
+ ToBeCreatedAllowedAndReached),
+ set.fold(record_instruction_before_prog_point(ProgPoint, Graph,
+ "T2", "create"),
+ ToBeCreatedAllowedAndReached, !AnnotationProc)
+ ;
+ (Expr = unify(_, _, _, deconstruct(_, _, _, _, _, _), _)
+ ;Expr = unify(_, _, _, assign(_, _), _)
+ ;Expr = unify(_, _, _, simple_test(_, _), _)
+ ;Expr = unify(_, _, _, complicated_unify(_, _, _), _)
+ ;Expr = plain_call(_, _, _, _, _, _)
+ ;Expr = conj(_, [])
+ ;Expr = disj([]))
+ ->
+ true
+ ;
+ unexpected(this_file,
+ "transformation_rule_2: non-atomic goal found")
+ ).
+
+ % Transformation rule 3: if a region is live before q but it is not
+ % live after q and it is not removed by q, the caller will remove it
+ % after calling q.
+ %
+ % There are two cases: either q is defined in this module or q is
+ % imported.
+ % The former is straightforward because we have the analysis information
+ % for q.
+ % The latter for now, with the assumption that all source code is in
+ % only one module, imported preds will only be ones from
+ % Mercury's library. We do not intent to deal with the library's code
+ % now therefore we have to assume here that the caller will always
+ % REMOVE the REGIONs for those procedures.
+ %
+:- pred transformation_rule_3(hlds_goal_expr::in, program_point::in,
+ region_set::in, rpta_info::in, proc_region_set_table::in,
+ annotation_proc::in, annotation_proc::out) is det.
+
+transformation_rule_3(Expr, ProgPoint, ToBeRemovedAndAllowed, RptaInfo,
+ DeadRTable, !AnnotationProc) :-
+ (
+ Expr = plain_call(PredId_q, ProcId_q, _, _, _, _)
+ ->
+ PPId_q = proc(PredId_q, ProcId_q),
+ ( if
+ map.search(DeadRTable, PPId_q, _)
+ then
+ RptaInfo = rpta_info(Graph, AlphaMapping),
+ map.lookup(AlphaMapping, ProgPoint, AlphaAtProgPoint),
+
+ map.lookup(DeadRTable, PPId_q, DeadR_q),
+ map.foldl(process_mapping_rule_3(ProgPoint,
+ ToBeRemovedAndAllowed, DeadR_q, Graph),
+ AlphaAtProgPoint, !AnnotationProc)
+ else
+ % q is from an imported module. So just remove whatever regions
+ % become dead provided that p is allowed to remove those
regions.
+ RptaInfo = rpta_info(Graph_p, _),
+ set.fold(record_instruction_after_prog_point(ProgPoint,
Graph_p,
+ "T3", "remove"),
+ ToBeRemovedAndAllowed, !AnnotationProc)
+ )
+ ;
+ (Expr = unify(_, _, _, _, _)
+ ;Expr = conj(_, [])
+ ;Expr = disj([]))
+ ->
+ true
+ ;
+ unexpected(this_file,
+ "transformation_rule_3: non-atomic goal found")
+ ).
+
+:- pred process_mapping_rule_3(program_point::in, region_set::in,
+ region_set::in, rpt_graph::in, rptg_node::in, rptg_node::in,
+ annotation_proc::in, annotation_proc::out) is det.
+
+process_mapping_rule_3(ProgPoint, ToBeRemovedAndAllowed, DeadR_q, Graph_p,
+ SourceRegion, TargetRegion, !AnnotationProc) :-
+ ( if
+ (
+ set.contains(ToBeRemovedAndAllowed, TargetRegion),
+ not set.contains(DeadR_q, SourceRegion)
+ )
+ then
+ record_instruction_after_prog_point(ProgPoint, Graph_p, "T3",
+ "remove", TargetRegion, !AnnotationProc)
+ else
+ true
+ ).
+
+ % Transformation rule 4: if a region is live before a unification but
+ % it is not live after and it is in the dead region set or is a local
+ % region, then it is removed after the unification if the current
+ % procedure is allowed to remove it.
+ %
+:- pred transformation_rule_4(hlds_goal_expr::in, program_point::in,
+ region_set::in, rpta_info::in, annotation_proc::in,
+ annotation_proc::out) is det.
+
+transformation_rule_4(Expr, ProgPoint, ToBeRemovedAndAllowed, RptaInfo,
+ !AnnotationProc) :-
+ (
+ Expr = unify(_, _, _, _, _)
+ ->
+ RptaInfo = rpta_info(Graph, _),
+ set.fold(record_instruction_after_prog_point(ProgPoint, Graph,
+ "T4", "remove"), ToBeRemovedAndAllowed, !AnnotationProc)
+ ;
+ (Expr = plain_call(_, _, _, _, _, _)
+ ;Expr = conj(_, [])
+ ;Expr = disj([]))
+ ->
+ true
+ ;
+ unexpected(this_file,
+ "transformation_rule_4: non-atomic goal found")
+ ).
+
+ % This is for the case rule 4 applied for a unification in a switch,
+ % the unification has been removed by MMC.
+ % We will record the annotations after the program point.
+ %
+:- pred transformation_rule_4_2(program_point::in, region_set::in,
+ rpta_info::in, annotation_proc::in, annotation_proc::out) is det.
+
+transformation_rule_4_2(ProgPoint, ToBeRemovedAndAllowed, RptaInfo,
+ !AnnotationProc) :-
+ RptaInfo = rpta_info(Graph, _),
+ set.fold(record_instruction_after_prog_point(ProgPoint, Graph,
+ "T4", "remove"), ToBeRemovedAndAllowed, !AnnotationProc).
+
+:- pred record_instruction_after_prog_point(program_point::in,
+ rpt_graph::in, string::in, string::in, rptg_node::in,
+ annotation_proc::in, annotation_proc::out) is det.
+
+record_instruction_after_prog_point(ProgPoint, Graph_p, Rule, Action,
Region,
+ !AnnotationProc) :-
+ rptg_node_contents(Graph_p, Region, Content),
+ RegionAnno = string.format("%s: %s %s",
+ [s(Rule), s(Action), s(Content^reg_var_name)]),
+ % get After of the pp and add annotation to it
+ ( if
+ map.search(!.AnnotationProc, ProgPoint,
+ before_after(Before, After))
+ then
+ ( if
+ list.member(RegionAnno, After)
+ then
+ true
+ else
+ svmap.set(ProgPoint,
+ before_after(Before, [RegionAnno | After]),
!AnnotationProc)
+ )
+ else
+ svmap.set(ProgPoint, before_after([], [RegionAnno]),
+ !AnnotationProc)
+ ).
+
+:- pred record_instruction_before_prog_point(program_point::in,
+ rpt_graph::in, string::in, string::in, rptg_node::in,
+ annotation_proc::in, annotation_proc::out) is det.
+
+record_instruction_before_prog_point(ProgPoint, Graph_p, Rule, Action,
+ Region, !AnnotationProc) :-
+ rptg_node_contents(Graph_p, Region, Content),
+ RegionAnno = string.format("%s: %s %s",
+ [s(Rule), s(Action), s(Content^reg_var_name)]),
+ % get After of the pp and add annotation to it
+ ( if
+ map.search(!.AnnotationProc, ProgPoint,
+ before_after(Before, After))
+ then
+ ( if
+ list.member(RegionAnno, Before)
+ then
+ true
+ else
+ svmap.set(ProgPoint,
+ before_after([RegionAnno | Before], After),
!AnnotationProc)
+ )
+ else
+ svmap.set(ProgPoint, before_after([RegionAnno], []),
+ !AnnotationProc)
+ ).
+
+:- func this_file = string.
+this_file = "rbmm.region_instruction.m".
Index: rbmm.region_liveness_info.m
===================================================================
RCS file: rbmm.region_liveness_info.m
diff -N rbmm.region_liveness_info.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ rbmm.region_liveness_info.m 22 May 2007 04:27:55 -0000
@@ -0,0 +1,125 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 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 rbmm.region_liveness_info.m.
+% Main author: Quan Phan
+%
+% Defines the data structures used in several phases of the live region
+% analysis.
+
+:- module transform_hlds.rbmm.region_liveness_info.
+
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+:- import_module transform_hlds.rbmm.points_to_graph.
+:- import_module transform_hlds.smm_common.
+
+:- import_module assoc_list.
+:- import_module list.
+:- import_module map.
+:- import_module set.
+
+:- type execution_path == assoc_list(program_point, hlds_goal).
+:- type execution_path_table == map(pred_proc_id, list(execution_path)).
+
+%----------------------------------------------------------------------------%
+%
+% The part for program variables.
+%
+
+ % Represents a set of program variables.
+ %
+:- type variable_set == set(prog_var).
+
+ % Represents the relation between a program point and a set of
+ % variables. E.g., a map of this type can be the sets of live
+ % variables before program points in a procedure.
+ %
+:- type pp_varset_table == map(program_point, variable_set).
+
+ % Represents the relation between a procedure and sets of variables
+ % associated with its program points.
+ %
+:- type proc_pp_varset_table == map(pred_proc_id, pp_varset_table).
+
+ % Find input and output formal arguments of the procedure.
+ %
+:- pred find_input_output_args(module_info::in, proc_info::in,
+ list(prog_var)::out, list(prog_var)::out) is det.
+
+%----------------------------------------------------------------------------%
+%
+% The part for region/node
+%
+
+ % Represents a set of regions, e.g., deadR, bornR, ..., live regions
+ % before and after a program point.
+ %
+:- type region_set == set(rptg_node).
+
+:- pred region_set_equal(region_set::in, region_set::in) is semidet.
+
+ % Represents the relation between a procedure and its interesting sets
+ % of regions, such as deadR, bornR, constantR.
+ %
+:- type proc_region_set_table == map(pred_proc_id, region_set).
+
+:- pred proc_region_set_table_equal(proc_region_set_table::in,
+ proc_region_set_table::in) is semidet.
+
+ % Represents the relation between a program point and its region set
+ % e.g., live regions before the pp, live regions after the pp.
+ %
+:- type pp_region_set_table == map(program_point, region_set).
+
+ % Represents the relation between a procedure and sets of regions
+ % associated with its program points.
+ %
+:- type proc_pp_region_set_table == map(pred_proc_id, pp_region_set_table).
+
+:- implementation.
+
+:- import_module hlds.arg_info.
+
+region_set_equal(RegionSet1, RegionSet2) :-
+ set.equal(RegionSet1, RegionSet2).
+
+proc_region_set_table_equal(ProcRegionSetTable1, ProcRegionSetTable2) :-
+ map.count(ProcRegionSetTable1, C1),
+ map.count(ProcRegionSetTable2, C2),
+ C1 = C2,
+
+ map.keys(ProcRegionSetTable1, PredProcIds1),
+ prst_equal_2(PredProcIds1, ProcRegionSetTable1, ProcRegionSetTable2).
+
+:- pred prst_equal_2(list(pred_proc_id)::in, proc_region_set_table::in,
+ proc_region_set_table::in) is semidet.
+
+prst_equal_2([], _, _).
+prst_equal_2([PPId|PPIds], PRST1, PRST2) :-
+ map.search(PRST2, PPId, RS2),
+
+ map.lookup(PRST1, PPId, RS1),
+ set.equal(RS1, RS2),
+ prst_equal_2(PPIds, PRST1, PRST2).
+
+find_input_output_args(ModuleInfo, CalleeProcInfo, Inputs, Outputs) :-
+ proc_info_get_headvars(CalleeProcInfo, ArgVars),
+ proc_info_get_vartypes(CalleeProcInfo, VarTypes),
+ list.map(map.lookup(VarTypes), ArgVars, ArgTypes),
+ proc_info_get_argmodes(CalleeProcInfo, ArgModes),
+ arg_info.compute_in_and_out_vars(ModuleInfo, ArgVars, ArgModes,
ArgTypes,
+ Inputs, Outputs).
+
+
Index: smm_common.m
===================================================================
RCS file: smm_common.m
diff -N smm_common.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ smm_common.m 22 May 2007 02:29:34 -0000
@@ -0,0 +1,126 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005-2007 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 smm_common.m.
+% Main author: Quan Phan.
+%
+% This module implements some common utilities and types for static memory
+% management analyses, e.g. CTGC, RBMM.
+
+:- module transform_hlds.smm_common.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_module.
+:- import_module mdbcomp.
+:- import_module mdbcomp.program_representation.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+
+:- import_module list.
+:- import_module term.
+
+ % Succeeds if the selector selects the type node of the input type.
+ %
+:- pred check_type_of_node(module_info::in, mer_type::in, selector::in)
+ is semidet.
+
+ % Succeeds if some (or all) of the procedures in the list are special.
+ %
+:- pred some_are_special_preds(list(pred_proc_id)::in, module_info::in)
+ is semidet.
+
+:- type program_point
+ ---> pp(
+ pp_context :: term.context,
+ pp_path :: goal_path
+ ).
+
+:- pred program_point_init(hlds_goal_info, program_point).
+:- mode program_point_init(in, out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.
+:- import_module check_hlds.type_util.
+:- import_module ll_backend.
+:- import_module ll_backend.liveness.
+
+:- import_module bool.
+:- import_module int.
+:- import_module map.
+
+ % Check if the selector is valid w.r.t the type.
+ %
+check_type_of_node(ModuleInfo, StartType, Selector) :-
+ (
+ Selector = [Sel | Sels],
+ (
+ Sel = termsel(Cons_id, Choice),
+ select_subtype(ModuleInfo, StartType, Cons_id, Choice,
+ SubType)
+ ;
+ Sel = typesel(SubType)
+ ),
+ check_type_of_node(ModuleInfo, SubType, Sels)
+ ;
+ Selector = []
+ ).
+
+ % Select the subtype of a type Type, selecting ConsId's position
+ % Position. Position counts starting from 1 (instead of 0).
+ % Predicate aborts if the subtype cannot be determined.
+ %
+:- pred select_subtype(module_info::in, mer_type::in, cons_id::in,
int::in,
+ mer_type::out) is semidet.
+
+select_subtype(ModuleInfo, Type, ConsID, Choice, SubType) :-
+ get_cons_id_non_existential_arg_types(ModuleInfo, Type, ConsID,
+ ArgTypes),
+ list.index1(ArgTypes, Choice, SubType).
+
+ % Special predicates are either compiler-generated ones, such as
+ % __Unify__ and others or ones that are not defined in the module.
+ %
+some_are_special_preds(PPIds, ModuleInfo) :-
+ module_info_get_special_pred_map(ModuleInfo, SpecialPredMap),
+ map.values(SpecialPredMap, SpecialPredIds),
+ (
+ list.filter(pred(PPId::in) is semidet :- (
+ PPId = proc(PredId, _),
+ list.member(PredId, SpecialPredIds)
+ ),
+ PPIds, SpecialPPIds),
+ SpecialPPIds = [_ | _]
+ ;
+ list.filter(proc_not_defined_in_module(ModuleInfo), PPIds,
+ FilteredPPIds),
+ FilteredPPIds = [_ | _]
+ ).
+
+:- pred proc_not_defined_in_module(module_info::in, pred_proc_id::in)
+ is semidet.
+
+proc_not_defined_in_module(ModuleInfo, proc(PredId, _)):-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_import_status(PredInfo, Status),
+ status_defined_in_this_module(Status) = no.
+
+ % Note: for a meaningful use of this predicate the goal needs to be
+ % filled with path information, i.e. call to fill_goal_path_slots(...).
+ %
+program_point_init(GoalInfo, ProgPoint) :-
+ goal_info_get_context(GoalInfo, Context),
+ goal_info_get_goal_path(GoalInfo, GoalPath),
+ ProgPoint = pp(Context, GoalPath).
+
Index: transform_hlds.m
===================================================================
RCS file:
/home/mercury/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.26
diff -u -u -r1.26 transform_hlds.m
--- transform_hlds.m 13 Jan 2007 12:23:14 -0000 1.26
+++ transform_hlds.m 21 May 2007 07:03:58 -0000
@@ -45,6 +45,10 @@
:- include_module transform_hlds.ctgc.
+:- include_module transform_hlds.rbmm.
+
+:- include_module transform_hlds.smm_common.
+
:- include_module term_constr_main.
:- include_module term_constr_initial.
% Pass 1.
cvs diff: Diffing notes
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list