[m-rev.] diff: use intermodule-analysis framework info. in unneeded_code

Julien Fischer juliensf at cs.mu.OZ.AU
Wed Feb 22 14:54:07 AEDT 2006


Estimated hours taken: 1
Branches: main

compiler/uneeded_code.m:
	Make this optimization use the new interface to
	goal_can_loop_or_throw.  This means the optimization can now make use
	of information from the intermodule-analysis framework (or the .opt
	files).
Julien.

Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.28
diff -u -r1.28 unneeded_code.m
--- compiler/unneeded_code.m	28 Nov 2005 04:11:59 -0000	1.28
+++ compiler/unneeded_code.m	22 Feb 2006 03:40:11 -0000
@@ -222,7 +222,7 @@
         hlds_out__write_pred_proc_id(!.ModuleInfo, PredId, ProcId, !IO),
         io__write_string(": ", !IO),
         pre_process_proc(!ProcInfo),
-        process_proc(!ProcInfo, !ModuleInfo, Successful),
+        process_proc(!ProcInfo, !ModuleInfo, Successful, !IO),
         (
             Successful = yes,
             io__write_string("done.\n", !IO)
@@ -233,7 +233,7 @@
     ;
         VeryVerbose = no,
         pre_process_proc(!ProcInfo),
-        process_proc(!ProcInfo, !ModuleInfo, _)
+        process_proc(!ProcInfo, !ModuleInfo, _, !IO)
     ).

 :- pred pre_process_proc(proc_info::in, proc_info::out) is det.
@@ -283,9 +283,9 @@
             ).

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

-process_proc(!ProcInfo, !ModuleInfo, Successful) :-
+process_proc(!ProcInfo, !ModuleInfo, Successful, !IO) :-
     goal_path__fill_slots(!.ModuleInfo, !ProcInfo),
     proc_info_goal(!.ProcInfo, Goal0),
     proc_info_varset(!.ProcInfo, Varset0),
@@ -308,8 +308,8 @@
     globals__lookup_int_option(Globals, unneeded_code_copy_limit, Limit),
     Options = option_values(FullyStrict, ReorderConj, Limit),
     process_goal(Goal0, Goal1, InitInstMap, FinalInstMap, VarTypes0,
-        !.ModuleInfo, Options, WhereNeededMap1, _, map__init, RefinedGoals1,
-        no, Changed),
+        Options, WhereNeededMap1, _, map__init, RefinedGoals1,
+        no, Changed, !ModuleInfo, !IO),
     refine_goal(Goal1, Goal2, RefinedGoals1, RefinedGoals),
     expect(map__is_empty(RefinedGoals),
         this_file, "process_proc: goal reattachment unsuccessful"),
@@ -326,7 +326,7 @@
         proc_info_set_goal(Goal, !ProcInfo),
         proc_info_set_varset(Varset, !ProcInfo),
         proc_info_set_vartypes(VarTypes, !ProcInfo),
-        process_proc(!ProcInfo, !ModuleInfo, _),
+        process_proc(!ProcInfo, !ModuleInfo, _, !IO),
         Successful = yes
     ;
         Changed = no,
@@ -334,21 +334,23 @@
     ).

 :- pred process_goal(hlds_goal::in, hlds_goal::out, instmap::in, instmap::in,
-    vartypes::in, module_info::in, option_values::in,
+    vartypes::in, option_values::in,
     where_needed_map::in, where_needed_map::out,
-    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
+    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out,
+    module_info::in, module_info::out, io::di, io::uo) is det.

-process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
-        Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
+process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes, Options,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO) :-
     can_eliminate_or_move(Goal0, InitInstMap, FinalInstMap,
-        VarTypes, ModuleInfo, Options, !.WhereNeededMap, WhereInfo),
+        VarTypes, Options, !.WhereNeededMap, WhereInfo, !ModuleInfo, !IO),
     (
         WhereInfo = everywhere,
         process_goal_internal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
-            ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed)
+            Options, !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo,
+            !IO)
     ;
         WhereInfo = branches(Branches),
