[m-rev.] for review: fixes for intermodule optimisation and CTGC

Peter Wang novalazy at gmail.com
Thu Apr 17 11:42:58 AEST 2008


Branches: main

Various fixes for intermodule optimisation and structure reuse analysis.

compiler/structure_reuse.analysis.m:
	Write `:- pragma structure_reuse' declarations when making `.opt'
	files.

	Write structure_reuse pragmas for procedures exported to submodules.

	Don't write structure_reuse pragmas for the reuse versions of
	procedures.

	Create forwarding procedures for procedures that, according to the
	.opt file, have conditional reuse versions, but when generating target
	code we find has no reuse.

compiler/structure_reuse.versions.m:
	Add predicates to create forwarding procedures.

	Record the origin of reuse procedures as `transform_structure_reuse'.

	Mark reuse versions of procedures as `status_local' if the original
	procedure was `opt_imported' so they don't get removed by dead proc
	elimination.

compiler/intermod.m:
	If structure reuse is enabled, read in a module's own `.opt' file and
	keep any `:- pragma structure_reuse' declarations so that we can know
	whether we need to create forwarding procedures.

compiler/mercury_compile.m:
	Perform higher-order specialisation, inlining and deforestation before
	CTGC passes when making intermodule optimisation or analysis files.
	This reduces the discrepancy between the CTGC results we get while
	making .opt/.trans_opt files and while making .c files.

compiler/ctgc.util.m:
	Don't abort in get_type_substitution if the caller's actual arguments
	don't match the callee's argument types and some compiler-generated
	procedures are type-incorrect.

compiler/hlds_pred.m:
compiler/layout_out.m:
	Add `transform_structure_reuse' option for `pred_transformation'.

Index: compiler/ctgc.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.util.m,v
retrieving revision 1.19
diff -u -p -r1.19 ctgc.util.m
--- compiler/ctgc.util.m	27 Mar 2008 02:29:41 -0000	1.19
+++ compiler/ctgc.util.m	16 Apr 2008 01:29:22 -0000
@@ -130,8 +130,8 @@ get_type_substitution(ModuleInfo, PPId, 
         ( type_list_subsumes(CalleeArgTypes, ActualTypes, TypeSubst0) ->
             TypeSubst1 = TypeSubst0
         ;
-            unexpected(this_file,
-                "ctgc.util.get_type_substitution: type unification failed")
+            % See comment in inlining.get_type_substitution.
+            TypeSubst1 = map.init
         )
     ;
         CalleeExistQVars = [_ | _],
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.241
diff -u -p -r1.241 hlds_pred.m
--- compiler/hlds_pred.m	7 Apr 2008 02:32:50 -0000	1.241
+++ compiler/hlds_pred.m	16 Apr 2008 03:56:51 -0000
@@ -473,7 +473,8 @@
                 int % This predicate was originally part of a predicate
                     % transformed into disjunctive normal form; this integer
                     % gives the part number.
-            ).
+            )
+    ;       transform_structure_reuse.
 
 :- type pred_creation
     --->    deforestation
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.230
diff -u -p -r1.230 intermod.m
--- compiler/intermod.m	27 Feb 2008 07:23:07 -0000	1.230
+++ compiler/intermod.m	16 Apr 2008 04:21:04 -0000
@@ -2278,24 +2278,41 @@ grab_opt_files(!Module, FoundError, !IO)
     % the .opt file for the current module. These are needed because we can
     % probably remove more arguments with intermod_unused_args, but the
     % interface for other modules must remain the same.
+    % 
+    % Similarly for the  :- pragma structure_reuse(...) declarations. With more
+    % information available when making the target code than when writing the
+    % `.opt' file, it can turn out that procedure which seemed to have
+    % condition reuse actually has none. But we have to maintain the interface
+    % for modules that use the conditional reuse information from the `.opt'
+    % file.
     globals.io_lookup_bool_option(intermod_unused_args, UnusedArgs, !IO),
