[m-dev.] [reuse] diff: add indirect pass
Nancy Mazur
Nancy.Mazur at cs.kuleuven.ac.be
Fri Oct 13 01:59:16 AEDT 2000
Hi,
===================================================================
Estimated hours taken: 10
Implement the final phase of the reformed structure reuse analysis: compute the
fixpoint for the indirect reuses. This final phase has in fact been split into
two parts: 1. compute the fixpoint, and 2. create the actual new versions of the
reuse predicates, and process the goals so that each call to a reuse version of
a procedure, calls the correct predid-procid (this is done in sr_split.m).
This change also meant that all references to the old reuse-pass had to be removed.
sr_indirect.m:
Fixpoint computation to detect indirect reuses and to propagate the
reuse_conditions they might impose.
sr_split.m:
(new file) Create separate reuse-versions based on the results obtained by
the final fixpoint-computation. Also process each goal so that it
calls the correct predid/procid if a reuse version is allowed.
(this is mainly code from sr_reuse_run that has been moved here).
fixpoint_table.m:
pa_util.m:
The general fixpoint table needed to be generalized even more, unfortunately
abandoning the great typeclass thingy...
The generalization was needed so that any init-function can be used for
initializing the entries of the fixpoint-table.
hlds_data.m:
New predicate: cons_id_maybe_arity: unlike cons_id_arity, this predicate will
not abort on the special cons_ids.
hlds_pred.m:
make_hlds.m:
mercury_compile.m:
prog_data.m:
prog_io_pragma.m:
trans_opt.m:
Replace references to the old single-pass-reuse-analysis, to the reformed
multi-pass reuse-analysis.
sr_data.m:
Moved predicates related to the former sr_reuse__reuse_condition type to
the new sr_data__reuse_condition type.
Added the type memo_reuse as a replacement of sr_reuse__tabled_reuse. Added
predicates to manipulate that type.
sr_util.m:
(new file) Some general use predicates which probably should move to
more appropriate modules.
sr_dead.m:
Move code to sr_util.
Handle cons_ids more carefully, not to abort when special cons_ids
are encountered.
sr_direct.m:
Update the proc_info with the maybe-reuses found after the choice-pass.
structure_reuse.m:
Take into account the fixpoint pass.
Add new predicate for outputting the correct reuse_info pragma's.
sr_reuse_run.m:
sr_run.m:
These two files will become obsolete very soon.
Index: fixpoint_table.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/fixpoint_table.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 fixpoint_table.m
--- fixpoint_table.m 2000/09/19 10:39:08 1.1.2.1
+++ fixpoint_table.m 2000/10/12 14:48:45
@@ -17,31 +17,24 @@
:- import_module list.
-:- typeclass tc_element(T) where [
- pred equal(T, T),
- mode equal(in,in) is semidet,
-
- pred init(T),
- mode init(out) is det
-].
-
:- type fixpoint_table( K, E ).
% initialise the table
% The first parameter is a list of keys which will be allowed in
% the table.
-:- pred fp_init(list(K),fixpoint_table(K, E)) <= tc_element(E).
-:- mode fp_init(in,out) is det.
+ % 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),fixpoint_table(K, E)) <= tc_element(E).
+:- pred fp_new_run(fixpoint_table(K, E),fixpoint_table(K, E)).
:- mode fp_new_run(in,out) is det.
-:- pred fp_which_run(fixpoint_table(K,E), int) <= tc_element(E).
+:- pred fp_which_run(fixpoint_table(K,E), int).
:- mode fp_which_run(in,out) is det.
% check whether a fixpoint has been reached
-:- pred fp_stable(fixpoint_table(K, E)) <= tc_element(E).
+:- pred fp_stable(fixpoint_table(K, E)).
:- mode fp_stable(in) is semidet.
% add a new element (E) associated with key (K) to the table.
@@ -53,20 +46,21 @@
% - if the element was not yet present in the table, add it
% to the table (which does not change the stability of the
% table)
-:- pred fp_add(K,E,fixpoint_table(K, E),fixpoint_table(K, E)) <= tc_element(E).
-:- mode fp_add(in,in,in,out) is det.
+ % 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.
% retreive an element (E) associated with key (K) from the table.
- % This operation can change the state of the table if the element
- % is not yet present in the table. This means that we're facing
+ % 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,E,fixpoint_table(K, E),fixpoint_table(K, E)) <= tc_element(E).
+ % allowed keys, then the procedure will fail.
+:- pred fp_get(K,E,fixpoint_table(K, E),fixpoint_table(K, E)).
:- mode fp_get(in,out,in,out) is semidet.
% retreive 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,E,fixpoint_table(K,E)) <= tc_element(E).
+:- pred fp_get_final(K,E,fixpoint_table(K,E)).
:- mode fp_get_final(in,out,in) is det.
:- implementation.
@@ -82,10 +76,19 @@
mapping :: map( K, E )
).
-fp_init( Ks, T ) :-
+fp_init( Init, Ks, T ) :-
Run = 0,
Stable = yes,
- map__init(Map),
+ map__init(Map0),
+ list__foldl(
+ (pred(K::in, M0::in, M::out) is det :-
+ Init(K, ELEM),
+ map__det_insert(M0, K, ELEM, M)
+ ),
+ Ks,
+ Map0,
+ Map
+ ),
T = ft(Ks,Run,Stable,Map).
fp_new_run( T0, T0^run := NewRun ) :-
@@ -95,14 +98,14 @@
fp_stable( T ) :-
T^stable = yes .
-fp_add( INDEX, ELEM, Tin, Tout ) :-
+fp_add( Equal, INDEX, ELEM, Tin, Tout ) :-
Map = Tin^mapping,
Sin = Tin^stable,
(
map__search( Map, INDEX, TabledELEM)
->
(
- equal(TabledELEM,ELEM)
+ Equal(TabledELEM,ELEM)
->
S = yes
;
@@ -132,17 +135,18 @@
List = Tin^keys,
list__member(INDEX,List), % can fail
MAPin = Tin^mapping,
- Sin = Tin^stable,
+ % Sin = Tin^stable,
(
map__search( MAPin, INDEX, TabledELEM)
->
ELEM = TabledELEM,
- Sout = Sin,
+ Sout = no,
MAPout = MAPin
;
- init(ELEM),
- Sout = no,
- map__det_insert(MAPin, INDEX, ELEM, MAPout)
+ require__error("(fixpoint_table): key not in map")
+ % init(ELEM),
+ % Sout = no,
+ % map__det_insert(MAPin, INDEX, ELEM, MAPout)
),
Tout = (Tin^mapping := MAPout)^stable := Sout.
Index: hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.46.4.1
diff -u -r1.46.4.1 hlds_data.m
--- hlds_data.m 2000/09/25 17:02:39 1.46.4.1
+++ hlds_data.m 2000/10/12 14:48:47
@@ -123,6 +123,12 @@
:- pred cons_id_arity(cons_id, arity).
:- mode cons_id_arity(in, out) is det.
+ % Get the arity of a cons_id. Return a `no' on those cons_ids
+ % where cons_id_arity/2 would normally abort.
+
+:- pred cons_id_maybe_arity( cons_id, maybe(arity)).
+:- mode cons_id_maybe_arity( in, out) is det.
+
% The reverse conversion - make a cons_id for a functor.
% Given a const and an arity for the functor, create a cons_id.
@@ -181,6 +187,16 @@
error("cons_id_arity: can't get arity of base_typeclass_info_const").
cons_id_arity(tabling_pointer_const(_, _), _) :-
error("cons_id_arity: can't get arity of tabling_pointer_const").
+
+cons_id_maybe_arity(cons(_, Arity), yes(Arity)).
+cons_id_maybe_arity(int_const(_), yes(0)).
+cons_id_maybe_arity(string_const(_), yes(0)).
+cons_id_maybe_arity(float_const(_), yes(0)).
+cons_id_maybe_arity(pred_const(_, _, _), no) .
+cons_id_maybe_arity(code_addr_const(_, _), no).
+cons_id_maybe_arity(type_ctor_info_const(_, _, _), no) .
+cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _), no).
+cons_id_maybe_arity(tabling_pointer_const(_, _), no).
make_functor_cons_id(term__atom(Name), Arity,
cons(unqualified(Name), Arity)).
Index: hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.81.2.4
diff -u -r1.81.2.4 hlds_pred.m
--- hlds_pred.m 2000/09/25 17:02:53 1.81.2.4
+++ hlds_pred.m 2000/10/12 14:49:03
@@ -17,7 +17,7 @@
:- import_module globals, term_util.
:- import_module bool, list, set, map, std_util, term, varset.
:- import_module pa_alias_as.
-:- import_module sr_reuse.
+:- import_module sr_data.
:- implementation.
@@ -1440,10 +1440,12 @@
:- pred proc_info_set_global_use(proc_info, set(prog_var), proc_info).
:- mode proc_info_set_global_use(in, in, out) is det.
-:- pred proc_info_reuse_information(proc_info, tabled_reuse).
+:- pred proc_info_reuse_information(proc_info,
+ maybe(list(sr_data__reuse_condition))).
:- mode proc_info_reuse_information(in, out) is det.
-:- pred proc_info_set_reuse_information(proc_info, tabled_reuse, proc_info).
+:- pred proc_info_set_reuse_information(proc_info,
+ maybe(list(sr_data__reuse_condition)), proc_info).
:- mode proc_info_set_reuse_information(in, in, out) is det.
% For a set of variables V, find all the type variables in the types
@@ -1616,7 +1618,16 @@
% (corresponds to the final set
% of Local Forward Use in the goal)
% (set during structure_reuse phase)
- structure_reuse:: tabled_reuse
+
+ % Set of possible reuses within
+ % the given procedure.
+ % XXX This will
+ % become obsolete and should be
+ % replaced by our new
+ % reuse_conditions in our new
+ % approach.
+ structure_reuse:: maybe(list(sr_data__reuse_condition))
+
).
% Some parts of the procedure aren't known yet. We initialize
@@ -1644,13 +1655,13 @@
RLExprn = no,
ALIAS = no,
GLOBAL_USE = no,
- sr_reuse__tabled_reuse_init(TREUSE),
+ REUSE = no,
NewProc = procedure(
MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
ArgInfo, InitialLiveness, TVarsMap, TCVarsMap, eval_normal,
no, no, DeclaredModes, IsAddressTaken, RLExprn, ALIAS,
- GLOBAL_USE, TREUSE
+ GLOBAL_USE, REUSE
).
proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
@@ -1660,13 +1671,13 @@
RLExprn = no,
ALIAS = no,
GLOBAL_USE = no,
- sr_reuse__tabled_reuse_init(TREUSE),
+ REUSE = no,
ProcInfo = procedure(
DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
HeadLives, Goal, Context, StackSlots, InferredDetism,
CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, eval_normal,
ArgSizes, Termination, no, IsAddressTaken, RLExprn,
- ALIAS, GLOBAL_USE, TREUSE).
+ ALIAS, GLOBAL_USE, REUSE).
proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
Context, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :-
@@ -1676,11 +1687,11 @@
RLExprn = no,
ALIAS = no,
GLOBAL_USE = no,
- sr_reuse__tabled_reuse_init(TREUSE),
+ REUSE = no,
ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
Liveness, TVarMap, TCVarsMap, eval_normal, no, no, no,
- IsAddressTaken, RLExprn, ALIAS, GLOBAL_USE, TREUSE).
+ IsAddressTaken, RLExprn, ALIAS, GLOBAL_USE, REUSE).
proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal,
TI_VarMap, TCI_VarMap, ProcInfo) :-
@@ -1798,8 +1809,8 @@
ProcInfo^maybe_alias_as := yes(Aliases)).
proc_info_set_global_use(ProcInfo, GLOBAL_USE,
ProcInfo^maybe_global_use := yes(GLOBAL_USE)).
-proc_info_set_reuse_information(ProcInfo, TREUSE,
- ProcInfo^structure_reuse := TREUSE).
+proc_info_set_reuse_information(ProcInfo, REUSE,
+ ProcInfo^structure_reuse:= REUSE).
proc_info_get_typeinfo_vars(Vars, VarTypes, TVarMap, TypeInfoVars) :-
set__to_sorted_list(Vars, VarList),
Index: make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.347.2.4
diff -u -r1.347.2.4 make_hlds.m
--- make_hlds.m 2000/09/25 17:03:24 1.347.2.4
+++ make_hlds.m 2000/10/12 14:49:21
@@ -99,7 +99,6 @@
:- import_module fact_table, purity, goal_util, term_util, export, llds.
:- import_module error_util.
:- import_module pa_run, pa_alias_as.
-:- import_module sr_reuse, sr_reuse_run.
:- import_module string, char, int, set, bintree, map, multi_map, require.
:- import_module bag, term, varset, getopt, assoc_list, term_io.
@@ -536,11 +535,16 @@
HeadVars,MaybeAlias, Module0, Module)
;
+ { Pragma = sr_reuse_info(_PredOrFunc, _SymName, _ModeList,
+ _HeadVars, _TREUSE, _MaybeReuseSymName) },
+ { Module = Module0 }
+ /** DO NOTHING
{ Pragma = sr_reuse_info(PredOrFunc, SymName, ModeList,
HeadVars, TREUSE, MaybeReuseSymName) },
add_pragma_reuse_info( PredOrFunc, SymName, ModeList,
HeadVars, TREUSE, MaybeReuseSymName,
Module0, Module)
+ **/
;
{ Pragma = terminates(Name, Arity) },
add_pred_marker(Module0, "terminates", Name, Arity,
@@ -1482,6 +1486,7 @@
%-----------------------------------------------------------------------------%
+/**********
:- pred add_pragma_reuse_info( pred_or_func, sym_name, list(mode),
list(var(T)), sr_reuse__tabled_reuse, maybe(sym_name),
module_info, module_info,
@@ -1547,8 +1552,8 @@
io__set_exit_status(1)
% { module_info_incr_errors(Module0, Module) }
).
-
+************/
%-----------------------------------------------------------------------------%
Index: mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.175.2.7
diff -u -r1.175.2.7 mercury_compile.m
--- mercury_compile.m 2000/10/09 09:10:37 1.175.2.7
+++ mercury_compile.m 2000/10/12 14:49:25
@@ -69,7 +69,7 @@
:- import_module options, globals, trace_params, passes_aux.
:- import_module pa_run. % possible aliases
-:- import_module sr_run. % structure reuse
+% :- import_module sr_run. % structure reuse
% library modules
:- import_module int, list, map, set, std_util, dir, require, string, bool.
@@ -1660,10 +1660,10 @@
->
maybe_write_string(Verbose, "% Structure-reuse analysis...\n"),
maybe_flush_output(Verbose),
- sr_run__structure_reuse_pass( HLDS0, HLDS),
+ % sr_run__structure_reuse_pass( HLDS0, HLDS),
% XXX plug in the new structure reuse framework
- structure_reuse(HLDS0, _),
+ structure_reuse(HLDS0, HLDS),
maybe_write_string(Verbose, "% done.\n"),
maybe_report_stats(Stats)
Index: pa_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/pa_util.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 pa_util.m
--- pa_util.m 2000/09/19 10:02:08 1.1.2.1
+++ pa_util.m 2000/10/12 14:49:28
@@ -67,14 +67,14 @@
:- import_module fixpoint_table.
-:- instance tc_element(alias_as) where [
- pred(equal/2) is pa_alias_as__equal,
- pred(init/1) is pa_alias_as__init
- ].
+:- pred wrapped_init( pred_proc_id, pa_alias_as__alias_as).
+:- mode wrapped_init( in, out ) is det.
+wrapped_init( _, E ) :- pa_alias_as__init(E).
pa_fixpoint_table_init( KEYS, TABLE):-
- fp_init( KEYS, TABLE).
+ fp_init( wrapped_init, KEYS, TABLE).
+
pa_fixpoint_table_new_run( Tin, Tout ) :-
fp_new_run(Tin,Tout).
@@ -85,7 +85,7 @@
fp_stable(TABLE).
pa_fixpoint_table_new_as( PRED_PROC_ID, ALIAS_AS, Tin, Tout) :-
- fp_add(PRED_PROC_ID, ALIAS_AS, Tin, Tout).
+ fp_add(pa_alias_as__equal, PRED_PROC_ID, ALIAS_AS, Tin, Tout).
pa_fixpoint_table_get_as( PRED_PROC_ID, ALIAS_AS, Tin, Tout) :-
fp_get(PRED_PROC_ID, ALIAS_AS, Tin, Tout).
Index: prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.58.2.2
diff -u -r1.58.2.2 prog_data.m
--- prog_data.m 2000/09/22 15:04:05 1.58.2.2
+++ prog_data.m 2000/10/12 14:49:30
@@ -25,7 +25,7 @@
:- import_module (inst).
:- import_module bool, list, assoc_list, map, varset, term, std_util.
:- import_module pa_alias_as.
-:- import_module sr_reuse.
+:- import_module sr_data.
%-----------------------------------------------------------------------------%
@@ -270,7 +270,7 @@
% These pragma's are used in opt.pa files
; sr_reuse_info(pred_or_func, sym_name, list(mode),
- list(prog_var), tabled_reuse, maybe(sym_name))
+ list(prog_var), memo_reuse, maybe(sym_name))
; terminates(sym_name, arity)
% Predname, Arity
Index: prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.23.2.2
diff -u -r1.23.2.2 prog_io_pragma.m
--- prog_io_pragma.m 2000/09/22 15:04:09 1.23.2.2
+++ prog_io_pragma.m 2000/10/12 14:49:32
@@ -26,7 +26,7 @@
:- import_module term_util, term_errors.
:- import_module int, map, string, std_util, bool, require.
:- import_module pa_alias_as.
-:- import_module sr_reuse.
+:- import_module sr_data.
parse_pragma(ModuleName, VarSet, PragmaTerms, Result) :-
(
@@ -804,7 +804,7 @@
term__vars_list(ListHVTerm, HeadVarsGeneric),
list__map(term__coerce_var, HeadVarsGeneric, HeadVars),
- sr_reuse__tabled_reuse_parse(ReuseInformation, ParsedReuse,
+ sr_data__memo_reuse_parse(ReuseInformation, ParsedReuse,
MaybeReuseName),
Result0 = ok(pragma(sr_reuse_info(PredOrFunc, PredName, ModeList,
Index: sr_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_data.m,v
retrieving revision 1.1.2.6
diff -u -r1.1.2.6 sr_data.m
--- sr_data.m 2000/10/10 16:10:11 1.1.2.6
+++ sr_data.m 2000/10/12 14:49:40
@@ -15,8 +15,10 @@
:- module sr_data.
:- interface.
-:- import_module hlds_goal, pa_alias_as, pa_datastruct, prog_data.
-:- import_module set, std_util, list.
+:- import_module map, set, std_util, list, io, term.
+:- import_module pa_alias_as, pa_datastruct.
+:- import_module sr_live.
+:- import_module hlds_goal, hlds_pred, hlds_module, prog_data.
% The information placed in the goal info which is used by
% structure reuse.
@@ -57,7 +59,13 @@
local_alias_headvars :: alias_as
).
+ % XXX this will replace the former tabled_reuse type.
+:- type memo_reuse == maybe(list(reuse_condition)).
+
+%-----------------------------------------------------------------------------%
+% reuse_condition predicates
+%-----------------------------------------------------------------------------%
:- pred reuse_condition_merge( reuse_condition::in,
reuse_condition::in,
reuse_condition::out) is det.
@@ -70,13 +78,60 @@
alias_as, list(prog_var), reuse_condition).
:- mode reuse_condition_init(in, in, in, in, in, out) is det.
+ % rename the reuse condition given a map from FROM_VARS, to
+ % TO_VARS
+:- pred reuse_condition_rename( map(prog_var, prog_var),
+ reuse_condition, reuse_condition).
+:- mode reuse_condition_rename( in, in, out ) is det.
+
+ % print the reuse_condition
+:- pred reuse_condition_print( proc_info, reuse_condition, io__state,
+ io__state).
+:- mode reuse_condition_print( in, in, di, uo) is det.
+
+ % check whether the given live_set and alias_as satisfy
+ % the condition for reuse.
+:- pred reuse_condition_verify( proc_info, module_info,
+ live_set, alias_as, reuse_condition ).
+:- mode reuse_condition_verify( in, in, in, in, in ) is semidet.
+
+:- pred reuse_condition_update( proc_info, module_info,
+ set(prog_var), set(prog_var),
+ alias_as, list(prog_var),
+ reuse_condition, reuse_condition ).
+:- mode reuse_condition_update( in, in, in, in, in, in, in, out) is det.
+
%-----------------------------------------------------------------------------%
+% memo_reuse predicates
%-----------------------------------------------------------------------------%
+:- pred memo_reuse_equal( memo_reuse::in, memo_reuse::in) is semidet.
+:- pred memo_reuse_init( memo_reuse::out ) is det.
+:- pred memo_reuse_top( memo_reuse::in ) is semidet.
+:- pred memo_reuse_rename( proc_info::in, list(prog_var)::in,
+ memo_reuse::in, memo_reuse::out) is det.
+:- pred memo_reuse_rename( map(prog_var, prog_var)::in, memo_reuse::in,
+ memo_reuse::out) is det.
+:- pred memo_reuse_print( memo_reuse::in, sym_name::in, proc_info::in,
+ io__state::di, io__state::uo) is det.
+:- pred memo_reuse_parse( term(T)::in, memo_reuse::out,
+ maybe(sym_name)::out) is semidet.
+:- pred memo_reuse_verify_reuse( proc_info::in, module_info::in,
+ memo_reuse::in, live_set::in, alias_as::in) is semidet.
+:- pred memo_reuse_is_conditional( memo_reuse::in ) is semidet.
+:- pred memo_reuse_is_unconditional( memo_reuse::in) is semidet.
+:- pred memo_reuse_simplify( memo_reuse::in, memo_reuse::out) is det.
+:- pred memo_reuse_merge( memo_reuse::in, memo_reuse::in,
+ memo_reuse::out) is det.
+
+%-----------------------------------------------------------------------------%
+
:- implementation.
-:- import_module list.
+:- import_module list, string, require, varset, bool.
:- import_module pa_datastruct, pa_alias_as.
+:- import_module mercury_to_mercury, prog_out, prog_io, prog_io_util.
+:- import_module sr_util.
reuse_condition_merge( C1, C2, C ):-
(
@@ -159,5 +214,405 @@
CONDITION = condition(NODES_set,LUiHVs, LAiHVs)
).
+reuse_condition_rename( Dict, Cin, Cout ) :-
+ (
+ Cin = condition( Nodes, LUiH, LAiH )
+ ->
+ % rename the nodes:
+ set__to_sorted_list(Nodes, NodesList),
+ list__map(
+ pa_datastruct__rename( Dict ),
+ NodesList,
+ RenNodesList),
+ % rename the datastructures
+ set__to_sorted_list(LUiH, ListLUiH),
+ list__map(
+ map__lookup( Dict ),
+ ListLUiH,
+ ListRenLUiH ),
+ set__list_to_set(ListRenLUiH, RenLUiH),
+ % rename the alias
+ pa_alias_as__rename( Dict, LAiH, RenLAiH ),
+ set__list_to_set( RenNodesList, RenNodes ),
+ Cout = condition(RenNodes, RenLUiH, RenLAiH )
+ ;
+ Cout = Cin
+ ).
+
+reuse_condition_print( _, always ) -->
+ io__write_string("always").
+reuse_condition_print( ProcInfo, condition(Nodes, LUiH, LAiH)) -->
+ { set__to_sorted_list( Nodes, NodesList ) },
+ io__write_string("condition("),
+ % write out the list of headvar-nodes involved
+ io__write_string("["),
+ io__write_list( NodesList, ",",
+ pred( D::in, IO1::di, IO2::uo) is det :-
+ ( pa_datastruct__print(D, ProcInfo, IO1, IO2) )
+ ),
+ io__write_string("], "),
+
+ % write out LUiH, list of prog_vars
+ io__write_string("["),
+ { proc_info_varset(ProcInfo, ProgVarset) },
+ { set__to_sorted_list(LUiH, ListLUiH) },
+ mercury_output_vars(ListLUiH, ProgVarset, bool__no),
+ io__write_string("], "),
+
+ % write out LAiH, the aliases at the reuse-point
+ pa_alias_as__print_aliases(LAiH, ProcInfo),
+
+ io__write_string(")").
+
+reuse_condition_verify( _ProcInfo, _HLDS, _Live0, _Alias0, always).
+reuse_condition_verify( ProcInfo, HLDS, Live0, Alias0,
+ condition( Nodes, LUiH, LAiH ) ):-
+ pa_alias_as__extend( ProcInfo, HLDS, Alias0, LAiH, Alias),
+ pa_alias_as__live( LUiH, Live0, Alias, Live),
+ set__to_sorted_list(Nodes, NodesList),
+ list__filter(
+ pred( D::in ) is semidet :-
+ ( sr_live__is_live_datastruct(D, Live) ),
+ NodesList,
+ [] ).
+
+reuse_condition_update( _ProcInfo, _HLDS,
+ _LFUi, _LBUi, _ALIASi, _HVs, always, always ).
+reuse_condition_update( ProcInfo, HLDS, LFUi, LBUi, ALIASi, HVs,
+ condition( OLD_NODES_set, OLD_LUiH, OLD_LAiH ),
+ CONDITION):-
+ set__to_sorted_list( OLD_NODES_set, OLD_NODES ),
+ list__map(
+ pred(TOP::in,LIST::out) is det :-
+ ( pa_alias_as__collect_aliases_of_datastruct(TOP,
+ ALIASi, LIST)),
+ OLD_NODES,
+ LISTS_ALL_NEW_NODES
+ ),
+ list__condense(LISTS_ALL_NEW_NODES, ALL_NEW_NODES),
+ list__filter(
+ pred(DATA::in) is semidet :-
+ ( pa_datastruct__get_var(DATA,V),
+ list__member(V, HVs) ),
+ ALL_NEW_NODES,
+ NEW_NODES),
+ (
+ NEW_NODES = []
+ ->
+ CONDITION = always
+ ;
+ % normalize all the datastructs
+ list__map(
+ pa_datastruct__normalize_wti( ProcInfo, HLDS ),
+ NEW_NODES,
+ NORM_NODES
+ ),
+ % bit strange naming perhaps, but here the
+ % OLD_LAiH has the role of `NEW' wrt the extension
+ % operation.
+ pa_alias_as__extend( ProcInfo, HLDS,
+ OLD_LAiH, ALIASi, NewALIASi),
+ pa_alias_as__project( HVs, NewALIASi, NEW_LAiH),
+ set__union(LFUi, LBUi, LUi),
+ set__union(LUi, OLD_LUiH, NEW_LUi),
+ set__list_to_set(HVs, HVsSet),
+ set__intersect(NEW_LUi, HVsSet, NEW_LUiH),
+ set__list_to_set( NORM_NODES, NORM_NODES_set),
+ CONDITION = condition( NORM_NODES_set, NEW_LUiH, NEW_LAiH )
+ ).
+
+:- pred reuse_conditions_simplify( list(reuse_condition)::in,
+ list(reuse_condition)::out) is det.
+
+reuse_conditions_simplify( OLD, NEW ):-
+ list__foldl(
+ reuse_conditions_simplify_2,
+ OLD,
+ [],
+ NEW).
+
+:- pred reuse_conditions_simplify_2(reuse_condition,
+ list(reuse_condition), list(reuse_condition)).
+:- mode reuse_conditions_simplify_2(in,in,out) is det.
+
+reuse_conditions_simplify_2( COND, ACC, NewACC) :-
+ (
+ COND = always
+ ->
+ NewACC = ACC
+ ;
+ list_ho_member(reuse_condition_equal,
+ COND,
+ ACC)
+ ->
+ NewACC = ACC
+ ;
+ NewACC = [ COND | ACC ]
+ ).
+
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+memo_reuse_equal(no, no).
+memo_reuse_equal(yes(C1), yes(C2)):-
+ list__length(C1, L),
+ list__length(C2, L),
+ list__filter(
+ pred( COND::in ) is semidet :-
+ (
+ ( sr_util__list_ho_member( reuse_condition_equal,
+ COND,
+ C1)
+ ->
+ fail
+ ;
+ true
+ )
+ ),
+ C2,
+ []).
+
+memo_reuse_init(no).
+memo_reuse_top(no).
+
+memo_reuse_rename(ProcInfo, ActualVars, MEMOin, MEMOout ) :-
+ proc_info_headvars(ProcInfo, FormalVars),
+ map__from_corresponding_lists( FormalVars, ActualVars, Dict),
+ memo_reuse_rename( Dict, MEMOin, MEMOout).
+
+memo_reuse_rename( Dict, TREUSEin, TREUSEout) :-
+ (
+ TREUSEin = yes(CONDITIONS)
+ ->
+ list__map(
+ reuse_condition_rename( Dict ),
+ CONDITIONS,
+ RenCONDITIONS),
+ TREUSEout = yes(RenCONDITIONS)
+ ;
+ TREUSEout = TREUSEin
+ ).
+
+memo_reuse_print( TREUSE, Name, ProcInfo ) -->
+ (
+ { TREUSE = yes(CONDS) }
+ ->
+ io__write_string("yes(["),
+ io__write_list(CONDS, ",", reuse_condition_print(ProcInfo)),
+ io__write_string("], "),
+ prog_out__write_quoted_sym_name(Name),
+ io__write_string(")")
+ ;
+ io__write_string("no")
+ ).
+
+memo_reuse_parse( ReuseInformation, ParsedReuse, MaybeReuseName ) :-
+ (
+ ReuseInformation = term__functor( term__atom("no"), _, _),
+ MaybeReuseName = no,
+ memo_reuse_init(ParsedReuse)
+ ;
+ ReuseInformation = term__functor( term__atom("yes"),
+ ReadConditions, _),
+ conditions_list_parse( ReadConditions, Conditions, ReuseName),
+ MaybeReuseName = yes(ReuseName),
+ ParsedReuse = yes(Conditions)
+ ).
+
+:- pred conditions_list_parse( list(term(T)),
+ list(reuse_condition), sym_name).
+:- mode conditions_list_parse( in, out, out ) is det.
+
+conditions_list_parse( LISTTERM, CONDS, ReuseName ) :-
+ (
+ LISTTERM = [ OneITEM , NameTerm ]
+ ->
+ condition_rest_parse(OneITEM, CONDS),
+ parse_qualified_term(NameTerm, NameTerm, "pragma reuse",
+ Result),
+ ( Result = ok(ReuseName0, []) ->
+ ReuseName = ReuseName0
+ ;
+ error("(sr_data) conditions_list_parse: conditions_list_parse")
+ )
+ ;
+ list__length( LISTTERM, L ),
+ string__int_to_string(L, LS),
+ string__append_list( ["(sr_data) conditions_list_parse: ",
+ "wrong number of arguments. yes/", LS,
+ " should be yes/2"], Msg),
+ error(Msg)
+ ).
+
+:- pred condition_parse(term(T), reuse_condition).
+:- mode condition_parse(in, out) is det.
+
+condition_parse( TERM, COND ) :-
+ (
+ TERM = term__functor( term__atom( CONS ), Args, _)
+ ->
+ (
+ CONS = "condition"
+ ->
+ (
+ Args = [ NodesTerm, LUiHTerm, LAiHTerm ]
+ ->
+ nodes_parse(NodesTerm, NodesList),
+ set__list_to_set(NodesList, Nodes),
+ vars_parse(LUiHTerm, LUiH),
+ pa_alias_as__parse_read_aliases_from_single_term( LAiHTerm, LAiH),
+ COND = condition( Nodes, LUiH, LAiH )
+ ;
+ list__length(Args, L),
+ string__int_to_string( L, LS),
+ string__append_list(
+ [ "(sr_data) condition_parse: ",
+ "wrong number of arguments. ",
+ "condition/",LS, " should be ",
+ "condition/3"], Msg),
+ error(Msg)
+ )
+ ;
+ term__det_term_to_type( TERM, TYPE ),
+ varset__init(V),
+ mercury_type_to_string(V, TYPE, StringTerm),
+ string__append_list(
+ ["(sr_data) condition_parse: ",
+ "wrong constructur. `",
+ StringTerm,
+ "' should be `condition'"], Msg),
+ error(Msg)
+ )
+ ;
+ error("(sr_data) condition_parse: term is not a functor")
+ ).
+
+:- pred nodes_parse( term(T), list(pa_datastruct__datastruct)).
+:- mode nodes_parse( in, out) is det.
+
+nodes_parse( Term, Datastructs ) :-
+ (
+ Term = term__functor( term__atom(CONS), Args, _)
+ ->
+ (
+ CONS = ".",
+ Args = [ First , Rest ]
+ ->
+ pa_datastruct__parse_term( First, D1),
+ nodes_parse( Rest, D2),
+ Datastructs = [ D1 | D2 ]
+ ;
+ CONS = "[]"
+ ->
+ Datastructs = []
+ ;
+ string__append("(sr_data) nodes_parse: could not parse nodes, top cons: ", CONS, Msg),
+ error(Msg)
+ )
+ ;
+ error("(sr_data) nodes_parse: term not a functor")
+ ).
+
+:- pred vars_parse( term(T), set(prog_var)).
+:- mode vars_parse( in, out) is det.
+
+vars_parse( Term, Vars ) :-
+ vars_parse_list( Term, VarList) ,
+ set__list_to_set( VarList, Vars).
+
+:- pred vars_parse_list( term(T), list(prog_var)).
+:- mode vars_parse_list( in, out) is det.
+
+vars_parse_list( Term, Vars ) :-
+ (
+ Term = term__functor( term__atom(CONS), Args, _)
+ ->
+ (
+ CONS = ".",
+ Args = [ First , Rest ]
+ ->
+ (
+ First = term__variable(V)
+ ->
+ V1 = V
+ ;
+ error("(sr_data) vars_parse_list: list should contain variables.")
+ ),
+ term__coerce_var(V1, PROGVAR),
+ vars_parse_list( Rest, V2),
+ Vars = [ PROGVAR | V2 ]
+ ;
+ CONS = "[]"
+ ->
+ Vars = []
+ ;
+ string__append("(sr_data) vars_parse_list: could not parse nodes, top cons: ", CONS, Msg),
+ error(Msg)
+ )
+ ;
+ error("(sr_data) vars_parse_list: term not a functor")
+ ).
+
+
+:- pred condition_rest_parse(term(T), list(reuse_condition)).
+:- mode condition_rest_parse(in, out) is det.
+
+condition_rest_parse( Term, CONDS ) :-
+ (
+ Term = term__functor( term__atom(CONS), Args, _)
+ ->
+ (
+ CONS = ".",
+ Args = [ First , Rest ]
+ ->
+ condition_parse( First, COND1),
+ condition_rest_parse( Rest, COND2),
+ CONDS = [ COND1 | COND2 ]
+ ;
+ CONS = "[]"
+ ->
+ CONDS = []
+ ;
+ string__append("(sr_data) condition_rest_parse: could not parse conditions, top cons: ", CONS, Msg),
+ error(Msg)
+ )
+ ;
+ error("(sr_data) condition_rest_parse: term not a functor")
+ ).
+
+memo_reuse_verify_reuse( ProcInfo, HLDS, TREUSE, Live0, Alias0 ) :-
+ TREUSE = yes(CONDITIONS),
+ list__takewhile( reuse_condition_verify( ProcInfo, HLDS,
+ Live0, Alias0 ),
+ CONDITIONS, _, [] ).
+
+memo_reuse_is_conditional( yes([_|_]) ).
+memo_reuse_is_unconditional( yes([]) ).
+
+memo_reuse_simplify(M0, M):-
+ (
+ M0 = yes( Conditions0 )
+ ->
+ reuse_conditions_simplify( Conditions0, Conditions ),
+ M = yes( Conditions )
+ ;
+ M = M0
+ ).
+
+memo_reuse_merge(M1, M2, M) :-
+ (
+ M1 = yes(L1)
+ ->
+ (
+ M2 = yes(L2)
+ ->
+ list__append(L1, L2, L),
+ M0 = yes(L)
+ ;
+ M0 = M1
+ )
+ ;
+ M0 = M2
+ ),
+ memo_reuse_simplify(M0, M).
+
Index: sr_dead.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_dead.m,v
retrieving revision 1.1.2.2
diff -u -r1.1.2.2 sr_dead.m
--- sr_dead.m 2000/10/10 16:10:11 1.1.2.2
+++ sr_dead.m 2000/10/12 14:49:41
@@ -33,38 +33,16 @@
:- import_module hlds_goal, prog_data, hlds_data.
:- import_module sr_data, sr_live.
:- import_module pa_alias_as, pa_run.
+:- import_module sr_util.
process_goal( PredId, ProcInfo, ModuleInfo, Goal0, Goal) :-
pa_alias_as__init(Alias0),
- compute_real_headvars(ModuleInfo, PredId, ProcInfo, RealHeadVars),
+ sr_util__compute_real_headvars(ModuleInfo, PredId,
+ ProcInfo, RealHeadVars),
dead_cell_pool_init(RealHeadVars, Pool0),
annotate_goal(ProcInfo, ModuleInfo, Goal0, Goal,
Pool0, _Pool, Alias0, _Alias).
-:- pred compute_real_headvars(module_info, pred_id, proc_info,
- list(prog_var)).
-:- mode compute_real_headvars(in, in, in, out) is det.
-
-compute_real_headvars( HLDS, PredId, ProcInfo, HVS ) :-
- module_info_pred_info( HLDS, PredId, PredInfo),
- pred_info_arity(PredInfo, Arity),
- proc_info_headvars(ProcInfo, HeadVars),
- list__length(HeadVars, PseudoArity) ,
- NumberOfTypeInfos = PseudoArity - Arity ,
- list_drop_det(NumberOfTypeInfos, HeadVars, RealHeadVars) ,
- HVS = RealHeadVars.
-
-:- pred list_drop_det(int,list(T),list(T)).
-:- mode list_drop_det(in,in,out) is det.
-
-list_drop_det(Len,List,End):-
- (
- list__drop(Len,List,End0)
- ->
- End = End0
- ;
- End = List
- ).
%-----------------------------------------------------------------------------%
@@ -83,7 +61,7 @@
% * conjunction
Expr0 = conj(Goals0)
->
- list_map_foldl2(
+ sr_util__list_map_foldl2(
annotate_goal(ProcInfo, HLDS),
Goals0, Goals,
Pool0, Pool,
@@ -103,7 +81,7 @@
% * switch
Expr0 = switch(A, B, Cases0, SM)
->
- list_map3(
+ sr_util__list_map3(
annotate_case(ProcInfo, HLDS, Pool0, Alias0),
Cases0, Cases,
ListPools, ListAliases),
@@ -255,52 +233,6 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- pred list_map3( pred( T, T1, T2, T3 ), list(T), list(T1), list(T2),
- list(T3) ).
-:- mode list_map3( pred( in, out, out, out) is det, in,
- out, out, out) is det.
-
-list_map3( P, L, A, B, C) :-
- (
- L = [ L1 | LR ]
- ->
- P( L1, A1, B1, C1),
- list_map3( P, LR, AR, BR, CR ),
- A = [ A1 | AR ],
- B = [ B1 | BR ],
- C = [ C1 | CR ]
- ;
- A = [],
- B = [],
- C = []
- ).
-
-:- pred list_map_foldl2(
- pred( T, T1, T2, T2, T3, T3 ),
- list(T),
- list(T1),
- T2, T2, T3, T3).
-:- mode list_map_foldl2( pred( in, out, in, out, in, out) is det,
- in, out, in, out, in, out) is det.
-
-list_map_foldl2( P, L0, L1, A0, A, B0, B) :-
- (
- L0 = [ LE0 | LR0 ]
- ->
- P( LE0, LE1, A0, A1, B0, B1),
- list_map_foldl2( P, LR0, LR1, A1, A, B1, B),
- L1 = [ LE1 | LR1 ]
- ;
- L1 = [],
- A = A0,
- B = B0
- ).
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
% type used for threading through all the information about
% eventual dead cells.
:- type dead_cell_pool --->
@@ -376,14 +308,20 @@
pool(HVS, Pool) ) :-
% XXX Candidates are always zero. For the
% moment we will not try to track this !
- cons_id_arity( Cons, Arity ),
- Extra = extra( Arity, ReuseCond, [] ),
- (
- map__insert( Pool0, Var, Extra, Pool1)
+ cons_id_maybe_arity( Cons, MaybeArity ),
+ (
+ MaybeArity = yes(Arity)
->
- Pool = Pool1
+ Extra = extra( Arity, ReuseCond, [] ),
+ (
+ map__insert( Pool0, Var, Extra, Pool1)
+ ->
+ Pool = Pool1
+ ;
+ require__error("(sr_direct) add_dead_cell: trying to add dead variable whilst already being marked as dead?")
+ )
;
- require__error("(sr_direct) add_dead_cell: trying to add dead variable whilst already being marked as dead?")
+ Pool = Pool0
).
@@ -460,17 +398,23 @@
dead_cell_pool_try_to_reuse( Cons, Pool, Set) :-
Pool = pool( _HVS, Map ),
- cons_id_arity( Cons, Arity ),
- map__to_assoc_list( Map, AssocList),
- list__filter(
- cons_can_reuse( Arity ),
- AssocList,
- CellsThatCanBeReused),
- list__map(
- to_pair_var_condition,
- CellsThatCanBeReused,
- VarConditionPairs),
- set__list_to_set(VarConditionPairs, Set).
+ cons_id_maybe_arity( Cons, MaybeArity ),
+ (
+ MaybeArity = yes(Arity)
+ ->
+ map__to_assoc_list( Map, AssocList),
+ list__filter(
+ cons_can_reuse( Arity ),
+ AssocList,
+ CellsThatCanBeReused),
+ list__map(
+ to_pair_var_condition,
+ CellsThatCanBeReused,
+ VarConditionPairs),
+ set__list_to_set(VarConditionPairs, Set)
+ ;
+ set__init(Set)
+ ).
:- pred cons_can_reuse( arity, pair( prog_var, dead_extra_info )).
:- mode cons_can_reuse( in, in ) is semidet.
Index: sr_direct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_direct.m,v
retrieving revision 1.1.2.7
diff -u -r1.1.2.7 sr_direct.m
--- sr_direct.m 2000/10/10 16:10:12 1.1.2.7
+++ sr_direct.m 2000/10/12 14:49:41
@@ -32,6 +32,7 @@
:- import_module sr_lfu, sr_lbu, sr_dead, sr_choice, sr_data, sr_live.
:- import_module hlds_goal, hlds_data, prog_data.
+:- import_module hlds_pred.
process_proc(PredId, _ProcId, ProcInfo0, ProcInfo, ModuleInfo0, ModuleInfo) -->
% Determine the LFU (local forward use)
@@ -43,14 +44,14 @@
% Determine which cells die and can be reused and what
% the conditions on that reuse are
{ proc_info_goal(ProcInfo2, Goal0) },
-
{ sr_dead__process_goal(PredId,ProcInfo0,ModuleInfo0,Goal0,Goal1) },
% Select which cells will be reused and which can be
% compile time garbage collected.
{ sr_choice__process_goal(strategy(same_cons_id, random),
- Goal1, Goal, _MaybeReuseConditions) },
-
- { proc_info_set_goal( ProcInfo2, Goal, ProcInfo ) },
+ Goal1, Goal, MaybeReuseConditions) },
+ { proc_info_set_reuse_information( ProcInfo2, MaybeReuseConditions,
+ ProcInfo3 ) },
+ { proc_info_set_goal( ProcInfo3, Goal, ProcInfo ) },
{ ModuleInfo = ModuleInfo0 }.
Index: sr_indirect.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_indirect.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 sr_indirect.m
--- sr_indirect.m 2000/10/04 13:00:07 1.1.2.1
+++ sr_indirect.m 2000/10/12 14:49:42
@@ -24,8 +24,535 @@
:- implementation.
-compute_fixpoint(ModuleInfo0, ModuleInfo) -->
- { ModuleInfo = ModuleInfo0 }.
+:- import_module map, list, std_util, require, set.
+:- import_module hlds_pred.
+:- import_module dependency_graph, hlds_goal, prog_data, prog_util.
+:- import_module pa_alias_as, pa_run.
+:- import_module sr_data, sr_util, sr_live.
+:- import_module sr_fixpoint_table.
+
+compute_fixpoint(HLDS0, HLDSout) -->
+ % compute the strongly connected components
+ { module_info_ensure_dependency_info( HLDS0, HLDS1) },
+ { module_info_get_maybe_dependency_info( HLDS1, MaybeDepInfo) } ,
+ (
+ { MaybeDepInfo = yes(DepInfo) }
+ ->
+ { hlds_dependency_info_get_dependency_ordering( DepInfo,
+ DepOrdering ) },
+ % perform the analysis, and annotate the procedures
+ run_with_dependencies( DepOrdering, HLDS1, HLDS2),
+ { HLDSout = HLDS2 }
+ ;
+ { error("(sr_indirect) compute_fixpoint: no dependency info") }
+ ).
+
+:- pred run_with_dependencies( dependency_ordering, module_info,
+ module_info, io__state, io__state).
+:- mode run_with_dependencies( in, in, out, di, uo) is det.
+
+run_with_dependencies( Deps, HLDSin, HLDSout) -->
+ list__foldl2( run_with_dependency, Deps, HLDSin, HLDSout ).
+
+:- pred run_with_dependency( list(pred_proc_id), module_info, module_info,
+ io__state, io__state).
+:- mode run_with_dependency( in, in, out, di, uo ) is det.
+
+run_with_dependency( SCC , HLDSin, HLDSout ) -->
+ (
+ % analysis ignores special predicates
+ { some_are_special_preds(SCC, HLDSin) }
+ ->
+ { HLDSout = HLDSin }
+ ;
+ % for each list of strongly connected components,
+ % perform a fixpoint computation.
+ { sr_fixpoint_table_init( HLDSin, SCC, FPtable0 ) } ,
+ run_with_dependency_until_fixpoint( SCC, FPtable0,
+ HLDSin, HLDSout )
+ ).
+
+:- pred some_are_special_preds( list(pred_proc_id), module_info).
+:- mode some_are_special_preds( in, in ) is semidet.
+
+some_are_special_preds( SCC, HLDS ):-
+ module_info_get_special_pred_map( HLDS, MAP),
+ map__values( MAP, SpecPRED_IDS ),
+
+ (
+ % either some of the predicates are special
+ % preds, such as __Unify__ and others
+
+ list__filter( pred_id_in(SpecPRED_IDS), SCC, SpecialPREDS),
+ SpecialPREDS = [_|_]
+
+ ;
+ % or some of the predicates are not defined in this
+ % module.
+
+ list__filter( not_defined_in_this_module(HLDS), SCC,
+ FILTERED),
+ FILTERED = [_|_]
+ ).
+
+:- pred pred_id_in( list(pred_id), pred_proc_id ).
+:- mode pred_id_in( in, in) is semidet.
+
+pred_id_in( IDS, PRED_PROC_ID):-
+ PRED_PROC_ID = proc( PRED_ID, _),
+ list__member( PRED_ID, IDS ).
+
+:- pred not_defined_in_this_module(module_info, pred_proc_id).
+:- mode not_defined_in_this_module(in,in) is semidet.
+
+not_defined_in_this_module( HLDS, proc(PREDID, _) ):-
+ hlds_module__pred_not_defined_in_this_module(HLDS,
+ PREDID).
+ % module_info_pred_proc_info(HLDS, PRED_PROC_ID, PRED_INFO, _),
+ % pred_info_import_status(PRED_INFO, STATUS),
+ % status_defined_in_this_module(STATUS, no).
+
+%-------------------------------------------------------------------%
+:- pred run_with_dependency_until_fixpoint( list(pred_proc_id),
+ sr_fixpoint_table__table, module_info, module_info,
+ io__state, io__state ).
+:- mode run_with_dependency_until_fixpoint( in, in, in, out, di, uo) is det.
+
+run_with_dependency_until_fixpoint( SCC, FPtable0, HLDSin, HLDSout ) -->
+ list__foldl2( analyse_pred_proc( HLDSin ), SCC, FPtable0, FPtable),
+ (
+ { sr_fixpoint_table_all_stable( FPtable) }
+ ->
+ { list__foldl( update_goal_in_module_info(FPtable), SCC,
+ HLDSin, HLDSout) }
+ ;
+ { sr_fixpoint_table_new_run(FPtable,
+ FPtable1) },
+ run_with_dependency_until_fixpoint( SCC, FPtable1, HLDSin,
+ HLDSout)
+ ).
+
+:- pred update_goal_in_module_info( sr_fixpoint_table__table::in,
+ pred_proc_id::in,
+ module_info::in, module_info::out) is det.
+
+update_goal_in_module_info( FP, PredProcId, HLDS0, HLDS) :-
+ PredProcId = proc( PredId, ProcId ),
+ sr_fixpoint_table_get_final_reuse(PredProcId, Memo, Goal, FP),
+ module_info_pred_proc_info( HLDS0, PredProcId, PredInfo0, ProcInfo0),
+ proc_info_set_goal( ProcInfo0, Goal, ProcInfo1),
+ proc_info_set_reuse_information( ProcInfo1, Memo, ProcInfo),
+ pred_info_procedures( PredInfo0, Procedures0),
+ map__det_update( Procedures0, ProcId, ProcInfo, Procedures ),
+ pred_info_set_procedures( PredInfo0, Procedures, PredInfo),
+ module_info_set_pred_info( HLDS0, PredId, PredInfo, HLDS ).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+:- pred analyse_pred_proc( module_info, pred_proc_id,
+ sr_fixpoint_table__table,
+ sr_fixpoint_table__table,
+ io__state, io__state).
+:- mode analyse_pred_proc( in, in, in, out, di, uo) is det.
+
+analyse_pred_proc( HLDS, PRED_PROC_ID, FPin, FPout) -->
+ { module_info_pred_proc_info( HLDS, PRED_PROC_ID,_PredInfo,ProcInfo) },
+ { PRED_PROC_ID = proc(PredId, _ProcId) },
+
+ {
+ % initialize all the necessary information to get the
+ % analysis started.
+
+ % 1. get ProcInfo
+ % OK
+ % 2. get Goal
+ proc_info_goal( ProcInfo, Goal0 ),
+ % OK
+ % 3. initialize alias-information
+ pa_alias_as__init(Alias0),
+ % OK
+ % 4. initialize reuses-information
+ compute_real_headvars( HLDS, PredId, ProcInfo, HVs),
+ % do not change the state of the fixpoint table by
+ % simply consulting it now for initialization.
+ sr_fixpoint_table_get_final_reuse( PRED_PROC_ID,
+ MemoStarting, _, FPin ),
+ indirect_reuse_pool_init( HVs, MemoStarting, Pool0 ),
+ % 5. analyse_goal
+ analyse_goal( ProcInfo, HLDS,
+ Goal0, Goal,
+ Pool0, Pool,
+ Alias0, _Alias,
+ FPin, FP1 ),
+ % OK
+ % 6. update all kind of information
+ indirect_reuse_pool_get_memo_reuse( Pool, Memo ),
+ sr_fixpoint_table_new_reuse( PRED_PROC_ID,
+ Memo, Goal, FP1, FPout )
+ }.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- pred analyse_goal( proc_info, module_info,
+ hlds_goal, hlds_goal,
+ indirect_reuse_pool, indirect_reuse_pool,
+ alias_as, alias_as,
+ sr_fixpoint_table__table, sr_fixpoint_table__table).
+:- mode analyse_goal( in, in, in, out, in, out, in, out, in, out )
+ is det.
+
+
+analyse_goal( ProcInfo, HLDS, Goal0, Goal,
+ Pool0, Pool,
+ Alias0, AliasRed,
+ FP0, FP ) :-
+ Goal0 = Expr0 - Info0,
+ % each of the branches of the following if/then/else branches
+ % must instantiate:
+ % Expr
+ % Info
+ % Pool,
+ % Aliases,
+ % FP
+ (
+ % 1. conjunction
+ Expr0 = conj(Goals0)
+ ->
+ list_map_foldl3( analyse_goal(ProcInfo, HLDS),
+ Goals0, Goals,
+ Pool0, Pool,
+ Alias0, Alias,
+ FP0, FP),
+ Info = Info0,
+ Expr = conj(Goals)
+ ;
+ % 2. call
+ Expr0 = call(PredId, ProcId, ActualVars, _, _, _)
+ ->
+
+ (
+ pa_alias_as__is_top(Alias0)
+ ->
+ Info = Info0,
+ Pool = Pool0,
+ FP = FP0
+ ;
+ call_verify_reuse( ProcInfo, HLDS,
+ PredId, ProcId, ActualVars, Alias0,
+ Pool0, Pool,
+ Info0, Info,
+ FP0, FP)
+ ),
+ pa_run__extend_with_call_alias( HLDS, ProcInfo,
+ PredId, ProcId, ActualVars, Alias0, Alias),
+ Expr = Expr0
+ ;
+ % 3. generic_call --> see end
+ % 4. switch
+ Expr0 = switch( A, B, Cases0, SM)
+ ->
+ list_map3_foldl(
+ analyse_case(ProcInfo, HLDS,
+ Pool0, Alias0),
+ Cases0,
+ Cases,
+ ListPools,
+ ListAliases,
+ FP0, FP),
+ indirect_reuse_pool_least_upper_bound_disjunction( ListPools,
+ Pool),
+ pa_alias_as__least_upper_bound_list(ProcInfo, HLDS,
+ ListAliases,
+ Alias),
+ Info = Info0,
+ Expr = switch( A, B, Cases, SM)
+
+ ;
+ % 5. unification
+ Expr0 = unify(_Var, _Rhs, _Mode, Unification, _Context)
+ ->
+ Pool = Pool0,
+ pa_alias_as__extend_unification(ProcInfo, HLDS,
+ Unification, Info, Alias0, Alias),
+ Info = Info0,
+ FP = FP0,
+ Expr = Expr0
+
+ ;
+ % 6. disjunction
+ Expr0 = disj( Goals0, SM )
+ ->
+ (
+ Goals0 = []
+ ->
+ Goals = Goals0,
+ Pool = Pool0,
+ Alias = Alias0,
+ FP = FP0
+ ;
+
+ list_map3_foldl(
+ pred( Gin::in, Gout::out, R::out, A::out,
+ FPin::in, FPout::out) is det :-
+ (
+ analyse_goal( ProcInfo, HLDS,
+ Gin, Gout,
+ Pool0, R,
+ Alias0, A,
+ FPin, FPout)
+ ),
+ Goals0,
+ Goals,
+ ListPools,
+ ListAliases,
+ FP0, FP),
+ indirect_reuse_pool_least_upper_bound_disjunction(
+ ListPools,
+ Pool),
+ pa_alias_as__least_upper_bound_list(ProcInfo, HLDS,
+ ListAliases,
+ Alias)
+ ),
+ Info = Info0,
+ Expr = disj(Goals, SM)
+
+ ;
+ % 7. not
+ Expr0 = not(NegatedGoal0)
+ ->
+ analyse_goal(ProcInfo, HLDS,
+ NegatedGoal0, NegatedGoal,
+ Pool0, Pool,
+ Alias0, Alias,
+ FP0, FP),
+ Info = Info0,
+ Expr = not(NegatedGoal)
+ ;
+ % 8. some --> treated as unhandled case
+ % 9. if_then_else
+ Expr0 = if_then_else( Vars, Cond0, Then0, Else0, SM)
+ ->
+ analyse_goal( ProcInfo, HLDS, Cond0, Cond,
+ Pool0, PoolCOND,
+ Alias0, AliasCOND,
+ FP0, FP1),
+ analyse_goal( ProcInfo, HLDS, Then0, Then,
+ PoolCOND, PoolTHEN,
+ AliasCOND, AliasTHEN,
+ FP1, FP2 ),
+ analyse_goal( ProcInfo, HLDS, Else0, Else,
+ Pool0, PoolELSE,
+ Alias0, AliasELSE,
+ FP2, FP3 ),
+ indirect_reuse_pool_least_upper_bound_disjunction(
+ [PoolTHEN, PoolELSE],
+ Pool),
+
+ pa_alias_as__least_upper_bound_list(ProcInfo, HLDS,
+ [AliasTHEN, AliasELSE],
+ Alias),
+ FP = FP3,
+ Info = Info0,
+ Expr = if_then_else( Vars, Cond, Then, Else, SM)
+
+ ;
+ Expr = Expr0,
+ Pool = Pool0,
+ pa_alias_as__top("unhandled goal", Alias),
+ FP = FP0,
+ Info = Info0
+ ),
+ (
+ goal_is_atomic( Expr )
+ ->
+ AliasRed = Alias % projection operation is not worthwhile
+ ;
+ goal_info_get_outscope( Info, Outscope ),
+ pa_alias_as__project_set( Outscope, Alias, AliasRed )
+ ),
+ Goal = Expr - Info.
+
+:- pred analyse_case( proc_info, module_info,
+ indirect_reuse_pool, alias_as,
+ case, case,
+ indirect_reuse_pool, alias_as,
+ sr_fixpoint_table__table,
+ sr_fixpoint_table__table).
+:- mode analyse_case( in, in, in, in, in, out, out, out, in, out) is det.
+
+analyse_case( ProcInfo, HLDS, Reuses0, Alias0, Case0, Case,
+ Reuses, Alias, FP0, FP ):-
+ Case0 = case(CONS, Goal0),
+ analyse_goal( ProcInfo, HLDS, Goal0, Goal, Reuses0, Reuses,
+ Alias0, Alias, FP0, FP),
+ Case = case( CONS, Goal).
+
+:- pred call_verify_reuse( proc_info, module_info, pred_id, proc_id,
+ list(prog_var), alias_as,
+ indirect_reuse_pool, indirect_reuse_pool,
+ hlds_goal_info , hlds_goal_info,
+ sr_fixpoint_table__table, sr_fixpoint_table__table).
+:- mode call_verify_reuse( in, in, in, in, in, in,
+ in, out,
+ in, out,
+ in, out) is det.
+
+call_verify_reuse( ProcInfo, HLDS, PredId0, ProcId0, ActualVars, Alias0,
+ Pool0, Pool,
+ Info0, Info, FP0, FP ) :-
+
+ module_info_structure_reuse_info(HLDS, ReuseInfo),
+ ReuseInfo = structure_reuse_info(ReuseMap),
+ ( map__search(ReuseMap, proc(PredId0, ProcId0), Result) ->
+ Result = proc(PredId, ProcId) - _Name
+ ;
+ PredId = PredId0,
+ ProcId = ProcId0
+ ),
+
+ % 0. fetch the procinfo of the called procedure:
+ module_info_pred_proc_info( HLDS, PredId, ProcId, _,
+ ProcInfo0),
+ % 1. find the tabled reuse for the called predicate
+ lookup_memo_reuse( PredId, ProcId, HLDS, FP0, FP,
+ FormalMemo),
+ % 2. once found, we can immediately handle the case where
+ % the tabled reuse would say that reuse is not possible anyway:
+ (
+ memo_reuse_top(FormalMemo)
+ ->
+ Pool = Pool0,
+ Info = Info0
+ ;
+ memo_reuse_rename( ProcInfo0, ActualVars, FormalMemo,
+ Memo ),
+ % 3. compute the Live variables upon a procedure entry:
+ % 3.a. compute the full live set at the program point of
+ % the call.
+ sr_live__init(LIVE0),
+ % usually this should be the output variables
+ % of the procedure which we're analysing, yet
+ % output variables are guaranteed to belong to
+ % the LFUi set, so there is no loss in taking
+ % LIVE0 as the empty live-set.
+ goal_info_get_lfu(Info0, LFUi),
+ goal_info_get_lbu(Info0, LBUi),
+ set__union(LFUi, LBUi, LUi),
+ pa_alias_as__live( LUi, LIVE0, Alias0, Live_i),
+ % 3.b. project the live-set to the actual vars:
+ sr_live__project( ActualVars, Live_i, ActualLive_i ),
+ % 4. project the aliases to the actual vars
+ pa_alias_as__project( ActualVars, Alias0, ActualAlias_i),
+ (
+ memo_reuse_verify_reuse( ProcInfo, HLDS,
+ Memo, ActualLive_i, ActualAlias_i)
+ ->
+ indirect_reuse_pool_add( HLDS, ProcInfo,
+ Memo, LFUi, LBUi,
+ Alias0, Pool0, Pool),
+ goal_info_set_reuse(Info0, reuse(reuse_call), Info)
+ ;
+ Pool = Pool0,
+ Info = Info0
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- pred lookup_memo_reuse( pred_id, proc_id, module_info,
+ sr_fixpoint_table__table, sr_fixpoint_table__table,
+ memo_reuse ).
+:- mode lookup_memo_reuse( in, in, in, in, out, out) is det.
+
+ % similar to the lookup_call_alias from pa_run:
+ % 1. check in fixpoint table
+ % 2. check in module_info (already fully analysed or imported pred)
+ % no special treatment necessary for primitive predicates and
+ % alike, as the default of predicates is no reuse anyway.
+lookup_memo_reuse( PredId, ProcId, HLDS, FP0, FP, Memo ):-
+ PRED_PROC_ID = proc(PredId, ProcId),
+ (
+ % 1 - check in table
+ sr_fixpoint_table_get_reuse( PRED_PROC_ID,
+ Memo1, FP0, FP1 )
+ ->
+ Memo = Memo1,
+ FP = FP1
+ ;
+ FP = FP0,
+ % 2 - lookup in module_info
+ module_info_pred_proc_info( HLDS, PRED_PROC_ID, _PredInfo,
+ ProcInfo ),
+ proc_info_reuse_information( ProcInfo, Memo)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- type indirect_reuse_pool --->
+ pool(
+ list(prog_var), % real headvars
+ memo_reuse
+ ).
+
+:- pred indirect_reuse_pool_init(list(prog_var)::in,
+ memo_reuse::in,
+ indirect_reuse_pool::out) is det.
+:- pred indirect_reuse_pool_get_memo_reuse( indirect_reuse_pool::in,
+ memo_reuse::out) is det.
+:- pred indirect_reuse_pool_least_upper_bound_disjunction(
+ list(indirect_reuse_pool)::in,
+ indirect_reuse_pool::out) is det.
+:- pred indirect_reuse_pool_least_upper_bound(
+ indirect_reuse_pool::in,
+ indirect_reuse_pool::in,
+ indirect_reuse_pool::out ) is det.
+:- pred indirect_reuse_pool_add( module_info::in, proc_info::in,
+ memo_reuse::in,
+ set(prog_var)::in, set(prog_var)::in, alias_as::in,
+ indirect_reuse_pool::in, indirect_reuse_pool::out) is det.
+
+
+indirect_reuse_pool_init( HVs, MEMO, pool( HVs, MEMO) ).
+indirect_reuse_pool_get_memo_reuse( pool(_, MEMO), MEMO).
+
+indirect_reuse_pool_least_upper_bound_disjunction( List, Pool ):-
+ (
+ List = [ P1 | R ]
+ ->
+ list__foldl(
+ indirect_reuse_pool_least_upper_bound,
+ R,
+ P1,
+ Pool)
+ ;
+ require__error("(sr_indirect) indirect_reuse_pool_least_upper_bound_disjunction: list is empty")
+ ).
+
+indirect_reuse_pool_least_upper_bound( Pool1, Pool2, Pool ):-
+ Pool1 = pool( HVS, Memo1 ),
+ Pool2 = pool( _, Memo2 ),
+ memo_reuse_merge( Memo1, Memo2, Memo),
+ Pool = pool(HVS, Memo).
+
+indirect_reuse_pool_add( HLDS, ProcInfo, MemoReuse,
+ LFUi, LBUi, Alias, Pool0, Pool) :-
+
+ (
+ MemoReuse = yes(OldConditions)
+ ->
+ Pool0 = pool( HVS, ExistingMemo),
+ list__map(
+ reuse_condition_update(ProcInfo, HLDS,
+ LFUi, LBUi, Alias, HVS ),
+ OldConditions,
+ NewConditions),
+ memo_reuse_merge(ExistingMemo, yes(NewConditions),
+ NewMemo),
+ Pool = pool( HVS, NewMemo )
+ ;
+ Pool = Pool0
+ ).
+
+
+
Index: sr_reuse_run.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_reuse_run.m,v
retrieving revision 1.1.2.7
diff -u -r1.1.2.7 sr_reuse_run.m
--- sr_reuse_run.m 2000/10/09 17:53:16 1.1.2.7
+++ sr_reuse_run.m 2000/10/12 14:49:48
@@ -639,7 +639,8 @@
module_info_set_predicate_table(HLDSin1, PredTable, HLDSout)
% ; contains_unconditional_reuse(TREUSE) ->
;
- proc_info_set_reuse_information(ProcInfo0, TREUSE, ProcInfo1),
+ proc_info_set_reuse_information_obsolete(ProcInfo0,
+ TREUSE, ProcInfo1),
(
MaybeHLDS_GOAL = yes(HLDS_GOAL),
proc_info_set_goal(ProcInfo1, HLDS_GOAL, ProcInfo)
@@ -659,7 +660,8 @@
create_reuse_pred(TabledReuse, MaybeReuseGoal, PredInfo, ProcInfo,
ReusePredInfo, ReuseProcInfo, ReuseProcId, SymName) :-
- proc_info_set_reuse_information(ProcInfo, TabledReuse, ReuseProcInfo0),
+ proc_info_set_reuse_information_obsolete(ProcInfo,
+ TabledReuse, ReuseProcInfo0),
(
MaybeReuseGoal = yes(ReuseGoal),
proc_info_set_goal(ReuseProcInfo0, ReuseGoal, ReuseProcInfo)
@@ -717,7 +719,7 @@
% 2 - lookup in module_info
module_info_pred_proc_info( HLDS, PRED_PROC_ID, _PredInfo,
ProcInfo ),
- proc_info_reuse_information( ProcInfo, TREUSE)
+ proc_info_reuse_information_obsolete( ProcInfo, TREUSE)
).
:- pred arg_types_are_all_primitive(module_info, pred_info).
Index: sr_run.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_run.m,v
retrieving revision 1.1.2.3
diff -u -r1.1.2.3 sr_run.m
--- sr_run.m 2000/09/22 15:04:15 1.1.2.3
+++ sr_run.m 2000/10/12 14:49:49
@@ -143,7 +143,7 @@
},
{ module_info_pred_proc_info(HLDS, ReusePredId, ReuseProcId,
_ReusePredInfo, ReuseProcInfo) },
- { proc_info_reuse_information(ReuseProcInfo, TREUSE) },
+ { proc_info_reuse_information_obsolete(ReuseProcInfo, TREUSE) },
sr_reuse__tabled_reuse_print( TREUSE, ReuseName, ReuseProcInfo) ,
io__write_string(").\n").
Index: sr_split.m
===================================================================
RCS file: sr_split.m
diff -N sr_split.m
--- /dev/null Tue Jul 25 14:12:01 2000
+++ sr_split.m Fri Oct 13 01:49:50 2000
@@ -0,0 +1,256 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000 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.
+%-----------------------------------------------------------------------------%
+%
+% Module: sr_indirect
+% Main authors: nancy
+%
+% Determine the indirect reuse. This requires a fixpoint computation.
+%
+%-----------------------------------------------------------------------------%
+
+:- module sr_split.
+:- interface.
+
+:- import_module hlds_module, io.
+
+ % create_multiple_versions( VirginHLDS, ReuseHLDS, FinalHLDS ).
+ % Starting from the VirginHLDS, it computes a new HLDS where for
+ % each procedure having conditional reuse (ReuseHLDS), a new
+ % separate reuse-procedure is added. The calls can then also
+ % be corrected so that they point to the correct reuse-versions.
+:- pred sr_split__create_multiple_versions( module_info::in, module_info::in,
+ module_info::out, io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module std_util, require, list, set, map.
+:- import_module dependency_graph, hlds_pred.
+:- import_module hlds_goal, prog_data, hlds_data, prog_util.
+:- import_module sr_data.
+
+
+sr_split__create_multiple_versions( VirginHLDS, ReuseHLDS, HLDS) -->
+ % compute the strongly connected components
+ { module_info_ensure_dependency_info( ReuseHLDS, ReuseHLDS1) },
+ { module_info_get_maybe_dependency_info( ReuseHLDS1, MaybeDepInfo) } ,
+ (
+ { MaybeDepInfo = yes(DepInfo) }
+ ->
+ { hlds_dependency_info_get_dependency_ordering( DepInfo,
+ DepOrdering ) },
+ run_with_dependencies( DepOrdering, ReuseHLDS1,
+ VirginHLDS, HLDS)
+ ;
+ { error("(sr_split) create_multiple_versions: no dependency info") }
+ ).
+
+:- pred run_with_dependencies( dependency_ordering, module_info, module_info,
+ module_info, io__state, io__state).
+:- mode run_with_dependencies( in, in, in, out, di, uo) is det.
+
+run_with_dependencies( Deps, ReuseHLDSin, VirginHLDS, HLDSout) -->
+ list__foldl2( run_with_dependency(VirginHLDS), Deps,
+ ReuseHLDSin, HLDSout ).
+
+:- pred run_with_dependency( module_info, list(pred_proc_id),
+ module_info, module_info,
+ io__state, io__state).
+:- mode run_with_dependency( in, in, in, out, di, uo ) is det.
+
+run_with_dependency( VirginHLDS, SCC , HLDSin, HLDSout ) -->
+ { list__foldl( create_versions(VirginHLDS),
+ SCC,
+ HLDSin,
+ HLDSout ) }.
+
+:- pred create_versions( module_info::in, pred_proc_id::in,
+ module_info::in, module_info::out) is det.
+
+create_versions( VirginHLDS, PredProcId, WorkingHLDS, HLDS):-
+ module_info_pred_proc_info( WorkingHLDS, PredProcId,
+ PredInfo0, ProcInfo0),
+ proc_info_reuse_information( ProcInfo0, Memo),
+ module_info_pred_proc_info( VirginHLDS, PredProcId, _,
+ CleanProcInfo),
+
+ (
+ Memo = no
+ ->
+ % restore the old status of the procedure
+ module_info_set_pred_proc_info( WorkingHLDS, PredProcId,
+ PredInfo0, CleanProcInfo, HLDS)
+ ;
+ (
+ memo_reuse_is_conditional(Memo)
+ ->
+ % fetch the reuse goal
+ proc_info_goal( ProcInfo0, ReuseGoal),
+ create_reuse_pred(Memo, yes(ReuseGoal),
+ PredInfo0, ProcInfo0,
+ ReusePredInfo, ReuseProcInfo0,
+ ReuseProcId, ReuseName),
+ module_info_get_predicate_table(WorkingHLDS,
+ PredTable0),
+ module_info_structure_reuse_info(WorkingHLDS,
+ StrReuseInfo0),
+ StrReuseInfo0 = structure_reuse_info(ReuseMap0),
+ predicate_table_insert(PredTable0, ReusePredInfo,
+ ReusePredId, PredTable),
+ map__det_insert(ReuseMap0, PredProcId,
+ proc(ReusePredId, ReuseProcId) - ReuseName,
+ ReuseMap),
+ StrReuseInfo = structure_reuse_info(ReuseMap),
+ module_info_set_structure_reuse_info(WorkingHLDS,
+ StrReuseInfo, WorkingHLDS1),
+ module_info_set_predicate_table(WorkingHLDS1,
+ PredTable, WorkingHLDS2),
+
+ % reprocess the goal
+ process_goal( ReuseGoal, ReuseGoal2, WorkingHLDS2, _),
+ proc_info_set_goal( ReuseProcInfo0, ReuseGoal2,
+ ReuseProcInfo1),
+ module_info_set_pred_proc_info( WorkingHLDS2,
+ ReusePredId, ReuseProcId,
+ ReusePredInfo, ReuseProcInfo1,
+ WorkingHLDS3),
+
+ % and put a clean procedure back in place
+ module_info_set_pred_proc_info( WorkingHLDS3,
+ PredProcId, PredInfo0, CleanProcInfo, HLDS)
+ ;
+ % memo_reuse is unconditional -- perfect --
+ % nothing to be done!
+ HLDS = WorkingHLDS
+ )
+ ).
+
+
+
+:- pred create_reuse_pred(memo_reuse::in, maybe(hlds_goal)::in,
+ pred_info::in, proc_info::in,
+ pred_info::out, proc_info::out,
+ proc_id::out, sym_name::out) is det.
+
+create_reuse_pred(TabledReuse, MaybeReuseGoal, PredInfo, ProcInfo,
+ ReusePredInfo, ReuseProcInfo, ReuseProcId, SymName) :-
+ proc_info_set_reuse_information(ProcInfo,
+ TabledReuse, ReuseProcInfo0),
+ (
+ MaybeReuseGoal = yes(ReuseGoal),
+ proc_info_set_goal(ReuseProcInfo0, ReuseGoal, ReuseProcInfo)
+ ;
+ MaybeReuseGoal = no,
+ ReuseProcInfo = ReuseProcInfo0
+ ),
+ pred_info_module(PredInfo, ModuleName),
+ pred_info_name(PredInfo, Name),
+ pred_info_arg_types(PredInfo, TypeVarSet, ExistQVars, Types),
+ Cond = true,
+ pred_info_context(PredInfo, PredContext),
+ pred_info_import_status(PredInfo, Status),
+ pred_info_get_markers(PredInfo, Markers),
+ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
+ pred_info_get_class_context(PredInfo, ClassContext),
+ pred_info_get_aditi_owner(PredInfo, Owner),
+
+ set__init(Assertions),
+
+ Line = 0,
+ Counter = 0,
+
+ make_pred_name_with_context(ModuleName, "reuse", PredOrFunc, Name,
+ Line, Counter, SymName),
+
+ pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types,
+ Cond, PredContext, Status, Markers, PredOrFunc,
+ ClassContext, Owner, Assertions, ReuseProcInfo,
+ ReuseProcId, ReusePredInfo).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- pred process_goal(hlds_goal::in, hlds_goal::out,
+ module_info::in, module_info::out) is det.
+
+process_goal(Goal0 - GoalInfo, Goal - GoalInfo) -->
+ { Goal0 = call(PredId0, ProcId0, Args, Builtin, MaybeContext, Name0) },
+ =(ModuleInfo),
+ { module_info_structure_reuse_info(ModuleInfo, ReuseInfo) },
+ { ReuseInfo = structure_reuse_info(ReuseMap) },
+ {
+ goal_info_get_reuse(GoalInfo, reuse(reuse_call)),
+ map__search(ReuseMap, proc(PredId0, ProcId0), Result)
+ ->
+ Result = proc(PredId, ProcId) - Name
+ ;
+ PredId = PredId0,
+ ProcId = ProcId0,
+ Name = Name0
+ },
+ { Goal = call(PredId, ProcId, Args, Builtin, MaybeContext, Name) }.
+
+process_goal(Goal0 - GoalInfo, Goal - GoalInfo) -->
+ { Goal0 = unify(_Var, _Rhs, _Mode, _Unification0, _Ctxt) },
+ { Goal = Goal0 }.
+process_goal(Goal0 - GoalInfo, Goal - GoalInfo) -->
+ { Goal0 = generic_call(_, _, _, _) },
+ { Goal = Goal0 }.
+process_goal(Goal0 - GoalInfo, Goal - GoalInfo) -->
+ { Goal0 = pragma_foreign_code(_, _, _, _, _, _, _, _) },
+ { Goal = Goal0 }.
+process_goal(Goal0 - _GoalInfo, _) -->
+ { Goal0 = bi_implication(_, _) },
+ { error("structure_reuse: bi_implication.\n") }.
+
+process_goal(Goal0 - GoalInfo, Goal - GoalInfo) -->
+ { Goal0 = if_then_else(Vars, If0, Then0, Else0, SM) },
+ process_goal(If0, If),
+ process_goal(Then0, Then),
+ process_goal(Else0, Else),
+ { Goal = if_then_else(Vars, If, Then, Else, SM) }.
+
+process_goal(Goal0 - GoalInfo, Goal - GoalInfo) -->
+ { Goal0 = switch(Var, CanFail, Cases0, StoreMap) },
+ process_goal_cases(Cases0, Cases),
+ { Goal = switch(Var, CanFail, Cases, StoreMap) }.
+
+process_goal(Goal0 - GoalInfo, Goal - GoalInfo) -->
+ { Goal0 = some(Vars, CanRemove, SomeGoal0) },
+ process_goal(SomeGoal0, SomeGoal),
+ { Goal = some(Vars, CanRemove, SomeGoal) }.
+
+process_goal(not(Goal0) - GoalInfo, not(Goal) - GoalInfo) -->
+ process_goal(Goal0, Goal).
+process_goal(conj(Goal0s) - GoalInfo, conj(Goals) - GoalInfo) -->
+ process_goal_list(Goal0s, Goals).
+process_goal(disj(Goal0s, SM) - GoalInfo, disj(Goals, SM) - GoalInfo) -->
+ process_goal_list(Goal0s, Goals).
+process_goal(par_conj(Goal0s, SM) - GoalInfo,
+ par_conj(Goals, SM) - GoalInfo) -->
+ process_goal_list(Goal0s, Goals).
+
+:- pred process_goal_cases(list(case)::in, list(case)::out,
+ module_info::in, module_info::out) is det.
+
+process_goal_cases([], []) --> [].
+process_goal_cases([Case0 | Case0s], [Case | Cases]) -->
+ { Case0 = case(ConsId, Goal0) },
+ process_goal(Goal0, Goal),
+ { Case = case(ConsId, Goal) },
+ process_goal_cases(Case0s, Cases).
+
+:- pred process_goal_list(hlds_goals::in, hlds_goals::out,
+ module_info::in, module_info::out) is det.
+
+process_goal_list([], []) --> [].
+process_goal_list([Goal0 | Goal0s], [Goal | Goals]) -->
+ process_goal(Goal0, Goal),
+ process_goal_list(Goal0s, Goals).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: sr_util.m
===================================================================
RCS file: sr_util.m
diff -N sr_util.m
--- /dev/null Tue Jul 25 14:12:01 2000
+++ sr_util.m Fri Oct 13 01:49:50 2000
@@ -0,0 +1,147 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000 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.
+%-----------------------------------------------------------------------------%
+%
+% Module: sr_dead
+% Main authors: nancy
+%
+%-----------------------------------------------------------------------------%
+
+:- module sr_util.
+:- interface.
+
+:- import_module list.
+:- import_module hlds_module, hlds_pred, prog_data.
+
+:- pred compute_real_headvars(module_info, pred_id, proc_info,
+ list(prog_var)).
+:- mode compute_real_headvars(in, in, in, out) is det.
+
+
+:- pred list_drop_det(int,list(T),list(T)).
+:- mode list_drop_det(in,in,out) is det.
+
+
+:- pred list_map3( pred( T, T1, T2, T3 ), list(T), list(T1), list(T2),
+ list(T3) ).
+:- mode list_map3( pred( in, out, out, out) is det, in,
+ out, out, out) is det.
+
+:- pred list_map_foldl2(
+ pred( T, T1, T2, T2, T3, T3 ),
+ list(T),
+ list(T1),
+ T2, T2, T3, T3).
+:- mode list_map_foldl2( pred( in, out, in, out, in, out) is det,
+ in, out, in, out, in, out) is det.
+
+:- pred list_map3_foldl( pred(T1, T2, T3, T4, T5, T5),
+ list(T1), list(T2), list(T3), list(T4),
+ T5, T5).
+:- mode list_map3_foldl( pred(in, out, out, out, in, out) is det,
+ in, out, out, out, in, out) is det.
+
+:- pred list_map_foldl3( pred(T1, T2, T3, T3, T4, T4, T5, T5),
+ list(T1), list(T2),
+ T3, T3, T4, T4, T5, T5).
+:- mode list_map_foldl3( pred(in, out, in, out, in, out, in, out) is det,
+ in, out, in, out, in, out, in, out) is det.
+
+:- pred list_ho_member(pred(T,T), T, list(T)).
+:- mode list_ho_member(pred(in, in) is semidet, in, in) is semidet.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+
+compute_real_headvars( HLDS, PredId, ProcInfo, HVS ) :-
+ module_info_pred_info( HLDS, PredId, PredInfo),
+ pred_info_arity(PredInfo, Arity),
+ proc_info_headvars(ProcInfo, HeadVars),
+ list__length(HeadVars, PseudoArity) ,
+ NumberOfTypeInfos = PseudoArity - Arity ,
+ list_drop_det(NumberOfTypeInfos, HeadVars, RealHeadVars) ,
+ HVS = RealHeadVars.
+
+list_drop_det(Len,List,End):-
+ (
+ list__drop(Len,List,End0)
+ ->
+ End = End0
+ ;
+ End = List
+ ).
+
+
+list_map3( P, L, A, B, C) :-
+ (
+ L = [ L1 | LR ]
+ ->
+ P( L1, A1, B1, C1),
+ list_map3( P, LR, AR, BR, CR ),
+ A = [ A1 | AR ],
+ B = [ B1 | BR ],
+ C = [ C1 | CR ]
+ ;
+ A = [],
+ B = [],
+ C = []
+ ).
+
+list_map_foldl2( P, L0, L1, A0, A, B0, B) :-
+ (
+ L0 = [ LE0 | LR0 ]
+ ->
+ P( LE0, LE1, A0, A1, B0, B1),
+ list_map_foldl2( P, LR0, LR1, A1, A, B1, B),
+ L1 = [ LE1 | LR1 ]
+ ;
+ L1 = [],
+ A = A0,
+ B = B0
+ ).
+
+list_map3_foldl( P, L0, L1, L2, L3, A0, A) :-
+ (
+ L0 = [ X | Xs ]
+ ->
+ P( X, Y1, Y2, Y3, A0, A1),
+ list_map3_foldl( P, Xs, Ys1, Ys2, Ys3, A1, A),
+ L1 = [ Y1 | Ys1 ],
+ L2 = [ Y2 | Ys2 ],
+ L3 = [ Y3 | Ys3 ]
+ ;
+ L1 = [],
+ L2 = [],
+ L3 = [],
+ A = A0
+ ).
+
+list_map_foldl3( P, L1, L, A1, A, B1, B, C1, C) :-
+ (
+ L1 = [ X | Xs ]
+ ->
+ P( X, Y, A1, A2, B1, B2, C1, C2 ),
+ list_map_foldl3( P, Xs, Ys, A2, A, B2, B, C2, C),
+ L = [ Y | Ys ]
+ ;
+ L = [],
+ A = A1,
+ B = B1,
+ C = C1
+ ).
+
+list_ho_member( EQUALITY_TEST, ELEMENT, LIST ) :-
+ LIST = [ HEAD | TAIL ],
+ (
+ EQUALITY_TEST(HEAD, ELEMENT)
+ ->
+ true
+ ;
+ list_ho_member( EQUALITY_TEST, ELEMENT, TAIL )
+ ).
Index: structure_reuse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/structure_reuse.m,v
retrieving revision 1.1.2.2
diff -u -r1.1.2.2 structure_reuse.m
--- structure_reuse.m 2000/10/11 11:02:56 1.1.2.2
+++ structure_reuse.m 2000/10/12 14:49:50
@@ -39,19 +39,21 @@
:- module structure_reuse.
:- interface.
-:- import_module hlds_module.
-:- import_module io.
+:- import_module list,io.
+:- import_module hlds_module, hlds_pred.
:- pred structure_reuse(module_info::in, module_info::out,
io__state::di, io__state::uo) is det.
+:- pred write_pragma_reuse_info(module_info::in, list(pred_id)::in,
+ pred_id::in, io__state::di, io__state::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module passes_aux, sr_direct, sr_indirect.
-:- import_module list, map.
+:- import_module passes_aux, sr_direct, sr_indirect, sr_split, sr_util.
+:- import_module list, map, varset, std_util, int, bool.
structure_reuse(HLDS0, HLDS) -->
{ module_info_get_special_pred_map(HLDS0, SpecialPredMap) },
@@ -67,7 +69,97 @@
% Do the fixpoint computation to determine all the indirect
% reuse, and the implied conditions.
- sr_indirect__compute_fixpoint(HLDS1, HLDS).
-
+ sr_indirect__compute_fixpoint(HLDS1, HLDS2),
+ sr_split__create_multiple_versions(HLDS0, HLDS2, HLDS).
+
+
+write_pragma_reuse_info( HLDS, SpecPredIds, PredId ) -->
+ { module_info_pred_info( HLDS, PredId, PredInfo ) },
+ (
+ { pred_info_is_exported( PredInfo ) }
+ ->
+ (
+ { list__member( PredId, SpecPredIds ) }
+ ->
+ []
+ ;
+ { pred_info_procids(PredInfo, ProcIds) },
+ list__foldl(
+ write_pred_proc_sr_reuse_info(HLDS, PredId),
+ ProcIds )
+ )
+ ;
+ []
+ ).
+
+:- import_module sr_data.
+:- import_module mercury_to_mercury, prog_data.
+
+:- pred write_pred_proc_sr_reuse_info( module_info, pred_id,
+ proc_id, io__state, io__state).
+:- mode write_pred_proc_sr_reuse_info( in, in, in, di, uo) is det.
+
+write_pred_proc_sr_reuse_info( HLDS, PredId, ProcId) -->
+ { module_info_pred_proc_info(HLDS, PredId, ProcId,
+ PredInfo, ProcInfo) },
+
+ io__write_string(":- pragma sr_reuse_info("),
+
+ % write a simple predicate declaration
+
+ { varset__init( InitVarSet ) },
+ { pred_info_name( PredInfo, PredName ) },
+ { pred_info_get_is_pred_or_func( PredInfo, PredOrFunc ) },
+ { pred_info_module( PredInfo, ModuleName ) },
+ { pred_info_context( PredInfo, Context ) },
+ { pred_info_arity( PredInfo, Arity) },
+ { SymName = qualified( ModuleName, PredName ) },
+
+ { proc_info_declared_argmodes( ProcInfo, Modes ) },
+
+ (
+ { PredOrFunc = predicate },
+ mercury_output_pred_mode_subdecl( InitVarSet, SymName, Modes,
+ std_util__no, Context )
+ ;
+ { PredOrFunc = function },
+ { pred_args_to_func_args( Modes, FuncModes, RetMode ) },
+ mercury_output_func_mode_subdecl( InitVarSet, SymName,
+ FuncModes, RetMode, std_util__no, Context )
+ ),
+
+ io__write_string(", "),
+
+ % write headvars vars(HeadVar__1, ... HeadVar__n)
+
+ { proc_info_varset(ProcInfo, ProgVarset) },
+ { proc_info_headvars(ProcInfo, HeadVars) },
+ { list__length(HeadVars, PseudoArity) },
+ { NumberOfTypeInfos = PseudoArity - Arity },
+ { list_drop_det(NumberOfTypeInfos, HeadVars, RealHeadVars) },
+ io__write_string("vars("),
+ mercury_output_vars(RealHeadVars, ProgVarset, no),
+ io__write_string(")"),
+
+ io__write_string(", "),
+
+ % write reuse information
+ { module_info_structure_reuse_info(HLDS, ReuseInfo) },
+ { ReuseInfo = structure_reuse_info(ReuseMap) },
+ {
+ map__search(ReuseMap, proc(PredId, ProcId), Result)
+ ->
+ Result = proc(ReusePredId, ReuseProcId) - ReuseName
+ ;
+ ReusePredId = PredId,
+ ReuseProcId = ProcId,
+ ReuseName = SymName
+ },
+ { module_info_pred_proc_info(HLDS, ReusePredId, ReuseProcId,
+ _ReusePredInfo, ReuseProcInfo) },
+ { proc_info_reuse_information(ReuseProcInfo, TREUSE) },
+ sr_data__memo_reuse_print( TREUSE, ReuseName, ReuseProcInfo) ,
+
+ io__write_string(").\n").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: trans_opt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.15.4.2
diff -u -r1.15.4.2 trans_opt.m
--- trans_opt.m 2000/09/22 15:04:16 1.15.4.2
+++ trans_opt.m 2000/10/12 14:49:51
@@ -77,7 +77,7 @@
:- import_module set, string, list, map, varset, term, std_util.
:- import_module pa_run.
-:- import_module sr_run.
+:- import_module structure_reuse.
%-----------------------------------------------------------------------------%
@@ -179,9 +179,9 @@
{ StructureReuse = yes }
->
% output structure-reuse information
- io__write_string(
+ io__write_string(
"\n%----------- sr_reuse_info/3 ------------- \n\n"),
- list__foldl( sr_run__write_pred_sr_reuse_info(Module,
+ list__foldl( structure_reuse__write_pragma_reuse_info(Module,
AllSpecialPredIds),
PredIds)
;
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list