-        demand_inputs(Goal0, ModuleInfo, InitInstMap, WhereInfo,
+        demand_inputs(Goal0, !.ModuleInfo, InitInstMap, WhereInfo,
             !WhereNeededMap),
         map__to_assoc_list(Branches, BranchList),
         list__foldl(insert_branch_into_refined_goals(Goal0), BranchList,
@@ -356,7 +358,7 @@
         true_goal(Goal),
         !:Changed = yes
     ),
-    undemand_virgin_outputs(Goal0, ModuleInfo, InitInstMap,
+    undemand_virgin_outputs(Goal0, !.ModuleInfo, InitInstMap,
         !WhereNeededMap),
     (
         Goal = _ - GoalInfo,
@@ -400,13 +402,13 @@

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

-:- pred can_eliminate_or_move(hlds_goal::in, instmap::in,
-    instmap::in, vartypes::in, module_info::in, option_values::in,
-    where_needed_map::in, where_needed::out) is det.
-
-can_eliminate_or_move(Goal, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
-        Options, WhereNeededMap, !:WhereInfo) :-
-    instmap_changed_vars(InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
+:- pred can_eliminate_or_move(hlds_goal::in, instmap::in, instmap::in,
+    vartypes::in, option_values::in, where_needed_map::in,where_needed::out,
+    module_info::in, module_info::out, io::di, io::uo) is det.
+
+can_eliminate_or_move(Goal, InitInstMap, FinalInstMap, VarTypes,
+        Options, WhereNeededMap, !:WhereInfo, !ModuleInfo, !IO) :-
+    instmap_changed_vars(InitInstMap, FinalInstMap, VarTypes, !.ModuleInfo,
         ChangedVarSet),
     set__to_sorted_list(ChangedVarSet, ChangedVars),
     map__init(Empty),
@@ -415,7 +417,7 @@
     goal_info_get_goal_path(GoalInfo, CurrentPath),
     list__foldl(collect_where_needed(CurrentPath, WhereNeededMap), ChangedVars,
         !WhereInfo),
-    adjust_where_needed(Goal, Options, !WhereInfo).
+    adjust_where_needed(Goal, Options, !WhereInfo, !ModuleInfo, !IO).

 :- pred collect_where_needed(goal_path::in, where_needed_map::in, prog_var::in,
     where_needed::in, where_needed::out) is det.
@@ -433,9 +435,11 @@
     % programmer.
     %
 :- pred adjust_where_needed(hlds_goal::in, option_values::in,
-    where_needed::in, where_needed::out) is det.
+    where_needed::in, where_needed::out, module_info::in, module_info::out,
+    io::di, io::uo) is det.

-adjust_where_needed(Goal, Options, !WhereInfo) :-
+adjust_where_needed(Goal, Options, !WhereInfo, !ModuleInfo, !IO) :-
+    goal_can_loop_or_throw(Goal, GoalCanLoopOrThrow, !ModuleInfo, !IO),
     (
         Goal = GoalExpr - GoalInfo,
         (
@@ -453,12 +457,12 @@
             % With --fully-strict, we cannot optimize away infinite loops
             % or exceptions.
             Options ^ fully_strict = yes,
-            goal_can_loop_or_throw(Goal)
+            GoalCanLoopOrThrow = can_loop_or_throw
         ;
             % With --no-reorder-conj, we cannot move infinite loops or
             % exceptions, but we can delete them.
             Options ^ reorder_conj = no,
-            goal_can_loop_or_throw(Goal),
+            GoalCanLoopOrThrow = can_loop_or_throw,
             !.WhereInfo = branches(BranchMap),
             \+ map__is_empty(BranchMap)
         ;
@@ -571,43 +575,44 @@
 %---------------------------------------------------------------------------%

 :- pred process_goal_internal(hlds_goal::in, hlds_goal::out,
-    instmap::in, instmap::in, vartypes::in, module_info::in,
-    option_values::in, where_needed_map::in, where_needed_map::out,
-    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
+    instmap::in, instmap::in, vartypes::in, option_values::in,
+    where_needed_map::in, where_needed_map::out,
+    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out,
+    module_info::in, module_info::out, io::di, io::uo) is det.

 process_goal_internal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
-        ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
+        Options, !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO) :-
     Goal0 = GoalExpr0 - GoalInfo0,
     (
         GoalExpr0 = unify(_, _, _, _, _),
         Goal = Goal0,
-        demand_inputs(Goal, ModuleInfo, InitInstMap, everywhere,
+        demand_inputs(Goal, !.ModuleInfo, InitInstMap, everywhere,
             !WhereNeededMap)
     ;
         GoalExpr0 = call(_, _, _, _, _, _),
         Goal = Goal0,
-        demand_inputs(Goal, ModuleInfo, InitInstMap, everywhere,
+        demand_inputs(Goal, !.ModuleInfo, InitInstMap, everywhere,
             !WhereNeededMap)
     ;
         GoalExpr0 = generic_call(_, _, _, _),
         Goal = Goal0,
-        demand_inputs(Goal, ModuleInfo, InitInstMap, everywhere,
+        demand_inputs(Goal, !.ModuleInfo, InitInstMap, everywhere,
             !WhereNeededMap)
     ;
         GoalExpr0 = foreign_proc(_, _, _, _, _, _),
         Goal = Goal0,
-        demand_inputs(Goal, ModuleInfo, InitInstMap, everywhere,
+        demand_inputs(Goal, !.ModuleInfo, InitInstMap, everywhere,
             !WhereNeededMap)
     ;
         GoalExpr0 = par_conj(_),
         Goal = Goal0,
-        demand_inputs(Goal, ModuleInfo, InitInstMap, everywhere,
+        demand_inputs(Goal, !.ModuleInfo, InitInstMap, everywhere,
             !WhereNeededMap)
     ;
         GoalExpr0 = conj(Conjuncts0),
         process_conj(Conjuncts0, Conjuncts, InitInstMap, FinalInstMap,
-            VarTypes, ModuleInfo, Options, !WhereNeededMap, !RefinedGoals,
-            !Changed),
+            VarTypes, Options, !WhereNeededMap, !RefinedGoals,
+            !Changed, !ModuleInfo, !IO),
         GoalExpr = conj(Conjuncts),
         Goal = GoalExpr - GoalInfo0
     ;
@@ -627,8 +632,9 @@
         map__map_values(demand_var_everywhere, !WhereNeededMap),
         map__init(BranchNeededMap0),
         process_cases(Cases0, Cases, BranchPoint, 1, InitInstMap, FinalInstMap,
-            VarTypes, ModuleInfo, Options, GoalPath, !.WhereNeededMap,
-            BranchNeededMap0, BranchNeededMap, !RefinedGoals, !Changed),
+            VarTypes, Options, GoalPath, !.WhereNeededMap,
+            BranchNeededMap0, BranchNeededMap, !RefinedGoals, !Changed,
+            !ModuleInfo, !IO),
         merge_where_needed_maps(GoalPath, !.WhereNeededMap,
             BranchNeededMap, !:WhereNeededMap),
         demand_var(GoalPath, everywhere, SwitchVar, !WhereNeededMap),
@@ -639,9 +645,9 @@
         goal_info_get_goal_path(GoalInfo0, GoalPath),
         map__map_values(demand_var_everywhere, !WhereNeededMap),
         process_disj(Disjuncts0, Disjuncts, InitInstMap, FinalInstMap,
-            VarTypes, ModuleInfo, Options, GoalPath,
+            VarTypes, Options, GoalPath,
             !.WhereNeededMap, !.WhereNeededMap, !:WhereNeededMap,
-            !RefinedGoals, !Changed),
+            !RefinedGoals, !Changed, !ModuleInfo, !IO),
         GoalExpr = disj(Disjuncts),
         Goal = GoalExpr - GoalInfo0
     ;
@@ -650,21 +656,22 @@
         BranchPoint = branch_point(GoalPath, ite),
         map__map_values(demand_var_everywhere, !WhereNeededMap),
         process_ite(Cond0, Cond, Then0, Then, Else0, Else, BranchPoint,
-            InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, GoalPath,
-            !WhereNeededMap, !RefinedGoals, !Changed),
+            InitInstMap, FinalInstMap, VarTypes, Options, GoalPath,
+            !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO),
         GoalExpr = if_then_else(Quant, Cond, Then, Else),
         Goal = GoalExpr - GoalInfo0
     ;
         GoalExpr0 = not(NegGoal0),
         process_goal(NegGoal0, NegGoal, InitInstMap, FinalInstMap,
-            VarTypes, ModuleInfo, Options,
-            !WhereNeededMap, !RefinedGoals, !Changed),
+            VarTypes, Options,
+            !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO),
         GoalExpr = not(NegGoal),
         Goal = GoalExpr - GoalInfo0
     ;
         GoalExpr0 = scope(Reason, SomeGoal0),
         process_goal(SomeGoal0, SomeGoal, InitInstMap, FinalInstMap, VarTypes,
-            ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed),
+            Options, !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo,
+            !IO),
         GoalExpr = scope(Reason, SomeGoal),
         Goal = GoalExpr - GoalInfo0
     ;
@@ -678,16 +685,17 @@
     --->    bracketed_goal(hlds_goal, instmap, instmap).

 :- pred process_conj(list(hlds_goal)::in, list(hlds_goal)::out,
-    instmap::in, instmap::in, vartypes::in, module_info::in,
-    option_values::in, where_needed_map::in, where_needed_map::out,
-    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
+    instmap::in, instmap::in, vartypes::in, option_values::in,
+    where_needed_map::in, where_needed_map::out,
+    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out,
+    module_info::in, module_info::out, io::di, io::uo) is det.

-process_conj(Goals0, Goals, InitInstMap, _FinalInstMap, VarTypes, ModuleInfo,
-        Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
+process_conj(Goals0, Goals, InitInstMap, _FinalInstMap, VarTypes, Options,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO) :-
     build_bracketed_conj(Goals0, InitInstMap, BracketedGoals),
     list__reverse(BracketedGoals, RevBracketedGoals),
     process_rev_bracketed_conj(RevBracketedGoals, RevGoals, VarTypes,
-        ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed),
+        Options, !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO),
     list__reverse(RevGoals, Goals).

 :- pred build_bracketed_conj(list(hlds_goal)::in, instmap::in,
@@ -707,19 +715,20 @@
     ).

 :- pred process_rev_bracketed_conj(list(bracketed_goal)::in,
-    list(hlds_goal)::out, vartypes::in, module_info::in, option_values::in,
+    list(hlds_goal)::out, vartypes::in, option_values::in,
     where_needed_map::in, where_needed_map::out,
-    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
+    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out,
+    module_info::in, module_info::out, io::di, io::uo) is det.

-process_rev_bracketed_conj([], [], _, _, _,
-        !WhereNeededMap, !RefinedGoals, !Changed).
+process_rev_bracketed_conj([], [], _, _,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO).
 process_rev_bracketed_conj([BracketedGoal | BracketedGoals], Goals, VarTypes,
-        ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed) :-
+        Options, !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO) :-
     BracketedGoal = bracketed_goal(Goal0, InitInstMap, FinalInstMap),
     process_goal(Goal0, Goal1, InitInstMap, FinalInstMap, VarTypes,
-        ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed),
+        Options, !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO),
     process_rev_bracketed_conj(BracketedGoals, Goals1, VarTypes,
-        ModuleInfo, Options, !WhereNeededMap, !RefinedGoals, !Changed),
+        Options, !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO),
     ( true_goal(Goal1) ->
         Goals = Goals1
     ;
@@ -729,72 +738,75 @@
 %---------------------------------------------------------------------------%

 :- pred process_disj(list(hlds_goal)::in, list(hlds_goal)::out,
-    instmap::in, instmap::in, vartypes::in, module_info::in,
-    option_values::in, goal_path::in,
+    instmap::in, instmap::in, vartypes::in, option_values::in, goal_path::in,
     where_needed_map::in, where_needed_map::in, where_needed_map::out,
-    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
+    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out,
+    module_info::in, module_info::out, io::di, io::uo) is det.

-process_disj([], [], _, _, _, _, _, _, _,
-        !WhereNeededMap, !RefinedGoals, !Changed).
+process_disj([], [], _, _, _, _, _, _,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO).
 process_disj([Goal0 | Goals0], [Goal | Goals], InitInstMap, FinalInstMap,
-        VarTypes, ModuleInfo, Options, CurrentPath,
-        StartWhereNeededMap, !WhereNeededMap, !RefinedGoals, !Changed) :-
-    process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
+        VarTypes, Options, CurrentPath, StartWhereNeededMap,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO) :-
+    process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
         Options, StartWhereNeededMap, WhereNeededMapFirst, !RefinedGoals,
-        !Changed),
+        !Changed, !ModuleInfo, !IO),
     map__to_assoc_list(WhereNeededMapFirst, WhereNeededList),
     add_where_needed_list(WhereNeededList, CurrentPath, !WhereNeededMap),
     process_disj(Goals0, Goals, InitInstMap, FinalInstMap, VarTypes,
-        ModuleInfo, Options, CurrentPath, StartWhereNeededMap,
-        !WhereNeededMap, !RefinedGoals, !Changed).
+        Options, CurrentPath, StartWhereNeededMap,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO).

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

 :- pred process_cases(list(case)::in, list(case)::out, branch_point::in,
-    int::in, instmap::in, instmap::in, vartypes::in, module_info::in,
+    int::in, instmap::in, instmap::in, vartypes::in,
     option_values::in, goal_path::in, where_needed_map::in,
     where_needed_map::in, where_needed_map::out,
     refined_goal_map::in, refined_goal_map::out,
-    bool::in, bool::out) is det.
+    bool::in, bool::out, module_info::in, module_info::out, io::di, io::uo)
+    is det.