+    globals.io_lookup_bool_option(structure_reuse_analysis, StructureReuse,
+        !IO),
     (
-        UnusedArgs = yes,
+        ( UnusedArgs = yes
+        ; StructureReuse = yes
+        )
+    ->
         read_optimization_interfaces(no, ModuleName, [ModuleName],
-            set.init, [], LocalItems, no, UAError, !IO),
-        IsPragmaUnusedArgs = (pred(Item::in) is semidet :-
+            set.init, [], LocalItems, no, UA_SR_Error, !IO),
+        KeepPragma = (pred(Item::in) is semidet :-
             Item = item_pragma(ItemPragma),
             ItemPragma = item_pragma_info(_, Pragma, _),
-            Pragma = pragma_unused_args(_,_,_,_,_)
+            (
+                UnusedArgs = yes,
+                Pragma = pragma_unused_args(_,_,_,_,_)
+            ;
+                StructureReuse = yes,
+                Pragma = pragma_structure_reuse(_, _, _, _, _, _)
+            )
         ),
-        list.filter(IsPragmaUnusedArgs, LocalItems, PragmaItems),
+        list.filter(KeepPragma, LocalItems, PragmaItems),
 
         module_imports_get_items(!.Module, Items2),
         list.append(Items2, PragmaItems, Items),
         module_imports_set_items(Items, !Module)
     ;
-        UnusedArgs = no,
-        UAError = no
+        UA_SR_Error = no
     ),
 
     % Read .int0 files required by the `.opt' files.
@@ -2335,7 +2352,7 @@ grab_opt_files(!Module, FoundError, !IO)
     (
         ( FoundError0 \= no_module_errors
         ; OptError = yes
-        ; UAError = yes
+        ; UA_SR_Error = yes
         )
     ->
         FoundError = yes
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.96
diff -u -p -r1.96 layout_out.m
--- compiler/layout_out.m	7 Apr 2008 02:32:51 -0000	1.96
+++ compiler/layout_out.m	16 Apr 2008 03:57:19 -0000
@@ -1458,6 +1458,7 @@ pred_transform_name(transform_return_via
 pred_transform_name(transform_table_generator) = "table_gen".
 pred_transform_name(transform_stm_expansion) = "stm_expansion".
 pred_transform_name(transform_dnf(N)) = "dnf_" ++ int_to_string(N).
+pred_transform_name(transform_structure_reuse) = "structure_reuse".
 
 :- func ints_to_string(list(int)) = string.
 
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.467
diff -u -p -r1.467 mercury_compile.m
--- compiler/mercury_compile.m	10 Apr 2008 07:03:51 -0000	1.467
+++ compiler/mercury_compile.m	16 Apr 2008 03:30:15 -0000
@@ -2329,8 +2329,7 @@ maybe_write_optfile(MakeOptInt, !HLDS, !
                 ),
                 (
                     ReuseAnalysis = yes,
-                    maybe_structure_reuse_analysis(Verbose, Stats,
-                        !HLDS, !IO)
+                    maybe_structure_reuse_analysis(Verbose, Stats, !HLDS, !IO)
                 ;
                     ReuseAnalysis = no
                 ),
@@ -2396,6 +2395,8 @@ output_trans_opt_file(!.HLDS, !DumpInfo,
     globals.lookup_bool_option(Globals, verbose, Verbose),
     globals.lookup_bool_option(Globals, statistics, Stats),
     globals.lookup_bool_option(Globals, analyse_closures, ClosureAnalysis),
+    globals.lookup_bool_option(Globals, structure_sharing_analysis,
+        SharingAnalysis),
 
     % Closure analysis assumes that lambda expressions have
     % been converted into separate predicates.
@@ -2414,6 +2415,19 @@ output_trans_opt_file(!.HLDS, !DumpInfo,
     maybe_dump_hlds(!.HLDS, 120, "termination", !DumpInfo, !IO),
     maybe_termination2(Verbose, Stats, !HLDS, !IO),
     maybe_dump_hlds(!.HLDS, 121, "termination_2", !DumpInfo, !IO),
+    (
+        SharingAnalysis = yes,
+        % These affect the results we write out for structure sharing/reuse
+        % analysis.
+        maybe_higher_order(Verbose, Stats, !HLDS, !IO),
+        maybe_dump_hlds(!.HLDS, 135, "higher_order", !DumpInfo, !IO),
+        maybe_do_inlining(Verbose, Stats, !HLDS, !IO),
+        maybe_dump_hlds(!.HLDS, 145, "inlining", !DumpInfo, !IO),
+        maybe_deforestation(Verbose, Stats, !HLDS, !IO),
+        maybe_dump_hlds(!.HLDS, 155, "deforestation", !DumpInfo, !IO)
+    ;
+        SharingAnalysis = no
+    ),
     maybe_structure_sharing_analysis(Verbose, Stats, !HLDS, !IO),
     maybe_dump_hlds(!.HLDS, 162, "structure_sharing", !DumpInfo, !IO),
     maybe_structure_reuse_analysis(Verbose, Stats, !HLDS, !IO),
@@ -2432,6 +2446,8 @@ output_analysis_file(ModuleName, !.HLDS,
     globals.lookup_bool_option(Globals, verbose, Verbose),
     globals.lookup_bool_option(Globals, statistics, Stats),
     globals.lookup_bool_option(Globals, analyse_closures, ClosureAnalysis),
+    globals.lookup_bool_option(Globals, structure_sharing_analysis,
+        SharingAnalysis),
 
     % Closure analysis assumes that lambda expressions have
     % been converted into separate predicates.
@@ -2450,6 +2466,19 @@ output_analysis_file(ModuleName, !.HLDS,
     maybe_dump_hlds(!.HLDS, 120, "termination", !DumpInfo, !IO),
     maybe_termination2(Verbose, Stats, !HLDS, !IO),
     maybe_dump_hlds(!.HLDS, 121, "termination_2", !DumpInfo, !IO),
+    (
+        SharingAnalysis = yes,
+        % These affect the results we write out for structure sharing/reuse
+        % analysis.
+        maybe_higher_order(Verbose, Stats, !HLDS, !IO),
+        maybe_dump_hlds(!.HLDS, 135, "higher_order", !DumpInfo, !IO),
+        maybe_do_inlining(Verbose, Stats, !HLDS, !IO),
+        maybe_dump_hlds(!.HLDS, 145, "inlining", !DumpInfo, !IO),
+        maybe_deforestation(Verbose, Stats, !HLDS, !IO),
+        maybe_dump_hlds(!.HLDS, 155, "deforestation", !DumpInfo, !IO)
+    ;
+        SharingAnalysis = no
+    ),
     maybe_structure_sharing_analysis(Verbose, Stats, !HLDS, !IO),
     maybe_dump_hlds(!.HLDS, 162, "structure_sharing", !DumpInfo, !IO),
     maybe_structure_reuse_analysis(Verbose, Stats, !HLDS, !IO),
Index: compiler/structure_reuse.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.analysis.m,v
retrieving revision 1.10
diff -u -p -r1.10 structure_reuse.analysis.m
--- compiler/structure_reuse.analysis.m	10 Jan 2008 04:29:53 -0000	1.10
+++ compiler/structure_reuse.analysis.m	16 Apr 2008 04:01:06 -0000
@@ -114,8 +114,8 @@ structure_reuse_analysis(!ModuleInfo, !I
     SharingTable = load_structure_sharing_table(!.ModuleInfo),
 
     % Load all the available reuse information into a reuse table.
-    % XXX TO DO!
     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
@@ -143,18 +143,69 @@ structure_reuse_analysis(!ModuleInfo, !I
     % For every procedure that has some potential (conditional) reuse (either 
     % direct or indirect), create a new procedure that actually implements
     % that reuse. 
-    % XXX TO DO!
     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),
 
     % Record the results of the reuse table into the HLDS.
-    map.foldl(save_reuse_in_module_info, ReuseTable2, !ModuleInfo).
-    %
+    map.foldl(save_reuse_in_module_info, ReuseTable2, !ModuleInfo),
+
+    % Only write structure reuse pragmas to `.opt' files for
+    % `--intermodule-optimization' not `--intermodule-analysis'.
+    globals.io_lookup_bool_option(make_optimization_interface, MakeOptInt,
+        !IO),
+    globals.io_lookup_bool_option(intermodule_analysis, IntermodAnalysis, !IO),
+    (
+        MakeOptInt = yes,
+        IntermodAnalysis = no
+    ->
+        make_opt_int(!ModuleInfo, !IO)
+    ;
+        true
+    ).
+
     % Output some profiling information.
     % XXX TO DO!
     % profiling(!.ModuleInfo, ReuseTable3).
 
 %-----------------------------------------------------------------------------%
 
