[m-rev.] diff: reduce clutter in my workspace
Peter Wang
novalazy at gmail.com
Thu Jan 10 15:36:08 AEDT 2008
Branches: main
Commit some simple changes accumulating in a workspaces to reduce clutter.
compiler/ctgc.datastruct.m:
Write datastructs_subsumed_by_list more declaratively.
compiler/ctgc.util.m:
Rename `preds_requiring_no_analysis' to
`some_preds_requiring_no_analysis' to reflect what it does and
simplify the implementation.
compiler/hlds_goal.m:
Use `needs_update' instead of `bool' in a spot.
Update comments.
compiler/quantification.m:
compiler/structure_reuse.versions.m:
Conform to use of `needs_update' instead of `bool'.
compiler/hlds_pred.m:
compiler/prog_data.m:
compiler/prog_io_pragma.m:
compiler/structure_reuse.direct.m:
Update comments.
compiler/liveness.m:
Move a goal into execution order.
compiler/structure_reuse.direct.detect_garbage.m:
Delete an unnecessary (and overloaded) predicate.
compiler/structure_reuse.analysis.m:
compiler/structure_reuse.domain.m:
Make the reuse information dump more readable (longer strings instead
of single character codes, names instead of ids).
compiler/structure_reuse.indirect.m:
Use `map.apply_to_list' instead of higher order calls.
Use readable strings for fixpoint table short descriptions.
compiler/structure_sharing.analysis.m:
Rename some variables.
Use `map.apply_to_list' instead of higher order calls.
compiler/trans_opt.m:
Use `assoc_list.keys' instead of higher order calls.
compiler/type_util.m:
Fix typo.
Index: compiler/ctgc.datastruct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.datastruct.m,v
retrieving revision 1.9
diff -u -r1.9 ctgc.datastruct.m
--- compiler/ctgc.datastruct.m 31 Jul 2006 08:31:33 -0000 1.9
+++ compiler/ctgc.datastruct.m 10 Jan 2008 04:08:45 -0000
@@ -151,9 +151,11 @@
datastructs_subsumed_by_list(ModuleInfo, ProcInfo, PerhapsSubsumedData,
Data) :-
- list.takewhile(datastructs_subsume_datastruct(ModuleInfo, ProcInfo, Data),
- PerhapsSubsumedData, _, NotSubsumed),
- NotSubsumed = [].
+ all [X] (
+ list.member(X, PerhapsSubsumedData)
+ =>
+ datastructs_subsume_datastruct(ModuleInfo, ProcInfo, Data, X)
+ ).
:- pred datastructs_subsume_datastruct(module_info::in, proc_info::in,
list(datastruct)::in, datastruct::in) is semidet.
Index: compiler/ctgc.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.util.m,v
retrieving revision 1.13
diff -u -r1.13 ctgc.util.m
--- compiler/ctgc.util.m 28 Sep 2007 03:17:11 -0000 1.13
+++ compiler/ctgc.util.m 10 Jan 2008 04:08:45 -0000
@@ -29,8 +29,8 @@
% current module, as these predicates are not analysed by the CTGC
% system.
%
-:- pred preds_requiring_no_analysis(module_info::in, list(pred_proc_id)::in)
- is semidet.
+:- pred some_preds_requiring_no_analysis(module_info::in,
+ list(pred_proc_id)::in) is semidet.
:- pred pred_requires_no_analysis(module_info::in, pred_id::in) is semidet.
:- pred pred_requires_analysis(module_info::in, pred_id::in) is semidet.
@@ -76,13 +76,9 @@
pred_requires_analysis(ModuleInfo, PredId) :-
\+ pred_requires_no_analysis(ModuleInfo, PredId).
-:- func get_pred_id(pred_proc_id) = pred_id.
-get_pred_id(proc(PredId, _)) = PredId.
-
-preds_requiring_no_analysis(ModuleInfo, PPIds) :-
- list.takewhile(pred_requires_analysis(ModuleInfo),
- list.map(get_pred_id, PPIds), _RequiresAnalysis, RequiresNoAnalysis),
- RequiresNoAnalysis = [_|_].
+some_preds_requiring_no_analysis(ModuleInfo, PPIds) :-
+ list.member(proc(PredId, _), PPIds),
+ pred_requires_no_analysis(ModuleInfo, PredId).
:- pred not_defined_in_this_module(module_info::in, pred_proc_id::in)
is semidet.
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.185
diff -u -r1.185 hlds_goal.m
--- compiler/hlds_goal.m 30 Dec 2007 08:23:42 -0000 1.185
+++ compiler/hlds_goal.m 10 Jan 2008 04:08:46 -0000
@@ -764,8 +764,7 @@
% Information on how to construct the cell for a construction unification.
% The `construct_statically' alternative is set by the mark_static_terms.m
% pass, and is currently only used for the MLDS back-end (for the LLDS
- % back-end, the same optimization is handled by var_locn.m). The
- % `reuse_cell' alternative is not yet used.
+ % back-end, the same optimization is handled by var_locn.m).
%
:- type how_to_construct
---> construct_statically(
@@ -802,7 +801,7 @@
prog_var,
list(cons_id), % The cell to be reused may be tagged
% with one of these cons_ids.
- list(bool) % A `no' entry means that the corresponding
+ list(needs_update) % Whether the corresponding
% argument already has the correct value
% and does not need to be filled in.
).
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.235
diff -u -r1.235 hlds_pred.m
--- compiler/hlds_pred.m 31 Dec 2007 10:03:46 -0000 1.235
+++ compiler/hlds_pred.m 10 Jan 2008 04:08:47 -0000
@@ -2304,22 +2304,22 @@
% that, this field is of no use.
).
- % Sharing information is expressed in terms of headvariables and the
+ % Sharing information is expressed in terms of head variables and the
% type variables occurring in their types. In order to correctly process
% (mainly renaming) this information, we need both the list of head
- % variables as well as their types. As this list of headvariables may
- % contain any compiler-added headvariables, the processing of imported
+ % variables as well as their types. As this list of head variables may
+ % contain any compiler-added head variables, the processing of imported
% structure sharing information needs to be postponed until the actual
% structure sharing analysis, which explains the need for the type
- % imported_sharing to temporarely store the imported sharing information.
+ % imported_sharing to temporarily store the imported sharing information.
%
:- type imported_sharing
---> imported_sharing(
- % The list of headvars in which terms the imported sharing
- % is expressed.
+ % The list of head variables in which terms the imported
+ % sharing is expressed.
s_headvars :: prog_vars,
- % The types of the headvars.
+ % The types of the head variables.
s_types :: list(mer_type),
s_sharing :: structure_sharing_domain
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.159
diff -u -r1.159 liveness.m
--- compiler/liveness.m 30 Dec 2007 08:23:46 -0000 1.159
+++ compiler/liveness.m 10 Jan 2008 04:08:48 -0000
@@ -380,6 +380,8 @@
set.difference(TypeInfos, Liveness0, NewTypeInfos),
set.union(Births1, NewTypeInfos, Births)
),
+ set.union(Liveness0, Births, Liveness),
+
( goal_is_atomic(GoalExpr0) ->
PreDeaths = Empty,
PreBirths = Births,
@@ -396,7 +398,6 @@
set.difference(FinalLiveness, Liveness, PostDeaths),
set.difference(Liveness, FinalLiveness, PostBirths)
),
- set.union(Liveness0, Births, Liveness),
% We initialize all the fields in order to obliterate any
% annotations left by a previous invocation of this module.
goal_info_initialize_liveness_info(PreBirths, PostBirths,
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.200
diff -u -r1.200 prog_data.m
--- compiler/prog_data.m 5 Dec 2007 05:07:36 -0000 1.200
+++ compiler/prog_data.m 10 Jan 2008 04:08:50 -0000
@@ -338,6 +338,7 @@
%
% Stuff for the `structure_sharing_info' pragma.
%
+
% Whenever structure sharing analysis is unable to determine a good
% approximation of the set of structure sharing pairs that might exist
% during the execution of a program, it must use "top" as the only safe
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.130
diff -u -r1.130 prog_io_pragma.m
--- compiler/prog_io_pragma.m 5 Dec 2007 05:07:37 -0000 1.130
+++ compiler/prog_io_pragma.m 10 Jan 2008 04:08:50 -0000
@@ -956,7 +956,7 @@
NameAndModesResult),
NameAndModesResult = ok2(PredName - PredOrFunc, ModeList),
- % Parse the headvariables:
+ % Parse the head variables:
HeadVarsTerm = term.functor(term.atom("vars"), ListHVTerm, _),
term.vars_list(ListHVTerm, HeadVarsGeneric),
list.map(term.coerce_var, HeadVarsGeneric, HeadVars),
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.123
diff -u -r1.123 quantification.m
--- compiler/quantification.m 30 Dec 2007 08:23:55 -0000 1.123
+++ compiler/quantification.m 10 Jan 2008 04:08:51 -0000
@@ -709,7 +709,7 @@
union(NonLocals1, NonLocals2, NonLocals),
set_nonlocals(NonLocals, !Info).
-:- pred implicitly_quantify_unify_rhs(maybe(list(bool))::in,
+:- pred implicitly_quantify_unify_rhs(maybe(list(needs_update))::in,
hlds_goal_info::in, unify_rhs::in, unify_rhs::out,
unification::in, unification::out, quant_info::in, quant_info::out) is det.
@@ -1284,8 +1284,8 @@
!LambdaSet) :-
conj_vars(NonLocalsToRecompute, [LHS, RHS], !Set, !LambdaSet).
-:- pred unify_rhs_vars(nonlocals_to_recompute, unify_rhs, maybe(list(bool)),
- set_of_var, set_of_var, set_of_var, set_of_var).
+:- pred unify_rhs_vars(nonlocals_to_recompute, unify_rhs,
+ maybe(list(needs_update)), set_of_var, set_of_var, set_of_var, set_of_var).
:- mode unify_rhs_vars(in(ordinary_nonlocals), in, in, in, out, in, out)
is det.
:- mode unify_rhs_vars(in(code_gen_nonlocals), in, in, in, out, in, out)
@@ -1314,20 +1314,20 @@
delete_list(GoalVars, LambdaVars, GoalVars1),
union(!.LambdaSet, GoalVars1, !:LambdaSet).
-:- pred insert_set_fields(list(bool)::in, list(prog_var)::in,
+:- pred insert_set_fields(list(needs_update)::in, list(prog_var)::in,
set_of_var::in, set_of_var::out) is det.
insert_set_fields(SetArgs, Args, !Set) :-
get_updated_fields(SetArgs, Args, ArgsToSet),
insert_list(!.Set, ArgsToSet, !:Set).
-:- pred get_updated_fields(list(bool)::in,
+:- pred get_updated_fields(list(needs_update)::in,
list(prog_var)::in, list(prog_var)::out) is det.
get_updated_fields(SetArgs, Args, ArgsToSet) :-
get_updated_fields(SetArgs, Args, [], ArgsToSet).
-:- pred get_updated_fields(list(bool)::in,
+:- pred get_updated_fields(list(needs_update)::in,
list(prog_var)::in, list(prog_var)::in, list(prog_var)::out) is det.
get_updated_fields([], [], !ArgsToSet).
@@ -1337,10 +1337,10 @@
unexpected(this_file, "get_updated_fields").
get_updated_fields([SetArg | SetArgs], [Arg | Args], !ArgsToSet) :-
(
- SetArg = yes,
+ SetArg = needs_update,
!:ArgsToSet = [Arg | !.ArgsToSet]
;
- SetArg = no,
+ SetArg = does_not_need_update,
!:ArgsToSet = !.ArgsToSet
),
get_updated_fields(SetArgs, Args, !ArgsToSet).
Index: compiler/structure_reuse.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.analysis.m,v
retrieving revision 1.9
diff -u -r1.9 structure_reuse.analysis.m
--- compiler/structure_reuse.analysis.m 17 May 2007 03:52:51 -0000 1.9
+++ compiler/structure_reuse.analysis.m 10 Jan 2008 04:08:51 -0000
@@ -131,14 +131,14 @@
direct_reuse_pass(SharingTable, !ModuleInfo,
ReuseTable0, ReuseTable1, !IO),
maybe_write_string(VeryVerbose, "% Direct reuse: done.\n", !IO),
- reuse_as_table_maybe_dump(VeryVerbose, ReuseTable1, !IO),
+ reuse_as_table_maybe_dump(VeryVerbose, !.ModuleInfo, ReuseTable1, !IO),
% Determine information about possible indirect reuses.
maybe_write_string(VeryVerbose, "% Indirect reuse...\n", !IO),
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, !.ModuleInfo, ReuseTable2, !IO),
% For every procedure that has some potential (conditional) reuse (either
% direct or indirect), create a new procedure that actually implements
Index: compiler/structure_reuse.direct.detect_garbage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.detect_garbage.m,v
retrieving revision 1.10
diff -u -r1.10 structure_reuse.direct.detect_garbage.m
--- compiler/structure_reuse.direct.detect_garbage.m 7 Aug 2007 07:10:05 -0000 1.10
+++ compiler/structure_reuse.direct.detect_garbage.m 10 Jan 2008 04:08:52 -0000
@@ -59,14 +59,8 @@
determine_dead_deconstructions(ModuleInfo, PredInfo, ProcInfo, SharingTable,
Goal, DeadCellTable) :-
- determine_dead_deconstructions(
- detect_bg_info_init(ModuleInfo, PredInfo, ProcInfo, SharingTable),
- Goal, DeadCellTable).
-
-:- pred determine_dead_deconstructions(detect_bg_info::in, hlds_goal::in,
- dead_cell_table::out) is det.
-
-determine_dead_deconstructions(Background, Goal, DeadCellTable):-
+ Background = detect_bg_info_init(ModuleInfo, PredInfo, ProcInfo,
+ SharingTable),
% In this process we need to know the sharing at each program point,
% which boils down to reconstructing that sharing information based on the
% sharing recorded in the sharing table.
Index: compiler/structure_reuse.direct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.m,v
retrieving revision 1.8
diff -u -r1.8 structure_reuse.direct.m
--- compiler/structure_reuse.direct.m 23 May 2007 09:41:49 -0000 1.8
+++ compiler/structure_reuse.direct.m 10 Jan 2008 04:08:52 -0000
@@ -9,12 +9,12 @@
% File: structure_reuse.direct.m.
% Main authors: nancy.
%
-% This module efined procedure and type related to the dectection of so called
-% direct reuses within the CTGC system. A "direct reuse" is a combination of
-% the location of a deconstruction unification (where a datastructure may
-% become garbage under certain conditions) and a set of locations of
-% construction unifications where the garbage datastructure can be reused
-% locally.
+% This module defines procedures and types related to the detection of so
+% called "direct reuses" within the CTGC system. A direct reuse is a
+% combination of the location of a deconstruction unification (where a
+% datastructure may become garbage under certain conditions) and a set of
+% locations of construction unifications where the garbage datastructure can
+% be reused locally.
%
% Direct reuse analysis requires two steps:
% - Detecting where datastructures may become garbage.
Index: compiler/structure_reuse.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.domain.m,v
retrieving revision 1.9
diff -u -r1.9 structure_reuse.domain.m
--- compiler/structure_reuse.domain.m 28 Sep 2007 03:17:14 -0000 1.9
+++ compiler/structure_reuse.domain.m 10 Jan 2008 04:08:52 -0000
@@ -189,8 +189,8 @@
:- pred reuse_as_table_set(pred_proc_id::in, reuse_as::in,
reuse_as_table::in, reuse_as_table::out) is det.
-:- pred reuse_as_table_maybe_dump(bool::in, reuse_as_table::in,
- io::di, io::uo) is det.
+:- pred reuse_as_table_maybe_dump(bool::in, module_info::in,
+ reuse_as_table::in, io::di, io::uo) is det.
% Load all the structure reuse information present in the HLDS into
% a reuse table.
@@ -202,6 +202,7 @@
:- implementation.
+:- import_module hlds.hlds_out.
:- import_module libs.compiler_util.
:- import_module parse_tree.prog_ctgc.
:- import_module transform_hlds.ctgc.datastruct.
@@ -357,9 +358,9 @@
ReuseAs = unconditional
).
-reuse_as_short_description(no_reuse) = "n".
-reuse_as_short_description(unconditional) = "u".
-reuse_as_short_description(conditional(Conds)) = "c(" ++ Size ++ ")" :-
+reuse_as_short_description(no_reuse) = "no_reuse".
+reuse_as_short_description(unconditional) = "uncond".
+reuse_as_short_description(conditional(Conds)) = "cond(" ++ Size ++ ")" :-
Size = string.int_to_string(list.length(Conds)).
@@ -676,34 +677,34 @@
reuse_as_table_set(PPId, ReuseAs, !Table) :-
!:Table = !.Table ^ elem(PPId) := ReuseAs.
-reuse_as_table_maybe_dump(DoDump, Table, !IO) :-
+reuse_as_table_maybe_dump(DoDump, ModuleInfo, Table, !IO) :-
(
DoDump = no
;
DoDump = yes,
- reuse_as_table_dump(Table, !IO)
+ reuse_as_table_dump(ModuleInfo, Table, !IO)
).
-:- pred reuse_as_table_dump(reuse_as_table::in, io::di, io::uo) is det.
+:- pred reuse_as_table_dump(module_info::in, reuse_as_table::in,
+ io::di, io::uo) is det.
-reuse_as_table_dump(Table, !IO) :-
- (
- map.is_empty(Table)
- ->
+reuse_as_table_dump(ModuleInfo, Table, !IO) :-
+ ( map.is_empty(Table) ->
io.write_string("% ReuseTable: Empty", !IO)
;
io.write_string("% ReuseTable: PPId --> Reuse\n", !IO),
- io.write_list(map.to_assoc_list(Table), "", dump_entries, !IO)
+ map.foldl(dump_entries(ModuleInfo), Table, !IO)
).
-:- pred dump_entries(pair(pred_proc_id, reuse_as)::in, io::di, io::uo) is det.
+:- pred dump_entries(module_info::in, pred_proc_id::in, reuse_as::in,
+ io::di, io::uo) is det.
-dump_entries(PPId - ReuseAs, !IO) :-
- PPId = proc(PredId, ProcId),
- io.write_string(
- "% " ++ string.int_to_string(pred_id_to_int(PredId)) ++ ", " ++
- string.int_to_string(proc_id_to_int(ProcId)) ++ "\t-->" ++
- reuse_as_short_description(ReuseAs) ++ "\n", !IO).
+dump_entries(ModuleInfo, PPId, ReuseAs, !IO) :-
+ io.write_string("% ", !IO),
+ write_pred_proc_id(ModuleInfo, PPId, !IO),
+ io.write_string("\t--> ", !IO),
+ io.write_string(reuse_as_short_description(ReuseAs), !IO),
+ io.nl(!IO).
load_structure_reuse_table(ModuleInfo) = ReuseTable :-
module_info_predids(PredIds, ModuleInfo, _ModuleInfo),
@@ -733,7 +734,7 @@
;
MaybePublicReuse = no
).
-
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.13
diff -u -r1.13 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m 30 Dec 2007 08:23:57 -0000 1.13
+++ compiler/structure_reuse.indirect.m 10 Jan 2008 04:08:52 -0000
@@ -95,7 +95,7 @@
reuse_as_table::in, reuse_as_table::out, io::di, io::uo) is det.
indirect_reuse_analyse_scc(SharingTable, SCC, !ModuleInfo, !ReuseTable, !IO) :-
- ( preds_requiring_no_analysis(!.ModuleInfo, SCC) ->
+ ( some_preds_requiring_no_analysis(!.ModuleInfo, SCC) ->
true
;
indirect_reuse_analyse_scc_until_fixpoint(SharingTable,
@@ -199,7 +199,7 @@
ReuseTable) = BG :-
% 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:
+ % of head variables:
proc_info_get_headvars(ProcInfo, HeadVars),
proc_info_get_vartypes(ProcInfo, Vartypes),
HeadVarsOfInterest =
@@ -528,7 +528,7 @@
SharingAs = AnalysisInfo ^ sharing_as,
proc_info_get_vartypes(ProcInfo, ActualVarTypes),
pred_info_get_typevarset(PredInfo, ActualTVarset),
- list.map(map.lookup(ActualVarTypes), CalleeArgs, CalleeTypes),
+ map.apply_to_list(CalleeArgs, ActualVarTypes, CalleeTypes),
reuse_as_rename_using_module_info(ModuleInfo, CalleePPId,
CalleeArgs, CalleeTypes, ActualTVarset, FormalReuseAs, ActualReuseAs),
LiveData = livedata_init_at_goal(ModuleInfo, ProcInfo, GoalInfo,
@@ -660,7 +660,11 @@
get_from_fixpoint_table(PPId, ReuseAs, !Table).
sr_fixpoint_table_get_short_description(PPId, Table) = Descr :-
- ( fixpoint_table.is_recursive(Table) -> Rec = "(r)" ; Rec = "(-)"),
+ ( fixpoint_table.is_recursive(Table) ->
+ Rec = "(rec)"
+ ;
+ Rec = "(non-rec)"
+ ),
( As = sr_fixpoint_table_get_final_as_semidet(PPId, Table) ->
Descr0 = reuse_as_short_description(As)
;
Index: compiler/structure_reuse.versions.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.versions.m,v
retrieving revision 1.8
diff -u -r1.8 structure_reuse.versions.m
--- compiler/structure_reuse.versions.m 30 Dec 2007 08:23:58 -0000 1.8
+++ compiler/structure_reuse.versions.m 10 Jan 2008 04:08:52 -0000
@@ -75,6 +75,7 @@
:- 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),
@@ -104,8 +105,8 @@
% 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).
+ ReusePPIds = ReuseCondPPIds ++ UncondPPIds,
+ list.foldl2(process_proc(ReuseMap), ReusePPIds, !ModuleInfo, !IO).
:- pred has_conditional_reuse(reuse_as_table::in, pred_proc_id::in) is semidet.
@@ -115,13 +116,14 @@
:- 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):-
+create_fresh_pred_proc_info_copy(PPId, NewPPId, !ModuleInfo) :-
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
ReusePredName = generate_reuse_name(!.ModuleInfo, PPId),
create_fresh_pred_proc_info_copy_2(PredInfo0, ProcInfo0, ReusePredName,
@@ -136,12 +138,11 @@
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):-
+ ReusePredInfo, ReuseProcId) :-
ModuleName = pred_info_module(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
pred_info_get_context(PredInfo, ProgContext),
@@ -171,7 +172,7 @@
pred_proc_id::in, module_info::in, module_info::out,
io::di, io::uo) is det.
-process_proc(ReuseMap, PPId, !ModuleInfo, !IO):-
+process_proc(ReuseMap, PPId, !ModuleInfo, !IO) :-
write_proc_progress_message("(reuse version) ", PPId, !.ModuleInfo, !IO),
module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
proc_info_get_goal(ProcInfo0, Goal0),
@@ -284,17 +285,13 @@
CellsToUpdate)
->
CellToReuse = cell_to_reuse(DeadVar, PossibleConsIds,
- list.map(needs_update_to_bool, CellsToUpdate)),
+ CellsToUpdate),
HowToConstruct = reuse_cell(CellToReuse),
!:Unification = construct(A, B, C, D, HowToConstruct, F, G)
;
true
).
-:- func needs_update_to_bool(needs_update) = bool.
-needs_update_to_bool(needs_update) = no.
-needs_update_to_bool(does_not_need_update) = yes.
-
:- 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.
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.24
diff -u -r1.24 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 30 Dec 2007 08:23:58 -0000 1.24
+++ compiler/structure_sharing.analysis.m 10 Jan 2008 04:08:52 -0000
@@ -223,7 +223,7 @@
sharing_as_table::in, sharing_as_table::out, io::di, io::uo) is det.
analyse_scc(ModuleInfo, SCC, !SharingTable, !IO) :-
- ( preds_requiring_no_analysis(ModuleInfo, SCC) ->
+ ( some_preds_requiring_no_analysis(ModuleInfo, SCC) ->
true
;
analyse_scc_until_fixpoint(ModuleInfo, SCC, !.SharingTable,
@@ -342,16 +342,17 @@
"par_conj (" ++ ContextString ++ ")", !.SharingAs)
)
;
- GoalExpr = plain_call(CalleePredId, CalleeProcId, CalleeArgs,_, _, _),
+ GoalExpr = plain_call(CalleePredId, CalleeProcId, CallArgs,_, _, _),
CalleePPId = proc(CalleePredId, CalleeProcId),
lookup_sharing(ModuleInfo, SharingTable, CalleePPId,
!FixpointTable, CalleeSharing),
% Rename
- proc_info_get_vartypes(ProcInfo, AllTypes),
- list.map(map.lookup(AllTypes), CalleeArgs, ActualTypes),
+ proc_info_get_vartypes(ProcInfo, CallerVarTypes),
+ map.apply_to_list(CallArgs, CallerVarTypes, ActualTypes),
pred_info_get_typevarset(PredInfo, ActualTVarset),
- sharing_as_rename_using_module_info(ModuleInfo, CalleePPId, CalleeArgs,
+
+ sharing_as_rename_using_module_info(ModuleInfo, CalleePPId, CallArgs,
ActualTypes, ActualTVarset, CalleeSharing, RenamedSharing),
% Combine
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.45
diff -u -r1.45 trans_opt.m
--- compiler/trans_opt.m 19 Jan 2007 07:04:33 -0000 1.45
+++ compiler/trans_opt.m 10 Jan 2008 04:08:53 -0000
@@ -103,6 +103,7 @@
:- import_module transform_hlds.termination.
:- import_module transform_hlds.trailing_analysis.
+:- import_module assoc_list.
:- import_module list.
:- import_module map.
:- import_module pair.
@@ -139,13 +140,13 @@
% All predicates to write global items into the .trans_opt
% file should go here.
- % Select all the predicates for which something should be writting
+ % Select all the predicates for which something should be written
% into the .trans_opt file.
%
module_info_predids(PredIds, Module, _Module),
module_info_get_structure_reuse_map(Module, ReuseMap),
map.values(ReuseMap, ReuseResults),
- list.map(fst, ReuseResults, ReusePredProcIds),
+ assoc_list.keys(ReuseResults, ReusePredProcIds),
list.map(get_pred_id, ReusePredProcIds, ReusePredIds),
list.delete_elems(PredIds, ReusePredIds, PredIdsNoReuseVersions),
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.187
diff -u -r1.187 type_util.m
--- compiler/type_util.m 30 Dec 2007 08:24:00 -0000 1.187
+++ compiler/type_util.m 10 Jan 2008 04:08:53 -0000
@@ -916,7 +916,7 @@
TypeDefn = TypeDefnPrime,
ConsDefn = ConsDefnPrime
;
- unexpected(this_file, "gget_type_and_cons_defn")
+ unexpected(this_file, "get_type_and_cons_defn")
).
:- pred do_get_type_and_cons_defn(module_info::in, type_ctor::in, cons_id::in,
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list