[m-rev.] for review: [CTGC] generate optimised versions, reuse pragmas
Nancy Mazur
Nancy.Mazur at cs.kuleuven.ac.be
Wed Jun 7 04:55:04 AEST 2006
Hi,
for anybody to review....
I've got one problem with the change below which also contains the mechanism
to output structure_reuse pragma's, as well as reading them back in. Each
structure reuse pragma is related to a procedure. It dictates the
conditions which a caller of this procedure needs to meet in order to
safely replace the original call by a call to the optimised version of that
procedure. This means that for each procedure, we create a separate (optimised)
version (if optimisations are possible of course) with a compiler-generated
name. This name is generated using the function:
generate_reuse_name(module_info, pred_proc_id) = reuse_name.
defined in structure_reuse.split,
which uses the predicate
prog_util.make_pred_name_with_context/7
The problem is that this generates a name with a whole bunch of "__", and of
course, once you print this name out, and read it back in, you get a sym_name
with the strangest set of qualifiers.
Just as an example. If I generate and print the name:
'concat.ctgc__pred__concatenate__0__0'
then reading it back in (using prog_io.sym_name_and_args/3), and printing
it back out again (in a hlds_dump file), this looks like this:
((('concat.ctgc'.(pred)).concatenate).'0').'0'
I don't really know what already exists to print and parse such sym_names
correctly. Can someone help me out on this one?
Many thanks,
Nancy
===================================================================
Estimated hours taken: 15
Branches: main
Create optimised versions for all the procedures in which possibilities for
structure reuse are detected. Put the mechanism in place to generate reuse
pragma's, and to parse them back in.
compiler/add_pragma.m:
compiler/make_hlds_passes.m:
compiler/mercury_to_mercury.m:
compiler/prog_ctgc.m:
compiler/prog_io_pragma.m:
compiler/structure_reuse.analysis.m:
compiler/trans_opt.m:
Add the mechanism to output and parse the structure_reuse pragma's.
compiler/hlds_module.m:
Simplify the type structure_reuse_info.
compiler/hlds_pred.m:
Add structure sharing information at the level of each individual
procedure. This information consists of a description of any reuse
conditions that have been derived for that procedure.
compiler/prog_item.m:
compiler/prog_data.m:
Add types for the public representation of reuse conditions.
(remove the previous name "reuse_tuple", which simply does not sound
adequate).
compiler/prog_type.m:
Add functions to remove all typeinfo-vars from a
given list (resp. set) of vars.
compiler/structure_reuse.domain.m:
Conversion procedures between the public and private representation
for structure reuse conditions.
compiler/structure_reuse.indirect.m:
Do not try to replace call information even when you know the
pred_proc_id of the reuse version of that call (which is the case for
imported procedures with reuse). It is more consistent
to do this at the same time when all the other conversions are done,
i.e. when generating the optimised versions of the procedures with
reuse (even with unconditional reuse).
compiler/structure_reuse.lbu.m:
compiler/structure_reuse.lfu.m:
Make sure that no lbu/lfu information regarding typeinfo-vars is
recorded. These variables are irrelevant for the analysis. On the
contrary, keeping these variables may cause errors:
the generated (reuse) pragma's may end up containing these
typeinfo-vars, when reading these pragma's back in, it becomes
troublesome to match them with the corresponding predicate signatures,
as these signatures do not contain such typeinfo-headvars.
compiler/structure_reuse.analysis.m:
compiler/structure_reuse.m:
compiler/structure_reuse.split.m:
Create optimised versions for the procedures for which
reuse was detected.
(structure_reuse.split.m = new file)
compiler/structure_sharing.analysis.m:
Add some documentation.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.33
diff -u -d -r1.33 add_pragma.m
--- compiler/add_pragma.m 5 Jun 2006 02:26:06 -0000 1.33
+++ compiler/add_pragma.m 6 Jun 2006 13:31:22 -0000
@@ -56,6 +56,11 @@
maybe(structure_sharing_domain)::in, prog_context::in,
module_info::in, module_info::out, io::di, io::uo) is det.
+:- pred add_pragma_structure_reuse(pred_or_func::in, sym_name::in,
+ list(mer_mode)::in, list(prog_var)::in, list(mer_type)::in,
+ maybe(structure_reuse_domain)::in, maybe(sym_name)::in, prog_context::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
% module_add_pragma_import:
%
% Handles `pragma import' declarations, by figuring out which predicate
@@ -1227,6 +1232,99 @@
% module_info_incr_errors(!ModuleInfo)
).
+add_pragma_structure_reuse(_PredOrFunc, _SymName, _ModeList, _HeadVars,
+ _Types, no, _MaybeReusePredName, _Context, !ModuleInfo, !IO).
+add_pragma_structure_reuse(PredOrFunc, SymName, ModeList, HeadVars,
+ Types, yes(ReuseDomain), MaybeReusePredName,
+ Context, !ModuleInfo, !IO):-
+ module_info_get_predicate_table(!.ModuleInfo, Preds),
+ list.length(ModeList, Arity),
+ (
+ predicate_table_search_pf_sym_arity(Preds, is_fully_qualified,
+ PredOrFunc, SymName, Arity, PredIds),
+ PredIds = [_ | _]
+ ->
+ ( PredIds = [PredId] ->
+ module_info_preds(!.ModuleInfo, PredTable0),
+ map.lookup(PredTable0, PredId, PredInfo0),
+ pred_info_get_procedures(PredInfo0, ProcTable0),
+ map.to_assoc_list(ProcTable0, ProcList),
+ (
+ get_procedure_matching_declmodes(ProcList, ModeList,
+ !.ModuleInfo, ProcId)
+ ->
+ map.lookup(ProcTable0, ProcId, ProcInfo0),
+
+ % Rename headvars/types to those used in the proc_info.
+ proc_info_get_headvars(ProcInfo0, ProcHeadVars),
+
+ % As the HeadVars recorded in the pragma may contain additional
+ % vars (e.g. typeinfos), and in the same time ProcHeadVars does
+ % not, make sure to remove all TypeInfo-vars from HeadVars,
+ % the same for the list Types.
+ Diff = list.length(HeadVars) - list.length(ProcHeadVars),
+ (
+ list.drop(Diff, HeadVars, RemHeadVars0),
+ list.drop(Diff, Types, RemTypes0)
+ ->
+ RemHeadVars = RemHeadVars0,
+ RemTypes = RemTypes0
+ ;
+ unexpected(this_file, "Impossible situation.")
+ ),
+ map.from_corresponding_lists(RemHeadVars, ProcHeadVars,
+ MapHeadVars),
+ pred_info_get_arg_types(PredInfo0, ArgTypes),
+ TypeSubst0 = map.init,
+ (
+ type_unify_list(RemTypes, ArgTypes, [], TypeSubst0,
+ TypeSubst1)
+ ->
+ TypeSubst = TypeSubst1
+ ;
+ TypeSubst = TypeSubst0
+ ),
+ rename_structure_reuse_domain(MapHeadVars, TypeSubst,
+ ReuseDomain, RenamedReuseDomain),
+ proc_info_set_structure_reuse(RenamedReuseDomain,
+ ProcInfo0, ProcInfo1),
+ (
+ MaybeReusePredName = no,
+ ProcInfo = ProcInfo1
+ ;
+ MaybeReusePredName = yes(ReusePredName),
+ proc_info_set_structure_reuse_pred_name(ReusePredName,
+ ProcInfo1, ProcInfo)
+ ),
+ map.det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
+ pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
+ map.det_update(PredTable0, PredId, PredInfo, PredTable),
+ module_info_set_preds(PredTable, !ModuleInfo)
+
+ ;
+ module_info_incr_errors(!ModuleInfo),
+ Pieces = [words("Error: `:- pragma structure_reuse'"),
+ words("declaration for undeclared mode of"),
+ simple_call_id(simple_call_id(PredOrFunc, SymName, Arity)),
+ suffix(".")],
+ write_error_pieces(Context, 0, Pieces, !IO)
+ )
+ ;
+ module_info_incr_errors(!ModuleInfo),
+ Pieces = [words("Error: ambiguous predicate name"),
+ simple_call_id(simple_call_id(PredOrFunc, SymName, Arity)),
+ words("in"), fixed("`pragma structure_reuse'.")],
+ write_error_pieces(Context, 0, Pieces, !IO)
+ )
+ ;
+ % XXX This happens in `.trans_opt' files sometimes --
+ % so just ignore it
+ true
+ % undefined_pred_or_func_error(SymName, Arity, Context,
+ % "`:- pragma structure_sharing' declaration",
+ % !IO),
+ % module_info_incr_errors(!ModuleInfo)
+ ).
%-----------------------------------------------------------------------------%
add_pragma_termination_info(PredOrFunc, SymName, ModeList,
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.136
diff -u -d -r1.136 hlds_module.m
--- compiler/hlds_module.m 5 Jun 2006 02:26:07 -0000 1.136
+++ compiler/hlds_module.m 6 Jun 2006 13:31:24 -0000
@@ -209,10 +209,8 @@
% procedures, and their optimised versions with respect to
% structure reuse (CTGC).
%
-:- type structure_reuse_info
- ---> structure_reuse_info(
- map(pred_proc_id, pair(pred_proc_id, sym_name))
- ).
+:- type structure_reuse_map ==
+ map(pred_proc_id, pair(pred_proc_id, sym_name)).
%-----------------------------------------------------------------------------%
%
% Various predicates for manipulating the module_info data structure
@@ -489,10 +487,10 @@
:- pred module_info_user_final_pred_c_names(module_info::in,
list(string)::out) is det.
-:- pred module_info_get_structure_reuse_info(module_info::in,
- structure_reuse_info::out) is det.
+:- pred module_info_get_structure_reuse_map(module_info::in,
+ structure_reuse_map::out) is det.
-:- pred module_info_set_structure_reuse_info(structure_reuse_info::in,
+:- pred module_info_set_structure_reuse_map(structure_reuse_map::in,
module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -747,7 +745,7 @@
user_final_pred_c_names :: assoc_list(sym_name, string),
% Information about which procedures implement structure reuse.
- structure_reuse_info :: structure_reuse_info
+ structure_reuse_map :: structure_reuse_map
).
module_info_init(Name, Items, Globals, QualifierInfo, RecompInfo,
@@ -790,7 +788,7 @@
[], [], StratPreds, UnusedArgInfo, ExceptionInfo, TrailingInfo,
MM_TablingInfo, map.init, counter.init(1), ImportedModules,
IndirectlyImportedModules, TypeSpecInfo, NoTagTypes, no, [],
- init_analysis_info(mmc), [], [], structure_reuse_info(map.init)),
+ init_analysis_info(mmc), [], [], map.init),
ModuleInfo = module_info(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, SuperClassTable, InstanceTable, AssertionTable,
@@ -877,8 +875,8 @@
MI ^ sub_info ^ maybe_complexity_proc_map).
module_info_get_complexity_proc_infos(MI,
MI ^ sub_info ^ complexity_proc_infos).
-module_info_get_structure_reuse_info(MI,
- MI ^ sub_info ^ structure_reuse_info).
+module_info_get_structure_reuse_map(MI,
+ MI ^ sub_info ^ structure_reuse_map).
% XXX There is some debate as to whether duplicate initialise directives
% in the same module should constitute an error. Currently it is not, but
@@ -990,8 +988,8 @@
MI ^ sub_info ^ maybe_complexity_proc_map := NewVal).
module_info_set_complexity_proc_infos(NewVal, MI,
MI ^ sub_info ^ complexity_proc_infos := NewVal).
-module_info_set_structure_reuse_info(ReuseMap, MI,
- MI ^ sub_info ^ structure_reuse_info := ReuseMap).
+module_info_set_structure_reuse_map(ReuseMap, MI,
+ MI ^ sub_info ^ structure_reuse_map := ReuseMap).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.197
diff -u -d -r1.197 hlds_pred.m
--- compiler/hlds_pred.m 20 Apr 2006 05:36:53 -0000 1.197
+++ compiler/hlds_pred.m 6 Jun 2006 13:31:27 -0000
@@ -1781,6 +1781,18 @@
:- pred proc_info_set_structure_sharing(structure_sharing_domain::in,
proc_info::in, proc_info::out) is det.
+:- pred proc_info_get_structure_reuse(proc_info::in,
+ maybe(structure_reuse_domain)::out) is det.
+
+:- pred proc_info_set_structure_reuse(structure_reuse_domain::in,
+ proc_info::in, proc_info::out) is det.
+
+:- pred proc_info_get_structure_reuse_pred_name(proc_info::in,
+ maybe(sym_name)::out) is det.
+
+:- pred proc_info_set_structure_reuse_pred_name(sym_name::in,
+ proc_info::in, proc_info::out) is det.
+
:- pred proc_info_head_modes_constraint(proc_info::in, mode_constraint::out)
is det.
@@ -2090,10 +2102,21 @@
% arguments in the original
% procedure.
- maybe_structure_sharing :: maybe(structure_sharing_domain)
+ maybe_structure_sharing :: maybe(structure_sharing_domain),
% Structure sharing information
% as obtained by the structure
% sharing analysis.
+
+ maybe_structure_reuse :: maybe(structure_reuse_domain),
+ % Structure reuse conditions
+ % obtained by the structure
+ % reuse analysis (CTGC).
+
+ maybe_structure_reuse_pred_name :: maybe(sym_name)
+ % When the procedure is an imported
+ % procedure, then we might have to
+ % record the name of the reuse
+ % version of that procedure.
).
proc_info_init(MContext, Arity, Types, DeclaredModes, Modes, MaybeArgLives,
@@ -2122,7 +2145,7 @@
DeclaredModes, Modes, no, MaybeArgLives, MaybeDet, InferredDet,
ClauseBody, CanProcess, ModeErrors, RttiVarMaps, eval_normal,
proc_sub_info(no, no, Term2Info, IsAddressTaken, StackSlots,
- ArgInfo, InitialLiveness, no, no, no, no, no, no)).
+ ArgInfo, InitialLiveness, no, no, no, no, no, no, no, no)).
proc_info_set(Context, BodyVarSet, BodyTypes, HeadVars, InstVarSet, HeadModes,
HeadLives, DeclaredDetism, InferredDetism, Goal, CanProcess,
@@ -2130,7 +2153,8 @@
IsAddressTaken, StackSlots, ArgInfo, Liveness, ProcInfo) :-
ModeErrors = [],
ProcSubInfo = proc_sub_info(ArgSizes, Termination, Termination2,
- IsAddressTaken, StackSlots, ArgInfo, Liveness, no, no, no, no, no, no),
+ IsAddressTaken, StackSlots, ArgInfo, Liveness, no, no, no, no, no,
+ no, no, no),
ProcInfo = proc_info(Context, BodyVarSet, BodyTypes, HeadVars,
InstVarSet, no, HeadModes, no, HeadLives,
DeclaredDetism, InferredDetism, Goal, CanProcess, ModeErrors,
@@ -2151,7 +2175,7 @@
ModeErrors = [],
Term2Info = term_constr_main.term2_info_init,
ProcSubInfo = proc_sub_info(no, no, Term2Info, IsAddressTaken,
- StackSlots, no, Liveness, no, no, no, no, no, no),
+ StackSlots, no, Liveness, no, no, no, no, no, no, no, no),
ProcInfo = proc_info(Context, VarSet, VarTypes, HeadVars,
InstVarSet, no, HeadModes, no, MaybeHeadLives,
MaybeDeclaredDetism, Detism, Goal, yes, ModeErrors,
@@ -2319,6 +2343,20 @@
proc_info_set_structure_sharing(Sharing, !ProcInfo) :-
!:ProcInfo = !.ProcInfo ^ proc_sub_info ^ maybe_structure_sharing :=
yes(Sharing).
+
+proc_info_get_structure_reuse(ProcInfo, MaybeReuse) :-
+ MaybeReuse = ProcInfo ^ proc_sub_info ^ maybe_structure_reuse.
+
+proc_info_set_structure_reuse(Reuse, !ProcInfo) :-
+ !:ProcInfo = !.ProcInfo ^ proc_sub_info ^ maybe_structure_reuse :=
+ yes(Reuse).
+
+proc_info_get_structure_reuse_pred_name(ProcInfo, ReusePredName) :-
+ ReusePredName = ProcInfo ^ proc_sub_info ^ maybe_structure_reuse_pred_name.
+
+proc_info_set_structure_reuse_pred_name(ReusePredName, !ProcInfo) :-
+ !:ProcInfo = !.ProcInfo ^ proc_sub_info ^
+ maybe_structure_reuse_pred_name := yes(ReusePredName).
proc_info_ensure_unique_names(!ProcInfo) :-
proc_info_get_vartypes(!.ProcInfo, VarTypes),
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.41
diff -u -d -r1.41 make_hlds_passes.m
--- compiler/make_hlds_passes.m 27 Apr 2006 07:34:30 -0000 1.41
+++ compiler/make_hlds_passes.m 6 Jun 2006 13:31:30 -0000
@@ -925,6 +925,13 @@
add_pragma_structure_sharing(PredOrFunc, SymName, ModeList,
HeadVars, Types, SharingDomain, Context, !ModuleInfo, !IO)
;
+ Pragma = structure_reuse(PredOrFunc, SymName, ModeList,
+ HeadVars, Types, MaybeReuseDomain, MaybeReusePredName)
+ ->
+ add_pragma_structure_reuse(PredOrFunc, SymName, ModeList,
+ HeadVars, Types, MaybeReuseDomain, MaybeReusePredName,
+ Context, !ModuleInfo, !IO)
+ ;
Pragma = reserve_tag(TypeName, TypeArity)
->
add_pragma_reserve_tag(TypeName, TypeArity, !.Status,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.291
diff -u -d -r1.291 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 5 Jun 2006 02:26:08 -0000 1.291
+++ compiler/mercury_to_mercury.m 6 Jun 2006 13:31:36 -0000
@@ -318,6 +318,12 @@
maybe(prog_varset)::in, list(mer_type)::in, maybe(tvarset)::in,
maybe(structure_sharing_domain)::in, io::di, io::uo) is det.
+:- pred write_pragma_structure_reuse_info(pred_or_func::in, sym_name::in,
+ list(mer_mode)::in, prog_context::in, prog_vars::in,
+ maybe(prog_varset)::in, list(mer_type)::in, maybe(tvarset)::in,
+ maybe(structure_reuse_domain)::in, maybe(sym_name)::in,
+ io::di, io::uo) is det.
+
% Write the given arg size info. Verbose if the second arg is yes.
%
:- pred write_maybe_arg_size_info(maybe(generic_arg_size_info(T))::in,
@@ -669,7 +675,11 @@
write_pragma_structure_sharing_info(PredOrFunc, PredName, ModesList,
Context, HeadVars, no, Types, no, MaybeStructureSharing, !IO)
;
- Pragma = structure_reuse(_, _, _, _, _, _, _)
+ Pragma = structure_reuse(PredOrFunc, PredName, ModesList, HeadVars,
+ Types, MaybeStructureReuseDomain, MaybeReusePredName),
+ write_pragma_structure_reuse_info(PredOrFunc, PredName, ModesList,
+ Context, HeadVars, no, Types, no, MaybeStructureReuseDomain,
+ MaybeReusePredName, !IO)
;
Pragma = mode_check_clauses(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, predicate,
@@ -4349,6 +4359,54 @@
io.write_string(", ", !IO),
prog_ctgc.print_interface_structure_sharing_domain(VarSet, TypeVarSet,
MaybeSharingAs, !IO),
+ io.write_string(").\n", !IO).
+
+write_pragma_structure_reuse_info(PredOrFunc, SymName, Modes, Context,
+ HeadVars, MaybeVarSet, HeadVarTypes, MaybeTypeVarSet,
+ MaybeStructureReuseDomain, MaybeReusePredName, !IO) :-
+ io.write_string(":- pragma structure_reuse(", !IO),
+ varset.init(InitVarSet),
+ (
+ MaybeVarSet = yes(VarSet)
+ ;
+ MaybeVarSet = no,
+ varset.init(VarSet)
+ ),
+ (
+ MaybeTypeVarSet = yes(TypeVarSet)
+ ;
+ MaybeTypeVarSet = no,
+ varset.init(TypeVarSet)
+ ),
+
+ (
+ PredOrFunc = predicate,
+ mercury_output_pred_mode_subdecl(InitVarSet, SymName,
+ Modes, no, Context, !IO)
+ ;
+ PredOrFunc = function,
+ pred_args_to_func_args(Modes, FuncModeList, RetMode),
+ mercury_output_func_mode_subdecl(InitVarSet, SymName,
+ FuncModeList, RetMode, no, Context, !IO)
+ ),
+ % write headvars and types:
+ io.write_string(", ", !IO),
+ write_vars_and_types(HeadVars, VarSet, HeadVarTypes, TypeVarSet, !IO),
+ % write structure reuse information.
+ io.write_string(", ", !IO),
+ prog_ctgc.print_interface_maybe_structure_reuse_domain(VarSet, TypeVarSet,
+ MaybeStructureReuseDomain, !IO),
+ % write name of the reuse version of the procedure
+ io.write_string(", ", !IO),
+ (
+ MaybeReusePredName = no,
+ io.write_string("no", !IO)
+ ;
+ MaybeReusePredName = yes(ReusePredName),
+ io.write_string("yes(", !IO),
+ prog_out.write_quoted_sym_name(ReusePredName, !IO),
+ io.write_string(")", !IO)
+ ),
io.write_string(").\n", !IO).
:- pred write_vars_and_types(prog_vars::in, prog_varset::in,
Index: compiler/prog_ctgc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_ctgc.m,v
retrieving revision 1.9
diff -u -d -r1.9 prog_ctgc.m
--- compiler/prog_ctgc.m 5 Jun 2006 05:23:26 -0000 1.9
+++ compiler/prog_ctgc.m 6 Jun 2006 13:31:37 -0000
@@ -45,9 +45,11 @@
:- func parse_structure_sharing_domain(term(T)) = structure_sharing_domain.
-:- func parse_reuse_tuple(term(T)) = reuse_tuple.
+:- func parse_structure_reuse_condition(term(T)) = structure_reuse_condition.
-:- func parse_reuse_tuples(term(T)) = reuse_tuples.
+:- func parse_structure_reuse_conditions(term(T)) = structure_reuse_conditions.
+
+:- func parse_structure_reuse_domain(term(T)) = structure_reuse_domain.
%-----------------------------------------------------------------------------%
%
@@ -112,14 +114,17 @@
:- pred print_interface_structure_sharing_domain(prog_varset::in,
tvarset::in, maybe(structure_sharing_domain)::in, io::di, io::uo) is det.
-:- pred print_reuse_tuple(prog_varset::in, tvarset::in, reuse_tuple::in,
- io::di, io::uo) is det.
+:- pred print_structure_reuse_condition(prog_varset::in, tvarset::in,
+ structure_reuse_condition::in, io::di, io::uo) is det.
-:- pred print_reuse_tuples(prog_varset::in, tvarset::in, reuse_tuples::in,
- io::di, io::uo) is det.
+:- pred print_structure_reuse_conditions(prog_varset::in, tvarset::in,
+ structure_reuse_conditions::in, io::di, io::uo) is det.
-:- pred print_interface_maybe_reuse_tuples(prog_varset::in, tvarset::in,
- maybe(reuse_tuples)::in, io::di, io::uo) is det.
+:- pred print_structure_reuse_domain(prog_varset::in, tvarset::in,
+ structure_reuse_domain::in, io::di, io::uo) is det.
+
+:- pred print_interface_maybe_structure_reuse_domain(prog_varset::in,
+ tvarset::in, maybe(structure_reuse_domain)::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%
@@ -148,6 +153,18 @@
tsubst::in, structure_sharing_domain::in,
structure_sharing_domain::out) is det.
+:- pred rename_structure_reuse_condition(map(prog_var, prog_var)::in,
+ tsubst::in, structure_reuse_condition::in,
+ structure_reuse_condition::out) is det.
+
+:- pred rename_structure_reuse_conditions(map(prog_var, prog_var)::in,
+ tsubst::in, structure_reuse_conditions::in,
+ structure_reuse_conditions::out) is det.
+
+:- pred rename_structure_reuse_domain(map(prog_var, prog_var)::in,
+ tsubst::in, structure_reuse_domain::in,
+ structure_reuse_domain::out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -329,7 +346,7 @@
unexpected(this_file, "Error while parsing structure sharing domain.")
).
-parse_reuse_tuple(Term) = ReuseTuple :-
+parse_structure_reuse_condition(Term) = ReuseCondition :-
(
Term = term.functor(term.atom(Cons), Args, _)
->
@@ -340,20 +357,17 @@
DeadNodes = parse_datastruct_list(DeadNodesTerm),
InUseNodes = parse_datastruct_list(InUseNodesTerm),
Sharing = parse_structure_sharing_domain(SharingTerm),
- ReuseTuple = conditional(DeadNodes, InUseNodes, Sharing)
- ;
- Cons = "unconditional"
- ->
- ReuseTuple = unconditional
+ ReuseCondition = structure_reuse_condition(DeadNodes,
+ InUseNodes, Sharing)
;
- unexpected(this_file, "Error while parsing reuse tuple.")
+ unexpected(this_file, "Error while parsing reuse condition.")
)
;
- unexpected(this_file, "Error while parsing reuse tuple " ++
+ unexpected(this_file, "Error while parsing reuse condition " ++
"(term not a functor).")
).
-parse_reuse_tuples(Term) = ReuseTuples :-
+parse_structure_reuse_conditions(Term) = ReuseConditions :-
(
Term = term.functor(term.atom(Cons), Args, _)
->
@@ -361,20 +375,47 @@
Cons = "[|]",
Args = [FirstTupleTerm, RestTuplesTerm]
->
- ReuseTuples = [parse_reuse_tuple(FirstTupleTerm)|
- parse_reuse_tuples(RestTuplesTerm)]
+ ReuseConditions = [parse_structure_reuse_condition(FirstTupleTerm)|
+ parse_structure_reuse_conditions(RestTuplesTerm)]
;
Cons = "[]"
->
- ReuseTuples = []
+ ReuseConditions = []
;
- unexpected(this_file, "Error while parsing list of reuse tuples.")
+ unexpected(this_file, "Error while parsing reuse conditions.")
)
;
- unexpected(this_file, "Error while parsing list of reuse tuples " ++
+ unexpected(this_file, "Error while parsing reuse conditions " ++
"(term not a functor).")
).
+parse_structure_reuse_domain(Term) = ReuseDomain :-
+ (
+ Term = term.functor(term.atom(Cons), Args, _)
+ ->
+ (
+ Cons = "has_no_reuse"
+ ->
+ ReuseDomain = has_no_reuse
+ ;
+ Cons = "has_only_unconditional_reuse"
+ ->
+ ReuseDomain = has_only_unconditional_reuse
+ ;
+ Cons = "has_conditional_reuse",
+ Args = [ReuseConditionsTerm]
+ ->
+ ReuseDomain = has_conditional_reuse(
+ parse_structure_reuse_conditions(ReuseConditionsTerm))
+ ;
+ unexpected(this_file, "Error while parsing reuse domain.")
+ )
+ ;
+ unexpected(this_file, "Error while parsing reuse domain " ++
+ "(term not a functor).")
+ ).
+
+
%-----------------------------------------------------------------------------%
%
% Printing routines
@@ -513,35 +554,45 @@
!IO),
io.write_string(")", !IO).
-print_reuse_tuple(ProgVarSet, TypeVarSet, ReuseTuple, !IO) :-
+print_structure_reuse_condition(ProgVarSet, TypeVarSet, ReuseCond, !IO) :-
+ ReuseCond = structure_reuse_condition(DeadNodes, InUseNodes, Sharing),
+ io.write_string("condition(", !IO),
+ print_datastructs(ProgVarSet, TypeVarSet, DeadNodes, !IO),
+ io.write_string(",", !IO),
+ print_datastructs(ProgVarSet, TypeVarSet, InUseNodes, !IO),
+ io.write_string(",", !IO),
+ print_structure_sharing_domain(ProgVarSet, TypeVarSet, no, no,
+ Sharing, !IO),
+ io.write_string(")", !IO).
+
+print_structure_reuse_conditions(ProgVarSet, TypeVarSet, ReuseConds, !IO) :-
+ io.write_string("[", !IO),
+ io.write_list(ReuseConds, ",",
+ print_structure_reuse_condition(ProgVarSet, TypeVarSet), !IO),
+ io.write_string("]", !IO).
+
+print_structure_reuse_domain(ProgVarSet, TypeVarSet, ReuseDomain, !IO) :-
(
- ReuseTuple = unconditional,
- io.write_string("unconditional", !IO)
+ ReuseDomain = has_no_reuse,
+ io.write_string("has_no_reuse", !IO)
;
- ReuseTuple = conditional(DeadNodes, InUseNodes, Sharing),
- io.write_string("conditional(", !IO),
- print_datastructs(ProgVarSet, TypeVarSet, DeadNodes, !IO),
- io.write_string(",", !IO),
- print_datastructs(ProgVarSet, TypeVarSet, InUseNodes, !IO),
- io.write_string(",", !IO),
- print_structure_sharing_domain(ProgVarSet, TypeVarSet, no, no,
- Sharing, !IO),
+ ReuseDomain = has_only_unconditional_reuse,
+ io.write_string("has_only_unconditional_reuse", !IO)
+ ;
+ ReuseDomain = has_conditional_reuse(ReuseConditions),
+ io.write_string("has_conditional_reuse(", !IO),
+ print_structure_reuse_conditions(ProgVarSet, TypeVarSet,
+ ReuseConditions, !IO),
io.write_string(")", !IO)
).
-print_reuse_tuples(ProgVarSet, TypeVarSet, ReuseTuples, !IO) :-
- io.write_string("[", !IO),
- io.write_list(ReuseTuples, ",", print_reuse_tuple(ProgVarSet, TypeVarSet),
- !IO),
- io.write_string("]", !IO).
-
-print_interface_maybe_reuse_tuples(_, _, no, !IO) :-
+print_interface_maybe_structure_reuse_domain(_, _, no, !IO) :-
io.write_string("not_available", !IO).
-print_interface_maybe_reuse_tuples(ProgVarSet, TypeVarSet,
- yes(ReuseTuples), !IO) :-
+print_interface_maybe_structure_reuse_domain(ProgVarSet, TypeVarSet,
+ yes(ReuseDomain), !IO) :-
io.write_string("yes(", !IO),
- print_reuse_tuples(ProgVarSet, TypeVarSet, ReuseTuples, !IO),
+ print_structure_reuse_domain(ProgVarSet, TypeVarSet, ReuseDomain, !IO),
io.write_string(")", !IO).
%-----------------------------------------------------------------------------%
@@ -582,6 +633,24 @@
rename_structure_sharing_domain(Dict, TypeSubst, real(!.List), real(!:List)):-
rename_structure_sharing(Dict, TypeSubst, !List).
+rename_structure_reuse_condition(Dict, TypeSubst,
+ structure_reuse_condition(DeadNodes, LiveNodes, Sharing),
+ structure_reuse_condition(RenDeadNodes, RenLiveNodes, RenSharing)) :-
+ RenDeadNodes = list.map(rename_datastruct(Dict, TypeSubst), DeadNodes),
+ RenLiveNodes = list.map(rename_datastruct(Dict, TypeSubst), LiveNodes),
+ rename_structure_sharing_domain(Dict, TypeSubst, Sharing, RenSharing).
+
+rename_structure_reuse_conditions(Dict, TypeSubst, Conds, RenConds) :-
+ list.map(rename_structure_reuse_condition(Dict, TypeSubst),
+ Conds, RenConds).
+
+rename_structure_reuse_domain(_, _, has_no_reuse, has_no_reuse).
+rename_structure_reuse_domain(_, _, has_only_unconditional_reuse,
+ has_only_unconditional_reuse).
+rename_structure_reuse_domain(Dict, TypeSubst, has_conditional_reuse(Conds),
+ has_conditional_reuse(RenConds)):-
+ rename_structure_reuse_conditions(Dict, TypeSubst, Conds, RenConds).
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.165
diff -u -d -r1.165 prog_data.m
--- compiler/prog_data.m 5 Jun 2006 02:26:09 -0000 1.165
+++ compiler/prog_data.m 6 Jun 2006 13:31:39 -0000
@@ -316,6 +316,8 @@
% (no structure sharing), top (any kind of structure sharing), or
% a list of structure sharing pairs.
%
+ % This is the public representation of the type "sharing_as".
+ %
:- type structure_sharing_domain
---> bottom
; real(structure_sharing)
@@ -355,7 +357,7 @@
%-----------------------------------------------------------------------------%
%
-% Stuff for the `structure_reuse_info' pragma
+% Stuff for the `structure_reuse_info' pragma.
%
:- type dead_var == prog_var.
@@ -367,33 +369,34 @@
:- type live_datastruct == datastruct.
:- type live_datastructs == list(live_datastruct).
- % A reuse-tuple is used to describe the condition for which reuse
- % within a particular procedure is allowed.
+ % This is the public representation of the type "reuse_as".
%
-:- type reuse_tuple
- ---> unconditional
- ; conditional(
- reuse_nodes :: dead_datastructs,
- % The set of datastructures pointing to the memory that
- % becomes 'dead' and thus will be reused. This set is
- % restricted to the head variables of the involved
- % procedure.
-
- live_headvars :: live_datastructs,
- % The set of datastructures inherently live at the moment
- % where the reuse_nodes become dead. This set is
- % restricted to the head variables of the procedure the
- % reuse condition refers to.
-
- sharing_headvars :: structure_sharing_domain
- % Description of the structure sharing existing at the
- % moment where the reuse_nodes become dead. The sharing is
- % also restricted to the headvariables of the concerned
- % procedure.
- ).
+:- type structure_reuse_domain
+ ---> has_no_reuse
+ ; has_only_unconditional_reuse
+ ; has_conditional_reuse(structure_reuse_conditions).
-:- type reuse_tuples == list(reuse_tuple).
+:- type structure_reuse_conditions == list(structure_reuse_condition).
+ % A structure reuse condition specifies all the information needed to
+ % verify whether some memory cells can safely be considered as dead at
+ % some program point, depending on the calling context.
+ % This information consists of three parts:
+ % - a list of dead datastructures specifying which memory cells
+ % might become dead, hence reuseable;
+ % - a list of live datastructures that specifies which memory cells
+ % are always live at the place where the above dead datastructures might
+ % become dead;
+ % - a description of the structure sharing existing at the place
+ % where these datastructures might become dead.
+ %
+:- type structure_reuse_condition
+ ---> structure_reuse_condition(
+ dead_nodes :: dead_datastructs,
+ local_use_nodes :: live_datastructs,
+ local_sharing :: structure_sharing_domain
+ ).
+
%-----------------------------------------------------------------------------%
%
% Stuff for the `unused_args' pragma
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.103
diff -u -d -r1.103 prog_io_pragma.m
--- compiler/prog_io_pragma.m 5 Jun 2006 02:26:10 -0000 1.103
+++ compiler/prog_io_pragma.m 6 Jun 2006 13:31:42 -0000
@@ -1115,6 +1115,66 @@
"declaration", ErrorTerm)
).
+parse_pragma_type(ModuleName, "structure_reuse", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
+ (
+ PragmaTerms = [
+ PredAndModesTerm0,
+ HeadVarsTerm,
+ HeadVarTypesTerm,
+ MaybeStructureReuseTerm,
+ MaybeReusePredNameTerm
+ ],
+ parse_pred_or_func_and_arg_modes(yes(ModuleName), PredAndModesTerm0,
+ ErrorTerm, "`:- pragma structure_reuse' declaration",
+ NameAndModesResult),
+ NameAndModesResult = ok(PredName - PredOrFunc, ModeList),
+
+ % Parse the headvariables:
+ HeadVarsTerm = term.functor(term.atom("vars"), ListHVTerm, _),
+ term.vars_list(ListHVTerm, HeadVarsGeneric),
+ list.map(term.coerce_var, HeadVarsGeneric, HeadVars),
+
+ % Parse the types:
+ HeadVarTypesTerm = term.functor(term.atom("types"), ListTypeTerms, _),
+ parse_types(ListTypeTerms, ok(Types)),
+
+ % Parse the actual structure reuse information.
+
+ (
+ MaybeStructureReuseTerm = term.functor(term.atom("not_available"),
+ _, _),
+ MaybeStructureReuse = no
+ ;
+ MaybeStructureReuseTerm = term.functor(term.atom("yes"),
+ MaybeStructureReuseTermArgs, _),
+ MaybeStructureReuseTermArgs = [ StructureReuseTerm ],
+ StructureReuse = parse_structure_reuse_domain(StructureReuseTerm),
+ MaybeStructureReuse = yes(StructureReuse)
+ ),
+
+ % Parse the name of the optimised version (reuse version) of the
+ % given procedure.
+ (
+ MaybeReusePredNameTerm = term.functor(term.atom("no"), _, _),
+ MaybeReusePredName = no
+ ;
+ MaybeReusePredNameTerm = term.functor(term.atom("yes"),
+ [ReusePredNameTerm], _),
+ sym_name_and_args(ReusePredNameTerm, ReusePredName, []),
+ MaybeReusePredName = yes(ReusePredName)
+ ),
+
+ Result0 = ok(pragma(user, structure_reuse(PredOrFunc, PredName,
+ ModeList, HeadVars, Types, MaybeStructureReuse,
+ MaybeReusePredName)))
+ ->
+ Result = Result0
+ ;
+ Result = error("syntax error in `:- pragma structure_reuse' " ++
+ "declaration", ErrorTerm)
+ ).
+
parse_pragma_type(ModuleName, "exceptions", PragmaTerms, ErrorTerm, _VarSet,
Result) :-
(
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.15
diff -u -d -r1.15 prog_item.m
--- compiler/prog_item.m 5 Jun 2006 02:26:10 -0000 1.15
+++ compiler/prog_item.m 6 Jun 2006 13:31:43 -0000
@@ -627,7 +627,7 @@
reuse_mode :: list(mer_mode),
reuse_headvars :: prog_vars,
reuse_headvartypes :: list(mer_type),
- reuse_description :: maybe(reuse_tuples),
+ reuse_description :: maybe(structure_reuse_domain),
reuse_optimised_name :: maybe(sym_name)
).
% After reuse analysis, the compiler generates structure reuse
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.22
diff -u -d -r1.22 prog_type.m
--- compiler/prog_type.m 20 Apr 2006 05:37:00 -0000 1.22
+++ compiler/prog_type.m 6 Jun 2006 13:31:44 -0000
@@ -26,6 +26,7 @@
:- import_module list.
:- import_module map.
:- import_module maybe.
+:- import_module set.
:- import_module term.
%-----------------------------------------------------------------------------%
@@ -231,6 +232,13 @@
%
:- func put_typeinfo_vars_first(list(prog_var), vartypes) = list(prog_var).
+ % Given a list of variables, remove all the type_info-related
+ % variables.
+ %
+:- func remove_typeinfo_vars(vartypes, list(prog_var)) = list(prog_var).
+:- func remove_typeinfo_vars_from_set(vartypes, set(prog_var))
+ = set(prog_var).
+
% In the forwards mode, this predicate checks for a "new " prefix
% at the start of the functor name, and removes it if present;
% it fails if there is no such prefix.
@@ -780,10 +788,27 @@
put_typeinfo_vars_first(VarsList, VarTypes) =
TypeInfoVarsList ++ NonTypeInfoVarsList :-
+ split_vars_typeinfo_no_typeinfo(VarsList, VarTypes,
+ TypeInfoVarsList, NonTypeInfoVarsList).
+
+remove_typeinfo_vars(VarTypes, VarsList) = NonTypeInfoVarsList :-
+ split_vars_typeinfo_no_typeinfo(VarsList, VarTypes, _,
+ NonTypeInfoVarsList).
+
+remove_typeinfo_vars_from_set(VarTypes, VarsSet) =
+ set.from_list(remove_typeinfo_vars(VarTypes,
+ set.to_sorted_list(VarsSet))).
+
+:- pred split_vars_typeinfo_no_typeinfo(list(prog_var)::in,
+ vartypes::in, list(prog_var)::out, list(prog_var)::out) is det.
+
+split_vars_typeinfo_no_typeinfo(VarsList, VarTypes, TypeInfoVarsList,
+ NonTypeInfoVarsList) :-
list.filter((pred(Var::in) is semidet :-
Type = map.lookup(VarTypes, Var),
is_introduced_type_info_type(Type)),
VarsList, TypeInfoVarsList, NonTypeInfoVarsList).
+
remove_new_prefix(unqualified(Name0), unqualified(Name)) :-
string.append("new ", Name, Name0).
Index: compiler/structure_reuse.analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_reuse.analysis.m,v
retrieving revision 1.3
diff -u -d -r1.3 structure_reuse.analysis.m
--- compiler/structure_reuse.analysis.m 5 Jun 2006 05:23:27 -0000 1.3
+++ compiler/structure_reuse.analysis.m 6 Jun 2006 13:31:45 -0000
@@ -52,30 +52,53 @@
:- interface.
:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
:- import_module io.
+%-----------------------------------------------------------------------------%
+
+ % Perform structure reuse analysis on the procedures defined in the
+ % current module.
+ %
:- pred structure_reuse_analysis(module_info::in, module_info::out,
io::di, io::uo) is det.
+ % Write all the reuse information concerning the specified predicate as
+ % reuse pragma's.
+ %
+:- pred write_pred_reuse_info(module_info::in, pred_id::in,
+ io::di, io::uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.goal_path.
-:- import_module hlds.hlds_pred.
:- import_module hlds.passes_aux.
:- import_module libs.globals.
:- import_module libs.options.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.modules.
+:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
:- import_module transform_hlds.ctgc.structure_reuse.direct.
:- import_module transform_hlds.ctgc.structure_reuse.domain.
:- import_module transform_hlds.ctgc.structure_reuse.indirect.
:- import_module transform_hlds.ctgc.structure_reuse.lbu.
:- import_module transform_hlds.ctgc.structure_reuse.lfu.
+:- import_module transform_hlds.ctgc.structure_reuse.split.
:- import_module transform_hlds.ctgc.structure_sharing.domain.
+:- import_module bool.
+:- import_module list.
+:- import_module map.
+:- import_module maybe.
+:- import_module pair.
+:- import_module set.
:- import_module string.
%-----------------------------------------------------------------------------%
@@ -88,7 +111,7 @@
% Load all the available reuse information into a reuse table.
% XXX TO DO!
- % ReuseTable0 = load_structure_reuse_table(!.ModuleInfo),
+ ReuseTable0 = load_structure_reuse_table(!.ModuleInfo),
% Pre-annotate each of the goals with "Local Forward Use" and
% "Local Backward Use" information, and fill in all the goal_path slots
@@ -101,9 +124,8 @@
% Determine information about possible direct reuses.
maybe_write_string(VeryVerbose, "% Direct reuse...\n", !IO),
- DummyReuseTable = reuse_as_table_init,
direct_reuse_pass(SharingTable, !ModuleInfo,
- DummyReuseTable, ReuseTable1, !IO),
+ ReuseTable0, ReuseTable1, !IO),
maybe_write_string(VeryVerbose, "% Direct reuse: done.\n", !IO),
reuse_as_table_maybe_dump(VeryVerbose, ReuseTable1, !IO),
@@ -112,23 +134,43 @@
indirect_reuse_pass(SharingTable, !ModuleInfo, ReuseTable1, ReuseTable2,
!IO),
maybe_write_string(VeryVerbose, "% Indirect reuse: done.\n", !IO),
- reuse_as_table_maybe_dump(VeryVerbose, ReuseTable2, !IO).
+ reuse_as_table_maybe_dump(VeryVerbose, ReuseTable2, !IO),
% For every procedure that has some potential (conditional) reuse (either
% direct or indirect), create a new procedure that actually implements
% that reuse.
% XXX TO DO!
- % split_reuse_procedures(!ModuleInfo, ReuseTable2, ReuseTable3, !IO),
- % reuse_as_table_maybe_dump(VeryVerbose, ReuseTable3, !IO).
+ split_reuse_procedures(ReuseTable2, !ModuleInfo, !IO),
% Record the results of the reuse table into the HLDS.
- % XXX TO DO!
- % map.foldl(save_reuse_in_module_info, ReuseTable3, !ModuleInfo).
+ map.foldl(save_reuse_in_module_info, ReuseTable2, !ModuleInfo).
%
% Output some profiling information.
% XXX TO DO!
% profiling(!.ModuleInfo, ReuseTable3).
+:- pred save_reuse_in_module_info(pred_proc_id::in, reuse_as::in,
+ module_info::in, module_info::out) is det.
+
+save_reuse_in_module_info(PPId, ReuseAs, !ModuleInfo) :-
+ save_reuse_in_module_info_2(PPId, ReuseAs, !ModuleInfo),
+ module_info_get_structure_reuse_map(!.ModuleInfo, ReuseMap),
+ ( map.search(ReuseMap, PPId, Result) ->
+ Result = ReusePPId - _Name,
+ save_reuse_in_module_info_2(ReusePPId, ReuseAs, !ModuleInfo)
+ ;
+ true
+ ).
+
+:- pred save_reuse_in_module_info_2(pred_proc_id::in, reuse_as::in,
+ module_info::in, module_info::out) is det.
+
+save_reuse_in_module_info_2(PPId, ReuseAs, !ModuleInfo) :-
+ module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
+ proc_info_set_structure_reuse(to_structure_reuse_domain(ReuseAs),
+ ProcInfo0, ProcInfo),
+ module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo).
+
:- pred annotate_in_use_information(pred_id::in, proc_id::in,
module_info::in, proc_info::in, proc_info::out, io::di, io::uo) is det.
@@ -137,6 +179,109 @@
backward_use_information(ModuleInfo, !ProcInfo),
fill_goal_path_slots(ModuleInfo, !ProcInfo).
+%-----------------------------------------------------------------------------%
+%
+% Code for writing out optimization interfaces
+%
+
+:- pred make_opt_int(module_info::in, io::di, io::uo) is det.
+
+make_opt_int(ModuleInfo, !IO) :-
+ module_info_get_name(ModuleInfo, ModuleName),
+ module_name_to_file_name(ModuleName, ".opt.tmp", no, OptFileName, !IO),
+ globals.io_lookup_bool_option(verbose, Verbose, !IO),
+ maybe_write_string(Verbose, "% Appending structure_reuse pragmas to ",
+ !IO),
+ maybe_write_string(Verbose, add_quotes(OptFileName), !IO),
+ maybe_write_string(Verbose, "...", !IO),
+ maybe_flush_output(Verbose, !IO),
+ io.open_append(OptFileName, OptFileRes, !IO),
+ (
+ OptFileRes = ok(OptFile),
+ io.set_output_stream(OptFile, OldStream, !IO),
+ module_info_predids(ModuleInfo, PredIds),
+ list.foldl(write_pred_reuse_info(ModuleInfo), PredIds, !IO),
+ io.set_output_stream(OldStream, _, !IO),
+ io.close_output(OptFile, !IO),
+ maybe_write_string(Verbose, " done.\n", !IO)
+ ;
+ OptFileRes = error(IOError),
+ maybe_write_string(Verbose, " failed!\n", !IO),
+ io.error_message(IOError, IOErrorMessage),
+ io.write_strings(["Error opening file `",
+ OptFileName, "' for output: ", IOErrorMessage], !IO),
+ io.set_exit_status(1, !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for writing out structure_reuse pragmas
+%
+
+write_pred_reuse_info(ModuleInfo, PredId, !IO) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_import_status(PredInfo, ImportStatus),
+ module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
+ TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
+ (
+ (
+ ImportStatus = exported
+ ;
+ ImportStatus = opt_exported
+ ),
+ \+ is_unify_or_compare_pred(PredInfo),
+
+ % XXX These should be allowed, but the predicate declaration for the
+ % specialized predicate is not produced before the structure_reuse
+ % pragmas are read in, resulting in an undefined predicate error.
+ \+ set.member(PredId, TypeSpecForcePreds)
+ ->
+ PredName = pred_info_name(PredInfo),
+ ProcIds = pred_info_procids(PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ ModuleName = pred_info_module(PredInfo),
+ pred_info_get_procedures(PredInfo, ProcTable),
+ pred_info_context(PredInfo, Context),
+ SymName = qualified(ModuleName, PredName),
+ pred_info_get_typevarset(PredInfo, TypeVarSet),
+ module_info_get_structure_reuse_map(ModuleInfo, ReuseMap),
+ list.foldl(
+ write_proc_reuse_info(ReuseMap, PredId, ProcTable, PredOrFunc,
+ SymName, Context, TypeVarSet),
+ ProcIds, !IO)
+ ;
+ true
+ ).
+
+:- pred write_proc_reuse_info(structure_reuse_map::in, pred_id::in,
+ proc_table::in, pred_or_func::in, sym_name::in, prog_context::in,
+ tvarset::in, proc_id::in, io::di, io::uo) is det.
+
+write_proc_reuse_info(ReuseMap, PredId, ProcTable, PredOrFunc, SymName,
+ Context, TypeVarSet, ProcId, !IO) :-
+ globals.io_lookup_bool_option(structure_reuse_analysis,
+ ReuseAnalysis, !IO),
+ (
+ ReuseAnalysis = yes,
+ map.lookup(ProcTable, ProcId, ProcInfo),
+ proc_info_get_structure_reuse(ProcInfo, MaybeStructureReuseDomain),
+ ( map.search(ReuseMap, proc(PredId, ProcId), Result) ->
+ Result = _ReusePPId - ReusePredName,
+ MaybeReusePredName = yes(ReusePredName)
+ ;
+ MaybeReusePredName = no
+ ),
+ proc_info_declared_argmodes(ProcInfo, Modes),
+ proc_info_get_varset(ProcInfo, VarSet),
+ proc_info_get_headvars(ProcInfo, HeadVars),
+ proc_info_get_vartypes(ProcInfo, VarTypes),
+ list.map(map.lookup(VarTypes), HeadVars, HeadVarTypes),
+ write_pragma_structure_reuse_info(PredOrFunc, SymName, Modes,
+ Context, HeadVars, yes(VarSet), HeadVarTypes, yes(TypeVarSet),
+ MaybeStructureReuseDomain, MaybeReusePredName, !IO)
+ ;
+ ReuseAnalysis = no
+ ).
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/structure_reuse.domain.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_reuse.domain.m,v
retrieving revision 1.3
diff -u -d -r1.3 structure_reuse.domain.m
--- compiler/structure_reuse.domain.m 5 Jun 2006 05:23:27 -0000 1.3
+++ compiler/structure_reuse.domain.m 6 Jun 2006 13:31:46 -0000
@@ -74,22 +74,6 @@
:- pred reuse_condition_subsumed_by(module_info::in, proc_info::in,
reuse_condition::in, reuse_condition::in) is semidet.
- % Translate a reuse condition to its new environment.
- % E.g. Consider a procedure definition: p :- ..., q, ... ,
- % where q contains a potential reuse expressed by a condition C, then this
- % condition needs to be translated to calls to p, such that calls to p
- % can be checked w.r.t. reuses that are possible in q.
- %
- % In order to translate a condition to its new environment, the same kind
- % of information is needed as when creating an initial condition, i.e.:
- % set of variables in local forward and backward use, as well as the
- % structure sharing existing at that place.
- %
-% XXX To be implemented. Used at indirect-reuse-analysis stage.
-% :- pred reuse_condition_translate(module_info::in, proc_info::in,
-% set(prog_var)::in, set(prog_var)::in, sharing_as::in, reuse_condition::in,
-% reuse_condition::out) is det.
-
%-----------------------------------------------------------------------------%
% reuse_as
%
@@ -186,9 +170,11 @@
:- pred reuse_as_satisfied(module_info::in, proc_info::in, livedata::in,
sharing_as::in, prog_vars::in, reuse_as::in) is semidet.
-% XXX TO DO!
-% :- func from_reuse_domain(reuse_domain) = reuse_as.
-% :- func to_reuse_domain(reuse_as) = reuse_domain.
+ % Conversion procedures between the public (structure_reuse_domain)
+ % and private (reuse_as) representation for structure reuse conditions.
+ %
+:- func from_structure_reuse_domain(structure_reuse_domain) = reuse_as.
+:- func to_structure_reuse_domain(reuse_as) = structure_reuse_domain.
%-----------------------------------------------------------------------------%
%
@@ -208,8 +194,10 @@
:- pred reuse_as_table_maybe_dump(bool::in, reuse_as_table::in,
io::di, io::uo) is det.
-% XXX TO DO!
-% :- func load_structure_reuse_table(module_info) = reuse_as_table.
+ % Load all the structure reuse information present in the HLDS into
+ % a reuse table.
+ %
+:- func load_structure_reuse_table(module_info) = reuse_as_table.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -221,6 +209,7 @@
:- import_module transform_hlds.ctgc.datastruct.
:- import_module transform_hlds.ctgc.util.
+:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module string.
@@ -620,6 +609,63 @@
).
%-----------------------------------------------------------------------------%
+
+from_structure_reuse_domain(ReuseDomain) = ReuseAs :-
+ (
+ ReuseDomain = has_no_reuse,
+ ReuseAs = no_reuse
+ ;
+ ReuseDomain = has_only_unconditional_reuse,
+ ReuseAs = unconditional
+ ;
+ ReuseDomain = has_conditional_reuse(PublicReuseConditions),
+ ReuseAs = conditional(
+ from_public_reuse_conditions(PublicReuseConditions))
+ ).
+
+:- func from_public_reuse_conditions(structure_reuse_conditions) =
+ reuse_conditions.
+
+from_public_reuse_conditions(PublicReuseConditions) =
+ list.map(from_public_reuse_condition, PublicReuseConditions).
+
+:- func from_public_reuse_condition(structure_reuse_condition) =
+ reuse_condition.
+
+from_public_reuse_condition(PublicReuseCondition) = ReuseCondition :-
+ PublicReuseCondition = structure_reuse_condition(DeadNodes, LiveNodes,
+ PublicSharing),
+ ReuseCondition = condition(DeadNodes, LiveNodes,
+ from_structure_sharing_domain(PublicSharing)).
+
+to_structure_reuse_domain(ReuseAs) = ReuseDomain :-
+ (
+ ReuseAs = no_reuse,
+ ReuseDomain = has_no_reuse
+ ;
+ ReuseAs = unconditional,
+ ReuseDomain = has_only_unconditional_reuse
+ ;
+ ReuseAs = conditional(ReuseConditions),
+ ReuseDomain = has_conditional_reuse(
+ to_structure_reuse_conditions(ReuseConditions))
+ ).
+
+:- func to_structure_reuse_conditions(reuse_conditions) =
+ structure_reuse_conditions.
+
+to_structure_reuse_conditions(ReuseConditions) =
+ list.filter_map(to_structure_reuse_condition, ReuseConditions).
+
+:- func to_structure_reuse_condition(reuse_condition) =
+ structure_reuse_condition is semidet.
+
+to_structure_reuse_condition(Condition) = StructureReuseCondition :-
+ Condition = condition(DeadNodes, LiveNodes, SharingAs),
+ StructureReuseCondition = structure_reuse_condition(DeadNodes, LiveNodes,
+ to_structure_sharing_domain(SharingAs)).
+
+%-----------------------------------------------------------------------------%
%
% reuse_as_table
%
@@ -658,6 +704,35 @@
string.int_to_string(proc_id_to_int(ProcId)) ++ "\t-->" ++
reuse_as_short_description(ReuseAs) ++ "\n", !IO).
+load_structure_reuse_table(ModuleInfo) = ReuseTable :-
+ module_info_predids(ModuleInfo, PredIds),
+ list.foldl(load_structure_reuse_table_2(ModuleInfo), PredIds,
+ reuse_as_table_init, ReuseTable).
+
+:- pred load_structure_reuse_table_2(module_info::in, pred_id::in,
+ reuse_as_table::in, reuse_as_table::out) is det.
+
+load_structure_reuse_table_2(ModuleInfo, PredId, !ReuseTable) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_procids(PredInfo),
+ list.foldl(load_structure_reuse_table_3(ModuleInfo, PredId),
+ ProcIds, !ReuseTable).
+
+:- pred load_structure_reuse_table_3(module_info::in, pred_id::in,
+ proc_id::in, reuse_as_table::in, reuse_as_table::out) is det.
+
+load_structure_reuse_table_3(ModuleInfo, PredId, ProcId, !ReuseTable) :-
+ module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
+ proc_info_get_structure_reuse(ProcInfo, MaybePublicReuse),
+ (
+ MaybePublicReuse = yes(PublicReuse),
+ PPId = proc(PredId, ProcId),
+ PrivateReuse = from_structure_reuse_domain(PublicReuse),
+ reuse_as_table_set(PPId, PrivateReuse, !ReuseTable)
+ ;
+ MaybePublicReuse = no
+ ).
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.2
diff -u -d -r1.2 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m 5 Jun 2006 05:23:27 -0000 1.2
+++ compiler/structure_reuse.indirect.m 6 Jun 2006 13:31:46 -0000
@@ -63,6 +63,7 @@
:- import_module transform_hlds.ctgc.util.
:- import_module transform_hlds.dependency_graph.
+:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
@@ -196,9 +197,17 @@
ir_background_info_init(ModuleInfo, PredInfo, ProcInfo, SharingTable,
ReuseTable) = BG :-
+ PredOrigArity = pred_info_orig_arity(PredInfo),
proc_info_get_headvars(ProcInfo, HeadVars),
+ PredArity = list.length(HeadVars),
+ Diff = PredArity - PredOrigArity,
+ % We don't need to keep track of any information regarding inserted
+ % type-info arguments and alike, so we remove them from the list
+ % of headvariables:
+ list.det_split_list(Diff, HeadVars, _AddedHeadVars, OrigHeadVars),
+
BG = ir_background_info(ModuleInfo, PredInfo, ProcInfo,
- SharingTable, ReuseTable, HeadVars).
+ SharingTable, ReuseTable, OrigHeadVars).
:- func analysis_info_init(pred_proc_id, sr_fixpoint_table) = ir_analysis_info.
@@ -400,27 +409,8 @@
verify_indirect_reuse(BaseInfo, CalleePredId, CalleeProcId, CalleeArgs,
!GoalInfo, !AnalysisInfo, !IO):-
- globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
- reuse_as_table_maybe_dump(VeryVerbose, BaseInfo ^ reuse_table, !IO),
-
- ModuleInfo = BaseInfo ^ module_info,
-
- % Check if the called procedure already has a reuse version (which can
- % be the case if it is a procedure belonging to an imported module).
- module_info_get_structure_reuse_info(ModuleInfo, ModuleReuseInfo),
- ModuleReuseInfo = structure_reuse_info(ReuseMap),
- ( map.search(ReuseMap, proc(CalleePredId, CalleeProcId), Result) ->
- Result = proc(ReuseCalleePredId, ReuseCalleeProcId) - _Name,
- CalleePPId = proc(ReuseCalleePredId, ReuseCalleeProcId),
- passes_aux.write_proc_progress_message(
- "%\t\tSuccess lookup in reuse map: ",
- CalleePredId, CalleeProcId, ModuleInfo, !IO)
- ;
- CalleePPId = proc(CalleePredId, CalleeProcId)
- ),
-
- % Find the reuse information of the called procedure (or its explicit
- % reuse version) in the reuse table:
+ % Find the reuse information of the called procedure in the reuse table:
+ CalleePPId = proc(CalleePredId, CalleeProcId),
lookup_reuse_as(BaseInfo, CalleePPId, !AnalysisInfo, FormalReuseAs),
(
Index: compiler/structure_reuse.lbu.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_reuse.lbu.m,v
retrieving revision 1.2
diff -u -d -r1.2 structure_reuse.lbu.m
--- compiler/structure_reuse.lbu.m 5 Jun 2006 05:23:27 -0000 1.2
+++ compiler/structure_reuse.lbu.m 6 Jun 2006 13:31:47 -0000
@@ -44,6 +44,7 @@
:- import_module hlds.hlds_llds.
:- import_module libs.compiler_util.
:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_type.
:- import_module list.
:- import_module pair.
@@ -52,35 +53,35 @@
%-----------------------------------------------------------------------------%
-backward_use_information(ModuleInfo, !ProcInfo):-
+backward_use_information(_ModuleInfo, !ProcInfo):-
proc_info_get_goal(!.ProcInfo, Goal0),
+ proc_info_get_vartypes(!.ProcInfo, VarTypes),
% Before the first goal, the set of variables in LBU is empty.
LBU0 = set.init,
- backward_use_in_goal(ModuleInfo, !.ProcInfo, Goal0, Goal, LBU0, _LBU),
+ backward_use_in_goal(VarTypes, Goal0, Goal, LBU0, _LBU),
proc_info_set_goal(Goal, !ProcInfo).
-:- pred backward_use_in_goal(module_info::in, proc_info::in,
- hlds_goal::in, hlds_goal::out, set(prog_var)::in, set(prog_var)::out)
- is det.
+:- pred backward_use_in_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
+ set(prog_var)::in, set(prog_var)::out) is det.
-backward_use_in_goal(ModuleInfo, ProcInfo, !TopGoal, !LBU) :-
+backward_use_in_goal(VarTypes, !TopGoal, !LBU) :-
!.TopGoal = Expr0 - Info0,
% Add resume_vars to the LBU-set.
- set.union(get_backtrack_vars(Info0), !LBU),
+ set.union(get_backtrack_vars(VarTypes, Info0), !LBU),
- backward_use_in_goal_2(ModuleInfo, ProcInfo, Info0, Expr0, Expr, !LBU),
+ backward_use_in_goal_2(VarTypes, Info0, Expr0, Expr, !LBU),
goal_info_set_lbu(!.LBU, Info0, Info),
!:TopGoal = Expr - Info.
-:- pred backward_use_in_goal_2(module_info::in, proc_info::in,
- hlds_goal_info::in, hlds_goal_expr::in, hlds_goal_expr::out,
- set(prog_var)::in, set(prog_var)::out) is det.
+:- pred backward_use_in_goal_2(vartypes::in, hlds_goal_info::in,
+ hlds_goal_expr::in, hlds_goal_expr::out, set(prog_var)::in,
+ set(prog_var)::out) is det.
-backward_use_in_goal_2(ModuleInfo, ProcInfo, Info0, !Expr, !LBU) :-
+backward_use_in_goal_2(VarTypes, Info0, !Expr, !LBU) :-
% Handle each goal type separately:
(
!.Expr = unify(_, _, _, _, _)
@@ -98,7 +99,8 @@
goal_info_get_pre_births(Info0, PreBirths),
goal_info_get_post_births(Info0, PostBirths),
!:LBU = set.union_list([goal_info_get_lfu(Info0),
- PreBirths, PostBirths, !.LBU])
+ remove_typeinfo_vars_from_set(VarTypes, PreBirths),
+ remove_typeinfo_vars_from_set(VarTypes, PostBirths), !.LBU])
;
true
)
@@ -110,22 +112,21 @@
!.Expr = foreign_proc(_, _, _, _, _, _)
;
!.Expr = conj(ConjType, Goals0),
- backward_use_in_conj(ModuleInfo, ProcInfo,
- Goals0, Goals, !LBU),
+ backward_use_in_conj(VarTypes, Goals0, Goals, !LBU),
!:Expr = conj(ConjType, Goals)
;
!.Expr = disj(Goals0),
- backward_use_in_disj(ModuleInfo, ProcInfo, Goals0, Goals, !LBU),
+ backward_use_in_disj(VarTypes, Goals0, Goals, !LBU),
!:Expr = disj(Goals)
;
!.Expr = switch(A, B, Cases0),
- backward_use_in_cases(ModuleInfo, ProcInfo, Cases0, Cases, !LBU),
+ backward_use_in_cases(VarTypes, Cases0, Cases, !LBU),
!:Expr = switch(A, B, Cases)
;
!.Expr = not(Goal0),
% handled as: if(Goal0) then fail else true
LBU0 = !.LBU,
- backward_use_in_goal(ModuleInfo, ProcInfo, Goal0, Goal, !.LBU, _),
+ backward_use_in_goal(VarTypes, Goal0, Goal, !.LBU, _),
% A not does not introduce any choice-points! Hence the
% not itself is deterministic, and no new variables in LBU
% are introduced into the resulting LBU-set.
@@ -133,7 +134,7 @@
!:Expr = not(Goal)
;
!.Expr = scope(Reason, SomeGoal0),
- backward_use_in_goal(ModuleInfo, ProcInfo, SomeGoal0, SomeGoal, !LBU),
+ backward_use_in_goal(VarTypes, SomeGoal0, SomeGoal, !LBU),
!:Expr = scope(Reason, SomeGoal)
;
% XXX The implementation for if-then-else is different from the theory
@@ -145,7 +146,7 @@
LBU0 = !.LBU,
% Annotate Cond-goal.
- backward_use_in_goal(ModuleInfo, ProcInfo, Cond0, Cond, LBU0, _),
+ backward_use_in_goal(VarTypes, Cond0, Cond, LBU0, _),
% Annotate Then-goal.
% When annotating the then-part, the lbu used for it should not
@@ -155,12 +156,11 @@
Cond0 = CondGoal0 - CondInfo0,
goal_info_set_resume_point(no_resume_point, CondInfo0, InfoTmp),
CondTmp = CondGoal0 - InfoTmp,
- backward_use_in_goal(ModuleInfo, ProcInfo, CondTmp, _, LBU0, LBU0T),
- backward_use_in_goal(ModuleInfo, ProcInfo, Then0, Then, LBU0T, LBUT),
+ backward_use_in_goal(VarTypes, CondTmp, _, LBU0, LBU0T),
+ backward_use_in_goal(VarTypes, Then0, Then, LBU0T, LBUT),
% Annotate Else-goal.
- backward_use_in_goal(ModuleInfo, ProcInfo, Else0, Else,
- LBU0, LBUE),
+ backward_use_in_goal(VarTypes, Else0, Else, LBU0, LBUE),
set.union(LBUT, LBUE, !:LBU),
!:Expr = if_then_else(Vars, Cond, Then, Else)
;
@@ -168,13 +168,13 @@
unexpected(this_file, "backward_use_in_goal_2: shorthand goal.")
).
-:- func get_backtrack_vars(hlds_goal_info) = set(prog_var).
+:- func get_backtrack_vars(vartypes, hlds_goal_info) = set(prog_var).
-get_backtrack_vars(Info) = Vars :-
+get_backtrack_vars(VarTypes, Info) = Vars :-
goal_info_get_resume_point(Info, ResPoint),
(
ResPoint = resume_point(ResVars, _),
- Vars = ResVars
+ Vars = remove_typeinfo_vars_from_set(VarTypes, ResVars)
;
ResPoint = no_resume_point,
Vars = set.init
@@ -187,49 +187,43 @@
detism_allows_multiple_solns(cc_nondet).
detism_allows_multiple_solns(cc_multidet).
-:- pred backward_use_in_conj(module_info::in, proc_info::in,
- hlds_goals::in, hlds_goals::out, set(prog_var)::in, set(prog_var)::out)
- is det.
+:- pred backward_use_in_conj(vartypes::in, list(hlds_goal)::in,
+ list(hlds_goal)::out, set(prog_var)::in, set(prog_var)::out) is det.
-backward_use_in_conj(ModuleInfo, ProcInfo, !Goals, !LBU) :-
- list.map_foldl(backward_use_in_goal(ModuleInfo, ProcInfo), !Goals, !LBU).
+backward_use_in_conj(VarTypes, !Goals, !LBU) :-
+ list.map_foldl(backward_use_in_goal(VarTypes), !Goals, !LBU).
-:- pred backward_use_in_cases(module_info::in, proc_info::in,
- list(case)::in, list(case)::out, set(prog_var)::in, set(prog_var)::out)
- is det.
+:- pred backward_use_in_cases(vartypes::in, list(case)::in, list(case)::out,
+ set(prog_var)::in, set(prog_var)::out) is det.
-backward_use_in_cases(ModuleInfo, ProcInfo, !Cases, !LBU) :-
+backward_use_in_cases(VarTypes, !Cases, !LBU) :-
% Every case is analysed with the same initial set of LBU-vars.
LBU0 = !.LBU,
- list.map_foldl(backward_use_in_case(LBU0, ModuleInfo, ProcInfo),
- !Cases, !LBU).
+ list.map_foldl(backward_use_in_case(LBU0, VarTypes), !Cases, !LBU).
-:- pred backward_use_in_case(set(prog_var)::in, module_info::in,
- proc_info::in, case::in, case::out, set(prog_var)::in, set(prog_var)::out)
- is det.
+:- pred backward_use_in_case(set(prog_var)::in, vartypes::in, case::in,
+ case::out, set(prog_var)::in, set(prog_var)::out) is det.
-backward_use_in_case(LBU0, ModuleInfo, ProcInfo, !Case, !LBU):-
+backward_use_in_case(LBU0, VarTypes, !Case, !LBU):-
!.Case = case(Cons, Goal0),
- backward_use_in_goal(ModuleInfo, ProcInfo, Goal0, Goal, LBU0, NewLBU),
+ backward_use_in_goal(VarTypes, Goal0, Goal, LBU0, NewLBU),
!:Case = case(Cons, Goal),
set.union(NewLBU, !LBU).
-:- pred backward_use_in_disj(module_info::in, proc_info::in,
- hlds_goals::in, hlds_goals::out, set(prog_var)::in, set(prog_var)::out)
- is det.
+:- pred backward_use_in_disj(vartypes::in, list(hlds_goal)::in,
+ list(hlds_goal)::out, set(prog_var)::in, set(prog_var)::out) is det.
-backward_use_in_disj(ModuleInfo, ProcInfo, !Goals, !LBU) :-
+backward_use_in_disj(VarTypes, !Goals, !LBU) :-
% Every disj-goal is analysed with the same initial set of LBU-vars.
LBU0 = !.LBU,
- list.map_foldl(backward_use_in_disj_goal(LBU0, ModuleInfo, ProcInfo),
- !Goals, !LBU).
+ list.map_foldl(backward_use_in_disj_goal(LBU0, VarTypes), !Goals, !LBU).
-:- pred backward_use_in_disj_goal(set(prog_var)::in, module_info::in,
- proc_info::in, hlds_goal::in, hlds_goal::out, set(prog_var)::in,
+:- pred backward_use_in_disj_goal(set(prog_var)::in, vartypes::in,
+ hlds_goal::in, hlds_goal::out, set(prog_var)::in,
set(prog_var)::out) is det.
-backward_use_in_disj_goal(LBU0, ModuleInfo, ProcInfo, !Goal, !LBU) :-
- backward_use_in_goal(ModuleInfo, ProcInfo, !Goal, LBU0, NewLBU),
+backward_use_in_disj_goal(LBU0, VarTypes, !Goal, !LBU) :-
+ backward_use_in_goal(VarTypes, !Goal, LBU0, NewLBU),
set.union(NewLBU, !LBU).
%-----------------------------------------------------------------------------%
Index: compiler/structure_reuse.lfu.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_reuse.lfu.m,v
retrieving revision 1.2
diff -u -d -r1.2 structure_reuse.lfu.m
--- compiler/structure_reuse.lfu.m 5 Jun 2006 05:23:27 -0000 1.2
+++ compiler/structure_reuse.lfu.m 6 Jun 2006 13:31:47 -0000
@@ -37,8 +37,10 @@
:- import_module hlds.hlds_pred.
:- import_module libs.compiler_util.
:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_type.
:- import_module list.
+:- import_module map.
:- import_module set.
:- import_module pair.
:- import_module string.
@@ -46,6 +48,7 @@
%-----------------------------------------------------------------------------%
forward_use_information(!ProcInfo) :-
+ proc_info_get_vartypes(!.ProcInfo, VarTypes),
proc_info_get_goal(!.ProcInfo, Goal0),
% Set of variables initially instantiated.
@@ -54,85 +57,98 @@
% syntactically do not occur in the remainder of the goal.
set.init(DeadVars0),
- forward_use_in_goal(Goal0, Goal, InstantiatedVars0, _InstantiatedVars,
- DeadVars0, _DeadVars),
+ forward_use_in_goal(VarTypes, Goal0, Goal,
+ remove_typeinfo_vars_from_set(VarTypes, InstantiatedVars0),
+ _InstantiatedVars, DeadVars0, _DeadVars),
proc_info_set_goal(Goal, !ProcInfo).
+:- pred forward_use_in_goal(vartypes::in, hlds_goal::in, hlds_goal::out,
+ set(prog_var)::in, set(prog_var)::out,
+ set(prog_var)::in, set(prog_var)::out) is det.
-:- pred forward_use_in_goal(hlds_goal::in, hlds_goal::out, set(prog_var)::in,
- set(prog_var)::out, set(prog_var)::in, set(prog_var)::out) is det.
-
-forward_use_in_goal(!Goal, !InstantiatedVars, !DeadVars) :-
+forward_use_in_goal(VarTypes, !Goal, !InstantiatedVars, !DeadVars) :-
(
!.Goal = GoalExpr0 - GoalInfo0,
goal_is_atomic(GoalExpr0)
->
InstantiatedVars0 = !.InstantiatedVars,
- compute_instantiated_and_dead_vars(GoalInfo0, !InstantiatedVars,
- !DeadVars),
+ compute_instantiated_and_dead_vars(VarTypes, GoalInfo0,
+ !InstantiatedVars, !DeadVars),
set.difference(InstantiatedVars0, !.DeadVars, LFU),
goal_info_set_lfu(LFU, GoalInfo0, GoalInfo),
!:Goal = GoalExpr0 - GoalInfo
;
- forward_use_in_composite_goal(!Goal, !InstantiatedVars, !DeadVars)
+ forward_use_in_composite_goal(VarTypes, !Goal,
+ !InstantiatedVars, !DeadVars)
).
-:- pred compute_instantiated_and_dead_vars(hlds_goal_info::in,
- set(prog_var)::in, set(prog_var)::out,
+:- pred compute_instantiated_and_dead_vars(vartypes::in, hlds_goal_info::in,
+ set(prog_var)::in, set(prog_var)::out,
set(prog_var)::in, set(prog_var)::out) is det.
-compute_instantiated_and_dead_vars(Info, !Inst, !Dead) :-
+compute_instantiated_and_dead_vars(VarTypes, Info, !Inst, !Dead) :-
% Inst = Inst0 + birth-set
% Dead = Dead0 + death-set
goal_info_get_pre_births(Info, PreBirths),
goal_info_get_post_births(Info, PostBirths),
goal_info_get_post_deaths(Info, PostDeaths),
goal_info_get_pre_deaths(Info, PreDeaths),
- !:Inst = set.union_list([PreBirths, PostBirths, !.Inst]),
+ !:Inst = set.union_list([
+ remove_typeinfo_vars_from_set(VarTypes, PreBirths),
+ remove_typeinfo_vars_from_set(VarTypes, PostBirths), !.Inst]),
!:Dead = set.union_list([PreDeaths, PostDeaths, !.Dead]).
-:- pred forward_use_in_composite_goal(hlds_goal::in, hlds_goal::out,
- set(prog_var)::in, set(prog_var)::out, set(prog_var)::in,
- set(prog_var)::out) is det.
+:- pred forward_use_in_composite_goal(vartypes::in, hlds_goal::in,
+ hlds_goal::out, set(prog_var)::in, set(prog_var)::out,
+ set(prog_var)::in, set(prog_var)::out) is det.
-forward_use_in_composite_goal(!Goal, !InstantiatedVars, !DeadVars) :-
+forward_use_in_composite_goal(VarTypes, !Goal, !InstantiatedVars,
+ !DeadVars) :-
!.Goal = GoalExpr0 - GoalInfo0,
InstantiadedBefore = !.InstantiatedVars,
(
GoalExpr0 = conj(A,Goals0)
->
- forward_use_in_conj(Goals0, Goals, !InstantiatedVars, !DeadVars),
- GoalExpr = conj(A,Goals)
+ forward_use_in_conj(VarTypes, Goals0, Goals,
+ !InstantiatedVars, !DeadVars),
+ GoalExpr = conj(A, Goals)
;
GoalExpr0 = switch(A, B, Cases0)
->
- forward_use_in_cases(Cases0, Cases, !InstantiatedVars, !DeadVars),
+ forward_use_in_cases(VarTypes, Cases0, Cases,
+ !InstantiatedVars, !DeadVars),
GoalExpr = switch(A, B, Cases)
;
GoalExpr0 = disj(Disj0)
->
- forward_use_in_disj(Disj0, Disj, !InstantiatedVars, !DeadVars),
+ forward_use_in_disj(VarTypes, Disj0, Disj,
+ !InstantiatedVars, !DeadVars),
GoalExpr = disj(Disj)
;
GoalExpr0 = not(Goal0)
->
- forward_use_in_goal(Goal0, Goal, !InstantiatedVars, !DeadVars),
+ forward_use_in_goal(VarTypes, Goal0, Goal,
+ !InstantiatedVars, !DeadVars),
GoalExpr = not(Goal)
;
GoalExpr0 = scope(A, Goal0)
->
- forward_use_in_goal(Goal0, Goal, !InstantiatedVars, !DeadVars),
+ forward_use_in_goal(VarTypes, Goal0, Goal,
+ !InstantiatedVars, !DeadVars),
GoalExpr = scope(A, Goal)
;
GoalExpr0 = if_then_else(V, Cond0, Then0, Else0)
->
Inst0 = !.InstantiatedVars,
Dead0 = !.DeadVars,
- forward_use_in_goal(Cond0, Cond, !InstantiatedVars, !DeadVars),
- forward_use_in_goal(Then0, Then, !InstantiatedVars, !DeadVars),
- forward_use_in_goal(Else0, Else, Inst0, Inst1, Dead0, Dead1),
+ forward_use_in_goal(VarTypes, Cond0, Cond,
+ !InstantiatedVars, !DeadVars),
+ forward_use_in_goal(VarTypes, Then0, Then,
+ !InstantiatedVars, !DeadVars),
+ forward_use_in_goal(VarTypes, Else0, Else, Inst0, Inst1,
+ Dead0, Dead1),
set.union(Inst1, !InstantiatedVars),
set.union(Dead1, !DeadVars),
GoalExpr = if_then_else(V, Cond, Then, Else)
@@ -144,51 +160,53 @@
goal_info_set_lfu(LFU, GoalInfo0, GoalInfo),
!:Goal = GoalExpr - GoalInfo.
-:- pred forward_use_in_conj(list(hlds_goal)::in, list(hlds_goal)::out,
- set(prog_var)::in, set(prog_var)::out, set(prog_var)::in,
- set(prog_var)::out) is det.
+:- pred forward_use_in_conj(vartypes::in, list(hlds_goal)::in,
+ list(hlds_goal)::out, set(prog_var)::in, set(prog_var)::out,
+ set(prog_var)::in, set(prog_var)::out) is det.
-forward_use_in_conj(!Goals, !InstantiatedVars, !DeadVars) :-
- list.map_foldl2(forward_use_in_goal, !Goals, !InstantiatedVars,
- !DeadVars).
+forward_use_in_conj(VarTypes, !Goals, !InstantiatedVars, !DeadVars) :-
+ list.map_foldl2(forward_use_in_goal(VarTypes), !Goals,
+ !InstantiatedVars, !DeadVars).
-:- pred forward_use_in_cases(list(case)::in, list(case)::out,
+:- pred forward_use_in_cases(vartypes::in, list(case)::in, list(case)::out,
set(prog_var)::in, set(prog_var)::out, set(prog_var)::in,
set(prog_var)::out) is det.
-forward_use_in_cases(!Cases, !InstantiatedVars, !DeadVars) :-
+forward_use_in_cases(VarTypes, !Cases, !InstantiatedVars, !DeadVars) :-
Inst0 = !.InstantiatedVars,
Dead0 = !.DeadVars,
- list.map_foldl2(forward_use_in_case(Inst0, Dead0),
+ list.map_foldl2(forward_use_in_case(VarTypes, Inst0, Dead0),
!Cases, !InstantiatedVars, !DeadVars).
-:- pred forward_use_in_case(set(prog_var)::in, set(prog_var)::in,
- case::in, case::out, set(prog_var)::in, set(prog_var)::out,
- set(prog_var)::in, set(prog_var)::out) is det.
+:- pred forward_use_in_case(vartypes::in, set(prog_var)::in,
+ set(prog_var)::in, case::in, case::out, set(prog_var)::in,
+ set(prog_var)::out, set(prog_var)::in, set(prog_var)::out) is det.
-forward_use_in_case(Inst0, Dead0, !Case, !InstantiatedVars, !DeadVars) :-
+forward_use_in_case(VarTypes, Inst0, Dead0, !Case,
+ !InstantiatedVars, !DeadVars) :-
!.Case = case(Cons, Goal0),
- forward_use_in_goal(Goal0, Goal, Inst0, Inst, Dead0, Dead),
+ forward_use_in_goal(VarTypes, Goal0, Goal, Inst0, Inst, Dead0, Dead),
!:Case = case(Cons, Goal),
set.union(Inst, !InstantiatedVars),
set.union(Dead, !DeadVars).
-:- pred forward_use_in_disj(list(hlds_goal)::in, list(hlds_goal)::out,
- set(prog_var)::in, set(prog_var)::out, set(prog_var)::in,
- set(prog_var)::out) is det.
+:- pred forward_use_in_disj(vartypes::in, list(hlds_goal)::in,
+ list(hlds_goal)::out, set(prog_var)::in, set(prog_var)::out,
+ set(prog_var)::in, set(prog_var)::out) is det.
-forward_use_in_disj(!Goals, !InstantiatedVars, !DeadVars):-
+forward_use_in_disj(VarTypes, !Goals, !InstantiatedVars, !DeadVars):-
Inst0 = !.InstantiatedVars,
Dead0 = !.DeadVars,
- list.map_foldl2(forward_use_in_disj_goal(Inst0, Dead0),
+ list.map_foldl2(forward_use_in_disj_goal(VarTypes, Inst0, Dead0),
!Goals, !InstantiatedVars, !DeadVars).
-:- pred forward_use_in_disj_goal(set(prog_var)::in, set(prog_var)::in,
- hlds_goal::in, hlds_goal::out, set(prog_var)::in, set(prog_var)::out,
- set(prog_var)::in, set(prog_var)::out) is det.
+:- pred forward_use_in_disj_goal(vartypes::in, set(prog_var)::in,
+ set(prog_var)::in, hlds_goal::in, hlds_goal::out, set(prog_var)::in,
+ set(prog_var)::out, set(prog_var)::in, set(prog_var)::out) is det.
-forward_use_in_disj_goal(Inst0, Dead0, !Goal, !InstantiatedVars, !DeadVars) :-
- forward_use_in_goal(!Goal, Inst0, Inst, Dead0, Dead),
+forward_use_in_disj_goal(VarTypes, Inst0, Dead0, !Goal,
+ !InstantiatedVars, !DeadVars) :-
+ forward_use_in_goal(VarTypes, !Goal, Inst0, Inst, Dead0, Dead),
set.union(Inst, !InstantiatedVars),
set.union(Dead, !DeadVars).
Index: compiler/structure_reuse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_reuse.m,v
retrieving revision 1.3
diff -u -d -r1.3 structure_reuse.m
--- compiler/structure_reuse.m 29 May 2006 13:04:35 -0000 1.3
+++ compiler/structure_reuse.m 6 Jun 2006 13:31:48 -0000
@@ -21,6 +21,7 @@
:- include_module lbu.
:- include_module direct.
:- include_module indirect.
+ :- include_module split.
% :- include_module util.
:- include_module domain.
Index: compiler/structure_reuse.split.m
===================================================================
RCS file: compiler/structure_reuse.split.m
diff -N compiler/structure_reuse.split.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/structure_reuse.split.m 6 Jun 2006 13:31:48 -0000
@@ -0,0 +1,302 @@
+%------------------------------------------------------------------------------%
+% vim: ft=mercury ff=unix ts=4 sw=4 et
+%------------------------------------------------------------------------------%
+% Copyright (C) 2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: structure_reuse.split.m
+% Main authors: nancy
+%
+% Provide the functionality to create optimised versions of those procedures
+% for which reuse was detected.
+%
+%------------------------------------------------------------------------------%
+
+:- module structure_reuse.split.
+
+:- interface.
+
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+:- import_module transform_hlds.ctgc.structure_reuse.domain.
+
+:- import_module io.
+
+
+ % For each of the entries in the reuse table:
+ % * if the listed reuse is conditional, then duplicate the
+ % pred-info/proc-info of the original procedure, changing all potential
+ % reuse annotation to real reuses;
+ % * if the listed reuse is unconditional, then no duplication is needed,
+ % yet the goal needs to be traversed to correctly replace all
+ % procedure calls to calls to reuse versions whenever needed.
+ % * if the listed reuse is "no reuse", then obviously, nothing needs to
+ % be done.
+ %
+ % This process updates the module information by adding the new predicates,
+ % and recording the pred-proc-id to the reuse pred-proc-id mappings in
+ % module_info.
+ %
+:- pred split_reuse_procedures(reuse_as_table::in, module_info::in,
+ module_info::out, io::di, io::uo) is det.
+
+ % Create a copy of the predicate/procedure information specified by the
+ % given pred_proc_id, and return the pred_proc_id of that copy. This
+ % operation also updates the structure_reuse_map in the HLDS. Note that the
+ % copy is not altered w.r.t. structure reuse. It is a plain copy, nothing
+ % more than that.
+ %
+:- pred create_fresh_pred_proc_info_copy(pred_proc_id::in, pred_proc_id::out,
+ module_info::in, module_info::out) is det.
+
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module hlds.hlds_goal.
+:- import_module hlds.passes_aux.
+:- import_module hlds.pred_table.
+:- import_module libs.compiler_util.
+:- import_module mdbcomp.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.prog_util.
+
+:- import_module map.
+:- import_module maybe.
+:- import_module pair.
+:- import_module string.
+:- import_module list.
+
+:- type reuse_name == sym_name.
+
+:- func generate_reuse_name(module_info, pred_proc_id) = reuse_name.
+generate_reuse_name(ModuleInfo, PPId) = ReuseName :-
+ module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _ProcInfo),
+ PPId = proc(_, ProcId),
+ Line = 0,
+ Counter = proc_id_to_int(ProcId),
+ make_pred_name_with_context(pred_info_module(PredInfo), "ctgc",
+ pred_info_is_pred_or_func(PredInfo), pred_info_name(PredInfo),
+ Line, Counter, ReuseName).
+
+%------------------------------------------------------------------------------%
+
+ % This process can be split into separate steps:
+ % - determine all the pred-proc-ids of procedure with conditional reuse;
+ % - create duplicates of these procedures (and record the mapping in
+ % the structure_reuse_map in module_info);
+ % - traverse all these procedures + the procedures with unconditional reuse
+ % to correctly update the reuse annotations.
+ %
+split_reuse_procedures(ReuseTable, !ModuleInfo, !IO):-
+ PPIds = map.keys(ReuseTable),
+ CondPPIds = list.filter(has_conditional_reuse(ReuseTable), PPIds),
+ UncondPPIds = list.filter(has_unconditional_reuse(ReuseTable), PPIds),
+
+ % Create all the duplicates:
+ list.map_foldl(create_fresh_pred_proc_info_copy,
+ CondPPIds, ReuseCondPPIds, !ModuleInfo),
+
+ % Process all the goals to update the reuse annotations:
+ module_info_get_structure_reuse_map(!.ModuleInfo, ReuseMap),
+ list.foldl2(process_proc(ReuseMap), list.append(ReuseCondPPIds,
+ UncondPPIds), !ModuleInfo, !IO).
+
+:- pred has_conditional_reuse(reuse_as_table::in, pred_proc_id::in) is semidet.
+
+has_conditional_reuse(ReuseTable, PPId) :-
+ ReuseAs = reuse_as_table_search(PPId, ReuseTable),
+ reuse_as_conditional_reuses(ReuseAs).
+
+:- pred has_unconditional_reuse(reuse_as_table::in, pred_proc_id::in)
+ is semidet.
+has_unconditional_reuse(ReuseTable, PPId) :-
+ ReuseAs = reuse_as_table_search(PPId, ReuseTable),
+ reuse_as_all_unconditional_reuses(ReuseAs).
+
+%------------------------------------------------------------------------------%
+
+create_fresh_pred_proc_info_copy(PPId, NewPPId, !ModuleInfo):-
+ module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
+ proc_info_get_structure_reuse_pred_name(ProcInfo0, MaybeReuseName),
+ (
+ MaybeReuseName = yes(ReusePredName)
+ ;
+ MaybeReuseName = no,
+ ReusePredName = generate_reuse_name(!.ModuleInfo, PPId)
+ ),
+ create_fresh_pred_proc_info_copy_2(PredInfo0, ProcInfo0, ReusePredName,
+ ReusePredInfo, ReuseProcId),
+
+ module_info_get_predicate_table(!.ModuleInfo, PredTable0),
+ predicate_table_insert(ReusePredInfo, ReusePredId, PredTable0, PredTable),
+ NewPPId = proc(ReusePredId, ReuseProcId),
+ module_info_set_predicate_table(PredTable, !ModuleInfo),
+
+ module_info_get_structure_reuse_map(!.ModuleInfo, ReuseMap0),
+ map.det_insert(ReuseMap0, PPId, NewPPId - ReusePredName, ReuseMap),
+ module_info_set_structure_reuse_map(ReuseMap, !ModuleInfo).
+
+
+:- pred create_fresh_pred_proc_info_copy_2(pred_info::in, proc_info::in,
+ reuse_name::in, pred_info::out, proc_id::out) is det.
+
+create_fresh_pred_proc_info_copy_2(PredInfo, ProcInfo, ReusePredName,
+ ReusePredInfo, ReuseProcId):-
+ ModuleName = pred_info_module(PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ pred_info_context(PredInfo, ProgContext),
+ pred_info_get_origin(PredInfo, PredOrigin),
+ pred_info_get_import_status(PredInfo, ImportStatus),
+ pred_info_get_markers(PredInfo, PredMarkers),
+ pred_info_get_arg_types(PredInfo, MerTypes),
+ pred_info_get_typevarset(PredInfo, TVarset),
+ pred_info_get_exist_quant_tvars(PredInfo, ExistQTVars),
+ pred_info_get_class_context(PredInfo, ProgConstraints),
+ pred_info_get_assertions(PredInfo, AssertIds),
+ pred_info_create(ModuleName, ReusePredName, PredOrFunc, ProgContext,
+ PredOrigin, ImportStatus, PredMarkers, MerTypes, TVarset,
+ ExistQTVars, ProgConstraints, AssertIds, ProcInfo, ReuseProcId,
+ ReusePredInfo).
+
+%------------------------------------------------------------------------------%
+
+ % Process the goal of the procedure with the given pred_proc_id so that
+ % all potential reuses are replaced by real reuses, and all calls to
+ % procedures that have a reuse version are replaced by calls to their
+ % reuse version (if of course, that is in accordance with the reuse
+ % annotations).
+ %
+:- pred process_proc(structure_reuse_map::in,
+ pred_proc_id::in, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+process_proc(ReuseMap, PPId, !ModuleInfo, !IO):-
+ write_proc_progress_message("(split) ", PPId, !.ModuleInfo, !IO),
+ module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
+ proc_info_get_goal(ProcInfo0, Goal0),
+ process_goal(ReuseMap, Goal0, Goal, !IO),
+ proc_info_set_goal(Goal, ProcInfo0, ProcInfo),
+ module_info_set_pred_proc_info(PPId, PredInfo0, ProcInfo, !ModuleInfo).
+
+:- pred process_goal(structure_reuse_map::in, hlds_goal::in, hlds_goal::out,
+ io::di, io::uo) is det.
+
+process_goal(ReuseMap, !Goal, !IO) :-
+ !.Goal = GoalExpr0 - GoalInfo0,
+ (
+ GoalExpr0 = conj(ConjType, Goals0),
+ list.map_foldl(process_goal(ReuseMap), Goals0, Goals, !IO),
+ GoalExpr = conj(ConjType, Goals),
+ !:Goal = GoalExpr - GoalInfo0
+ ;
+ GoalExpr0 = call(CalleePredId, CalleeProcId, A, B, C, CalleePredName),
+ ReuseDescription0 = goal_info_get_reuse(GoalInfo0),
+ (
+ % If the reuse description already sais "reuse", then this is
+ % a call to a procedure which might have specified conditions, yet
+ % whose conditions are always met, hence do not imply conditions on
+ % the procedure in which this call appears. We must therefore
+ % make sure to call the appropriate version of the called
+ % procedure.
+ ReuseDescription0 = reuse(reuse_call(_CondDescr))
+ ->
+ determine_reuse_version(ReuseMap, CalleePredId, CalleeProcId,
+ CalleePredName, ReuseCalleePredId, ReuseCalleeProcId,
+ ReuseCalleePredName),
+ GoalExpr = call(ReuseCalleePredId, ReuseCalleeProcId, A, B, C,
+ ReuseCalleePredName),
+ !:Goal = GoalExpr - GoalInfo0
+ ;
+ ReuseDescription0 = potential_reuse(reuse_call(CondDescr))
+ ->
+ % Replace the call to the reuse version, and change the
+ % potential reuse annotation to a real annotation.
+ determine_reuse_version(ReuseMap, CalleePredId, CalleeProcId,
+ CalleePredName, ReuseCalleePredId, ReuseCalleeProcId,
+ ReuseCalleePredName),
+ GoalExpr = call(ReuseCalleePredId, ReuseCalleeProcId, A, B, C,
+ ReuseCalleePredName),
+ ReuseDescription = reuse(reuse_call(CondDescr)),
+ goal_info_set_reuse(ReuseDescription, GoalInfo0, GoalInfo),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ true
+ )
+ ;
+ GoalExpr0 = generic_call(_, _, _, _)
+ ;
+ GoalExpr0 = unify(_, _, _, _, _),
+ ReuseDescription0 = goal_info_get_reuse(GoalInfo0),
+ (
+ ReuseDescription0 = potential_reuse(Descr)
+ ->
+ ReuseDescription = reuse(Descr),
+ goal_info_set_reuse(ReuseDescription, GoalInfo0, GoalInfo),
+ !:Goal = GoalExpr0 - GoalInfo
+ ;
+ true
+ )
+ ;
+ GoalExpr0 = disj(Goals0),
+ list.map_foldl(process_goal(ReuseMap), Goals0, Goals, !IO),
+ GoalExpr = disj(Goals),
+ !:Goal = GoalExpr - GoalInfo0
+ ;
+ GoalExpr0 = switch(A, B, Cases0),
+ list.map_foldl(process_case(ReuseMap), Cases0, Cases, !IO),
+ GoalExpr = switch(A, B, Cases),
+ !:Goal = GoalExpr - GoalInfo0
+ ;
+ % XXX To check and compare with the theory.
+ GoalExpr0 = not(_Goal)
+ ;
+ GoalExpr0 = scope(A, SubGoal0),
+ process_goal(ReuseMap, SubGoal0, SubGoal, !IO),
+ GoalExpr = scope(A, SubGoal),
+ !:Goal = GoalExpr - GoalInfo0
+ ;
+ GoalExpr0 = if_then_else(A, IfGoal0, ThenGoal0, ElseGoal0),
+ process_goal(ReuseMap, IfGoal0, IfGoal, !IO),
+ process_goal(ReuseMap, ThenGoal0, ThenGoal, !IO),
+ process_goal(ReuseMap, ElseGoal0, ElseGoal, !IO),
+ GoalExpr = if_then_else(A, IfGoal, ThenGoal, ElseGoal),
+ !:Goal = GoalExpr - GoalInfo0
+ ;
+ GoalExpr0 = foreign_proc(_Attrs, _ForeignPredId, _ForeignProcId,
+ _ForeignArgs, _, _)
+ ;
+ GoalExpr0 = shorthand(_),
+ unexpected(this_file, "process_goal: shorthand goal.")
+ ).
+
+:- pred determine_reuse_version(structure_reuse_map::in, pred_id::in,
+ proc_id::in, sym_name::in, pred_id::out, proc_id::out,
+ reuse_name::out) is det.
+
+determine_reuse_version(ReuseMap, PredId, ProcId, PredName,
+ ReusePredId, ReuseProcId, ReusePredName) :-
+ ( map.search(ReuseMap, proc(PredId, ProcId), Result) ->
+ Result = proc(ReusePredId, ReuseProcId) - ReusePredName
+ ;
+ ReusePredId = PredId,
+ ReuseProcId = ProcId,
+ ReusePredName = PredName
+ ).
+
+:- pred process_case(structure_reuse_map::in, case::in, case::out,
+ io::di, io::uo) is det.
+
+process_case(ReuseMap, !Case, !IO) :-
+ !.Case = case(ConsId, Goal0),
+ process_goal(ReuseMap, Goal0, Goal, !IO),
+ !:Case = case(ConsId, Goal).
+
+%------------------------------------------------------------------------------%
+:- func this_file = string.
+this_file = "structure_reuse.split.m".
+
+:- end_module structure_reuse.split.
+%------------------------------------------------------------------------------%
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.13
diff -u -d -r1.13 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 5 Jun 2006 05:23:27 -0000 1.13
+++ compiler/structure_sharing.analysis.m 6 Jun 2006 13:31:49 -0000
@@ -25,9 +25,15 @@
%-----------------------------------------------------------------------------%
+ % Perform structure sharing analysis on the procedures defined in the
+ % current module.
+ %
:- pred structure_sharing_analysis(module_info::in, module_info::out,
io::di, io::uo) is det.
+ % Write all the sharing information concerning the specified predicate as
+ % reuse pragma's.
+ %
:- pred write_pred_sharing_info(module_info::in, pred_id::in,
io::di, io::uo) is det.
@@ -561,7 +567,7 @@
% XXX These should be allowed, but the predicate declaration for the
% specialized predicate is not produced before the structure_sharing
- % pramgas are read in, resulting in an undefined predicate error.
+ % pragmas are read in, resulting in an undefined predicate error.
\+ set.member(PredId, TypeSpecForcePreds)
->
PredName = pred_info_name(PredInfo),
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.39
diff -u -d -r1.39 trans_opt.m
--- compiler/trans_opt.m 5 Jun 2006 02:26:11 -0000 1.39
+++ compiler/trans_opt.m 6 Jun 2006 13:31:49 -0000
@@ -93,6 +93,8 @@
:- import_module parse_tree.prog_io.
:- import_module parse_tree.prog_out.
:- import_module transform_hlds.ctgc.
+:- import_module transform_hlds.ctgc.structure_reuse.
+:- import_module transform_hlds.ctgc.structure_reuse.analysis.
:- import_module transform_hlds.ctgc.structure_sharing.
:- import_module transform_hlds.ctgc.structure_sharing.analysis.
:- import_module transform_hlds.exception_analysis.
@@ -104,6 +106,7 @@
:- import_module list.
:- import_module map.
+:- import_module pair.
:- import_module set.
:- import_module string.
:- import_module term.
@@ -147,8 +150,21 @@
list.foldl(term_constr_main.output_pred_termination2_info(Module),
PredIds, !IO),
+ % XXX I have a strong feeling that also writing termination info and
+ % exception information should be limited to those pred_ids that do not
+ % correspond to compiler generated reuse versions of other predicates.
+ %
+ module_info_get_structure_reuse_map(Module, ReuseMap),
+ map.values(ReuseMap, ReuseResults),
+ list.map(fst, ReuseResults, ReusePredProcIds),
+ list.map(get_pred_id, ReusePredProcIds, ReusePredIds),
+ list.delete_elems(PredIds, ReusePredIds, PredIdsNoReuseVersions),
+
list.foldl(structure_sharing.analysis.write_pred_sharing_info(Module),
- PredIds, !IO),
+ PredIdsNoReuseVersions, !IO),
+ list.foldl(structure_reuse.analysis.write_pred_reuse_info(Module),
+ PredIdsNoReuseVersions, !IO),
+
module_info_get_exception_info(Module, ExceptionInfo),
list.foldl(
exception_analysis.write_pragma_exceptions(Module, ExceptionInfo),
@@ -171,6 +187,10 @@
update_interface(OptName, !IO),
touch_interface_datestamp(ModuleName, ".trans_opt_date", !IO)
).
+
+:- pred get_pred_id(pred_proc_id::in, pred_id::out) is det.
+
+get_pred_id(proc(PredId, _ProcId), PredId).
%-----------------------------------------------------------------------------%
%
--
nancy.mazur at cs.kuleuven.ac.be ------------ Katholieke Universiteit Leuven -
tel: +32-16-327596 - fax: +32-16-327996 ------- Dept. of Computer Science -
Disclaimer: http://www.kuleuven.be/cwis/email_disclaimer.htm
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list