+:- pred create_forwarding_procedures(reuse_as_table::in, reuse_as_table::in,
+    module_info::in, module_info::out) is det.
+
+create_forwarding_procedures(InitialReuseTable, FinalReuseTable,
+        !ModuleInfo) :-
+    map.foldl(create_forwarding_procedures_2(FinalReuseTable),
+        InitialReuseTable, !ModuleInfo).
+
+:- pred create_forwarding_procedures_2(reuse_as_table::in, pred_proc_id::in,
+    reuse_as::in, module_info::in, module_info::out) is det.
+
+create_forwarding_procedures_2(FinalReuseTable, PPId, InitialReuseAs,
+        !ModuleInfo) :-
+    PPId = proc(PredId, _),
+    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+    pred_info_get_import_status(PredInfo, ImportStatus),
+    (
+        reuse_as_conditional_reuses(InitialReuseAs),
+        status_defined_in_this_module(ImportStatus) = yes,
+        map.search(FinalReuseTable, PPId, FinalReuseAs),
+        reuse_as_no_reuses(FinalReuseAs)
+    ->
+        create_fake_reuse_procedure(PPId, !ModuleInfo)
+    ;
+        true
+    ).
+
+%-----------------------------------------------------------------------------%
+
     % Process all the reuse annotation from imported predicates.
     %
 :- pred process_imported_reuse(module_info::in, module_info::out) is det.
