[m-rev.] for review: call-dependent structure reuse analysis

Peter Wang novalazy at gmail.com
Mon May 26 12:54:37 AEST 2008


Branches: main

Add initial support for performing call-specific structure reuse analysis.
If a call site violates the conditions for calling the reuse version of a
procedure, it can request a different reuse version of the procedure with
possibly laxer reuse conditions.  At least for now, I have chosen call
patterns to simply be lists of argument positions, the arguments are which
cannot be clobbered by the callee.

Requests across module boundaries are supported when using the
`--intermodule-analysis' option.

This initial version does a lot of unnecessary reanalysis so must be switched
on explicitly with a `--structure-reuse-repeat <n>' option.  This option
shouldn't be needed in the future.


compiler/options.m:
	Add a `--structure-reuse-repeat <n>' option.

compiler/analysis.m:
compiler/mercury_compile.m:
	Read in the `.request' file for the current module being analysed
	when we're preparing to use the intermodule analysis framework.

	Don't return duplicates when looking up analysis requests.

compiler/structure_reuse.analysis.m:
	Read in old reuse analysis answers and new requests when using
	`--intermodule-analysis'.  Make procedures corresponding to old
	Answers (as expected by other modules) and new requests (so we
	analyse the procedures with the requested call patterns).

	When `--structure-reuse-repeat' is used, use the requests from the
	latest indirect reuse pass to create new reuse procedures with the
	extra constraints on some of the head variables (that they must not
	be clobbered).  Perform direct reuse analysis on those procedures,
	then repeat indirect reuse on the whole module so those new
	procedures might be called.

	Record intermodule requests when using `--intermodule-analysis'.

	Delete reuse versions of procedures we may have created, which after
	analysis turn out to have no reuse opportunities at all.

compiler/structure_reuse.lfu.m:
	Add a procedure that adds a set of variables to all the
	local-forward-use sets of a procedure.

compiler/structure_reuse.direct.m:
	Add code to perform direct reuse on a specific list of procedures
	instead of all the procedures in a module.

compiler/structure_reuse.indirect.m:
	Add code to re-run indirect reuse analysis which when analysing an
	SCC also analyses the reuse versions of procedures that were created
	from the procedures in the SCC.

	Remember and return intra- and inter-module requests when existing
	reuse procedures can't be called, for later passes and for later
	analyses of other modules.

	When looking up reuse information for a procedure, if we don't have
	that information we should take that assumed result is `optimal'.
	Otherwise, the analysis results of mutually recursive procedures will
	never get out of the `suboptimal' state.  (Other analyses make the
	same mistake.)

compiler/structure_reuse.domain.m:
	Extend the `reuse_as_table' with a mapping from an original
	(non-reuse) procedure plus call pattern to the procedure which
	actually implements that reuse.

	Make `reuse_as_satisfied' try to return all of the variables at a call
	site that violate the reuse conditions.  That is, instead of just
	giving one reason that a reuse procedure call can't be made, try to
	return all the reasons so we don't waste effort requesting laxer reuse
	procedures which wouldn't be lax enough for the call site anyway.

compiler/structure_reuse.versions.m:
	Account for multiple reuse versions of procedures.

compiler/prog_util.m:
	Use `make_pred_name' to make the names for reuse predicates.

compiler/hlds_goal.m:
compiler/hlds_out.m:
	Record in HLDS goals which reuse version of a procedure to call,
	since there can be multiple to choose from.

compiler/hlds_module.m:
compiler/trans_opt.m:
	Replace the `structure_reuse_map' field in the module structure by a
	simple set of pred_ids of reuse predicates.  The old map from
	procedures to their reuse counterparts is not needed outside of the
	structure reuse passes, which has the same information in a separate
	table anyway.

compiler/structure_sharing.analysis.m:
	Assume guessed structure sharing answers are `optimal' instead of
	`suboptimal', as above.

compiler/structure_reuse.direct.choose_reuse.m:
compiler/structure_reuse.direct.detect_garbage.m:
	Module import changes.


===================================================================

No speedtest yet as the analysis is too slow.  Here are some run times
for icfp2000 (--intermodule-analysis, asm_fast.gc).  The first float is
user time in seconds with CTGC enabled; the second is without CTGC.

dice:       1 - 7.41 / 7.78 = 0.05
golf:       1 - 0.95 / 1.05 = 0.09
mtest7:     1 - 2.40 / 2.70 = 0.11
snowgoon:   1 - 4.97 / 5.05 = 0.02

These memory calculations are based on GC_PRINT_STATS output as I
couldn't be bothered recompiling in .memprof.  The first number is total
allocated memory in bytes (up to the last GC) with CTGC; the second is
without CTGC.

dice:       1 - 1496674496 / 1726076880 = 0.133
golf:       1 -  227425536 /  276405008 = 0.177
mtest7:     1 -  558735136 /  733795728 = 0.239
snowgoon:   1 -  971669520 / 1026713552 = 0.054


Index: compiler/analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/analysis.m,v
retrieving revision 1.3
diff -u -p -r1.3 analysis.m
--- compiler/analysis.m	27 Mar 2008 02:29:40 -0000	1.3
+++ compiler/analysis.m	26 May 2008 01:34:09 -0000
@@ -241,7 +241,8 @@
 
 %-----------------------------------------------------------------------------%
 
-    % prepare_intermodule_analysis(ModuleNames, LocalModuleNames, !Info, !IO)
+    % prepare_intermodule_analysis(ThisModuleName, ModuleNames,
+    %   LocalModuleNames, !Info, !IO)
     %
     % This predicate should be called before any pass begins to use the
     % analysis framework.  It ensures that all the analysis files 
@@ -249,7 +250,7 @@
     % all modules that are directly or indirectly imported by the module being
     % analysed.  LocalModuleNames is the set of non-"library" modules.
     %
-:- pred prepare_intermodule_analysis(set(module_name)::in,
+:- pred prepare_intermodule_analysis(module_name::in, set(module_name)::in,
     set(module_name)::in, analysis_info::in, analysis_info::out,
     io::di, io::uo) is det.
 
@@ -295,7 +296,6 @@
 :- import_module libs.compiler_util.
 
 :- import_module map.
-:- import_module require.
 :- import_module string.
 :- import_module univ.
 
@@ -582,12 +582,17 @@ record_result_in_analysis_map(ModuleName
 %-----------------------------------------------------------------------------%
 
 lookup_requests(Info, AnalysisName, ModuleName, FuncId, CallPatterns) :-
-    map.lookup(Info ^ analysis_requests, ModuleName, ModuleRequests),
-    ( CallPatterns0 = ModuleRequests ^ elem(AnalysisName) ^ elem(FuncId) ->
-        CallPatterns = list.filter_map(
+    (
+        map.search(Info ^ analysis_requests, ModuleName, ModuleRequests),
+        CallPatterns0 = ModuleRequests ^ elem(AnalysisName) ^ elem(FuncId)
+    ->
+        CallPatterns1 = list.filter_map(
             (func(analysis_request(Call0)) = Call is semidet :-
                 univ(Call) = univ(Call0)
-            ), CallPatterns0)
+            ), CallPatterns0),
+        % Requests simply get appended to `.request' files so when we read them
+        % back in there may be duplicates.
+        list.sort_and_remove_dups(CallPatterns1, CallPatterns)
     ;
         CallPatterns = []
     ).