-process_cases([], [], _, _, _, _, _, _, _, _, _,
-        !WhereNeededMap, !RefinedGoals, !Changed).
+process_cases([], [], _, _, _, _, _, _, _, _,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO).
 process_cases([case(Var, Goal0) | Cases0], [case(Var, Goal) | Cases],
         BranchPoint, BranchNum, InitInstMap, FinalInstMap, VarTypes,
-        ModuleInfo, Options, CurrentPath, StartWhereNeededMap,
-        !WhereNeededMap, !RefinedGoals, !Changed) :-
-    process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
+        Options, CurrentPath, StartWhereNeededMap,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO) :-
+    process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes,
         Options, StartWhereNeededMap, WhereNeededMapFirst, !RefinedGoals,
-        !Changed),
+        !Changed, !ModuleInfo, !IO),
     map__to_assoc_list(WhereNeededMapFirst, WhereNeededList),
     add_alt_start(WhereNeededList, BranchPoint, BranchNum, CurrentPath,
         !WhereNeededMap),
     process_cases(Cases0, Cases, BranchPoint, BranchNum + 1,
-        InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, CurrentPath,
-        StartWhereNeededMap, !WhereNeededMap, !RefinedGoals, !Changed).
+        InitInstMap, FinalInstMap, VarTypes, Options, CurrentPath,
+        StartWhereNeededMap, !WhereNeededMap, !RefinedGoals, !Changed,
+        !ModuleInfo, !IO).

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

 :- pred process_ite(hlds_goal::in, hlds_goal::out,
     hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out,
     branch_point::in, instmap::in, instmap::in, vartypes::in,
-    module_info::in, option_values::in, goal_path::in,
+    option_values::in, goal_path::in,
     where_needed_map::in, where_needed_map::out,
-    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det.
+    refined_goal_map::in, refined_goal_map::out, bool::in, bool::out,
+    module_info::in, module_info::out, io::di, io::uo) is det.

 process_ite(Cond0, Cond, Then0, Then, Else0, Else, BranchPoint,
-        InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options,
-        CurrentPath, !WhereNeededMap, !RefinedGoals, !Changed) :-
+        InitInstMap, FinalInstMap, VarTypes, Options, CurrentPath,
+        !WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO) :-
     Cond0 = _ - CondInfo0,
     goal_info_get_instmap_delta(CondInfo0, InstMapDelta),
     instmap__apply_instmap_delta(InitInstMap, InstMapDelta, InstMapCond),