@@ -295,6 +346,7 @@ make_opt_int(!ModuleInfo, !IO) :-
 write_pred_reuse_info(ModuleInfo, PredId, !IO) :-
     module_info_pred_info(ModuleInfo, PredId, PredInfo),
     pred_info_get_import_status(PredInfo, ImportStatus),
+    pred_info_get_origin(PredInfo, PredOrigin),
     module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
     TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
     (
@@ -302,9 +354,14 @@ write_pred_reuse_info(ModuleInfo, PredId
             ImportStatus = status_exported
         ;
             ImportStatus = status_opt_exported
+        ;
+            ImportStatus = status_exported_to_submodules
         ),
         \+ is_unify_or_compare_pred(PredInfo),
 
+        % Don't write out info for reuse versions of procedures.
+        PredOrigin \= origin_transformed(transform_structure_reuse, _, _),
+
         % XXX These should be allowed, but the predicate declaration for the
         % specialized predicate is not produced before the structure_reuse
         % pragmas are read in, resulting in an undefined predicate error.
Index: compiler/structure_reuse.versions.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.versions.m,v
retrieving revision 1.12
diff -u -p -r1.12 structure_reuse.versions.m
--- compiler/structure_reuse.versions.m	27 Feb 2008 07:23:15 -0000	1.12
+++ compiler/structure_reuse.versions.m	16 Apr 2008 04:15:15 -0000
@@ -43,14 +43,10 @@
 :- pred create_reuse_procedures(reuse_as_table::in, module_info::in,
     module_info::out, io::di, io::uo) is det.
 
-    % Create a copy of the predicate/procedure information specified by the
-    % given pred_proc_id, and return the pred_proc_id of that copy.  This
-    % operation also updates the structure_reuse_map in the HLDS. Note that the
-    % copy is not altered w.r.t. structure reuse. It is a plain copy, nothing
-    % more than that.
+    % Create a fake reuse procedure that simply calls the non-reuse procedure.
     %
-:- pred create_fresh_pred_proc_info_copy(pred_proc_id::in, pred_proc_id::out,
-    module_info::in, module_info::out) is det.
+:- pred create_fake_reuse_procedure(pred_proc_id::in, module_info::in,
+    module_info::out) is det.
 
 %------------------------------------------------------------------------------%
 %------------------------------------------------------------------------------%
@@ -68,10 +64,10 @@
 :- 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 list.
 
 %------------------------------------------------------------------------------%
 
@@ -126,11 +122,21 @@ has_unconditional_reuse(ReuseTable, PPId
 
 %------------------------------------------------------------------------------%
 
+    % 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.
+
 create_fresh_pred_proc_info_copy(PPId, NewPPId, !ModuleInfo) :-
     module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo0, ProcInfo0),
     ReusePredName = generate_reuse_name(!.ModuleInfo, PPId),
-    create_fresh_pred_proc_info_copy_2(PredInfo0, ProcInfo0, ReusePredName,
-        ReusePredInfo, ReuseProcId),
+    PPId = proc(PredId, _),
+    create_fresh_pred_proc_info_copy_2(PredId, PredInfo0, ProcInfo0,
+        ReusePredName, ReusePredInfo, ReuseProcId),
 
     module_info_get_predicate_table(!.ModuleInfo, PredTable0),
     predicate_table_insert(ReusePredInfo, ReusePredId, PredTable0, PredTable),
@@ -141,16 +147,23 @@ create_fresh_pred_proc_info_copy(PPId, N
     map.det_insert(ReuseMap0, PPId, NewPPId - ReusePredName, ReuseMap),
     module_info_set_structure_reuse_map(ReuseMap, !ModuleInfo).
 
-:- pred create_fresh_pred_proc_info_copy_2(pred_info::in, proc_info::in,
-    reuse_name::in, pred_info::out, proc_id::out) is det.
+:- 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.
 
-create_fresh_pred_proc_info_copy_2(PredInfo, ProcInfo, ReusePredName,
+create_fresh_pred_proc_info_copy_2(PredId, PredInfo, ProcInfo, ReusePredName,
         ReusePredInfo, ReuseProcId) :-
     ModuleName = pred_info_module(PredInfo),
     PredOrFunc = pred_info_is_pred_or_func(PredInfo),
     pred_info_get_context(PredInfo, ProgContext),
     pred_info_get_origin(PredInfo, PredOrigin),
-    pred_info_get_import_status(PredInfo, ImportStatus),
+    pred_info_get_import_status(PredInfo, ImportStatus0),
+    % If the predicate was opt_imported then the specialised copy should be
+    % local otherwise it will be eliminated by dead proc elimination.
+    ( ImportStatus0 = status_opt_imported ->
+        ImportStatus = status_local
+    ;
+        ImportStatus = ImportStatus0
+    ),
     pred_info_get_markers(PredInfo, PredMarkers),
     pred_info_get_arg_types(PredInfo, MerTypes),
     pred_info_get_typevarset(PredInfo, TVarset),
@@ -158,8 +171,10 @@ create_fresh_pred_proc_info_copy_2(PredI
     pred_info_get_class_context(PredInfo, ProgConstraints),
     pred_info_get_assertions(PredInfo, AssertIds),
     pred_info_get_var_name_remap(PredInfo, VarNameRemap),
+    NewPredOrigin = origin_transformed(transform_structure_reuse, PredOrigin,
+        PredId),
     pred_info_create(ModuleName, ReusePredName, PredOrFunc, ProgContext,
-        PredOrigin, ImportStatus, PredMarkers, MerTypes, TVarset,
+        NewPredOrigin, ImportStatus, PredMarkers, MerTypes, TVarset,
         ExistQTVars, ProgConstraints, AssertIds, VarNameRemap,
         ProcInfo, ReuseProcId, ReusePredInfo).
 
@@ -331,6 +346,31 @@ process_case(ReuseMap, !Case, !IO) :-
 
 %------------------------------------------------------------------------------%
 
+create_fake_reuse_procedure(PPId, !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),
+    some [!PredInfo, !ProcInfo] (
+        module_info_pred_proc_info(!.ModuleInfo, NewPPId, !:PredInfo,
+            !:ProcInfo),
+        proc_info_get_goal(!.ProcInfo, Body),
+        Body = hlds_goal(_, GoalInfo0),
+        proc_info_get_headvars(!.ProcInfo, HeadVars),
+        GoalExpr = plain_call(PredId, ProcId, HeadVars, not_builtin, no,
+            qualified(OldPredModule, OldPredName)),
+        goal_info_set_determinism(Determinism, GoalInfo0, GoalInfo),
+        Goal = hlds_goal(GoalExpr, GoalInfo),
+        proc_info_set_goal(Goal, !ProcInfo),
+        module_info_set_pred_proc_info(NewPPId, !.PredInfo, !.ProcInfo,
+            !ModuleInfo)
+    ).
+
+%------------------------------------------------------------------------------%
+
 :- func this_file = string.
 
 this_file = "structure_reuse.versions.m".


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