[m-rev.] for review: avoid excessive goal traversal in trail usage opt

Julien Fischer juliensf at cs.mu.OZ.AU
Fri Dec 2 16:00:58 AEDT 2005


For review by Mark or Ralph.

Estimated hours taken: 10
Branches: main

Attach trail usage information to the goal_info rather than recomputing it on
demand - this avoids repeated traversals of the goal structure during trail
usage analysis.

compiler/trailing_analysis.m:
	Add an optional second pass to trail usage analysis that annotates
	goals with trail usage information.  The second pass is optional
	because we only run it when we are generating code; when building the
	optimization interfaces we don't run it.

	Factor out code that is common to both passes into separate
	procedures.

	Fix some problems with the documentation in this module.

	Update the TODO list in this module.

	Add exception.rethrow/1 to the known procedures table.

compiler/hlds_goal.m:
	Add a new goal feature `will_not_modify_trail' that can be used to
	mark goals that will not modify the trail.

compiler/goal_form.m:
	Instead of traversing the a goal to work out if it may modify the
	trail, just look for the will_not_modify_trail feature in the
	goal_info.

compiler/saved_vars.m:
compiler/add_trail_ops.m:
compiler/code_gen.m:
compiler/code_util.m:
compiler/disj_gen.m:
	Minor change to conform to the above.

Julien.

Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.25
diff -u -r1.25 add_trail_ops.m
--- compiler/add_trail_ops.m	28 Nov 2005 04:11:37 -0000	1.25
+++ compiler/add_trail_ops.m	1 Dec 2005 06:06:21 -0000
@@ -110,7 +110,7 @@
     OptTrailUsage = !.Info ^ opt_trail_usage,
     (
         OptTrailUsage = yes,
-        goal_cannot_modify_trail(!.Info ^ module_info, !.Goal)
+        goal_cannot_modify_trail(!.Goal)
     ->
         % Don't add trail ops if the goal cannot modify the trail
         % and we are optimizing trail usage.
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.147
diff -u -r1.147 code_gen.m
--- compiler/code_gen.m	28 Nov 2005 04:11:39 -0000	1.147
+++ compiler/code_gen.m	2 Dec 2005 04:51:24 -0000
@@ -1086,9 +1086,7 @@
         % omit them.  We only do the latter if we are optimizing trail usage.
         %
         code_info__get_globals(!.CI, Globals),
-        code_info__get_module_info(!.CI, ModuleInfo),
-        AddTrailOps = should_add_trail_ops(Globals, ModuleInfo,
-            Goal - GoalInfo),
+        AddTrailOps = should_add_trail_ops(Globals, Goal - GoalInfo),
         code_gen__generate_goal_2(Goal, GoalInfo, CodeModel, AddTrailOps,
             GoalCode, !CI),
         goal_info_get_features(GoalInfo, Features),
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.161
diff -u -r1.161 code_util.m
--- compiler/code_util.m	28 Nov 2005 04:11:39 -0000	1.161
+++ compiler/code_util.m	1 Dec 2005 06:08:03 -0000
@@ -101,7 +101,7 @@
     % we are optimizing trail usage and trail usage analysis tells
     % us that it is safe to omit the trail ops.
     %
-:- func should_add_trail_ops(globals, module_info, hlds_goal) = add_trail_ops.
+:- func should_add_trail_ops(globals, hlds_goal) = add_trail_ops.

 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
@@ -458,7 +458,7 @@
 % Utility predicates used to implement trailing
 %

-should_add_trail_ops(Globals, ModuleInfo, Goal) = AddTrailOps :-
+should_add_trail_ops(Globals, Goal) = AddTrailOps :-
     globals.lookup_bool_option(Globals, use_trail, UseTrail),
     (
         UseTrail = no,
@@ -472,7 +472,7 @@
             AddTrailOps = yes
         ;
             OptTrailUsage = yes,
-            ( goal_cannot_modify_trail(ModuleInfo, Goal) ->
+            ( goal_cannot_modify_trail(Goal) ->
                 AddTrailOps = no
             ;
                 AddTrailOps = yes
Index: compiler/goal_form.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_form.m,v
retrieving revision 1.21
diff -u -r1.21 goal_form.m
--- compiler/goal_form.m	17 Nov 2005 15:57:13 -0000	1.21
+++ compiler/goal_form.m	1 Dec 2005 06:03:35 -0000
@@ -113,7 +113,7 @@
     % Succeeds if the goal (and its subgoals) do not modify the trail.
     % (Requires --analyse-trail-usage to be of any use.)
     %
-:- pred goal_cannot_modify_trail(module_info::in, hlds_goal::in) is semidet.
+:- pred goal_cannot_modify_trail(hlds_goal::in) is semidet.

 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -558,47 +558,8 @@
     ).
 %-----------------------------------------------------------------------------%

-goal_cannot_modify_trail(ModuleInfo, GoalExpr - _GoalInfo) :-
-    goal_cannot_modify_trail_2(ModuleInfo, GoalExpr).
-
-:- pred goal_cannot_modify_trail_2(module_info::in, hlds_goal_expr::in)
-    is semidet.
-
-goal_cannot_modify_trail_2(ModuleInfo, Goal) :-
-    (
-        Goal = conj(Goals)
-    ;
-        Goal = par_conj(Goals)
-    ;
-        Goal = disj(Goals)
-    ;
-        Goal  = if_then_else(_, IfGoal, ThenGoal, ElseGoal),
-        Goals = [IfGoal, ThenGoal, ElseGoal]
-    ),
-    list.all_true(goal_cannot_modify_trail(ModuleInfo), Goals).
-goal_cannot_modify_trail_2(ModuleInfo, Goal) :-
-    Goal = call(CallPredId, CallProcId, _, _, _, _),
-    module_info_get_trailing_info(ModuleInfo, TrailingInfo),
-    map.search(TrailingInfo, proc(CallPredId, CallProcId), TrailingStatus),
-    TrailingStatus = will_not_modify_trail.
-% XXX We should actually look this up since we have closure analysis.
-goal_cannot_modify_trail_2(_ModuleInfo, generic_call(_, _, _, _)) :- fail.
-goal_cannot_modify_trail_2(ModuleInfo, switch(_, _, Goals)) :-
-    CheckCase = (pred(Case::in) is semidet :-
-        Case = case(_, Goal),
-        goal_cannot_modify_trail(ModuleInfo, Goal)
-    ),
-    list.all_true(CheckCase, Goals).
-goal_cannot_modify_trail_2(_, unify(_, _, _, _, _)).
-goal_cannot_modify_trail_2(ModuleInfo, not(Goal)) :-
-    goal_cannot_modify_trail(ModuleInfo, Goal).
-goal_cannot_modify_trail_2(ModuleInfo, scope(_, Goal)) :-
-    goal_cannot_modify_trail(ModuleInfo, Goal).
-goal_cannot_modify_trail_2(_, Goal) :-
-    Goal = foreign_proc(Attributes, _, _, _, _, _),
-    may_modify_trail(Attributes) = will_not_modify_trail.
-goal_cannot_modify_trail_2(_, shorthand(_)) :-
-    unexpected(this_file, "goal_cannot_modify_trial_2: shorthand goal.").
+goal_cannot_modify_trail(Goal) :-
+    goal_has_feature(Goal, will_not_modify_trail).

 %-----------------------------------------------------------------------------%

Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.146
diff -u -r1.146 hlds_goal.m
--- compiler/hlds_goal.m	28 Nov 2005 04:11:41 -0000	1.146
+++ compiler/hlds_goal.m	28 Nov 2005 04:12:29 -0000
@@ -1004,7 +1004,7 @@
                             % mark the unifications it creates, and get
                             % the singleton warning code to respect it.

-    ;       mode_check_clauses_goal.
+    ;       mode_check_clauses_goal
                             % This goal is the main disjunction of a predicate
                             % with the mode_check_clauses pragma. No compiler
                             % pass should try to invoke quadratic or worse
@@ -1012,6 +1012,11 @@
                             % probably has many arms (possibly several
                             % thousand). This feature may be attached to
                             % switches as well as disjunctions.
+
+    ;       will_not_modify_trail.
+                            % This goal will not modify the trail, so it
+                            % is safe for the compiler to omit trailing
+                            % primitives when generating code for this goal.

     % We can think of the goal that defines a procedure to be a tree,
     % whose leaves are primitive goals and whose interior nodes are
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.56
diff -u -r1.56 saved_vars.m
--- compiler/saved_vars.m	28 Nov 2005 04:11:54 -0000	1.56
+++ compiler/saved_vars.m	28 Nov 2005 04:12:30 -0000
@@ -226,6 +226,7 @@
 ok_to_duplicate(save_deep_excp_vars) = no.
 ok_to_duplicate(dont_warn_singleton) = yes.
 ok_to_duplicate(mode_check_clauses_goal) = yes.
+ok_to_duplicate(will_not_modify_trail) = yes.

     % Divide a list of goals into an initial subsequence of goals
     % that construct constants, and all other goals.
Index: compiler/trailing_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trailing_analysis.m,v
retrieving revision 1.2
diff -u -r1.2 trailing_analysis.m
--- compiler/trailing_analysis.m	16 Nov 2005 07:02:00 -0000	1.2
+++ compiler/trailing_analysis.m	2 Dec 2005 04:47:24 -0000
@@ -5,16 +5,16 @@
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
-%
-% file: trailing_analysis.m
-% author: juliensf
-%
+
+% File: trailing_analysis.m.
+% Author: juliensf.
+
 % This module implements trail usage analysis.  It annotates the HLDS with
-% information about which procedures may modify the trail.
+% information about which procedures will not modify the trail.
 %
-% It intended to be used in helping the compiler decide when it is safe to
-% omit trailing operations in trailing grades.  After running the analysis
-% the trailing status of each procedure is one of:
+% The compiler can use this information to omit redundant trailing operations
+% in trailing grades.  After running the analysis the trailing status of each
+% procedue is one of:
 %
 %   (1) will_not_modify_trail
 %   (2) may_modify_trail
@@ -35,24 +35,24 @@
 % or comparison predicate.
 %
 % For procedures defined using the foreign language interface we rely upon
-% the user annotations, `will_not_modify_trail' and `may_not_modify_trail'.
+% the user annotations `will_not_modify_trail' and `may_not_modify_trail'.
 %
 % The predicates for determining if individual goals modify the trail
 % are in goal_form.m.