-    process_goal(Else0, Else, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
+    process_goal(Else0, Else, InitInstMap, FinalInstMap, VarTypes,
         Options, !.WhereNeededMap, WhereNeededMapElse, !RefinedGoals,
-        !Changed),
-    process_goal(Then0, Then, InstMapCond, FinalInstMap, VarTypes, ModuleInfo,
+        !Changed, !ModuleInfo, !IO),
+    process_goal(Then0, Then, InstMapCond, FinalInstMap, VarTypes,
         Options, !.WhereNeededMap, WhereNeededMapThen, !RefinedGoals,
-        !Changed),
+        !Changed, !ModuleInfo, !IO),

     map__init(BranchNeededMap0),
     map__to_assoc_list(WhereNeededMapElse, WhereNeededListElse),
@@ -807,8 +819,8 @@
         !.WhereNeededMap, BranchNeededMap, WhereNeededMapCond),

     process_goal(Cond0, Cond, InitInstMap, InstMapCond,
-        VarTypes, ModuleInfo, Options, WhereNeededMapCond,
-        !:WhereNeededMap, !RefinedGoals, !Changed).
+        VarTypes, Options, WhereNeededMapCond,
+        !:WhereNeededMap, !RefinedGoals, !Changed, !ModuleInfo, !IO).

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