@@ -971,8 +976,15 @@ combine_imdg_lists(ArcsA, ArcsB, ArcsA +
 
 %-----------------------------------------------------------------------------%
 
-prepare_intermodule_analysis(ModuleNames, LocalModuleNames, !Info, !IO) :-
+prepare_intermodule_analysis(ThisModuleName, ModuleNames, LocalModuleNames,
+        !Info, !IO) :-
     set.fold2(ensure_analysis_files_loaded, ModuleNames, !Info, !IO),
+
+    % Read in requests for the module being analysed.
+    read_module_analysis_requests(!.Info, ThisModuleName, ThisModuleRequests,
+        !IO),
+    !Info ^ analysis_requests ^ elem(ThisModuleName) := ThisModuleRequests,
+
     !Info ^ local_module_names := LocalModuleNames.
 
 :- pred ensure_analysis_files_loaded(module_name::in,
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.190
diff -u -p -r1.190 hlds_goal.m
--- compiler/hlds_goal.m	28 Apr 2008 00:50:53 -0000	1.190
+++ compiler/hlds_goal.m	26 May 2008 01:34:10 -0000
@@ -1042,7 +1042,11 @@
                                 % Which of the fields of the cell to be
                                 % reused already contain the correct value.
             )
-    ;       reuse_call(is_conditional).
+    ;       reuse_call(
+                is_conditional,
+                list(int)       % Which arguments must not be clobbered;
+                                % determines the reuse version to call.
+            ).
 
     % Used to represent the fact whether a reuse opportunity is either
     % always safe (unconditional_reuse) or involves a reuse condition to
@@ -2497,7 +2501,7 @@ rename_vars_in_goal_info(Must, Subn, !Go
 rename_vars_in_short_reuse_desc(Must, Subn, ShortReuseDesc0, ShortReuseDesc) :-
     (
         ( ShortReuseDesc0 = cell_died
-        ; ShortReuseDesc0 = reuse_call(_)
+        ; ShortReuseDesc0 = reuse_call(_, _)
         ),
         ShortReuseDesc = ShortReuseDesc0
     ;
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.157
diff -u -p -r1.157 hlds_module.m
--- compiler/hlds_module.m	27 Feb 2008 07:23:06 -0000	1.157
+++ compiler/hlds_module.m	26 May 2008 01:34:10 -0000
@@ -204,12 +204,6 @@
     ;       complexity_input_fixed_size
     ;       complexity_output.
 
-    % This type is used to record the mapping between original procedures,
-    % and their optimised versions with respect to structure reuse (CTGC).
-    %
-:- type structure_reuse_map ==
-    map(pred_proc_id, pair(pred_proc_id, sym_name)).
-
 %-----------------------------------------------------------------------------%
 %
 % Types for foreign exported enumerations
@@ -511,10 +505,10 @@
 :- pred module_info_user_final_pred_procs(module_info::in,
     list(pred_proc_id)::out) is det.
 
-:- pred module_info_get_structure_reuse_map(module_info::in,
-    structure_reuse_map::out) is det.
+:- pred module_info_get_structure_reuse_preds(module_info::in,
+    set(pred_id)::out) is det.
 
-:- pred module_info_set_structure_reuse_map(structure_reuse_map::in,
+:- pred module_info_set_structure_reuse_preds(set(pred_id)::in,
     module_info::in, module_info::out) is det.
 
 :- pred module_info_get_used_modules(module_info::in,
@@ -814,8 +808,10 @@
                 user_final_pred_c_names     :: assoc_list(sym_name_and_arity,
                                                 string),
 
-                % Information about which procedures implement structure reuse.
-                structure_reuse_map         :: structure_reuse_map,
+                % Predicates which were created as reuse versions of other
+                % procedures.  Its only use is to avoid writing out pragmas
+                % for structure reuse predicates to `.trans_opt' files.
+                structure_reuse_preds       :: set(pred_id),
 
                 % The modules which have already been calculated as being used.
                 % Currently this is the module imports inherited from the
@@ -876,7 +872,7 @@ module_info_init(Name, Items, Globals, Q
     AnalysisInfo = init_analysis_info(mmc),
     UserInitPredCNames = [],
     UserFinalPredCNames = [],
-    map.init(StructureReuseMap),
+    set.init(StructureReusePredIds),
     UsedModules = used_modules_init,
     set.init(InterfaceModuleSpecs),
     ExportedEnums = [],
@@ -893,7 +889,7 @@ module_info_init(Name, Items, Globals, Q
         IndirectlyImportedModules, TypeSpecInfo, NoTagTypes,
         MaybeComplexityMap, ComplexityProcInfos,
         AnalysisInfo, UserInitPredCNames, UserFinalPredCNames,
-        StructureReuseMap, UsedModules, InterfaceModuleSpecs,
+        StructureReusePredIds, UsedModules, InterfaceModuleSpecs,
         ExportedEnums, EventSet),
 
     predicate_table_init(PredicateTable),
@@ -999,7 +995,8 @@ module_info_get_maybe_complexity_proc_ma
     MI ^ sub_info ^ maybe_complexity_proc_map).
 module_info_get_complexity_proc_infos(MI,
     MI ^ sub_info ^ complexity_proc_infos).
-module_info_get_structure_reuse_map(MI, MI ^ sub_info ^ structure_reuse_map).
+module_info_get_structure_reuse_preds(MI,
+    MI ^ sub_info ^ structure_reuse_preds).
 module_info_get_used_modules(MI, MI ^ sub_info ^ used_modules).
 module_info_get_interface_module_specifiers(MI,
     MI ^ sub_info ^ interface_module_specifiers).
@@ -1148,8 +1145,8 @@ module_info_set_maybe_complexity_proc_ma
     MI ^ sub_info ^ maybe_complexity_proc_map := NewVal).
 module_info_set_complexity_proc_infos(NewVal, MI,
     MI ^ sub_info ^ complexity_proc_infos := NewVal).
-module_info_set_structure_reuse_map(ReuseMap, MI,
-    MI ^ sub_info ^ structure_reuse_map := ReuseMap).
+module_info_set_structure_reuse_preds(ReusePreds, MI,
+    MI ^ sub_info ^ structure_reuse_preds := ReusePreds).
 module_info_set_used_modules(UsedModules, MI,
     MI ^ sub_info ^ used_modules := UsedModules).
 module_info_set_event_set(EventSet, MI, MI ^ sub_info ^ event_set := EventSet).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.450
diff -u -p -r1.450 hlds_out.m
--- compiler/hlds_out.m	7 May 2008 05:05:51 -0000	1.450
+++ compiler/hlds_out.m	26 May 2008 01:34:10 -0000
@@ -4756,9 +4756,11 @@ write_short_reuse_description(ShortDescr
         io.write_string(" - ", !IO), 
         write_is_conditional(IsConditional, !IO)
     ;
-        ShortDescription = reuse_call(IsConditional),
+        ShortDescription = reuse_call(IsConditional, NoClobbers),
         io.write_string("reuse call - ", !IO), 
-        write_is_conditional(IsConditional, !IO)
+        write_is_conditional(IsConditional, !IO),
+        io.write_string(", no clobbers = ", !IO),
+        io.write(NoClobbers, !IO)
     ).
 
 :- pred write_is_conditional(is_conditional::in, io::di, io::uo) is det.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.469
diff -u -p -r1.469 mercury_compile.m
--- compiler/mercury_compile.m	1 May 2008 02:35:10 -0000	1.469
+++ compiler/mercury_compile.m	26 May 2008 01:34:11 -0000
@@ -1570,8 +1570,8 @@ prepare_intermodule_analysis(!HLDS, !IO)
     LocalModuleNames = set.from_list(SymNames),
 
     module_info_get_analysis_info(!.HLDS, AnalysisInfo0),
-    analysis.prepare_intermodule_analysis(ModuleNames, LocalModuleNames,
-        AnalysisInfo0, AnalysisInfo, !IO),
+    analysis.prepare_intermodule_analysis(ThisModuleName, ModuleNames,
+        LocalModuleNames, AnalysisInfo0, AnalysisInfo, !IO),
     module_info_set_analysis_info(AnalysisInfo, !HLDS).
 
 :- pred mercury_compile_after_front_end(list(module_name)::in,
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.616
diff -u -p -r1.616 options.m
--- compiler/options.m	16 May 2008 08:10:51 -0000	1.616
+++ compiler/options.m	26 May 2008 01:34:12 -0000
@@ -612,6 +612,7 @@
     ;       structure_reuse_analysis
     ;           structure_reuse_constraint
     ;           structure_reuse_constraint_arg
+    ;           structure_reuse_repeat
 
     % Stuff for the old termination analyser.
     ;       termination
@@ -1312,6 +1313,7 @@ option_defaults_2(special_optimization_o
     structure_reuse_analysis            -   bool(no), 
     structure_reuse_constraint        -   string("within_n_cells_difference"),
     structure_reuse_constraint_arg      -   int(0),
+    structure_reuse_repeat              -   int(0),
     termination                         -   bool(no),
     termination_single_args             -   int(0),
     termination_norm                    -   string("total"),
@@ -2252,6 +2254,7 @@ long_option("structure-reuse-constraint"
 long_option("ctgc-constraint",      structure_reuse_constraint).
 long_option("structure-reuse-constraint-arg", structure_reuse_constraint_arg).
 long_option("ctgc-constraint-arg",  structure_reuse_constraint_arg).
+long_option("structure-reuse-repeat", structure_reuse_repeat).
 
 % HLDS->LLDS optimizations
 long_option("smart-indexing",       smart_indexing).
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.104
diff -u -p -r1.104 prog_util.m
--- compiler/prog_util.m	3 Apr 2008 05:26:45 -0000	1.104
+++ compiler/prog_util.m	26 May 2008 01:34:12 -0000
@@ -150,6 +150,8 @@
     ;       newpred_type_subst(tvarset, type_subst)
     ;       newpred_unused_args(list(int))
     ;       newpred_parallel_args(list(int))
+    ;       newpred_structure_reuse(int, list(int))     % Mode, no-clobber
+                                                        % arguments.
     ;       newpred_distance_granularity(int).          % Distance
 
 %-----------------------------------------------------------------------------%
@@ -615,11 +617,15 @@ make_pred_name(ModuleName, Prefix, Maybe
         ),
         list_to_string(SubstToString, TypeSubst, PredIdStr)
     ;
-        NewPredId = newpred_unused_args(Args),
+        ( NewPredId = newpred_unused_args(Args)
+        ; NewPredId = newpred_parallel_args(Args)
+        ),
         list_to_string(int_to_string, Args, PredIdStr)
     ;
-        NewPredId = newpred_parallel_args(Args),
-        list_to_string(int_to_string, Args, PredIdStr)
+        NewPredId = newpred_structure_reuse(ModeNum, Args),
+        int_to_string(ModeNum, ModeStr),
+        list_to_string(int_to_string, Args, ArgsStr),
+        PredIdStr = ModeStr ++ "__" ++ ArgsStr
     ;
         NewPredId = newpred_distance_granularity(Distance),
         int_to_string(Distance, PredIdStr)
Index: compiler/structure_reuse.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.analysis.m,v
retrieving revision 1.13
diff -u -p -r1.13 structure_reuse.analysis.m
--- compiler/structure_reuse.analysis.m	12 May 2008 01:37:05 -0000	1.13
+++ compiler/structure_reuse.analysis.m	26 May 2008 01:34:13 -0000
@@ -7,7 +7,7 @@
 %-----------------------------------------------------------------------------%
 %
 % File: structure_reuse.analysis.m.
-% Main authors: nancy.
+% Main authors: nancy, wangp.
 %
 % Implementation of the structure reuse analysis (compile-time garbage
 % collection system): each procedure is analysed to see whether some
@@ -94,6 +94,7 @@
 
 :- import_module check_hlds.goal_path.
 :- import_module hlds.passes_aux.
+:- import_module hlds.pred_table.
 :- import_module libs.compiler_util.
 :- import_module libs.globals.
 :- import_module libs.options.
@@ -115,10 +116,10 @@
 :- import_module transform_hlds.mmc_analysis.
 
 :- import_module bool.
+:- import_module int.
 :- import_module list.
 :- import_module map.
 :- import_module maybe.
-:- import_module pair.
 :- import_module set.
 :- import_module string.
 :- import_module svmap.
@@ -128,61 +129,100 @@
 structure_reuse_analysis(!ModuleInfo, !IO):- 
     globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
 
+    % Load all available structure sharing information into a sharing table.
+    SharingTable = load_structure_sharing_table(!.ModuleInfo),
+
     % Process all imported reuse information.
     globals.io_lookup_bool_option(intermodule_analysis, IntermodAnalysis, !IO),
     (
         IntermodAnalysis = yes,
-        process_intermod_analysis_imported_reuse(!ModuleInfo)
+        % Load structure reuse answers from the analysis registry into a reuse
+        % table.  Add procedures to the module as necessary.  Look up the
+        % requests made for procedures in this module by other modules.
+        process_intermod_analysis_reuse(!ModuleInfo, ReuseTable0,
+            ExternalRequests)
     ;
         IntermodAnalysis = no,
-        process_imported_reuse(!ModuleInfo)
+        % Convert imported structure reuse information into structure reuse
+        % information, then load the available reuse information into a reuse
+        % table.
+        %
+        % There is no way to request specific reuse versions of procedures
+        % across module boundaries using the old intermodule optimisation
+        % system.
+        process_imported_reuse(!ModuleInfo),
+        ReuseTable0 = load_structure_reuse_table(!.ModuleInfo),
+        ExternalRequests = []
     ),
 
-    % Load all available structure sharing information into a sharing table.
-    SharingTable = load_structure_sharing_table(!.ModuleInfo),
+    some [!ReuseTable] (
+        !:ReuseTable = ReuseTable0,
+
+        % Pre-annotate each of the goals with "Local Forward Use" and
+        % "Local Backward Use" information, and fill in all the goal_path slots
+        % as well. 
+        maybe_write_string(VeryVerbose, "% Annotating in use information...",
+            !IO), 
+        process_all_nonimported_procs(
+            update_proc_io(annotate_in_use_information),
+            !ModuleInfo, !IO),
+        maybe_write_string(VeryVerbose, "done.\n", !IO),
+
+        % Create copies of externally requested procedures.  This must be done
+        % after the in-use annotations have been added to the procedures being
+        % copied.
+        list.map_foldl2(make_intermediate_reuse_proc, ExternalRequests,
+            _NewPPIds, !ReuseTable, !ModuleInfo),
+
+        % Determine information about possible direct reuses.
+        maybe_write_string(VeryVerbose, "% Direct reuse...\n", !IO), 
+        direct_reuse_pass(SharingTable, !ModuleInfo, !ReuseTable, !IO),
+        maybe_write_string(VeryVerbose, "% Direct reuse: done.\n", !IO),
+        reuse_as_table_maybe_dump(VeryVerbose, !.ModuleInfo, !.ReuseTable,
+            !IO),
+
+        % Determine information about possible indirect reuses.
+        maybe_write_string(VeryVerbose, "% Indirect reuse...\n", !IO), 
+        indirect_reuse_pass(SharingTable, !ModuleInfo, !ReuseTable, DepProcs0,
+            InternalRequests, IntermodRequests0),
+        maybe_write_string(VeryVerbose, "% Indirect reuse: done.\n", !IO),
+        reuse_as_table_maybe_dump(VeryVerbose, !.ModuleInfo, !.ReuseTable,
+            !IO),
+
+        % Handle requests for "intermediate" reuse versions of procedures
+        % and repeat the analyses.
+        globals.io_lookup_int_option(structure_reuse_repeat, Repeats, !IO),
+        handle_structure_reuse_requests(Repeats, SharingTable, InternalRequests,
+            !ReuseTable, !ModuleInfo, DepProcs0, DepProcs,
+            IntermodRequests0, IntermodRequests, !IO),
+
+        % Create reuse versions of procedures.  Update goals to reuse cells and
+        % call reuse versions of procedures.
+        create_reuse_procedures(!ReuseTable, !ModuleInfo),
+
+        ReuseTable = !.ReuseTable
+    ),
 
-    % Load all the available reuse information into a reuse table.
-    ReuseTable0 = load_structure_reuse_table(!.ModuleInfo), 
-    InitialReuseTable = ReuseTable0,
-   
-    % Pre-annotate each of the goals with "Local Forward Use" and
-    % "Local Backward Use" information, and fill in all the goal_path slots
-    % as well. 
-
-    maybe_write_string(VeryVerbose, "% Annotating in use information...", !IO), 
-    process_all_nonimported_procs(update_proc_io(annotate_in_use_information),
-         !ModuleInfo, !IO),
-    maybe_write_string(VeryVerbose, "done.\n", !IO),
-
-    % Determine information about possible direct reuses.
-    maybe_write_string(VeryVerbose, "% Direct reuse...\n", !IO), 
-    direct_reuse_pass(SharingTable, !ModuleInfo, ReuseTable0, ReuseTable1, !IO),
-    maybe_write_string(VeryVerbose, "% Direct reuse: done.\n", !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, 
-       DepProcs, !IO), 
-    maybe_write_string(VeryVerbose, "% Indirect reuse: done.\n", !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
-    % that reuse. 
-    create_reuse_procedures(ReuseTable2, !ModuleInfo, !IO),
-    FinalReuseTable = ReuseTable2,
-
-    % Create forwarding procedures for procedures which we thought had
-    % conditional reuse when making the `.opt' file, but with further
-    % information (say, from `.trans_opt' files) we decide has no reuse
-    % opportunities. Otherwise other modules may contain references to
-    % reuse versions of procedures which we never produce.
-    create_forwarding_procedures(InitialReuseTable, FinalReuseTable,
-        !ModuleInfo),
+    (
+        IntermodAnalysis = no,
+        % Create forwarding procedures for procedures which we thought had
+        % conditional reuse when making the `.opt' file, but with further
+        % information (say, from `.trans_opt' files) we decide has no reuse
+        % opportunities. Otherwise other modules may contain references to
+        % reuse versions of procedures which we never produce.
+        create_forwarding_procedures(ReuseTable0, ReuseTable, !ModuleInfo)
+    ;
+        IntermodAnalysis = yes
+        % We don't need to do anything here as we will have created procedures
+        % corresponding to existing structure reuse answers already.
+    ),
+
+    ReuseTable = reuse_as_table(ReuseInfoMap, ReuseVersionMap),
 
     % Record the results of the reuse table into the HLDS.
-    map.foldl(save_reuse_in_module_info, ReuseTable2, !ModuleInfo),
+    % This is mainly to show the reuse information in HLDS dumps as no later
+    % passes need the information.
+    map.foldl(save_reuse_in_module_info, ReuseInfoMap, !ModuleInfo),
 
     % Only write structure reuse pragmas to `.opt' files for
     % `--intermodule-optimization' not `--intermodule-analysis'.
@@ -197,7 +237,7 @@ structure_reuse_analysis(!ModuleInfo, !I
         true
     ),
 
-    % If making a `.analysis' file, record structure sharing results, analysis
+    % If making a `.analysis' file, record structure reuse results, analysis
     % dependencies, assumed answers and requests in the analysis framework.
     globals.io_lookup_bool_option(make_analysis_registry, MakeAnalysisRegistry,
         !IO),
@@ -205,19 +245,135 @@ structure_reuse_analysis(!ModuleInfo, !I
         MakeAnalysisRegistry = yes,
         some [!AnalysisInfo] (
             module_info_get_analysis_info(!.ModuleInfo, !:AnalysisInfo),
-            map.foldl(record_structure_reuse_results(!.ModuleInfo),
-                ReuseTable2, !AnalysisInfo),
-            list.foldl(handle_dep_procs(!.ModuleInfo), DepProcs,
-                !AnalysisInfo),
+            CondReuseRevMap = map.reverse_map(ReuseVersionMap),
+            map.foldl(
+                record_structure_reuse_results(!.ModuleInfo, CondReuseRevMap),
+                ReuseInfoMap, !AnalysisInfo),
+            set.fold(handle_structure_reuse_dependency(!.ModuleInfo),
+                DepProcs, !AnalysisInfo),
+            set.fold(record_intermod_requests(!.ModuleInfo),
+                IntermodRequests, !AnalysisInfo),
             module_info_set_analysis_info(!.AnalysisInfo, !ModuleInfo)
         )
     ;
         MakeAnalysisRegistry = no
+    ),
+
+    % Delete the reuse versions of procedures which turn out to have no reuse.
+    % Nothing should be calling them but dead procedure elimination won't
+    % remove them if they were created from exported procedures (so would be
+    % exported themselves). 
+    module_info_get_predicate_table(!.ModuleInfo, PredTable0),
+    map.foldl(remove_useless_reuse_proc(ReuseInfoMap), ReuseVersionMap,
+        PredTable0, PredTable),
+    module_info_set_predicate_table(PredTable, !ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+
+    % Create intermediate reuse versions of procedures according to the
+    % requests from indirect reuse analysis.  We perform direct reuse
+    % analyses on the newly created procedures, then repeat indirect reuse
+    % analysis on all procedures in the module so that calls to the new
+    % procedures can be made.  This may create new requests.
+    %
+    % XXX this is temporary only; we shouldn't be redoing so much work.
+    %
+:- pred handle_structure_reuse_requests(int::in, sharing_as_table::in,
+    set(sr_request)::in, reuse_as_table::in, reuse_as_table::out,
+    module_info::in, module_info::out,
+    set(ppid_no_clobbers)::in, set(ppid_no_clobbers)::out,
+    set(sr_request)::in, set(sr_request)::out, io::di, io::uo) is det.
+
+handle_structure_reuse_requests(Repeats, SharingTable, Requests,
+        !ReuseTable, !ModuleInfo, !DepProcs, !IntermodRequests, !IO) :-
+    ( Repeats > 0 ->
+        handle_structure_reuse_requests_2(Repeats, SharingTable, Requests,
+            !ReuseTable, !ModuleInfo, !DepProcs, !IntermodRequests, !IO)
+    ;
+        true
     ).
 
-    % Output some profiling information.
-    % XXX TO DO!
-    % profiling(!.ModuleInfo, ReuseTable3).
+:- pred handle_structure_reuse_requests_2(int::in, sharing_as_table::in,
+    set(sr_request)::in, reuse_as_table::in, reuse_as_table::out,
+    module_info::in, module_info::out,
+    set(ppid_no_clobbers)::in, set(ppid_no_clobbers)::out,
+    set(sr_request)::in, set(sr_request)::out, io::di, io::uo) is det.
+
+handle_structure_reuse_requests_2(Repeats, SharingTable, Requests,
+        !ReuseTable, !ModuleInfo, !DepProcs, !IntermodRequests, !IO) :-
+    io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+
+    % Create copies of the requested procedures.
+    RequestList = set.to_sorted_list(Requests),
+    list.map_foldl2(make_intermediate_reuse_proc, RequestList, NewPPIds,
+        !ReuseTable, !ModuleInfo),
+
+    % Perform direct reuse analysis on the new procedures.
+    maybe_write_string(VeryVerbose, "% Repeating direct reuse...\n", !IO),
+    direct_reuse_process_specific_procs(SharingTable, NewPPIds,
+        !ModuleInfo, !ReuseTable, !IO),
+    maybe_write_string(VeryVerbose, "% done.\n", !IO),
+
+    % Rerun indirect reuse analysis on all procedures.
+    %
+    % XXX goals which already have reuse annotations don't need to be
+    % reanalysed.  For old procedures (not the ones just created) we actually
+    % only need to check that calls which previously had no reuse opportunity
+    % might be able to call the new procedures.
+    maybe_write_string(VeryVerbose, "% Repeating indirect reuse...\n", !IO),
+    indirect_reuse_rerun(SharingTable, !ModuleInfo, !ReuseTable,
+        NewDepProcs, NewRequests, !IntermodRequests),
+    !:DepProcs = set.union(NewDepProcs, !.DepProcs),
+    maybe_write_string(VeryVerbose, "% done.\n", !IO),
+
+    ( set.empty(NewRequests) ->
+        maybe_write_string(VeryVerbose,
+            "% No more structure reuse requests.\n", !IO)
+    ;
+        maybe_write_string(VeryVerbose,
+            "% Outstanding structure reuse requests exist.\n", !IO),
+        handle_structure_reuse_requests(Repeats - 1, SharingTable, NewRequests,
+            !ReuseTable, !ModuleInfo, !DepProcs, !IntermodRequests, !IO)
+    ).
+
+    % Create a new copy of a procedure to satisfy an intermediate reuse
+    % request, i.e. some of its arguments are prevented from being reused.
+    %
+    % The goal of the original procedure must already be annotated with in-use
+    % sets.  For the new procedure, we simply add the head variables at the
+    % no-clobber argument positions to the forward-use set of each goal.
+    % We also remove any existing reuse annotations on the goals.
+    %
+:- pred make_intermediate_reuse_proc(sr_request::in, pred_proc_id::out,
+    reuse_as_table::in, reuse_as_table::out, module_info::in, module_info::out)
+    is det.
+
+make_intermediate_reuse_proc(sr_request(PPId, NoClobbers), NewPPId,
+        !ReuseTable, !ModuleInfo) :-
+    create_fresh_pred_proc_info_copy(PPId, NoClobbers, NewPPId, !ModuleInfo),
+
+    module_info_pred_proc_info(!.ModuleInfo, NewPPId, PredInfo, ProcInfo0),
+    proc_info_get_headvars(ProcInfo0, HeadVars),
+    get_numbered_args(1, NoClobbers, HeadVars, NoClobberVars),
+    add_vars_to_lfu(set.from_list(NoClobberVars), ProcInfo0, ProcInfo),
+    module_info_set_pred_proc_info(NewPPId, PredInfo, ProcInfo, !ModuleInfo),
+
+    reuse_as_table_insert_reuse_version_proc(PPId, NoClobbers, NewPPId,
+        !ReuseTable).
+
+:- pred get_numbered_args(int::in, list(int)::in, prog_vars::in,
+    prog_vars::out) is det.
+
+get_numbered_args(_, [], _, []).
+get_numbered_args(_, [_ | _], [], _) :-
+    unexpected(this_file, "get_numbered_args: argument list too short").
+get_numbered_args(I, [N | Ns], [Var | Vars], Selected) :-
+    ( I = N ->
+        get_numbered_args(I + 1, Ns, Vars, Selected0),
+        Selected = [Var | Selected0]
+    ;
+        get_numbered_args(I + 1, [N | Ns], Vars, Selected)
+    ).
 
 %-----------------------------------------------------------------------------%
 
@@ -227,7 +383,7 @@ structure_reuse_analysis(!ModuleInfo, !I
 create_forwarding_procedures(InitialReuseTable, FinalReuseTable,
         !ModuleInfo) :-
     map.foldl(create_forwarding_procedures_2(FinalReuseTable),
-        InitialReuseTable, !ModuleInfo).
+        InitialReuseTable ^ reuse_info_map, !ModuleInfo).
 
 :- pred create_forwarding_procedures_2(reuse_as_table::in, pred_proc_id::in,
     reuse_as_and_status::in, module_info::in, module_info::out) is det.
@@ -240,18 +396,19 @@ create_forwarding_procedures_2(FinalReus
     (
         reuse_as_conditional_reuses(InitialReuseAs),
         status_defined_in_this_module(ImportStatus) = yes,
-        map.search(FinalReuseTable, PPId, FinalReuseAs_Status),
+        reuse_as_table_search(FinalReuseTable, PPId, FinalReuseAs_Status),
         FinalReuseAs_Status = reuse_as_and_status(FinalReuseAs, _),
         reuse_as_no_reuses(FinalReuseAs)
     ->
-        create_fake_reuse_procedure(PPId, !ModuleInfo)
+        NoClobbers = [],
+        create_fake_reuse_procedure(PPId, NoClobbers, !ModuleInfo)
     ;
         true
     ).
 
 %-----------------------------------------------------------------------------%
 
-    % Process all the reuse annotation from imported predicates.
+    % Process the imported reuse annotations from .opt files.
     %
 :- pred process_imported_reuse(module_info::in, module_info::out) is det.
 
@@ -322,77 +479,90 @@ process_imported_reuse_in_proc(PredInfo,
 
 %-----------------------------------------------------------------------------%
 
-    % Process the intermodule imported sharing information from the analysis
-    % framework
+    % Process the intermodule imported reuse information from the analysis
+    % framework.
     %
-:- pred process_intermod_analysis_imported_reuse(module_info::in,
-    module_info::out) is det.
+:- pred process_intermod_analysis_reuse(module_info::in, module_info::out,
+    reuse_as_table::out, list(sr_request)::out) is det.
 
-process_intermod_analysis_imported_reuse(!ModuleInfo):-
+process_intermod_analysis_reuse(!ModuleInfo, ReuseTable, ExternalRequests) :-
     module_info_predids(PredIds, !ModuleInfo), 
-    list.foldl(process_intermod_analysis_imported_reuse_in_pred, PredIds,
-        !ModuleInfo).
-
-:- pred process_intermod_analysis_imported_reuse_in_pred(pred_id::in,
-    module_info::in, module_info::out) is det.
+    list.foldl3(process_intermod_analysis_reuse_pred, PredIds,
+        !ModuleInfo, reuse_as_table_init, ReuseTable, [], ExternalRequests0),
+    list.sort_and_remove_dups(ExternalRequests0, ExternalRequests).
+
+:- pred process_intermod_analysis_reuse_pred(pred_id::in,
+    module_info::in, module_info::out, reuse_as_table::in, reuse_as_table::out,
+    list(sr_request)::in, list(sr_request)::out) is det.
 
-process_intermod_analysis_imported_reuse_in_pred(PredId, !ModuleInfo) :- 
-    some [!PredTable] (
-        module_info_preds(!.ModuleInfo, !:PredTable), 
-        PredInfo0 = !.PredTable ^ det_elem(PredId), 
-        pred_info_get_import_status(PredInfo0, ImportStatus),
-        ( ImportStatus = status_imported(_) ->
-            module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo),
-            process_intermod_analysis_imported_reuse_in_procs(!.ModuleInfo,
-                AnalysisInfo, PredId, PredInfo0, PredInfo),
-            svmap.det_update(PredId, PredInfo, !PredTable),
-            module_info_set_preds(!.PredTable, !ModuleInfo)
-        ;
-            true
-        )
-    ).
-
-:- pred process_intermod_analysis_imported_reuse_in_procs(module_info::in,
-    analysis_info::in, pred_id::in, pred_info::in, pred_info::out) is det.
-
-process_intermod_analysis_imported_reuse_in_procs(ModuleInfo, AnalysisInfo,
-        PredId, !PredInfo) :- 
-    some [!ProcTable] (
-        pred_info_get_procedures(!.PredInfo, !:ProcTable), 
-        ProcIds = pred_info_procids(!.PredInfo), 
+process_intermod_analysis_reuse_pred(PredId, !ModuleInfo, !ReuseTable,
+        !ExternalRequests) :- 
+    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+    pred_info_get_import_status(PredInfo, ImportStatus),
+    ProcIds = pred_info_procids(PredInfo), 
+    (
+        ImportStatus = status_imported(_)
+    ->
+        % Read in answers for imported procedures.
+        list.foldl2(process_intermod_analysis_reuse_proc(PredId, PredInfo),
+            ProcIds, !ModuleInfo, !ReuseTable)
+    ;
+        status_defined_in_this_module(ImportStatus) = yes
+    ->
+        % For procedures defined in this module we need to read in the answers
+        % from previous passes to know which versions of procedures other
+        % modules will be expecting.  We also need to read in new requests.
         list.foldl(
-            process_intermod_analysis_imported_reuse_in_proc(ModuleInfo,
-                AnalysisInfo, PredId, !.PredInfo), 
-            ProcIds, !ProcTable),
-        pred_info_set_procedures(!.ProcTable, !PredInfo)
+            process_intermod_analysis_defined_proc(!.ModuleInfo, PredId),
+            ProcIds, !ExternalRequests)
+    ;
+        true
     ).
 
-:- pred process_intermod_analysis_imported_reuse_in_proc(module_info::in,
-    analysis_info::in, pred_id::in, pred_info::in, proc_id::in,
-    proc_table::in, proc_table::out) is det.
+:- pred process_intermod_analysis_reuse_proc(pred_id::in,
+    pred_info::in, proc_id::in, module_info::in, module_info::out,
+    reuse_as_table::in, reuse_as_table::out) is det.
 
-process_intermod_analysis_imported_reuse_in_proc(ModuleInfo, AnalysisInfo,
-        PredId, PredInfo, ProcId, !ProcTable) :- 
+process_intermod_analysis_reuse_proc(PredId, PredInfo, ProcId,
+        !ModuleInfo, !ReuseTable) :-
     PPId = proc(PredId, ProcId),
-    some [!ProcInfo] (
-        !:ProcInfo = !.ProcTable ^ det_elem(ProcId), 
+    module_info_get_analysis_info(!.ModuleInfo, AnalysisInfo),
+    module_name_func_id(!.ModuleInfo, PPId, ModuleName, FuncId),
+    pred_info_proc_info(PredInfo, ProcId, ProcInfo),
+    lookup_results(AnalysisInfo, ModuleName, FuncId, ImportedResults),
+    list.foldl2(
+        process_intermod_analysis_imported_reuse_answer(PPId, PredInfo,
+            ProcInfo),
+        ImportedResults, !ModuleInfo, !ReuseTable).
+
+:- pred process_intermod_analysis_imported_reuse_answer(pred_proc_id::in,
+    pred_info::in, proc_info::in,
+    analysis_result(structure_reuse_call, structure_reuse_answer)::in,
+    module_info::in, module_info::out, reuse_as_table::in, reuse_as_table::out)
+    is det.
 
-        module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
-        FuncInfo = structure_reuse_func_info(ModuleInfo, !.ProcInfo),
-        lookup_best_result(AnalysisInfo, ModuleName, FuncId, FuncInfo,
-            structure_reuse_call, MaybeBestResult),
-        (
-            MaybeBestResult = yes(analysis_result(_Call, Answer,
-                ResultStatus)),
-            structure_reuse_answer_to_domain(PredInfo, !.ProcInfo, Answer,
-                Reuse),
-            proc_info_set_structure_reuse(
-                structure_reuse_domain_and_status(Reuse, ResultStatus),
-                !ProcInfo),
-            svmap.det_update(ProcId, !.ProcInfo, !ProcTable)
-        ;
-            MaybeBestResult = no
-        )
+process_intermod_analysis_imported_reuse_answer(PPId, PredInfo, ProcInfo,
+        ImportedResult, !ModuleInfo, !ReuseTable) :-
+    ImportedResult = analysis_result(Call, Answer, ResultStatus),
+    Call = structure_reuse_call(NoClobbers),
+    structure_reuse_answer_to_domain(PredInfo, ProcInfo, Answer, Domain),
+    ReuseAs = from_structure_reuse_domain(Domain),
+    ReuseAs_Status = reuse_as_and_status(ReuseAs, ResultStatus),
+    (
+        NoClobbers = [],
+        % When the no-clobber list is empty we store the information with the
+        % original pred_proc_id.
+        reuse_as_table_set(PPId, ReuseAs_Status, !ReuseTable)
+    ;
+        NoClobbers = [_ | _],
+        % When the no-clobber list is non-empty we need to create a new
+        % procedure stub and add a mapping to from the original pred_proc_id to
+        % the stub.
+        create_fresh_pred_proc_info_copy(PPId, NoClobbers, NewPPId,
+            !ModuleInfo),
+        reuse_as_table_set(NewPPId, ReuseAs_Status, !ReuseTable),
+        reuse_as_table_insert_reuse_version_proc(PPId, NoClobbers, NewPPId,
+            !ReuseTable)
     ).
 
 :- pred structure_reuse_answer_to_domain(pred_info::in,
@@ -422,25 +592,51 @@ structure_reuse_answer_to_domain(PredInf
         )
     ).
 
-%-----------------------------------------------------------------------------%
+:- pred process_intermod_analysis_defined_proc(module_info::in, pred_id::in,
+    proc_id::in, list(sr_request)::in, list(sr_request)::out) is det.
 
-:- pred save_reuse_in_module_info(pred_proc_id::in, reuse_as_and_status::in,
-    module_info::in, module_info::out) is det.
+process_intermod_analysis_defined_proc(ModuleInfo, PredId, ProcId,
+        !ExternalRequests) :-
+    PPId = proc(PredId, ProcId),
+    module_info_get_analysis_info(ModuleInfo, AnalysisInfo),
+    module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
 
-save_reuse_in_module_info(PPId, ReuseAs_Status, !ModuleInfo) :- 
-    save_reuse_in_module_info_2(PPId, ReuseAs_Status, !ModuleInfo), 
-    module_info_get_structure_reuse_map(!.ModuleInfo, ReuseMap), 
-    ( map.search(ReuseMap, PPId, Result) -> 
-        Result = ReusePPId - _Name, 
-        save_reuse_in_module_info_2(ReusePPId, ReuseAs_Status, !ModuleInfo)
+    % Add requests corresponding to the call patterns of existing answers.
+    lookup_results(AnalysisInfo, ModuleName, FuncId,
+        Results : list(analysis_result(structure_reuse_call, _))),
+    list.foldl(add_reuse_request_for_answer(PPId), Results, !ExternalRequests),
+
+    % Add new requests from other modules.
+    lookup_requests(AnalysisInfo, analysis_name, ModuleName, FuncId, Calls),
+    list.foldl(add_reuse_request(PPId), Calls, !ExternalRequests).
+
+:- pred add_reuse_request_for_answer(pred_proc_id::in,
+    analysis_result(structure_reuse_call, structure_reuse_answer)::in,
+    list(sr_request)::in, list(sr_request)::out) is det.
+
+add_reuse_request_for_answer(PPId, Result, !ExternalRequests) :-
+    add_reuse_request(PPId, Result ^ ar_call, !ExternalRequests).
+
+:- pred add_reuse_request(pred_proc_id::in, structure_reuse_call::in,
+    list(sr_request)::in, list(sr_request)::out) is det.
+
+add_reuse_request(PPId, structure_reuse_call(NoClobbers), !Requests) :-
+    (
+        NoClobbers = []
+        % We don't need to add these as explicit requests, and in fact it's
+        % better if we don't.  The analysis is already designed to analyse for
+        % this case by default and create the reuse procedures if necessary.
     ;
-        true
+        NoClobbers = [_ | _],
+        !:Requests = [sr_request(PPId, NoClobbers) | !.Requests]
     ).
 
-:- pred save_reuse_in_module_info_2(pred_proc_id::in, reuse_as_and_status::in,
+%-----------------------------------------------------------------------------%
+
+:- pred save_reuse_in_module_info(pred_proc_id::in, reuse_as_and_status::in,
     module_info::in, module_info::out) is det.
 
-save_reuse_in_module_info_2(PPId, ReuseAs_Status, !ModuleInfo) :- 
+save_reuse_in_module_info(PPId, ReuseAs_Status, !ModuleInfo) :- 
     ReuseAs_Status = reuse_as_and_status(ReuseAs, Status),
     ReuseDomain = to_structure_reuse_domain(ReuseAs),
     Domain_Status = structure_reuse_domain_and_status(ReuseDomain, Status),
@@ -546,8 +742,7 @@ write_proc_reuse_info(ModuleInfo, PredId
 %
 
 :- type structure_reuse_call
-    --->    structure_reuse_call.
-            % Eventually we should have different call patterns.
+    --->    structure_reuse_call(no_clobber_args).
 
 :- type structure_reuse_answer
     --->    structure_reuse_answer_no_reuse
@@ -572,7 +767,7 @@ analysis_name = "structure_reuse".
     structure_reuse_answer) where
 [
     analysis_name(_, _) = analysis_name,
-    analysis_version_number(_, _) = 1,
+    analysis_version_number(_, _) = 2,
     preferred_fixpoint_type(_, _) = greatest_fixpoint,
     bottom(_, _) = structure_reuse_answer_no_reuse,
     ( top(_, _) = _ :-
@@ -591,15 +786,23 @@ analysis_name = "structure_reuse".
 
 :- instance partial_order(structure_reuse_func_info, structure_reuse_call)
         where [
-    (more_precise_than(_, _, _) :-
-        semidet_fail
+    (more_precise_than(_, Call1, Call2) :-
+        Call1 = structure_reuse_call(Args1),
+        Call2 = structure_reuse_call(Args2),
+        set.subset(sorted_list_to_set(Args2), sorted_list_to_set(Args1))
     ),
     equivalent(_, Call, Call)
 ].
 
 :- instance to_string(structure_reuse_call) where [
-    to_string(structure_reuse_call) = "",
-    from_string("") = structure_reuse_call
+    ( to_string(structure_reuse_call(List)) = String :-
+        Strs = list.map(string.from_int, List),
+        String = string.join_list(" ", Strs)
+    ),
+    ( from_string(String) = structure_reuse_call(List) :-
+        Strs = string.words(String),
+        List = list.map(string.det_to_int, Strs)
+    )
 ].
 
 :- instance answer_pattern(structure_reuse_func_info, structure_reuse_answer)
@@ -700,10 +903,34 @@ reuse_answer_from_string(String) = Answe
 % Additional predicates used for intermodule analysis
 %
 
-:- pred record_structure_reuse_results(module_info::in, pred_proc_id::in,
+:- pred record_structure_reuse_results(module_info::in,
+    map(pred_proc_id, set(ppid_no_clobbers))::in, pred_proc_id::in,
     reuse_as_and_status::in, analysis_info::in, analysis_info::out) is det.
 
-record_structure_reuse_results(ModuleInfo, PPId, ReuseAs_Status,
+record_structure_reuse_results(ModuleInfo, CondReuseReverseMap,
+        PPId, ReuseAs_Status, !AnalysisInfo) :-
+    ( map.search(CondReuseReverseMap, PPId, Set) ->
+        % PPId is a conditional reuse procedure created from another procedure.
+        % We need to record the result using the name of the original
+        % procedure.
+        ( set.singleton_set(Set, Elem) ->
+            Elem = ppid_no_clobbers(RecordPPId, NoClobbers)
+        ;
+            unexpected(this_file,
+                "record_structure_reuse_results: non-singleton set")
+        )
+    ;
+        RecordPPId = PPId,
+        NoClobbers = []
+    ),
+    record_structure_reuse_results_2(ModuleInfo, RecordPPId, NoClobbers,
+        ReuseAs_Status, !AnalysisInfo).
+
+:- pred record_structure_reuse_results_2(module_info::in, pred_proc_id::in,
+    no_clobber_args::in, reuse_as_and_status::in,
+    analysis_info::in, analysis_info::out) is det.
+
+record_structure_reuse_results_2(ModuleInfo, PPId, NoClobbers, ReuseAs_Status,
         !AnalysisInfo) :-
     PPId = proc(PredId, ProcId),
     ReuseAs_Status = reuse_as_and_status(ReuseAs, Status),
@@ -718,30 +945,32 @@ record_structure_reuse_results(ModuleInf
         ; reuse_as_all_unconditional_reuses(ReuseAs) ->
             Answer = structure_reuse_answer_unconditional
         ; reuse_as_conditional_reuses(ReuseAs) ->
-            module_info_pred_proc_info(ModuleInfo, PPId, _PredInfo, ProcInfo),
+            module_info_pred_proc_info(ModuleInfo, PPId, _PredInfo,
+                ProcInfo),
             proc_info_get_headvars(ProcInfo, HeadVars),
             proc_info_get_vartypes(ProcInfo, VarTypes),
             map.apply_to_list(HeadVars, VarTypes, HeadVarTypes),
-            Answer = structure_reuse_answer_conditional(HeadVars, HeadVarTypes,
-                ReuseAs)
+            Answer = structure_reuse_answer_conditional(HeadVars,
+                HeadVarTypes, ReuseAs)
         ;
             unexpected(this_file, "record_structure_reuse_results")
         ),
         module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
-        record_result(ModuleName, FuncId, structure_reuse_call, Answer, Status,
-            !AnalysisInfo)
+        record_result(ModuleName, FuncId, structure_reuse_call(NoClobbers),
+            Answer, Status, !AnalysisInfo)
     ;
         ShouldWrite = no
     ).
 
-:- pred handle_dep_procs(module_info::in, pred_proc_id::in,
-    analysis_info::in, analysis_info::out) is det.
+:- pred handle_structure_reuse_dependency(module_info::in,
+    ppid_no_clobbers::in, analysis_info::in, analysis_info::out) is det.
 
-handle_dep_procs(ModuleInfo, DepPPId, !AnalysisInfo) :-
+handle_structure_reuse_dependency(ModuleInfo,
+        ppid_no_clobbers(DepPPId, NoClobbers), !AnalysisInfo) :-
     % Record that we depend on the result for the called procedure.
     module_info_get_name(ModuleInfo, ThisModuleName),
     module_name_func_id(ModuleInfo, DepPPId, DepModuleName, DepFuncId),
-    Call = structure_reuse_call,
+    Call = structure_reuse_call(NoClobbers),
     record_dependency(ThisModuleName, analysis_name, DepModuleName, DepFuncId,
         Call, !AnalysisInfo),
 
@@ -756,7 +985,10 @@ handle_dep_procs(ModuleInfo, DepPPId, !A
     (
         AnyResults = [],
         Answer = bottom(FuncInfo, Call) : structure_reuse_answer,
-        record_result(DepModuleName, DepFuncId, Call, Answer, suboptimal,
+        % We assume an unknown answer is `optimal' otherwise we would not be
+        % able to get mutually recursive procedures out of the `suboptimal'
+        % state.
+        record_result(DepModuleName, DepFuncId, Call, Answer, optimal,
             !AnalysisInfo),
         % Record a request as well.
         record_request(analysis_name, DepModuleName, DepFuncId, Call,
@@ -765,6 +997,15 @@ handle_dep_procs(ModuleInfo, DepPPId, !A
         AnyResults = [_ | _]
     ).
 
+:- pred record_intermod_requests(module_info::in, sr_request::in,
+    analysis_info::in, analysis_info::out) is det.
+
+record_intermod_requests(ModuleInfo, sr_request(PPId, NoClobbers),
+        !AnalysisInfo) :-
+    module_name_func_id(ModuleInfo, PPId, ModuleName, FuncId),
+    record_request(analysis_name, ModuleName, FuncId,
+        structure_reuse_call(NoClobbers), !AnalysisInfo).
+
 %-----------------------------------------------------------------------------%
 
 :- type allow_type_spec_preds
@@ -804,6 +1045,24 @@ should_write_reuse_info(ModuleInfo, Pred
 
 %-----------------------------------------------------------------------------%
 
+:- pred remove_useless_reuse_proc(map(pred_proc_id, reuse_as_and_status)::in,
+    ppid_no_clobbers::in, pred_proc_id::in,
+    predicate_table::in, predicate_table::out) is det.
+
+remove_useless_reuse_proc(ReuseAsMap, _, PPId, !PredTable) :-
+    map.lookup(ReuseAsMap, PPId, ReuseAs_Status),
+    ReuseAs_Status = reuse_as_and_status(ReuseAs, _),
+    ( reuse_as_no_reuses(ReuseAs) ->
+        PPId = proc(PredId, _),
+        % We can remove the whole predicate because we never generate
+        % multi-moded reuse versions of predicates.
+        predicate_table_remove_predicate(PredId, !PredTable)
+    ;
+        true
+    ).
+
+%-----------------------------------------------------------------------------%
+
 :- func this_file = string.
 
 this_file = "structure_reuse.analysis.m".
Index: compiler/structure_reuse.direct.choose_reuse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.choose_reuse.m,v
retrieving revision 1.15
diff -u -p -r1.15 structure_reuse.direct.choose_reuse.m
--- compiler/structure_reuse.direct.choose_reuse.m	27 Feb 2008 07:23:15 -0000	1.15
+++ compiler/structure_reuse.direct.choose_reuse.m	26 May 2008 01:34:13 -0000
@@ -98,6 +98,10 @@
 :- module transform_hlds.ctgc.structure_reuse.direct.choose_reuse.
 :- interface.
 
+:- import_module hlds.hlds_goal.
+
+%-----------------------------------------------------------------------------%
+
 :- pred determine_reuse(reuse_strategy::in, module_info::in, proc_info::in,
     dead_cell_table::in, hlds_goal::in, hlds_goal::out, reuse_as::out,
     io::di, io::uo) is det.
@@ -120,6 +124,7 @@
 :- import_module set.
 :- import_module string.
 :- import_module svmulti_map.
+:- import_module term.
 
 %-----------------------------------------------------------------------------%
 
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.17
diff -u -p -r1.17 structure_reuse.direct.detect_garbage.m
--- compiler/structure_reuse.direct.detect_garbage.m	19 May 2008 01:03:45 -0000	1.17
+++ compiler/structure_reuse.direct.detect_garbage.m	26 May 2008 01:34:13 -0000
@@ -16,7 +16,11 @@
 
 :- module transform_hlds.ctgc.structure_reuse.direct.detect_garbage.
 :- interface.
-    
+
+:- import_module hlds.hlds_goal.
+
+%-----------------------------------------------------------------------------%
+
     % Using the sharing table listing all the structure sharing of all 
     % the known procedures, return a table of all data structures that may
     % become available for reuse (i.e. cells that may become dead) of a given
Index: compiler/structure_reuse.direct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.m,v
retrieving revision 1.11
diff -u -p -r1.11 structure_reuse.direct.m
--- compiler/structure_reuse.direct.m	7 May 2008 05:05:52 -0000	1.11
+++ compiler/structure_reuse.direct.m	26 May 2008 01:34:13 -0000
@@ -26,29 +26,36 @@
 :- interface.
 
 :- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
 :- import_module transform_hlds.ctgc.structure_reuse.domain.
 :- import_module transform_hlds.ctgc.structure_sharing.domain.
 
 :- import_module io.
+:- import_module list.
 
 %-----------------------------------------------------------------------------%
 
+    % The first pass, where we process all procedures defined in the module.
+    %
 :- pred direct_reuse_pass(sharing_as_table::in, module_info::in,
     module_info::out, reuse_as_table::in, reuse_as_table::out, 
     io::di, io::uo) is det.
 
+    % Subsequent passes, where we process only the listed procedures.
+    %
+:- pred direct_reuse_process_specific_procs(sharing_as_table::in,
+    list(pred_proc_id)::in, module_info::in, module_info::out,
+    reuse_as_table::in, reuse_as_table::out, io::di, io::uo) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation. 
 
 :- import_module analysis.
-:- import_module hlds.hlds_goal.
-:- import_module hlds.hlds_pred.
 :- import_module hlds.passes_aux.
 :- import_module libs.globals.
 :- import_module libs.options.
-:- import_module mdbcomp.program_representation.
 :- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_out.
 :- import_module transform_hlds.ctgc.structure_reuse.direct.choose_reuse.
@@ -57,10 +64,8 @@
 :- import_module transform_hlds.smm_common.
 
 :- import_module bool.
-:- import_module list.
 :- import_module map.
 :- import_module svmap.
-:- import_module term.
 
 :- include_module transform_hlds.ctgc.structure_reuse.direct.detect_garbage.
 :- include_module transform_hlds.ctgc.structure_reuse.direct.choose_reuse.
@@ -136,9 +141,9 @@ direct_reuse_process_pred(Strategy, Shar
             set_external_pred_reuse_as(PredId, reuse_as_init, optimal),
             pred_info_procids(PredInfo0), !ReuseTable)
     ;
-        list.foldl3(direct_reuse_process_proc(Strategy, SharingTable, PredId), 
-            pred_info_non_imported_procids(PredInfo0), !ModuleInfo, 
-            !ReuseTable, !IO)
+        ProcIds = pred_info_non_imported_procids(PredInfo0),
+        list.foldl3(direct_reuse_process_proc(Strategy, SharingTable, PredId),
+            ProcIds, !ModuleInfo, !ReuseTable, !IO)
     ).
 
 :- pred set_external_pred_reuse_as(pred_id::in, reuse_as::in,
@@ -149,18 +154,35 @@ set_external_pred_reuse_as(PredId, Reuse
     reuse_as_table_set(proc(PredId, ProcId),
         reuse_as_and_status(ReuseAs, Status), !ReuseTable).
 
+direct_reuse_process_specific_procs(SharingTable, PPIds,
+        !ModuleInfo, !ReuseTable, !IO) :-
+    get_strategy(Strategy, !ModuleInfo, !IO), 
+    list.foldl3(direct_reuse_process_ppid(Strategy, SharingTable),
+        PPIds, !ModuleInfo, !ReuseTable, !IO).
+
+:- pred direct_reuse_process_ppid(reuse_strategy::in, sharing_as_table::in, 
+    pred_proc_id::in, module_info::in, module_info::out,
+    reuse_as_table::in, reuse_as_table::out, io::di, io::uo) is det.
+
+direct_reuse_process_ppid(Strategy, SharingTable, proc(PredId, ProcId),
+        !ModuleInfo, !ReuseTable, !IO) :- 
+    direct_reuse_process_proc(Strategy, SharingTable, PredId, ProcId,
+        !ModuleInfo, !ReuseTable, !IO).
+
+    % Process one individual procedure. 
+    %
 :- pred direct_reuse_process_proc(reuse_strategy::in, sharing_as_table::in, 
     pred_id::in, proc_id::in, module_info::in, module_info::out,
     reuse_as_table::in, reuse_as_table::out, io::di, io::uo) is det.
 
-direct_reuse_process_proc(Strategy, SharingTable, PredId, ProcId, 
+direct_reuse_process_proc(Strategy, SharingTable, PredId, ProcId,
         !ModuleInfo, !ReuseTable, !IO) :- 
     module_info_preds(!.ModuleInfo, Preds0), 
     map.lookup(Preds0, PredId, Pred0), 
     pred_info_get_procedures(Pred0, Procs0), 
     map.lookup(Procs0, ProcId, Proc0), 
 
-    direct_reuse_process_procedure(Strategy, SharingTable, PredId, ProcId, 
+    direct_reuse_process_proc_2(Strategy, SharingTable, PredId, ProcId, 
         !.ModuleInfo, Pred0, Proc0, Proc, ReuseAs, !IO), 
     % XXX is this right?
     Status = optimal,
@@ -172,14 +194,12 @@ direct_reuse_process_proc(Strategy, Shar
     map.det_update(Preds0, PredId, Pred, Preds),
     module_info_set_preds(Preds, !ModuleInfo).
 
-    % Process one individual procedure. 
-    %
-:- pred direct_reuse_process_procedure(reuse_strategy::in, 
+:- pred direct_reuse_process_proc_2(reuse_strategy::in, 
     sharing_as_table::in, pred_id::in, proc_id::in, module_info::in, 
     pred_info::in, proc_info::in, proc_info::out, reuse_as::out, 
     io::di, io::uo) is det.
 
-direct_reuse_process_procedure(Strategy, SharingTable, PredId, ProcId,
+direct_reuse_process_proc_2(Strategy, SharingTable, PredId, ProcId,
         ModuleInfo, PredInfo, !ProcInfo, ReuseAs, !IO):- 
     io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
 
Index: compiler/structure_reuse.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.domain.m,v
retrieving revision 1.15
diff -u -p -r1.15 structure_reuse.domain.m
--- compiler/structure_reuse.domain.m	7 May 2008 05:05:52 -0000	1.15
+++ compiler/structure_reuse.domain.m	26 May 2008 01:34:13 -0000
@@ -191,7 +191,7 @@
     ;       reuse_condition_violated(list(prog_var))
             % At least these variables couldn't be allowed to be clobbered.
 
-    ;       reuse_nodes_have_sharing.
+    ;       reuse_nodes_have_sharing(list(prog_var)).
             % The reuse conditions are individually satisfied, but the
             % arguments for reuse have sharing between them which would lead
             % to undefined behaviour in the reuse version of the procedure.
@@ -209,7 +209,15 @@
 
     % Intermediate storage of the reuse results for individual procedures.
     %
-:- type reuse_as_table == map(pred_proc_id, reuse_as_and_status).
+:- type reuse_as_table
+    --->    reuse_as_table(
+                reuse_info_map      :: map(pred_proc_id, reuse_as_and_status),
+                % Maps pred_proc_ids to their reuse information and status.
+
+                reuse_version_map   :: map(ppid_no_clobbers, pred_proc_id)
+                % Maps original procedures and associated no-clobber argument
+                % lists to the reuse version procedures already created.
+            ).
 
 :- type reuse_as_and_status
     --->    reuse_as_and_status(
@@ -217,19 +225,37 @@
                 analysis_status
             ).
 
+:- type ppid_no_clobbers
+    --->    ppid_no_clobbers(
+                pred_proc_id,
+                no_clobber_args
+            ).
+
+    % The arguments at these positions must not be clobbered.
+    %
+:- type no_clobber_args == list(int).
+
 :- func reuse_as_table_init = reuse_as_table.
 
-:- pred reuse_as_table_search(pred_proc_id::in, reuse_as_table::in, 
+:- pred reuse_as_table_search(reuse_as_table::in, pred_proc_id::in, 
     reuse_as_and_status::out) is semidet.
 
+:- pred reuse_as_table_search_reuse_version_proc(reuse_as_table::in,
+    pred_proc_id::in, list(int)::in, pred_proc_id::out) is semidet.
+
 :- pred reuse_as_table_set(pred_proc_id::in, reuse_as_and_status::in, 
     reuse_as_table::in, reuse_as_table::out) is det.
 
+:- pred reuse_as_table_insert_reuse_version_proc(pred_proc_id::in,
+    no_clobber_args::in, pred_proc_id::in,
+    reuse_as_table::in, reuse_as_table::out) 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. 
+    % a reuse table. This is only for the old intermodule optimisation system
+    % where imported structure reuse information lives with the proc_infos.
     %
 :- func load_structure_reuse_table(module_info) = reuse_as_table.
 
@@ -244,10 +270,12 @@
 :- import_module transform_hlds.ctgc.datastruct.
 :- import_module transform_hlds.ctgc.util.
 
-:- import_module maybe. 
+:- import_module maybe.
 :- import_module pair.
 :- import_module set.
+:- import_module solutions.
 :- import_module string.
+:- import_module svset.
 
 %-----------------------------------------------------------------------------%
 
@@ -638,13 +666,15 @@ reuse_as_satisfied(ModuleInfo, ProcInfo,
         % undefined behaviour.
         (
             Result0 = reuse_possible,
+            aliases_between_reuse_nodes(ModuleInfo, ProcInfo, SharingAs,
+                Conditions, AliasedVars),
             (
-                no_aliases_between_reuse_nodes(ModuleInfo, ProcInfo,
-                    SharingAs, Conditions)
-            ->
+                AliasedVars = [],
                 Result = reuse_possible
             ;
-                Result = reuse_not_possible(reuse_nodes_have_sharing)
+                AliasedVars = [_ | _], 
+                Result = reuse_not_possible(reuse_nodes_have_sharing(
+                    AliasedVars))
             )
         ;
             Result0 = reuse_not_possible(_),
@@ -666,64 +696,103 @@ reuse_as_satisfied_2(ModuleInfo, ProcInf
         reuse_as_satisfied_2(ModuleInfo, ProcInfo, LiveData, SharingAs,
             StaticVars, Conds, Result)
     ;
-        Result0 = reuse_not_possible(_),
+        Result0 = reuse_not_possible(reuse_condition_violated(Vars0)),
+        % We try to collect all the variables which violate conditions.
+        reuse_as_satisfied_2(ModuleInfo, ProcInfo, LiveData, SharingAs,
+            StaticVars, Conds, Result1),
+        (
+            Result1 = reuse_not_possible(reuse_condition_violated(Vars1)),
+            Vars = list.sort_and_remove_dups(Vars0 ++ Vars1),
+            Result = reuse_not_possible(reuse_condition_violated(Vars))
+        ;
+            ( Result1 = reuse_possible
+            ; Result1 = reuse_not_possible(no_reuse)
+            ),
+            Result = Result0
+        ;
+            ( Result1 = reuse_not_possible(unknown_livedata)
+            ; Result1 = reuse_not_possible(reuse_nodes_have_sharing(_))
+            ),
+            unexpected(this_file, "reuse_as_satisfied_2: unexpected result")
+        )
+    ;
+        Result0 = reuse_not_possible(no_reuse),
         Result = Result0
+    ;
+        Result0 = reuse_not_possible(unknown_livedata),
+        Result = Result0
+    ;
+        Result0 = reuse_not_possible(reuse_nodes_have_sharing(_)),
+        unexpected(this_file, "reuse_as_satisfied_2: reuse_nodes_have_sharing")
     ).
 
-:- pred no_aliases_between_reuse_nodes(module_info::in, proc_info::in,
-    sharing_as::in, list(reuse_condition)::in) is semidet.
+:- pred aliases_between_reuse_nodes(module_info::in, proc_info::in,
+    sharing_as::in, list(reuse_condition)::in, prog_vars::out) is det.
 
-no_aliases_between_reuse_nodes(ModuleInfo, ProcInfo, SharingAs, Conditions):-
+aliases_between_reuse_nodes(ModuleInfo, ProcInfo, SharingAs, Conditions,
+        AliasedVars) :-
     list.filter_map(reuse_condition_reusable_nodes, Conditions, ListNodes),
     list.condense(ListNodes, AllNodes),
     (
         AllNodes = [Node | Rest],
-        no_aliases_between_reuse_nodes_2(ModuleInfo, ProcInfo, SharingAs,
-            Node, Rest)
+        aggregate(aliases_between_reuse_nodes_2(ModuleInfo, ProcInfo,
+            SharingAs, Node, Rest), collect_aliased_vars, set.init,
+            AliasedVarsSet),
+        AliasedVars = set.to_sorted_list(AliasedVarsSet)
     ;
         AllNodes = [],
         unexpected(this_file, "no_aliases_between_reuse_nodes: no nodes")
     ).
 
-:- pred no_aliases_between_reuse_nodes_2(module_info::in, proc_info::in,
-    sharing_as::in, datastruct::in, list(datastruct)::in) is semidet.
+:- pred aliases_between_reuse_nodes_2(module_info::in, proc_info::in,
+    sharing_as::in, datastruct::in, list(datastruct)::in,
+    pair(datastruct)::out) is nondet.
 
-no_aliases_between_reuse_nodes_2(ModuleInfo, ProcInfo, SharingAs, Node,
-        OtherNodes):-
+aliases_between_reuse_nodes_2(ModuleInfo, ProcInfo, SharingAs, Node,
+        OtherNodes, AliasedNodes) :-
     SharingNodes0 = extend_datastruct(ModuleInfo, ProcInfo, SharingAs, Node),
     list.delete(SharingNodes0, Node, SharingNodes),
 
     % Check whether none of the structures to which the current Node is
     % aliased is subsumed by or subsumes one of the other nodes, including the
     % current node itself.
-    all [SharingNode] (
-        list.member(SharingNode, SharingNodes)
-    =>
-        not there_is_a_subsumption_relation(ModuleInfo, ProcInfo,
-            [Node | OtherNodes], SharingNode)
-    ),
     (
-        OtherNodes = [NextNode | NextOtherNodes],
-        no_aliases_between_reuse_nodes_2(ModuleInfo, ProcInfo, SharingAs,
-            NextNode, NextOtherNodes)
+        list.member(SharingNode, SharingNodes),
+        there_is_a_subsumption_relation(ModuleInfo, ProcInfo,
+            [Node | OtherNodes], SharingNode, OtherAliasedNode),
+        AliasedNodes = SharingNode - OtherAliasedNode
     ;
-        OtherNodes = []
+        OtherNodes = [NextNode | NextOtherNodes],
+        aliases_between_reuse_nodes_2(ModuleInfo, ProcInfo, SharingAs,
+            NextNode, NextOtherNodes, AliasedNodes)
     ).
 
     % Succeed if Data is subsumed or subsumes some of the datastructures in
     % Datastructs.
     %
 :- pred there_is_a_subsumption_relation(module_info::in, proc_info::in,
-    list(datastruct)::in, datastruct::in) is semidet.
+    list(datastruct)::in, datastruct::in, datastruct::out) is nondet.
 
-there_is_a_subsumption_relation(ModuleInfo, ProcInfo, Datastructs, DataA):-
-    list.member(DataB, Datastructs),
+there_is_a_subsumption_relation(ModuleInfo, ProcInfo, [DataB0 | DataBs],
+        DataA, DataB) :-
     (
-        datastruct_subsumed_by(ModuleInfo, ProcInfo, DataA, DataB)
+        datastruct_subsumed_by(ModuleInfo, ProcInfo, DataA, DataB),
+        DataB = DataB0
+    ;
+        datastruct_subsumed_by(ModuleInfo, ProcInfo, DataB, DataA),
+        DataB = DataB0
     ;
-        datastruct_subsumed_by(ModuleInfo, ProcInfo, DataB, DataA)
+        there_is_a_subsumption_relation(ModuleInfo, ProcInfo, DataBs,
+            DataA, DataB)
     ).
 
+:- pred collect_aliased_vars(pair(datastruct)::in,
+    set(prog_var)::in, set(prog_var)::out) is det.
+
+collect_aliased_vars(DataA - DataB, !Vars) :-
+    svset.insert(DataA ^ sc_var, !Vars),
+    svset.insert(DataB ^ sc_var, !Vars).
+
 %-----------------------------------------------------------------------------%
 
 :- pred reuse_condition_satisfied(module_info::in, proc_info::in,
@@ -836,13 +905,24 @@ to_structure_reuse_condition(Condition) 
 % reuse_as_table
 %
 
-reuse_as_table_init = map.init.
+reuse_as_table_init = reuse_as_table(map.init, map.init).
+
+reuse_as_table_search(Table, PPId, ReuseAs_Status) :-
+    map.search(Table ^ reuse_info_map, PPId, ReuseAs_Status).
 
-reuse_as_table_search(PPId, Table, ReuseAs_Status) :-
-    map.search(Table, PPId, ReuseAs_Status).
+reuse_as_table_search_reuse_version_proc(Table, PPId, NoClobbers, NewPPId) :-
+    map.search(Table ^ reuse_version_map, ppid_no_clobbers(PPId, NoClobbers),
+        NewPPId).
 
 reuse_as_table_set(PPId, ReuseAs_Status, !Table) :- 
-    !Table ^ elem(PPId) := ReuseAs_Status.
+    T0 = !.Table ^ reuse_info_map,
+    map.set(T0, PPId, ReuseAs_Status, T),
+    !Table ^ reuse_info_map := T.
+
+reuse_as_table_insert_reuse_version_proc(PPId, NoClobbers, NewPPId, !Table) :- 
+    T0 = !.Table ^ reuse_version_map,
+    map.det_insert(T0, ppid_no_clobbers(PPId, NoClobbers), NewPPId, T),
+    !Table ^ reuse_version_map := T.
 
 reuse_as_table_maybe_dump(DoDump, ModuleInfo, Table, !IO) :-
     (
@@ -856,11 +936,12 @@ reuse_as_table_maybe_dump(DoDump, Module
     io::di, io::uo) is det.
 
 reuse_as_table_dump(ModuleInfo, Table, !IO) :-
-    ( map.is_empty(Table) ->
+    ReuseInfoMap = Table ^ reuse_info_map,
+    ( map.is_empty(ReuseInfoMap) ->
         io.write_string("% ReuseTable: Empty", !IO)
     ;
         io.write_string("% ReuseTable: PPId --> Reuse\n", !IO), 
-        map.foldl(dump_entries(ModuleInfo), Table, !IO)
+        map.foldl(dump_entries(ModuleInfo), ReuseInfoMap, !IO)
     ).
 
 :- pred dump_entries(module_info::in, pred_proc_id::in,
@@ -894,11 +975,11 @@ load_structure_reuse_table_3(ModuleInfo,
     module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
     proc_info_get_structure_reuse(ProcInfo, MaybePublicReuse),
     (
-        MaybePublicReuse = yes(
-            structure_reuse_domain_and_status(PublicReuse, Status)),
+        MaybePublicReuse = yes(structure_reuse_domain_and_status(PublicReuse,
+            Status)),
         PPId = proc(PredId, ProcId),
         PrivateReuse = from_structure_reuse_domain(PublicReuse),
-        reuse_as_table_set(PPId, reuse_as_and_status(PrivateReuse, Status), 
+        reuse_as_table_set(PPId, reuse_as_and_status(PrivateReuse, Status),
             !ReuseTable)
     ;
         MaybePublicReuse = no
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.24
diff -u -p -r1.24 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m	9 May 2008 05:45:11 -0000	1.24
+++ compiler/structure_reuse.indirect.m	26 May 2008 01:34:13 -0000
@@ -7,7 +7,7 @@
 %-----------------------------------------------------------------------------%
 %
 % File: structure_reuse.indirect.m.
-% Main authors: nancy.
+% Main authors: nancy, wangp.
 %
 % Determine the indirect reuse.  This requires a fixpoint computation.
 %
@@ -21,11 +21,19 @@
 :- import_module transform_hlds.ctgc.structure_reuse.domain.
 :- import_module transform_hlds.ctgc.structure_sharing.domain.
 
-:- import_module io.
-:- import_module list.
+:- import_module set.
 
 %------------------------------------------------------------------------------%
 
+    % Represents a request to perform analyses of a procedure with
+    % restriction on which arguments may be clobbered.
+    %
+:- type sr_request
+    --->    sr_request(
+                srreq_ppid  :: pred_proc_id,
+                srreq_args  :: no_clobber_args
+            ).
+
     % Direct reuse analysis derives information about deconstructions that
     % under certain circumstances (formalised as "reuse conditions") form
     % the last ever (memory) access to the deconstructed term.
@@ -41,9 +49,20 @@
     % also involves annotations at the level of the individual procedure calls,
     % which explains the need for updating the HLDS as well.
     %
+    % Returns requests for analyses of procedures with specific call patterns,
+    % both for procedures defined in this module and externally.
+    %
 :- pred indirect_reuse_pass(sharing_as_table::in, module_info::in,
     module_info::out, reuse_as_table::in, reuse_as_table::out,
-    list(pred_proc_id)::out, io::di, io::uo) is det.
+    set(ppid_no_clobbers)::out, set(sr_request)::out, set(sr_request)::out)
+    is det.
+
+    % Repeat the indirect structure reuse analysis.
+    %
+:- pred indirect_reuse_rerun(sharing_as_table::in, module_info::in,
+    module_info::out, reuse_as_table::in, reuse_as_table::out,
+    set(ppid_no_clobbers)::out, set(sr_request)::out,
+    set(sr_request)::in, set(sr_request)::out) is det.
 
 %------------------------------------------------------------------------------%
 %------------------------------------------------------------------------------%
@@ -56,7 +75,6 @@
 :- import_module libs.compiler_util.
 :- import_module libs.globals.
 :- import_module libs.options.
-:- import_module mdbcomp.prim_data.
 :- import_module parse_tree.mercury_to_mercury.
 :- import_module parse_tree.prog_data.
 :- import_module parse_tree.prog_out.
@@ -69,19 +87,21 @@
 
 :- import_module bool.
 :- import_module int.
+:- import_module io.
+:- import_module list.
 :- import_module map.
 :- import_module maybe.
-:- import_module pair.
-:- import_module set.
+:- import_module solutions.
 :- import_module string.
 
 %------------------------------------------------------------------------------%
 
-:- type dep_procs == list(pred_proc_id).
+:- type dep_procs == set(ppid_no_clobbers).
 
 %------------------------------------------------------------------------------%
 
-indirect_reuse_pass(SharingTable, !ModuleInfo, !ReuseTable, DepProcs, !IO):-
+indirect_reuse_pass(SharingTable, !ModuleInfo, !ReuseTable, DepProcs,
+        Requests, IntermodRequests) :-
     %
     % Perform a bottom-up traversal of the SCCs in the module,
     % analysing indirect structure reuse in each one as we go.
@@ -91,9 +111,9 @@ indirect_reuse_pass(SharingTable, !Modul
     (
         MaybeDepInfo = yes(DepInfo),
         hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
-        list.foldl3(indirect_reuse_analyse_scc(SharingTable), SCCs,
-            !ModuleInfo, !ReuseTable, [], DepProcs0),
-        DepProcs = list.sort_and_remove_dups(DepProcs0)
+        list.foldl5(indirect_reuse_analyse_scc(SharingTable), SCCs,
+            !ModuleInfo, !ReuseTable, set.init, DepProcs, set.init, Requests,
+            set.init, IntermodRequests)
     ;
         MaybeDepInfo = no,
         unexpected(this_file, "No dependency information.")
@@ -101,38 +121,103 @@ indirect_reuse_pass(SharingTable, !Modul
 
 :- pred indirect_reuse_analyse_scc(sharing_as_table::in,
     list(pred_proc_id)::in, module_info::in, module_info::out,
-    reuse_as_table::in, reuse_as_table::out, dep_procs::in, dep_procs::out)
-    is det.
+    reuse_as_table::in, reuse_as_table::out,
+    dep_procs::in, dep_procs::out,
+    set(sr_request)::in, set(sr_request)::out,
+    set(sr_request)::in, set(sr_request)::out) is det.
 
 indirect_reuse_analyse_scc(SharingTable, SCC, !ModuleInfo, !ReuseTable,
-        !DepProcs) :-
+        !DepProcs, !Requests, !IntermodRequests) :-
     ( some_preds_requiring_no_analysis(!.ModuleInfo, SCC) ->
         true
     ;
-        FixpointTable0 = sr_fixpoint_table_init(!.ModuleInfo, SCC,
-            !.ReuseTable),
+        FixpointTable0 = sr_fixpoint_table_init(SCC, !.ReuseTable),
         indirect_reuse_analyse_scc_until_fixpoint(SharingTable,
             SCC, !.ReuseTable, !ModuleInfo, FixpointTable0, FixpointTable,
-            !DepProcs),
+            !DepProcs, !Requests, !IntermodRequests),
         list.foldl(update_reuse_in_table(FixpointTable), SCC, !ReuseTable)
     ).
 
+:- pred update_reuse_in_table(sr_fixpoint_table::in, pred_proc_id::in,
+    reuse_as_table::in, reuse_as_table::out) is det.
+
+update_reuse_in_table(FixpointTable, PPId, !ReuseTable) :-
+    FinalAs = sr_fixpoint_table_get_final_as(PPId, FixpointTable),
+    reuse_as_table_set(PPId, FinalAs, !ReuseTable).
+
+%-----------------------------------------------------------------------------%
+
+indirect_reuse_rerun(SharingTable, !ModuleInfo, !ReuseTable,
+        DepProcs, Requests, !IntermodRequests) :-
+    module_info_rebuild_dependency_info(!ModuleInfo, DepInfo),
+    hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
+    list.foldl5(indirect_reuse_rerun_analyse_scc(SharingTable),
+        SCCs, !ModuleInfo, !ReuseTable, set.init, DepProcs, set.init, Requests,
+        !IntermodRequests).
+
+:- pred indirect_reuse_rerun_analyse_scc(sharing_as_table::in,
+    list(pred_proc_id)::in, module_info::in, module_info::out,
+    reuse_as_table::in, reuse_as_table::out,
+    dep_procs::in, dep_procs::out,
+    set(sr_request)::in, set(sr_request)::out,
+    set(sr_request)::in, set(sr_request)::out) is det.
+
+indirect_reuse_rerun_analyse_scc(SharingTable, SCC, !ModuleInfo,
+        !ReuseTable, !DepProcs, !Requests, !IntermodRequests) :-
+    ( some_preds_requiring_no_analysis(!.ModuleInfo, SCC) ->
+        true
+    ;
+        % Also analyse reuse versions of any procedures in the SCC at the same
+        % time.
+        extend_scc_with_reuse_procs(!.ReuseTable, SCC, ExtendedSCC),
+
+        FixpointTable0 = sr_fixpoint_table_init(ExtendedSCC, !.ReuseTable),
+        indirect_reuse_analyse_scc_until_fixpoint(SharingTable,
+            ExtendedSCC, !.ReuseTable, !ModuleInfo, FixpointTable0,
+            FixpointTable, !DepProcs, !Requests, !IntermodRequests),
+        list.foldl(update_reuse_in_table(FixpointTable), ExtendedSCC,
+            !ReuseTable)
+    ).
+
+:- pred extend_scc_with_reuse_procs(reuse_as_table::in, list(pred_proc_id)::in,
+    list(pred_proc_id)::out) is det.
+
+% extend_scc_with_reuse_procs(_, SCC, SCC).
+
+% temporarily commented out to narrow down --structure-reuse-repeat bug
+
+extend_scc_with_reuse_procs(ReuseTable, SCC, ExtendedSCC) :-
+    ReuseVersionMap = ReuseTable ^ reuse_version_map,
+    solutions(
+        (pred(NewPPId::out) is nondet :-
+            member(OrigPPId, SCC),
+            map.member(ReuseVersionMap, ppid_no_clobbers(OrigPPId, _), NewPPId)
+        ), Extension),
+    ExtendedSCC = SCC ++ Extension.
+
+%-----------------------------------------------------------------------------%
+
 :- pred indirect_reuse_analyse_scc_until_fixpoint(sharing_as_table::in,
     list(pred_proc_id)::in, reuse_as_table::in,
     module_info::in, module_info::out,
     sr_fixpoint_table::in, sr_fixpoint_table::out,
-    dep_procs::in, dep_procs::out) is det.
+    dep_procs::in, dep_procs::out,
+    set(sr_request)::in, set(sr_request)::out,
+    set(sr_request)::in, set(sr_request)::out) is det.
 
 indirect_reuse_analyse_scc_until_fixpoint(SharingTable, SCC,
-        ReuseTable, !ModuleInfo, !FixpointTable, !DepProcs) :-
-    list.foldl3(indirect_reuse_analyse_pred_proc(SharingTable, ReuseTable),
-        SCC, !ModuleInfo, !FixpointTable, !DepProcs),
+        ReuseTable, !ModuleInfo, !FixpointTable, !DepProcs, !Requests,
+        !IntermodRequests) :-
+    list.foldl5(indirect_reuse_analyse_pred_proc(SharingTable, ReuseTable),
+        SCC, !ModuleInfo, !FixpointTable, !DepProcs, !Requests,
+        !IntermodRequests),
     ( sr_fixpoint_table_stable(!.FixpointTable) ->
         true
     ;
         sr_fixpoint_table_new_run(!FixpointTable),
-        indirect_reuse_analyse_scc_until_fixpoint(SharingTable,
-            SCC, ReuseTable, !ModuleInfo, !FixpointTable, !DepProcs)
+        indirect_reuse_analyse_scc_until_fixpoint(SharingTable, SCC,
+            ReuseTable, !ModuleInfo, !FixpointTable, !DepProcs, !Requests,
+            !IntermodRequests)
     ).
 
 %-----------------------------------------------------------------------------%
@@ -140,10 +225,13 @@ indirect_reuse_analyse_scc_until_fixpoin
 :- pred indirect_reuse_analyse_pred_proc(sharing_as_table::in,
     reuse_as_table::in, pred_proc_id::in, module_info::in, module_info::out,
     sr_fixpoint_table::in, sr_fixpoint_table::out,
-    dep_procs::in, dep_procs::out) is det.
+    dep_procs::in, dep_procs::out,
+    set(sr_request)::in, set(sr_request)::out,
+    set(sr_request)::in, set(sr_request)::out) is det.
 
 indirect_reuse_analyse_pred_proc(SharingTable, ReuseTable, PPId,
-        !ModuleInfo, !FixpointTable, !DepProcs) :-
+        !ModuleInfo, !FixpointTable, !DepProcs, !Requests,
+        !IntermodRequests) :-
     PPId = proc(PredId, _),
     module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
     pred_info_get_origin(PredInfo, Origin),
@@ -152,16 +240,20 @@ indirect_reuse_analyse_pred_proc(Sharing
         true
     ;
         indirect_reuse_analyse_pred_proc_2(SharingTable, ReuseTable, PPId,
-            !ModuleInfo, !FixpointTable, !DepProcs)
+            !ModuleInfo, !FixpointTable, !DepProcs, !Requests,
+            !IntermodRequests)
     ).
 
 :- pred indirect_reuse_analyse_pred_proc_2(sharing_as_table::in,
     reuse_as_table::in, pred_proc_id::in, module_info::in, module_info::out,
     sr_fixpoint_table::in, sr_fixpoint_table::out,
-    dep_procs::in, dep_procs::out) is det.
+    dep_procs::in, dep_procs::out,
+    set(sr_request)::in, set(sr_request)::out,
+    set(sr_request)::in, set(sr_request)::out) is det.
 
 indirect_reuse_analyse_pred_proc_2(SharingTable, ReuseTable, PPId,
-        !ModuleInfo, !FixpointTable, !DepProcs):-
+        !ModuleInfo, !FixpointTable, !DepProcs, !Requests,
+        !IntermodRequests) :-
     module_info_get_globals(!.ModuleInfo, Globals),
     globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
     globals.lookup_bool_option(Globals, debug_indirect_reuse, DebugIndirect),
@@ -191,12 +283,14 @@ indirect_reuse_analyse_pred_proc_2(Shari
     proc_info_get_goal(ProcInfo0, Goal0),
     BaseInfo = ir_background_info_init(!.ModuleInfo, PPId, PredInfo0,
         ProcInfo0, SharingTable, ReuseTable),
-    IrInfo0 = ir_analysis_info_init(PPId, !.FixpointTable),
+    IrInfo0 = ir_analysis_info_init(PPId, !.FixpointTable, !.DepProcs,
+        !.Requests, !.IntermodRequests),
 
     % The actual analysis of the goal:
-    indirect_reuse_analyse_goal(BaseInfo, Goal0, Goal, IrInfo0, IrInfo,
-        !DepProcs),
-    !:FixpointTable = IrInfo ^ fptable,
+    indirect_reuse_analyse_goal(BaseInfo, Goal0, Goal, IrInfo0, IrInfo),
+
+    IrInfo = ir_analysis_info(_, _, _, _, !:FixpointTable, !:DepProcs,
+        !:Requests, !:IntermodRequests),
 
     % Some feedback.
     (
@@ -207,7 +301,8 @@ indirect_reuse_analyse_pred_proc_2(Shari
         trace [io(!IO)] (
             io.write_string("% FPT: ", !IO),
             io.write_string(
-                sr_fixpoint_table_get_short_description(PPId, !.FixpointTable),
+                sr_fixpoint_table_get_short_description(PPId,
+                    !.FixpointTable),
                 !IO),
             io.nl(!IO)
         )
@@ -218,8 +313,8 @@ indirect_reuse_analyse_pred_proc_2(Shari
     % Record the obtained reuse description in the fixpoint table...
     ReuseAs_Status = reuse_as_and_status(IrInfo ^ reuse_as,
         IrInfo ^ analysis_status),
-    sr_fixpoint_table_new_as(!.ModuleInfo, ProcInfo0, PPId, ReuseAs_Status,
-        !FixpointTable),
+    sr_fixpoint_table_new_as(!.ModuleInfo, ProcInfo0, PPId,
+        ReuseAs_Status, !FixpointTable),
 
     % As the analysis changes the goal, we must update proc_info and
     % module_info:
@@ -254,7 +349,12 @@ indirect_reuse_analyse_pred_proc_2(Shari
                 reuse_as        :: reuse_as,
                 analysis_status :: analysis_status,
                 static_vars     :: set(prog_var),
-                fptable         :: sr_fixpoint_table
+                fptable         :: sr_fixpoint_table,
+                dep_procs       :: dep_procs,
+                requests        :: set(sr_request),
+                                % Requests to locally-defined procedures.
+                inter_requests  :: set(sr_request)
+                                % Requests to imported procedures.
             ).
 
 :- func ir_background_info_init(module_info, pred_proc_id, pred_info,
@@ -267,8 +367,7 @@ ir_background_info_init(ModuleInfo, PPId
     % of head variables:
     proc_info_get_headvars(ProcInfo, HeadVars),
     proc_info_get_vartypes(ProcInfo, Vartypes),
-    HeadVarsOfInterest =
-        remove_typeinfo_vars(Vartypes, HeadVars),
+    HeadVarsOfInterest = remove_typeinfo_vars(Vartypes, HeadVars),
 
     module_info_get_globals(ModuleInfo, Globals),
     globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
@@ -278,14 +377,15 @@ ir_background_info_init(ModuleInfo, PPId
         SharingTable, ReuseTable, HeadVarsOfInterest, VeryVerbose,
         DebugIndirect).
 
-:- func ir_analysis_info_init(pred_proc_id, sr_fixpoint_table) =
-    ir_analysis_info.
+:- func ir_analysis_info_init(pred_proc_id, sr_fixpoint_table, dep_procs,
+    set(sr_request), set(sr_request)) = ir_analysis_info.
 
-ir_analysis_info_init(PPId, FixpointTable) = Info :-
+ir_analysis_info_init(PPId, FixpointTable, DepProcs, Requests,
+        IntermodRequests) = Info :-
     ReuseAs_Sharing = sr_fixpoint_table_get_final_as(PPId, FixpointTable),
     ReuseAs_Sharing = reuse_as_and_status(ReuseAs, Status),
     Info = ir_analysis_info(sharing_as_init, ReuseAs, Status, set.init,
-        FixpointTable).
+        FixpointTable, DepProcs, Requests, IntermodRequests).
 
     % When analysing disjuncts (or switches) each branch yields its own
     % analysis information. This needs to be combined to form one single
@@ -313,73 +413,71 @@ ir_analysis_info_combine(BaseInfo, IrInf
 ir_analysis_info_lub(BaseInfo, IrInfo0, !IrInfo):-
     ModuleInfo = BaseInfo ^ module_info,
     ProcInfo = BaseInfo ^ proc_info,
+
     % Lub of the sharing
     NewSharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo,
         !.IrInfo ^ sharing_as, IrInfo0 ^ sharing_as),
+
     % Lub of the reuse
     NewReuse = reuse_as_least_upper_bound(ModuleInfo, ProcInfo,
         !.IrInfo ^ reuse_as, IrInfo0 ^ reuse_as),
+
     % Lub of the analysis status.
     NewStatus = lub(!.IrInfo ^ analysis_status, IrInfo0 ^ analysis_status),
+
     % Union of the static vars
     NewStaticVars = set.union(!.IrInfo ^ static_vars, IrInfo0 ^ static_vars),
+
+    % Union of the dependencies.
+    NewDepProcs = set.union(!.IrInfo ^ dep_procs, IrInfo0 ^ dep_procs),
+
+    % Union of the requests.
+    NewRequests = set.union(!.IrInfo ^ requests, IrInfo0 ^ requests),
+    NewIntermodRequests = set.union(!.IrInfo ^ inter_requests,
+        IrInfo0 ^ inter_requests),
+
+    % The fixpoint table field is updated in ir_analysis_info_combine.
     !:IrInfo = ir_analysis_info(NewSharing, NewReuse, NewStatus, NewStaticVars,
-        !.IrInfo ^ fptable).
+        !.IrInfo ^ fptable, NewDepProcs, NewRequests, NewIntermodRequests).
 
 %-----------------------------------------------------------------------------%
 
 :- pred indirect_reuse_analyse_goal(ir_background_info::in, hlds_goal::in,
-    hlds_goal::out, ir_analysis_info::in, ir_analysis_info::out,
-    dep_procs::in, dep_procs::out) is det.
+    hlds_goal::out, ir_analysis_info::in, ir_analysis_info::out) is det.
 
-indirect_reuse_analyse_goal(BaseInfo, !Goal, !IrInfo, !DepProcs) :-
+indirect_reuse_analyse_goal(BaseInfo, !Goal, !IrInfo) :-
     ModuleInfo = BaseInfo ^ module_info,
     PredInfo = BaseInfo ^ pred_info,
     ProcInfo = BaseInfo ^ proc_info,
     SharingTable = BaseInfo ^ sharing_table,
+
     !.Goal = hlds_goal(GoalExpr0, GoalInfo0),
     (
         GoalExpr0 = conj(ConjType, Goals0),
-        list.map_foldl2(indirect_reuse_analyse_goal(BaseInfo),
-            Goals0, Goals, !IrInfo, !DepProcs),
+        list.map_foldl(indirect_reuse_analyse_goal(BaseInfo),
+            Goals0, Goals, !IrInfo),
         GoalExpr = conj(ConjType, Goals),
         !:Goal = hlds_goal(GoalExpr, GoalInfo0)
     ;
         GoalExpr0 = plain_call(CalleePredId, CalleeProcId, CalleeArgs,
-            _, _, _),
-        verify_indirect_reuse(BaseInfo, CalleePredId, CalleeProcId,
-            CalleeArgs, GoalInfo0, GoalInfo, !IrInfo),
+            _Builtin, _Context, _Sym),
+        NoClobbers = [],
+        verify_indirect_reuse(BaseInfo, proc(CalleePredId, CalleeProcId),
+            NoClobbers, CalleeArgs, GoalInfo0, GoalInfo, !IrInfo),
         OldSharing = !.IrInfo ^ sharing_as,
         lookup_sharing_and_comb(ModuleInfo, PredInfo, ProcInfo, SharingTable,
             CalleePredId, CalleeProcId, CalleeArgs, OldSharing, NewSharing),
-        !IrInfo ^ sharing_as := NewSharing,
-
-        % If the called procedure was imported (not opt_imported) then remember
-        % that this module depends on the results for that procedure.
-        (
-            pred_info_get_import_status(PredInfo, PredImportStatus),
-            status_defined_in_this_module(PredImportStatus) = yes,
-            module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
-            pred_info_get_import_status(CalleePredInfo, CalleeImportStatus),
-            CalleeImportStatus = status_imported(_),
-            \+ is_unify_or_compare_pred(CalleePredInfo)
-        ->
-            CalleePPId = proc(CalleePredId, CalleeProcId),
-            !:DepProcs = [CalleePPId | !.DepProcs]
-        ;
-            true
-        ),
-
+        update_sharing_as(BaseInfo, OldSharing, NewSharing, !IrInfo),
         !:Goal = hlds_goal(GoalExpr0, GoalInfo)
     ;
         GoalExpr0 = generic_call(_GenDetails, _, _, _),
         Context = goal_info_get_context(GoalInfo0),
         context_to_string(Context, ContextString),
-        SharingAs = !.IrInfo ^ sharing_as,
         Msg = "generic call (" ++ ContextString ++ ")",
-        !IrInfo ^ sharing_as :=
-            sharing_as_top_sharing_accumulate(top_cannot_improve(Msg),
-                SharingAs)
+        OldSharing = !.IrInfo ^ sharing_as,
+        NewSharing = sharing_as_top_sharing_accumulate(top_cannot_improve(Msg),
+            OldSharing),
+        update_sharing_as(BaseInfo, OldSharing, NewSharing, !IrInfo)
     ;
         GoalExpr0 = unify(_, _, _, Unification, _),
         % Record the statically constructed variables.
@@ -405,25 +503,23 @@ indirect_reuse_analyse_goal(BaseInfo, !G
             unexpected(this_file,
             "complicated unification in indirect structure sharing analysis.")
         ),
-        !IrInfo ^ sharing_as :=
-            add_unify_sharing(ModuleInfo, ProcInfo, Unification, GoalInfo0,
-                !.IrInfo ^ sharing_as)
+        OldSharing = !.IrInfo ^ sharing_as,
+        NewSharing = add_unify_sharing(ModuleInfo, ProcInfo, Unification,
+            GoalInfo0, OldSharing),
+        update_sharing_as(BaseInfo, OldSharing, NewSharing, !IrInfo)
     ;
         GoalExpr0 = disj(Goals0),
-        list.map2_foldl2(
-            indirect_reuse_analyse_disj(BaseInfo, !.IrInfo),
-            Goals0, Goals, IrInfoList, !.IrInfo ^ fptable, NewFixpointTable,
-            !DepProcs),
+        list.map2_foldl(indirect_reuse_analyse_disj(BaseInfo, !.IrInfo),
+            Goals0, Goals, IrInfoList, !.IrInfo ^ fptable, NewFixpointTable),
         ir_analysis_info_combine(BaseInfo, IrInfoList, NewFixpointTable,
             !IrInfo),
         GoalExpr = disj(Goals),
         !:Goal = hlds_goal(GoalExpr, GoalInfo0)
     ;
         GoalExpr0 = switch(A, B, Cases0),
-        list.map2_foldl2(
+        list.map2_foldl(
             indirect_reuse_analyse_case(BaseInfo, !.IrInfo),
-            Cases0, Cases, IrInfoList, !.IrInfo ^ fptable, NewFixpointTable,
-            !DepProcs),
+            Cases0, Cases, IrInfoList, !.IrInfo ^ fptable, NewFixpointTable),
         ir_analysis_info_combine(BaseInfo, IrInfoList, NewFixpointTable,
             !IrInfo),
         GoalExpr = switch(A, B, Cases),
@@ -433,8 +529,7 @@ indirect_reuse_analyse_goal(BaseInfo, !G
         GoalExpr0 = negation(_Goal)
     ;
         GoalExpr0 = scope(A, SubGoal0),
-        indirect_reuse_analyse_goal(BaseInfo, SubGoal0, SubGoal, !IrInfo,
-            !DepProcs),
+        indirect_reuse_analyse_goal(BaseInfo, SubGoal0, SubGoal, !IrInfo),
         GoalExpr = scope(A, SubGoal),
         !:Goal = hlds_goal(GoalExpr, GoalInfo0)
     ;
@@ -451,12 +546,12 @@ indirect_reuse_analyse_goal(BaseInfo, !G
         GoalExpr0 = if_then_else(A, IfGoal0, ThenGoal0, ElseGoal0),
         IrInfo0 = !.IrInfo,
         indirect_reuse_analyse_goal(BaseInfo, IfGoal0, IfGoal,
-            IrInfo0, IrInfoIfGoal, !DepProcs),
+            IrInfo0, IrInfoIfGoal),
         indirect_reuse_analyse_goal(BaseInfo, ThenGoal0, ThenGoal,
-            IrInfoIfGoal, IrInfoThenGoal, !DepProcs),
+            IrInfoIfGoal, IrInfoThenGoal),
         IrInfoElseGoal0 = IrInfo0 ^ fptable := IrInfoThenGoal ^ fptable,
         indirect_reuse_analyse_goal(BaseInfo, ElseGoal0, ElseGoal,
-            IrInfoElseGoal0, IrInfoElseGoal, !DepProcs),
+            IrInfoElseGoal0, IrInfoElseGoal),
         ir_analysis_info_lub(BaseInfo, IrInfoThenGoal, IrInfoElseGoal,
             !:IrInfo),
         GoalExpr = if_then_else(A, IfGoal, ThenGoal, ElseGoal),
@@ -469,7 +564,7 @@ indirect_reuse_analyse_goal(BaseInfo, !G
         OldSharing = !.IrInfo ^ sharing_as,
         add_foreign_proc_sharing(ModuleInfo, PredInfo, ProcInfo,
             ForeignPPId, Attributes, Args, Context, OldSharing, NewSharing),
-        !IrInfo ^ sharing_as := NewSharing
+        update_sharing_as(BaseInfo, OldSharing, NewSharing, !IrInfo)
     ;
         GoalExpr0 = shorthand(_),
         % These should have been expanded out by now.
@@ -482,34 +577,55 @@ indirect_reuse_analyse_goal(BaseInfo, !G
     %
 :- pred indirect_reuse_analyse_disj(ir_background_info::in,
     ir_analysis_info::in, hlds_goal::in, hlds_goal::out, ir_analysis_info::out,
-    sr_fixpoint_table::in, sr_fixpoint_table::out,
-    dep_procs::in, dep_procs::out) is det.
+    sr_fixpoint_table::in, sr_fixpoint_table::out) is det.
 
 indirect_reuse_analyse_disj(BaseInfo, IrInfo0, Goal0, Goal, IrInfo,
-        !FixpointTable, !DepProcs) :-
+        !FixpointTable) :-
     % Replace the state of the fixpoint_table in IrInfo0:
     NewIrInfo = IrInfo0 ^ fptable := !.FixpointTable,
-    indirect_reuse_analyse_goal(BaseInfo, Goal0, Goal, NewIrInfo, IrInfo,
-        !DepProcs),
+    indirect_reuse_analyse_goal(BaseInfo, Goal0, Goal, NewIrInfo, IrInfo),
     !:FixpointTable = IrInfo ^ fptable.
 
     % Similar to indirect_reuse_analyse_disj.
 :- pred indirect_reuse_analyse_case(ir_background_info::in,
     ir_analysis_info::in, case::in, case::out, ir_analysis_info::out,
-    sr_fixpoint_table::in, sr_fixpoint_table::out,
-    dep_procs::in, dep_procs::out) is det.
+    sr_fixpoint_table::in, sr_fixpoint_table::out) is det.
 
 indirect_reuse_analyse_case(BaseInfo, IrInfo0, Case0, Case, IrInfo,
-        !FixpointTable, !DepProcs) :-
+        !FixpointTable) :-
     Case0 = case(MainConsId, OtherConsIds, Goal0),
     % Replace the state of the fixpoint_table in IrInfo0:
     NewIrInfo = IrInfo0 ^ fptable := !.FixpointTable,
-    indirect_reuse_analyse_goal(BaseInfo, Goal0, Goal, NewIrInfo, IrInfo,
-        !DepProcs),
+    indirect_reuse_analyse_goal(BaseInfo, Goal0, Goal, NewIrInfo, IrInfo),
     !:FixpointTable = IrInfo ^ fptable,
     Case = case(MainConsId, OtherConsIds, Goal).
 
+:- pred update_sharing_as(ir_background_info::in, sharing_as::in,
+    sharing_as::in, ir_analysis_info::in, ir_analysis_info::out) is det.
+
+update_sharing_as(BaseInfo, OldSharing, NewSharing, !IrInfo) :-
+    DebugIndirect = BaseInfo ^ debug_indirect,
+    (
+        DebugIndirect = yes,
+        trace [io(!IO)] (
+            (
+                sharing_as_is_top(NewSharing),
+                not sharing_as_is_top(OldSharing)
+            ->
+                io.write_string("\tsharing is now top\n", !IO)
+            ;
+                true
+            )
+        )
+    ;
+        DebugIndirect = no
+    ),
+    !IrInfo ^ sharing_as := NewSharing.
+
 %-----------------------------------------------------------------------------%
+%
+% Verification of a reuse calls
+%
 
 :- type verify_indirect_reuse_reason
     --->    callee_has_no_reuses
@@ -519,31 +635,43 @@ indirect_reuse_analyse_case(BaseInfo, Ir
     ;       reuse_is_unconditional
     ;       reuse_is_conditional.
 
-:- pred verify_indirect_reuse(ir_background_info::in, pred_id::in, proc_id::in,
-    prog_vars::in, hlds_goal_info::in, hlds_goal_info::out,
+:- pred verify_indirect_reuse(ir_background_info::in, pred_proc_id::in,
+    list(int)::in, prog_vars::in, hlds_goal_info::in, hlds_goal_info::out,
     ir_analysis_info::in, ir_analysis_info::out) is det.
 
-verify_indirect_reuse(BaseInfo, CalleePredId, CalleeProcId, CalleeArgs,
+    % CalleePPId refers to the original procedure, not the procedure of any
+    % reuse version of another procedure.
+    %
+verify_indirect_reuse(BaseInfo, CalleePPId, NoClobbers, CalleeArgs,
         !GoalInfo, !IrInfo) :-
     % Find the reuse information of the called procedure in the reuse table:
-    CalleePPId = proc(CalleePredId, CalleeProcId),
-    lookup_reuse_as(BaseInfo, CalleePPId, !IrInfo, FormalReuseAs_Status),
-    FormalReuseAs_Status = reuse_as_and_status(FormalReuseAs, LookupStatus),
+    % XXX if we can't find an exact match for NoClobbers, we could try
+    % procedures which have no-clobber sets which are supersets of NoClobbers.
+    lookup_reuse_as(BaseInfo, CalleePPId, NoClobbers, !IrInfo, FormalReuseAs),
 
     (
         % If there is no reuse, then nothing can be done.
         reuse_as_no_reuses(FormalReuseAs)
     ->
-        Reason = callee_has_no_reuses
+        Reason = callee_has_no_reuses,
+        trace [io(!IO)] (
+            maybe_write_verify_indirect_reuse_reason(BaseInfo, CalleePPId,
+                NoClobbers, !.GoalInfo, Reason, !IO)
+        )
     ;
         reuse_as_all_unconditional_reuses(FormalReuseAs)
     ->
         % With unconditional reuse, we need to mark that the call is always
         % a reuse call.
         reuse_as_add_unconditional(!.IrInfo ^ reuse_as, NewReuseAs),
-        !:IrInfo = !.IrInfo ^ reuse_as := NewReuseAs,
-        goal_info_set_reuse(reuse(reuse_call(unconditional_reuse)), !GoalInfo),
-        Reason = callee_has_only_unconditional_reuse
+        !IrInfo ^ reuse_as := NewReuseAs,
+        goal_info_set_reuse(reuse(reuse_call(unconditional_reuse, NoClobbers)),
+            !GoalInfo),
+        trace [io(!IO)] (
+            maybe_write_verify_indirect_reuse_reason(BaseInfo, CalleePPId,
+                NoClobbers, !.GoalInfo, callee_has_only_unconditional_reuse,
+                !IO)
+        )
     ;
         % With a conditional reuse, we need to check the conditions. If they
         % are satisfied, these conditions need to be translated to the callers
@@ -557,84 +685,88 @@ verify_indirect_reuse(BaseInfo, CalleePr
             % pairs. In this case, reuse is not allowed.
             sharing_as_is_top(!.IrInfo ^ sharing_as)
         ->
-            % no need to update anything
-            Reason = current_sharing_is_top
-        ;
-            verify_indirect_reuse_2(BaseInfo, !.IrInfo, !.GoalInfo,
-                CalleePPId, CalleeArgs, FormalReuseAs, NewAndRenamedReuseAs,
-                NotDeadVars),
-            (
-                reuse_as_no_reuses(NewAndRenamedReuseAs)
-            ->
-                % Don't do anything.
-                Reason = reuse_is_unsafe(NotDeadVars)
-            ;
-                reuse_as_all_unconditional_reuses(NewAndRenamedReuseAs)
-            ->
-                % Update reuse information and goal_info:
-                reuse_as_add_unconditional(!.IrInfo ^ reuse_as, NewReuseAs),
-                !IrInfo ^ reuse_as := NewReuseAs,
-                goal_info_set_reuse(reuse(reuse_call(unconditional_reuse)),
-                    !GoalInfo),
-                Reason = reuse_is_unconditional
-            ;
-                % Update reuse information and goal_info:
-                reuse_as_least_upper_bound(BaseInfo ^ module_info,
-                    BaseInfo ^ proc_info, !.IrInfo ^ reuse_as,
-                    NewAndRenamedReuseAs, NewReuseAs),
-                !IrInfo ^ reuse_as := NewReuseAs,
-                goal_info_set_reuse(
-                    potential_reuse(reuse_call(conditional_reuse)),
-                    !GoalInfo),
-                Reason = reuse_is_conditional
+            % No need to update anything.
+            trace [io(!IO)] (
+                maybe_write_verify_indirect_reuse_reason(BaseInfo, CalleePPId,
+                    NoClobbers, !.GoalInfo, current_sharing_is_top, !IO)
             )
-        )
-    ),
-
-    % Combine the status of the reuse information with the status of the
-    % current analysis.
-    !IrInfo ^ analysis_status := lub(LookupStatus, !.IrInfo ^ analysis_status),
-
-    % Output the reasoning behind the result.
-    trace [io(!IO)] (
-        DebugIndirect = BaseInfo ^ debug_indirect,
-        (
-            DebugIndirect = yes,
-            ModuleInfo = BaseInfo ^ module_info,
-            GoalReuse = goal_info_get_reuse(!.GoalInfo),
-            Context = goal_info_get_context(!.GoalInfo),
-            proc_info_get_varset(BaseInfo ^ proc_info, VarSet),
-            io.write_string("\tcall to ", !IO),
-            write_pred_proc_id_pair(ModuleInfo, CalleePredId, CalleeProcId,
-                !IO),
-            io.write_string("\n\tfrom ", !IO),
-            write_context(Context, !IO),
-            io.write_string("\n\t\treuse: ", !IO),
-            io.write(GoalReuse, !IO),
-            io.write_string("\n\t\treason: ", !IO),
-            write_verify_indirect_reuse_reason(Reason, VarSet, !IO),
-            io.nl(!IO)
         ;
-            DebugIndirect = no
+            verify_indirect_reuse_conditional(BaseInfo, CalleePPId, NoClobbers,
+                CalleeArgs, FormalReuseAs, !GoalInfo, !IrInfo)
         )
     ).
 
-:- pred lookup_reuse_as(ir_background_info::in, pred_proc_id::in,
-    ir_analysis_info::in, ir_analysis_info::out, reuse_as_and_status::out)
-    is det.
+:- pred verify_indirect_reuse_conditional(ir_background_info::in,
+    pred_proc_id::in, no_clobber_args::in, prog_vars::in, reuse_as::in,
+    hlds_goal_info::in, hlds_goal_info::out, ir_analysis_info::in,
+    ir_analysis_info::out) is det.
 
-lookup_reuse_as(BaseInfo, PPId, !IrInfo, ReuseAs) :-
+verify_indirect_reuse_conditional(BaseInfo, CalleePPId, NoClobbers, CalleeArgs,
+        FormalReuseAs, !GoalInfo, !IrInfo) :-
+    verify_indirect_reuse_for_call(BaseInfo, !.IrInfo, !.GoalInfo, CalleePPId,
+        CalleeArgs, FormalReuseAs, NewAndRenamedReuseAs, NotDeadVars),
     (
-        % Check in the fixpoint table
-        sr_fixpoint_table_get_as(PPId, ReuseAs0, !.IrInfo ^ fptable,
-            NewFixpointTable)
+        reuse_as_no_reuses(NewAndRenamedReuseAs)
     ->
-        ReuseAs = ReuseAs0,
-        !IrInfo ^ fptable := NewFixpointTable
+        get_var_indices(NotDeadVars, CalleeArgs, 1, NotDeadArgNums0),
+        NotDeadArgNums = list.sort_and_remove_dups(NotDeadArgNums0
+            ++ NoClobbers),
+        (
+            NotDeadArgNums = NoClobbers
+        ->
+            % Don't do anything.  Don't even request a new version.
+            trace [io(!IO)] (
+                maybe_write_verify_indirect_reuse_reason(BaseInfo, CalleePPId,
+                    NoClobbers, !.GoalInfo, reuse_is_unsafe(NotDeadVars), !IO)
+            )
+        ;
+            % If there is already an entry for the callee procedure with the
+            % same set of no-clobber arguments we don't need to make a request.
+            % XXX might we look up the result for the procedures we're
+            % currently analysing, and would that be a problem?
+            reuse_as_table_search_reuse_version_proc(BaseInfo ^ reuse_table,
+                CalleePPId, NotDeadArgNums, _ReusePPId)
+        ->
+            verify_indirect_reuse(BaseInfo, CalleePPId, NotDeadArgNums,
+                CalleeArgs, !GoalInfo, !IrInfo)
+        ;
+            % Request another version of the procedure.
+            maybe_add_request(BaseInfo, CalleePPId, NotDeadArgNums, !IrInfo),
+            trace [io(!IO)] (
+                maybe_write_verify_indirect_reuse_reason(BaseInfo, CalleePPId,
+                    NoClobbers, !.GoalInfo, reuse_is_unsafe(NotDeadVars), !IO)
+            )
+        )
     ;
-        % Or check in the reuse table
-        ReuseAs = get_reuse_as(BaseInfo ^ module_info, BaseInfo ^ reuse_table,
-            PPId)
+        reuse_as_all_unconditional_reuses(NewAndRenamedReuseAs)
+    ->
+        % Update reuse information and goal_info:
+        reuse_as_add_unconditional(!.IrInfo ^ reuse_as, NewReuseAs),
+        !IrInfo ^ reuse_as := NewReuseAs,
+        goal_info_set_reuse(reuse(reuse_call(unconditional_reuse, NoClobbers)),
+            !GoalInfo),
+        trace [io(!IO)] (
+            maybe_write_verify_indirect_reuse_reason(BaseInfo, CalleePPId,
+                NoClobbers, !.GoalInfo, reuse_is_unconditional, !IO)
+        )
+    ;
+        reuse_as_conditional_reuses(NewAndRenamedReuseAs)
+    ->
+        % Update reuse information and goal_info:
+        reuse_as_least_upper_bound(BaseInfo ^ module_info,
+            BaseInfo ^ proc_info, !.IrInfo ^ reuse_as, NewAndRenamedReuseAs,
+            NewReuseAs),
+        !IrInfo ^ reuse_as := NewReuseAs,
+        goal_info_set_reuse(
+            potential_reuse(reuse_call(conditional_reuse, NoClobbers)),
+            !GoalInfo),
+        trace [io(!IO)] (
+            maybe_write_verify_indirect_reuse_reason(BaseInfo, CalleePPId,
+                NoClobbers, !.GoalInfo, reuse_is_conditional, !IO)
+        )
+    ;
+        unexpected(this_file,
+            "verify_indirect_reuse_conditional: unknown NewReuseAs")
     ).
 
     % Verify whether the caller's environment satisfies the reuse conditions
@@ -645,12 +777,12 @@ lookup_reuse_as(BaseInfo, PPId, !IrInfo,
     % Pre-conditions: The sharing is not top, and reuse_as contains at least
     % one conditional reuse condition.
     %
-:- pred verify_indirect_reuse_2(ir_background_info::in, ir_analysis_info::in,
-    hlds_goal_info::in, pred_proc_id::in, list(prog_var)::in, reuse_as::in,
-    reuse_as::out, prog_vars::out) is det.
+:- pred verify_indirect_reuse_for_call(ir_background_info::in,
+    ir_analysis_info::in, hlds_goal_info::in, pred_proc_id::in,
+    list(prog_var)::in, reuse_as::in, reuse_as::out, prog_vars::out) is det.
 
-verify_indirect_reuse_2(BaseInfo, IrInfo, GoalInfo, CalleePPId,
-        CalleeArgs, FormalReuseAs, NewReuseAs, NotDeadVars):-
+verify_indirect_reuse_for_call(BaseInfo, IrInfo, GoalInfo, CalleePPId,
+        CalleeArgs, FormalReuseAs, NewReuseAs, NotDeadVars) :-
     ModuleInfo = BaseInfo ^ module_info,
     PredInfo = BaseInfo ^ pred_info,
     ProcInfo = BaseInfo ^ proc_info,
@@ -686,14 +818,99 @@ verify_indirect_reuse_2(BaseInfo, IrInfo
         (
             ( Reason = no_reuse
             ; Reason = unknown_livedata
-            ; Reason = reuse_nodes_have_sharing
             ),
             NotDeadVars = []
         ;
             Reason = reuse_condition_violated(NotDeadVars)
+        ;
+            Reason = reuse_nodes_have_sharing(NotDeadVars)
         )
     ).
 
+:- pred lookup_reuse_as(ir_background_info::in, pred_proc_id::in,
+    list(int)::in, ir_analysis_info::in, ir_analysis_info::out,
+    reuse_as::out) is det.
+
+lookup_reuse_as(BaseInfo, OrigPPId, NoClobbers, !IrInfo, ReuseAs) :-
+    (
+        reuse_as_table_search_reuse_version_proc(BaseInfo ^ reuse_table,
+            OrigPPId, NoClobbers, PPId0)
+    ->
+        PPId = PPId0
+    ;
+        NoClobbers = []
+    ->
+        PPId = OrigPPId
+    ;
+        unexpected(this_file, "lookup_reuse_as")
+    ),
+    (
+        % Check in the fixpoint table
+        sr_fixpoint_table_get_as(PPId, ReuseAs_Status0, !.IrInfo ^ fptable,
+            NewFixpointTable)
+    ->
+        ReuseAs_Status = ReuseAs_Status0,
+        !IrInfo ^ fptable := NewFixpointTable
+    ;
+        % Or check in the reuse table
+        ReuseAs_Status = get_reuse_as(BaseInfo ^ reuse_table, PPId)
+    ),
+
+    ReuseAs_Status = reuse_as_and_status(ReuseAs, Status),
+
+    % Combine the status of the reuse information with the status of the
+    % current analysis.
+    !IrInfo ^ analysis_status := lub(Status, !.IrInfo ^ analysis_status),
+
+    % If the called procedure was imported (not opt_imported) then remember
+    % that this module depends on the results for that procedure.
+    (
+        pred_info_get_import_status(BaseInfo ^ pred_info, PredImportStatus),
+        status_defined_in_this_module(PredImportStatus) = yes,
+
+        OrigPPId = proc(CalleePredId, _),
+        module_info_pred_info(BaseInfo ^ module_info, CalleePredId,
+            CalleePredInfo),
+        pred_info_get_import_status(CalleePredInfo, CalleeImportStatus),
+        CalleeImportStatus = status_imported(_),
+        \+ is_unify_or_compare_pred(CalleePredInfo)
+    ->
+        Dep = ppid_no_clobbers(OrigPPId, NoClobbers),
+        !IrInfo ^ dep_procs := set.insert(!.IrInfo ^ dep_procs, Dep)
+    ;
+        true
+    ).
+
+    % Output the reasoning behind the result.
+    %
+:- pred maybe_write_verify_indirect_reuse_reason(ir_background_info::in,
+    pred_proc_id::in, list(int)::in, hlds_goal_info::in,
+    verify_indirect_reuse_reason::in, io::di, io::uo) is det.
+
+maybe_write_verify_indirect_reuse_reason(BaseInfo, CalleePPId, NoClobbers,
+        GoalInfo, Reason, !IO) :-
+    DebugIndirect = BaseInfo ^ debug_indirect,
+    (
+        DebugIndirect = yes,
+        ModuleInfo = BaseInfo ^ module_info,
+        GoalReuse = goal_info_get_reuse(GoalInfo),
+        Context = goal_info_get_context(GoalInfo),
+        proc_info_get_varset(BaseInfo ^ proc_info, VarSet),
+        io.write_string("\tcall to ", !IO),
+        write_pred_proc_id(ModuleInfo, CalleePPId, !IO),
+        io.write_string("\n\tfrom ", !IO),
+        write_context(Context, !IO),
+        io.write_string("\n\twith NoClobbers = ", !IO),
+        io.write(NoClobbers, !IO),
+        io.write_string("\n\t\treuse: ", !IO),
+        io.write(GoalReuse, !IO),
+        io.write_string("\n\t\treason: ", !IO),
+        write_verify_indirect_reuse_reason(Reason, VarSet, !IO),
+        io.nl(!IO)
+    ;
+        DebugIndirect = no
+    ).
+
 :- pred write_verify_indirect_reuse_reason(verify_indirect_reuse_reason::in,
     prog_varset::in, io::di, io::uo) is det.
 
@@ -713,14 +930,42 @@ write_verify_indirect_reuse_reason(Reaso
         io.write_string(")", !IO)
     ).
 
-%-----------------------------------------------------------------------------%
+:- pred get_var_indices(prog_vars::in, prog_vars::in, int::in,
+    list(int)::out) is det.
 
-:- pred update_reuse_in_table(sr_fixpoint_table::in, pred_proc_id::in,
-    reuse_as_table::in, reuse_as_table::out) is det.
+get_var_indices(_, [], _, []).
+get_var_indices(List, [Var | Vars], Index, Indices) :-
+    get_var_indices(List, Vars, Index + 1, Indices0),
+    ( list.member(Var, List) ->
+        Indices = [Index | Indices0]
+    ;
+        Indices = Indices0
+    ).
 
-update_reuse_in_table(FixpointTable, PPId, !ReuseTable) :-
-    reuse_as_table_set(PPId,
-        sr_fixpoint_table_get_final_as(PPId, FixpointTable), !ReuseTable).
+:- pred maybe_add_request(ir_background_info::in, pred_proc_id::in,
+    list(int)::in, ir_analysis_info::in, ir_analysis_info::out) is det.
+
+maybe_add_request(BaseInfo, CalleePPId, NotDeadArgNums, !IrInfo) :-
+    CalleePPId = proc(CalleePredId, _),
+    ModuleInfo = BaseInfo ^ module_info,
+    module_info_pred_info(ModuleInfo, CalleePredId, PredInfo),
+    pred_info_get_import_status(PredInfo, ImportStatus),
+    ( status_defined_in_this_module(ImportStatus) = yes ->
+        Request = sr_request(CalleePPId, NotDeadArgNums),
+        !IrInfo ^ requests := set.insert(!.IrInfo ^ requests, Request)
+    ;
+        module_info_get_globals(ModuleInfo, Globals),
+        globals.lookup_bool_option(Globals, intermodule_analysis,
+            IntermoduleAnalysis),
+        (
+            IntermoduleAnalysis = yes, 
+            Request = sr_request(CalleePPId, NotDeadArgNums),
+            !IrInfo ^ inter_requests :=
+                set.insert(!.IrInfo ^ inter_requests, Request)
+        ;
+            IntermoduleAnalysis = no
+        )
+    ).
 
 %-----------------------------------------------------------------------------%
 %
@@ -732,7 +977,7 @@ update_reuse_in_table(FixpointTable, PPI
 
     % Initialise the fixpoint table for the given set of pred_proc_id's.
     %
-:- func sr_fixpoint_table_init(module_info, list(pred_proc_id), reuse_as_table)
+:- func sr_fixpoint_table_init(list(pred_proc_id), reuse_as_table)
     = sr_fixpoint_table.
 
     % Add the results of a new analysis pass to the already existing
@@ -795,30 +1040,20 @@ update_reuse_in_table(FixpointTable, PPI
 
 %-----------------------------------------------------------------------------%
 
-:- func get_reuse_as(module_info, reuse_as_table, pred_proc_id) =
-    reuse_as_and_status.
+:- func get_reuse_as(reuse_as_table, pred_proc_id) = reuse_as_and_status.
 
-get_reuse_as(ModuleInfo, ReuseTable, PPId) = ReuseAs :-
-    ( reuse_as_table_search(PPId, ReuseTable, ReuseAs0) ->
+get_reuse_as(ReuseTable, PPId) = ReuseAs :-
+    ( reuse_as_table_search(ReuseTable, PPId, ReuseAs0) ->
         ReuseAs = ReuseAs0
     ;
-        PPId = proc(PredId, _),
-        module_info_pred_info(ModuleInfo, PredId, PredInfo),
-        (
-            ( is_unify_or_compare_pred(PredInfo)
-            ; pred_info_get_import_status(PredInfo, status_external(_))
-            )
-        ->
-            Status = optimal
-        ;
-            % XXX not sure about this
-            Status = suboptimal
-        ),
-        ReuseAs = reuse_as_and_status(reuse_as_init, Status)
+        % We assume an unknown answer is `optimal' otherwise we would not be
+        % able to get mutually recursive procedures out of the `suboptimal'
+        % state.
+        ReuseAs = reuse_as_and_status(reuse_as_init, optimal)
     ).
 
-sr_fixpoint_table_init(ModuleInfo, Keys, ReuseTable) = Table :-
-    Table = init_fixpoint_table(get_reuse_as(ModuleInfo, ReuseTable), Keys).
+sr_fixpoint_table_init(Keys, ReuseTable) = Table :-
+    Table = init_fixpoint_table(get_reuse_as(ReuseTable), Keys).
 
 sr_fixpoint_table_new_run(!Table) :-
     fixpoint_table.new_run(!Table).
Index: compiler/structure_reuse.lfu.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.lfu.m,v
retrieving revision 1.10
diff -u -p -r1.10 structure_reuse.lfu.m
--- compiler/structure_reuse.lfu.m	27 Feb 2008 07:23:15 -0000	1.10
+++ compiler/structure_reuse.lfu.m	26 May 2008 01:34:13 -0000
@@ -23,9 +23,20 @@
 :- interface.
 
 :- import_module hlds.hlds_pred.
+:- import_module parse_tree.prog_data.
+:- import_module set.
+
+%-----------------------------------------------------------------------------%
 
 :- pred forward_use_information(proc_info::in, proc_info::out) is det.
 
+    % add_vars_to_lfu(Vars, !ProcInfo).
+    %
+    % Add the vars to all the LFU sets in the body of the procedure.
+    %
+:- pred add_vars_to_lfu(set(prog_var)::in, proc_info::in, proc_info::out)
+    is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -35,12 +46,10 @@
 :- import_module hlds.hlds_llds.
 :- import_module hlds.hlds_pred.
 :- import_module libs.compiler_util.
-:- import_module parse_tree.prog_data.
 :- import_module parse_tree.prog_type.
 
 :- import_module list.
 :- import_module map.
-:- import_module set.
 :- import_module pair.
 
 %-----------------------------------------------------------------------------%
@@ -212,6 +221,103 @@ forward_use_in_disj_goal(VarTypes, Inst0
 
 %-----------------------------------------------------------------------------%
 
+add_vars_to_lfu(ForceInUse, !ProcInfo) :-
+    proc_info_get_goal(!.ProcInfo, Goal0),
+    add_vars_to_lfu_in_goal(ForceInUse, Goal0, Goal),
+    proc_info_set_goal(Goal, !ProcInfo).
+
+:- pred add_vars_to_lfu_in_goal(set(prog_var)::in,
+    hlds_goal::in, hlds_goal::out) is det.
+
+add_vars_to_lfu_in_goal(ForceInUse, Goal0, Goal) :-
+    Goal0 = hlds_goal(Expr0, GoalInfo0),
+    add_vars_to_lfu_in_goal_expr(ForceInUse, Expr0, Expr),
+    LFU0 = goal_info_get_lfu(GoalInfo0),
+    LFU = set.union(ForceInUse, LFU0),
+    goal_info_set_lfu(LFU, GoalInfo0, GoalInfo1),
+    goal_info_set_reuse(no_reuse_info, GoalInfo1, GoalInfo),
+    Goal = hlds_goal(Expr, GoalInfo).
+
+:- pred add_vars_to_lfu_in_goal_expr(set(prog_var)::in,
+    hlds_goal_expr::in, hlds_goal_expr::out) is det.
+
+add_vars_to_lfu_in_goal_expr(ForceInUse, Expr0, Expr) :-
+    (
+        Expr0 = conj(ConjType, Goals0),
+        add_vars_to_lfu_in_goals(ForceInUse, Goals0, Goals),
+        Expr = conj(ConjType, Goals)
+    ;
+        Expr0 = disj(Goals0),
+        add_vars_to_lfu_in_goals(ForceInUse, Goals0, Goals),
+        Expr = disj(Goals)
+    ;
+        Expr0 = switch(Var, Det, Cases0),
+        add_vars_to_lfu_in_cases(ForceInUse, Cases0, Cases),
+        Expr = switch(Var, Det, Cases)
+    ;
+        Expr0 = if_then_else(Vars, Cond0, Then0, Else0),
+        add_vars_to_lfu_in_goal(ForceInUse, Cond0, Cond),
+        add_vars_to_lfu_in_goal(ForceInUse, Then0, Then),
+        add_vars_to_lfu_in_goal(ForceInUse, Else0, Else),
+        Expr = if_then_else(Vars, Cond, Then, Else)
+    ;
+        Expr0 = negation(Goal0),
+        add_vars_to_lfu_in_goal(ForceInUse, Goal0, Goal),
+        Expr = negation(Goal)
+    ;
+        Expr0 = scope(Reason, Goal0),
+        add_vars_to_lfu_in_goal(ForceInUse, Goal0, Goal),
+        Expr = scope(Reason, Goal)
+    ;
+        Expr0 = generic_call(_, _, _, _),
+        Expr = Expr0
+    ;
+        Expr0 = plain_call(_, _, _, _, _, _),
+        Expr = Expr0
+    ;
+        Expr0 = unify(_, _, _, _, _),
+        Expr = Expr0
+    ;
+        Expr0 = call_foreign_proc(_, _, _, _, _, _, _),
+        Expr = Expr0
+    ;
+        Expr0 = shorthand(Shorthand0),
+        (
+            Shorthand0 = atomic_goal(GoalType, Outer, Inner,
+                MaybeOutputVars, MainGoal0, OrElseGoals0),
+            add_vars_to_lfu_in_goal(ForceInUse, MainGoal0, MainGoal),
+            add_vars_to_lfu_in_goals(ForceInUse, OrElseGoals0, OrElseGoals),
+            Shorthand = atomic_goal(GoalType, Outer, Inner,
+                MaybeOutputVars, MainGoal, OrElseGoals)
+        ;
+            Shorthand0 = bi_implication(LeftGoal0, RightGoal0),
+            add_vars_to_lfu_in_goal(ForceInUse, LeftGoal0, LeftGoal),
+            add_vars_to_lfu_in_goal(ForceInUse, RightGoal0, RightGoal),
+            Shorthand = bi_implication(LeftGoal, RightGoal)
+        ),
+        Expr = shorthand(Shorthand)
+    ).
+
+:- pred add_vars_to_lfu_in_goals(set(prog_var)::in,
+    hlds_goals::in, hlds_goals::out) is det.
+
+add_vars_to_lfu_in_goals(_, [], []).
+add_vars_to_lfu_in_goals(ForceInUse, [Goal0 | Goals0], [Goal | Goals]) :-
+    add_vars_to_lfu_in_goal(ForceInUse, Goal0, Goal),
+    add_vars_to_lfu_in_goals(ForceInUse, Goals0, Goals).
+
+:- pred add_vars_to_lfu_in_cases(set(prog_var)::in,
+    list(case)::in, list(case)::out) is det.
+
+add_vars_to_lfu_in_cases(_, [], []).
+add_vars_to_lfu_in_cases(ForceInUse, [Case0 | Cases0], [Case | Cases]) :-
+    Case0 = case(MainConsId, OtherConsIds, Goal0),
+    add_vars_to_lfu_in_goal(ForceInUse, Goal0, Goal),
+    Case = case(MainConsId, OtherConsIds, Goal),
+    add_vars_to_lfu_in_cases(ForceInUse, Cases0, Cases).
+
+%-----------------------------------------------------------------------------%
+
 :- func this_file = string.
 
 this_file = "structure_reuse.lfu.m".
Index: compiler/structure_reuse.versions.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.versions.m,v
retrieving revision 1.15
diff -u -p -r1.15 structure_reuse.versions.m
--- compiler/structure_reuse.versions.m	19 May 2008 01:03:45 -0000	1.15
+++ compiler/structure_reuse.versions.m	26 May 2008 01:34:13 -0000
@@ -21,8 +21,6 @@
 :- import_module hlds.hlds_pred.
 :- import_module transform_hlds.ctgc.structure_reuse.domain.
 
-:- import_module io.
-
 %------------------------------------------------------------------------------%
 
 
@@ -40,13 +38,21 @@
     % and recording the pred-proc-id to the reuse pred-proc-id mappings in
     % module_info.
     %
-:- pred create_reuse_procedures(reuse_as_table::in, module_info::in,
-    module_info::out, io::di, io::uo) is det.
+:- pred create_reuse_procedures(reuse_as_table::in, reuse_as_table::out,
+    module_info::in, module_info::out) is det.
+
+    % Create a copy of the predicate/procedure information specified by the
+    % given pred_proc_id, and return the pred_proc_id of that copy.  The copy
+    % is not altered w.r.t. structure reuse. It is a plain copy, nothing more
+    % than that.
+    %
+:- pred create_fresh_pred_proc_info_copy(pred_proc_id::in, no_clobber_args::in,
+    pred_proc_id::out, module_info::in, module_info::out) is det.
 
     % Create a fake reuse procedure that simply calls the non-reuse procedure.
     %
-:- pred create_fake_reuse_procedure(pred_proc_id::in, module_info::in,
-    module_info::out) is det.
+:- pred create_fake_reuse_procedure(pred_proc_id::in, no_clobber_args::in,
+    module_info::in, module_info::out) is det.
 
 %------------------------------------------------------------------------------%
 %------------------------------------------------------------------------------%
@@ -64,67 +70,81 @@
 :- import_module mdbcomp.prim_data.
 :- import_module parse_tree.prog_util.
 
-:- import_module bool.
 :- import_module list.
 :- import_module map.
 :- import_module maybe.
-:- import_module pair.
+:- import_module set.
+:- import_module string.
 
 %------------------------------------------------------------------------------%
 
 :- type reuse_name == sym_name.
 
-:- func generate_reuse_name(module_info, pred_proc_id) = reuse_name.
+:- func generate_reuse_name(module_info, pred_proc_id, list(int)) = reuse_name.
 
-generate_reuse_name(ModuleInfo, PPId) = ReuseName :-
-    module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _ProcInfo),
+generate_reuse_name(ModuleInfo, PPId, NoClobbers) = ReuseName :-
     PPId = proc(_, ProcId),
-    Line = 0,
-    Counter = proc_id_to_int(ProcId),
-    make_pred_name_with_context(pred_info_module(PredInfo), "ctgc",
-        pred_info_is_pred_or_func(PredInfo), pred_info_name(PredInfo),
-        Line, Counter, ReuseName).
+    module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _ProcInfo),
+    PredModule = pred_info_module(PredInfo),
+    PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+    PredName = pred_info_name(PredInfo),
+    proc_id_to_int(ProcId, ProcInt),
+    make_pred_name(PredModule, "ctgc", yes(PredOrFunc), PredName,
+        newpred_structure_reuse(ProcInt, NoClobbers), ReuseName).
 
 %------------------------------------------------------------------------------%
 
     % This process can be split into separate steps:
     % - determine all the pred-proc-ids of procedure with conditional reuse;
-    % - create duplicates of these procedures (and record the mapping in
-    %   the structure_reuse_map in module_info);
+    % - create duplicates of these procedures;
     % - traverse all these procedures + the procedures with unconditional reuse
     %   to correctly update the reuse annotations.
     %
-create_reuse_procedures(ReuseTable, !ModuleInfo, !IO):-
-    map.foldl2(divide_reuse_procs, ReuseTable, [], CondPPIds, [], UncondPPIds),
-
-    % Create duplicates of the procedures which have conditional reuse.
-    list.map_foldl(create_fresh_pred_proc_info_copy,
-        CondPPIds, ReuseCondPPIds, !ModuleInfo),
+create_reuse_procedures(!ReuseTable, !ModuleInfo) :-
+    % Get the list of conditional reuse procedures already created.
+    ExistingReusePPIds = map.values(!.ReuseTable ^ reuse_version_map),
+    ExistingReusePPIdsSet = set.from_list(ExistingReusePPIds),
+
+    map.foldl2(divide_reuse_procs(ExistingReusePPIdsSet),
+        !.ReuseTable ^ reuse_info_map, [], CondOrigPPIds, [], UncondOrigPPIds),
+
+    % Create duplicates of the procedures which have conditional reuse.  The
+    % "intermediate" reuse procedures will already have been created during the
+    % analysis, so this creates just the reuse versions where all possible
+    % arguments are potentially reusable.
+    list.map_foldl2(maybe_create_full_reuse_proc_copy,
+        CondOrigPPIds, ReuseCondPPIds, !ModuleInfo, !ReuseTable),
 
     % Process all the goals to update the reuse annotations.  In the reuse
     % versions of procedures we can take advantage of potential reuse
     % opportunities.
-    module_info_get_structure_reuse_map(!.ModuleInfo, ReuseMap),
-    list.foldl2(process_proc(convert_potential_reuse, ReuseMap),
-        ReuseCondPPIds, !ModuleInfo, !IO),
+    list.foldl(process_proc(convert_potential_reuse, !.ReuseTable),
+        ReuseCondPPIds, !ModuleInfo),
+    list.foldl(process_proc(convert_potential_reuse, !.ReuseTable),
+        ExistingReusePPIds, !ModuleInfo),
 
     % In the original procedures, only the unconditional reuse opportunities
     % can be taken.
-    list.foldl2(process_proc(leave_potential_reuse, ReuseMap),
-        CondPPIds, !ModuleInfo, !IO),
-    list.foldl2(process_proc(leave_potential_reuse, ReuseMap),
-        UncondPPIds, !ModuleInfo, !IO).
+    list.foldl(process_proc(leave_potential_reuse, !.ReuseTable),
+        CondOrigPPIds, !ModuleInfo),
+    list.foldl(process_proc(leave_potential_reuse, !.ReuseTable),
+        UncondOrigPPIds, !ModuleInfo).
 
     % Separate procedures in the reuse table into those with some conditional
     % reuse opportunities, and those with only unconditional reuse.
+    % Skip any procedure which is already a reuse copy of another procedure.
     %
-:- pred divide_reuse_procs(pred_proc_id::in, reuse_as_and_status::in,
+:- pred divide_reuse_procs(set(pred_proc_id)::in,
+    pred_proc_id::in, reuse_as_and_status::in,
     list(pred_proc_id)::in, list(pred_proc_id)::out,
     list(pred_proc_id)::in, list(pred_proc_id)::out) is det.
 
-divide_reuse_procs(PPId, ReuseAs_Status, !CondPPIds, !UncondPPIds) :-
+divide_reuse_procs(ExistingReusePPIdsSet, PPId, ReuseAs_Status,
+        !CondPPIds, !UncondPPIds) :-
     ReuseAs_Status = reuse_as_and_status(ReuseAs, _),
-    ( reuse_as_conditional_reuses(ReuseAs) ->
+    ( set.contains(ExistingReusePPIdsSet, PPId) ->
+        true
+    ; reuse_as_conditional_reuses(ReuseAs) ->
         !:CondPPIds = [PPId | !.CondPPIds]
     ; reuse_as_all_unconditional_reuses(ReuseAs) ->
         !:UncondPPIds = [PPId | !.UncondPPIds]
@@ -134,32 +154,49 @@ divide_reuse_procs(PPId, ReuseAs_Status,
         unexpected(this_file, "divide_reuse_procs")
     ).
 
-%------------------------------------------------------------------------------%
+:- pred maybe_create_full_reuse_proc_copy(pred_proc_id::in, pred_proc_id::out,
+    module_info::in, module_info::out, reuse_as_table::in, reuse_as_table::out)
+    is det.
 
-    % Create a copy of the predicate/procedure information specified by the
-    % given pred_proc_id, and return the pred_proc_id of that copy.  This
-    % operation also updates the structure_reuse_map in the HLDS. Note that the
-    % copy is not altered w.r.t. structure reuse. It is a plain copy, nothing
-    % more than that.
-    %
-:- pred create_fresh_pred_proc_info_copy(pred_proc_id::in, pred_proc_id::out,
-    module_info::in, module_info::out) is det.
+maybe_create_full_reuse_proc_copy(PPId, NewPPId, !ModuleInfo, !ReuseTable) :-
+    NoClobbers = [],
+    (
+        reuse_as_table_search_reuse_version_proc(!.ReuseTable,
+            PPId, NoClobbers, _)
+    ->
+        unexpected(this_file,
+            "maybe_create_full_reuse_proc_copy: procedure already exists")
+    ;
+        true
+    ),
+    create_fresh_pred_proc_info_copy(PPId, NoClobbers, NewPPId, !ModuleInfo),
+    ( reuse_as_table_search(!.ReuseTable, PPId, ReuseAs_Status) ->
+        reuse_as_table_set(NewPPId, ReuseAs_Status, !ReuseTable),
+        reuse_as_table_insert_reuse_version_proc(PPId, NoClobbers, NewPPId,
+            !ReuseTable)
+    ;
+        unexpected(this_file,
+            "maybe_create_full_reuse_proc_copy: no reuse information")
+    ).
+
+%------------------------------------------------------------------------------%
 
-create_fresh_pred_proc_info_copy(PPId, NewPPId, !ModuleInfo) :-
+create_fresh_pred_proc_info_copy(PPId, NoClobbers, NewPPId, !ModuleInfo) :-
     module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
-    ReusePredName = generate_reuse_name(!.ModuleInfo, PPId),
+    ReusePredName = generate_reuse_name(!.ModuleInfo, PPId, NoClobbers),
     PPId = proc(PredId, _),
     create_fresh_pred_proc_info_copy_2(PredId, PredInfo0, ProcInfo0,
         ReusePredName, ReusePredInfo, ReuseProcId),
 
+    NewPPId = proc(ReusePredId, ReuseProcId),
+
     module_info_get_predicate_table(!.ModuleInfo, PredTable0),
     predicate_table_insert(ReusePredInfo, ReusePredId, PredTable0, PredTable),
-    NewPPId = proc(ReusePredId, ReuseProcId),
     module_info_set_predicate_table(PredTable, !ModuleInfo),
 
-    module_info_get_structure_reuse_map(!.ModuleInfo, ReuseMap0),
-    map.det_insert(ReuseMap0, PPId, NewPPId - ReusePredName, ReuseMap),
-    module_info_set_structure_reuse_map(ReuseMap, !ModuleInfo).
+    module_info_get_structure_reuse_preds(!.ModuleInfo, ReusePreds0),
+    set.insert(ReusePreds0, ReusePredId, ReusePreds),
+    module_info_set_structure_reuse_preds(ReusePreds, !ModuleInfo).
 
 :- pred create_fresh_pred_proc_info_copy_2(pred_id::in, pred_info::in,
     proc_info::in, reuse_name::in, pred_info::out, proc_id::out) is det.
@@ -204,21 +241,24 @@ create_fresh_pred_proc_info_copy_2(PredI
     % reuse version (if of course, that is in accordance with the reuse
     % annotations).
     %
-:- pred process_proc(convert_potential_reuse::in, structure_reuse_map::in,
-    pred_proc_id::in, module_info::in, module_info::out,
-    io::di, io::uo) is det.
+:- pred process_proc(convert_potential_reuse::in, reuse_as_table::in,
+    pred_proc_id::in, module_info::in, module_info::out) is det.
 
-process_proc(ConvertPotentialReuse, ReuseMap, PPId, !ModuleInfo, !IO) :-
-    write_proc_progress_message("(reuse version) ", PPId, !.ModuleInfo, !IO),
+process_proc(ConvertPotentialReuse, ReuseTable, PPId, !ModuleInfo) :-
+    trace [io(!IO)] (
+        write_proc_progress_message("(reuse version) ", PPId, !.ModuleInfo,
+            !IO)
+    ),
     some [!ProcInfo] (
         module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, !:ProcInfo),
         pred_info_get_import_status(PredInfo0, ImportStatus),
         ( ImportStatus = status_imported(_) ->
-            % Don't process the bodies of imported predicates.
+            % The bodies may contain junk, so don't try to process.
             true
         ;
             proc_info_get_goal(!.ProcInfo, Goal0),
-            process_goal(ConvertPotentialReuse, ReuseMap, Goal0, Goal, !IO),
+            process_goal(ConvertPotentialReuse, ReuseTable, !.ModuleInfo,
+                Goal0, Goal),
             proc_info_set_goal(Goal, !ProcInfo),
 
             % A dead variable needs to appear in the non-local set of the
@@ -226,22 +266,23 @@ process_proc(ConvertPotentialReuse, Reus
             % requantify.  Then we recompute instmap deltas with the updated
             % non-local sets.
             requantify_proc(!ProcInfo),
-            recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
+            recompute_instmap_delta_proc(
+                do_not_recompute_atomic_instmap_deltas,
                 !ProcInfo, !ModuleInfo),
             module_info_set_pred_proc_info(PPId, PredInfo0, !.ProcInfo,
                 !ModuleInfo)
         )
     ).
 
-:- pred process_goal(convert_potential_reuse::in, structure_reuse_map::in,
-    hlds_goal::in, hlds_goal::out, io::di, io::uo) is det.
+:- pred process_goal(convert_potential_reuse::in, reuse_as_table::in,
+    module_info::in, hlds_goal::in, hlds_goal::out) is det.
 
-process_goal(ConvertPotentialReuse, ReuseMap, !Goal, !IO) :-
+process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo, !Goal) :-
     !.Goal = hlds_goal(GoalExpr0, GoalInfo0),
     (
         GoalExpr0 = conj(ConjType, Goals0),
-        list.map_foldl(process_goal(ConvertPotentialReuse, ReuseMap),
-            Goals0, Goals, !IO),
+        list.map(process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo),
+            Goals0, Goals),
         GoalExpr = conj(ConjType, Goals),
         !:Goal = hlds_goal(GoalExpr, GoalInfo0)
     ;
@@ -255,26 +296,28 @@ process_goal(ConvertPotentialReuse, Reus
             % the procedure in which this call appears. We must therefore
             % make sure to call the appropriate version of the called
             % procedure.
-            ReuseDescription0 = reuse(reuse_call(_CondDescr))
+            ReuseDescription0 = reuse(reuse_call(_CondDescr, NoClobbers))
         ->
-            determine_reuse_version(ReuseMap, CalleePredId, CalleeProcId,
-                CalleePredName, ReuseCalleePredId, ReuseCalleeProcId,
-                ReuseCalleePredName),
+            determine_reuse_version(ReuseTable, ModuleInfo, CalleePredId,
+                CalleeProcId, CalleePredName, NoClobbers, ReuseCalleePredId,
+                ReuseCalleeProcId, ReuseCalleePredName),
             GoalExpr = plain_call(ReuseCalleePredId, ReuseCalleeProcId,
                 Args, BI, UC, ReuseCalleePredName),
             !:Goal = hlds_goal(GoalExpr, GoalInfo0)
         ;
-            ReuseDescription0 = potential_reuse(reuse_call(CondDescr)),
+            ReuseDescription0 = potential_reuse(reuse_call(CondDescr,
+                NoClobbers)),
             ConvertPotentialReuse = convert_potential_reuse
         ->
+            ConvertPotentialReuse = convert_potential_reuse,
             % Replace the call to the reuse version, and change the
             % potential reuse annotation to a real annotation.
-            determine_reuse_version(ReuseMap, CalleePredId, CalleeProcId,
-                CalleePredName, ReuseCalleePredId, ReuseCalleeProcId,
-                ReuseCalleePredName),
+            determine_reuse_version(ReuseTable, ModuleInfo,
+                CalleePredId, CalleeProcId, CalleePredName, NoClobbers,
+                ReuseCalleePredId, ReuseCalleeProcId, ReuseCalleePredName),
             GoalExpr = plain_call(ReuseCalleePredId, ReuseCalleeProcId,
                 Args, BI, UC, ReuseCalleePredName),
-            ReuseDescription = reuse(reuse_call(CondDescr)),
+            ReuseDescription = reuse(reuse_call(CondDescr, NoClobbers)),
             goal_info_set_reuse(ReuseDescription, GoalInfo0, GoalInfo),
             !:Goal = hlds_goal(GoalExpr, GoalInfo)
         ;
@@ -307,14 +350,14 @@ process_goal(ConvertPotentialReuse, Reus
         )
     ;
         GoalExpr0 = disj(Goals0),
-        list.map_foldl(process_goal(ConvertPotentialReuse, ReuseMap),
-            Goals0, Goals, !IO),
+        list.map(process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo),
+            Goals0, Goals),
         GoalExpr = disj(Goals),
         !:Goal = hlds_goal(GoalExpr, GoalInfo0)
     ;
         GoalExpr0 = switch(A, B, Cases0),
-        list.map_foldl(process_case(ConvertPotentialReuse, ReuseMap),
-            Cases0, Cases, !IO),
+        list.map(process_case(ConvertPotentialReuse, ReuseTable, ModuleInfo),
+            Cases0, Cases),
         GoalExpr = switch(A, B, Cases),
         !:Goal = hlds_goal(GoalExpr, GoalInfo0)
     ;
@@ -322,16 +365,18 @@ process_goal(ConvertPotentialReuse, Reus
         GoalExpr0 = negation(_Goal)
     ;
         GoalExpr0 = scope(A, SubGoal0),
-        process_goal(ConvertPotentialReuse, ReuseMap, SubGoal0, SubGoal, !IO),
+        process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo,
+            SubGoal0, SubGoal),
         GoalExpr = scope(A, SubGoal),
         !:Goal = hlds_goal(GoalExpr, GoalInfo0)
     ;
         GoalExpr0 = if_then_else(A, IfGoal0, ThenGoal0, ElseGoal0),
-        process_goal(ConvertPotentialReuse, ReuseMap, IfGoal0, IfGoal, !IO),
-        process_goal(ConvertPotentialReuse, ReuseMap, ThenGoal0, ThenGoal,
-            !IO),
-        process_goal(ConvertPotentialReuse, ReuseMap, ElseGoal0, ElseGoal,
-            !IO),
+        process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo,
+            IfGoal0, IfGoal),
+        process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo,
+            ThenGoal0, ThenGoal),
+        process_goal(ConvertPotentialReuse, ReuseTable, ModuleInfo,
+            ElseGoal0, ElseGoal),
         GoalExpr = if_then_else(A, IfGoal, ThenGoal, ElseGoal),
         !:Goal = hlds_goal(GoalExpr, GoalInfo0)
     ;
@@ -360,38 +405,45 @@ unification_set_reuse(ShortReuseDescript
         true
     ).
 
-:- pred determine_reuse_version(structure_reuse_map::in, pred_id::in,
-    proc_id::in, sym_name::in, pred_id::out, proc_id::out,
-    reuse_name::out) is det.
-
-determine_reuse_version(ReuseMap, PredId, ProcId, PredName,
-        ReusePredId, ReuseProcId, ReusePredName) :-
-    ( map.search(ReuseMap, proc(PredId, ProcId), Result) ->
-        Result = proc(ReusePredId, ReuseProcId) - ReusePredName
+:- pred determine_reuse_version(reuse_as_table::in, module_info::in,
+    pred_id::in, proc_id::in, sym_name::in, list(int)::in,
+    pred_id::out, proc_id::out, reuse_name::out) is det.
+
+determine_reuse_version(ReuseTable, ModuleInfo, PredId, ProcId, PredName,
+        NoClobbers, ReusePredId, ReuseProcId, ReusePredName) :-
+    (
+        reuse_as_table_search_reuse_version_proc(ReuseTable,
+            proc(PredId, ProcId), NoClobbers, Result)
+    ->
+        Result = proc(ReusePredId, ReuseProcId),
+        module_info_pred_info(ModuleInfo, ReusePredId, ReusePredInfo),
+        ModuleName = pred_info_module(ReusePredInfo),
+        Name = pred_info_name(ReusePredInfo),
+        ReusePredName = qualified(ModuleName, Name)
     ;
         ReusePredId = PredId,
         ReuseProcId = ProcId,
         ReusePredName = PredName
     ).
 
-:- pred process_case(convert_potential_reuse::in, structure_reuse_map::in,
-    case::in, case::out, io::di, io::uo) is det.
+:- pred process_case(convert_potential_reuse::in, reuse_as_table::in,
+    module_info::in, case::in, case::out) is det.
 
-process_case(ConvertPotentialReuse, ReuseMap, Case0, Case, !IO) :-
+process_case(ConvertPotentialReuse, ReuseMap, ModuleInfo, Case0, Case) :-
     Case0 = case(MainConsId, OtherConsIds, Goal0),
-    process_goal(ConvertPotentialReuse, ReuseMap, Goal0, Goal, !IO),
+    process_goal(ConvertPotentialReuse, ReuseMap, ModuleInfo, Goal0, Goal),
     Case = case(MainConsId, OtherConsIds, Goal).
 
 %------------------------------------------------------------------------------%
 
-create_fake_reuse_procedure(PPId, !ModuleInfo) :-
+create_fake_reuse_procedure(PPId, NoClobbers, !ModuleInfo) :-
     PPId = proc(PredId, ProcId),
     module_info_pred_proc_info(!.ModuleInfo, PPId, OldPredInfo, OldProcInfo),
     OldPredModule = pred_info_module(OldPredInfo),
     OldPredName = pred_info_name(OldPredInfo),
     proc_info_interface_determinism(OldProcInfo, Determinism),
 
-    create_fresh_pred_proc_info_copy(PPId, NewPPId, !ModuleInfo),
+    create_fresh_pred_proc_info_copy(PPId, NoClobbers, NewPPId, !ModuleInfo),
     some [!PredInfo, !ProcInfo] (
         module_info_pred_proc_info(!.ModuleInfo, NewPPId, !:PredInfo,
             !:ProcInfo),
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.34
diff -u -p -r1.34 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m	12 May 2008 01:37:05 -0000	1.34
+++ compiler/structure_sharing.analysis.m	26 May 2008 01:34:13 -0000
@@ -1216,7 +1216,7 @@ handle_dep_procs(ModuleInfo, DepPPId, !A
     (
         AnyResults = [],
         Answer = top(FuncInfo, Call) : structure_sharing_answer,
-        record_result(DepModuleName, DepFuncId, Call, Answer, suboptimal,
+        record_result(DepModuleName, DepFuncId, Call, Answer, optimal,
             !AnalysisInfo),
         % Record a request as well.
         record_request(analysis_name, DepModuleName, DepFuncId, Call,
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.48
diff -u -p -r1.48 trans_opt.m
--- compiler/trans_opt.m	18 Feb 2008 23:57:45 -0000	1.48
+++ compiler/trans_opt.m	26 May 2008 01:34:13 -0000
@@ -107,6 +107,7 @@
 :- import_module list.
 :- import_module map.
 :- import_module pair.
+:- import_module set.
 :- import_module term.
 
 %-----------------------------------------------------------------------------%
@@ -144,11 +145,10 @@ write_trans_opt_file(Module, !IO) :-
         % into the .trans_opt file. 
         %
         module_info_predids(PredIds, Module, _Module),
-        module_info_get_structure_reuse_map(Module, ReuseMap), 
-        map.values(ReuseMap, ReuseResults), 
-        assoc_list.keys(ReuseResults, ReusePredProcIds), 
-        list.map(get_pred_id, ReusePredProcIds, ReusePredIds), 
-        list.delete_elems(PredIds, ReusePredIds, PredIdsNoReuseVersions), 
+        PredIdsSet = set.from_list(PredIds),
+        module_info_get_structure_reuse_preds(Module, ReusePredsSet),
+        PredIdsNoReusePredsSet = set.difference(PredIdsSet, ReusePredsSet),
+        PredIdsNoReuseVersions = set.to_sorted_list(PredIdsNoReusePredsSet),
 
         list.foldl(termination.write_pred_termination_info(Module),
             PredIdsNoReuseVersions, !IO),


--------------------------------------------------------------------------
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