-%
+
 % TODO:
-%   - Rather than using the predicates in goal_form.m., annotate each
-%     goal with trail usage information.  These would prevent multiple
-%     traversals of the goal structure.  It would also make it easier
-%     to do "clever" things during the trailing transformation.
 %
 %   - Use the results of closure analysis to determine the trailing
 %     status of higher-order calls.
-%
+%   - Improve the analysis in the presence of solver types.
+%   - Lift some of the restrictions on compiler-generated unification and
+%     comparison preds.
+%   - Create specialised versions of higher-order procedures based on
+%     whether or not their arguments modify the trail.
+
 %----------------------------------------------------------------------------%

 :- module transform_hlds.trailing_analysis.
-
 :- interface.

 :- import_module hlds.hlds_module.
@@ -60,7 +60,9 @@

 :- import_module io.

-    % Perform trailing analysis on a module.
+%----------------------------------------------------------------------------%
+
+    % Perform trail usage analysis on a module.
     %
 :- pred analyse_trail_usage(module_info::in, module_info::out,
     io::di, io::uo) is det.
@@ -110,18 +112,31 @@
 % Perform trail usage analysis on a module
 %

+% The analysis is carried out in two passes.  Both passes do a bottom-up
+% traversal of the callgraph, one SCC at a time.  For each SCC the first
+% pass works out the trailing_status for each procedure in the SCC.  The
+% second pass then uses this information to annotate the goals in each
+% procedure with trail usage information.
+%
+% The second pass is only run if we are going to use the information,
+% that is if we are generating code as opposed to building the optimization
+% interfaces.
+
 analyse_trail_usage(!ModuleInfo, !IO) :-
     globals.io_lookup_bool_option(use_trail, UseTrail, !IO),
     (
         % Only run the analysis in trailing grades.
         UseTrail = yes,
+        globals.io_lookup_bool_option(make_optimization_interface,
+            MakeOptInt, !IO),
+        globals.io_lookup_bool_option(make_transitive_opt_interface,
+            MakeTransOptInt, !IO),
+        Pass1Only = MakeOptInt `bool.or` MakeTransOptInt,
         module_info_ensure_dependency_info(!ModuleInfo),
         module_info_dependency_info(!.ModuleInfo, DepInfo),
         hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
         globals.io_lookup_bool_option(debug_trail_usage, Debug, !IO),
-        list.foldl2(process_scc(Debug), SCCs, !ModuleInfo, !IO),
-        globals.io_lookup_bool_option(make_optimization_interface,
-            MakeOptInt, !IO),
+        list.foldl2(process_scc(Debug, Pass1Only), SCCs, !ModuleInfo, !IO),
         (
             MakeOptInt = yes,
             make_opt_int(!.ModuleInfo, !IO)
@@ -141,15 +156,15 @@
 :- type proc_results == list(proc_result).

 :- type proc_result
-    ---> proc_result(
-            ppid :: pred_proc_id,
-            status :: trailing_status
-    ).
+    --->    proc_result(
+                ppid   :: pred_proc_id,
+                status :: trailing_status
+            ).

-:- pred process_scc(bool::in, scc::in,
+:- pred process_scc(bool::in, bool::in, scc::in,
     module_info::in, module_info::out, io::di, io::uo) is det.

-process_scc(Debug, SCC, !ModuleInfo, !IO) :-
+process_scc(Debug, Pass1Only, SCC, !ModuleInfo, !IO) :-
     ProcResults = check_procs_for_trail_mods(SCC, !.ModuleInfo),
     %
     % The `Results' above are the results of analysing each individual
@@ -173,7 +188,13 @@
         Info = Info0 ^ elem(PPId) := Status
     ),
     list.foldl(Update, SCC, TrailingInfo0, TrailingInfo),
-    module_info_set_trailing_info(TrailingInfo, !ModuleInfo).
+    module_info_set_trailing_info(TrailingInfo, !ModuleInfo),
+    (
+        Pass1Only = no,
+        list.foldl(annotate_proc, SCC, !ModuleInfo)
+    ;
+        Pass1Only = yes
+    ).

     % Check each procedure in the SCC individually.
     %
@@ -277,6 +298,7 @@
             ),
             special_pred_name_arity(SpecialPredId, Name, _, Arity)
         ;
+            % XXX This is too conservative.
             pred_info_get_origin(CallPredInfo, Origin),
             Origin = special_pred(SpecialPredId - _),
             ( SpecialPredId = spec_pred_compare
@@ -286,22 +308,15 @@
     ->
         % At the moment we assume that calls to out-of-line
         % unification/comparisons are going to modify the trail.
-        % XXX This is far too conservative.
         Result = may_modify_trail
     ;
         % Handle library predicates whose trailing status
         % can be looked up in the known procedures table.
-        Name = pred_info_name(CallPredInfo),
-        PredOrFunc = pred_info_is_pred_or_func(CallPredInfo),
-        ModuleName = pred_info_module(CallPredInfo),
-        ModuleName = unqualified(ModuleNameStr),
-        Arity = pred_info_orig_arity(CallPredInfo),
-        known_procedure(PredOrFunc, ModuleNameStr, Name, Arity, Result0)
+        pred_info_has_known_status(CallPredInfo, Result0)
     ->
         Result = Result0
     ;
-        check_nonrecursive_call(ModuleInfo, VarTypes, CallPPId, CallArgs,
-            Result)
+        check_call(ModuleInfo, VarTypes, CallPPId, CallArgs, Result)
     ).
 check_goal_for_trail_mods_2(_, _ModuleInfo, _VarTypes, Goal, _GoalInfo,
         Result) :-
@@ -333,29 +348,13 @@
     InnerGoal = _ - InnerGoalInfo,
     goal_info_get_code_model(InnerGoalInfo, InnerCodeModel),
     goal_info_get_code_model(OuterGoalInfo, OuterCodeModel),
-    (
-        % If we're at a commit for Goal that might modify the trail then we
-        % will need to emit some trailing code around the scope goal.
-        InnerCodeModel = model_non,
-        OuterCodeModel \= model_non,
-        Result0 \= will_not_modify_trail
-    ->
-        Result = may_modify_trail
-    ;
-        Result = Result0
-    ).
+    Result = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, Result0).
 check_goal_for_trail_mods_2(_, _, _, Goal, _, Result) :-
     Goal = foreign_proc(Attributes, _, _, _, _, _),
-    %
-    % XXX polymorphic foreign calls.
-    ( may_modify_trail(Attributes) = may_modify_trail ->
-        Result = may_modify_trail
-    ;
-        Result = will_not_modify_trail
-    ).
+    Result = attributes_imply_trail_mod(Attributes).
 check_goal_for_trail_mods_2(_, _, _, shorthand(_), _, _) :-
     unexpected(this_file,
-        "shorthand goal encountered during trailing analysis.").
+        "shorthand goal encountered during trail usage analysis.").
 check_goal_for_trail_mods_2(SCC, ModuleInfo, VarTypes, Goal, _, Result) :-
     Goal = switch(_, _, Cases),
     CaseGoals = list.map((func(case(_, CaseGoal)) = CaseGoal), Cases),
@@ -370,8 +369,6 @@
         Result0 = will_not_modify_trail,
         Result  = will_not_modify_trail
     ;
-        % XXX In the case where this is conditional we could do better
-        % by creating specialised versions of the procedure.
         ( Result0 = conditional ; Result0 = may_modify_trail),
         Result = may_modify_trail
     ).
@@ -408,20 +405,67 @@

 %----------------------------------------------------------------------------%
 %
-% "Known" library procedures
+% Utility procedure for processing goals
 %

-% known_procedure/4 is a table of library predicates whose trailing
-% status is hardcoded into the analyser.  For a few predicates this
-% information can make a big difference (particularly in the absence
-% of any form of intermodule analysis).
+:- func attributes_imply_trail_mod(pragma_foreign_proc_attributes) =
+    trailing_status.

+attributes_imply_trail_mod(Attributes) =
+    ( may_modify_trail(Attributes) = may_modify_trail ->
+        may_modify_trail
+    ;
+        will_not_modify_trail
+    ).
+
+:- func scope_implies_trail_mod(code_model, code_model, trailing_status)
+    = trailing_status.
+
+scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, InnerStatus) =
+    (
+        % If we're at a commit for a goal that might modify the trail
+        % then we need to emit some trailing code around the scope goal.
+        InnerCodeModel = model_non,
+        OuterCodeModel \= model_non,
+        InnerStatus \= will_not_modify_trail
+    ->
+        may_modify_trail
+    ;
+        InnerStatus
+    ).
+
+%----------------------------------------------------------------------------%
+%
+% "Known" library procedures
+%
+    % Succeeds if the given pred_info is for a predicate or function
+    % whose trailing status can be looked up in the known procedures
+    % table.  Returns the trailing status corresponding to that procedure.
+    % Fails if there was no corresponding entry in the table.
+    %
+:- pred pred_info_has_known_status(pred_info::in, trailing_status::out)
+    is semidet.
+
+pred_info_has_known_status(PredInfo, Status) :-
+    Name = pred_info_name(PredInfo),
+    PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+    ModuleName = pred_info_module(PredInfo),
+    ModuleName = unqualified(ModuleNameStr),
+    Arity = pred_info_orig_arity(PredInfo),
+    known_procedure(PredOrFunc, ModuleNameStr, Name, Arity, Status).
+
+    % known_procedure/4 is a table of library predicates whose trailing
+    % status is hardcoded into the analyser.  For a few predicates this
+    % information can make a big difference (particularly in the absence
+    % of any form of intermodule analysis).
+    %
 :- pred known_procedure(pred_or_func::in, string::in, string::in, int::in,
     trailing_status::out) is semidet.

 known_procedure(predicate, "require", "error", 1, will_not_modify_trail).
 known_procedure(function,  "require", "func_error", 1, will_not_modify_trail).
 known_procedure(_, "exception", "throw", 1, will_not_modify_trail).
+known_procedure(_, "exception", "rethrow", 1, will_not_modify_trail).

 %----------------------------------------------------------------------------%
 %
@@ -472,10 +516,12 @@
 % Extra procedures for handling calls
 %

-:- pred check_nonrecursive_call(module_info::in, vartypes::in,
+    % Check the trailing status of a call.
+    %
+:- pred check_call(module_info::in, vartypes::in,
     pred_proc_id::in, prog_vars::in, trailing_status::out) is det.

-check_nonrecursive_call(ModuleInfo, VarTypes, PPId, Args, Result) :-
+check_call(ModuleInfo, VarTypes, PPId, Args, Result) :-
     module_info_get_trailing_info(ModuleInfo, TrailingInfo),
     ( map.search(TrailingInfo, PPId, CalleeTrailingStatus) ->
         (
@@ -512,7 +558,7 @@

 % This is used in the analysis of calls to polymorphic procedures.
 %
-% By saying a `type may modify the trail' we mean that tail modification
+% By saying that a "type may modify the trail" we mean that tail modification
 % may occur as a result of a unification or comparison involving the type
 % because it has a user-defined equality/comparison predicate that modifies
 % the trail.
@@ -525,14 +571,15 @@
 % procedure is as follows:
 %
 % Examine the functor and then recursively examine the arguments.
+%
 % * If everything will not will_not_modify_trail then the type will not
 %   modify the trail.
 %
 % * If at least one of the types may modify the trail then the type will
 %   will modify the trail.
 %
-% * If at least one of the types is conditional and none of them throw then
-%   the type is conditional.
+% * If at least one of the types is conditional and none of them modify
+%   the trail then the type is conditional.

     % Return the collective trailing status of a list of types.
     %
@@ -610,13 +657,175 @@

 %----------------------------------------------------------------------------%
 %
+% Code for attaching trail usage information to goals
+%
+
+    % Traverse the body of the procedure and attach will_not_modify trail
+    % features to the goal_infos of those procedure that cannot modify the
+    % trail.
+    %
+:- pred annotate_proc(pred_proc_id::in,
+    module_info::in, module_info::out) is det.
+
+annotate_proc(PPId, !ModuleInfo) :-
+    some [!ProcInfo, !Body] (
+      module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, !:ProcInfo),
+      proc_info_goal(!.ProcInfo, !:Body),
+      proc_info_vartypes(!.ProcInfo, VarTypes),
+      annotate_goal(!.ModuleInfo, VarTypes, !Body, _Status),
+      proc_info_set_goal(!.Body, !ProcInfo),
+      module_info_set_pred_proc_info(PPId, PredInfo, !.ProcInfo, !ModuleInfo)
+    ).
+
+:- pred annotate_goal(module_info::in, vartypes::in,
+    hlds_goal::in, hlds_goal::out, trailing_status::out) is det.
+
+annotate_goal(ModuleInfo, VarTypes, !Goal, Status) :-
+    !.Goal = GoalExpr0 - GoalInfo0,
+    annotate_goal_2(ModuleInfo, VarTypes, GoalInfo0, GoalExpr0, GoalExpr,
+        Status),
+    ( Status = will_not_modify_trail ->
+        goal_info_add_feature(will_not_modify_trail, GoalInfo0, GoalInfo)
+    ;
+        GoalInfo = GoalInfo0
+    ),
+    !:Goal = GoalExpr - GoalInfo.
+
+:- pred annotate_goal_2(module_info::in, vartypes::in,
+    hlds_goal_info::in, hlds_goal_expr::in, hlds_goal_expr::out,
+    trailing_status::out) is det.
+
+annotate_goal_2(ModuleInfo, VarTypes, _, !Goal, Status) :-
+    !.Goal = conj(Conjuncts0),
+    annotate_goal_list(ModuleInfo, VarTypes, Conjuncts0, Conjuncts, Status),
+    !:Goal = conj(Conjuncts).
+annotate_goal_2(ModuleInfo, VarTypes, _, !Goal, Status) :-
+    !.Goal = par_conj(Conjuncts0),
+    annotate_goal_list(ModuleInfo, VarTypes, Conjuncts0, Conjuncts, Status),
+    !:Goal = par_conj(Conjuncts).
+annotate_goal_2(ModuleInfo, VarTypes, _, !Goal, Status) :-
+    !.Goal = call(CallPredId, CallProcId, CallArgs, _, _, _),
+    CallPPId = proc(CallPredId, CallProcId),
+    module_info_pred_info(ModuleInfo, CallPredId, CallPredInfo),
+    (
+        pred_info_is_builtin(CallPredInfo)
+    ->
+        Status = will_not_modify_trail
+    ;
+        % Handle unify and compare.
+        (
+            ModuleName = pred_info_module(CallPredInfo),
+            any_mercury_builtin_module(ModuleName),
+            Name = pred_info_name(CallPredInfo),
+            Arity = pred_info_orig_arity(CallPredInfo),
+            ( SpecialPredId = spec_pred_compare
+            ; SpecialPredId = spec_pred_unify
+            ),
+            special_pred_name_arity(SpecialPredId, Name, _, Arity)
+        ;
+            pred_info_get_origin(CallPredInfo, Origin),
+            Origin = special_pred(SpecialPredId - _),
+            ( SpecialPredId = spec_pred_compare
+            ; SpecialPredId = spec_pred_unify
+            )
+        )
+    ->
+        Status = may_modify_trail
+    ;
+        % Handle library predicates whose trailing status
+        % can be looked up in the known procedure table.
+        pred_info_has_known_status(CallPredInfo, Status0)
+    ->
+        Status = Status0
+    ;
+        % This time around we will be checking recursive calls as well.
+        check_call(ModuleInfo, VarTypes, CallPPId, CallArgs, Status)
+    ).
+annotate_goal_2(_ModuleInfo, _VarTypes, _, !Goal, Status) :-
+    % XXX Use closure analysis results here.
+    !.Goal = generic_call(_, _, _, _),
+    Status = may_modify_trail.
+annotate_goal_2(ModuleInfo, VarTypes, _, !Goal, Status) :-
+    !.Goal = switch(Var, CanFail, Cases0),
+    annotate_cases(ModuleInfo, VarTypes, Cases0, Cases, Status),
+    !:Goal = switch(Var, CanFail, Cases).
+annotate_goal_2(_ModuleInfo, _VarTypes, _, !Goal, Status) :-
+    !.Goal = unify(_, _, _, Kind, _),
+    ( Kind = complicated_unify(_, _, _) ->
+        unexpected(this_file, "complicated unify during trail usage analysis.")
+    ;
+        true
+    ),
+    Status = will_not_modify_trail.
+annotate_goal_2(ModuleInfo, VarTypes, _, !Goal, Status) :-
+    !.Goal = disj(Disjuncts0),
+    annotate_goal_list(ModuleInfo, VarTypes, Disjuncts0, Disjuncts, Status),
+    !:Goal = disj(Disjuncts).
+annotate_goal_2(ModuleInfo, VarTypes, _, !Goal, Status) :-
+    !.Goal = not(NegGoal0),
+    annotate_goal(ModuleInfo, VarTypes, NegGoal0, NegGoal, Status),
+    !:Goal = not(NegGoal).
+annotate_goal_2(ModuleInfo, VarTypes, OuterGoalInfo, !Goal, Status) :-
+    !.Goal = scope(Reason, InnerGoal0),
+    annotate_goal(ModuleInfo, VarTypes, InnerGoal0, InnerGoal, Status0),
+    InnerGoal = _ - InnerGoalInfo,
+    goal_info_get_code_model(InnerGoalInfo, InnerCodeModel),
+    goal_info_get_code_model(OuterGoalInfo, OuterCodeModel),
+    Status = scope_implies_trail_mod(InnerCodeModel, OuterCodeModel, Status0),
+    !:Goal = scope(Reason, InnerGoal).
+annotate_goal_2(ModuleInfo, VarTypes, _, !Goal, Status) :-
+    !.Goal = if_then_else(Vars, If0, Then0, Else0),
+    annotate_goal(ModuleInfo, VarTypes, If0, If, IfStatus),
+    annotate_goal(ModuleInfo, VarTypes, Then0, Then, ThenStatus),
+    annotate_goal(ModuleInfo, VarTypes, Else0, Else, ElseStatus),
+    (
+        IfStatus   = will_not_modify_trail,
+        ThenStatus = will_not_modify_trail,
+        ElseStatus = will_not_modify_trail
+    ->
+        Status = will_not_modify_trail
+    ;
+        Status = may_modify_trail
+    ),
+    !:Goal = if_then_else(Vars, If, Then, Else).
+annotate_goal_2( _, _, _, !Goal, Status) :-
+    !.Goal = foreign_proc(Attributes, _, _, _, _, _),
+    Status = attributes_imply_trail_mod(Attributes).
+annotate_goal_2(_, _, _, shorthand(_), _, _) :-
+    unexpected(this_file, "shorthand goal").
+
+:- pred annotate_goal_list(module_info::in, vartypes::in, hlds_goals::in,
+    hlds_goals::out, trailing_status::out) is det.
+
+annotate_goal_list(ModuleInfo, VarTypes, !Goals, Status) :-
+    list.map2(annotate_goal(ModuleInfo, VarTypes), !Goals, Statuses),
+    list.foldl(combine_trailing_status, Statuses, will_not_modify_trail,
+        Status).
+
+:- pred annotate_cases(module_info::in, vartypes::in,
+    list(case)::in, list(case)::out, trailing_status::out) is det.
+
+annotate_cases(ModuleInfo, VarTypes, !Cases, Status) :-
+    list.map2(annotate_case(ModuleInfo, VarTypes), !Cases, Statuses),
+    list.foldl(combine_trailing_status, Statuses, will_not_modify_trail,
+        Status).
+
+:- pred annotate_case(module_info::in, vartypes::in,
+    case::in, case::out, trailing_status::out) is det.
+
+annotate_case(ModuleInfo, VarTypes, !Case, Status) :-
+    !.Case = case(ConsId, Goal0),
+    annotate_goal(ModuleInfo, VarTypes, Goal0, Goal, Status),
+    !:Case = case(ConsId, Goal).
+
+%----------------------------------------------------------------------------%
+%
 % Stuff for intermodule optimization
 %

-:- pred trailing_analysis.make_opt_int(module_info::in, io::di, io::uo)
-    is det.
+:- pred make_opt_int(module_info::in, io::di, io::uo) is det.

-trailing_analysis.make_opt_int(ModuleInfo, !IO) :-
+make_opt_int(ModuleInfo, !IO) :-
     module_info_get_name(ModuleInfo, ModuleName),
     module_name_to_file_name(ModuleName, ".opt.tmp", no, OptFileName, !IO),
     globals.io_lookup_bool_option(verbose, Verbose, !IO),
@@ -704,8 +913,9 @@
 output_proc_names(ModuleInfo, SCC, !IO) :-
     list.foldl(output_proc_name(ModuleInfo), SCC, !IO).

-:- pred output_proc_name(module_info::in, pred_proc_id::in,
-    io::di, io::uo) is det.
+:- pred output_proc_name(module_info::in, pred_proc_id::in, io::di, io::uo)
+    is det.
+
 output_proc_name(Moduleinfo, PPId, !IO) :-
    Pieces = describe_one_proc_name(Moduleinfo, should_module_qualify, PPId),
    Str = error_pieces_to_string(Pieces),

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list